comment A1 -- DH's versions;
comment A1 now has crude inbasicsymbol;
procedure open(dv); value dv; integer dv;
kdf9 2/1/1/0;
{dv}; JSP293; exit
P293V40; ( Open );
V0 = Q 0/AV1/AV40; (+ V-stores are paper tape input buffer );
SET20; NEV; J1=Z; EXIT1; (+ interim version only devs 20 and 30 allowed );
1; V0; =Q15; SET2; SET5; OUT; =C15; (+ Max amount of data is 320 chars );
Q15; =V0;
2; PREQ15; PARQ15;
I15; =RM15; SET-48; =C15; Q15; =V0P295;
EXIT1;
P295V9; ( General Character and Basic Symbol Handling );
V3 = 0; (+ shift indicator );
V4 = B 000 00 230 645 07 246; (blank, pound, semicolon, !=, star, comma 000 012 230 322 216 246);
V5 = B 000 05 230 603 50 413; (blank, subten, semicolon, +, -, dot 000 012 230 301 321 013);
V6 = -1; ( retained basic symbol );
V7 = Q B134601 / B104631 / B101302; ( colon, uparrow, lhsq, rhsq, lt, gt );
V8 = Q B121261 / B110604 / B112000; ( =, times, idiv, bra, ket, 000 );
V9 = Q B106616 / B111235 / B131000; (C15 = 0 for LH-quote, 1 for star, 2 for <=, 3 for RH-quote, 4 for >= );
10; V6; REV; =V6; J91<Z; (+ retain basic symbol );
SET10; SET5; J109P299; (+ error if used twice );
4; (+ initialise basic symbol fetch );
3; (+ initialise character fetch );
ERASE; (+ assume dv = 20 );
V0; DUP; JP299=Z;
=Q13; EXIT1;
94; V0P293; =Q15; JS2P293; V0; =Q13;
5; J52C13NZ; (+ fetch character );
SETAV40P293; M13; -; J94=Z; ( end of buffer );
M+I13; SET-48; =C13; ( move to next word );
52; SET6; =+C13; M0M13; SHLC13; SETB77; AND;
91; EXIT1;
8; (+ freeze basic symbol fetch );
7; (+ freeze character fetch );
Q13; =V0; EXIT1;
85; =V3; ( store shift char and fetch another symbol );
6; (+ fetch basic symbol - only letters and digits + a few others );
V6; ZERO; NOT; =V6; DUP; J92>=Z; ERASE;
JS5; DUP; SHL-5; J86=Z; SETB25; -; SET26; V3; AND; +; EXIT2; ( letter );
86; DUP; J87#Z; ERASE; SETB236; EXIT2;
87; DUP; NOT; NEG; SHL-4; J88=Z; ( J if not / or digit etc );
DUP; SETB32; -; DUP; SHL+3; =C15; J89<Z; ( J if / or digit );
ERASE; J70C15Z; ( J if underline );
V3; =M15; ( shift indicator );
V5M15; SHLC15; SHL-40; DUP; J96=Z; EXIT2; ( chars beyond digits );
89; V3; J93#Z; SETB20; -; DUP; J92>=Z; ( j IF digit );
ERASE; SETB241; ( SLASH );
92; EXIT2;
93: ( shifted digit );
ERASE; V8; V7; SHLDC15; ERASE; SETB377; AND; EXIT2;
88; SHC-1; DUP; NEG; NOT; J84#Z; ERASE; SETB240; EXIT2; (carriage return);
84; STR; NOT; REV; SET3; NEV; J85=Z; ( SHIFT CHAR );
71: NC15; ERASE; (C15 = 0 for LH-quote, 1 for star, 2 for <=, 3 for RH-quote, 4 for >= );
C15; SHL+3; =C15; V9; SHLC15; SHL-40; EXIT2;
70; JS6; J96; C0TOQ15;
SETB211; J71=; DC15; DUP; J71=Z; DC15; SETB202; J71=;
DC15; SETB231; J71=; DC15; SETB302; J71=;
96; ERASE; SETB216; EXIT2; (+ fetch basic symbol - too fancy - return asterisk );
( SET6; SET5; J109P299; earlier failure response );
12; ERASE; (+ initialise basic symbol output - ignore device number );
SETB177615; =V1; (+ opening string quote );
M2TOQ8; (+ keep stack pointer );
EXIT1;
V2 = Q B117256/B120240/0; (+ space, tab, page?? newline?? );
18; SHL+3; =C8; (+ output editing symbol );
V2; SHLC8; SHL-40; (+ drop through to output basic symbol );
14; V1; DUP; (+ output basic symbol );
NOT; SHL-40; J141=Z; (+ J if word not full );
=Y0M2Q; ZERO; NOT;
141;SHL+8; OR; =V1;
C0TOQ8; (+ mystery use of J116C8Z in P291 );
EXIT1;
16; SETB235; JS14; (+ freeze basic symbol output );
V1; NOT; ZERO;
161;ERASE; ZERO; SHLD+8;
DUP; J161=Z; (+ remove dummies at start of word );
SHLD-8; ERASE; NOT;
=Y0M2Q; (+ partial word to buffer );
M8; SETAY0; +; (+ closing string quote to use writetext );
JS2P288;
M8TOQ2; (+ put the stack pointer back );
VR; (+ P291 (write) sometimes leaves overflow set );
EXIT1;
(+ stolen from KQX -- used in format );
20; ERASE;
1; (Fetch BS from string address in M14);
J189C13NZ;
M0M14Q; =V8; SET6; =C13;
189; V8; ZERO; SHLD+8; REV; =V8;
DC13; SETB236; J20=;
SETB240; J20=;
SETB256; J20=;
EXIT1;
(+ unimplemented );
9; SET9; SET5; J108P299; (+ retain character );
11; SET11; SET5; J108P299; (+ initialise character output );
13; SET13; SET5; J108P299; (+ output character );
15; ZERO; SET15; SET5; J108P299; (+ freeze character output );
116;SET116; SET5; J108P299; (+ output characters with automatic case management );
P288V41; ( write text -- also used in R16P295 );
V0 = Q 0/1/AV0; ( buffer for partial line );
ERASE; ( ignore device number for now );
2; SETAY0; M2; +; DUP; PERM; NOT; NEG; =RM15;
CI0TOQ13; SET100; =C15; ( P700 setup missed out by side entry);
V0; = Q14; J10C14Z; ( J if there is no left-over partial line );
11; M0M14Q; =M0M15Q; J11C14NZ; ( copy it at start of output area );
M0M14N; NOT; ( turn dummies to zeros );
DUP; SHL+42; J9#Z; ( J if last saved word is full);
SETB77;
8; DUPD; SET+6; =+C13; ( find position of next free char slot );
SHLC13; AND; J8=Z; ( J if character is dummy - 1st char is never dummy );
REV;
ZERO; NOT; SHLC13; NEV; ( invert the characters back to normal leaving the blanks );
M-I15; =M0M15Q; ( and put the word back in the buffer );
9; ERASE;
10; JS22P700; ( convert ABS to chars );
SETAV0; =RM14;
SETB102; DUP; ( leave 1 in the nest for use later );
M0M15; NEV;
SETB76; AND; J3=Z; ( N1=Z for any paper feed );
=Y0M2; ( if we scan back to this there is no newline - 01 can never be output by P700 );
I15=-1; SET40; =C15; ( for scanning backwards to find last cr );
M0M15Q;
4; =M0M14QN; M0M15Q; J6C15Z; DUP; SETB76;
AND; NEG; NOT; NEG; NOT;
J4#Z;
NC14; I14=-1; ( Ready to unstack the saved words );
M-I15; ( last word to be output );
SETB102; NEV; ( no newline in output string );
3; Q14; =V0; ( stack of output held over to newline );
SETB30; =Y0M2; ( always output on stream 30 for now );
REV; =I15; ( start of output kept from label 2 );
J12=Z; ( jump if there was no newline char );
C0TOQ15; Q15;
SET8; OUT;
12; EXIT1;
6; M0M15; SET3; SETB177410; J108P299; (fail too much output without cr );
algol
procedure close(dv); value dv; integer dv;
kdf9 12/3/2/0;
{dv};JSP292; exit (+ P292 is missing from KQX9101, so it used to be in runtime2.txt );
P292V0; ( Close );
V0 = Q B106640 / B116400 / 0; ( {{c}} );
ERASE; ( interim version only devs 20 and 30 actually work );
V0P288; SHL-32; J9=Z; ( J if no incomplete line to print );
SETAV0; J2P288; ( output newline to force printing );
9; EXIT1;
21;SET21; SET2; J109P299; ( don't know why we need this - perhaps we don't );
algol
****