!comment A6 -- DH's version of A1 etc !comment A1 now has crude inbasicsymbol; !procedure open(dv); !value dv; !integer dv; !KDF9 12/9/14/0; (+ usage by the genuine original ); {dv}; JSP293; !EXIT; P293V40; ( Open ); V0 = Q 0/AV1/AV40; (+ V-stores are paper tape input buffer ); SET20; NEV; J1#Z; (+ interim(?) version only devs 20 and 30 allowed ); V0; DUP; =V0P295; (+ first JS5P295 will cause the first read ); =Q13; SET2; SET5; OUT; =C13; Q13; =V0; 1; 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; 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 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 ); SET22; =+M2; (+ avoid overwriting base of stack frame ); 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; (+ freeze basic symbol output ); JS14; (+ add closing string quote to use writetext ); 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; SETAY22; +; (+ address of start of string ); 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 ); SET22; =+M2; ( leave gap at top of stack ); JS2; SET-22; =+M2; ( reclaim gap at top of stack ); EXIT1; 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; M-I15; ( last word to be output ); 5; NC14; I14=-1; ( Ready to unstack the saved words ); SETB102; NEV; ( will be 0 if 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; I15=+1; M+I15; ( step back up the string ); SETB177702; =M0M15QN; ( put in an extra CR ); J5; !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}} ); SET30; -; ( interim version only devs 20 and 30 actually work ); J9=Z; REV; DUP; J6C7NZ; I7=-1; J9C8NZ; M8; J6=Z; 9; J3>=Z; NOT; C0TOQ9; J4; 10; DUP; M8; -; NOT; DUP; J15>Z; I7=-1; J25C8NZ; J14=Z; REV; DUP; J11>=Z; J13C9Z; NOT; 13; NEG; 11; I8; J12>=Z; NEG; 12; I0TOQ8; =V0; Q9; =V1; Q0TOQ9; DC8; ZERO; NOT; REV; C0TOQ7; J8; 14; I9; J26#Z; I9=+1; J8; 15; SET182; J17=; SET198; J18#; ERASE; I8; I8=-1; 16; J27#Z; I7=-1; REV; DUP; J28>=Z; REV; J8; 17; ERASE; I8; I8=+1; J16; 18; ERASE; I7; J8=Z; M8; SETB236; J34=; SETB240; J34=; SETB256; J34=; ERASE; 36; ERASE; DUP; J19>=Z; J29C9Z; NOT; 19; M9; I9; +; NEG; NOT; J30=Z; I8; J20>=Z; NEG; 20; J21C8Z; V1; =Q9; =+C9; V0; 21; C9; M9; -; M8; JS10P295; JS8P295; 22; V2; *D; SHAD+2; DUPD; ROUND; DUP; =Q8; ZERO; REV; -D; CONT; DUP; DUP; *; SHA-7; DUP; V3; *; V4; +; REV; V5; +; V6; REV; %; +; REV; SHA-4; DUPD; +; PERM; -; SHA+1; %; REV; DUP; ZERO; FLOAT; FIX; NEG; =C9; ERASE; SHLC9; *; Q8; SET48; +; C9; -; REV; DUP; J41=Z; ZERO; FLOAT; STR; PERM; ZERO; SHAD+8; CAB; +; SHAD-8; DUP; J42 >=Z; ERASE; 41; ERASE; ERASE; ZERO; J43; 42; CONT; REV; CONT; 43; J33V; V7; SHA+48; ERASE; EXIT1; 24; ERASE; SET1; 31; CAB; ERASE; 32; V12; PERM; V10; JS39; J37; JS39; J38; J36; 37; DUP; 38; SHL+8; OR; SHL+8; OR; SHL+16; V11; OR; =V9; JP299; 25; ERASE; ERASE; SET2; J32; 26; ERASE; SET3; J32; 27; ERASE; SET4; J32; 28; SET5; J31; 29; SET6; J32; 30; SET7; J32; 33; SET8; J32; 34; ERASE; J8; 35; M7; NOT; NEG; =I14; I7; J23=Z; =M8; J36; 39; SET10; %I; REV; DUP; J40#Z; ERASE; SETB236; EXIT1; 40; EXIT2; 'ALGOL'; 'boolean' 'procedure' read boolean(device); 'value' device; 'integer' device; 'KDF9' 12/9/14/0; {device}; (read b00llan); JS4P295; ZERO; J2; 1; SETB315; NEV; J3=Z; DUP; 4; ERASE; 2; JS6P295; J4; SETB335; J1#; ERASE; NOT; 3; JS8P295; 'EXIT'; 'ALGOL'; 'comment' A5 -- Genuine library A5 taken from KQX; 'procedure' write(device,form,value); 'value' device,form,value; 'real' value; 'integer' device,form; 'KDF9' 12/9/14/0; {value}; {form}; {device}; JSP291; 'EXIT'; P291V31; (PROCEDURE WRITE); V1=B1212121212121212; V2=B2020202020202020; V3=B2030446722743250; (1.024 TO 1I.P.); V4=B175/8; (1000/1024 TO 1I,P.); V5=B1463 1463 1463 1463; (.8 TO 1I.P.); V6=B2400 0000 0000 0000; (10/8 TO 1I.P.); V7=Q0/3/3; (INITIAL SPACES/SIGN/EXP SIGN); V8=B0013573716200001; (FORMAT/DS/ZS/DPH/APM/;/C/NDP); V9=B0314631463146315; (.1); V10=B0024365605075341; (.01); V11=B0000150667056544; (.0001); V12=B0000000005274617; (.00000001); V13=B12; (10); V14=B144; (100); V15=B23420; (10000); V16=B575360400; (100000000); V20=Q12/11/1; (S/F/E); V25=B0000 0003 7777 7775; V26=B0000 0001 7777 7777; V29=B4323606713434452; V30=B4720000000000000; 101; PERM; 102; =V21; 103; =V22; DUP; =V31; JS12P295; ZERO; =V28; V21; ZERO; SHLD+24; REV; ZERO; SHLD+4; =C10; ZERO; SHLD+2; =I10; ZERO; SHLD+5; NEG; =C7; ZERO; SHLD+4; =C11; ZERO; SHLD+2; =M10; ZERO; SHLD+4; =M7; SHC+3; =I7; DUP; ZERO; REV; SHLDC7; BITS; NEG; NOT; =I11; BITS; =M11; V22; I13=+1; DUP; J5>=Z; NEGF; I13=-1; I10; J5#Z; SET2; JS100; 1; JS80; 70; M7; SHC-2; J95=Z; M14; I11; +; DUP; =M15; M13; REV; -; J7=Z; M13; NOT; J6#Z; SET5; SHA+43; M13; NOT; NEG; =M13; ZERO; NOT; =TR; J10; 6; ERASE; ZERO; J12; 7; SET4; =RC15; ZERO; NOT; NEG; SHC-2; M13; 8; SHC-1; DUP; J9>=Z; REV; V9M15; *; REV; 9; M+I15; DC15; J8C15NZ; ERASE; SHA-4; 10; +; 11; DUP; SHL-43; SET10; -; J113=Z; 12; ZERO; DUP; =TR; NOT; NEG; M13; SET4; =RC15; 13; SHC-1; DUP; J14>=Z; REV; V13M15; *D; CONT; REV; 14; M+I15; DC15; J13C15NZ; ERASE; *D; SHAD+4; REV; ERASE; DUP; =V0; JS90; =V23; =V24; I10; NEG; NOT; SHL-1; J15#Z; SETB20; M7; OR; =M7; 15; I11; M11; +; C11; -; ZERO; =RM15; I11; NOT; NEG; NOT; NEG; =M13; J18<=Z; M14; C11; -; NOT; NEG; DUP; J32=Z; ERASE; ZERO; J72; 17; DC13; SHL+1; J73C13Z; C0TOQ14; SET8; =RC12; 19; DUP; J21=Z; ZERO; J26; 31; ZERO; V23M11; DC11; SHAD-6; =V23M11; J25C11NZ; M-I11; SET8; =C11; 25; SHL+1; M7; SETB10; AND; J27#Z; SETB77; SHL+42; J26#; ERASE; ZERO; J26; 27; SETB77; SHL+42; J30#; M13; J96=Z; ERASE; ZERO; J26; 96; ERASE; M7; SHL-4; J98=Z; M+I15; J29; 30; M7; SHL-4; J26=Z; M15; J26=Z; ERASE; ERASE; SET5; J74; 28; ERASE; M15; DUP; =+C10; NEG; =+C7; I10; J35=Z; I13; J34=Z; SETB13; =M13; J77<=Z; 68; M10; J75=Z; V0; J64=Z; C0TOQ13; M14; DUP; J37>=Z; NEG; DC13; 37; JS90; NOT; J78#Z; ZERO; REV; SHAD-12; NOT; J79#Z; ZERO; SHLD+7; JS40; SETB12; JS14P295; SETB77; J51=; C13; J38=Z; SETB230; JS14P295; 57; I7; SHL-2; J63#Z; I7; =C7; J60C7Z; 59; SET2; JS18P295; DC7; J59C7NZ; 60; M7; SHC-2; J62>=Z; V27; DUP; =C14; J62=Z; SETB216; JS14P295; 43; I10; J44=Z; SHA-27; REV; 92; REV; EXIT1; 100; =V28; EXIT1; 'ALGOL'; 'integer' 'procedure' format(lay out); 'string' lay out; 'KDF9' 12/9/14/6; (format); V2=B0013573703034671; V5=B4321221604215035; V6=B4720000000000000; {lay out}; DUP; =V1; =RM14; SET2; SHC-8; =V0; Q0TOQ15; SET24; DUP; =C12; SHA-1; =C11; Q0TOQ13; IM0TOQ12; IM0TOQ11; Q12TOQ10; Q0TOQ9; ZERO; JS27; SETB215; J32#; ERASE; J2; 1; REV; DUP; SHA+2; +; SHA+1; +; 2; JS27; DUP; SET10; -; J112); DC11; 12; PERM; DUP; PERM; OR; REV; CAB; (insert digit in field lay out); 13; ERASE; SHL+1; DC12; J32C12Z; (EFC>24); I10; J4#Z; (DPM); DC10; J4C10NZ; (NDP); J32; 14; (+-#); SHC-4; DUP; SHL+46; REV; SHL-44; ROUND; (1=+, 2=-, 3=#); I12; J15#Z; (EXM); C12; SET24; -; J31#Z; (SFC=0); I11; J31#Z; (first sign); =I11; J4; 15; (EXP SIGN); SET3; C12; -; J31#Z; M11; J31#Z; = M11; J4; 16; I10; J31#Z; (DPM); ERASE; I10=+1; J4; 17; (zero); J12C9NZ; C11; SET12; -; J31=Z; DC9; J12; 18; (subten); I12; J31#Z; I10; J31=Z; I12=+1; ERASE; OR; DUP; =V4; SHLC10; SHL+24; BITS; NEG; NOT; J34#Z; SET3; =C12; J3; 19; (;); I9; J31#Z; I9=+1; DC9; ERASE; J4; 20; (c); M10; SHL-2; J31#Z; DC9; ZERO; NOT; NEG; =+M10; ERASE; J4; 21; (p); M10; J31#Z; DC9; SET4; =M10; ERASE; J4; 22; SETB70; (s); J24#; ERASE; ERASE; 23; NOT; NEG; DUP; DUP; SHL-4; J4=Z; NEG; NOT; =V3; DC15; ZERO; DUP; NOT; NEG; CAB; J13; 24; PERM; ERASE; 25; =V3; DC15; ZERO; DUP; NOT; NEG; CAB; J5; 26; REV; DUP; J25=Z; J32; 39; ERASE; 27; ZERO; V0; 28; ZERO; SHLD+8; PERM; OR; DUP; J29=Z; =V0; SETB236; J39=; SETB240; J39=; SETB256; J39=; EXIT1; 29; ERASE; M0M14Q; J28; 30; ERASE; 31; ERASE; 32; ERASE; 33; ERASE; 34; V0P299; JS12P295; SETAV5; =RM14; 35; JS1P295; SETB235; J36=; JS14P295; J35; 36; ERASE; V1; =RM14; 37; JS1P295; SETB235; J38=; JS14P295; J37; 38; JS16P295; V2; J9; 'ALGOL'; 'procedure' output(device,value); 'value' device,value; 'real' value; 'integer' device; 'KDF9' 12/9/14/0; {value}; V0; {device}; JSP291; 'EXIT'; V0=B0013573703034651; 'ALGOL'; 'procedure' write boolean(device,boolean); 'value' device,boolean; 'integer' device; 'boolean' boolean; 'KDF9' 12/9/14/0; {boolean}; {device}; (write boolean); JS12P295; J2