github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-09 20:18:23 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/unscsp/aid/interp.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

7823 lines
172 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE INTERP V.012 MARFEB-79
SUBTTL JOSS INTERPRETER
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1970,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
HISEG
;VARIOUSLY USED 8 BIT AND 7 BIT ASCII CODE
EOC1=100; SIXTEEN END-OF-CELL INDICATORS
EOC2=117;
EOB=136; END OF DISC-BUFFER INDICATOR
EOS=165; END-OF-STRING INDICATOR
EOSII=0; ASCII END-OF-STRING
SP=170; SINGLE SPACE
SPS=177; EIGHT SPACES
TAB=152; LOWER CASE TAB
UTAB=147; UPPER CASE TAB
PG=150; PAGE
PGII=14; ASCII PAGE
IF1=245; "IF"
IF2=257; "IF" ASSUMED TO DELIMIT CONDITIONAL CLAUSE
DOT=160; .
PERIOD=166; DOT AT END OF SENTENCE
QMARK=164; ?
COMMA=161; ,
COMMA2=167; COMMAS THAT DELIMIT ITEMS IN A "TYPE" LIST
STAR=144; *
QUOTE=154; "
CG=151; CARRIAGE RETURN
CGII=15; ASCII CG
WORD=177; CODES FOR RECOGNIZABLE WORDS START AT 200
UNDER=155; UNDERSCORE
MINUS=141; -
COLON=163; :
LEFT=120; (
RIGHT=121; )
LEFTB=122; [
RIGHTB=123; ]
ALPHA=125; USED TO TYPE VALUES OF CONDITIONAL EXPRESSIONS.
OMEGA1=126;
OMEGA2=127;
EQUALS=130; =
BAD=156; ILLEGAL BYTE CLASS
BADII=26; ASCII INDICATOR FOR BAD BYTES
BSIZE=246; "SIZE"
BTIME=247; "TIME"
BUSERS=250; "USERS"
BFORM=235; "FORM"
BFIRST=267; "FIRST"
DO.=261; PARENTHETICAL "DO"
CANCEL.=262; PARENTHETICAL "CANCEL"
CS=77; INDICATES NEXT BYTE IS CODE FOR COMMENTARY STRING
SPARSE=20; FLAG BIT FOR SPARSE ARRAYS.
EXTERNAL SK1,SK2,SK3,SK4,SK5,SK6
EXTERNAL SK7,SK8,SK9,SK10,SK11,PK1
EXTERNAL PK2,PK3,PK4,PK5,PK6,PK7
EXTERNAL PK8,PK9,PK10,PK11,PK12,PK13
EXTERNAL PK14,PK15,PK16,PK17,PK18,PK19
EXTERNAL PK20,PK21,PK22,PK23,PK24,PK25
EXTERNAL PK26,PK27,PK28,PK29,PK30,PK31
EXTERNAL PK32,PK33,PK34,PK35,PK36,PK37
EXTERNAL PK38,PK39,PK40,T48,T49,T49X,JWSPDL
EXTERNAL SPARE,VEND
DEFINE U(P);
<
EXTERNAL P;>
U(INTENT);
USER0=INTENT ;***FIRST LOC OF USER AREA
U(JOBNO);
U(SPARE4);
U(RISIG)
U(UBUF);
U(ME);
U(RETURN);
U(WIDTH)
U(SIZE)
U(SPACE);
U(LINE);
U(USIZE);
U(UTIME);
U(UUSERS);
U(UMIN);
U(UMIN1);
U(USEC);
U(UCR);
U(UA1);
U(UA);
U(UB1);
U(UB);
U(UACL);
U(UDS);
U(UPS);
U(UCP);
U(UCC);
U(U0)
U(U1);
U(U2);
U(U3);
U(U4);
U(U5);
U(U6);
U(U7);
U(U8);
U(FPDL);
U(LEVEL)
U(US0);
U(US1);
U(US2);
U(US3);
U(US4);
U(US5);
U(US6);
U(US7);
U(UP0);
U(UP1);
U(UP2);
U(UP3);
U(UP4);
U(UP5);
U(UP6);
U(UP7);
U(UP8);
U(UP9);
U(UP10);
U(UP11);
U(UP12);
U(UX1);
U(UX2);
U(UX3);
U(UX4);
U(TRUE);
U(FALSE);
U(PARTS);
U(FORMS);
U(MODE);
U(BASE)
U(JPDL);
U(JD);
U(U24);
U(U25);
U(CPI);
U(CSI);
U(CSA);
U(UDF1);
U(UDF2);
U(UBFR);
U(UFILE);
U(UKEY);
U(UNAME);
U(UITEM);
U(V);
SYN RISIG,RIF;
SUBTTL FIELD LENGTHS AND MASKS
INDEX=11; FIELD LENGTH OF PACKED ARRAY INDICES
XP=11; DITTO FOR XP OF ARRAY ELEMENTS
IDN=^D8; FIELD LENGTH FOR IDENTIFIER BYTE
IDM=1777; AND MASK FRO SAME -- IN DESCRIPTORS
IDMC=776000;
SUBTTL HIGH SPEED REGISTER ASSIGNEMENT
CR=0; STACK POINTER FOR PDP-6 STACKING INSTRUCTIONS
; THE "A" AND "B" BANKS ARE USED VARIOUSLY. IN PARTICULAR
; THEY CONTAIN FIRST AND SECOND ARGUMENTS RESP. ON ENTRANCE
; TO ARITHMETIC AND FUNCTION SUB-ROUTINES. RESULTS ALWAYS IN
; THE "A" BANK. "B" BANK GARBAGED EXCEPT FOR COMPARISONS.
A1=1; PACKED SIGN AND IP OF ARGUMENT; IP OF RESULT
A=2; SIGN OF RESULT
A2=3; XP OF ARGUMENT AND RESULT (TWO-COMPLEMENT REP.)
B1=4;
B=5;
B2=6;
ACL=7; ADDRESS OF FIRST CELL ON AVAILABLE-CELL-LIST
DS=10; ADDRESS OF FIRST CELL ON DESCRIPTOR PDL
PS=11; ADDRESS OF FIRST CELL(SECOND ITEM) ON PROCESSOR PDL
CP=16; TOP ITEM OF PROCESSOR PDL
CC=17; EITHER CURRENT BYTE OR CURRENT TERMINAL DESCRIPTOR
SUBTTL; SYNONYMS
OPDEF J[JRST ];
OPDEF JE[JUMPE ];
OPDEF JN[JUMPN ];
OPDEF JL[JUMPL ];
OPDEF JLE[JUMPLE ];
OPDEF JG[JUMPG ];
OPDEF JGE[JUMPGE ];
OPDEF SN[SKIPN ];
OPDEF CE[CAME ];
OPDEF CN[CAMN ];
OPDEF CL[CAML ];
OPDEF CLE[CAMLE ];
OPDEF CGE[CAMGE ];
OPDEF F[MOVE ];
OPDEF FI[MOVEI ];
OPDEF M[MOVEM ];
OPDEF XCH[EXCH ];
OPDEF XEC[XCT ];
OPDEF L[HLL ];
OPDEF PJ[PUSHJ CR,];
OPDEF INVOKE[JSP B,];
OPDEF RTN[J 0,(B)];
OPDEF SKRTN[J 0,1(B)];
SUBTTL MACROS FOR TESTING OF MIXED ARITH.
DEFINE TVJNF;
<
PJ SIN2; >
DEFINE JNFTVB;
<
PJ SIN3; >
DEFINE JNFTV;
<
PJ SIN1; >
DEFINE TVSET;
<
PJ SIN4; >
SYN TVSET,TVDICT;
DEFINE TVTEXT;
<
PJ SIN5; >
SUBTTL LIST PROCESSING MACROS
DEFINE M52(S,P); POP S TO P
<
AOS SIZE;
F P,(S);
XCH ACL,1(S);
XCH ACL,S
>
DEFINE M53A(P,S); PUSH P ONT S
<
SOS SIZE;
M P,(ACL);
XCH S,1(ACL);
XCH ACL,S;
>
DEFINE M53(P,S,E); M53A TO E IF OUTSIZE
<
SOSG SIZE;
PJ E;
M P,(ACL);
XCH S,1(ACL);
XCH ACL,S;
>
DEFINE M54(P); RELEASE CELL
<
AOS SIZE;
M ACL,1(P);
F ACL,P;
>
DEFINE M55A(P1,P2); P1,P2 TO CELL; ADD. TO P2
<
SOS SIZE;
M P1,(ACL);
XCH P2,1(ACL);
XCH ACL,P2;
>
DEFINE M55(P1,P2,E); M55A TO E IF OUTSIZE
<
SOSG SIZE;
PJ E;
M P1,(ACL);
XCH P2,1(ACL);
XCH ACL,P2;
>
PAGE
DEFINE M56(P1,P2,E); M55 FOR P1,P2 = JNF
<
HRLZ P2,P2;
M55 P1,P2,E;
>
DEFINE M57A(P,Q); INSRT ARRAY CELL AT P,ADDRESS TO Q
<
SOS SIZE;
HRR Q,1(P);
HRRM ACL,1(P);
XCH Q,1(ACL);
XCH ACL,Q;
>
DEFINE M58(OP);
<
INVOKE P53;
TVJNF;
OP ;
J SP1.1;
>
DEFINE M59(P,Q,E);
<
SOSG SIZE;
PJ E;
F Q,ACL;
HRRM Q,(P);
F ACL,1(ACL);
SETZM 1(Q);
>
DEFINE M60(P); UNPACK EXPONENT
<
HLRZ P,P;
AND P,MASK2;
CAML P,MASK9;
ORCM P,MASK2;
>
DEFINE M61(OP,P,Q,R);
<
SOS SIZE;
XCH R,ACL;
OP R,1(P);
MOVEM Q,(R);
XCH ACL,1(R); >
PAGE
DEFINE M59A(P,Q); APPEND ARRAY CELL TO HEADER AT P
<
SOS SIZE;
F Q,ACL;
HRRM Q,(P);
F ACL,1(ACL);
SETZM 1(Q);
>
SUBTTL MACROS FOR ARITHMETIC AND FUNCTIONS
DEFINE CALL(P);
< EXTERN P;
JSR P; >
DEFINE JADD;
< CALL P75; >
DEFINE JSUB;
< CALL P76; >
DEFINE JMPY;
< CALL P77; >
DEFINE JDIV(E);
< CALL P78;
PJ E;>
DEFINE JPWR(E1,E2,E3);
< CALL P79;
PJ E1;
PJ E2;
PJ E3;>
DEFINE JSQRT(E);
<
CALL P80;
PJ E;>
DEFINE JEXP(E);
<
CALL P81;
PJ E;>
DEFINE JLOG(E);
<
CALL P82;
PJ E;>
DEFINE JSIN(E);
<
CALL P83;
PJ E;>
DEFINE JCOS(E);
<
CALL P84;
PJ E;>
DEFINE JARG;
<
CALL P85;>
DEFINE JIP;
< CALL P90; >
DEFINE JFP;
< CALL P91; >
DEFINE JDP;
<
CALL P92;>
DEFINE JXP;
<
CALL P93;>
DEFINE JSGN;
< CALL P94; >
SUBTTL CENTRAL-PROCESSOR/SUPERVISOR INTERFACE
EXTERN S62,S61,ERR
INTERNAL ERRX,S61X,S62X
EXTERN MONENT,COMEBACK,CT14;
INTERN JOSS,INTBEG;
BUFAD=4;
EXTERN USERS,HR,MIN,SECONDS;
EXTERN ACTION,RESULT,FILE,KEY,NAME,PROG;
EXTERN TYPE,FLAG,BFR,BFRP;
EXTERN RPN,KILL;
X43: HRRI A,X44; AFTER LOG-ON RITUAL.
HRRZM A,ME;
HRRZM A,INTENT;
SETZM RETURN;
X44: HRRZ CC,RETURN; ALL OTHER ENTRIES.
FI CR,JWSPDL;
JE CC,X44.1;
CAIG CC,X44;
PJ KILL; ABORT USER IF BAD ADDRESS
CAIL CC,DT50;
PJ KILL;
J (CC);
X44.1: HLRZ CC,ME;
CAILE CC,3;
PJ KILL;
J .+1(CC);
J X43X; AFTER LOG-ON
J X45; AWAITING COMMAND
J X45; AWAITING DEMAND
J X45; AWAITING FORM
PAGE
INTBEG: JRST X43;
JOSS: JRST X44;
SU: SETZB A1,MODE; SWITCH TO USER
SETZM RIF; TURN OFF IN-REQU FLAG
JRST MONENT;
XMIT: MOVEI A1,3; SEND LINE IN BUFFER TO USER
MOVE BUFAD,UBUF;
JRST MONENT;
PAGE: FI A1,13; PAGE SIGNAL AND HEADING TO USER
MOVE BUFAD,UBUF; HEADING ONLY IF UBUF<0!
JRST MONENT;
REQBUF: FI A1,1; REQUEST BUFFER; RETURN WITH ADD IN BUFAD
JRST MONENT;
RETBUF: FI A1,2; RETURN BUFFER TO SUPERVISOR
MOVE BUFAD,UBUF;
JRST MONENT;
REQCOR: FI A1,11; REQUEST ANOTHER CORE BLOCK
JRST MONENT; RETURNS WITH A1=0 IF REQUEST DENIED.
DEMCOR: FI A1,12; DEMAND ANOTHER CORE BLOCK
JRST MONENT;
RETCOR: FI BUFAD,1; RETURN CORE BLOCKS (NR IN BUFAD).
FI A1,15;
JRST MONENT;
PAGE
DISKA: SKIPN RIF; REQUEST THE DISK. IN SIGNAL?
J DISKA2; NO
DISKA1: JSR S62; RESTORE CONSOLE
J X47.0; GO TO HONOR IN SIGNAL
DISKA2: HRLZ A1,RETURN;
HRRI A1,DISKA3; RETURN BELOW
M A1,RETURN; AFTER
FI A1,6; REQUESTING DISK SERVICE.
J MONENT;
DISKA3: HLRZ A1,RETURN;
M A1,RETURN; RESTORE ORIGINAL RETURN ADDRESS.
SKIPN RIF; IN SIGNAL?
J X44;
SKIPN SPARE4; SOK TO HONOR IT?
J DISKA1; YES
JRST X44; NO; STILL USING DISC.
DISKB: HRLI A,1; BEGIN DISK ACTION.
J DISKC+1;
DISKC: HRRZ A,A; CONTINUE DISK ACTION.
M A,ACTION;
HRRZM A,UDF1;
F A,UFILE;
M A,FILE;
F A,JOBNO;
M A,RPN;
F A,UKEY;
M A,KEY;
F A,UNAME;
M A,NAME;
F A,UITEM;
M A,PROG;
FI A1,7;
J MONENT;
DISKD: FI A1,10 ;DONE WITH DISK.
J MONENT;
SUBTTL ERROR PROCESSOR
DEFINE E(X);
<
HRLI CR,X-1;
J ERR1;
>
; DO NOT GIVE THIS COMMAND DIRECTLY.
E1: E CS32;
; DO NOT GIVE THIS COMMAND INDIRECTLY
E2: E CS33;
; RUN OUT OF SPACE
E3: AOS SIZE;
E3A: JSR S61; SAVE CONSOLE
FI B,E3A.0;
M B,RETURN;
J REQCOR; REQUEST CORE
E3A.0: M A1,UA1;
JSR S62; RESTORE CONSOLE
JN A1,E3C; HAVE CORE.
SETZM U2; NO CORE.
SKIPGE MODE;
MOVNS MODE;
SETZM US7;
SKIPN UDF1; DISK?
J E3A.3; NO
JSP B,X46; YES; RELEASE DISK
XWD .+1,DISKD;
SETZM UDF1;
JSR S62; RESTORE CONSOLE
HRLI CC,41000;
HRRI CC,CS4-1;
M CC,US5; AND GENERATE APPROPRIATE MSG.
J E3A.4;
E3A.3: F CC,MODE;
HRLI CR,ES1-1; ASSUME NOT DURING
SKIPE CC;
HRLI CR,ES2-1; DURING
JSR ERR; POINT-OF-ERROR
J E3A.2; ABOVE
PJ E54; A MESS.
F CC,MODE;
CAIGE CC,2; DURING?
J E3A.1; NO
PAGE
E3A.4: JSP B,X48;
XWD 41000,ES3-1; I'VE RUN OUT OF SPACE
XWD 41000,ES3.1-1;
XWD 0,US5; DURING .........
BYTE (8)277,DOT,CG,EOS;
DEC -1;
SETZM MODE;
J X52;
E3A.1: FI CC,ES4-1; ASSUME IN FORMULA
SKIPN US7;
E3A.2: FI CC,ES5-1; NOPE
HRLI CC,41000;
M CC,US5;
JSP B,X48;
XWD 0,US6;
BYTE (8)277,DOT,SP,EOS;
XWD 41000,ES6-1;
XWD 41000,ES3.1-1;
XWD 0,US5;
BYTE (8)277,DOT,CG,EOS;
DEC -1;
SETZM MODE;
J X52;
ES1: BYTE (8)33,50,71,62,56,50,47,EOS;
ES2: BYTE (8)CS,5,SP,CS,11,EOS;
ES3: BYTE (8)22,153,71,50,SP,65,70,61,EOS;
ES3.1: BYTE (8)SP,62,70,67,SP,62,51,SP;
ES3.2: BYTE (8)66,63,44,46,50,EOS;
ES4: BYTE (8)SP,120,CS,30,CS,31,121,EOS;
ES5: BYTE (8)EOS,
ES6: BYTE (8)22,SP,65,44,61,EOS;
E3B: JSP B,X48;
XWD 41000,ES3-1;
XWD 41000,ES3.1-1;
BYTE (8)277,DOT,CG,EOS;
DEC -1;
SETZM MODE;
J X52;
PAGE
E3C: F B,U2;
M B,U1; SAVE DEMAND RESPONSE FLAG
PJ S60; CLEAR CONSOLE
F B,SPACE; ADD NEW 1K BLOCK
ADD B,K36; TO TOP OF ACL
HRRZM ACL,-1(B);
AOS SIZE;
SUBI B,2;
CAMN B,SPACE;
J .+3;
HRRZM B,-1(B);
J .-5;
F ACL,B;
ADD B,K36;
M B,SPACE;
M ACL,UACL;
F B,U1; RESTORE DEMAND RESPONSE FLAG
M B,U2;
JL B,V13.3; OUT IFFON DEMAND RESP.
SKIPE UDF1; DISK?
J E3C.1; YES
SKIPN MODE; NO; DIRECT MODE?
J E3C.1; YES
LDB CC,BYTE8; NO; WHERE ARE WE?
JE CC,X53.1; AT ...
J X56.2; DURING ...
E3C.1: F A1,US0; AT LAST BYTE OF INPUT IMAGE
FI CC,CGII;
DPB CC,A1; MAKE SURE IT IS A CG
SETZM UP0;
F A,WIDTH;
CAIN A,110;
SETOM UP0; NOTE TTY OR JOSS CONSOLE
J D60X;
E4: PJ P69;
E5: HRLI CR,CS51-1;
J ERR0;
E6: M A,PK8;
SETZM T48;
INVOKE P51;
E6X: HLRZ CC,CC;
JE CC,E5;
CAMN CC,TYPE12;
J E5;
E10: F CC,PK8;
F A,US1;
PJ S70G;
PAGE
E10.1: JSR ERR;
J E10.3;
PJ E54;
SKIPE UDF1;
PJ E54;
JSP B,X48;
XWD 41000,CS1-1;
XWD 0,US5;
BYTE (8)277,COLON,EOS;
OCT 0;
BYTE (8)277,SP+1,EOS;
E10.2: XWD 0,US1;
OCT 0;
XWD 0,K23;
BYTE (8)277,QMARK,QMARK,QMARK,CG,EOS;
DEC -1;
J ERR5;
E10.3: FI B,E10.2;
J X48;
PAGE
E7: PJ P69;
J E3;
E8: E CS53;
E9: E CS40;
SYN E5,E11;
SYN E5,E12;
SYN E5,E13;
E14: E CS21;
E15: E CS22;
E16: E CS27;
E17: E CS28;
E18: E CS25;
E19: E CS26;
E20: E CS45;
SYN E20,E21;
SYN E5,E22;
E23: E CS47;
E24: E CS50;
PAGE
E25: LDB A2,BYTE6;
HRLI CR,CS43-1;
CAIN A2,1;
HRLI CR,CS42-1;
J ERR1;
E26: E CS49;
E27: E CS41;
E28: E CS43;
E29: LDB A2,BYTE6;
HRLI CR,CS37-1;
CAIN A2,1;
HRLI CR,CS38-1;
J ERR1;
SYN E5,E30;
E31: HRRZ CC,PK36;
SUB CC,K22;
HRL CR,.+2(CC);
J ERR1;
XWD 0,CS51-1;
XWD 0,CS35-1;
XWD 0,CS34-1;
XWD 0,CS36-1;
E32: HRRZ CC,PK36;
SUB CC,K22;
HRL CR,.+2(CC);
J ERR1;
XWD 0,CS51-1;
XWD 0,CS42-1;
XWD 0,CS43-1;
XWD 0,CS41-1;
SYN E5,E33;
SYN E5,E34;
SYN E5,E35;
SYN E5,E36;
E37: E CS54;
SYN E5,E38;
PAGE
E39: E CS52;
E40: E CS30;
E41: E CS56;
E42: E CS29;
E43: E CS46;
E44: E CS57;
SYN E5,E45;
SYN E5,E46;
SYN E5,E47;
E48: F B,US1;
HLRZ B1,ME;
SOJG B1,.+3;
HRLI B,141000; POINT TO COMMAND PROPER
ADDI B,1; IF A COMMAND.
M B,US6;
SKIPE UDF1; FROM DISC?
J E54; YES
JSP B,X48;
XWD 0,US6;
BYTE (8)277,CG,EOS;
DEC -1;
E48X: JSP B,X48; SORRY. SAY AGAIN.
BYTE (8)277,34,62,65,65,74,DOT,SP;
BYTE (8)34,44,74,SP,44,52,44,54,61,COLON,CG,EOS;
DEC -1;
JSR S61;
SETZM RETURN;
SKIPL U2; DEMAND RESPONSE?
J SU; NO
J V13.1; YES; DO IT AGAIN.
E49: E CS59;
PAGE
E50: M52 PS,CP;
XCH CP,U1;
F A,US1;
FI CC,BFIRST;
IDPB CC,A;
LDB CC,U1;
IDPB CC,A;
PJ S50;
IDPB CC,A;
CAME CP,U1;
JRST .-3;
FI CC,EOS;
IDPB CC,A;
J E10.1;
E51: F B1,K44;
F A,US2; BAD FILE NR.
PJ S66;
FI CC,EOS;
IDPB CC,A;
E CS64;
E52: E CS62; BAD IDENTIFICATION KEY
E53: FI CC,CS60; NO SUCH FILE
E53A: SUBI CC,1;
M CC,US6;
PJ S60;
SKIPN UDF1; USING DISK?
J E53B; NO.
JSP B,X46; END DISK ACTIVITY
XWD .+1,DISKD;
JSR S62;
SETZM UDF1;
E53B: HRL CR,US6; SEND APPROPRIATE ERROR SCREED.
J ERR1;
E54: FI CC,CS69; OOPS - TRY AGAIN
J E53A;
E54A: FI CC,CS71; FLAMEOUT
J E53A;
PAGE
E55: F B1,K45; INADMISSIBLE ITEM NR
F A,US2; BAD ITEM NR.
PJ S66;
FI CC,EOS;
IDPB CC,A;
E CS65;
E56: E CS66; NO OPEN FILE
E57: FI CC,CS67; OUT OF DISK SPACE
J E53A;
E58: FI CC,CS61; NO SUCH ITEM
J E53A;
E59: FI CC,CS72; DELETE BEFORE WRITING
J E53A;
E60: E CS73;
SUBTTL GENERATE POINT-OF-ERROR MSG
; JSR ERR
ERRX: M CC,US3+1; PERIOD OR QHESTION MARK
HLRZ CC,CR;
HRLI CC,41000;
M CC,US6; SET UP POINTER TO ERROR SCREED
F CC,MODE;
JGE CC,.+2;
FI CC,1;
SKIPGE U2; DEMAND RESPONSE?
SETZB CC,MODE; YES; MODE IS DIRECT.
HRRZI CR,JWSPDL; REFRESH STACK
TRZ CC,777774; SWITCH MODULO 3
FI A,ERRA-1; TENTATIVE ERROR-POINT MSG
ADD A,CC;
HRLI A,41000;
M A,US5; TO US5
PJ S67X; ARE WE IN A FORMULA?
J ERR2(CC); NO
CAILE CC,1; DURING?
J ERR2(CC); YES
FI A,ERRE-1;
HRRM A,US5; ERROR ABOVE
JE CC,ERR3.1;
ERR1.1: FI A,ERRF-1; ERROR AT STEP
HRRM A,US5;
J ERR3;
ERR2: JRST @ERR; ABOVE
J ERR3; AT STEP
J ERR3.1; ABOVE
F A,JPDL; DURING STEP; FETCH ERROR POINT.
F A,1(A);
F A1,(A); PART INDEX
F A,1(A);
F A2,(A); STEP INDEX
J ERR3.1-1;
ERR3: F A1,CPI; PART INDEX
F A2,CSI; STEP INDEX
PJ S67Y; CONVERT TO JWS STRING IN US4
ERR3.1: HRRZ B,ERR;
J 2(B);
SUBTTL GENERATE AND SEND ERROR MSG TO USER
; LEFT HALF OF CR CONTAINS ADDRESS OF MSG.
ERR0: F CC,ERRD; QUERIES
SKIPA;
ERR1: F CC,ERRC; STATEMENTS
SKIPE UDF1; DURING DISC OPERATION?
J E54; YES
JSR ERR; POINT-OF-ERROR
J ERR6; ABOVE
PJ E54; A MESS.
ERR4: JSP B,X48; SEND TO USER
XWD 41000,CS1-1; ERROR
XWD 0,US5;
BYTE (8)277,COLON,EOS;
OCT 0; BREAK FOR DOUBLE LINES.
BYTE (8)277,SP+1,EOS;
XWD 0,US6;
XWD 0,US3;
DEC -1;
ERR5: SKIPL U2; DEMAND RESPONSE?
J ERR5A; NO
MOVEI CC,BFR
SKIPE BFR ;DEMAND AS TEXT?
HRRM CC,US2 ;YES,SO RESET POINTER
J V13.1; YES; DO IT AGAIN.
ERR5A: SETZM MODE;
JRST X52;
ERR6: JSP B,X48;
XWD 0,US6;
XWD 0,US3;
DEC -1;
J ERR5;
ERRA: BYTE (8)EOS,
BYTE (8)CS,2,EOS;
BYTE (8)CS,3,EOS;
BYTE (8)CS,4,EOS;
ERRB: BYTE (8)CS,12,CS,13,EOS;
ERRC: BYTE (8)DOT,CG,EOS;
ERRD: BYTE (8)QMARK,CG,EOS;
ERRE: BYTE (8)SP,CS,30,CS,31,EOS;
ERRF: BYTE (8)CS,2,SP,120,CS,30,CS,31,121,EOS;
SUBTTL X43X - AFTER LOG-ON RITUAL
;
X43X: F A,K36; BLOCK LENGTH
ADDI A,INTENT;
M A,SPACE;
SUBI A,1; CLEAR INITIAL BLOCK
X43X.0: SETZM (A);
CAIE A,LINE;
SOJA A,X43X.0;
JSR S62; RESTORE CLEARED CONSOLE
PJ S69Y; SET SIZE AND LINK ACL
MOVEI A,1;
MOVEM A,TRUE(A);
MOVEM A,FALSE(A);
F A,K15; JNF UNITY
M A,TRUE;
SETOM PARTS;
SETOM FORMS;
HRLI A,41000;
HRRI A,US1;
M A,US1;
HRRI A,US2;
M A,US2;
HRRI A,US3;
M A,US3;
HRRI A,US4;
M A,US4;
HRLZI A,172006;
FI A1,146;
X43X.2: M A,V(A1); ASSIGNMENT TABLE
SUB A,X43X.4;
SUBI A1,2;
JGE A1,X43X.2;
JSR S62;
F A,SECONDS;
M A,USEC;
PJ S69X; SET TIME,SIZE; ETC
JSP B,X48; PAGE
OCT 0;
SETZM RETURN;
MOVEI A,1; STATE=1 (AWAITING COMMAND)
HRLM A,ME;
JRST SU; SWITCH TO USER
X43X.4: XWD 2000,0;
SUBTTL X45 COMMAND, FORM; DEMAND RESPONSE
X45: HRRZ A,BUFAD;
MOVEM A,UBUF;
MOVEM A,UA;
JSR S62;
SETZM UP0; ASSUME NO TTY
MOVE A1,2(A);
TLNE A1,400000; TTY?
SETOM UP0; YES
FI A1,117; SET LINE LENGTH ACCORDING TO SIGNAL.
SKIPE UP0;
FI A1,110;
M A1,WIDTH; SET PAGE WIDTH
MOVE A1,1(A);
ADDI A,2;
HRLI A,10700;
MOVE B,US1;
SETOM UDF2; FLAG TO INDICATE FORM
HLRZ B1,ME;
CAIN B1,2; IS IT?
J X45.1; YES
SETZM UDF2; CORRECT FLAG
SOJG B1,X45.1; INTRODUCTORY BYTES FOR COMMANDS
HRLI B,141000;
ADDI B,1; TO 4TH BYTE (BEG. OF INPUT LINE)
SETZM (B);
X45.1: PJ S52; CONVERT TO 8-BIT ENCODING
F A,UBUF;
ADDI A,2;
HRLI A,10700;
ILDB A2,A; LOOK AT FIRST BYTE OF BUFFER.
FI A,X45.3; ASSUME LINE IS OK
CAIN A2,25; IS IT?
FI A,X45.2; TOO LONG
M A,RETURN;
SKIPL LINE; ARE WE PAGING?
JRST RETBUF; NO
F CC,K27; YES; RESET LINE CTR.
M CC,LINE;
LDB CC,A1; CAUSED BY PAGE-BUTTON?
CAIN CC,PGII;
HRROS UBUF; YES; SET MARK TO SEND PAGE HEAD ONLY
JRST PAGE;
PAGE
X45.2: JSR S62; RESTORE CONSOLE
SKIPE UDF1; FROM THE DISC?
J E54; YES
JSP B,X48 ;NO COMMENT ON LONG LINE.
BYTE (8)277,CS,25,EOS;
BYTE (8)277,57,54,61,50,66,SP,67,EOS;
BYTE (8)277,62,SP,7,8,SP,66,67;
BYTE (8)65,62,56,50,66,DOT,SP,EOS;
BYTE (8)277,34,44,74,SP,44,52,44;
BYTE (8)54,61,COLON,CG,EOS;
DEC -1;
JSR S61;
SETZM RETURN;
HLRZ A1,ME; WORKING ON DEMAND?
CAIE A1,3;
J SU; NO
J V13.1; YES; DO IT AGAIN.
X45.3: JSR S62; RESTORE CONSOLE
HLRZ B1,ME;
SOJE B1,X50; COMMAND
SOJE B1,V14X; FORM
JRST V13X; DEMAND
SUBTTL X46 -- SWITCH TO DISC ACTIVITIES
X46: HLL B,(B);
HLRZM B,RETURN;
HRRZ B,(B);
J (B);
SUBTTL X47 -- ACKNOWLEDGE IN-REQU. AND RECALL
X47: SKIPN RIF;
J X47.2; NO IN SIGNAL
SKIPE UDF1; IN DISK MODE?
J 1(B); YES; IGNORE IN SIGNAL.
X47.0: SETZM RIF; TURN OFF IN SIGNAL BEFORE RESPONDING.
SKIPE MODE;
J X47.1;
JSP B,X48;
BYTE (8)277,CS,7,PERIOD,CG,EOS;
DEC -1;
J X52;
X47.1: F A1,CPI;
F A2,CSI;
PJ S67Y; GENERATE POINT-OF-INTERRUPT MSG.
JSP B,X48;
BYTE (8)277,CS,5,SP,EOS;
XWD 0,US4;
BYTE (8)277,PERIOD,CG,EOS;
DEC -1;
SETZM MODE;
J X52;
X47.2: SKIPN COMEBACK;
JRST 1(B);
JSR S61;
HRL B,(B);
HRRI B,X47X; SET RE-ENTRY POINT
MOVEM B,RETURN;
SETZM COMEBACK;
MOVEI A1,5;
JRST MONENT;
X47X: JSR S62; RESTORE CONSOLE
J X47; TEST FOR IN SIGNAL
SUBTTL X48/X49 -- XMIT LINE TO USER
; JSP B,X48
; S55X CALLING SEQUENCE (ZERO IF PAGING ONLY)
;
X48: JSR S61; SAVE CONSOLE
SKIPE UDF1; IN DISK MODE?
J D50; YES
MOVE B1,(B); ARE WE PAGING ONLY?
JUMPN B1,X48.2; NO
X48.1: SETOM LINE; YES; NOTE THE FACT.
X48.2: MOVEI B1,X49;
MOVEM B1,RETURN;
JRST REQBUF; REQUEST BUFFER
; RETURN WITH BUFFER ADDRESS
X49: HRRZ B2,BUFAD;
MOVEM B2,UBUF;
ADDI B2,2;
HRLI B2,10700; BUFFER POINTER
FI CR,JWSPDL; RESET CONSOLE
F B,UB;
SKIPL LINE; ARE WE PAGING ONLY?
JRST X49.3; NO
X49.1: MOVEI B1,X49.2; YES; DO SO.
MOVEM B1,RETURN
JRST PAGE;
X49.2: MOVE B1,K27;
MOVEM B1,LINE; RESET LINE COUNTER
J X49.5; TIDY UP.
X49.3: PUSHJ CR,S55X; CONVERT TO ASCII IN BUFFER
MOVEM B,UB;
AOS LINE; INC. LINE COUNTER
MOVEI CC,X49.4;
MOVE B1,(B); END OF TYPE-OUT?
CAME B1,K20;
MOVEI CC,X48.2; NO,SET UP TO CONTINUE
MOVEM CC,RETURN
JRST XMIT; SEND BUFFER TO USER
X49.4: MOVE A,LINE;
CAMLE A,K28; IS PAGING REQUIRED NOW?
J X48.1; YES.
X49.5: JSR S62; DONE; RESTORE CONSOLE
SETZM RETURN
JRST 1(B);
SUBTTL X50 -- PRE-PROCESS COMMANDS FROM CONSOLE, DISC
; ASSUMES S52 HAS BEEN INVOKED
X50: SKIPN UP1; IS THIS A DEAD LINE?
J V0; YES
SKIPE UP3; TRANSMISSION ERROR?
PJ E48; YES
MOVE A,UP2;
LDB CC,A; LOOK AT LAST
MOVEI B1,PERIOD; NON-BLANK BYTE.
CAIE CC,DOT ;IS IT A DOT
J .+2; NO
DPB B1,A; DOT BECOMES PERIOD
MOVEI B1,EOS; AND EOS IS ALWAYS APPENDED.
IDPB B1,A;
MOVE B1,US1;
HRLI B1,141000;
ADDI B1,1; TO 4TH BYTE
MOVEM B1,SK8;
MOVEM B1,U1; POINTS TO COMMAND
PUSHJ CR,S54; COMPRESS THE LINE (B1 = BYTE COUNT)
MOVE B2,SK3; IS THERE A CONDITIONAL CLAUSE?
JE B2,X50.1; NO
ADDI B2,3;
DPB B2,SK8; DEPOSIT INDEX OF CONDITIONAL
MOVEI B2,IF2; REPLACE 'IF' BY SPECIAL BYTE
IDPB B2,SK1;
X50.1: MOVE B1,SK8;
MOVEM B1,U1; POINTS TO COMMAND
INVOKE P51; FETCH FIRST TERMINAL CHARACTER
HLRZ B2,CC;
CE B2,TYPE12; IS IT A LITERAL JBF?
JRST X50.6; NO; ASSUME DIRECT COMMAND.
MOVE A1,(CC); NOW FETCH JNF STEP NUMBER
MOVE A2,1(CC);
INVOKE P51; NEXT CHARACTER.
CE CC,T51.31; SKIP OVER TABS
J .+5;
INVOKE P51;
CN CC,T51.31;
J .-2;
SETO B1,0;
CE CC,T51.9; IF?
J .+3; NO
FI CC,277;
DPB CC,SK8; IMPAIRED.
CN CC,T51.8; PERIOD?
J .+4; YES
JN B1,.+3; LEADING SPACES? - YES
CE CC,T51.5; EOS?
PJ E5; NO; EH
JGE A1,X50.0; YES; CHECK STEP NR.
PJ E26; TOO LARGE
PAGE
X50.0: CALL S78; CONVERT TO IP AND FP
PJ E28; BAD STEP NUMBER
X50.5: PJ P51X; REMOVE STEP NUMBER FROM LINE IMAGE.
PJ P51Y; ENUF SPACE?
MOVE A2,A1; YES; PREPARE FOR
MOVE B2,A; STEP SEARCH
HRRZI A1,PARTS;
PUSHJ CR,P70L; LOOK FOR PART
JRST X50.2; NONE SUCH
MOVE A2,B2;
MOVE A1,A;
PUSHJ CR,P70R; LOOK FOR STEP
JRST X50.3; NONE SUCH
HLRZ B,1(A); GET LINK TO STRING
PUSHJ CR,P62; AND DELETE
JRST X50.4;
X50.2: M61 HRLM,A1,A2,A ;INSERT PART HEADER
HRLZS 1(A); ADJUST THINGS
HRRZ A1,A;
SETZ A,0;
X50.3: M61 HRRM,A1,B2,A ;INSERT STEP HEADER
X50.4: HRLM ACL,1(A);
MOVE A,ACL;
MOVE A1,US1;
MOVEM A1,U1;
PUSHJ CR,S56; MOVE STRING TO USER BLOCK
HRRZ ACL,1(A); FIX ACL AND
HLLZS 1(A); LAST CELL
J V0;
PAGE
X50.6: MOVE A1,US1;
M A1,U0; SAVE POINTER
F A2,SK8; TO BEGINNING OF COMMAND
CE CC,T51.31; IGNORE LEADING TABS.
J .+4;
F A2,U1;
INVOKE P51;
J .-4;
SETZM U6; TURN OFF TYPING FLAG
PUSH CR,A2;
PJ S69X; SET SIZE,TIME AND USERS
POP CR,A2;
HLRZ B2,CC; RESTORE CHARACTER TYPE/CLASS
CAMN B2,TYPE12; LITERAL?
PJ E5; YES
CN CC,T51.15; IS IT A FORM DECLARATION?
J V14; YES
CN CC,T51.9; IF?
PJ E5; YES
LDB A1,UP2; LOOK AT LAST BYTE
JN B2,X50.7; DO WE START WITH A LETTER?
F B2,SK3; YES; ASSUME SHORT-SET.
JE B2,.+2; CONDITIONAL CLAUSE?
PJ E5; YES; EH.
M A2,U1; TO BEGINNING.
F CC,T51.5; EXPECTED ENDING IS EOS!
CAIN A1,PERIOD;
F CC,T51.8; IT IS A PERIOD!
M CC,U3;
SETZM U2; MESH WITH SET PROCESSOR
J V1;
X50.7: CAIE B2,2; IS IT A LEFT PAREN?
J X50.13; NO
F B2,T54(CC);
CE B2,T51(A1); DOES IT MATCH LAST CHARACTER?
J X50.13; NO
FI CC,SP; YES; STRIP OFF PARENS
DPB CC,U1;
DPB CC,UP2;
INVOKE P51; LOOK AT NEXT TERMINAL CHAR.
CE CC,T51.17; "DO"?
J X50.8; NO
FI CC,DO.; YES
J X50.9;
X50.8: CE CC,T51.18; "CANCEL"?
PJ E5; NO
FI CC,CANCEL.;
X50.9: DPB CC,U1; REPLACE BY PARANTHETICAL VERB
X50.11: SETZ A,0;
PAGE
X50.10: PJ S50; MAKE SURE COMMAND ENDS WITH DOT.
CAIN CC,EOS; END OF STRING?
J X50.12; YES
CAIE CC,DOT; DOT?
J .+3; NO
F A,U1; YES; RECORD POSITION
J X50.10;
F CC,T51(CC);
CE CC,K19; SPACE-LIKE?
J X50.11; NO; NEGATE LAST DOT POSITION
J X50.10;
X50.12: JN A,.+2; ENDED BY DOT?
PJ E5; NO.
FI CC,PERIOD;
DPB CC,A; MAKE IT A PERIOD.
M A,UP2; SAVE POSITION
FI CC,EOS;
IDPB CC,A;
J X51;
X50.13: CAIN A1,PERIOD; IS LAST BYTE A PERIOD?
J X51; YES
PJ E5; NO; EH.
SUBTTL X51 -- STATEMENT INTERPRETATION
X51: PJ S69X; SET SIZE, TIME AND USERS.
F B,U0; POINTER TO STEP.
HRLI B,141000;
ADDI B,1; AT THIRD BYTE.
LDB B1,B; FETCH IT!
CAIN B1,277; IS STATEMENT IMPAIRED?
PJ E5; YES
SETZM U6; TURN OFF TYPING FLAG.
F CC,T51.8; ASSUME LAST CHARACTER
M CC,U3; WILL BE A PERIOD.
JE B1,X51.1; IS THERE A CONDITIONAL?
SKIPE UDF1; USING DISC?
J X51.1; YES; IGNORE CONDITIONAL!
F B2,U0; YES; EVALUATE
PJ S58; POINTER TO IT.
MOVEM B2,U1; U1 NOW POINTS AHEAD OF CONDITIONAL
INVOKE P51; CC = NEXT TERM. CHAR
CAME CC,T51.9; IS IT AN IFF-BYTE
PJ E5; NO
JUMPN B1,.+2; WITH LEADING SPACES
PJ E5; NO
M CC,U3; YES; "IFF" IS ENDING.
PJ S65; WITH TRAILING SPACES?
PJ E5; NO
X51.3: JSP B,P49; EVALUATE CONDITIONAL.
INVOKE P53; POP RESULT
JRST .+2; TV
JNFTV ; JNF
CAME CC,T51.8;
PJ E5; NOT ENDED BY PERIOD
JUMPE A1,X52; FINI IF FALSE CONDITIONAL
X51.1: F B2,U0;
HRLI B2,141000;
ADDI B2,1; TO BEGINNING OF COMMAND.
M B2,U1;
M B2,UP11; SAVE POINTER.
INVOKE P51; FETCH BEGINNING OF IMPAERATIVE
CN CC,T51.31; IGNORE LEADING TABS.
J .-2;
HLRZ B2,CC; TEST CLASS OF CC
CAME B2,TYPE14; IS IT A VERB?
PJ E5; NO
X51.2: HRRZM CC,U2; SAVE VERB TYPE.
PJ S65; TRAILING SPACES?
CN CC,U3; NO; DOES CC=EXPECTED ENDING?
J .+2; YES
PJ E5; EH
F A1,U2; YES; GET VERB TYPE AND
J T59(A1); FIRE APPROPRIATE PROCESSOR.
SUBTTL X52: INTER-STEP SEQUENCING AND CONTROL
; X52.1 IS ENTRY FROM 'TO' ROUTINE
X52: SETOM PK35; FLAG TO ADVANCE STEP
X52.1: PUSHJ CR,S60; TIDY UP
AOS CT14; TALLY!
SKIPE MODE; ARE WE SERVICING USER
JRST X52.3; NO
X52.2: MOVEI A,1; YES; STATE = 1 (AWAITING COMMAND)
HRLM A,ME;
SETZM RETURN;
JRST SU; AND SWITCH TO USER
X52.3: LDB A,BYTE6; LOOK AT JOB CODE
JUMPE A,X52.2; SU IF NULL JOB
CAIN A,2; ARE WE DOING A STEP
JRST X55; YES; TO JOB COMPLETION ROUTINE
MOVE A,PK35; NO; ASSUME PART. LOOK AT STEP-ADVANCE.
JUMPE A,X53; NO STEP ADVANCE
X52.4: DPB A,BYTE10; SET SKIP
PUSHJ CR,P74; ADVANCE STEP
JRST X55; DONE; TO JOB COMPLETION
X53: SETZ A,0; SKIP IS OFF.
DPB A,BYTE10;
DPB A,BYTE8; BREAK = 0
SETOM MODE; MODE IS INDIRECT
X53.1: JSP B,X47; ACKNOLWEDGE RECALLS AND IN-REQU.
OCT 4;
; NOW START INTERPRETATION OF NEXT STEP!
X54: SETOM MODE; MODE IS INDIRECT
PUSHJ CR,P74; GET CURRENT (OR NEXT) STEP
JRST X54.1; NONE; MAY BE DONE
SETZ A,0; SKIP IS OFF.
DPB A,BYTE10;
X54.2: MOVE A,CSA;
HLRZ A,1(A); LINK TO CURRENT STEP STRING
SUBI A,1;
HRLI A,41000; POINT TO FIRST BYTE
M A,U0; SAVE POINTER
JRST X51; TO STATEMENT INTERPRETER
X54.1: LDB A,BYTE6; LOOK AT JOB CODE
CAIN A,1; WERE WE DOING A PART
JRST X52.4; YES; TO STEP ADVANCE
LDB A,BYTE11; NO; FOR CLAUSE?
JN A,X54.3; YES; CAN'T FIND STEP FOR ITER.
PJ P72A; NO; POP JOB,POP JOB -- HMMM-DE-HUMMM-DE HMM
SKIPN MODE; STARTED BY USER?
J X54.4; YES
SETZ A,0; NO; RESET:
DPB A,BYTE8; SKIP AND
DPB A,BYTE10; BREAK
E CS34; CAN'T FIND REQUIRED STEP
PAGE
X54.4: JSP B,X48;
BYTE (8)277,CS,0,CS,1,COLON,SP+1,EOS;
XWD 41000,CS34-1; ERR ABOVE. CAN NOT FIND STEP
BYTE (8)277,DOT,CG,EOS;
DEC -1;
J X52;
X54.3: FI A1,1; CAN'T FIND STEP FOR ITERATION
DPB A1,BYTE8; BREAK=1
LDB A1,BYTE7;
ADDI A1,2;
M A1,MODE; MODE=JOB MODE + 2
PJ E29;
SUBTTL X55 -- TEST FOR JOB COMPLETION
;
X55: LDB A,BYTE11; GET FOR-CLAUSE LINK
JUMPE A,X57; NONE; FINISHED WITH JOB
MOVEM A,PK29;
MOVEI A1,1;
DPB A1,BYTE8;
SETZ A1,0; SKIP IS OFF
DPB A1,BYTE10; BREAK=1
LDB A1,BYTE7;
M A1,MODE; MODE=JOB MODE
PUSHJ CR,P71; ADVANCE FOR CLAUSE
HRRZ A,@PK29; GET NEXT ON ROV
JUMPE A,X57; NO MORE; FINISHED WITH JOB
X56: AOS MODE; ADJUST TO INDICATE "DURING ..."
AOS MODE;
PUSHJ CR,P73; FIND OBJECT FOR ITERATION
JRST X56.1; STEP (A1 = LINK)
HRR A1,1(A1); PART; GET FIRST STEP LINK
X56.1: HRRZM A1,CSA; SET CSA
MOVE A2,(A1);
MOVEM A2,CSI; SET CSI
MOVE A2,PK22; AND
MOVEM A2,CPI; CPI
X56.2: LDB A,BYTE11; GET FOR-CLAUSE LINK
JUMPE A,X53; NO FOR-CLAUSE
PUSHJ CR,S63; FETCH LHS AND RSH FOR ITERATION.
PUSHJ CR,P67; SET ITERATION VARIABLE.
PJ E3A; OUT-SIZE
J X53;
SUBTTL X57 -- POP JOB LIST AND ACT ACCORDINGLY
X57: PUSHJ CR,P72A; POP JOB LIST
X57.1: LDB A,BYTE6; ANYTHING TO DO?
JN A,.+3; YES
SETZM MODE;
J X52.1; NO; SWITCH TO USER
SKIPE MODE; SERVICING USER?
J X52; NO; TO STEP ADVANCE.
X57.4: F A1,CPI;
F A2,CSI;
LDB A,BYTE8; WHERE WERE WE?
JE A,X57.2; AT STATEMENT BREAK.
F A,JPDL; DURING STEP
F A,1(A);
F A1,(A);
F A,1(A);
F A2,(A);
LDB A,BYTE7; WAS JOB ORIGINATED BY USER?
JN A,X57.2; NO
X57.6: JSP B,X48; TELL USER WE ARE DONE.
XWD 41000,CS16-1; DONE. I'M READY TO GO
BYTE (8)277,DOT,CG,EOS;
DEC -1;
J X52.1; AND SU
X57.2: M A1,UP1;
M A2,UP2;
PJ S67Y; CONVERT STEP NUMBER
HRRZI A1,PARTS;
F A2,UP1;
PJ P70L;
J X57.3; NO SUCH PART
F A1,A;
F A2,UP2;
PJ P70R;
J X57.3; NO SUCH STEP
J X57.5;
PAGE
X57.3: FI A,CS15-1; STEP HAS BEEN DELETED!
J X57.5+1;
X57.5: FI A,ERRA-1;
HRLI A,41000;
M A,US5;
LDB A,BYTE8;
LSH A,1;
LDB A1,BYTE10;
JE A1,.+2; SWITCH ON BREAK AND SKIP CODES
TRO A,1;
F A,X57A(A);
M A,US6;
JSP B,X48;
XWD 0,US6;
BYTE (8)277,SP,CS,11,EOS;
XWD 0,US5;
BYTE (8)277,DOT,CG,EOS;
DEC -1;
J X52.1;
X57A: POINT 8,CS12-1,31;
POINT 8,CS13-1,31;
POINT 8,CS14-1,31;
POINT 8,CS14-1,31;
SUBTTL AFTER "SET", "LET" AND STORING A FORM.
V0: SETZM UDF2; RESET FLAG FOR NON-FORM
SKIPN UDF1; IN DISC MODE?
J X52; NO
PJ S60; CLEAR CONSOLE
J D60.1; RE-ENTER RECALL ROUTINE
SUBTTL V1 'SET' STATEMENTS
V1: JSP B,P40; GET LHS
PJ E5; NO LHS!
CAME CC,T51.6; FOLLOWED BY EQUAL SIGN
PJ E5; NO
V1.2: JSP B,P49; EVALUATE RHS
V1.3: CE CC,U3; FOLLOWED BY EXPECTED ENDING?
PJ E5; NO
INVOKE P53; OK; POP AND TEST RHS.
TVSET ; TV
LDB A,BYTE2;
M A,PK19; SAVE TYPE
MOVEM A1,PK20; AND
MOVEM A2,PK21; SAVE RHS VALUE
PUSHJ CR,P66; POP/TEST LHS
PUSHJ CR,P67; SET LHS TO RHS
PJ E3A; OUT-SIZE
J V0;
SUBTTL V2 'LET' STATEMENTS
V2: INVOKE P51; CC = NEXT CHAR.
TLNE CC,777777; IS IT A LETTER
PJ E5; NO
MOVEM CC,PK27; YES--SAVE IT
PUSHJ CR,S59; FETCH DUMMY LETTER LIST (IF ANY)
CE CC,T51.6; FOLLOWED BY EQUALS SIGN?
J V2.9; NO
F B2,T48; NR OF DUMMY LETTERS
JE B2,V2.2; NONE
CLE B2,K29;
PJ E37; TOO MANY.
V2.4: F B1,B2; DUMMY-LETTERS MUST BE DISTINCT.
SOJE B1,V2.5;
F CC,T48(B2);
CN CC,T48(B1);
PJ E47; WE HAVE DUPLICATION.
SOJG B1,.-2;
SOJG B2,V2.4;
V2.5: F B,US1; PREPARE TO COLLECT DLS IN US1
MOVEI B2,1;
V2.1: MOVE B1,T48(B2);
IDPB B1,B; COLLECT DUMMY-LETTER STRING
CAME B2,T48;
AOJA B2,V2.1;
MOVEI B1,EOS; APPEND EOS
IDPB B1,B;
V2.2: PJ S68; SKIP LEADING BLANKS
F B2,U3; LOOK AT EXPECTED ENDING.
MOVEI B1,PERIOD; ASSUME PERIOD
CAME B2,T51.8; IS IT
MOVEI B1,IF2; NO--IFF-BYTE
MOVE B,US2; POINTER TO DEF. SIG.
PUSHJ CR,S57; COLLECT
CAIG B2,1 ;HAVE WE COLLECTED ANYTHING
PJ E5; NO
ADD B2,T48; CALCULATE SPACE REQU
ADDI B2,6; SIX BYTES PER CELL
MOVE B1,B2;
PJ P51Y; ENUF SPACE?
F A,PK27; OK; LOOK AT ENTRY.
HLRZ A1,1(A); DEFINED AT THIS LEVEL?
CAME A1,LEVEL;
PJ P58; NO; PUSH THE ENTRY.
PJ P60; YES; DELETE THE ENTRY
SETZ A1,0;
HRL A2,T48; DIMENSION
HRRI A2,1 ;USE COUNT = 1
PAGE
M55A A1,A2; STORE
HRRZM A2,PK27; SAVE HEADER ADDRESS
HLL A2,(A); MAKE UP FORMULA DESCRIPTOR
TLZ A2,IDM;
HRLZ A1,TYPE4;
IOR A2,A1;
MOVEM A2,(A);
MOVE A,ACL;
SKIPN T48;
JRST V2.7; NO PARAMETERS!
MOVE A1,US1;
MOVEM A1,U1; POINTER TO DLS
HRLM ACL,@PK27; DLS POINTER (IN USER)
PUSHJ CR,S56; DLS TO USER
HRRZ ACL,1(A);
HLLZS 1(A);
F A,ACL; PREPARE TO STORE RHS
V2.7: F A1,US2;
M A1,U1; PTR TO RHS
HRRM ACL,@PK27; DEF. PTR. (IN USER)
PJ S56; STORE DEF.
HRRZ ACL,1(A);
HLLZS 1(A);
J V0;
PAGE
V2.9: CE CC,T51.33; "BE"?
PJ E5; NO
INVOKE P51; FOLLOWED BY
CE CC,T51.34; "SPARSE"?
PJ E5; NO
INVOKE P51; FOLLOWED BY
CE CC,U3; EXPECTED ENDING?
PJ E5; NO
SKIPE T48; ANY LETTERS?
PJ E5; YES; EH?
F CC,PK27; LETTER'S TABLE ADDRESS
F A,(CC); ITS DESCRIPTOR
M A,PK8;
HLRZ A1,1(CC); DEFINED AT THIS LEVEL?
CE A1,LEVEL;
PJ E10; NO
LDB B2,BYTE2; ITS TYPE
CE B2,TYPE3; AN ARRAY?
J V2.10; NO
TLO A,SPARSE; MAKE IT SPARSE.
M A,(CC);
J V0;
V2.10: F A,PK27;
PJ P60; DELETE ENTRY
HLLZ A2,(A);
TLZ A2,IDM;
HRLZ A1,TYPE6; UNDEFINED BUT TO BE SPARSE!
TLO A1,SPARSE; COMPOSE DESCRIPTOR
IOR A1,A2;
M A1,(A); DESCRIPTOR TO TABLE ENTRY
J V0;
SUBTTL V3 -- TYPE STATEMENTS
V3: F A,U1; SAVE POINTER
JSP B,P38L; A LIST REQUEST?
J V3.100; YES
V3.0: CE CC,T51.10; QUOTE MARK?
J V3.3; NO
F B,US2; YES; PREPARE TO COLLECT IN US2
V3.1: FI B1,QUOTE;
PJ S57; COLLECT TO NEXT QUOTE MARK
F A,U1; SAVE POINTER BEFORE LOOKING AT
M B,UP1;
INVOKE P51; NEXT TERMINAL CHAR.
CN CC,U3; EXPECTED ENDING?
J V3.2; YES; SEND TO USER
M A,U1; NO; RESTORE PTR.
MOVEI B1,QUOTE; AND
F B,UP1;
DPB B1,B; DEPOSIT QUOTE (OVER EOS)
J V3.1; AND CONTINUE COLLECTING
V3.2: JSP B,X48;
XWD 0,US2;
BYTE (8)277,CG,EOS;
DEC -1;
J X52; QUOTATION SENT; DONE!
V3.3: M A,U1;
F A,US1;
M A,UP1; MOVE STRING INTO US1
JSP B,S64; AND WORK ON IT THERE.
XWD 0,U1;
DEC -1;
SETZM UP6; CLEAR ITEM-TYPE FLAG.
SETOM U6; TURN ON TYPING FLAG.
AOS SIZE; PREPARE TO USE TWO EXTRA
AOS SIZE; IF NECESSARY.
SETOM U7; AND NOTE THE FACT!
F A,UP1;
M A,U1; RESET POINTER
SETZM UP3; ITEM COUNT=0
V3.31: JSP B,P38X; IS NEXT ITEM AN OOD?
J V3.32; NO
AOS UP6; NOTE THE FACT.
J V3.33;
V3.32: JSP B,P49; FETCH ELEMENTARY OPERAND
PAGE
V3.33: AOS A1,UP3; INC. COUNT AND FETCH IT TO A1
HRLM DS,UP3; RECORD POSITION OF ITEM ON PDL
HLRZ A1,A1; POSITION OF LAST
JE A1,V3.34; IT'S THE FIRST.
F A2,1(A1); STACK ON PDL AS FIFO
HRRM DS,1(A1);
F A1,1(DS);
HRRM A2,1(DS);
HRRZ DS,A1;
V3.34: CE CC,T51.4; IS ITEM DELIMITED BY A COMMA?
J V3.35; NO
FI CC,COMMA2; YES; MAKE SURE IT'S A SPECIAL ONE!
DPB CC,U1;
J V3.31; RETURN FOR NEXT ITEM.
V3.35: CE CC,U3; EXPECTED ENDING?
J V3.9; NO
LDB CC,U1; YES;
M CC,UP2; RECORD THE FINAL BYTE.
HRRZS UP3; FIX ITEM COUNT
V3.4: SOSGE UP3; ANY MORE ITEMS?
J X52; NO
JSP B,X47 ;RECALLS IN-REQU
OCT 6;
F A,(DS); LOOK AT NEXT DESCRIPTOR
M A,UP4; SAVE IT
LDB A1,BYTE2; ITS TYPE
CE A1,TYPE13; SINGULAR ITEM?
J V3.41; NO
M52 DS,A; YES; POP DESC.
JSP B,S69; SEND IT
J V3.431; ADVANCE TO NEXT ITEM
PAGE
V3.41: CLE A1,TYPE2; SCALAR?
J V3.42; NO
JSP B,S70C; YES; SEND IT
J V3.4;
V3.42: CLE A1,TYPE4; ARRAY OR FORMULA?
J V3.45; NO; MAY BE OOD.
M52 DS,A; YES; POP DESCRIPTOR
V3.43: XCT V3.44(A1);
V3.431: F A,UP1; ADVANCE POINTER
M A,U1; TO NEXT ITEM.
PJ S50;
CAIN CC,COMMA2;
J .+3;
CE CC,UP2;
J .-4;
F A,U1; RESET POINTER.
M A,UP1;
J V3.4;
V3.44: PJ E5;
PJ E5;
JSP B,S71;
JSP B,S70B;
V3.45: CE A1,TYPE11; OOD?
EXTERN FORMFG
PJ E5; NO
M52 DS,A; POP ITS DESCRIPTOR.
PJ P70X; DECOMPILE IT
PJ E54; BAD OBJECT NR.
PJ E54; NO SUCH OBJECT.
JSP B,V3.5; TYPE THE OBJECT
J V3.431; CONTINUE.
PAGE
; TYPE OBJECTS-OF-DISCOURSE
; JSP B,V3.5
V3.5: HRRZM B,UX4; SAVE CALLER
F B2,UP3; SAVE ITEM COUNT
M B2,U8;
HRRZ B2,PK36; WHAT DO WE HAVE?
SETZ A1,0;
XCT V3.51(B2);
J V3.6;
V3.51: TRO A1,37; ALL
TRO A1,1; ALL PARTS
TRO A1,1; ALL STEPS
TRO A1,2; ALL FORMS
TRO A1,4; ALL FORMULAS
TRO A1,30; ALL VALUES
PJ E5;
PJ E5;
J V3.52; PART
J V3.53; STEP
J V3.54; FORM
J V3.55; FORMULA
PJ E5;
PJ E5;
PJ E5;
V3.52: F A,PK39; PART HEADER
JSP B,S72;
J V3.84;
V3.53: F A,PK39; STEP HEADER
JSP B,S70A;
J V3.85;
V3.54: F A,PK39; FORM HEADER
SETOM FORMFG
JSP B,S70EX; SEND FORM WITHOUT IDENTIFICATION
SETZM FORMFG
J V3.85;
V3.55: F A,PK37;
F A,(A); FORMULA'S DESCRIPTOR
M A,UP4;
JSP B,S70B; SEND IT
J V3.85;
V3.6: M A1,UP10;
TRNN A1,1; ALL PARTS?
J V3.7; NO
JSP B,X48; YES; SPACE A LINE
BYTE (8)277,CG,EOS;
DEC -1;
FI A,PARTS; YES
HLRZ A,1(A); ANY PARTS?
JE A,V3.7; NO
M A,UP3; YES
J V3.62; PRINT THE FIRST PART.
PAGE
V3.61: F A,UP3;
HLRZ A,1(A); TO NEXT PART
M A,UP3;
JE A,V3.7; NO MORE PARTS
JSP B,X47; RECALLS AND IN-REQUESTS
OCT 6;
JSP B,X48;
BYTE (8)277,CG,EOS;
DEC -1; BLANK LINE AS SEPARATER
V3.62: JSP B,S72; SEND THE PART
J V3.61;
V3.7: F A1,UP10;
TRNN A1,2; ALL FORMS?
J V3.8; NO
JSP B,X48; YES; SPACE A LINE.
BYTE (8)277,CG,EOS;
DEC -1;
FI A,FORMS;
HLRZ A,1(A); ANY FORMS?
JE A,V3.8; NO
M A,UP3; YES
J V3.72; PRINT THE FIRST FORM
V3.71: F A,UP3;
HLRZ A,1(A); NEXT FORM
M A,UP3;
JE A,V3.8; NO MORE FORMS
JSP B,X47;
OCT 6; RECALLS AND IN-REQU
F A,UP3;
JSP B,X48; SPACE A LINE
BYTE (8)277,CG,EOS;
DEC -1;
V3.72: SETOM FORMFG
JSP B,S70E; SEND THE FORM
SETZM FORMFG
J V3.71;
V3.8: F A1,UP10;
TRNN A1,4; ALL FORMULAS?
J V3.82; NO
FI A,0;
JSP B,S73; SEND ALL FORMULAS
J V3.82;
V3.81: F A1,UP10;
TRNN A1,10; ALL ARRAYS?
J V3.84;
FI A,1; SEND VECTORS FIRST.
M A,UP11;
PAGE
V3.83: FI A,1;
JSP B,S73; SEND THEM
AOS A,UP11; SEND ARRAYS OF NEXT HIGHER DIMENSION.
CAMG A,K29;
J V3.83; MORE
J V3.84;
V3.82: F A1,UP10;
TRNN A1,20; ALL SCALARS?
J V3.81; NO; SEND ARRAYS
FI A,2;
JSP B,S73; SEND THEM
J V3.81; SEND ARRAYS.
V3.84: JSP B,X48; FINISH WITH BLANK LINE.
BYTE (8)277,CG,EOS;
DEC -1;
V3.85: F B2,U8; RESTORE ITEM COUNT
M B2,UP3;
J @UX4; AND FINI
PAGE
; TYPE IN FORM.
V3.9: HRRZS UP3; FIX COUNTER
CAME CC,T51.13; "IN"?
PJ E5; NO
F A,U1;
INVOKE P51;
CE CC,T51.21; FORM?
PJ E5; NO
SKIPE UP6; OBJECTS OF DISCOURSE?
PJ E46; YES
M A,U1;
JSP B,P38; FOLLOWED BY OOD?
PJ E5; NO
CE CC,U3; EXPECTED ENDING?
PJ E5; NO
MOVE A,PK39; LINK TO FORM HEADER
HRRZ A,1(A); LINK TO FORM
SUBI A,1;
HRLI A,41000; POINTER TO FORM
M A,US6;
F A,US1;
JSP B,S64; COPY INTO US1
XWD 0,US6;
BYTE (8)277,CG,EOS;
DEC -1;
F A,US1;
M A,U1;
SETZM PK38; POSITION OF LAST FIELD.
V3.91: PJ S65X; FETCH NEXT FIELD SPECIFICATION
SKIPE PK36;
J V3.910;
JN A2,V3.910;
PJ E40; TOO MANY VALUES
V3.910: F A,(DS); NEXT DESCRIPTOR
LDB A1,BYTE2; ITS TYPE
M A1,PK19; SAVE IT
CLE A1,TYPE2; TV OR JNF?
J V3.94; NO
INVOKE P53; YES; POP DESC. AND VALUE
SKIP ; TV'S ALREADY LEGISLATED
V3.913: F A,U1;
CAMN A,PK38; DO FIELDS ABUT?
PJ E44; YES
HLRZ B1,PK36; LEFT UNDERSCORES
HRRZ B,PK36; RIGHT UNDERSCORES
F B2,PK37; DOTS
CAILE B2,1; FIXED FIELD?
J V3.92; NO; SCIENTIFIC
PAGE
SKIPN PK19; TV?
J V3.912; YES
CALL S83; JNF TO FIXED FIELD
V3.911: PJ E41; DOES NOT FIT FIELD
J V3.93;
V3.912: JN B2,V3.911; NO DEC POINT FOR TV
JE A1,.+2; TRUE OR FALSE?
ADDI B2,1; TRUE
SUBI B1,5;
ADD B1,B2; LENGTH OF REMAINING FIELD
JL B1,V3.911; FIELD TOO SMALL.
FI CC,SP;
JUMPE B1,.+3;
IDPB CC,A;
SOJG B1,.-1; LEADING BLANKS
F B,ST51LO+64(B2); TO STRING
ILDB CC,B;
CAIN CC,EOS;
J V3.93;
IDPB CC,A;
J .-4;
V3.92: SKIPN PK19; TV?
PJ E41;
F B1,B2;
CALL S84; VALUE TO SCIENTIFIC FIELD
PJ E41; DOES NOT FIT
V3.93: M A,U1; RESTORE POINTER
M A,PK38;
SOSE UP3; ANY MORE ITEMS?
J V3.91; YES
PJ S65X; NEXT FIELD SPEC.
SKIPE PK36;
J V3.95; EXTRA FIELDS PERHAPS
JN A2,V3.95;
V3.96: JSP B,X48; SEND LINE TO USER
XWD 0,US1;
DEC -1;
J X52;
PAGE
V3.94: CE A1,TYPE13; SINGULAR ITEM?
PJ E43; NO; USE INDIVIDUAL VALUES ONLY.
F A,U1 ;DO FIELDS ABUT?
CAMN A,PK38;
PJ E44; YES
M52 DS,A; YES; POP DESCRIPTOR
TRNE A,777777; UNDERSCORE?
J V3.941; NO
F A,U1; YES
HLRZ A1,PK36;
HRRZ A2,PK36;
ADD A1,A2;
ADD A1,PK37;
FI CC,SP;
IDPB CC,A;
SOJG A1,.-1;
M A,U1;
M A,PK38;
SOSE UP3;
J V3.91;
PJ S65X; DO NOT CUT-OFF AFTER BLANK FIELD
SKIPE PK36;
PJ E42;
JE A2,V3.96;
PJ E42;
V3.941: HRRZM A,PK19; SAVE CODE.
F A1,LINE(A);
XEC V3.942-1(A);
CALL S81;
J V3.913;
V3.942: SETZ A2,0;
J V3.943;
SETZ A2,0;
V3.943: SKIPE PK37; NO POINTS FOR TIME!
PJ E41;
HLRZ B,PK36; FIELD LENGTH
CAIGE B,4;
PJ E41;
FI CC,SP;
F A,U1;
CAMN A,PK38;
PJ E44; FIELDS ABUT.
CAIN B,4; LEADING BLANKS
J .+3;
IDPB CC,A;
SOJA B,.-3;
F B1,UTIME;
PJ S66T;
J V3.93;
PAGE
; MAY HAVE TO CUT-OFF LINE
V3.95: F A,PK38;
CN A,U1; DO FIELDS ABUT?
PJ E44; YES
F A2,U1; SAVE BEGINNING OF NEXT FIELD.
M A,U1;
PJ V3.110; NEXT BYTE
J V3.959; DONE
CAIN CC,SP+1; 2 SPACES?
SUBI CC,1; YES; TREAT AS SINGLE SPACE HERE.
V3.950: F A1,U1; HOLD PTR.
CAIE CC,SP; SINGLE SPACE?
J V3.953; NO
PJ V3.110; NEXT BYTE
J V3.958; DONE
V3.951: CAIGE CC,12; LETTER?
J V3.959; NO; DONE
CAIG CC,75;
J .+3; YES
CAIG CC,WORD; A WORD?
J V3.959; NO
F A,A1; YES; START NEW WORD
V3.952: PJ V3.110; NEXT BYTE
J V3.958; NO MORE; CUT OFF RIGHT HERE!
CAIN CC,EQUALS;
J V3.959;
CAIGE CC,SP;
J V3.952;
CAIGE CC,SPS;
J V3.950;
J V3.952;
V3.953: CAIG CC,SP; NO SPACE; A LETTER POSSIBLY?
J V3.951; YES; BEGINNING OF WORD.
CAILE CC,SPS; MORE THAN ONE SPACE?
J V3.951; NO; MAY BE BEGINNING OF WORD.
PJ V3.110; YES; NEXT BYTE
J .+2; NO MORE;
CAIE CC,EQUALS; EQUAL SIGN?
F A,A1; NO; CUT OFF BEFORE LAST WORD.
J V3.959; CUT OFF HERE.
V3.958: F A,U1;
V3.959: FI CC,CG; APPEND CARRIAGE RETURN
IDPB CC,A;
FI CC,EOS;
IDPB CC,A; AND EOS.
J V3.96;
PAGE
V3.100: CE CC,U3;
PJ E5;
HRRZ CC,PK36;
CAIE CC,6; ITEM-LIST?
PJ E5; NO
J D63;
V3.110: CAMN A2,U1; ARE WE UP TO NEXT FIELD?
POPJ CR,0; YES
F B,CR; NO
AOS (B); INCREMENT RETURN ADDRESS
J S50; AND GET NEXT BYTE.
SUBTTL V4 DO STATEMENTS
V4A: SETOM UP0; PARENTHETICAL JOB
JRST V4+2;
V4: MOVE A,MODE; REGULAR JOB GOVERNED BY MODE.
MOVEM A,UP0;
JSP B,P38E; PART OR STEP?
PJ E5; NO
HRRZ A1,PK39; GET HEADER LINK
HRRZ A2,PK36; AND OOD TYPE.
SUB A2,K22;
CAIN A2,2; A STEP?
J V4.1; YES
CAIE A2,1; A PART?
PJ E5; NO
HRRZ A1,1(A1); YES; GET LINK TO FIRST STEP
V4.1: HRLM A1,UP1;
HRRM A2,UP1 ;UP1= LINK TO OBJECT OBJECT TYPE
F A2,PK37;
M A2,UP5;
F A2,PK38;
M A2,UP6; SAVE OBJECT NR.
F A2,PK22;
M A2,UP2; PART INDEX
F A2,(A1);
M A2,UP3; STEP INDEX
SETZM UP4; NULL FOR-CLAUSE LINK
CN CC,U3; EXPECTED ENDING?
J V4.2; YES
CE CC,T51.12; NO; HAVE WE A "FOR"?
J V4.6; NO; MAY BE "N TIMES".
JN B1,.+2; WITH LEADING SPACES?
PJ E5; NO
JSP B,P39; OKAY; COMPILE FOR-CLAUSE
CE CC,U3; EXPECTED ENDING?
PJ E5; NO
F A,(DS); FETCH ITS DESCRIPTOR
HRRM A,UP4; SAVE LINK TO FOR-CLAUSE
V4.2: SKIPN UP0; PARENTHETICAL JOB?
PJ S66Y; NO; CANCEL ALL.
F A,UP4; HAVE WE OPERATING ROOM?
JE A,V4.4; NO FOR-CALUSE
HLRZ A1,(A); LINK TO LHS
HLRZ A,(A1); NR OF SUBSCRIPTS
ADDI A,2; SPACE REQUIREMENTS PLUS ONE.
PAGE
V4.4: ADDI A,4; SPACE FOR JOB PDL
CL A,SIZE; ENUF SPACE?
PJ E3A; NO
SKIPN UP4; FOR-CLAUSE?
J V4.5; NO
M52 DS,A; YES; SAFE TO POP FOR-CLAUSE DESC.
V4.5: PJ P72B; PUSH CURRENT JOB
F A1,UP2;
M A1,CPI; SET CURRENT PART INDEX
F A1,UP3;
M A1,CSI; CURRENT STEP INDEX
F A,UP1;
HLRZM A,CSA; CURRENT STEP ADDRESS
SETZM JD; IN JOB DESCRIPTOR
DPB A,BYTE6; JOB CODE
F A,MODE;
DPB A,BYTE7; JOB MODE
F A,UP5;
M A,U24;
F A,UP6;
HRLZM A,U25; JNF OBJECT NR.
F A,UP4;
JE A,X53; NO FOR CLAUSE
DPB A,BYTE11; SAVE ITS LINK
PJ S63;
PJ P67;
J .+2; NEED MORE SPACE
J X53;
PJ P72A; POP JOB
PJ E3A;
V4.6: CE CC,T51.4; COMMA?
PJ E5; NO
JSP B,P49; YES; EVALUATE NEXT EXPRESSION
CE CC,T51.24; FOLLOWED BY "TIMES"?
PJ E5; NO
INVOKE P51;
CE CC,U3; AND EXPECTED ENDING?
PJ E5; NO
INVOKE P53; OK; POP AND TEST EXPRESSION
TVJNF;
M A1,PK37; SAVE THE NUMBER
M A2,PK38;
JE A1,X52;
JG A1,.+2;
PJ E49; NR. OF TIMES MUST BE > 0
CALL P91;
JN A1,.-2; AND INTEGRAL.
PAGE
F A1,PK37;
HRLZ A2,PK38;
M55 A1,A2,E3; STORE IT.
HRRZ A,A2;
HRL A,TYPE9; ROV DESCRIPTOR
M55 A,A2,E7;
HRRZS (A2); TREAT AS FOR-CLAUSE DESC.(NO LHS)
F A,A2;
HRL A,TYPE10; FOR-CLAUSE DESCRIPTOR
M53 A,DS,E7; TO DS
HRRM A,UP4;
J V4.2;
SUBTTL V5 DELETE
V5: AOS SIZE; TWO EXTRA CELLS
AOS SIZE;
SETOM U7; NOTE THE FACT.
SETZM UP3; COUNT OF ITEMS.
V5.0: JSP B,P38X; IS NEXT ITEM AN OOD?
JSP B,P37; NO; COMPILE LHS
V5.02: AOS UP3; COUNT!
CN CC,T51.4; FOLLOWED BY COMMA?
J V5.0; YES
CE CC,U3; EXPECTED ENDING?
PJ E5; NO
V5.1: SOSGE UP3; ANY MORE?
J V5.13; NO; CLEAN UP
F A,(DS); YES; FETCH DESCRIPTOR
LDB A1,BYTE2; WHAT IS IT?
CE A1,TYPE8; LHS?
J V5.11; NO
PJ P66; YES; EXPAND IT.
PJ S74B; AND DELETE ITEM
J V5.1;
V5.11: M52 DS,A ;;***POP DESCRIPTOR
CE A1,TYPE21; TABLE ENTRY?
J V5.12; NO
PJ P60; DELETE THE ENTRY
J V5.1;
V5.12: CE A1,TYPE11; OOD?
PJ E54; NO
PJ P70X; DE-COMPILE IT.
PJ E54; BAD NR.
J V5.1; DELETED!
JSP B,V5.2; DELETE THE OBJECT
J V5.1; CONTINUE.
PAGE
V5.13: PJ S60; CLEAN UP
PJ S69X; SET SIZE, TIME USERS
SKIPE USIZE; ANYTHING BEING USED?
J X52; YES
F B1,SIZE;
SUB B1,K32; PREPARE TO RETURN UNUSED BLOCKS
IDIVI B1,^D512;
JE B1,X52; NO EXCESS BLOCKS
FI A1,15;
JSP B,X46; RETURN EXCESS BLOCKS
XWD .+1,MONENT;
JSR S62; RESTORE CONSOLE
F A,K36;
ADDI A,INTENT;
M A,SPACE;
PJ S69Y; SET SIZE AND LINK ACL
J X52;
V5.2: HRRZM B,UX4;
HRRZ B2,PK36; OBJECT TYPE
SKIPN MODE;
J V5.20;
CAIG B2,3 ;INDIRECT; NO PARTS STEPS,FORMS,ALL
PJ SIN6;
CAIGE B2,10;
J V5.20;
CAIG B2,12;
PJ SIN6;
V5.20: SETZ A1,0; SWITCH ON OOD.
XCT V5.21(B2);
J V5.4;
PAGE
V5.21: TRO A1,37; ALL
TRO A1,1; ALL PARTS
TRO A1,1; ALL STEPS
TRO A1,2; ALL FORMS
TRO A1,4; ALL FORMULAS
TRO A1,30; ALL VALUES
PJ E5;
PJ E5;
J V5.31; PART
J V5.33; STEP
J V5.34; FORM
J V5.63; FORMULA
PJ E5;
PJ E5;
PJ E5;
PJ E5;
V5.31: F A1,PK39;
M A1,PK40;
HRL A,A1;
HRR A,1(A1);
PJ S74A; DELETE NEXT STEP IN PART
J V5.31; MORE
J @UX4; DONE
V5.33: F A,PK39;
PJ S74A; DELETE THE STEP
J @UX4; DONE
V5.335: J @UX4; DONE
V5.34: F A,PK39;
PJ S74C; DELETE THE FORM
J @UX4; DONE
V5.4: M A1,UP10;
CAIE A1,37; DELETING ALL?
J V5.41; NO
SETZM UP0;
PJ S66Y;
F A1,UP10;
V5.41: TRNN A1,1; ALL PARTS?
J V5.5; NO
FI A,PARTS;
HLRZ A1,1(A);
JE A1,V5.5; NO MORE PARTS
HRL A1,A;
M A1,PK40;
PAGE
V5.42: F A1,PK40;
HRL A,A1;
HRR A,1(A1);
PJ S74A; DELETE NEXT STEP
J V5.42; MORE; CONTINUE.
J V5.41+2; PART DELETED
V5.5: F A1,UP10;
TRNN A1,2; ALL FORMS?
J V5.6; NO
V5.51: FI A1,FORMS;
HLRZ A,1(A1);
JE A,V5.6; NO MORE FORMS
HRL A,A1;
M A,PK39;
PJ S74C; DELETE THE FORM
J V5.51;
V5.6: F A1,UP10;
TRNN A1,4; ALL FORMULAS?
J V5.61; NO
SETZ A,0;
PJ S74D; DELETE ALL FORMULAS
V5.61: F A1,UP10;
TRNN A1,10; ALL ARRAYS?
J V5.62; NO
FI A,1;
PJ S74D; DELETE ALL ARRAYS
V5.62: F A1,UP10;
TRNN A1,20; ALL SCALARS?
J @UX4; NO, DONE.
FI A,2;
PJ S74D; DELETE ALL SCALARS
J @UX4; FINI.
V5.63: F A,PK37;
PJ P60; DELETE THE FORMULA
J @UX4;
SUBTTL V6,V7,V8 LINE; PAGE, CANCEL
V6: PJ S68; NEXT NON BLANK
CE CC,U3; EXPECTED ENDING?
PJ E5; NO
F A1,LINE; DO NOTHING IF
CE A1,K27; IF AT TOP OF PAGE
J .+3;
SKIPN MODE; AND DIRECT.
J X52;
JSP B,X48;
BYTE (8)277,CG,165;
DEC -1;
JRST X52;
V7: PJ S68; NEXT NON-BLANK
CE CC,U3; EXPECTED ENDING?
PJ E5;
F A1,LINE;
CE A1,K27;
J .+3;
SKIPN MODE;
J X52;
JSP B,X48;
OCT 0;
JRST X52;
V8A: SETOM UP0; PARENTHETICAL CANCELLATION
JRST V8+1;
V8: SETZM UP0; CANCEL ALL.
SKIPE MODE;
PJ E2; DIRECT ONLY
PJ S68; NEXT NON BLANK
CE CC,U3; EXPECTED ENDING?
PJ E5;
PJ S66Y; CANCEL ACCORDING TO UP0
J X57+1;
SUBTTL V9, V11, V12 GO; DONE, STOP
V9: SKIPE MODE;
PJ E2; DIRECT ONLY
PJ S68; NEXT NON-BLANK
CE CC,U3; EXPECTED ENDING?
PJ E5;
LDB A,BYTE6;
JN A,.+2;
PJ E39; NOTHING TO DO!
LDB A,BYTE8; RE-ENTER ACCORDING TO BREAK CODE
JE A,V9.1;
LDB A,BYTE7; MODE=JOB MODE
MOVEM A,MODE;
J X56;
V9.1: LDB A,BYTE10; WERE WE STOPPED?
JE A,X54; NO
SETOM MODE;
J X52; YES; TO STEP ADVANCE
V11: SKIPN MODE;
PJ E1; INDIRECT ONLY
PJ S68; NEXT NON BLANK
CE CC,U3; EXPECTED ENDING?
PJ E5;
J X55;
V12: SKIPN MODE;
PJ E1; INDIRECT ONLY
PJ S68; NEXT NON BLANK
CE CC,U3; EXPECTED ENDING?
PJ E5;
SETO A,0;
DPB A,BYTE10; SKIP IS ON!
F A1,CPI;
F A2,CSI;
PJ S67Y; CONVERT STEP NUMBER
JSP B,X48;
BYTE (8)277,CS,6,SP,EOS;
XWD 0,US4;
BYTE (8)277,DOT,CG,EOS;
DEC -1;
SETZM MODE;
J X52;
SUBTTL V10 TO
V10: SKIPN MODE;
PJ E1; INDIRECT ONLY
JSP B,P38E; PART OR STEP?
PJ E5; NO
HRRZ A1,PK39; FETCH HEADER LINK
HRRZ A2,PK36; AND OOD TYPE
SUB A2,K22; SUBTRACT SINGULAR OFF-SET
CAIN A2,2; IS IT A STEP?
J V10.1; YES
CAIE A2,1; A PART?
PJ E5; NO
HRRZ A1,1(A1); FETCH LINK TO FIRST STEP HEADER
V10.1: CE CC,U3; EXPECTED ENDING?
PJ E5; NO
M A1,CSA; SET CURRENT STEP ADDRESS
F A2,PK22;
M A2,CPI; AND CURRENT PART INDEX
F A2,(A1);
M A2,CSI; AND CURRENT STEP INDEX
SETZM PK35; INHIBIT STEP ADVANCE
J X52.1;
SUBTTL V13 DEMAND
V13: SKIPN MODE;
PJ E1; INDIRECT ONLY!
JSP B,P40; COMPILE LHS
PJ E5; NO LHS.
F A1,US2
M A1,SXX
SETZM BFR
CAMN CC,T51.28 ;IS IT DEMAND AS
J V13.4 ;YES
CE CC,U3; EXPECTED ENDING?
PJ E5; NO
V13.Y: F A1,(DS); LINK TO LHS
PJ S63X; EXPAND IT.
F CC,(DS);
F CC,(CC); LHS DICTIONARY ENTRY
F CC,(CC); ENTRY ITSELF
F A,US2;
PJ S70G; GENERATE LHS FOR TYPE LINE
PJ S70D; GENERATE INDENTATION
M A1,U5;
SKIPN BFR
J V13.1
MOVE B,US2
HRRI B,BFR
MOVEM B,US2
MOVEI B1,QUOTE
PJ S57
V13.1: SOS LINE; ADJUST LINE COUNTER DOWN!
PJ S60; REFRESH CONSOLE
JSP B,X48; SEND TO USER
XWD 0,U5;
XWD 0,US2;
XWD 0,K23;
DEC -1;
F A,SXX ;GET RIGHT HEADER BACK
M A,US2
MOVEI A,3;
HRLM A,ME;
SETZM RETURN;
JRST SU;
V13X: SKIPE UP1; RE-ENTER WITH LINE IN US1
JRST V13.2;
SKIPE UP2;
J V13.1; DEAD LINE; DO IT AGAIN.
JRST X47.1;
V13.2: SETOM U2; NOTE DEMAND RESPONSE.
SKIPE UP3; TRANSMISSION ERROR?
PJ E48; YES
F B1,T51.5; EXPECTED ENDING IS EOS
LDB CC,UP2; IS IT?
CAIE CC,DOT;
J .+4; YES
FI CC,PERIOD; DOT BECOMES PERIOD
DPB CC,UP2;
F B1,T51.8;
M B1,U3;
F B1,US1;
M B1,U1;
SETZM UP0; DON'T MESS WITH UC/LC FOR LETTERS.
PJ S54; COMPRESS THE LINE.
F B1,SK3;
JE B1,.+2; CONDITIONAL CLAUSE?
PJ E5; YES
PAGE
V13.3: SETOM MODE; SET UP TO MERGE WITH "SET"
F B1,US2;
M B1,U1;
JSP B,P40; LHS
PJ E54; NONE; SOMETHING FISHY!
F B1,US1;
M B1,U1;
J V1.2; MESH WITH SET INTERPRETER.
V13.4: INVOKE P52
CE CC,T51.10 ;QUOTE MARKS
PJ E5 ;NO
SETOM BFR ;SIGNAL
J V13.Y
EXTERNAL SXX
SUBTTL V14 FORM
V14: HRRZM CC,U2; SAVE VERB TYPE.
SKIPE MODE;
SKIPE UDF1;
J .+2;
PJ E5; EH IF INDIRECT AND NOT FROM DISC.
LDB CC,UP2;
CAIE CC,COLON; IS LAST BYTE A COLON?
PJ E5; NO
PJ S50; LOOK AT NEXT BYTE
F CC,T51(CC);
CE CC,K19; SPACE-LIKE?
PJ E5; NO.
V14Z: JSP B,P49; YES; EVALUATE EXPRESSION.
CE CC,T51.14; FOLLOWED BY COLON?
PJ E5; NO
PJ S50; NEXT BYTE
CAIE CC,EOS; EOS?
PJ E5; NO
INVOKE P53; POP RESULT
TVJNF;
CALL S78; CONVERT TO IP, FP
PJ E27; BAD FORM NR.
JE A,.+2;
PJ E27; NON-INTEGRAL!
M A1,UP10; SAVE FORM NR.
V14.3: PJ S60; REFRESH CONSOLE
SETOM UDF2; NOTE AWAITING FORM.
SKIPE UDF1; IN DISC ACTION?
J D60.1; TO RECALL ROUTINE
FI A1,2;
HRLM A1,ME;
SETZM RETURN;
SETOM FORMFG
JRST SU; SWITCH TO USER
V14X: SETZM UP0;
SKIPE UP3; TRANSMISSION ERROR?
PJ E48; YES
F A,US1;
M A,U1;
PJ S54; COMPRESS THE LINE
PJ P51Y; ENUF SPACE?
PAGE
V14Y: F A2,UP10; YES
HRRZI A1,FORMS;
PJ P70L; SEARCH FOR FORM
J V14.1; NO SUCH FORM
HRRZ B,1(A); LINK TO FORM ITSELF
PJ P62; DELETE IT
J V14.2;
V14.1: M61 HRLM,A1,A2,A ;INSERT FORM HEADER
HRLZS 1(A); TIDY UP.
V14.2: HRRM ACL,1(A); STRING TO USER BLOCK.
F A,ACL;
F A1,US1;
M A1,U1;
SETOM FORMFG
PJ S56;
SETZM FORMFG
HRRZ ACL,1(A); TIDY UP
HLLZS 1(A);
J V0;
SUBTTL V15 QUIT
V15: PJ S68; TO NEXT NON BLANK.
CE CC,U3; EXPECTED ENDING?
PJ E5; NO
SKIPE MODE; YES; IN DIRECT MODE?
J X57; NO; POP JOB AND GO.
LDB A,BYTE6; YES; ANYTHING TO DO?
JN A,.+2;
PJ E39; NO; SAY SO.
PJ P72A; YES; POP JOB
SKIPE A,MODE;
DPB A,BYTE10; FIX SKIP-CODE IF INDIRECT.
SETZM MODE; FORCE RETURN TO USER.
J X57.1; AND TELL HIM WERE WE ARE.
SUBTTL V16 -- RESET TIMER
V16: INVOKE P51; FOLLOWED BY "TIMER"?
CE CC,T51.35;
PJ E5; NO
INVOKE P51;
CE CC,U3; AND EXPECTED ENDING?
PJ E5; NO
F A,SECONDS;
M A,USEC;
J X52;
SUBTTL ROUTINES FOR LARGE SYNTACTIC TYPES
INTERN P49,P42,P40,P39,P38,P37;
INTERN P38E,P38L,P38X,P36,P35,P42L;
SUBTTL P49 -- EXPRESSIONS
; JSP B,P49
P49: HRL CC,B; CC = (CALLER; BACKSTOP CODE)
HRR CC,K10; THEN ENTER CONTEXT I
; CONTEXT I: EXPECTING 'OPERANDS', LEFT GRPRS.,
; ABVAL BARS, UNARY OPERATORS
P49.1: INVOKE P52;
LDB B2,BYTE4; B2 = CLASS(CC)
XCT P49.2(B2); ACT ON IT
P49.2: J P49.6; LETTER
J P49.71; LIT. OR FCT.
J P49.1; ([
J P49.1; ABVAL
J P49.3; ARITH
J P49.5; 'NOT'
PJ E5; EH
PJ E5;
PJ E5;
J P49.21; MAY BE UNDERSCORE OR SYSTEM WORDS.
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
P49.21: HLLZ B2,CC;
CE B2,K40; UNDERSCORE OR SYSTEM ATTRIBUTE?
PJ E5; NO
HRL CC,TYPE13; YES; COMPOSE DESCRIPTOR
F A,CC;
P49.22: M53 A,DS,E7; SAVE IN USER BLOCK
P49.23: INVOKE P51;
LDB B2,BYTE4; IS NEXT AN OPERATOR?
CAIG B2,3;
J P48.1+1; NO; TO CONTEXT II
CAIL B2,10;
J P48.1+1;
PJ E5; YES -- NO GO!
PAGE
P49.3: CN CC,T51.1; PLUS SIGN?
J P49.4; YES
CE CC,T51.2; MINUS SIGN?
PJ E5; NO; EH
P49.4: F CC,T54(CC); OK; CC = UNARY ASSOCIATE OF CC
J P47; TO CONTEXT III
P49.5: INVOKE P52;
LDB B2,BYTE4; CLASS OF NEXT TERM. CHAR.
CAIE B2,1; IS IT A LITERAL?
JRST P47.1; NO; SLIDE INTO CONTEXT III
SN B1; LEADING SPACES
PJ E5; NO; EH
XCT P49.2(B2); YES; WE ARE IN CONTEXT I.
P49.6: F A,(CC); A = DICT. DESCRIPTOR
HLRZ B2,1(CC);
CAME B2,LEVEL; DEFINED AT THIS LEVEL?
J P49.62; NO
P49.61: LDB B2,BYTE2; GET OBJECT TYPE
XCT P49.7(B2); SWITCH ON IT.
J P49.9; RETURN HERE IF TV AND ALLOWED.
P49.62: CAME B2,BASE; DEFINED AT BASE LEVEL?
J P49.64; NO
P49.63: HRRZ CC,1(CC); YES; USE THE FIRST SUCH.
JE CC,P49.61;
HLRZ B2,1(CC);
CAME B2,BASE;
J P49.61;
F A,(CC);
J P49.63;
P49.64: CAMG B2,BASE; DEFINED AT LOWER BASE?
PJ E6; YES; NOT DEFINED.
HRRZ CC,1(CC); NO; GET NEXT ON LETTER'S PDL.
HLRZ B2,1(CC); DEFINING LEVEL.
JN CC,.+2; IS THIS THE LAST ON LETTER'S PDL?
PJ E6; YES; NOT DEFINED.
F A,(CC); NO; FETCH DESCRIPTOR.
J P49.62; AND KEEP LOOKING.
P49.7: J P49.9; TV
J P49.9; JNF
J P44; ARRAY
J P41; FORMULA
J P44F; FCT
J P36; FCTL
PJ E6; UNDEFINED
PJ E4;
PJ E4;
PJ E4;
PJ E4;
PJ E4;
J P49.22; UNDERSCORES, SIZE, TIME; USERS
PJ E4;
PJ E4;
PJ E4;
PAGE
P49.71: LDB B2,BYTE5; B2 = TYPE WITHIN CLASS OF CC
HRL A,B2;
HRR A,CC; A = OBJECT DESC. FOR CC
XCT P49.72(B2); ACT ON TYPE
J P49.9; RETURN HERE IF TV AND ALLOWED
P49.72: TVTEXT ; TV
J P49.73; JNF
PJ E5; ARRAY
PJ E5; FORMULA
J P44F; FUNCTION
J P36; FCTL.
J P49.74; DOLLAR SIGN
J P49.73; TIMER
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
P49.74: F A1,(CC);
SETZ A2,0;
CALL S81; CONVERT ACTIVE LINE CTR TO JNF
J P49.8;
P49.73: F A1,(A); FETCH DP
F A2,1(A); AND XP
TLNE A1,600000;
PJ E24; TOO MANY SIG. DIGS.
P49.8: M56 A1,A2,E3; STORE JNF
HRR A,A2; A = LINK TO STORED COPY
HRL A,TYPE2; A = JNF DESCRIPTOR
PAGE
P49.9: M53 A,DS,E7; PUSH ONTO DS AND ENTER CONTEXT II
; AND ENTER CONTEXT II.
PAGE
; CONTEXT II: EXPECTING OPERATORS AND 'RIGHT GRPRS.'
P48: INVOKE P51;
P48.1: LDB B2,BYTE4; B2 = CLASS(CC)
XCT P48.2(B2); ACT ON IT
PJ E5;
P48.2: JN B1,P48.3; LETTER
JN B1,P48.3; LITERALS; ET ALL
J P48.3; LEFT GRPR.
J P48.3; ABVAL
J P48.5; ARITH
JN B1,P48.3; 'NOT'
JN B1,P48.5; LOGIC; OK IF SPACE LED
J P48.5; RELATION
J P48.3; RT. GRPRS., ETC.
JN B1,P48.3; WORDS; OK IF SPACE-LED
PJ E5; EH
PJ E5;
PJ E5;
PJ E5;
PJ E5;
PJ E5;
P48.3: M B1,UB1; HOLD SPACE COUNT
SETZM U4; WEIGHT=0
XCT T56(CP); FIRE CURRENT PROCESS
P48.5: HRRZ B2,T53(CC);
M B2,U4; WEIGHT = RIGHT WEIGHT OF CC.
P48.6: HLRZ B2,T53(CP); B2 = LEFT; WEIGHT OF CP
CGE B2,U4; LEFT WEIGHT OF CP < WEIGHT?
XCT T55(CC); YES; LEAVE CONTEXT II UNDER CC'S CONTROL
XCT T56(CP); NO; FIRE CP.
PAGE
; CONTEXT III: LIKE CONTEXT I, BUT NO UNARY OPS
P47: INVOKE P52;
P47.1: LDB B2,BYTE4; B2 = CLASS (CC)
CAILE B2,3;
PJ E5; EH IF NOT ALLOWED
XCT P49.2(B2);
; CONTEXT IV: LIKE III, BUT ACCEPTS + -
P46: INVOKE P52;
P46.1: LDB B2,BYTE4;
CAILE B2,4;
PJ E5;
XCT P49.2(B2);
; CONTEXT V: LIKE I BUT DEMANDS SPACES
P45: INVOKE P52;
SN B1;
PJ E5; EH IF NO SPACES
LDB B2,BYTE4;
XCT P49.2(B2);
SUBTTL P44, P44F -- ARRAYS AND FUNCTIONS
; ARRAYS
P44: PJ P55; DOES LEFT GRPR FOLLOW HARD?
J P49.22; NO; MAY BE OKAY.
JSP B,P42; FETCH GROUPED ITEMS TO DS,T48=ITEM COUNT
M A,PK8; HIDE OBJECT'S DESCRIPTOR
PJ P61; PEEL INDEX VALUES OFF DS TO T48.
F A,PK8; RESTORE THE DESCRIPTOR
HLRZ B1,1(A); FETCH DIMENSION
CE B1,T48; DOES IT = ITEM COUNT
PJ E10; NO
PJ P56; SEARCH FOR ARRAY ELEMENT
J P44.2; NOT FOUND; MAY BE SPARSE.
F A1,(A); A1 = DP
HLR A2,1(A); A2 = PACKED XP
PJ P57Z; CONVERT EXP., STORE IF JNF; DESC. TO A
J P49.9;
P44.2: F A,PK8;
TLNN A,SPARSE; SPARSE?
PJ E10;
SETZB A1,A2; YES; USE A ZERO AS VALUE
J P49.8; TO CONTEXT II AFTER STORING.
; FUNCTIONS
P44F: PJ P55; AS FOR ARRAYS!
J P49.22; NO; MAY BE OK
JSP B,P42;
M A,PK8;
P43: HLRE B1,T47.1(A); B1 = ARG. COUNT
CE B1,T48; DOES IT MATCH ITEM COUNT?
JGE B1,P43.1 ;NO BUT OK IF B1<0 (FUNCTIONALS)
HRR B1,T47(A); B1 = FCT. EVALUATOR
PJ (B1); FIRE IT
J P49.9; TO END OF CONTEXT I
P43.1: PJ E11;
SUBTTL P41 -- FORMULAS
P41: HLRZ A1,1(A); A1 = ARG. COUNT
JN A1,P41.1; ANY PARAMETERS?
SETZM T48; PICK UP BELOW IF NO ARGS
AOS LEVEL;
J P41.6;
P41.1: PJ P55; FOLLOWED HARD BY LEFT GRPR?
J P49.22; NO; MAY BE OK
JSP B,P42; YES; FETCH ACTUAL PARAMS.
M A,PK8; HOLD DESCRIPTOR
HLRZ A1,1(A); DO COUNTS MATCH?
CE A1,T48;
PJ E22; NO
HLRZ A1,(A); LINK TO DLS
SUBI A1,1;
HRLI A1,41000; POINTER TO DLS
EXCH A1,U1; HOLD STATEMENT POINTER.
FI B2,1; PREPARE TO GET DLS DESCRIPTORS
P41.2: INVOKE P51; NEXT DL DESCRIPTOR
TLNE CC,777777; BETTER BE A LETTER!
PJ E5; IT ISN'T.
M CC,T48(B2); SAVE IT
CE B2,T48; DONE?
AOJA B2,P41.2; NO
M A1,U1; RESTORE STATEMENT POINTER
F B1,B2;
HRRZI B2,DS-1; PREPARE TO REPLACE PARAMS.
AOS LEVEL; UP THE LEVEL!
; PUSH DUMMY ENTRIES WITH ACTUAL PARAMS
; REPLACE PARAMS ON DS WITH DUMMY ENTRY DESCRIPTORS
P41.3: F B2,1(B2); LINK TO NEXT ON DS
F A,T48(B1); NEXT FORMAL PARAM. DICT.ADDRESS
PJ P58; PUSH DICT. ENTRY
F A2,(B2); NEXT ACTUAL PARAM. DESCRIPTOR
LDB A1,BYTE3; A1 = ITS TYPE
CLE A1,TYPE4; IS IT DEFINITELY NON-VOLATILE
J P41.5; YES
JE A1,P41.5; TV'S ARE NOT VOLATILE
P41.4: HRRZ A1,1(A2); INC. USE COUNT
ADDI A1,1;
HRRM A1,1(A2);
P41.5: LDB A1,BYTE12; A1 = LETTER BYTE FROM DICT ENTRY
M A2,(A); ACT. PARAM DESC TO DICT
TLNN A2,IDMC;
DPB A1,BYTE12; WITH PROPER IDENTIFICATION
HRL A,TYPE7; DUMMY LETTER DESCRIPTOR
M A,(B2); DICT ADD. TO DS STACK
SOJG B1,P41.3; CONTINUE IF MORE
F A,PK8 ;A = FORMULA DESCRIPTOR
PAGE
P41.6: F A2,U1; HOLD POINTER
INVOKE P51; NEXT CHARACTER.
LDB B2,BYTE4; ITS CLASS
CAIG B2,11; ACCEPTABLE?
J .+1(B2); MAYBE
PJ E5; LETTER
PJ E5; LITERALS ET ALL
J P41.7; LEFT GRPRS.
J P41.7; ABVAL
J P41.7; ARITH
PJ E5; NOT
JE B1,.-1; LOGIC
J P41.7; RELATION
J P41.7; RT. GRPR.
JE B1,.-4; WORDS
P41.7: HLRZ A1,A; LETTER BYTE
TRZ A1,IDM; POSITIONED
IOR A1,T48; WITH COUNT.
F B,FPDL;
HRL B,A1; TO FPDL WITH POINTER
M53 A2,B,E3;
HRRZM B,FPDL; UPDATED PDL
AOS U6;
HRRZ A1,(A); LINK TO FORMULA
SUBI A1,1;
HRLI A1,41000; POINTS TO FORMULA
M A1,U1;
JSP B,X47; ACKNOWLEDGE RECALLS AND IN-REQU
OCT 5; CONTROL STATE IF RECALLED
P41.8: JSP B,P49; EVAL. FORMULA
CE CC,T51.5; DELIMITED BY EOS?
PJ E5; NO
F A1,FPDL; YES;
M52 A1,B; POP POINTER
M B,U1;
HLRZ B2,A1; AND COUNT
TRZ B2,IDMC;
HRRZM A1,FPDL;
SOS LEVEL; DROP LEVEL.
SOS U6;
PAGE
M52 DS,A; POP RESULT DESCRIPTOR.
SETZM PK5; NO-PARAMS FLAG.
JE B2,P49.61; RE-ENTER CONTEXT 1 IF NO PARAMS
M A,PK5; HOLD DESCRIPTOR WHILE POPPING PARAMS
HRRZS A ;***RHS OF A FOR COMPARE
CAIGE A,USER0 ;***IN USER'S BLOCK?
J P41.9; NO
HRRZ A1,1(A);
ADDI A1,1;
HRRM A1,1(A); INCREMENT USE-COUNT.
P41.9: M52 DS,A; NEXT PARAM DESCRIPTOR
PJ P69; DELETE AND POP ENTRY.
SOJG B2,P41.9; CYCLE
F A,PK5 ;RESTORE DESCRIPTOR OF RESULT
HRRZ B2,PK5 ;***IN USER'S BLOCK?
CAIGE B2,USER0;***
J P41.10; NO
HRRZ A1,1(A);
SUBI A1,1;
HRRM A1,1(A); DEC. USE CNT.
JN A1,P41.10;
TLZ A,IDMC; ZERO ID IF ZERO USE COUNT
P41.10: J P49.61; RE-ENTER CONTEXT 1.
SUBTTL P42 -- COLLECT GROUPED ITEMS
; JSP B,P42; CC=LEFT GRPR, A=DESC.
P42: HRL B,B;
HRR B,K10; B=(CALLER; BACKSTOP CODE)
M53 B,PS,E3; STACK IT
M53 CP,PS,E3; STACK CP
M53 A,PS,E3; STACK CONTROLLING DESC.
HRRZ CP,CC ;CP=(COUNT=0; LEFT GRPR CODE)
P42.1: JSP B,P49; EVAL. NEXT ITEM
ADD CP,K4; INC. COUNT
CN CC,T51.4; IS CC A COMMA?
J P42.1; YES
CN CC,T54(CP); MATCHING RIGHT GROUPER?
J P42.3; YES
P42.2: TLNE CP,777776; FIRST ARGUMENT?
PJ E5; NO
JSP B,P35; TRY FOR CONDITIONAL EXPRESSION.
P42.3: HLRZM CP,T48; SAVE COUNT.
M52 PS,A;
PAGE
P42.4: M52 PS,CP; RESTORE CP
M52 PS,B;
HLR B,B;
J (B);
SUBTTL P42L -- COLLECT LIST OF GROUPED ITEMS
P42L: HRL B,B;
HRR B,K10; SAVE CALLER
M53 B,PS,E3;
JSP B,P42; COLLECT GROUPED ITEMS ON DS
F B,T48;
CAIN B,1; SINGLE ITEM?
J P42L.2; YES
HRRZ B1,DS; PEEL OFF DS ONTO SEPARATE LIST.
P42L.1: F B2,B1;
HRRZ B1,1(B2);
SOJG B1,P42L.1;
XCH B1,DS;
HRRZS 1(B2);
HRL B1,TYPE22; COMPOSE DESCRIPTOR
HRLZ B2,T48; WITH COUNT.
ASH B2,4;
IOR B1,B2;
M53 B1,DS,E7;
P42L.2: M52 PS,B;
HLR B,B;
J (B);
SUBTTL P40 -- COMPILE LEFT HAND SIDE
; JSP B,P40
; RETURN IF NO LHS; POINTER RESTORED
; NORMAL RETURN
P40: MOVE A,U1 ;HOLD POINTER
HRL CC,B;
HRR CC,K10 ;(CALLER; BACK-STOP CODE)
INVOKE P52; PUSH CP.,ETC
TLNN CC,777777; IS IT A LETTER?
JRST P40.4; YES
MOVEM A,U1; NO; RESTORE POINTER
JRST P40.5; AND LEAVE.
P40.4: ADD CP,K4; FIX FOR NORMAL RETURN
MOVE A,CC; SAVE TERM. CHARACTER.
PUSHJ CR,P55; IS NEXT A HARD LEFT GROUPER.
JRST 0,P40.3; NO
JSP B,P42; YES--FETCH GROUPED ITEMS TO DS.
MOVEM A,PK14; SAVE DESC.
PUSHJ CR,P61; PEEL OFF ITEMS AS INDICES;
HRLZ A,TYPE8; AND SET UP LHS DESC. IN A
HRRZ B1,T48; ITEM COUNT
CLE B1,K29;
PJ E8; TOO MANY ITEMS.
P40.1: MOVE A1,T48(B1); I-TH ONE
M53 A1,A,E7; TO LHS PDL
HRL A,TYPE8; REFRESH TYPE
SOJG B1,P40.1; CYCLE TEST.
HRL A1,T48;
HRR A1,PK14; COUNT; DICT. ADDRESS
P40.2: M53 A1,A,E7; TO LHS PDL
HRL A,TYPE8;
INVOKE P51; DELIMITING CHARACTER
HLR B,CP; RESTORE CALLER
M52 PS,CP; AND ORIGINAL STATE.
PAGE
M53 A,DS,E7; STACK LHS DESC.
J (B); FINI
P40.5: HLR B,CP; RESTORE CALLER.
M52 PS,CP; RESTORE ORIG. STATE
JRST 0,(B); FINI.
P40.3: HRRZ A1,A; (COUNT=0V-TABLE ADDRESS)
HRLZ A,TYPE8; EMPTY LHS DESCRIPTOR
JRST 0,P40.2;
SUBTTL P39 -- COMPILE FOR-CLAUSES
; JSP B,P39
P39: HRL CC,B;
HRR CC,K10; (CALLER; BACK-STOP CODE)
M53 CP,PS,E3; PUSH CO
MOVE CP,CC; CP=CC
JSP B,P40; FIRST GET LEFT-HAND-SIDE
PJ E5; NO LHS
CAME CC,T51.6; IS CC AN EQUAL SIGN?
PJ E5; NO; EH.
HRLZ A,TYPE9; A = ROV HEADER
M53 A,DS,E3; TO DS.
JSP B,P49; EVAL. FIRST PHRASE
P39.0: J P39.10;
P39.1: JSP B,P49; EVAL. NEXT PHRASE
P39.10: PUSHJ CR,P63; TACK ONTO ROV LIST
P39.11: HLRZ B1,CC; IS CC
CAIE B1,2; A LEFT:GROUPER
JRST 0,P39.2; NO
JSP B,P42; YES--FETCH GROUPED LIST
SOSE 0,T48; IS COUNT=1
PJ E5; NO; EH
JSP B,P49; OK--EVAL NEXT PHRASE
INVOKE P54; POP/TEST FINAL VALUE OF ROV
TVJNF;
INVOKE P53; POP/TEST INCREMENT
TVJNF;
MOVEM A1,PK15; SAVE IT
MOVEM A2,PK16;
HLR A,1(DS); NOW FETCH INITIAL VALUE
MOVE A1,(A); OF ROV
HLRZ A2,1(A);
CAME A2,MASK9; TV?
J .+3; NO
TVJNF; YES - VALID?
SETZ A2,0; YES; ADJUST EXPONENT
PAGE
PUSHJ CR,P57Y; UNPACK EXP.
CALL S76; AND COMPARE WITH FINAL VALUE
JUMPE A,P39.11; RESULT IN A--FINI IF EQUAL
XOR A,PK15; IS INCREMENT COMPATIBLE
TLNN A,400000; WITH INITIAL AND FINAL VALUES?
PUSHJ CR,E23; NO
MOVE A1,PK15; YES; FETCH INCREMENT
MOVE A2,PK16;
JUMPN A1,.+2;
PJ E23; ZERO INCREMENT NOT ALLOWED HERE.
PUSHJ CR,P63X; TACK ON INCREMENT
MOVE A1,B1;
MOVE A2,B2;
PUSHJ CR,P63X; TACK ON FINAL VALUE
JRST 0,P39.11;
P39.2: HLRZ B1,1(DS); FLAG LAST ELEMENT
HRLZI B2,400000; AS END OF RANGE ITEM
IORB B2,1(B1);
HLRZ B2,B2;
TRZ B2,400000; LOOK AT EXP PART
CAMN B2,MASK9; TV?
TVSET; YES; TEST VALIDITY.
CAMN CC,T51.4; IS CC A COMMA
JRST 0,P39.1; YES--CONTINUE
; NO::LHS + ROV BECOMES FOR-CLAUSE
MOVE B1,DS; SAVE POINTER TO ROV DESC.(ATOP DS)
HRRZ DS,1(DS); POP IT WITHOUT RELEASING SPACE.
MOVE B2,(DS); POINTER TO LHS.(NOW ATOP DS)
HRLM B2,(B1); JOINS ROV POINTER TO MAKE FOR-CLAUSE HEADER
HRRM B1,(DS); DS TOP BECOMES FOR-CLAUSE DESC.
MOVE B1,TYPE10;
HRLM B1,(DS);
HLR B,CP; GET CALLER
M52 PS,CP; RESTORE ORIG.STATE
JRST (B); DONE.
SUBTTL P38E -- LOOKING FOR PART OR STEP SPEC.
; BEHAVES LIKE P38
P38E: HRRZM B,UX1;
INVOKE P51; WHAT IS NEXR?
HLRZ A1,CC;
CAMN CC,T51.25; STEP?
J P38.0; YES
CAMN CC,T51.26; PART?
J P38.0; YES
JRST @UX1; NO
SUBTTL P38L -- LOOKING FOR "ITEM-LIST", ETC.
; BEHAVES LIKE P38
P38L: HRRZM B,UX1;
INVOKE P51; WHAT IS NEXT?
HLRZ A1,CC;
CAMN A1,TYPE15; SINGULAR NOUN?
J .+3; YES
P38L.1: F B,UX1;
J 1(B); NO SOAP.
HRRZM CC,PK36; SAVE OBJECT CODE
INVOKE P51;
CAME CC,T51.2; FOLLOWED BY DASH?
J P38L.1; NO
JN B1,P38L.1; NO LEADING SPACES
INVOKE P51;
CE CC,T51.30; "LIST"?
J P38L.1;
JN B1,P38L.1;
INVOKE P51;
J @UX1; FOUND - CODE IN PK36
SUBTTL P38--LOOKING FOR OBJECTS-OF-DISCOURSE
; JSP B,P38
; RETURN IF FIRST TERM. CHAR. SEZ NO OOD (CC=CHAR.)
; RETURN WITH OOD COMPILED
; PK36 = OOD CODE
; PK37,38 = OBJECT NR IF APPLICABLE
; PK39 = LINK TO HEADER PREDECESSOR,LINK TO HEADER
; PK40 = LINK TO PART PREDECESSOR,LINK TO PART
P38: HRRZM B,UX1;
INVOKE P51; NEXT CHAR.
HLRZ A1,CC; WUAT DO WE HAVE?
CN CC,T51.32; "FORMULA"?
J P38F; YES; TREAT INDIVIDUALLY.
CAMN A1,TYPE15; SINGLETONS?
J P38.0; YES
CAMN A1,TYPE17; "ALL" ?
J P38.0; YES
J @UX1; CAN NOT BE OOD
P38.0: SETZB A2,PK36; CODE FOR "ALL"
SETZM PK37;
SETZM PK38;
CAMN A1,TYPE15;
J P38.1; SINGLETONS
INVOKE P51; CC = NEXT TERM. CHAR
CN CC,U3; DONE IF CC IS EXPECTED ENDING
JRST P38.9;
CN CC,T51.4; OR COMMA.
J P38.9;
JUMPN B1,.+2; SPACES?
PJ E5; NO, EH.
HLRZ A1,CC; IS CC A PLURAL NOUN
CAME A1,TYPE16;
J P38.9; NO; DONE.
HRRM CC,PK36; YES; SAVE OOD DESC.
INVOKE P51; FETCH NEXT TERMINAL CHARACTER
JRST P38.9; AND DONE.
P38.1: ADD CC,K22;
HRRM CC,PK36; OOD CODE = CODE + SINGULAR OFFSET.
HRRZ CC,CC; IS THIS A
SUB CC,K22; REASONABLE PHRASE?
CAILE CC,3;
PJ E5; INADMISSIBLE.
MOVE B2,U1; SAVE POINTER
INVOKE P51; CC = NEXT TERM. CHARACTER
JUMPN B1,.+2; SPACES?
PJ E5; NO, EH.
HLRZ A2,CC;
CE A2,TYPE12; IS CC A JNF LITERAL?
JRST P38.2; NO
F A1,PK4; YES; FETCH DP
F A2,PK5; AND XP.
INVOKE P51; LOOK AT NEXT TERM. CHAR.
PAGE
LDB A,BYTE4;
CE A,TYPE14; A WORD?
J .+3; NO
JN B1,.+6; MUST HAVE LEADING SPACES.
PJ E5;
CN CC,T51.4; A COMMA?
J .+3; YES
CE CC,U3; EXPECTED ENDING?
JRST P38.2; NO
JUMPGE A1,P38.3; TOO MANY DIGITS?
PJ E24; YES.
P38.2: HRRZ A,PK36; OOD CODE
HRL A,TYPE11;
DPB A,BYTE16; OOD DESC.
HLLZ A,A;
M53 A,DS,E3; ON DS
MOVEM B2,U1; RESTORE POINTER
JSP B,P49; EVALUATE EXPRESSION.
INVOKE P53; POP/TEST RESULT.
TVJNF ;
M52 DS,A; OK -- RESTORE
LDB A,BYTE16; OOD CODE
M A,PK36; RESTORED
P38.3: MOVEM A1,PK37; SAVE OBJECT NR
MOVEM A2,PK38;
PJ P70; LOOK FOR OBJECT
PJ E32; BAD OBJECT NR.
PJ E31; CAN NOT FIND IT.
P38.9: F B,UX1;
J 1(B);
SUBTTL P38X -- COMPILE OOD AND DESCRIPTOR
P38X: HRRZM B,UX3;
F A,U1; HOLD PTR.
JSP B,P38; OOD?
J P38X.2; NO
HRR A,PK36; OOD CODE
HRL A,TYPE11;
DPB A,BYTE16;
HLLZ A,A; OOD DESC.
SKIPN PK37; OBJECT NR.?
J P38X.1; NO
F A1,PK37;
HRLZ A2,PK38;
M55 A1,A2,E3; COPY IN USER'S BLOCK
HRR A,A2;
P38X.1: M53 A,DS,E7; DESC. ONTO DS
F B,UX3;
J 1(B);
P38X.2: M A,U1; RESTORE POINTER
J @UX3;
SUBTTL P38F--EXPLICIT EXPRESSIONS FOR FORMULAS
P38F: INVOKE P51; NEXT CHARACTER
TLNE CC,777777; IS IT A LETTER
PJ E5; NO; EH.
HRRZM CC,PK37; DICTIONARY ADDRESS
MOVE A,(CC); LOOK AT ENTRY
HLRZ A1,1(CC);
CAME A1,LEVEL; DEFINED AT THIS LEVEL?
PJ E6; NO
LDB A1,BYTE2;
CAMN A1,TYPE6;
PJ E6; NO
CAME A1,TYPE4; IS IT A FORMULA
PJ E5; NO.
INVOKE P51; YES; FETCH NEXT TERM. CHAR.
FI A,13;
M A,PK36; CODE FOR FORMULA
F B,UX1; FINI
J 1(B);
SUBTTL P37--COMPILE LEFT SIDES FOR DELETION
P37: HRRZM B,UX1;
PUSH CR,U1; HOLD POINTER.
INVOKE P51; NEXT CHAR.
TLNE CC,777777; LETTER?
PJ E5; NO
F A,(CC); DICT. ENTRY
HLRZ B2,1(CC); DEFINED AT THIS LEVEL?
CAME B2,LEVEL;
PJ E6; NO; NOT DEFINED!
LDB B2,BYTE2; TYPE
CAMN B2,TYPE6;
PJ E6;
MOVEM CC,PK8; SAVE DICTIONARY ADDRESS
CAMLE B2,TYPE4; ACCEPTABLE?
PJ E5; NO
J .+1(B2); WHAT HAVE WE?
J .+3; TV
J .+2; JNF
J P37.1; ARRAY
INVOKE P51; FORMULA... GET NEXT CHARACTER
HRR A,PK8;
HRL A,TYPE21; DESC. FOR ASSIGNMENT ADDRESS
M53 A,DS,E3; ONTO DS
POP CR,A;
J @UX1;
P37.1: POP CR,U1; RESTORE POINTER
JSP B,P40; COMPILE LHS
PJ E5; NONE
PUSH CR,CC; HOLD DELIMITING CHARACTER
F A1,(DS); LINK TO LHS
PJ S63X; EXPAND IT
F A1,(DS);
F A1,(A1); DICT ADDRESS OF LHS
HRRZM A1,PK9;
F A,(A1); DICT. ENTRY
M A,PK8;
SKIPN T48; ANY SUBSCRIPTS?
J P37.2; NO
HLRZ B2,1(A); YES; DOES DIM. = NR OF SUBSCRIPTS?
CE B2,T48;
PJ E10; NO
PJ P56; DOES ELEMENT EXIST?
PJ E10; NO
PAGE
F CC,U2;
CAIN CC,4; FILING?
J P37.2; NO
F A1,(A); YES; FETCH COMPONENT
HLR A2,1(A);
PJ P57Z; CONVERT EXP.,STORE IF JNFDESC. TO A
XCH A,(DS); STACK BELOW LHS DESC.
M53 A,DS,E7;
P37.2: POP CR,CC; RESTORE DELIMITER
J @UX1;
SUBTTL P36 -- FUNCTIONALS
; REGISTER "A" CONTAINS DESCRIPTOR OF FUNCTIONAL
P36: PJ P55; DOES LEFT GROUPER FOLLOW HARD?
J P49.22; NO; BUT MAY BE OK
M53 CP,PS,E3; YES; PUSH CP TO SAVE:
HRL CP,A; FUNCTIONAL CODE AND
HRR CP,CC; GROUPER CODE.
F A,U1;
HLRZ A1,CP;
CAIE A1,4; "FIRST"?
J P36.01; NO
M53 A,PS,E3; YES; SAVE POINTER
J P36.0;
P36.01: INVOKE P51; NEXT TERMINAL CHAR.
TLNN CC,777777; LETTER?
J .+3; YES
M A,U1; NO; RESTORE POINTER
J P36.9; ASSUME LIST OF ITEMS.
PJ P55; FOLLOWED HARD BY LEFT GROUPER?
J P36.11; NO
F A1,CC; YES; HOLD THE GROUPER
FI A2,1; START GROUPER-LEVEL COUNT
P36.10: INVOKE P51; NEXT TERMINAL CHAR.
CN CC,U3; EXPECTED ENDING?
PJ E5; YES; EH.
CN CC,T51.5; EOS?
PJ E5; YES
LDB B2,BYTE4; CLASS OF NEXT TERM. CHAR.
CAIE B2,2; LEFT GROUPER?
J .+2; NO
AOJA A2,P36.10; YES; KEEP GOING
CAIE B2,10; RIGHT-GROUPER CLASS?
J P36.10; NO; KEEP GOING
TRNE CC,777776; RIGHT GOUPER?
J P36.10; NO
SOJG A2,P36.10; DECREMENT COUNT
CE CC,T54(A1); BASE LEVEL; MATCH?
PJ E12; NO
P36.11: INVOKE P51; LOOK AT NEXT TERM. CHAR.
M A,U1; RESET POINTER
CN CC,T51.6; IS NEXT AN EQUAL SIGN?
J P36.0; YES; ASSUME RANGE OF VALUES
PAGE
P36.9: HRR CC,CP;
HRLI CC,10; CC DESCRIBES LEFT GROUPER
HLRZ A,CP;
LSH A,1;
ADDI A,T47.2-T47;
HRL A,TYPE5; A DESCRIBES APPROPRIATE FUNCT.
M52 PS,CP; RESTORE CP
JSP B,P42; COMPILE GROUPED LIST
M A,PK8; SAVE FUNCTION DESC.
J P43; AND FIRE THE FUNCTION.
P36.0: JSP B,P39; COMPILE FOR-CLAUSE
CE CC,T51.14; IS IT FOLLOWED BY A COLON
PJ E5; NO
HRR A,(DS);
HLR A,(A); LINK TO LHS
HRRZ A,(A); LHS DICTIONARY ENTRY.
AOS U6;
PJ P58; PUSH IT!
HRL A,TYPE7; DUMMY LETTER DESC.
XCH A,(DS); ONTO DS BEFORE FOR-CLAUSE DESCRIPTOR
M53 A,DS,E7;
F A,U1; FETCH POINTER (POINTS AT COLON)
F B,FPDL; STACK IT ON FPDL.
HLL B,CP; WITH FCTL. CODE
M53 A,B,E3;
HRRZM B,FPDL;
F B,(DS);
HRRZM B,PK29; SAVE LINK TO FOR CLAUSE.
HLRZ A1,CP; FCTL CODE
XCT P36.3(A1); FETCH APPROPRIATE INITIAL VALUES
XCT P36.4(A1);
PJ SP1.2; SAVE INITIAL ACCUMULATORGEN DESC. IN A
PAGE
P36.1: M53 A,DS,E7; STACK THE DESCRIPTOR
P36.2: MOVE A,PK29; FOR-CLAUSE LINK
PJ S63; UNRAVEL LHS AND RHS.
SKIPN PK19; DO NOT ALLOW TRUTH VALUES
TVJNF;
HLRZ A1,CP;
CAIE A1,4; "FIRST"?
J P36.21; NO
F A2,(DS); YES; SAVE ITERATION VALUE
F A1,PK20;
M A1,(A2);
F A1,PK21;
HRLM A1,1(A2);
P36.21: PJ P67; SET LHS TO RHS
PJ E3A; OUT-SIZE
F B,FPDL; NEXT
F B,(B); SET POINTER AT COLON.
M B,U1;
JSP B,X47; ACKNOWLEDGE RECALLS AND IN-REQU
OCT 7;
JSP B,P49; EVALUATE THE EXPRESSION.
CE CC,T54(CP); ENDED BY PROPER RIGHT GROUPER?
PJ E5; NO.
F A,1(DS); YES; FETCH
F A,1(A); LINK TO
F A,(A); FOR-CLAUSE
HRRZM A,PK29; HOLD IT.
PJ P71; ADVANCE FOR-CLAUSE ROV.
HLRZ A,CP;
CAIN A,4; "FIRST"?
J P36.12; YES
INVOKE P54; POP EXPRESSION VALUE
TVJNF ;
INVOKE P53; AND ACCUMULATOR.
TVJNF ;
HLRZ A,CP; FCTL CODE
XCT P36.5(A); FIRE APPROPRIATE OPERATION
HRRZ B1,@PK29; ANY MORE ON ROV?
JN B1,P36.1; YES; KEEP GOING.
PAGE
P36.14: M A,PK29; NO HOLD RESULT DESCRIPTOR
F B,FPDL;
M52 B,A; POP FPDL
HRRZM B,FPDL;
SOS U6;
M52 DS,A;
PJ P69; RELEASE FOR CLAUSE.
M52 DS,A;
PJ P69; POP DUMMY
M52 PS,CP; RESTORE CP
F A,PK29; FETCH RESULT DESCRIPTOR
J P49.9; AND RE-ENTER AT END OF CONTEXT I
P36.3: SETZ A2,0;
SETZ A2,0;
MOVE A2,K5;
MOVE A2,K5;
SETZ A2,0;
P36.4: SETZ A1,0;
MOVE A1,K15;
MOVE A1,K33;
MOVE A1,K31;
SETZ A1,0;
P36.5: PJ SP1;
PJ SP3;
PJ P36.6;
PJ P36.7;
P36.6: CALL S76;
JGE A,SP1.2;
J P36.8;
P36.7: CALL S76;
JLE A,SP1.2;
PAGE
P36.8: MOVE A1,B1;
MOVE A2,B2;
J SP1.2;
P36.12: INVOKE P53; POP RESULT
SKIPA; SHOULD BE TV
JNFTV;
HRRZ B1,@PK29;
JN A1,P36.13; TRUE; DONE.
JN B1,P36.2; FALSE; CONTINUE IF MORE
PJ E50; ESLE ERROR
P36.13: M52 PS,CP; THROW OUT POINTER
M52 DS,A; POP RESULT DESCRIPTOR
J P36.14;
SUBTTL P35 -- EVALUATE CONDITIONAL EXPRESSIONS
; JSP B,P35
P35: HRL B,B;
HRR B,K10;
M53 B,PS,E3; SAVE CALLER
MP1.1: CE CC,T51.14; COLON?
PJ E12; NO
INVOKE P53; YES; LOOK AT LAST EXPRESSION.
SKIPA ; SHOULD BE TV
PJ SIN1;
JN A1,MP1.5; TRUE OR FALSE?
FI A1,1; FALSE; PREPARE TO SKIP OVER NEXT EXP.
MP1.2: PJ S50; NEXT BYTE
CAIL CC,SP; SPACE OR WORD?
J MP1.2; YES
LDB A2,BYTE14; NO; TAKE A CLOSER LOOK
J .+1(A2);
J MP1.2; UNIMPORTANT
PJ E12; EOS
SOJE A1,MP1.4; SEMI-COLON DONE IF CORRECT ONE.
AOJA A1,MP1.2; LEFT GRPR; UP PAREN LEVEL.
J MP1.3; RIGHT GRPR
PJ E5; ALPHA
PJ E5; OMEGA1
PJ E5; OMEGA2
MP1.3: SOJG A1,MP1.2; CONTINUE IF PAREN LEVEL NOT ZERO
PJ E5; OTHERWISE, ILL-FORMED.
MP1.4: F A,U1;
M53 A,PS,E3; SAVE POINTER
JSP B,P49; NEXT EXPRESSION
M52 PS,A; POP OLD POINTER
PAGE
M A,UP12; AND HOLD IT.
CE CC,T54(CP); MATCHING RIGHT GRPR?
J MP1.1; NO
MP1.41: SKIPL U6; ARE WE TYPING AT ZERO LEVEL?
J P35.9; NO; FINI.
FI CC,ALPHA; YES; MARK BEGINNING OF EXP.
DPB CC,UP12;
FI CC,OMEGA1;
DPB CC,U1; AND END OF EXP.
J P35.9; FINI
MP1.5: F A,U1;
M53 A,PS,E3; SAVE POINTER
JSP B,P49; NEXT EXPRESSION
M52 PS,A; POP OLD POINTER
M A,UP12; HOLD OLD POINTER
CN CC,T54(CP); MATCHING RIGHT GRPR?
J MP1.41; YES
CE CC,T51.23; SEMI-COLON?
PJ E5; NO
SKIPL U6;
J MP1.6; NO
FI CC,ALPHA; YES MARK BEGINNING
DPB CC,UP12;
FI CC,OMEGA2; AND END
DPB CC,U1; OF EXPRESSION
MP1.6: FI A1,1; PREPARE TO SKIP TO END OF CONDITIONAL
MP1.7: PJ S50; NEXT BYTE
CAIL CC,SP; SPACE OR WORD?
J MP1.7; YES
LDB A2,BYTE14; CLOSER LOOK.
XEC MP1.8(A2);
F CC,T51(CC); RETURN IF RIGHT GROUPER
CE CC,T54(CP); MATCH?
PJ E12; NO
P35.9: XCH CP,(PS); TO HOLD CURRENT CP
J MP8; RETURN TO CALLER
PAGE
MP1.8: J MP1.7; UNIMPORTANT
PJ E12; EOS
J MP1.7; SEMI-COLON
AOJA A1,MP1.7; LEFT GRPR.
SOJG A1,MP1.7; RIGHT GROUPER
PJ E5; ALPHA
PJ E5; OMEGA1
PJ E5; OMEGA2
SUBTTL MP1 THRU MP8: FIRST LEVEL PROCESSORS
; THESE ARE FIRED DIRECTLY FROM CONTEXT II VIA T55
; MP1 FOR LEFT GROUPERS
MP1: CN CC,T54(CP); MATCHING RIGHT GROUPER?
J MP1.0; YES
JSP B,P35; NO; EVALUATE CONDITIONAL EXPRESSION
MP1.0: M52 PS,CP; YES; POP PROCESSOR STACK
LDB B2,BYTE17;
CAIG B2,1; SCALAR?
J P48; YES; TO CONTEXT II
J P49.23; NO; CHECK CONTEXT.
; MP2 FOR ABSOLUTE VALUE SIGN
MP2: CAME CC,CP; MATCH?
PJ E13; NO
INVOKE P53; ARGUMENT TO A1,A2
J .+2; TV -- TREAT AS JNF
XCT T57(CP); JNF; FIRE SUB-PROCESSOR
M52 PS,CP; POP PROCESSOR
JRST P49.8; ENTER CONTEXT II AFTER STORING/STACKING A
; MP3 FOR BINARY ARITH.
MP3: INVOKE P54; ARG. B TO B1,B2
TVJNF ; TV
PAGE
; MP4 FOR UNARY ARITH.
MP4: INVOKE P53; ARG. A TO A1,A2
TVJNF ; TV
XCT T57(CP); JNF--FIRE CP'S SUB-ROUTINE
MP4.1: M53 A,DS,E7; STACK RESULT DESCRIPTOR
M52 PS,CP; POP PROC. STACK
JRST 0,P48.6; TO WEIGHT TEST IN CONTEXT II
PAGE
; MP5 FOR BINARY LOGIC
MP5: INVOKE P54; ARG. B
SKIPA ; TV
JNFTVB ; JNF
; MP6 FOR UNARY LOGIC
MP6: INVOKE P53; ARG. A
SKIPA ; TV
JNFTV ; JNF
XCT T57(CP); FIRE CP'S SUB-ROUTINE--RESULT IN A2
MOVE A,K1; ASSUME FALSE.
JE A1,MP4.1; IT IS.
MOVE A,K2; IT IS TRUE.
JRST 0,MP4.1;
; MP7 FOR RELATIONS
MP7: INVOKE P54; ARG. B
J MP7.00; TV
SETZM PK20; JNF; NOTE THE FACT!
INVOKE P53; GET ARGUMENT A.
J MP7.01; MIXED
J MP7.3; BOTH JNF.
MP7.00: M A,PK20; SAVE DESCRIPTOR
INVOKE P53; ARG. A
J MP7.2; BOTH TV
MP7.01: CAMN CP,T51.6; MIXED; VALID?
J MP7.31; YES
CAMN CP,T51.61;
J MP7.11;
J MP7.21; NO
MP7.11: F A,K2; TRUE!
J MP7.31+1;
MP7.2: CAMN CP,T51.6; EQUALITY CHECK?
J MP7.3; YES
CAME CP,T51.61; INEQUALITY?
MP7.21: TVJNF; NO
MP7.3: CALL S76; COMPARE ARGUMENTS, RESULT IN A
PAGE
MOVE B,A;
MOVE A,K2; ASSUME RELATION HOLDS
XCT T57(CP); FIRE SUB-ROUTINE
MP7.31: MOVE A,K1; FALSE!
HLRZ B,CC; TRUE--IS CC A RELATION
CAIE B,7;
JRST 0,MP4.1; NO--FINI
M53 A,DS,E7; YES--STACK A
F A,PK20;
JN A,MP7.4; TV - USE THIS DESCRIPTOR
M56 B1,B2,E3; STORE OPERAND B
HRR A,B2; GENERATE JNF DESCRIPTOR
HRL A,TYPE2; IN A
MP7.4: M53 A,DS,E7; AND STACK IT.
MOVE CP,T51.3; CP BECOMES "AND"
XCT T55(CC); LEAVE CONTEXT II UNDER CC'S CONTROL
; MP8 FOR BACK-STOP CHARACTER
MP8: HLR B,CP; EXTRACT CALLER
M52 PS,CP; POP PROC. STACK
JRST 0,(B); RETURN TO CALLER
SUBTTL SP1 THRU SP21--SECOND LEVEL PROCESSORS
; SUB PROCESSORS FOR JNF ARITHMETIC AND
; FOR FUNCTIONS.
; PUSHJ CR,SPI
SP1: JADD;
SP1.1: IOR A1,A; PACK SIGN/MAG.
CAMLE A2,K5; TEST EXP.
PUSHJ CR,E14; HI
CAMGE A2,K6;
SETZB A1,A2; LO
SP1.2: M56 A1,A2,E3; STORE
HRR A,A2; GENERATE JNF DESCRIPTOR
HRL A,TYPE2; IN A
POPJ CR,0; DONE
SP2: JSUB ; JNF A-B
JRST 0,SP1.1;
SP3: JMPY ; JNF A TIMES B
JRST 0,SP1.1;
SP4: JDIV E15; JNF A/B - TO E15 IF A/0
JRST 0,SP1.1;
SP5: JPWR E16,E14,E17; JNF A*B
JRST 0,SP1.1;
PAGE
SP6: M58<JSQRT(E18)>;
SP7: M58<JEXP(E14)>;
SP8: M58<JLOG(E19)>;
SP9: M58<JSIN(E20)>;
SP10: M58<JCOS(E21)>;
SP11: INVOKE P54; ARG(A,B)
TVJNF;
M58<JARG>;
SP12: M58<JIP>;
PAGE
SP13: M58<JFP>;
SP14: M58<JDP>;
SP15: M58<JXP>;
SP16: M58<JSGN>;
SP17: HRREI B,-1; MAX; SET COMPARATOR TO -1
SKIPA ;
SP18: MOVEI B,1; MIN; SET COMPARATOR TO 1
MOVEM B,PK18;
SOSG T48;
PJ E5; EH? IF ONLY ONE ARGUMENT
INVOKE P54; FIRST ARG. TO B1,B2
TVJNF; TV
SP18.1: MOVE A1,B1; RESULT MOVED
MOVE A2,B2; TO A1 A2
SP18.2: SOSGE T48; DEC. AND TEST ARG. COUNT
JRST 0,SP1.2; FINI
INVOKE P54; MORE - NEXT ARG. TO B1,B2
TVJNF;
CALL S76; COMPARE ARGUMENTS
CAME A,PK18; MATCH WITH COMPARATOR
JRST 0,SP18.2; (A1,A2) IS RESULT
JRST 0,SP18.1; (B1,B2) IS RESULT
PAGE
SP19: INVOKE P53; TV FUNCTION
J SP1.2;
F A,K1; JNF -- CONVERT TO TV
JE A1,.+2;
F A,K2;
POPJ CR,0;
SP20: SETZ A1,0; SUM; START WITH ZERO
SKIPA ;
SP21: MOVE A1,K15; PRODUCT; START WITH UNITY
M A1,PK18;
SOSG T48;
PJ E5; EH? IF ONLY ONE ARGUMENT
SETZ A2,0;
SP21.1: INVOKE P54; NEXT OPERAND
TVJNF ;
SKIPE PK18;
J SP21.2; PRODUCT
JADD ; SUM
J SP21.3;
SP21.2: JMPY ;
SP21.3: IOR A1,A;
CLE A2,K5; TEST EXP.
PJ E14; HI
CGE A2,K6;
SETZB A1,A2; LO
SOSGE T48; ANY MORE ARGUMENTS?
J SP1.2; NO
J SP21.1; MORE.
SUBTTL P51 -- FETCH NEXT CHARACTER TO CC
; FETCH NEXT TERMINAL CHARACTER TO CC
; U1 = POINTER TO CURRENT BYTE
; INVOKE P51; B1 = 0 IF NO LEADING SPACES
INTERN P51;
P51: SETZ B1,0; ASSUME NO SPACES
P51.1: ILDB CC,U1; CURRENT BYTE
P51.2: MOVE CC,T51(CC); ITS DESCRIPTOR
JUMPL CC,P51.3(CC); JUMP IF ACTIVE DESCRIPTOR
RTN; FINI IF PASSIVE
P51.3: AOJA B1,P51.1; SPACE OR TAB
JRST P51.4; DIGIT OR DOT
JRST P51.32; UNDERSCORE
HRRZ CC,@U1; EOC; LINK TO NEXT CELL
JUMPE CC,P51.31; NULL LINK
HRLI CC,341000; POINT AT FIRST BYTE
MOVEM CC,U1; RESTORE POINTER
LDB CC,CC; CURRENT BYTE
MOVE CC,T51(CC); AS P51.2
JUMPL CC,P51.3(CC);
RTN;
P51.31: HRLI CC,241000; RESET POINTER TO
HLLM CC,U1; POINT TO EOC
F CC,T51.5; FETCH EOS DESCRIPTOR
RTN; AND FINI.
P51.32: PUSH CR,U1; HOLD PTR.
PJ S50; ACCEPT STRING OF UNDERSCORES
CAIE CC,UNDER;
J P51.33;
POP CR,CC;
J P51.32;
P51.33: POP CR,U1;
F CC,K40; UNDERSCORE DESCRIPTOR
RTN;
PAGE
; NOW ASSEMBLE UPCOMING JNF LITERAL
P51.4: MOVEM B1,PK1; SAVE B-BANK
MOVEM B,PK2;
MOVEM B2,PK3;
SETZB B1,PK4; X=LEFT=0
SETZB B,PK5; SIGDIGS=RIGHT=0
SETZM PK6; DIGS=0
LDB CC,U1;
CAIE CC,DOT; DIGIT OR DOT?
J P51.5; DIGIT
P51.41: MOVE B2,U1; SAVE POINTER
PJ S50; NEXT BYTE
CAILE CC,11;
J P51.6; NON-DIGIT
AOS PK6; ANOTHER DIGIT
JE B,P51.42; ANY SIG DIGS?
CAIGE B,11; YES; HOW MANY?
J P51.43; LESS THAN NINE.
JE CC,P51.41; NINE; IGNORE TRAILING ZEROES.
AOJ B,P51.41; COUNT AND IGNORE
P51.42: AOS PK5; ONE MORE RIGHT OF DIT
JE CC,P51.41; LEADING ZEROES
P51.43: IMULI B1,12;
ADD B1,CC; X=10*X+CC
ADDI B,1; ONE MORE SIG DIG
J P51.41;
P51.5: MOVE B2,U1; SAVE POINTER
J P51.52; AND MERGE
P51.51: MOVE B2,U1;
PJ S50; NEXT BYTE
CAILE CC,11;
J P51.56; NON-DIGIT
P51.52: AOS PK6;
JE B,P51.53; NO SIG DIGS
CAIGE B,11; HOW MANY SIGDIGS?
J P51.54; LESS THAN NINE
JE CC,P51.55; TRAILING ZEROES.
AOJ B,P51.55; COUNT AND IGNORE
P51.53: JE CC,P51.51; LEADING ZEROES
P51.54: IMULI B1,12;
ADD B1,CC;
ADDI B,1;
P51.55: AOS PK4;
J P51.51;
P51.56: CAIN CC,DOT;
J P51.41;
PAGE
P51.6: MOVEM B2,U1; RESTORE PTR.
CAILE B,11; HOW MANY SIGDIGS?
J P51.7; TOO MANY
IMUL B1,P51.48(B); NORMALIZE X
EXCH B1,PK4; SAVE IT AND FETCH LEFT DIGS
MOVE B2,PK5; RIGHT DIGS
SETZM PK5; ASSUME ZERO
SKIPN PK4;
J P51.61; ZERO!
SOJGE B1,.+2; EXP = LEFT DIGS - 1
MOVN B1,B2; NOPE; EXP = - RIGHT DIGS
MOVEM B1,PK5; STORE EXP
P51.61: HRLI CC,1001;
HRRI CC,PK4; JNF DESCRIPTOR
F B1,PK1; RESTORE B BANK.
F B,PK2;
F B2,PK3;
SKIPN PK6;
F CC,T51.7; CC=BAD MARK IF NO DIGITS
RTN;
P51.7: SETOM PK4; -1 AS SIGNAL FOR TOO MANY SIGDIGS
J P51.61;
P51.48: DEC 0;
DEC 100000000;
DEC 10000000;
DEC 1000000;
DEC 100000;
DEC 10000;
DEC 1000;
DEC 100;
DEC 10;
DEC 1;
SUBTTL P51X -- STRIP OFF STEP NUMBERS
; PUSHJ P51X; RESULT STRING IN US1; NYTE COUNT IN B1
P51X: F B,SK8;
SETZB B1,B2; B1 CNTS LEADING SPACES AND ZEROES
P51X.0: ILDB CC,B; NEXT BYTE
CAIGE CC,SP; SPACES?
J P51X.1; NO
CAILE CC,SPS;
J P51X.1; NO
SUBI CC,SP-1; YES; COUNT THEM
ADD B1,CC;
J P51X.0;
P51X.1: JN CC,P51X.3; ZERO?
AOJA B1,P51X.0; YES; COUNT IT.
P51X.2: ILDB CC,B; NEXT BYTE; WORKING ON IP
P51X.3: CAIG CC,11; DIGIT?
J P51X.2; YES
CAIE CC,DOT; DOT?
J P51X.5; NO; FINI.
AOJA B2,.+1; YES; COUNT IT IN B2
P51X.4: ILDB CC,B; NEXT BYTE; WORKING ON FP
JE CC,.-2; COUNT ZEROES
CAILE CC,11; DIGIT?
J P51X.5; NO; FINI
SETZ B2,0; YES; RESET COUNT OF TRAILING ZEROES
J P51X.4;
P51X.5: M B,U1; PREPARE TO REQRITE SANS STEP NR.
F B,US1;
SETZM 1(B);
IDPB B1,B; SAVE COUNTS AS FIRST TWO BYTES
IDPB B2,B;
IBP B; THIRD BYTE WILL CONTAIN INDEX OF "IF"
F B2,B;
FI B1,3; COUNT NORM OF NEW STRING
J .+2;
P51X.6: ILDB CC,U1; NEXT BYTE
CAIN CC,EOS; EOS?
AOJA B1,P51X.7; YES; FINI
CAIN CC,IF2; NO; IS IT THE "IF"
DPB B1,B2; YES; SAVE ITS INDEX
IDPB CC,B; MOVE BYTE
AOJA B1,P51X.6;
P51X.7: M B,UP2; SAVE PTR TO LAST BYTE
IDPB CC,B; MOVE EOS
LDB CC,UP2; IS LAST BYTE A PERIOD?
CAIN CC,PERIOD;
POPJ CR,0; YES; DONE
FI CC,277; NO
DPB CC,B2; NO; MARK STEP AS IMPAIRED
POPJ CR,0;
SUBTTL P51Y ENUF SPACE TO STORE STRING ?
; PUSHJ P51Y; BYTE COUNT IN B1; ERROR IF NO SPACE.
P51Y: ADDI B1,7;
IDIVI B1,6;
ADDI B1,3;
CAML B1,SIZE;
PJ E3A; NOT ENUF
POPJ CR,0; OKAY
SUBTTL P52--PUSH CURRENT CHARACTER, FETCH NEXT
; P52 PUSHES CURRENT PROCESS WITH CURRENT CHAR
; FETCHES NEXT CHAR
; INVOKE P52
; TO E3 IF OUTSIZE
INTERN P52;
P52: M53 CP,PS,E3; STACK CP ON PS--TO E3 IF OUT-SIZE.
MOVE CP,CC; CURRENT PROC = CURRENT CHAR.
JRST 0,P51; FETCH NEXT CC VIA P51.
SUBTTL P53, P54 -- POP AND TEST TOP OF DS
; POP DESCRIPTOR-STACK TO A
; DESCRIPTEE TO A1,A2 (B1,B2) AS JNF
; RELEASE CELL IF SCRATCH JNF
; INVOKE P5X
; RETURN IF TV
; RETURN IF JNF
INTERN P53,P54;
P53: M52 DS,A;
MOVE A1,(A); SIGN AND MAGNITUDE
HLRE A2,1(A); EXPONENT
P53.1: TLNN A,17; TEST OBJECT-TYPE
RTN ; TV
TLNE A,000016;
PJ E4; NEITHER TV NOR JNF
TLNE A,776000; JNF--IS IT SCRATCH
JRST 0,P53.2; NO
M54 A; YES--RELEASE CELL
P53.2: SKRTN ; SKIP RETURN
P54: M52 DS,A; DESCRIPTOR TO A
MOVE B1,(A); SIGN AND MAGNITUDE
HLRE B2,1(A); EXPONENT
JRST 0,P53.1;
SUBTTL P55
; IS NEXT CHAR. A LEFT GRPR. WITH NO LEADING BLANKS
; PUSHJ CR,P55
; NO
; YES
; HIDES ORIG, BYTE PTR. IN PK7
INTERN P55;
P55: MOVE A1,U1; SAVE BYTE POINTER.
MOVEM A1,PK7;
INVOKE P51; FETCH CHAR.
JUMPN B1,P55.1; LEADING BLANKS -- YES;
HLRZ A1,CC; NO--IS CC
CAIE A1,2; A LEFT GROUPER
JRST P55.1; NO
POP CR,A1;
J 1(A1);
P55.1: MOVE A1,PK7;
M A1,U1; RESTORE POINTER ON FAILURE.
POPJ CR,0;
SUBTTL P56 -- SEARCH FOR COMPONENT OF ARRAY
; PK8 = LINK TO ARRAY HEADER
; T48 = NR. OF DIMENSIONS (LEVELS IN ARRAY STRUCTURE)
; T48(I) = I-TH INDEX
; PUSHJ CR,P56
; NOT FOUND; A1(A) = LINK TO PREDECESSOR (SUCCESSOR)
; FOUND; A = LINK TO COMPONENT
; A1 = LINK TO EITHER HEADER OR PREDECESSOR
; T49 = NR. OF LEVELS SEARCHED
; T49(I) = HEADER FOR I-TH LEVEL (LINK)
; T49X(I) = PREDECESSOR OF INDEX IN I-TH LEVEL (LINK)
INTERN P56;
P56: HRRZ A,PK8; TO HEADER
MOVEI B2,1; I = 1
SETZ A1,0; NULL PREDECESSOR FOR HEADER
P56.1: MOVEM B2,T49; SAVE I
MOVEM A,T49(B2); HEADER LINK
MOVEM A1,T49X(B2); AND PREDECESSOR
PUSHJ CR,P57; SEARCH THRU I-TH LEVEL
JRST P56.3; NOT FOUND
MOVE B1,T49(B2); FOUND; GET HEADER LINK
HRLM A,(B1); SET LAST-USED LINK.
P56.2: CAME B2,T48; DOES I = NR. OF DIMENSIONS
AOJA B2,P56.1; NO; CONTINUE.
POP CR,A2;
J 1(A2);
P56.3: HRRZ B1,T49(B2); GET HEADER
POPJ CR,0;
SUBTTL; P57
; P57 SEARCHES ACROSS ONE LEVEL OF
; ARRAY TREES.
; A = LINK TO HEADER FOR LEVEL
; B2 = LEVEL NR.
; OTHERWISE, LIKE P56
INTERN P57;
P57: HRRZ A1,A; OFF-SET HEADER LINK
SUBI A1,1; TO FIT SEARCH ALGORITHM
MOVE B1,T48(B2); DESIRED INDEX.
HLRZ A,1(A1); TRY LAST-USED COMPONENT.
JUMPE A,P57.1; NONE SUCH START WITH FIRST.
F A2,1(A); FETCH AND
AND A2,MASK1 ; MASK INDEX
CAMG A2,B1; COMPARE
JRST P57.3; RIGHT DIRECTION; ENTER MAIN STREAM
P57.1: HRRZ A,1(A1); LINK TO NEXT COMPONENT
P57.2: JUMPE A,P57.21; NO MORE
MOVE A2,1(A); FETCH AND
AND A2,MASK1; MASK INDEX
CAMLE A2,B1; COMPARE
P57.21: POPJ CR,0; NO GO; OVERSHOOT.
P57.3: CAML A2,B1; IS THIS THE ONE.
JRST P57.4; YES
MOVE A1,A; NO; RECYCLE
JRST P57.1;
P57.4: POP CR,A2;
J 1(A2);
SUBTTL; P57X(Y)
; CONVERTS PACKED INDEX (EXP) TO INTEGER
; ARG. IN A2 (RIGHT)
INTERN P57X,P57Y;
P57X: LSH A2,INDEX-22; POSITION INDEX
P57Y: AND A2,MASK2; ASSUME POSITIVE
CAML A2,MASK9; TEST SIGN
ORCM A2,MASK2; NEGATIVE; CORRECT
POPJ CR,0;
SUBTTL P57Z; PROCESS ARRAY COMPONENTS
; CONVERT PACKED EXP., STORE IF JNF, DESC. TO A
INTERN P57Z;
P57Z: AND A2,MASK2;
CN A2,MASK9; TV?
J P57Z.1; YES
CL A2,MASK9; JNF
ORCM A2,MASK2; ADJUST NEG. EXP.
M56 A1,A2,E3; STORE
HRR A,A2;
HRL A,TYPE2; JNF DESC.
POPJ CR,0;
P57Z.1: F A,K1; ASSUME FALSE
JE A1,.+2; IT IS.
F A,K2; TRUE
POPJ CR,0;
SUBTTL P58 -- PUSH ASSIGNMENT TABLE ENTRY
; COPY DICT. ENTRY (ADDRESS IN A) INTO FRESH CELL.
; NEW ENTRY IS UNDEFINED AND CHAINED TO COPY OF OLD.
; PUSHJ CR,P58
INTERN P58;
P58: MOVE A1,(A); FETCH ENTRY
MOVE A2,1(A);
M55 A1,A2,E3; COPY IN AVAIL. CELL (ADD.IN A2)
HRL A2,LEVEL ;NEW ENTRY LEVEL; AND
M A2,1(A); POINTER TO OLD ENTRY.
HRRZ A1,A; GENERATE UNDEFINED DESCRIPTOR
SUBI A1,V;
ROT A1,-11;
ADD A1,K41;
HLLZM A1,(A);
POPJ CR,0; RETURN
SUBTTL P59 -- POP DICTIONARY ENTRY
; POP DICT. ENTRY WHOSE ADDRESS IS IN A.
; PUSHJ CR,P59
INTERN P59;
P59: HRRZ A1,1(A); POINTER TO NEXT.
JUMPE A1,P59.1; NO WORK IF NONE
MOVE A2,(A1);
MOVEM A2,(A); RECLAIM OLD ENTRY
MOVE A2,1(A1);
MOVEM A2,1(A);
M54 A1; RELEASE CELL
P59.1: POPJ CR,0;
SUBTTL P60 -- DELETE DICTIONARY ENTRY
; EXAMINE DICT. ENTRY WHOSE ADDRESS IS IN A.
; DECREMENTS USER COUNT FOR VOLATILE ITEMS
; AND RELEASES SPACE IF COUNT BECOMES ZERO
; ALWAYS LEAVES ENTRY UNDEFINED
; PUSHJ CR,P60
INTERN P60;
P60: MOVE A1,(A); GET DESCRIPTOR
LDB A2,BYTE1; GET TYPE
CAMLE A2,TYPE4; TEST TYPE
JRST 0,P60.3; NON VOLATILE
JE A2,P60.3; TV'S NON-VOLATILE
HRRZ B1,1(A1); FETCH USER COUNT
SOJLE B1,P60.1(A2); DECREMENT -- READY FOR RELEASE.
HRRM B1,1(A1); STILL IN USE.
P60.1: JRST 0,P60.3; TV -- NON VOLATILE
JRST 0,P60J; JNF
JRST 0,P60A; ARRAY
JRST 0,P60C; FORMULA
P60A: MOVEM A,PK11; SAVE DESC.
HLRZ A2,1(A1); FETCH DIMENSION.
MOVEM A2,PK10;
PUSHJ CR,P64; RELEASE MATRIX (TREATED AS TREE)
MOVE A,PK11; RESTORE DESC.
MOVE A1,(A);
JRST 0,P60.3;
P60C: PUSHJ CR,P65; RELEASE DOUBLE LIST
JRST 0,P60.3;
P60J: M54 A1; RELEASE JNF CELL.
P60.3: TLZ A1,IDM; ENTRY IS UNDEFINED
HRLZ A2,TYPE6;
IOR A1,A2;
HLLZM A1,(A);
POPJ CR,0;
SUBTTL; P61
; PEEL ITEMS OFF DS AS INDICES.
; ITEM COUNT IN T48. TOP OF DS TO T48(COUNT), NEXT TO
; T48 (COUNT-1) AND SO ON.
; PUSHJ CR,P61
INTERN P61;
P61: MOVE B1,T48; SET I = COUNT.
P61.1: INVOKE P53; POP/TEST DS
TVJNF ; TV
CALL S77; JNF--CONVERT TO INDEX(LEFT IN A1) AND TEST.
PJ E9; INVALID INDEX
ROT A1,-INDEX; OKAY; POSITION INDEX
AND A1,MASK1; MASK IT
CAMG B1,K29;
M A1,T48(B1); AND STORE IT IFNOT TOO MANY.
SOJG B1,P61.1; DECREMENT I AND RECYCLE
POPJ CR,0;
SUBTTL P62 -- RELEASE A RIGHT-LINKED LIST
; B = LINK TO FIRST
; PUSHJ CR,P62
INTERN P62;
P62: HRRZ B2,B;
JUMPE B2,P62.2; EMPTY LIST
P62.1: MOVE B1,B2;
CAIG B1,USER0; STAY IN USER'S AREA!
PJ KILL;
CAML B1,SPACE;
PJ KILL;
AOS SIZE;
HRRZ B2,1(B1); LINK TO NEXT
JUMPN B2,P62.1; MORE
HRRM ACL,1(B1); FINI; LINK END TO FIRST AVAIL. CELL
HRRZ ACL,B; AND ACL TO FIRST
P62.2: POPJ CR,0;
SUBTTL; P63
; P63 TESTS ARITH. VALIDITY OF TOP OF DS.
; POPS AND TACKS ONTO LIST WHOSE HEADER
; IS NEXT ON DS.
; PUSHJ CR,P63
INTERN P63,P63X;
P63: INVOKE P53; POP/TEST DS
HRRZI A2,400; TV - MARK AS SUCH
P63X: HRLZ A2,A2; PACK EXPONENT LINK IS ZERO
AND A2,MASK3;
M55 A1,A2,E3; AND STORE
HRRZ A1,(DS); FIRST ON LIST
HLRZ A,1(DS); LAST ON LIST
JUMPN A1,P63.1; ANY ON LIST?
HRRM A2,(DS); NO -- SET FIRST
JRST 0,.+2;
P63.1: HRRM A2,1(A); LINK LAST ITEM TO NEW ONE.
HRLM A2,1(DS); RESET LAST.
POPJ CR,0;
SUBTTL P64 -- RELEASE AN ARRAY
; RELEASE ARRAY STRUCTURE
; PK10 = DIMENSION
; A1 = LINK TO ARRAY HEADER
; PUSHJ CR,P64
INTERN P64;
P64: F A2,(A1); ANYTHING TO DELETE?
JN A2,P64.0; YES
M54 A1; NO, DELETE HEADER.
POPJ CR,0;
P64.0: SETZ A2,0; LEVEL = 0
MOVEM A1,T49; BASE LINK AT LEVEL ZERO
P64.1: HRRZ A1,(A1); FIRST COMP. AT THIS LEVEL
ADDI A2,1; IS BASE OF
MOVEM A1,T49(A2); NEXT LEVEL.
CAME A2,PK10; IS THIS LAST LEVEL
JRST P64.1; NO
MOVE B,A1; YES; SET UP TO
PUSHJ CR,P62; RELEASE VECTOR.
P64.2: SUBI A2,1; DROP A LEVEL.
MOVE B,T49(A2); LAST COMP. AT THIS LEVEL
HRRZ A1,1(B);
M54 B; RELEASE COMPONENT HEADER
JUMPE A2,P64.3; FINI IF AT BASE LEVEL
MOVEM A1,T49(A2); NEXT ELEMENT AT THIS LEVEL.
JUMPE A1,P64.2; NO MORE AT THIS LEVEL; CLIMB DOWN
JRST P64.1; MORE; CLIMB UP.
P64.3: POPJ CR,0;
SUBTTL P65 -- RELEASE DOUBLY-LINKED LIST
; RELEASE DOUBLE LIST
; A1 = LINK TO HEADER
; PUSHJ CR,P65,
INTERN P65;
P65: HLR B,(A1); LEFT(HEADER) IS LINK TO FIRST LIST
PUSHJ CR,P62; RELEASE FIRST LIST
HRR B,(A1); LINK TO SECOND LIST
PUSHJ CR,P62;
MOVE B,A1;
M54 B; RELEASE HEADER
POPJ CR,0;
SUBTTL P66
; DISASSEMBLE LHS WHOSE DESCRIPTOR IS ON DS
; IF ARRAY, T48 = NR. OF DIM., T48(I) = I-TH INDEX
; PUSHJ CR,P66; B1=DIM., A=DICT. ADDRESS
INTERN P66;
P66: M52 DS,A1; POP LHS DESCRIPTOR
M52 A1,A; POP TOP OF LHS LIST
SETZB B1,T48; COUNTS ARE ZERO
TLZN A,777777; A = DIMENSION,DICT.ADDRESS
POPJ CR,0;
ADDI B1,1;
P66.1: M52 A1,A2; POP NEXT INDEX VALUE OFF LHS LIST
AND A2,MASK1; MASK IT
MOVEM A2,T48(B1);
TRNE A1,777777; ANY MORE
AOJA B1,P66.1; YES
MOVEM B1,T48; YES; RECORD COUNT
POPJ CR,0;
SUBTTL P67 -- SET LEFT-HAND-SIDE TO JNF NR.
; A = DICT. ADDRESS OF LHS
; T48 = NR. OF SUBSCRIPTS
; T48(I) = I-TH SUBSCRIPT (POSITIONED)
; PK20,PK21 = RHS-JNF
; PUSHJ CR, P67
; OUT-SIZE RETURN
; NORMAL RETURN
INTERN P67;
P67: TRNN A,777777; ANY LHS?
J P67.7; NO
MOVE A1,T48; YES; IS THERE
ADDI A1,1; ENUF
CAML A1,SIZE; SPACE?
POPJ CR,0; OUT-SIZE
HLRZ A2,1(A); WAS OLD ENTRY DEFINED
CAMN A2,LEVEL; AT THIS LEVEL?
J P67.0; YES; DELETE AND RESET.
ADDI A1,1; NO; MUST PUSH OLD ENTRY.
CAML A1,SIZE; ENUF SPACE?
POPJ CR,0; NO
PJ P58; YES; PUSH THE OLD ENTRY.
P67.0: SKIPN T48; IS NEW ENTRY A SCALAR?
JRST P67.6; YES
MOVE A2,(A); SUBSCRIPTED--LOOK AT
LDB A1,BYTE3; TYPE OF DICT. ENTRY
HRLZ B1,TYPE3; CODE FOR ARRAY.
CAME A1,TYPE3; IS IT ONE?
J P67.1; NO; MAY HAVE TO DELETE
HLRZ A1,1(A2); DOES ITS DIMENSION
CAMN A1,T48; MATCH?
J P67.4; YES; SEARCH FOR COMP.
J P67.10; NO; DELETE
P67.1: CAME A1,TYPE6; UNDEFINED?
J P67.10; NO; DELETE
TLNE A2,SPARSE; AND SPARSE?
TLO B1,SPARSE; YES; NOTE IT.
P67.10: PUSH CR,B1; SAVE IDENTOFYING CODE.
PJ P60; DELETE THE ENTRY.
M59A A,A1; LINK ENTRY TO FRESH HEADER CELL
P67.11: HRL A2,T48; MAKE UP HEADER
HRRI A2,1; A2 = (DIMENSION) USE-COUNT = 1)
MOVEM A2,1(A1); SET IT.
HLL A1,(A); MAKE UP ARRAY DESCRIPTOR--
TLZ A1,IDM; SAVE IDENTIFIER BYTE
POP CR,A2; RETRIEVE CODE.
IOR A1,A2
MOVEM A1,(A); SET IT.
MOVEI B1,1; LEVEL = 1
MOVE A,A1; A = LAST HEADER ADDRESS
PAGE
P67.2: M59A A,A1; FRESH CELL
P67.21: HRLM A1,(A); SET LAST-USED POINTER
MOVE A2,T48(B1); GET INDEX
HLLM A2,1(A1); TO CELL
MOVE A,A1;
CAME B1,T48; IS THIS LAST
AOJA B1,P67.2; NO
P67.3: MOVE A2,PK20; SET SIGN/MAG
MOVEM A2,(A);
HRLZ A2,PK21; AND
SKIPN PK19; THE APPROPRIATE
HRLI A2,400; (INDICATES TV)
AND A2,MASK3; PACKED
IORB A2,1(A); EXPONENT
POP CR,A2;
J 1(A2);
P67.4: MOVEM A2,PK8; SET UP FOR
PUSHJ CR,P56; ARRAY SEARCH
JRST P67.5; NOT FOUND
MOVE A2,1(A); FOUND
AND A2,MASK1; MASK OUT OLD EXP.
HLLM A2,1(A);
JRST P67.3;
P67.5: MOVE A,A1;
M57A A,A1; INSERT CELL
P67.51: MOVE B1,T49; GET LEVEL
MOVE A,T49(B1); HEADER FOR LEVEL
JRST P67.21;
PAGE
P67.6: PJ P60; DELETE ENTRY.
SKIPN PK19; TV OR JNF?
J P67.8; TV
M59A A,A1; LINK ENTRY TO FRESH CELL.
HLL A1,(A); MAKE UP JNF DESCRIPTOR
TLZ A1,001777;
HRLZ A2,TYPE2;
IOR A1,A2;
MOVEM A1,(A);
MOVE A2,PK20; COPY SIGN/MAG
MOVEM A2,(A1);
HRLZ A2,PK21; AND
HRRI A2,1;
MOVEM A2,1(A1); EXPONENT WITH USE-COUNT = 1
P67.7: POP CR,A2;
J 1(A2);
P67.8: HLLZ A1,(A); MAKE UP TV DESCRIPTOR
TLZ A1,IDM; SAVE IDENTIFIER BYTE
F A2,K1; ASSUME FALSE
SKIPE PK20;
F A2,K2; IT IS TRUE
IOR A1,A2;
M A1,(A);
J P67.7;
SUBTTL P68 -- RELEASE ARRAY COMPONENT
; RELEASE COMPONENT OF ARRAY
; USES OUTPUT OF P56
; A = LINK TO RELEASEE
; A1 = LINK TO EITHER HEADER OR PREDECESSOR
; B2 = DIMENSION
; PUSHJ CR,P68
INTERN P68;
P68: HRRZ A2,1(A1); FIND LINK TO PREDECESSOR
CAMN A2,A;
J .+3; THIS IS IT
F A1,A2; KEEP LOOKING
J P68;
HRR A2,1(A); LINK PREDECESSOR TO
HRRM A2,1(A1); SUCCESSOR OF RELEASEE
M54 A; RELEASE COMPONENT
MOVE A,T49(B2); COMPONENT'S HEADER (LINK)
MOVE A1,T49X(B2); HEADER'S PREDECESSOR (LINK)
HRLM A2,(A); RESET LAST USED IN HEADER
HRRZ A2,(A); HAS THIS LEVEL BEEN WIPED OUT
JUMPN A2,P68.1; NO -- FINI
SOJG B2,P68; YES; IS IT BASE LEVEL
M54 A; DELETE HEADER
F A,PK9; AND MAKE ENTRY UNDEFINED
F A1,(A);
TLZ A1,IDM; SAVE IDENTIFIER BYTE
HRLZ A2,TYPE6;
IOR A1,A2;
HLLZM A1,(A);
P68.1: POPJ CR,0;
SUBTTL P69 -- USED TO CLEAN UP DS.
; P69 ACTS ON OBJECT DESCRIPTOR IN A.
; RELEASES SPACE IF 'SCRATCH' OBJECT
; PUSHJ CR,P67
INTERN P69;
P69: LDB A1,BYTE2; A1=TYPE
XCT P69.1(A1);
P69.1: POPJ CR,0; TV
JRST P69.2; JNF
POPJ CR,0; ARRAY
POPJ CR,0; FORMULA
POPJ CR,0; FCT
POPJ CR,0; FCTL
POPJ CR,0; UND
JRST P69.3; FORMAL PARAM ASSIGNMENT TABLE ADDRESS
JRST P69.4; LHS
JRST P69.4; ROV
JRST P69.5; FOR-CLAUSE
JRST P69.6; OBJECT-OF-DISCOURSE
POPJ CR,0; UNDERSCORE OR SYSTEM WORD
POPJ CR,0; ASSIGNMENT TABLE ADDRESS
JRST P69.7; LIST OF OBJECT DESCRIPTORS
POPJ CR,0;
P69.2: TLNE A,IDMC; INTERMEDIATE RESULT?
POPJ CR,0; NO
M54 A; YES -- RELEASE
POPJ CR,0;
P69.3: PUSHJ CR,P60; RELEASE ENTRY
JRST P59; POP ENTRY AND FINI
P69.4: MOVE B,A; SET UP
JRST P62; RELEASE LIST AND FINI
P69.5: MOVE A1,A;
JRST P65; RELEASE DOUBLE LIST AND FINI
P69.6: TRNN A,777777; ANY STORAGE?
POPJ CR,0; NO
M54 A; YES, RELEASE IT
POPJ CR,0;
PAGE
P69.7: HRL DS,A; PUT LIST ATOP DS!
HRRZ A1,1(A);
JE A1,.+3;
F A,A1;
J .-3;
HRRM DS,1(A);
HLRZS DS;
J P69;
SUBTTL P70 -- PART, STEP; FORM SEARCHES
; PK36 = OOD CODE; (PK37,38)=(A1,A2)=JNF OBJECT NR.
; PUSHJ P70
; BAD OBJECT NR.
; NO SUCH OBJECT
; NORMAL RETURN (SET UP A-LA P38)
P70: CALL S78; IP AND FP OF OBJ NR (ALSO IN A1,A2)
POPJ CR,0; BAD NR.
M A1,PK22; SAVE IP
M A,PK23; AND FP
HRRZ B1,PK36; WHAT DO WE HAVE?
SUB B1,K22;
HRRZI A1,PARTS; ASSUME PART OR STEP
J .+1(B1);
PJ E5;
J .+3; PART
J .+4; STEP
HRRZI A1,FORMS; FORM
SKIPE PK23; IS FP=0?
POPJ CR,0; NO
F A2,PK22; YES; SEARCH FOR FIRST INDEX
PJ P70L;
J P70.2; NOT FOUND
HRRZ B1,PK36; WHAT DO WE HAVE?
CAIE B1,11; A STEP?
J P70.1; NO, DONE.
HRRM A,PK40; SAVE HEADER INFO
HRLM A1,PK40;
F A1,A; LOOK FOR STEP
F A2,PK23;
PJ P70R;
J P70.2; NOT FOUND
P70.1: HRRM A,PK39; SAVE HEADER INFO
HRLM A1,PK39;
POP CR,B;
J 2(B);
P70.2: POP CR,B;
J 1(B);
SUBTTL P70X -- DE-COMPILE OOD DESC. IN A
P70X: LDB A1,BYTE16;
M A1,PK36; OOD CODE
HRRZ A,A;
SETZM PK37;
JE A,P70X.1; NO OBJECT NR.
F A1,(A); GET NR.
HLRE A2,1(A);
M A1,PK37;
M A2,PK38;
M54 A; RELEASE CELL
F A,PK36;
CAIE A,13; FORMULA?
J P70; LOOK FOR OBJECT.
P70X.1: POP CR,B;
J 2(B);
SUBTTL P70L AND P70R -- PART, STEP
; FROM STRUCTURE SEARCH
; SEARCH THRU LEFT(RIGHT) LINKED LISTS
; A1= ADDRESS OF FIRST; A2=ARGUMENT
; PUSHJ CR,P70X
; NOT FOUND; A1(A)=ADD. OF PREDECESSOR(SUCCESSOR)
; FOUND; DITTO BUT A = ADDRESS OF ENTRY
INTERN P70L,P70R;
P70L: HLRZ A,1(A1);
JUMPE A,P70L.1;
CGE A2,(A);
P70L.1: POPJ CR,0;
CAMG A2,(A);
JRST P70L.2;
MOVE A1,A;
JRST P70L;
P70L.2: POP CR,B1;
J 1(B1);
P70R: HRRZ A,1(A1);
JUMPE A,P70R.1;
CGE A2,(A);
P70R.1: POPJ CR,0;
CAMG A2,(A);
JRST P70L.2;
MOVE A1,A;
JRST P70R;
SUBTTL P71 -- ADVANCE THROUGH RANGE OF VALUES
; ADVANCE THROUGH ROV LIST
; PK29=POINTER TO FOR CLAUSE HEADER
; PUSHJ CR,P67
; HEADER UP-DATED
INTERN P71;
P71: HLRZ A,@PK29; IS THERE A LHS?
JE A,P71.4; NO
HRRZ A,@PK29; YES GET LINK TO ROV
P71.1: MOVE A2,1(A);FLAG EXP., LINK OF CURRENT VALUE
TLNN A2,777000; IS THIS END OF CURRENT ROV
JRST P71.15; NO
HRRM A2,@PK29; YES; UPDATE HEADER.
M54 A; RELEASE CELL
POPJ CR,0; DONE.
P71.15: MOVE A1,(A); FETCH CV SIGN/MAG
MOVE A,(A2); FETCH INCREMENT
MOVE B,1(A2);
MOVE B1,(B); FETCH LIMIT VALUE
MOVE B2,1(B);
M60 A2; CONVERT EXPONENTS
M60 B; TO
M60 B2; JNF.
MOVEM A,PK30; SAVE
MOVEM B,PK31; INC.
MOVEM B1,PK32; AND
MOVEM B2,PK33; LV.
CALL S76; COMPARE CV WITH LV
JUMPN A,P71.3; UNEQUAL
PAGE
P71.2: HRR A,@PK29; CV=LV; END OF CURRENT ROV.
HRR A2,1(A);
M54 A; RELEASE CV
HRRZ A,1(A2);
M54 A2; RELEASE INCREMENT
HRRM A,@PK29; UPDATE HEADER.
JRST P71.1; AND RE-ENTER
P71.3: MOVEM A,PK34; SAVE COMPARATOR
MOVE B1,PK30;
MOVE B2,PK31;
JADD ; CV=CV+INC
IOR A1,A; PACK SIGN AND MAG.
MOVE B1,PK32; FETCH LV
MOVE B2,PK33;
CALL S76; COMPARE WITH NEW CV
JUMPE A,P71.7; CV=LV; USE CV
CAME A,PK34; HAVE WE OVERSHOT?
JRST .+3; YES; USE LV
CAMG A2,K5; NO; HAVE WE AN OVERFLOW?
JRST P71.7; NO; USE CV
MOVE A1,B1; YES--USE LV AS CV
MOVE A2,B2;
P71.7: CAMGE A2,K6; CHECK FOR UNDERFLOW
SETZB A1,A2; LO; CV=O
HRRZ A,@PK29;
MOVEM A1,(A); RESTORE
TRZ A2,777000; CV
HRLM A2,1(A); IN ROV.
POPJ CR,0;
PAGE
P71.4: HRRZ A,@PK29; LINK TO NR. OF TIMES
F A1,(A);
HLRE A2,1(A); FETCH NR OF TIMES
F B1,K15;
SETZ B2,0;
CALL P76; DECREMENT BY UNITY
HRRZ A,@PK29;
M A1,(A); RESTORE RESULT
HRLZM A2,1(A);
JE A1,.+2; DONE?
POPJ CR,0; NO
SETZM @PK29; YES; ZERO ROV LINK
M54 A; FREE ROV CELL
POPJ CR,0;
SUBTTL P72A -- POP THE JOB PDL
; PUSHJ CR,P72A TO POP JOB PDL
INTERN P72A,P72B;
P72A: LDB A1,BYTE11; FOR-CLAUSE LINK
JUMPE A1,.+2; NONE
PUSHJ CR,P65; DELETE FOR-CLAUSE
SETZM CSA; NO CURRENT-STEP ADDRESS AFTER JOB POP
HRRZ A1,JPDL; LINK TO JOB PDL
JN A1,.+3;
SETZM JD;
POPJ CR,0; NOTHING TO POP.
M52 A1,A;
MOVEM A,U24; POP OBJECT NR.
HLLZM A1,U25;
M52 A1,A;
MOVEM A,CPI; POP CURRENT PART INDEX
HLRM A1,JD; AND FOR-CLAUSE LINK
M52 A1,A;
MOVEM A,CSI; POP CURRENT STEP INDEX
HLLM A1,JD; AND JOB STATUS BITS
HRRZM A1,JPDL;
LDB A1,BYTE9;
MOVEM A1,MODE; MODE = JOB STATUS
POPJ CR,0;
SUBTTL P72B -- PUSH THE JOB PDL
; PUSHJ CR,P72B
P72B: MOVE A,MODE;
DPB A,BYTE9; JOB STATUS=MODE
HRRZ A1,JPDL; LINK TO JOB PDL
MOVE A,CSI; PUSH CSI
M53A A,A1;
F A,JD;
HLLM A,1(A1); AND JOB STATUS BITS
MOVE A,CPI; CPI
M53A A,A1;
F A,JD;
HRLM A,1(A1); AND FOR-CLAUSE LINK
MOVE A,U24;
M53A A,A1; OBJECT NR
MOVE A,U25;
HLLM A,1(A1);
HRRZM A1,JPDL;
POPJ CR,0;
SUBTTL P73 -- FIND PART OR STEP FOR ITERATION
; PUSHJ CR,P73
; RETURN IF STEP
; RETURN IF PART
; A1 = LINK TO OBJECT HEADER
INTERN P73;
P73: MOVE A1,U24; PART/STEP NR
HLRE A2,U25;
CALL S78; GEN. PI/SI IN A1/A
PJ E25; BAD NR.
MOVEM A1,PK22; SAVE PI
MOVEM A,PK23; AND SI
MOVE A2,A1; SET UP FOR
HRRZI A1,PARTS; PI SEARCH
PUSHJ CR,P70L; LOOK FOR PART
PJ E29; NO SUCH PART
MOVE A1,A; SET UP FOR
MOVE A2,PK23; SI SEARCH
LDB B,BYTE6; WHAT ARE WE LOOKING FOR
CAIN B,1;
JRST P73.1; PART
PUSHJ CR,P70R ;ASSUME STEP
PJ E29;
MOVE A1,A;
POPJ CR,0;
P73.1: POP CR,A2;
J 1(A2);
SUBTTL P74 -- LOOK FOR NEXT STEP IN PROGRAM
; FIND CURRENT (NEXT) STEP AS SKIP=0(1)
; PUSHJ CR,P74
; DONE
; NORMAL RETURN
INTERN P74;
P74: HRRZ A,CSA; IS CSA STILL VALID
JUMPN A,P74.1; YES
HRRZI A1,PARTS; NO
MOVE A2,CPI;
PUSHJ CR,P70L; LOOK FOR PART
POPJ CR,0; NONE SUCH; DONE.
MOVE A1,A; FOUND
MOVE A2,CSI;
PUSHJ CR,P70R; LOOK FOR STEP
JRST P74.4; NONE SUCH, BOT MAY BE OK IF SKIPPING
HRRZM A,CSA; FOUND
P74.1: LDB B,BYTE10; ARE WE SKIPPING
JUMPE B,P74.2; NO
HRRZ A,1(A); YES; FETCH NEXT CSA
JUMPE A,P74.3; IS THERE ANOTHER -- NO
P74.11: MOVEM A,CSA; YES; UPDATE CSA
MOVE A2,(A); AND
MOVEM A2,CSI; CSI
P74.2: POP CR,A2;
J 1(A2);
P74.3: POPJ CR,0;
P74.4: HRRZ A,A; IS THERE A POTENTIAL NEXT STOP
JUMPE A,P74.3; NO; DONE IN ANY EVENT
LDB B,BYTE10; ARE WE SKIPPING
JUMPE B,P74.3; NO; DONE.
MOVE A2,CSI; YES; IS IT REALLY A SUCCESSOR TO CSI
CAMLE A2,(A);
POPJ CR,0; NO; DONE.
JRST P74.11; YES; UPDATE CSA AND CSI
SUBTTL S50
; S50 FETCHES NEXT BYTE TO CC
; U1 = CURRENT-BYTE POINTER
; PUSHJ CR S50
INTERN S50;
S50: ILDB CC,U1; NEXT BYTE
CAIGE CC,EOC1; IS IT EOC
POPJ CR,0; NO
CAILE CC,EOC2; MAYBE
POPJ CR,0; NO
; YES; SKIP TO NEXT CELL VIA S51
SUBTTL S51
; SKIP TO NEXT CELL OF STRING
; FIRST BYTE OF NEXT CELL TO CC
; U1 = CURRENT BYTE POINTER
; PUSHJ CR,S51
; CC = EOS IF NO MORE CELLS
INTERN S51;
S51: HRRZ CC,@U1; ADDRESS OF NEXT CELL
JUMPE CC,S51.1; NO MORE
HRLI CC,341000; POINT AT FIRST
MOVEM CC,U1; BYTE OF NEXT CELL
LDB CC,CC; FETCH IT
POPJ CR,0;
S51.1: HRLI CC,241000; RESET THE
HLLM CC,U1; POINTER.
MOVEI CC,EOS; CC BECOMES EOS
POPJ CR,0;
SUBTTL S52
; S52 TRANSFORMS 7-BIT ASCII STRING TO 8-BIT SURROGATE
; A = POINTER TO FIRST SOURCE BYTE
; A1 POINTS AT LAST SOURCE BYTE
; B = POINTER TO FIRST OBJECT BYTE
; PUSHJ CR S52
; UP1 = ZERO IF NULL LINE
; UP2 POINTS AT LAST BLANK BYTE
; UP3 IS NON ZERO IF TRANSMISSION ERRORS
INTERN S52;
S52: SETZB B1,B2; INITIAL CONDITIONS.
SETZM UP3;
F CC,K46; PREPARE TO MAKE COPY IN US0
M CC,US0;
S52.1: ILDB CC,A; NEXT SOURCE BYTE
IDPB CC,US0; COPY IN IMAGE STRING
CAIN CC,BADII; BAD CODE?
AOS UP3; YES
HLRZ CC,ST50(CC);
LSH CC,-11; 8-BIT SURROGATE (9 BIT FIELD)
CN A,A1; IS THIS THE LAST BYTE?
J S52.2; YES; FINISH UP.
IDPB CC,B; TO OBJECT STG.
CAIN CC,SP; CONTINUE -- IS IT A BLANK
JRST 0,S52.1; YES -- RECYCLE
CAIN CC,TAB; A LOWER CASE TAB?
JRST S52.1; YES
CAIN CC,UTAB; AN UPPER CASE TAB?
JRST S52.1; YES
JUMPN B1,.+2; IS THIS FIRST NON-BLANK -- NO
MOVE B1,B; YES -- RECORD AS SUCH
MOVE B2,B; RECORD AS LAST NON-BLANK
JRST 0,S52.1;
S52.2: AOS A2,LINE; INC. LINE COUNTER
CAMG A2,K21; LINE CTR = -1 IF PAGING REQUIRED
CAIN CC,PG;
SETOM LINE;
SETZM UP1; THINK POSITIVELY!
JUMPE B1,S52.3; ALL BLANK -- OLE
LDB CC,B1;
CAIN CC,STAR;
JRST 0,S52.3; STAR-HEAD -- CRAZY
LDB CC,B2;
CAIN CC,STAR;
JRST 0,S52.3; STAR-TAIL -- MMMMMM
SETOM UP1; BAH!!
S52.3: M B2,UP2; POINTS AT LAST BYTE.
MOVEI CC,EOS; APPEND EOS
JN B2,.+2; EVEN IF NOTHING HAS BEEN COLLECTED
F B2,B; BUT SPACE-LIKE CHARACTERS.
IDPB CC,B2;
POPJ CR,0;
SUBTTL S53
; S53 SEARCHES THRU LIST OF KNOWN WORDS FOR
; MATCH WITH SK11
; PUSHJ CR,S53
; NO-GO
; FOUND (B2 = LINE NR. IN KNOWN-WORD TABLE)
INTERN S53;
S53: PUSH CR,CP;
PUSH CR,PS;
FI B2,1;
S53.1: HRRZ A,ST51LO(B2);
JE A,S53.6;
HRRI PS,SK11;
F CP,SK6;
S53.2: F A1,1(A);
F A2,1(PS);
TRZ A2,17;
CAME A1,A2;
S53.3: AOJA B2,S53.1;
ADDI A,1;
ADDI PS,1;
SOJG CP,S53.2;
HRLI A,41000;
LDB A1,A;
CAIE A1,EOS;
JN A1,S53.3;
POP CR,PS;
POP CR,CP;
POP CR,A1;
J 1(A1);
S53.6: POP CR,PS; RESTORE THINGS
POP CR,CP;
POPJ CR,0; DONE
SUBTTL S54 -- SEVEN PAGES FORWARD IN LISTING
SUBTTL S55
; S55 DECOMPRESSES INT. TO 7-BIT ASCII
; B1=SOURCE PTR;B2=OBJECT POINTER
; PUSHJ CR,S55
INTERN S55;
S55: EXCH B1,U1; EXCHANGE U1 PTR.
S55.1: PUSHJ CR,S50; NEXT BYTE TO CC
CAIN CC,EOS; IS BYTE AN EOS
JRST S55.3; EOS -- FINI
CAILE CC,SP; DOES BYTE HAVE DIRECT TRANSLATE
JRST 0,S55.2; NO
CAIN CC,CS; A SINGLE CHARACTER?
J S55.4; NO; NEXT IS COMMENTARY STRING CODE
HLR CC,ST50(CC); YES -- GET TRANSLATE
CAMGE A2,WIDTH;
IDPB CC,B2; AND STORE UNLESS BUFFER FULL
AOJA A2,S55.1; INC BYTE COUNT AND CONTINUE.
S55.2: SUBI CC,SP; BYTE REPRESENTS A STRING.
PUSH CR,B1; SAVE POINTER
MOVE B1,ST51(CC); GET POINTER
S55.5: PUSHJ CR,S55; RE-ENTER
POP CR,B1; POP OLD POINTER
JRST 0,S55.1;
S55.3: EXCH B1,U1; RESTORE U1 PTR.
POPJ CR,0;
S55.4: PJ S50; NEXT BYTE IS COMMENTARY CODE
PUSH CR,B1; SAVE POINTER
MOVE B1,ST51.1(CC); NEW POINTER
JRST S55.5; RE-ENTER
SUBTTL S55X
INTERN S55X
; CONCATENATES AND CONVERTS JWS STRINGS
; INTO ASCII STRINGS
; B POINTS TO BEGINNING OF S64-LIKE CALLING SEQUENCE
; B2 POINTS TO DESTINATION STRING
; PUSHJ CR,S55X
S55X: SETZB A2,SK1; ZERO BYTE COUNT AND BREAK-POINTS
SETZM SK2;
S55X.0: F A1,(B); NEXT ON CALLING SEQUENCE.
CN A1,K20; ANY MORE?
J S55X.2; NO
JN A1,.+5; BREAKPOINT?
ADDI B,1; YES
M B,SK1;
M B2,SK2; SAVE CONTEXT
J S55X.0;
TLNE A1,400000; HAVE WE AN ACTUAL STRING?
J S55X.1; YES
F B1,A1;
TLNE B1,777777; AN ACTUAL POINTER?
J .+2; YES
F B1,(B1); NO; FETCH POINTER
PJ S55; COLLECT AND CONVERT TO ASCII
AOJA B,S55X.0;
S55X.1: HRR B1,B; CONSTRUCT POINTER TO ACTUAL STG
HRLI B1,341000;
PJ S55;
HRRZ B,B1;
AOJA B,S55X.0;
S55X.2: CAMG A2,WIDTH; LONG LINE?
J S55X.3; NO
FI CC,CGII;
SKIPN SK1; WAS THERE A BREAKPOINT?
J S55X.3-1; NO; ABBREVIATE THE LINE.
F B,SK1; RESTORE BREAKPOINT CONTEXT
F B2,SK2;
IBP B2; APPEND CG AND EOS
DPB CC,B2; CG
S55X.3: FI CC,EOSII; EOS
IDPB CC,B2;
POPJ CR,0;
SUBTTL S56
; S56 MOVES LINEAR, INT. STRING TO CELL LIST.
; U1=POINTER TO INPUT
; A=ADDRESS OF FIRST CELL
; PUSHJ CR S56
; A=ADDRESS OF LAST CELL
INTERN S56;
S56: MOVEI B2,6; INTR-CELL COUNT
MOVE A2,K16;
MOVEM A2,(A); EOS'S TO FIRST WORD OF CELL
HRR A2,1(A); EOSEOS,EOC,LINK TO SECOND
TRZ A2,600000;
TLO A2,1;
MOVEM A2,1(A);
HRRZ A1,A; GENERATE OUTPUT BYTE PTR
SUBI A1,1;
HRLI A1,41000;
SOS SIZE;
S56.1: ILDB A2,U1; MOVE NEXT BYTE
IDPB A2,A1;
CAIN A2,EOS; IS IT EOS
POPJ CR,0; YES
SOJG B2,S56.1; NO -- CYCLE ON COUNT
HRRZ A,(A1); END OF CELL; TO NEXT CELL.
JRST 0,S56;
SUBTTL S57
; SOURCE BYTES COLLECTED TO BREAK BYTE;
; U1 = SOURCE PTR.
; B = OUTPUT PTR.
; B1 = BREAK BYTE
; PUSHJ CR, S57
; B2 = BYTE COUNT
; B PTS AT LAST BYTE
; U1 PTS. AT BREAK BYTE
INTERN S57;
S57: SETZ B2,0;
S57.1: PUSHJ CR,S50; CC = NEXT SOURCE BYTE
CAMN CC,B1; IS IT BREAK
JRST S57.2; YES
IDPB CC,B; COLLECT IT
CAIN CC,EOS; IS IT AN EOS?
PJ E5; YES; EH?
AOJA B2,S57.1;
S57.2: MOVEI CC,EOS; APPEND EOS
IDPB CC,B;
ADDI B2,1;
POPJ CR,0;
SUBTTL S58
; CONVERT BYTE INDEX TO BYTE POINTER
; B1 = INDEX
; B2 = POINTER TO FIRST BYTE
; PUSHJ CR,S58
; B2 = BYTE POINTER
INTERN S58;
S58: HRRZ B2,B2;
SKIPN MODE; 6 PER CELL IF INDIRECT
JRST S58.3+1; 8 PER CELL IF DIRECT
AOJA B2,.+2;
S58.1: HRRZ B2,1(B2);
SUBI B1,6;
JUMPG B1,S58.1;
S58.2: SUBI B2,1;
ADD B2,ST53(B1);
POPJ CR,0;
S58.3: ADDI B2,2;
SUBI B1,10;
JUMPG B1,S58.3;
ADD B2,ST53X(B1);
POPJ CR,0;
SUBTTL S59
; COLLECT DUMMY LETTER LIST
; PUSHJ CR,S59
; T48 = NR. OF LETTERS IN LIST
; T48(I) = I-TH LETTER BYTE.
INTERN S59;
S59: SETZ B2,0;
INVOKE P51; CC=NEXT CHAR
HLRZ B,CC; IS IT A LEFT GROUPER
CAIE B,2;
JRST S59.2; NO
JUMPE B1,.+2; LEADING BLANKS?
PUSHJ CR,E5; NO; EH
F CC,T54(CC);
M CC,PK28; SAVE ITS ASSOCIATED RT. GRPR.
S59.1: INVOKE P51; NEXT CC
TLNE CC,777777;
PJ E5; EH IF NOT A LETTER
LDB CC,U1; GET LETTER BYTE.
ADDI B2,1; INC. COUNT
MOVEM CC,T48(B2);
INVOKE P51; NEXT CC
CAMN CC,T51.4; IS IT A COMMA
JRST S59.1; YES--CONTINUE
CAME CC,PK28; NO; IS IT THE EXPECTED RIGHT GROUPER?
PJ E5; NO
INVOKE P51; YEP--GET NEXT CC
S59.2: MOVEM B2,T48; SAVE COUNT
POPJ CR,0;
SUBTTL S54
; S54 REPLACES RECOGNIZABLE WORDS AND BLANK STRINGS
; BY SINGLE (8-BIT) BYTES.
; U1 POINTS TO BEGINNING OF LINE.
; PUSHJ CR,S54
; B1 = FINAL BYTE COUNT
; SK1 POINTS TO LATEST MEANINGFUL IF
; SK3 = INDEX OF PREDECESSOR OF IF
; UP2 POINTS AT LAST BYTE (NON-BLANK)
; T49X = INDEX OF LAST IMPROPER STRING
INTERN S54;
S54: MOVE B,U1;
SETZB B1,SK1;
SETZM T48;
SETZM T49;
SETZM T49X;
PUSH CR,CP; SAVE THINGS
PUSH CR,PS;
JRST 0,S54.2;
S54.1: IDPB CC,B; DEPOSIT BYTE
ADDI B1,1; COUNT IT
S54.2: ILDB CC,U1; FETCH BYTE
CAIN CC,QUOTE; ATTEND TO QUOTE MARKS
J S54.10;
LDB CP,BYTE15; WHAT KIND OF BEAST IS IT?
CAILE CP,2;
JRST 0,S54.1; NOT NOTEWORTHY
JRST .+1(CP);
JRST 0,S54.5; LETTER
JRST 0,S54.9; EOS
S54.3: MOVE B2,CC; B2=BLANK STG. OF LENGTH 1(BYTE SURROGATE)
S54.4: ILDB CC,U1; NEXT SOURCE BYTE
CAIE CC,SP; IS IT A BLANK
JRST S54.41; NO
CAIE B2,SPS; HAVE WE COLLECTED A MAX. SPACE STG.
AOJA B2,S54.4; NO KEEP COMING.
ADDI B1,1; YES; STORE IT
IDPB B2,B;
JRST S54.3;
S54.41: IDPB B2,B;
ADDI B1,1;
JRST 0,S54.2+1;
S54.5: MOVEM B,SK4; SAVE CONTEXT
MOVEM B1,SK5;
MOVE PS,SK11; POINTER TO TEMP. STG.
SETZ B2,0; LENGTH OF COLLECTEE
PAGE
S54.6: CAMGE B2,K7; DON'T COLLECT IF TOO LONG.
IDPB CC,PS; TO COLLECTEE
IDPB CC,B; AND TO OUTPUT
ADDI B1,1;
ADDI B2,1; INC. LENGTH
ILDB CC,U1; NEXT SOURCE BYTE
HRRZ CP,ST50(CC); ITS TYPE
JUMPE CP,S54.6; RE-CYCLE IF LETTER
MOVEI CP,EOS; APPEND EOS
IDPB CP,PS;
CAIG B2,1;
JRST S54.11; SINGLE LETTER
CAMLE B2,K7;
JRST S54.12; TOO LONG!
ADDI B2,1; OK; CORRECT COUNT!
SETZ CP,0;
TRNN B2,000003; FILL IN LAST WORD
JRST .+4; WITH ZEROES
IDPB CP,PS;
ADDI B2,1;
JRST .-4;
LSH B2,-2;
M B2,SK6; SAVE WORD LENGTH
SKIPN UP0; INTERESTED IN FIRST CHAR. OF WORD?
JRST S54.7; NO
MOVE PS,SK11; YES
ILDB B2,PS;
SUBI B2,32; MAKE IT UPPER CASE
CAILE B2,11; UNLESS IT ALREADY IS
DPB B2,PS;
SETZM UP0; LOOK AT FIRST WORDS ONLY.
S54.7: PUSHJ CR,S53; SEARCH THRU LIST OF KNOWN WORDS.
JRST S54.12; NOT FOUND
S54.8: ADDI B2,WORD; BYTE CODE FOR WORD
MOVE B,SK4; RESTORE OLD CONTEXT
MOVE B1,SK5;
CAIE B2,IF1; IS IT 'IF'
JRST 0,S54.41; NO
M B,T48; YES; NOTE POINTER
M B1,T49; AND INDEX OF PRECECESSOR
JRST 0,S54.41;
S54.9: MOVEM B,UP2;
IDPB CC,B;
ADDI B1,1;
F PS,T48;
M PS,SK1; POINTER TO LAST MEANINGFULL "IF"
F PS,T49;
M PS,SK3; INDEX OF ITS PREDECESSOR
POP CR,PS; RESTORE THINGS
POP CR,CP;
POPJ CR,0; DONE.
PAGE
S54.10: F CP,SK1;
JN CP,.+3; FIRST QUOTE?
HRRM B1,SK1; YES; NOTE IT
J S54.1; AND SIMPLY CONTINUE.
SETZM T48; ERASE EMBEDDED "IF"
SETZM T49;
S54.13: J S54.1;
S54.12: SETZM UP0;
SYN S54.12,S54.11;
JRST S54.2+1;
SUBTTL S60
; CLEAR ALL SCRATCH PDL'S; REFRESH CONSOLE.
; PUSHJ CR,S60
INTERN S60;
S60: HRRZ B,FPDL; FORMULAS LIST
PUSHJ CR,P62;
HRRZ B,PS; PROCESSOR LIST
PUSHJ CR,P62;
S60.1: HRRZ DS,DS; OBJECT-DESCRIPTOR LIST
JUMPE DS,S60.2; NONE
M52 DS,A; POP DESCRIPTOR
PUSHJ CR,P69; RELEASE OBJECT
JRST S60.1; RECYCLE
S60.2: M ACL,UACL; SAVE ACL
SETZB CP,UCP; AND
SETZB PS,UPS; REFRESH
SETZB DS,UDS; CONSOLE
SETZM FPDL;
SETZM U2; MAKE SURE DEMAND-RESPONSE IS NOT SET.
SKIPL U7; EXTRA CELLS?
J .+3;
SOS SIZE; YES; TAKE BACK TWO CELLS.
SOS SIZE;
SETZM U7;
SETZM U6; TURN OFF TYPING FLAG
F B,BASE;
M B,LEVEL; RESET TO BASE LEVEL.
POP CR,B;
MOVEI CR,JWSPDL;
JRST (B);
SUBTTL; S61,S62
; JSR S61; SAVES CONSOLE AND HSM
; JSR S62; RESTORES THEM
; ENTRIES ARE IN SCRATCH STORAGE
INTERN S61X,S62X;
S61X: MOVEM CR,UCR;
HRLI CR,A1;
HRRI CR,UA1;
BLT CR,UPS;
MOVEM CP,UCP;
MOVEM CC,UCC;
F CR,UCR;
JRST @S61;
S62X: HRLI CR,UA1;
HRRI CR,A1;
BLT CR,PS;
MOVE CP,UCP;
MOVE CC,UCC;
HRRZI CR,JWSPDL;
JRST @S62;
SUBTTL S63
SUBTTL S63, S63X
; EXTRACT LHS AND RHS FROM FOR CLAUSE
; A = LINK TO FOR CLAUSE
; PJ S63 TO EXTRACT BOTH; S63X FOR LHS ONLY(A1=LINK)
; SETS THINGS UP FOR P67
; DIMENSION,DICT.ADDRESS OF LHS LEFT IN A
INTERN S63;
S63: HRRZ A1,(A); LINK TO ROV
MOVE B1,(A1); DP OF ITERATION VARIABLE
MOVE A2,1(A1); AND XP
MOVEM B1,PK20; SAVE DP
HRRZ B1,TYPE2; ASSUME WE HAVE JNF
HLRZ A2,A2; LOOK AT XP
AND A2,MASK2; UNPACK IT.
CAMN A2,MASK9; TV?
SETZB A2,B1; YES; ADJUST THINGS ACCORDINGLY
CAML A2,MASK9; CORRECT SIGN FOR JNF XP
ORCM A2,MASK2;
MOVEM A2,PK21; SAVE XP
MOVEM B1,PK19; AND DESCRIPTOR
HLRZ A1,(A); LINK TO LHS
S63X: SETZ A,0;
TRNE A1,777777; ANY LEFT-HAND-SIDE?
MOVE A,(A1); YES,FETCH DIM AND DICT ADDRESS
HLRZM A,T48; T48 = DIMENSION
FI B1,1; I=1.
S63.1: CAMLE B1,T48;
POPJ CR,0;
MOVE A1,1(A1);
MOVE A2,(A1);
AND A2,MASK1;
M A2,T48(B1); T48(I)=I-TH INDEX VALUE
AOJA B1,S63.1;
SUBTTL S64
; MOVES GENERAL STRINGS INTO LINEAR STG.
; A = POINTER TO FIRST DESTINATION BYTE
; JSP B,S64,
; VECTOR OF POINTER ADDRESSES, ACTUAL POINTERS OR
; ACTUAL STRINGS (FIRST BYTE = 277)
; DEC -1 INDICATES END OF CALLING SEQUENCE.
; NORMAL RETURN; EOS'S ARE NOT MOVED
INTERN S64;
S64: MOVE A1,(B); NEXT ARGUMENT
CAME A1,K20; ANY MORE STRINGS?
JRST .+4; YES; CONTINUE.
MOVEI CC,EOS; NO; APPEND EOS.
IDPB CC,A;
JRST 1(B); DONE.
JE A1,S64; IGNORE LONG LINE BREAKS
SETZ B1,0; SET FLAG ASSUMING WE HAVE POINTER
TLNE A1,400000; IS IT AN ACTUAL STRING?
JRST .+4; YES
TLNN A1,777777; POINTER ADDRESS OR POINTER?
MOVE A1,(A1); POINTER; FETCH IT
JRST S64.0;
SETO B1,0; RESET FLAG TO INDICATE ACTUAL STRING
HRR A1,B; AND CONSTRUCT POINTER
HRLI A1,341000; TO SECOND BYTE
S64.0: XCH A1,U1; SWAP POINTERS TO
S64.1: PJ S50; FETCH NEXT BYTE
CAIN CC,EOS; IS IT AN EOS?
JRST S64.2; YES
IDPB CC,A; NO; DEPOSIT BYTE
JRST S64.1;
S64.2: XCH A1,U1; RESTORE POINTERS
JE B1,.+2;
HRRZ B,A1 ;ADJUST IF WE HAD ACTUAL STG
AOJA B,S64;
SUBTTL S65
; PEEK AT NEXT BYTE. IS IT A SPACE?
; PUSHJ CR,S65
; NO
; YES
INTERN S65;
S65: MOVE A,U1; SAVE POINTER
PUSHJ CR,S50; CC = NEXT BYTE
F CC,T51(CC); CC = ITS DESCRIPTOR
CE CC,K19; IS IT SPACE-LIKE?
JRST S65.1; NO
M A,U1;
POP CR,A;
J 1(A);
S65.1: M A,U1; RESTORE POINTER.
POPJ CR,0;
SUBTTL S65X
; EXTRACT FORM FIELD SPECIFICATIONS
; PJ S65X
; PK36 = LEFT UNDERS, RIGHT UNDERS; PK37=DOTS
; A2=DOTS
S65X: SETZB A1,A;
SETZ A2,0;
F B,U1;
PJ S50; NEXT BYTE
CAIE CC,EOS; EOS?
J S65X.2; NO
S65X.1: M B,U1; RESTORE POINTER
HRLM A1,PK36;
HRRM A,PK36;
M A2,PK37;
POPJ CR,0;
S65X.2: CAIN CC,UNDER;
AOJA A1,S65X.3;
CAIE CC,DOT;
J S65X+2;
ADDI A2,1;
S65X.7: PJ S50; COLLECTING DOTS
CAIN CC,UNDER;
AOJA A,S65X.4; COLLECT RIGHT UNDERSCORES
CAIN CC,DOT;
AOJA A2,S65X.7;
JE A1,S65X.6; NO LEFT UNDERSCORES!
SOJE A2,S65X.1; ALLOW UP TO THREE DOTS AFTER ^^^^
SOJE A2,S65X.1;
SOJE A2,S65X.1;
CAIG A2,1;
J S65X.1; ALSO ^^^^^....
PJ E44; OTHERWISE, FUZZY FIELDS.
S65X.6: CAILE A2,3; IGNORE UP TO THREE DOTS
J S65X.1; MORE THAN THREE.
CAIN CC,EOS; FINI IF EOS
J S65X.1;
J S65X;
S65X.3: PJ S50; COLLECTING LEFT UNDERSCORES
CAIN CC,UNDER;
AOJA A1,S65X.3;
CAIE CC,DOT;
J S65X.1;
AOJA A2,S65X.7;
S65X.4: PJ S50; COLLECTING RIGHT UNDERSCORES
CAIN CC,UNDER;
AOJA A,S65X.4;
CAIN A2,1; ALLOW A SINGLE DOT
J S65X.1;
PJ E44; OTHERWISE, FUZZY FIELDS
SUBTTL S66
; BINARY INTEGER TO JWS STRING
; B1 = INTEGER
; A POINTS TO DESTINATION STRING
; PJ S66; A POINTS AT LAST BYTE
; T61 CONTAINS NR OF BYTES GENERATED
INTERN S66;
S66: SETZM T61;
JGE B1,S66.0;
MOVN B1,B1;
FI B,MINUS;
IDPB B,A;
AOS T61;
S66.0: FI B2,1;
S66.1: IDIVI B1,^D10;
PUSH CR,B;
JUMPE B1,S66.2;
AOJA B2,S66.1;
S66.2: ADDM B2,T61;
S66.3: POP CR,B;
IDPB B,A;
SOJG B2,S66.3;
POPJ CR,0;
; DITTO FOR 4 DIGIT NAVY TIME
S66T: FI B2,4;
IDIVI B1,^D10;
PUSH CR,B;
SOJN B2,.-2;
FI B2,4;
J S66.3;
SUBTTL S66Y
; CANCELS ALL OR CURRENT
S66Y: SKIPN JPDL;
POPJ CR,0;
PJ P72A;
SKIPN UP0;
J S66Y;
SKIPE MODE;
J S66Y;
POPJ CR,0;
SUBTTL S67
; CONVERTS JNF TO JWS STRING
; A = POINTER TO DESTINATION STRING
; A1,A2 = JNF NR.
; B1=OFFSET; USED BY S80 FOR DEC PT ALIGNEMENT
; PUSHJ CR,S67; A POINTS AT EOS
INTERN S67;
S67: CALL S80;
FI CC,EOS;
IDPB CC,A;
POPJ CR,0;
SUBTTL S67Y
; S67Y CONVERTS PART/STEP INDEX IN A1,A2 TO
; JWS STRING IN US4
S67Y: CALL S81; CONVERT TO JNF
F A,US4;
CALL S79; CONVERT TO JWS STRING IN US4
FI CC,EOS;
IDPB CC,A;
POPJ CR,0;
SUBTTL S67X
; ARE WE IN A FORMULA AT ERROR-POINT?
; PJ S67X
; RETURN IF NOT SO
; RETURN IF SO, WITH IDENT STRING IN US7
S67X: HRRZ B,FPDL; FIRST ON FPDL
JE B,S67X.1; NO MORE
HLLZ B2,1(B);
TLZ B2,IDM;
HRRZ B,1(B); POINTER TO NEXT ON FPDL
JE B2,.-4; KEEP SEARCHING IF FUNCTIONAL
TLO B2,724; APPEND EOS
M B2,US7;
POP CR,B;
J 1(B); AND FINI
S67X.1: POPJ CR,0;
SUBTTL S68
; MOVE TO FIRST NON-SPACE
; PUSHJ CR,S68; U1 = PTR TO STG
INTERN S68;
S68: F A,U1; SAVE PTR
PJ S50; NEXT BYTE
F CC,T51(CC); ITS DESC.
CN CC,K19; IS IT SPACE-LIKE?
J S68; YES
M A,U1; NO; RESTORE PTR
POPJ CR,0;
SUBTTL S69
; SEND UNDERSCORES AND SYSTEM PROPERTIES
; JSP B,S69 A=DESCRIPTOR
INTERN S69;
S69: HRRZM B,UX2; SAVE CALLER
F A1,S69A(A);
PJ S70D; GEN INDENTATION
F A1,S69B(A);
M A1,US3+1; APPROPRIATE LHS STRING
F B1,LINE(A); GET APPROPRIATE VALUE.
F A1,A;
F A,US2;
XCT S69.2(A1); PROCESS SELECTIVELY
S69.1: FI CC,EOS; APPEND EOS TO VALUES
IDPB CC,A;
JSP B,X48;
XWD 0,US6;
XWD 0,US3;
BYTE (8)277,COLON,SP+1,EOS;
XWD 0,US2;
BYTE (8)277,CG,EOS;
DEC -1;
J @UX2;
S69.2: J S69.3; UNDERSCORE
PJ S66; SIZE
PJ S66T; TIME
PJ S66; USERS
S69.3: JSP B,X48; SEND TO USER
BYTE (8)277,CG,EOS;
DEC -1;
J @UX2;
S69A: DEC 0;
DEC 4;
DEC 4;
DEC 5;
S69B: BYTE (8)EOS,
BYTE (8)BSIZE,EOS,
BYTE (8)BTIME,EOS,
BYTE (8)BUSERS,EOS,
SUBTTL S69X -- SET SIZE, TIME AND USERS
S69X: HRRZ B1,SPACE;
SUBI B1,INTENT ;***BEGINNING OF USER AREA
SUB B1,K36;
LSH B1,-1;
ADD B1,K32;
SUB B1,SIZE;
M B1,USIZE;
F A1,SECONDS;
SUB A1,USEC;
IMULI A1,^D10;
IDIVI A1,6;
SETZ A2,0;
CALL S81;
JE A1,.+2;
SUBI A2,2;
M A1,UMIN;
M A2,UMIN1;
F B1,HR;
IMULI B1,^D100;
ADD B1,MIN;
M B1,UTIME;
F B1,USERS;
M B1,UUSERS;
POPJ CR,0;
SUBTTL S69Y -- SET INITIAL SIZE AND LINK ACL
S69Y: F A,K32;
M A,SIZE;
ADDI A,2; TWO CELL ACE-IN-THE-HOLE
FI A1,UACL;
FI A2,VEND;
F ACL,A2;
M A2,(A1);
ADDI A2,1;
F A1,A2;
ADDI A2,1;
SOJG A,.-4;
SETZM (A1); ZERO THE LAST LINK
POPJ CR,0;
SUBTTL S70A -- SEND A STEP
; JSP B,S70A A LINKS TO STEP HEADER
INTERN S70A;
S70A: HRRZM B,UX2; SAVE CALLER.
JSR S61; SAVE CONSOLE REGISTERS.
F A1,PK22; FETCH PART INDEX
F A2,(A); AND STEP INDEX
M A2,PK23;
PJ S67Y; CONVERT TO STRING IN US4
F A,UA;
HLRZ A,1(A);
HRLI A,141000;
M A,US5; PTR TO TEXT OF STEP
HRLI A,341000;
LDB B1,A; NR OF LEADING SPACES
F A1,US3;
SETZ B,0;
FI CC,SPS;
JE B1,S70A.1;
SUBI B1,10;
JLE B1,.+3;
IDPB CC,A1; TO US2 AS SPACE STRING
J .-4;
ADDI B1,SP+7;
IDPB B1,A1;
S70A.1: FI CC,EOS;
IDPB CC,A1; APPEND EOS.
ILDB B1,A; NR OF TRAILING ZEROES
F A1,US2; TO US2
JE B1,S70A.2;
FI CC,DOT;
SKIPE PK23; ANY FRACTIONAL PART?
SETZ CC,0; YES; NO LEADING DOT.
IDPB CC,A1;
SOJG B1,.-2;
S70A.2: FI CC,EOS;
IDPB CC,A1; APPEND EOS
JSR S62; RESTORE CONSOLE
JSP B,X47; ACKNOWLEDGE IN SIGNALS ETC.
OCT 6;
JSP B,X48; SEND TO USER
XWD 0,US3; LEADING BLANKS
XWD 0,US4; STEP NUMBER
XWD 0,US2; TRAILING DOT AND ZEROES
OCT 0; LONG-LINE BREAK
XWD 0,US5; TEXT
BYTE (8)277,CG,EOS;
DEC -1;
J @UX2;
SUBTTL S70B
; SEND A FORMULA
; JSP B,S70B A LINKS TO HEADER
INTERN S70B;
S70B: HRRZM B,UX2;
HRRZ A1,(A); TO RHS
SUBI A1,1;
HRLI A1,41000; POINTS TO RHS
M A1,U1;
M A1,US5;
HLRZ A1,1(A); NR OF PARAMS
LSH A1,1; MESS AROUND.
JE A1,.+2;
ADDI A1,1;
ADDI A1,1; A1=LENGTH OF LHS
SETZ B1,0; B1 WILL CONTAIN LENGTH OF RHS
S70B4: PJ S50; NEXT BYTE
CAIN CC,EOS; EOS?
J S70B7; YES
CAIGE CC,SP; SPACE STRING?
AOJA B1,S70B4;
CAILE CC,SPS;
J S70B5; NO; WORD.
SUBI CC,SP-1; YES ITS LENGTH
ADD B1,CC;
J S70B4;
S70B5: SUBI CC,SP;
MOVE B2,ST51(CC); POINTER TO WORD.
XCH B2,U1; HOLD OLD POINTER
S70B6: PJ S50; NEXT BYTE IN WORD
CAIE CC,EOS;
AOJA B1,S70B6;
XCH B2,U1; RESTORE POINTER.
J S70B4;
S70B7: ADD B1,K25; RHS LENGTH PLUS INDENTATION
ADDI B1,4; PLUS 4 IS LINE LENGTH
SUB B1,WIDTH; WILL IT FIT?
JL B1,.+2; YES.
ADD A1,B1; TOO LONG; FORCE INDENTATION SHIFT
PJ S70D; SET INDENTATION AND OFF-SET
S70B8: F CC,A;
ROT CC,10; THE LETTER DESIGNATOR.
F A1,US2; COLLECT LEFT-HAND-SIDE IN US2
IDPB CC,A1; LETTER DESIGNATOR
HLRZ A,(A); LINK TO DLS
JE A,S70B3; NO PARAMETERS
SUBI A,1;
HRLI A,41000; POINTS TO DLS
M A,U1; PREPARE TO COLLECT DLS
FI CC,LEFT;
IDPB CC,A1; APPEND LEFT PAREN
PAGE
S70B1: PJ S50; NEXT DUMMY LETTER
CAIN CC,EOS; EOS?
J S70B2; YES; ALMOST DONE
IDPB CC,A1; NO; COLLECT LETTER
FI CC,COMMA; AND
IDPB CC,A1; COMMA
J S70B1;
S70B2: FI CC,RIGHT;
DPB CC,A1; RIGHT PAREN REPLACES LAST COMMA
S70B3: FI CC,EOS;
IDPB CC,A1; APPEND EOS
SKIPE UDF1; SENDING TO DISK?
J S70B9; YES
JSP B,X48; SEND TO USER
XWD 0,US6;
XWD 0,US2;
BYTE (8)277,COLON,SP+1,EOS;
OCT 0;
XWD 0,US5;
BYTE (8)277,CG,EOS;
DEC -1;
J @UX2;
S70B9: JSP B,X48; SEND TO DISK
BYTE (8)277,221,SP,EOS; LET
XWD 0,US2; LHS
BYTE (8)277,EQUALS,EOS; =
XWD 0,US5; RHS
BYTE (8)277,PERIOD,CG,EOS;
DEC -1;
J @UX2;
SUBTTL S70C
INTERN S70C;
; SEND A VALUE LINE
; JSP B,S70C
; UP1 POINTS TO START OF LHS; VALUE ON DS
S70C: HRRZM B,UX2;
F A1,UP1;
M A1,U1; UP1 POINTS TO LHS IN TYPE LINE
PJ S68; ADVANCE TO FIRST NON-SPACE
FI A1,T48; PREPARE TO DEAL WITH CONDITIONAL EXP.
F A,US2;
J .+2;
S70C0: IDPB CC,A; STORE LAST BYTE IN OUTPUT STRING
F B,A; B POINTS TO LAST NON-BLANK BYTE
S70C1: PJ S50; NEXT BYTE
CAIN CC,COMMA2; END OF TYPE EXPRESSION?
J S70C7; YES
CN CC,UP2; MAYBE
J S70C7; YES
CAIL CC,SP; NO; SPACE OR WORD?
J S70C2; YES
LDB A2,BYTE14; CLOSER LOOK
XEC .+1(A2);
J S70C0; UNIMPORTANT NON-BLANK
J S70C7; EOS
J S70C0; SEMI-COLON
PUSH A1,A; LEFT GROUPER; DROP A PAREN LEVEL
SUBI A1,1; RIGHT GROUPER
J S70C14; ALPHA; BACKTRACK IN OUTPUT STRING
J S70C13; OMEGA1
J S70C4; OMEGA2
S70C2: SUBI CC,SP; SPACE OR WORD
F A2,ST51(CC); POINTER TO IT.
XCH A2,U1; HOLD OLD POINTER
S70C3: PJ S50; NEXT BYTE
CAIE CC,EOS;
J .+3; MORE TO COME
XCH A2,U1; EOS; BACK TO MAIN STREAM.
J S70C1;
IDPB CC,A; SEND BYTE TO OUTPUT STREAM
CAIE CC,SP; SPACE
F B,A; NO; NOTE POINTER
J S70C3;
S70C4: FI A2,1; PREPARE TO SKIP OVER REST OF EXPRESSION
S70C5: PJ S50; NEXT BYTE
CAIN CC,LEFT;
AOJA A2,S70C5; UP COUNT FOR LEFT GROUPERS
CAIN CC,LEFTB;
AOJA A2,S70C5;
CAIN CC,RIGHT;
J S70C6;
CAIE CC,RIGHTB;
J S70C5;
S70C6: SOJG A2,S70C5; DROP COUNT FOR RIGHT GROUPERS
SOJA A1,S70C0;
PAGE
S70C7: F A1,B;
SUBI A1,US2; COMPUTE LENGTH OF OUTPUT STREAM
HLRZ A2,A1;
HRRZ A1,A1;
LSH A1,2;
LSH A2,-17;
SUB A1,A2;
F CC,U1;
M CC,UP1; MARK END OF EXPRESSION
FI CC,EOS;
IDPB CC,B; APPEND EOS
PJ S70D; SET INDENTATION AND OFF-SET
INVOKE P53; POP VALUE
SKIP ; TV'S ALREADY LEGISLATED
S70C10: LDB B2,BYTE2; LOOK AT TYPE
JN B2,.+3; TV?
PJ S70C11; YES
J .+3;
F A,US4; JNF,CONVERT TO STRING IN US4.
PJ S67;
JSP B,X48; SEND TO USER
XWD 0,US6;
XWD 0,US2; LHS
OCT 0; LONG-LINE BREAK
XWD 0,K23;
XWD 0,US4; RHS
BYTE (8)277,CG,EOS;
DEC -1;
J @UX2;
S70C11: F A,S70C12;
JE A1,.+2;
F A,S70C12+1;
FI B,1;
M A,US4(B);
POPJ CR,0;
S70C12: BYTE (8)SP+4,263,EOS; FALSE
BYTE (8)SP+4,264,EOS; TRUE
S70C13: ILDB CC,(A1);
ADDI CC,1;
SOJA A1,S70C0; CORRECT RT GRPR AND CONTINUE
S70C14: F A,(A1);
IBP A;
J S70C0+1;
SUBTTL S70D
; GENERATE INDENTATION STG POINTER
; A1 = NORM OF LHS STRING
; PJ S70D
; B1=OFF-SET; A1 AND US6 POINT TO INDENT STG
INTERN S70D;
S70D: SETZ B1,0; ASSUME NO OFF-SET
SUB A1,K25;
JLE A1,.+3; SO IT IS.
F B1,A1; OFFSET IS DIFFERENCE.
SETZ A1,0; NO INDENT
ADD A1,T60; GEN. INDENT. PTR.
M A1,US6;
SKIPN UDF1; TO DISC?
POPJ CR,0; NO
F A1,T60; YES; NO INDENTATION
M A1,US6;
FI B1,11; OR OFF-SET.
POPJ CR,0;
SUBTTL S70E
; SEND A FORM
; JSP B,S70E SENDS IDENTIFICATION AND FORM
; JSP B,S70EX SENDS FORM ONLY
; A LINKS TO FORM HEADER
INTERN S70E;
S70EX: HRRZM B,UX2; SAVE CALLER
M A,UP4; AND LINK TO FORM HEADER
SKIPN UDF1; PRINT ID IF GOING TO DISK
J S70E.1;
S70E: HRRZM B,UX2; SAVE CALLER
M A,UP4; SAVE FORM LINK
F B1,(A); FORM NR
F A,US2;
PJ S66;
FI CC,EOS;
IDPB CC,A;
SOS LINE; INHIBIT PAGING
JSP B,X48; SEND TO USER
BYTE (8)277,BFORM,SP,EOS;
XWD 0,US2;
BYTE (8)277,COLON,CG,EOS;
DEC -1;
F A,UP4;
AOS LINE;
S70E.1: HRRZ A,1(A); LINK TO FORM ITSELF
SUBI A,1;
HRLI A,41000; POINTS TO FORM
M A,US5;
JSP B,X48;
XWD 0,US5;
BYTE (8)277,CG,EOS;
DEC -1;
J @UX2;
SUBTTL S70F
; SEND A SCALAR VALUE
; JSP B,S70F A,UP4 BOTH CONTAIN DESCRIPTOR
INTERN S70F;
S70F: HRRZM B,UX2;
F CC,A;
ROT CC,IDN;
F A1,US2;
IDPB CC,A1; LETTER BYTE
FI CC,EOS;
IDPB CC,A1;
FI A1,1;
PJ S70D; GEN INDENT AND OFF SET
F A1,(A); DP
HLRZ A2,1(A); XP
PJ P57Y; UNPACKED
J S70C10; MERGE WITH VALUE LINE ROUTINE.
SUBTTL S70G
; GENERATE LHS FOR TYPE LINE
; DIMENSION AND SUBSCRIPTS IN T48 ON
; CC=DESCRIPTOR; A POINTS TO OUTPUT
; PJ S70G;
; PJ S70GX TO LEAVE OPEN LHS
; A1 = BYTE COUNT OF GEN. STRING.
INTERN S70G,S70GX;
S70G: PJ S70G0;
SKIPE T48;
J S70G3;
POPJ CR,0;
S70GX: PJ S70G0;
SKIPE T48;
J S70G2;
POPJ CR,0;
S70G0: ROT CC,IDN;
IDPB CC,A; START WITH LETTER BYTE
F A1,T48;
JE A1,S70G2; NO SUBSCRIPTS
ADDI A1,1;
FI CC,LEFT;
IDPB CC,A; APPEND LEFT PAREN
FI A2,1;
S70G1: CAMG A2,K29;
J S70G4; NO
FI CC,DOT;
IDPB CC,A;
IDPB CC,A;
IDPB CC,A;
SUB A1,T48;
ADDI A1,3;
ADD A1,K29;
F A2,T48;
J S70G5;
S70G4: HLRZ B1,T48(A2); NEXT INDEX VALUE
LSH B1,INDEX-22; UNPACK IT.
AND B1,MASK2;
CAML B1,MASK9;
ORCM B1,MASK2;
PJ S66; SEND TO OUTPUT
ADD A1,T61; INC. BYTE COUNT
S70G5: FI CC,COMMA;
IDPB CC,A; APPEND COMMA
CE A2,T48; DONE?
AOJA A2,S70G1; NO
POPJ CR,0; YES
S70G3: FI CC,RIGHT; RIGHT PAREN
DPB CC,A; OVER-WRITES LAST COMMA.
S70G2: ADDI A1,1;
FI CC,EOS;
IDPB CC,A; APPEND EOS
POPJ CR,0; DONE.
SUBTTL S71 -- SEND AN ARRAY
; JSP B,S71, DESCRIPTOR IN A
INTERN S71;
S71: HRRZM B,UX2; SAVE CALLER
M A,UP4; AND DESCRIPTOR
J S71.0; SEND COMPONENTS
S71.01: F A,UP4;
TLNN A,SPARSE; SPARSE?
J @UX2; NO; DONE.
F CC,A;
F A,US2;
SETZM T48;
PJ S70G;
SKIPE UDF1; TO DISC?
J S71.00; YES; NEED DIFFERENT MESSAGE
JSP B,X48;
XWD 0,US2; SAY IT IS SPARSE.
BYTE (8)277,SP,54,66,SP,303,CG,EOS;
DEC -1;
J @UX2;
S71.00: JSP B,X48; SEND TO DISC
BYTE (8)277,221,SP,EOS; LET
XWD 0,US2; ...
BYTE (8)277,SP,302,SP,303,DOT,CG,EOS; BE SPARSE
DEC -1;
J @UX2;
PAGE
S71.0: HLRZ A1,1(A);
M A1,UP5; SAVE DIMENSION
SETZ A1,0; STACK LEVEL TO ZERO.
S71.1: HRRZ A,(A); NEXT HEADER LINK
ADDI A1,1;
M A,UP12(A1); STACK IT IN USER BLOCK
CE A1,UP5; ANY MORE?
J S71.1; YES
S71.2: M A,UP6; SAVE LAST HEADER LINK
M A1,UP8; LEVEL=DIMENSION
S71.3: F A1,UP5; START TO PICK OFF IV'S
SUBI A1,1; IGNORING LAST ONE.
M A1,T48; HOLD FOR FUTURE USE BY S70GX
JE A1,S71.5; ANY MORE?
S71.4: F B2,UP12(A1); FETCH NEXT HEADER LINK
F A2,1(B2); FETCH INDEX VALUE
AND A2,MASK1; MASKED CLEAN
M A2,T48(A1); STACK IT.
SOJG A1,S71.4; RE-CYCLE IF MORE.
S71.5: F A,US2; COLLECT IN US2:
F CC,UP4;
PJ S70GX; GENERATE LHS
SKIPE T48; VECTOR?
J .+6; NO
FI CC,LEFT; YES; APPEND LEFT PAREN
DPB CC,A;
FI CC,EOS;
IDPB CC,A; AND EOS
ADDI A1,1; ADJUST BYTE COUNT
M A1,UP7; SAVE BYTE COUNT.
S71.8: HRRZ A,UP6; NEXT COMPONENT AT BOTTOM LEVEL
JE A,S71.9; NO MORE
HLRZ A2,1(A); ITS IV
PJ P57X; UNPACKED
F B1,A2;
F A,US3; COLLECT IN US3:
PJ S66; FINAL IV
FI CC,RIGHT;
IDPB CC,A; RIGHT PAREN
FI CC,EOS;
IDPB CC,A; AND EOS
F A1,UP7;
ADD A1,T61;
ADDI A1,1; A1=BYTE COUNT OF LHS STRING
PAGE
PJ S70D; GENERATE INDENTATION
F A,UP6;
F A2,1(A);
HRRZM A2,UP6; LINK TO NEXT COMPONENT
F A1,(A); DP OF COMPONENT
HLRZ A2,A2; XP
AND A2,MASK2;
CE A2,MASK9; TV?
J .+3; NO
PJ S70C11;
J .+4; FIELD FILLED WITH TRUE OR FALSE
PJ P57Y; UNPACKED
F A,US4;
PJ S67; COLLECT RHS VALUE IN US4
JSP B,X47; RECALLS AND IN-REQUESTS
OCT 6;
JSP B,X48; SEND TO USER
XWD 0,US6; INDENT
XWD 0,US2; LHS
XWD 0,US3; LHS TAIL
OCT 0;
XWD 0,K23;
XWD 0,US4; RHS
BYTE (8)277,CG,EOS;
DEC -1;
J S71.8;
S71.9: SOSG A1,UP8; DONE?
J S71.01; YES; MAY HAVE TO NOTE SPARSENESS.
F A,UP12(A1); NO; FETCH NEXT HEADER
HRRZ A,1(A); AND MOVE OUT
JE A,S71.9; DONE AT THIS LEVEL.
M A,UP12(A1); STACK NEW HEADER LINK
J S71.1; AND DO IT ALL AGAIN.
SUBTTL S72
; SEND A PART
; JSP B,S72 A LINKS TO HEADER
INTERN S72;
S72: HRRZM B,UX1;
M A,UP4;
F B,(A);
M B,UP8; PART NR.
S72.1: F A,UP8;
M A,PK22;
F A,UP4;
HRRZ A,1(A); TO STEP
M A,UP4;
JE A,@UX1; NO MORE
JSP B,S70A; SEND STEP
J S72.1;
SUBTTL S73
; SEND ALL FORMULAS,ARRAYS OR SCALARS
; AS A1=0,1 OR 2
; JSP B,S73
INTERN S73;
S73: HRRZM B,UX1;
HRROS UP10; SPACE BEFORE TYPING!
M A,UP9;
HRRI A,V;
S73.1: HRLM A,UP9;
HLRZ A,UP9;
HLRZ A2,1(A);
CE A2,LEVEL; DEFINED AT THIS LEVEL?
J S73.2; NO; IGNORE.
F A,(A); NEXT DESCRIPTOR FROM DICTIONARY
M A,UP4;
LDB A1,BYTE2; TYPE OF ENTRY
F A2,UP9;
XCT S73.3(A2);
J S73.2;
JSP B,X47; ACKNOWLEDGE RECALLS AND IN-REQU
OCT 6;
SKIPL UP10; SPACE A LINE FIRST?
J S73.5; NO
HRRZS UP10; NOTE THAT WE HAVE
JSP B,X48; SPACED A LINE.
BYTE (8)277,CG,EOS;
DEC -1; LINE SPACE.
S73.5: XCT S73.4(A2);
S73.2: HLRZ A,UP9;
ADDI A,2; TO NEXT DICT. ENTRY
CAIGE A,VEND; ANY MORE?
J S73.1; YES
J @UX1;
S73.3: CE A1,TYPE4;
JSP B,S73.6;
CLE A1,TYPE2;
S73.4: JSP B,S70B;
JSP B,S71;
JSP B,S70F;
S73.6: CE A1,TYPE3;
J S73.2;
HLRZ A1,1(A);
CE A1,UP11; RIGHT DIMENSION?
J S73.2; NO
HRROS UP10; YES; SPACE A LINE BEFORE ARRAYS!
J 1(B);
SUBTTL S74A
; DELETE A STEP
; PJ S74A
; A CONTAINS LINK TO PRECEEDING HDR,LINK TO HDR
; B IS DITTO FOR GERMANE PARTS
INTERN S74A;
S74A: HLRZ A1,A;
HRRZ A,A;
HLRZ B,1(A); LINK TO STEP PROPER
PJ P62; DELETE IT
HRRZ B,1(A); RE-LINK STEP HEADERS
HRRM B,1(A1);
M54 A; DELETE HEADER CELL
CN A,CSA; HAVE WE DELETED CURRENT STEP FOR EXEC.
SETZM CSA; YES; NOTE THE FACT.
HRR A,PK40;
HRRZ B,1(A);
JE B,.+2; HAVE WE WIPED OUT THE PART
POPJ CR,0; NO; DONE
HLR A1,PK40; YES; RE-LINK PART HEADERS
HLL B,1(A);
HLLM B,1(A1);
M54 A; DELETE HEADER CELL
POP CR,A1;
J 1(A1); SKIP RETURN
SUBTTL S74B
; DELETE AN ELEMENT
; A-DICT.ADDRESS; T48=NR OF SUBSCRIPTS
; T48(I)=I-TH SUBSCRIPT
; PJ S74B;
INTERN S74B;
S74B: SKIPE T48; SUBSCRIPTED?
J S74B1; YES
PJ P60; NO; DELETE ELEMENT
POPJ CR,0; DONE.
S74B1: F A2,(A); LOOK AT ENTRY
LDB A1,BYTE3; ITS TYPE
CE A1,TYPE3; AN ARRAY?
POPJ CR,0; NO; DONE.
HLRZ A1,1(A2);
CE A1,T48; DIM = NR OF SUBSCRIPTS?
POPJ CR,0; NO; DONE
M A,PK9; SET UP FOR COMPONENT SEARCH
M A2,PK8;
PJ P56; SEARCH!
POPJ CR,0; NOT FOUND; DONE
PJ P68; FOUND; DELETE COMPONENT
POPJ CR,0; DONE.
SUBTTL S74C
; DELETE A FORM
; A=PK39 = LINK TO PREC. HDR., LINK TO HEADER
; PJ S74C
INTERN S74C;
S74C: HLRZ A1,A;
HRRZ A,A;
HRRZ B,1(A); LINK TO FORM
PJ P62; DELETE IT.
HLRZ B,1(A);
HRLM B,1(A1); RE-LINK HEADERS
M54 A; RELEASE HEADER CELL
POPJ CR,0;
SUBTTL S74D
; DELETE ALL FORMULAS, ARRAYS, SCALARS
; AS: A = 0, 1, 2
; PJ S74D
INTERN S74D;
S74D: M A,UP9;
HRRI A,V;
S74D1: HRLM A,UP9;
F A1,(A); NEXT DICTIONARY ENTRY
LDB A1,BYTE1; ITS TYPE
F A2,UP9;
XCT S74D2(A2);
PJ P60; DELETE IF APPLICABLE
HLRZ A,UP9;
ADDI A,2; ADVANCE DICTIONARY POINTER
CAIGE A,VEND; DONE?
J S74D1; NO
POPJ CR,0;
S74D2: CN A1,TYPE4; SKIP IF NOT A FORMULA
CN A1,TYPE3; NOT AN ARRAY
CAMG A1,TYPE2; NOT A SCALAR
SUBTTL D50: FROM TYPE-OUT ROUTINES VIA X48
D50: F CC,UDF1;
CAIG CC,5; ADDMISSIBLE DISC ACTION?
J .+1(CC);
PJ E54; INADMISSIBLE RESULT
PJ E54; READING DISC
J D53; WRITING
PJ E54; DELETING
PJ E54; GETTING DICTIONARY
PJ E54; OPENING FILE
SUBTTL D51
; LOOK FOR FILE OR ITEM NR. FOLLOWED BY KEY
; JSP B,D51
; RETURN IF BAD NR.
; RETURN IF BAD KEY
; NORMAL RETURN; A=KEY AND UITEM-NR.
D51: HRRZM B,UX1; SAVE RETURN
PJ S65;
PJ E5; NO TRAILING SPACES
JSP B,P49;
INVOKE P53;
PJ E5; HAVE JNF IN A1,A2
CALL S78; CONVERT TO IP/FP
J @UX1; BAD NR.
JN A,@UX1;
M A1,UITEM;
F B1,UB1; COUNT OF TRAILING SPACES.
F B,UX1;
SETZ A,0; ASSUME NO KEY
CN CC,U3; END OF IMPERATIVE?
J 2(B); YES; DONE.
LDB B2,BYTE4; LEFT GROUPER?
CAIE B2,2;
PJ E5; NO
JE B1,.-1; EH IF NO LEADING SPACES
AOJA B,D52; YES; LOOK FOR KEY.
SUBTTL D52
; LOOK FOR KEY (BRACKETED).
; JSP B,D52
; RETURN IF BAD KEY
; NORMAL RETURN; A=KEY
D52: HRRZM B,UX1; SAVE RETURN
HRRZ B1,CC; LEFT-GROUPER CODE.
LSH B1,1;
ADDI B1,RIGHT; B1=EXPECTED RT. GRPR. BYTE
F A,US2; PREPARE TO COLLECT IN US2
SETZ A1,0;
D52.1: PJ S50; NEXT BYTE
CN CC,B1; DONE?
J D52.2; YES
CAIG CC,75;
J D52.0; DIGIT OR LETTER
CN CC,EOS;
PJ E5; EOS
CAIG CC,WORD; WORD?
J @UX1; NO
D52.0: IDPB CC,A; YES; COLLECT.
AOJA A1,D52.1;
D52.2: FI CC,EOS;
IDPB CC,A;
JN A1,.+2;
PJ E5; EH IF NULL KEY
INVOKE P51; NEXT CHARACTER
CE CC,U3; EXPECTED END?
PJ E5; NO
F B1,US2; CONVERT KEY TO ASCII
HRLI B2,10700;
HRRI B2,US1;
SETZB A2,1(B2);
PJ S55; CONVERT.
CAILE A2,5; TOO LONG/
J @UX1; YES
F A,(B2); FETCH KEY
F B,UX1;
PJ D62; CONVERT TO UC LETTERS
J 1(B);
SUBTTL D53
; FILL AND SEND BUFFERS TO DISC
; ENTERED INDIRECTLY VIA JSP B,X48
; FOLLOWED BY STANDARD STRING CALLING-SEQUENCE.
D53: F A,UBFR; CURRENT BUFFER POINTER
CN A,K42.1; END OF BUFFER?
J D53.6+1; YES
D53.0: F A1,(B); NEXT ON CALLING SEQU.
JN A1,.+2; LONG-LINE BREAK?
AOJA B,D53.0; YES; IGNORE
CE A1,K20; END OF CALLING-SEQUENCE?
J D53.1; NO
FI CC,EOS; YES
IDPB CC,A; YES; APPEND EOS
M A,UBFR; HOLD POINTER.
D53.3: M B,UB;
JSR S62; RESTORE CONSOLE
J 1(B);
D53.1: SETZ B1,0; ASSUME WE HAVE POINTER
TLNE A1,400000; ACTUAL STRING?
J .+4; YES
TLNN A1,777777; POINTER OR ADDRESS OF PTR?
F A1,(A1); ADDRESS
J D53.2;
SETO B1,0; NOTE ACTUAL STRING OCCURRENCE
HRR A1,B;
HRLI A1,341000; CONSTRUCT POINTER
D53.2: EXCH A1,U1;
D53.4: PJ S50; NEXT BYTE
CAIN CC,CG; IGNORE CARRIAGE RETURNS
J D53.4;
CAIN CC,EOS;
J D53.5; YES
CN A,K42; ROOM IN BUFFER?
J D53.6; NO
IDPB CC,A; YES; COLLECT THE BYTE
J D53.4;
D53.5: XCH A1,U1; RESTORE POINTER
JE B1,.+2; HAD WE A POINTER?
HRRZ B,A1; NO; ADJUST CALLING-SEQUENCE
AOJA B,D53.0;
D53.6: F A,UBFR; NO ROOM; MUST DRAIN BUFFER
SETZM FLAG; NOT THE LAST BUFFER.
D53.8: FI CC,EOB;
IDPB CC,A; APPEND END-OF-BUFFER
F A,K43;
M A,UBFR; INITIALIZE BUFFER POINTER.
FI A,2; AND SEND IT TO DISC
JSP B,X46;
XWD D53.7,DISKC;
PAGE
D53.7: JSR S62; RESTORE CONSOLE
HRRZ CC,RESULT; WUAT HAPPENED?
FI B1,DT51;
LDB CC,DT50(CC); TRANSLATE RESULT CODE
XEC .+1(CC);
PJ E54; FISHY BEHAVIOR
PJ E54A; BAD DISK
J D53.9; BUFFER DRAINED
J D53.10; DITTO AND END
PJ E57; NO MORE DISK SPACE
D53.9: SKIPE FLAG;
PJ E54; SOMETHING FISHY
J D53;
D53.10: SKIPE FLAG;
J D55;
PJ E54; SOMETHING FISHY
DT51: OCT 023000000044,100000000000;
SUBTTL D54-D55
; D54 DRAINS BUFFER IF REQUIRED
; D55 CLEANS UP AFTER SUCCESSFUL DISC PROTOCOL
D54: F A,UBFR;
CN A,K43; ANYTHING TO DRAIN?
J D55; NO
SETOM FLAG; YES
J D53.8; DO SO
D55: JSP B,X46; DONE WITH DISK
XWD D55.1,DISKD;
D55.1: HRRI A1,D55A-1;
HRLI A1,41000; "DONE"
F CC,UDF1;
CAIN CC,5; USE?
HRRI A1,D55B-1; YES; "ROGER"
M A1,US5;
JSR S62;
SETZM UDF1;
SKIPE MODE;
J X52; DONE IF INDIRECT; OTHERWISE
JSP B,X48; TELL USER WE ARE DONE.
XWD 0,US5;
DEC -1;
J X52;
D55A: BYTE (8)15,62,61,50,DOT,CG,EOS;
D55B: BYTE (8)33,62,52,50,65,DOT,CG,EOS;
SUBTTL D56 -- OPEN A FILE
D56: SKIPE MODE;
PJ SIN7; DIRECT ONLY?
INVOKE P51; NEXT CHAR
CE CC,T51.27; FILE?
PJ E5; NO
JSP B,D51; GET FILE NR AND KEY
PJ E51; BAD FILE NR
PJ E52; BAD ID
F A1,UITEM;
CLE A1,K44;
PJ E51; LARGE FILE NR
EXCH A,UKEY;
M A,UA;
EXCH A1,UFILE;
M A1,UA1;
PJ S60; REFRESH CONSOLE
JSP B,X46;
XWD D56.1,DISKA;
D56.1: FI A,5;
JSP B,X46;
XWD D56.2,DISKB; INITIATE ACTION
D56.2: JSR S62; RESTORE CONSOLE
HRRZ CC,RESULT; WHAT HAPPENED?
FI B1,DT52;
LDB CC,DT50(CC); TRANSLATE RESULT CODE
CAIN CC,2;
J D55; DONE
M A,UKEY;
M A1,UFILE;
XEC .+1(CC);
PJ E54; SOMETHING FISHY
PJ E54A; BAD DISK
J D55; DONE
PJ E53; NO SUCH FILE
DT52: OCT 000000000300,102000000000;
SUBTTL D57 -- RELEASE ITEM
D57: SKIPE MODE;
PJ SIN7; DIRECT ONLY?
SKIPN UFILE;
PJ E56; NO FILE OPENED YET.
INVOKE P51;
CE CC,T51.29; ITEM?
PJ E5; NO
JSP B,D51; ITEM NR AND ID
PJ E55; BAD ITEM NR
PJ E52; BAD KEY
M A,UNAME;
F A,UITEM;
CLE A,K45;
PJ E55; LARGE ITEM NR.
PJ S60; CLEAR CONSOLE
JSP B,X46;
XWD D57.1,DISKA; REQUEST DISK
D57.1: FI A,3; GOT IT.
JSP B,X46;
XWD D57.2,DISKB; INITIATE RELEASE
D57.2: JSR S62; RESTORE CONSOLE
HRRZ CC,RESULT; WHAT HAPPENED?
FI B1,DT53;
LDB CC,DT50(CC); TRANSLATE RESULT CODE
XEC .+1(CC);
PJ E54; SOMETHING FISHY
PJ E54A; BAD DISK
J D55; DONE
PJ E58; NO SUCH ITEM
DT53: OCT 000002003000,130000000000;
SUBTTL D58 -- FILE AN ITEM
D58: SKIPE MODE;
PJ SIN7; DIRECT ONLY?
SKIPN UFILE;
PJ E56; NO FILE OPENED YET
AOS SIZE;
AOS SIZE; TWO EXTRA CELLS
SETOM U7; NOTE THE FACT
SETZM UP3; ITEM COUNT
D58.1: JSP B,P38X; OOD?
JSP B,P37; NO; COMPILE LHS
AOS UP3; COUNT!
CN CC,T51.4; COMMA?
J D58.1; AND CONTINUE.
D58.3: CE CC,T51.28; FOLLOWED BY "AS"?
PJ E5; NO
INVOKE P51; NEXT CHAR.
CE CC,T51.29; "ITEM"?
PJ E5; NO
JSP B,D51; FETCH ITEM NR AND ID
PJ E55; BAD ITEM NR
PJ E52; BAD KEY
M A,UNAME;
F A,UITEM;
CLE A,K45;
PJ E55; BAD ITEM NR
JSR S61; SAVE CONSOLE
JSP B,X46; REQUEST DISK
XWD D58.4,DISKA;
D58.4: SETZM TYPE;
SETZM FLAG; FURTHER RECORDS
FI A,2;
JSP B,X46; INITIATE DISK WRITE
XWD D58.5,DISKB;
D58.5: JSR S62; RESTORE CONSOLE
HRRZ CC,RESULT; WHAT HAPPENED?
FI B1,DT54;
LDB CC,DT50(CC); TRANSLATE RESULT CODE
XEC .+1(CC);
PJ E54; SOMETHING FISHY
PJ E54A; BAD DISK
J D58.6; OK TO START WRITING
PJ E57; NO MORE DISK SPACE
PJ E59; DELETE BEFORE WRITING
DT54: OCT 020000000033,100400000000;
PAGE
D58.6: SETZM FLAG;
F A,K43;
M A,UBFR; INITIALIZE BUFFER POINTER
D58.7: F A,(DS);
LDB B2,BYTE2; WHAT NEXT?
CN B2,TYPE8; LHS?
J D58.11; YES
M52 DS,A; NO; POP DESCRIPTOR
M A,UP4;
CAMN B2,TYPE11; OOD?
J D58.8; YES
CE B2,TYPE21; ASSIGNMENT TABLE ADDRESS?
PJ E54; NO; EH?
D58.71: F A,(A); GET DESCRIPTOR
M A,UP4;
LDB B2,BYTE2; TYPE
XEC D58.10(B2);
D58.9: SOSLE UP3; REPEAT IF MORE.
J D58.7;
PJ S60; CLEAR CONSOLE
J D54; DRAIN BUFFER AND FINI
D58.10: JSP B,S70F; SEND TV
JSP B,S70F; SEND JNF
JSP B,S71; SEND ARRAY
JSP B,S70B; SEND FORMULA
D58.8: PJ P70X; DE-COMPILE OOD
PJ E54; BAD NR.
PJ E54; NO SUCH ANIMAL
JSP B,V3.5; SEND IT
J D58.9; AND CONTINUE
D58.11: PJ P66; DECOMPILE LHS
HRRZM A,PK9; TABLE ADDRESS
SKIPN T48; ANY INDEX VALUES
J D58.71; NO
F CC,(A); YES; GET DESCRIPTOR
F A,US2; COMPOSE LHS STRING
PJ S70G; IN US2
FI B,D58.9; RETURN TO D58.9 AFTER
M B,UX2; USING S70C TO
J S70C10-3; SEND LINE.
SUBTTL D59 -- RECALL
D59: SKIPE MODE;
PJ SIN7; DIRECT ONLY?
SKIPN UFILE;
PJ E56; NO FILE OPENED YET
INVOKE P51;
CE CC,T51.29; ITEM?
PJ E5; NO
JSP B,D51; FETCH ITEM NR AND ID
PJ E55; BAD ITEM NR
PJ E52; BAD ID
M A,UNAME; SAVE ID
F A,UITEM;
CLE A,K45;
PJ E55; LARGE ITEM NR
PJ S60; CLEAR CONSOLE
JSP B,X46; REQUEST DISK
XWD D59.1,DISKA;
D59.1: FI A,1; GOT IT
JSP B,X46; INITIATE SEARCH
XWD D59.2,DISKB;
D59.2: JSR S62; RESTORE CONSOLE
HRRZ CC,RESULT; WHAT HAPPENED?
FI B1,DT55;
LDB CC,DT50(CC);
XEC .+1(CC);
PJ E54; SOMETHING FISHY
PJ E54A; BAD DISK
J D60; NEXT RECORD; MORE TO COME
J D60; NEXT RECORD - NO MORE
PJ E58; NO SUCH ITEM
DT55: OCT 000230004000,140000000000;
SUBTTL D60 -- STILL RECALLING
D60: F A,K43;
M A,UBFR; INITIALIZE BUFFER POINTER
F A,K42.1; AT LAST BYTE
FI CC,EOB;
IDPB CC,A; MAKE SURE BUFFER ENDS WITH EOB
FI A,117;
M A,WIDTH;
SETZM UP0; MUST ASSUME MAX WIDTH PAGE.
D60.1: F A,UBFR;
ILDB CC,A; NEXT CHAR FROM BUFFER
CAIN CC,EOB; END OF BUFFER?
J D61; YES
D60.2: F B1,UBFR;
F B2,K46;
SETZ A2,0;
PJ S55; MOVE INTO US0
M B1,UBFR; SAVE BUFFER POINTER
F A1,B2;
FI CC,CGII;
IDPB CC,A1; APPEND CG
SETZM UP0;
D60X: F A,K46;
F B,US1;
SKIPE UDF2; FORM?
J D60.3; YES
HRLI B,141000; NO;
ADDI B,1; ADD THREE LEADING BYTES
SETZM (B);
D60.3: SOS LINE;
PJ S52; CONVERT BACK TO INTERNAL CODE
PJ S60; CLEAR CONSOLE
SKIPE UDF2; FORM?
J V14X; YES
SKIPN UP1; DEAD LINE?
J D60.1; YES
J X50; NO
D61: F A,RESULT; WAS THIS THE LAST RECORD?
CAIE A,3;
J D55; YES -- FINI WITH DISK
FI A,1; NO -- GET NEXT RECORD
JSP B,X46;
XWD D59.2,DISKC;
D62: HRLI A1,10700;
HRRI A1,A-1;
D62.1: ILDB CC,A1; CONVERT ASCII IN A TO UC
CAIL CC,141;
SUBI CC,40;
DPB CC,A1;
SOJG A2,D62.1;
POPJ CR,0;
SUBTTL D63 -- TYPE ITEM-LIST
D63: SKIPE MODE;
PJ SIN7; DIRECT ONLY?
SKIPN UFILE;
PJ E56; NO FILE IN USE
PJ S60; CLEAR CONSOLE
JSP B,X46; REQUEST DISC
XWD .+1,DISKA;
FI A,4;
JSP B,X46; REQUEST FILE DICTIONARY
XWD .+1,DISKB;
JSR S62;
SETZM UITEM;
HRRZ CC,RESULT; WHAT HAPPENED?
FI B1,DT56;
LDB CC,DT50(CC);
J .+1(CC);
JFCL
JFCL
SETOM UITEM; NO DICT.
JSP B,X46; DEMAND CORE
XWD .+1,DEMCOR;
JE A1,E3A.0; NO CORE
HRLI A1,BFR;
HRR A1,SPACE;
SETZM 1(A1); ASSUME NO DICT
SKIPE UITEM;
J D63.1; CHECK!
HRRZ A2,A1;
ADDI A2,200;
BLT A1,@A2; MOVE DICT INTO NEW CORE BLOCK
D63.1: JSP B,X46; RELEASE DISC
XWD .+1,DISKD;
SETZM UDF1;
SETZM UITEM; ITEM COUNT
D63.2: JSP B,X46; REQUEST BUFFER
XWD .+1,REQBUF;
M BUFAD,UBUF;
HRRZ 2,BUFAD;
ADDI 2,2;
HRLI 2,10700;
HRRZ 3,SPACE;
F 1,UITEM;
JSR S62; RESTORE CONSOLE
D63.3: JSP B,X46; RETURN UNUSED BUFFER
XWD .+1,RETBUF;
JSP B,X46; RETURN CORE
XWD .+1,RETCOR;
JSR S62;
J X52;
DT56: OCT 302000,100000000000;
SUBTTL DT50
DT50: POINT 3,(B1),2;
POINT 3,(B1),5;
POINT 3,(B1),8;
POINT 3,(B1),11;
POINT 3,(B1),14;
POINT 3,(B1),17;
POINT 3,(B1),20;
POINT 3,(B1),23;
POINT 3,(B1),26;
POINT 3,(B1),29;
POINT 3,(B1),32;
POINT 3,(B1),35;
POINT 3,1(B1),2;
POINT 3,1(B1),5;
POINT 3,1(B1),8;
POINT 3,1(B1),11;
POINT 3,1(B1),14;
POINT 3,1(B1),17;
POINT 3,1(B1),20;
SUBTTL OBJECT TYPES AND SUCH
;
TYPE1: OCT 0; TV
TYPE2: OCT 1; JNF
TYPE3: OCT 2; ARRAY
TYPE4: OCT 3; FORMULA
TYPE5: OCT 4; FUNCTION
TYPE6: OCT 6; UNDEFINED
TYPE7: OCT 7; DUMMY LETTER
TYPE8: OCT 10; LHS
TYPE9: OCT 11; ROV
TYPE10: OCT 12; FOR CLAUSE
TYPE11: OCT 13; OOD
TYPE12: OCT 1001; TYPE/CLASS OF JNF LITERALS
TYPE13: OCT 14; UNDERSCORE
TYPE14: OCT 11; VERBS
TYPE15: OCT 1011; SINGULAR NOUNS
TYPE16: OCT 2011; PLURAL NOUNS
TYPE17: OCT 3011; 'ALL'
TYPE18: OCT 4011; OTHERS
TYPE19: OCT 5011; SYSTEM ATTRIBUTES
TYPE20: XWD 13,12; OOD DESCRIPTOR FOR FORM
TYPE21: OCT 15; DICTIONARY ENTRY
TYPE22: OCT 16; LIST OF OBJECT DESCRIPTORS
SUBTTL MASKS
;
MASK1: XWD 777000,0; INDEX VALUE
MASK2: OCT 777; EXPONENT IN RIGHT HALF
MASK3: XWD 777,0; EXPONENT
MASK4: XWD 776000,0; OD'S ASSOCIATED LETTER
MASK5: XWD 17,0; DESCRIPTOR CLASS
MASK6: XWD 17,0; DESCRIPTOR TYPE
MASK7: XWD 17000,0; DESCRIPTOR TYPE WITHIN CLASS
MASK8: XWD 400000,0; JNF SIGN
MASK9: OCT 400; EXP. TEST
SUBTTL PARAMS
K1: XWD 0,FALSE; FALSE DESCRIPTOR
K2: XWD 0,TRUE; TRUE DESCRIPTOR
K3: DEC 1; RIGHT COUNTER
K4: XWD 1,0; LEFT COUNTER
K5: DEC 99; MAX EXPONENT
K6: DEC -99; MIN EXPONENT
K7: DEC 10; LENGTH OF LONGEST VOCAB WORD
K8: OCT 100; LENGTH OF ST54, SORT TABLE
K9: XWD 400000,0; ENDS VARIABLE CALLING SEQUENCES
K10: XWD 2,23; BACK-STOP DESCRIPTOR
K11: OCT 0; JNF IN LOGIC (YES IF NON ZERO)
K12: OCT 0; TV IN ARITH (YES IF NON ZERO)
K13: OCT 1; TV LITERALS IN TEXT (YES IF 1, NO IF 0)
K14: OCT 1; TV'S IN ASSIGNMENT TABLE (YES IF NON ZERO)
K15: DEC 100000000; JNF UNITY
K16: BYTE (8)165,165,165,165; EOS'S
K17: OCT INDEX; INDEX FIELD LENGTH
K18: OCT XP; EXPONENT FIELD LENGTH
K19: XWD -1,0; SPACE DESC.
K20: DEC -1; REALLY ENDS VBLE CALLING SEQUS.
K21: DEC 54; LINES PER PAGE
K22: DEC 7; OFF SET FOR PLURAL NOUNS IN OOD'S.
K23: XWD 41000,K23;
K24: BYTE (8)SP,EQUALS,SP,EOS; #=#
K25: DEC 12; INDENTATION
K26: DEC 54; MAXIMUM LHS STRING FOR TYPEING
K27: DEC 1; FIRST LINE NR.
SYN K21,K28; LINES PER PAGE
K29: DEC 10; MAX NR OF PARAMS OR INDEX VALUES
K30: DEC 80; LINE LENGTH
K31: DEC 999999999; MAX JNF DP
K32: DEC 367; INITIAL SIZE
K33: OCT 407346544777; MINUS K31
K34: XWD 1000,0; UNDERSCORE COUNTER
K35: DEC 1; REC. FORMULAS (NON-ZERO IF YES)
K36: DEC 1024; BLOCK LENGTH
K37: OCT 1; TV'S IAS FORMULA RESULTS(NO IF 0)
K38: BYTE (8)BAD,EOS; BAD STRING
K39: OCT 1; TV AS TYPE ITEM (NO IF ZERO)
K40: XWD 5011,0; DESCRIPTOR FOR UNDERSCORES
K41: XWD 024006,0; UNDEFINED DESC. FOR CAP "A"
K42: POINT 8,BFRP,15;
K42.1: POINT 8,BFRP,23;
K43: POINT 8,BFR,31; TO FIRST
K44: DEC 2750; MAX FILE NR
K45: DEC 25; MAX ITEM NR
K46: POINT 7,US0,34; TO INPUT LINE IMAGE
K47: OCT 1; INDIRECT DELETES?
K48: OCT 1; INDIRECT FILE REFERENCES?
K49: XWD V1.3,23; RIGHT-HAND-SIDE CALLERS
K50: XWD P39.0,23; OF EXPRESSEION EVALUATOR; P49.
K51: XWD P39.10,23; DITTO!
SUBTTL BYTE POINTERS FOR PACKED INFO
;
BYTE1: POINT 4,A1,17; A1 TYPE
BYTE2: POINT 4,A,17; A TYPE
BYTE3: POINT 4,A2,17; A2 TYPE
BYTE4: POINT 4,CC,17; CC CLASS
BYTE5: POINT 4,CC,8; CC TYPE WITHIN CLASS
BYTE6: POINT 2,JD,3; JOB CODE
BYTE7: POINT 1,JD,5; JOB MODE
BYTE8: POINT 2,JD,9; JOB BKPT
BYTE9: POINT 1,JD,11; JOB STATUS
BYTE10: POINT 1,JD,13; SKIP CODE
BYTE11: POINT 18,JD,35; JOB FOR-CLAUSE LINK
BYTE12: POINT IDN,(A),IDN-1; ID BYTE IN (A)
BYTE13: POINT IDN,A,IDN-1; DITTO IN A
BYTE14: POINT 9,ST50(CC),26; SPECIAL BYTE CODE
BYTE15: POINT 9,ST50(CC),35; BYTE TYPE
BYTE16: POINT 4,A,13; OOD TYPE
BYTE17: POINT 4,(DS),17; TYPE OF DS TOP
SUBTTL SYNTAX ENFORCERS
SIN2: SKIPN K12; TV IN ARITH
JRST E33;
POPJ CR,0;
;
SIN1: SKIPN K11; JNF (OP A) IN LOGIC
JRST E34;
SIN1.1: JUMPE A1,.+2;
MOVE A1,TRUE;
SETZ A2,0;
POPJ CR,0;
;
SIN3: SKIPN K11; JNF (OP B) IN LOGIC
JRST E34;
JUMPE B1,.+2
MOVE B1,TRUE;
SETZ B2,0;
POPJ CR,0;
;
SIN4: SKIPN K14; TV IN DICT
JRST E35;
POPJ CR,0;
SIN5: SKIPN K13; LITERAL TV IN TEXT
JRST E36;
POPJ CR,0;
SIN6: SKIPN K47; INDIRECT DELETES?
PJ E2; NO
POPJ CR,0;
SIN7: SKIPN K48; INDIRECT FILE WORK?
PJ E2; NO
POPJ CR,0;
SUBTTL ST50 -- CONVERSION BTWN ASCII AND 8-BIT
;
DEFINE MLPFS (I,E,T);
<BYTE (9)I,E(18)T;>
DEFINE ML(I,E,S,T);
<BYTE (9)I,E,S,T;>
; I=8-BIT CODE FOR ENTRY; E=ASCII CODE FOR ENTRY
; S=CLASSIFICATION CODE FOR TYPING
; T=CLASSIFICATION CODE FOR PRE-PROCESSING
; ENTRY E I
ST50: MLPFS 156,60,3; 0 # 0
MLPFS 156,61,3; 1 # 1
MLPFS 156,62,3; 2 # 2
MLPFS 156,63,3; 3 # 3
MLPFS 156,64,3; 4 # 4
MLPFS 156,65,3; 5 # 5
MLPFS 156,66,3; 5 # 6
MLPFS 156,67,3; 7 # 7
MLPFS 156,70,3; 10 # 8
MLPFS 152,71,3; 11 TAB(LC) 9
MLPFS 156,101,0; 12 # A(UC)
MLPFS 156,102,0; 13 # B
MLPFS 150,103,0; 14 PAGE C
MLPFS 151,104,0; 15 CR D
MLPFS 156,105,0; 16 # E
MLPFS 156,106,0; 17 # F
MLPFS 156,107,0; 20 # G
MLPFS 156,110,0; 21 # H
MLPFS 156,111,0; 22 # I
MLPFS 156,112,0; 23 # J
MLPFS 156,113,0; 24 # K
MLPFS 156,114,0; 25 # L
MLPFS 156,115,0; 26 # M
MLPFS 156,116,0; 27 # N
MLPFS 156,117,0; 30 # O
MLPFS 147,120,0, 31 TAB(UC) P
MLPFS 156,121,0; 32 # Q
MLPFS 156,122,0; 33 # R
MLPFS 156,123,0; 34 # S
MLPFS 156,124,0; 35 # T
MLPFS 156,125,0; 36 # U
MLPFS 156,126,0; 37 # V
MLPFS 170,127,0; 40 SP W
MLPFS 124,130,0; 41 ABVAL X
MLPFS 154,131,0; 42 " Y
MLPFS 156,132,0; 43 # Z(UC)
MLPFS 157,141,0; 44 $ A(LC)
MLPFS 131,142,0; 45 NOT= B
MLPFS 142,143,0; 46 TIMES C
MLPFS 153,144,0; 47 ' D
MLPFS 120,145,0; 50 ( E
MLPFS 121,146,0; 51 ) F
MLPFS 144,147,0; 52 * G
MLPFS 140,150,0; 53 & H
MLPFS 161,151,0, 54 ; I
MLPFS 141,152,0; 55 - J
MLPFS 160,153,0; 56 . K
MLPFS 143,154,0; 57 / L
MLPFS 0,155,0; 60 0 M
MLPFS 1,156,0; 61 1 N
MLPFS 2,157,0; 62 2 O
MLPFS 3,160,0; 63 3 P
MLPFS 4,161,0; 64 4 Q
MLPFS 5,162,0; 65 5 R
MLPFS 6,163,0; 66 6 S
MLPFS 7,164,0; 67 7 T
MLPFS 10,165,0; 70 8 U
MLPFS 11,166,0; 71 9 V
MLPFS 163,167,0; 72 : W
MLPFS 162,170,0; 73 ; X
MLPFS 132,171,0; 74 < Y
MLPFS 130,172,0; 75 " Z
MLPFS 133,43,4; 76 > #
MLPFS 164,43,4; 77 ? #
MLPFS 135,43,4; 100 >= # EOC
MLPFS 12,43,4; 101 A(UC) # EOC
MLPFS 13,43,4; 102 B # EOC
MLPFS 14,43,4; 103 C # EOC
MLPFS 15,43,4; 104 D # EOC
MLPFS 16,43,4; 105 E # EOC
MLPFS 17,43,4; 106 F # EOC
MLPFS 20,43,4; 107 G # EOC
MLPFS 21,43,4; 110 H # EOC
MLPFS 22,43,4; 111 I # EOC
MLPFS 23,43,4; 112 J # EOC
MLPFS 24,43,4; 113 K # EOC
MLPFS 25,43,4; 114 L # EOC
MLPFS 26,43,4; 115 M # EOC
MLPFS 27,43,4; 116 N # EOC
MLPFS 30,43,4; 117 0 # EOC
ML 31,50,3,7; 120 P (
ML 32,51,4,7; 121 Q )
ML 33,133,3,7; 122 R [
ML 34,135,4,7; 123 S ]
MLPFS 35,41,7; 124 T ABVAL
ML 36,50,5,7; 125 U ALPHA
ML 37,51,6,7; 126 V OMEGA1
ML 40,54,7,5; 127 W OMEGA2
MLPFS 41,75,10; 130 X =
MLPFS 42,45,10; 131 Y NOT=
MLPFS 43,74,10; 132 Z <
MLPFS 122,76,10; 133 [ >
MLPFS 134,134,10; 134 <= <=
MLPFS 123,100,10; 135 ] >=
MLPFS 155,43,4; 136 UNDER #
MLPFS 156,43,4; 137 UNDER #
MLPFS 156,53,11; 140 # &
MLPFS 44,55,11; 141 A(LC) -
MLPFS 45,46,11; 142 B TIMES
MLPFS 46,57,11; 143 C /
MLPFS 47,52,11; 144 D *
MLPFS 50,43,4; 145 E #
MLPFS 51,43,4; 146 F #
MLPFS 52,31,12; 147 G TAB(UC)
MLPFS 53,14,12; 150 H PG
MLPFS 54,15,12; 151 I CR
MLPFS 55,11,12; 152 J TAB
MLPFS 56,47,6; 153 K '
MLPFS 57,42,6; 154 L "
MLPFS 60,136,6; 155 M UNDER
MLPFS 61,43,6; 156 N #
MLPFS 62,44,6; 157 O $
MLPFS 63,56,5; 160 P .
MLPFS 64,54,5, 161 Q ;
ML 65,73,2,5; 162 R ;
MLPFS 66,72,5; 163 S :
MLPFS 67,77,5; 164 T ?
ML 70,EOSII,1,1; 165 U EOS
MLPFS 71,56,5; 166 V .
MLPFS 72,54,5; 167 W COMMA2
MLPFS 73,40,2; 170 X SP
MLPFS 74,40,2, 171 Y # 2 SP
MLPFS 75,40,2; 172 Z # 3 SP
MLPFS 156,40,2; 173 # #
MLPFS 156,40,2; 174 # #
MLPFS 156,40,2; 175 # #
MLPFS 156,40,2; 176 # #
MLPFS 156,40,2; 177 # #
SUBTTL ST51 CONTAINS STRING POINTERS TO ST52
DEFINE PM(A)
<
POINT 8,ST52+A,31 >
ST51: POINT 8,ST52+1,23; 1 SPACE
POINT 8,ST52+1,15; 2 SPACES
POINT 8,ST52+1,7;
POINT 8,ST52,31;
POINT 8,ST52,23;
POINT 8,ST52,15;
POINT 8,ST52,7;
ST51LO: POINT 8,ST52-1,31; 8 SPACES
PM 2; AND
PM 3; OR
PM 4; NOT
PM 5; SQRT
PM 7; LOG
PM 10; EXP
PM 11; SIN
PM 12; COS
PM 13; ARG
PM 14; IP
PM 15; FP
PM 16; DP
PM 17; XP
PM 20; SGN
PM 21; MAX
PM 22; MIN
PM 23; SET
PM 24; LET
PM 25; DO
PM 26; TYPE
PM 30; DELETE
PM 32; LINE
PM 34; PAGE
PM 36; CANCEL
PM 40; GO
PM 41; TO
PM 42; DONE
PM 44; STOP
PM 46; DEMAND
PM 50; FORM
PM 52; STEPS
PM 54; PARTS
PM 56; FORMS
PM 60; VALUES
PM 62; ALL
PM 63; IN
PM 64; FOR
PM 65; IF
PM 66; SIZE
PM 70; TIME
PM 72; USERS
PM 74; STEP
PM 76; PART
PM 100; FORM
PM 102; SUM
PM 103; FORMULAS
PM 106; PROD
PM 65; SPECIAL IF
PM 110; TV
PM 25; PARENTHETICAL DO
PM 36; PARENTHETICAL CANCEL
PM 111; FALSE
PM 113; TRUE
PM 115; FORMULA
PM 117; TIMES
PM 121; FIRST
PM 123; FILE (LC)
PM 125; ITEM
PM 127; AS
PM 130; RELEASE
PM 132; FILE
PM 134; RECALL
PM 136; USE
PM 137; QUIT
PM 141; LIST
PM 143; TIMER
PM 145; BE
PM 146; SPARSE
PM 150; RESET
OCT 0;
SUBTTL ST51 EXTENDED
; MORE POINTERS
ST51.1: POINT 8,CS1-1,31; ERROR
POINT 8,CS2-1,31; ERROR ABOVE
POINT 8,CS3-1,31; ERROR AT STEP
POINT 8,CS4-1,31; ERROR DURING ABOVE
POINT 8,CS5-1,31; ERROR DURING STEP
POINT 8,CS6-1,31; I'M AT STEP
POINT 8,CS7-1,31; STOPPED BY STEP
POINT 8,CS8-1,31; REVOKED BY IN-REQUEST
POINT 8,CS74-1,31; I HAVE A
POINT 8,US4,31;
POINT 8,CS10-1,31; IT'S A MESS.
POINT 8,CS11-1,31; LET'S START OVER
POINT 8,CS16-1,31; DONE. I'M READY TO GO SP
POINT 8,CS17-1,31; I HAVE #
POINT 8,CS18-1,31; I CAN'T FIND THE #
POINT 8,CS19-1,31; REQUIRED #
POINT 8,CS20-1,31; # FOR ITERATION
POINT 8,CS23-1,31; # IS NOT DEFINED
POINT 8,CS24-1,31; DON'T GIVE THIS COMMAND
POINT 8,CS31-1,31; MUST BE INTEGER AND #
POINT 8,CS39-1,31; NUMBER #
POINT 8,CS44-1,31; PLEASE LIMIT #
POINT 8,CS48-1,31; TO 9 SIGNIFICANT DIGITS
POINT 8,CS55-1,31; I CAN'T #
POINT 8,CS58-1,31; IN FORMULA ##
POINT 8,US7-1,31;
POINT 8,CS63-1,31; MUST BE POSITIVE INTEGER >=
POINT 8,CS68-1,31; SOMETHING'S WRONG
POINT 8,US2,31;
SUBTTL; ST52 EXPERIMENTAL
S=ST51.1-ST51LO+177;
; PERMANENT STRINGS IN JWS FORM
ST52: BYTE (8)170,170,170,170,170,170,170,170,165;
BYTE (8)44,61,47,EOS; AND
BYTE (8)62,65,EOS; OR
BYTE (8)61,62,67,EOS; NOT
BYTE (8)66,64,65,67,EOS; SQRT
BYTE (8)57,62,52,EOS; LOG
BYTE (8)50,73,63,EOS; EXP
BYTE (8)66,54,61,EOS; SIN
BYTE (8)46,62,66,EOS; COS
BYTE (8)44,65,52,EOS; ARG
BYTE (8)54,63,EOS; IP
BYTE (8)51,63,EOS; FP
BYTE (8)47,63,EOS; DP
BYTE (8)73,63,EOS; XP
BYTE (8)66,52,61,EOS; SGN
BYTE (8)60,44,73,EOS; MAX
BYTE (8)60,54,61,EOS; MIN
BYTE (8)34,50,67,EOS; SET
BYTE (8)25,50,67,EOS; LET
BYTE (8)15,62,EOS; DO
BYTE (8)35,74,63,50,EOS; TYPE
BYTE (8)15,50,57,50,67,50,EOS; DELETE
BYTE (8)25,54,61,50,EOS; LINE
BYTE (8)31,44,52,50,EOS; PAGE
BYTE (8)14,44,61,46,50,57,EOS; CANCEL
BYTE (8)20,62,EOS; GO
BYTE (8)35,62,EOS; TO
BYTE (8)15,62,61,50,EOS; DONE
BYTE (8)34,67,62,63,EOS; STOP
BYTE (8)15,50,60,44,61,47,EOS; DEMAND
BYTE (8)17,62,65,60,EOS; FORM
BYTE (8)66,67,50,63,66,EOS; STEPS
BYTE (8)63,44,65,67,66,EOS; PARTS
BYTE (8)51,62,65,60,66,EOS; FORMS
BYTE (8)71,44,57,70,50,66,EOS; VALUES
BYTE (8)44,57,57,EOS; ALL
BYTE (8)54,61,EOS; IN
BYTE (8)51,62,65,EOS; FOR
BYTE (8)54,51,EOS; IF
BYTE (8)66,54,75,50,EOS; SIZE
BYTE (8)67,54,60,50,EOS; TIME
BYTE (8)70,66,50,65,66,EOS; USERS
BYTE (8)66,67,50,63,EOS; STEP
BYTE (8)63,44,65,67,EOS; PART
BYTE (8)51,62,65,60,EOS; FORM
BYTE (8)66,70,60,EOS; SUM
BYTE (8)51,62,65,60,70,57,44,66,EOS; FORMULAS
BYTE (8)63,65,62,47,EOS; PROD
BYTE (8)67,71,EOS; TV
BYTE (8)51,44,57,66,50,EOS; FALSE
BYTE (8)67,65,70,50,EOS; TRUE
BYTE (8)51,62,65,60,70,57,44,EOS; FORMULA
BYTE (8)67,54,60,50,66,EOS; TIMES
BYTE (8)51,54,65,66,67,EOS; FIRST
BYTE (8)51,54,57,50,EOS; FILE
BYTE (8)54,67,50,60,EOS; ITEM
BYTE (8)44,66,EOS; AS
BYTE (8)15,54,66,46,44,65,47,EOS; DISCARD
BYTE (8)17,54,57,50,EOS; FILE (VERB)
BYTE (8)33,50,46,44,57,57,EOS; RECALL
BYTE (8)36,66,50,EOS; USE
BYTE (8)32,70,54,67,EOS; QUIT
BYTE (8)57,54,66,67,EOS; LIST
BYTE (8)67,54,60,50,65,EOS; TIMER
BYTE (8)45,50,EOS; BE
BYTE (8)66,63,44,65,66,50,EOS; SPARSE
BYTE (8)33,50,66,50,67,EOS; RESET
SUBTTL ; ST52.1
; MORE STRINGS
CS1: BYTE (8)16,65,65,62,65,EOS; ERROR
CS2: BYTE (8)SP,44,45,62,71,50,EOS; #ABOVE
CS3: BYTE (8)SP,44,67,SP,251,SP,CS,11,EOS; AT STEP
CS4: BYTE (8)SP,47,70,65,54,61,52,SP;
BYTE (8)44,45,62,71,50,EOS; DURING ABOVE
CS5: BYTE (8)SP,47,70,65,54,61,52,SP;
BYTE (8)251,SP,CS,11,EOS; DURING STEP
CS6: BYTE (8)22,153,60,SP,44,67,SP,251,EOS; I'M AT STEP
CS7: BYTE (8)34,67,62,63,63,50,47,SP; STOPPED
BYTE (8)45,74,SP,251,EOS; BY STEP
CS8: BYTE (8)33,50,71,62,56,50,47,SP; REVOKED BY
BYTE (8)45,74,SP,54,61,67,50,65; INTERRUPT
BYTE (8)65,70,63,67,EOS;
CS10: BYTE (8)22,67,153,66,SP,44,SP,60; IT'S A MESS.
BYTE (8)50,66,66,PERIOD,SP,EOS;
CS11: BYTE (8)25,50,67,153,66,SP,66,67; LET'S START
BYTE (8)44,65,67,SP,62,71,50,65,EOS; OVER
CS12: BYTE (8)CS,14,SP,44,67,SP,251,EOS; DONE. AT STEP
CS13: BYTE (8)CS,14,SP,51,65,62,60,SP,251,EOS; FROM STEP
CS14: BYTE (8)CS,14,SP,54,61,SP,251,EOS; IN STEP
CS15: BYTE (8)COMMA,SP,44,57,67,53,62,SP; ALTHO
BYTE (8)22,SP,46,44,61,153,67,SP; I CAN'T
BYTE (8)51,54,61,47,SP,54,67,EOS; FIND IT.
CS16: BYTE (8)232,DOT,SP,22,153,60,SP,65; DONE. I'M
BYTE (8)50,44,47,74,SP,67,62,SP; READY TO
BYTE (8)52,62,EOS; GO
CS17: BYTE (8)22,SP,53,44,71,50,SP,EOS; I HAVE SP
CS18: BYTE (8)22,SP,46,44,61,153,67,SP; I CAN'T
BYTE (8)51,54,61,47,SP,67,53,50,SP,EOS; FIND THE SP
CS19: BYTE (8)65,50,64,70,54,65,50,47,SP,EOS; REQUIRED#
CS20: BYTE (8)SP,244,SP,54,67,50,65,44; #FOR
BYTE (8)67,54,62,61,EOS; ITERATION
CS21: BYTE (8)CS,10,61,SP,62,71,50,65; I HAVE AN
BYTE (8)51,57,62,72,EOS; OVERFLOW
CS22: BYTE (8)CS,10,SP,75,50,65,62,SP; I HAVE A ZERO
BYTE (8)47,54,71,54,66,62,65,EOS; DIVISOR
CS23: BYTE (8)SP,54,66,SP,202,SP,47,50; #IS NOT
BYTE (8)51,54,61,50,47,EOS; DEFINED
CS24: BYTE (8)15,62,61,153,67,SP,52,54; DON'T GIVE
BYTE (8)71,50,SP,67,53,54,66,SP; THIS
BYTE (8)46,62,60,60,44,61,47,EOS; COMMAND
CS25: BYTE (8)CS,10,SP,61,50,52,44,67; I HAVE A
BYTE (8)54,71,50,SP,44,65,52,70; NEGATIVE ARGUMENT
BYTE (8)60,50,61,67,SP,244,SP,203,EOS; FOR SQRT
CS26: BYTE (8)CS,10,61,SP,44,65,52,70; I HAVE AN
BYTE (8)60,50,61,67,SP,134,SP,0; ARGUMENT <= 0
BYTE (8)SP,244,SP,204,EOS; FOR LOG
CS27: BYTE (8)CS,10,SP,61,50,52,44,67; I HAVE A NEGATIVE
BYTE (8)54,71,50,SP,45,44,66,50; BASE TO A
BYTE (8)SP,67,62,SP,44,SP,51,65; FRACTIONAL
BYTE (8)44,46,67,54,62,61,44,57; POWER
BYTE (8)SP,63,62,72,50,65,EOS;
CS28: BYTE (8)CS,15,75,50,65,62,SP,67; I HAVE ZERO
BYTE (8)62,SP,44,SP,61,50,52,44; TO A NEGATIVE
BYTE (8)67,54,71,50,SP,63,62,72,50,65,EOS; POWER
CS29: BYTE (8)CS,15,67,62,62,SP,51,50; I HAVE TOO FEW VALUES
BYTE (8)72,SP,241,SP,244,SP,67,53; THE FORM
BYTE (8)50,SP,253,EOS;
CS30: BYTE (8)CS,15,67,62,62,SP,60,44; I HAVE TOO MANY
BYTE (8)61,74,SP,241,SP,244,SP,67; VALUES FOR
BYTE (8)53,50,SP,253,EOS; THE FORM
CS31: BYTE (8)60,70,66,67,SP,45,50,SP; MUST BE
BYTE (8)54,61,67,50,52,50,65,SP; INTEGER
BYTE (8)200,SP,EOS; AND #
CS32: BYTE (8)CS,22,SP,47,54,65,50,46; DON'T GIVE
BYTE (8)67,57,74,EOS; COMMAND DIRECTLY
CS33: BYTE (8)CS,22,SP,243,47,54,65,50; DON'T GIVE
BYTE (8)46,67,57,74,EOS; COMMAND INDIRECTLY
CS34: BYTE (8)CS,16,CS,17,251,EOS; CAN'T FIND STEP
CS35: BYTE (8)CS,16,CS,17,252,EOS; CAN'T FIND PART
CS36: BYTE (8)CS,16,CS,17,253,EOS; CAN'T FIND FORM
CS37: BYTE (8)CS,16,CS,17,251,CS,20,EOS; NO STEP FOR ITER.
CS38: BYTE (8)CS,16,CS,17,252,CS,20,EOS; NO PART FOR ITER.
CS39: BYTE (8)61,70,60,45,50,65,SP,EOS; NUMBER #
CS40: BYTE (8)22,61,47,50,73,SP,71,44; INDEX VALUE MUST
BYTE (8)57,70,50,SP,S+23,124,54,61; BE INTEGER AND
BYTE (8)47,50,73,124,134,2,5,0,EOS; !INDEX!<250
CS41: BYTE (8)235,SP,CS,24,CS,23,1,134; FORM NR
BYTE (8)253,132,1,0,144,9,EOS; MUST BE ...
CS42: BYTE (8)31,44,65,67,SP,CS,24,CS; PART NR.
BYTE (8)23,1,134,252,132,1,0,144,9,EOS; MUST BE ...
CS43: BYTE (8)34,67,50,63,SP,CS,24,60; STEP NR. MUST
BYTE (8)70,66,67,SP,66,44,67,54; SATISFY
BYTE (8)66,51,74,SP,1,134,251,132,1,0,144,9,EOS;
CS44: BYTE (8)31,57,50,44,66,50,SP,57; PLEASE
BYTE (8)54,60,54,67,SP,EOS; LIMIT #
CS45: BYTE (8)31,57,50,44,66,50,SP,56; PLEASE KEEP !X!
BYTE (8)50,50,63,SP,124,73,124,132; < 100 FOR
BYTE (8)1,0,0,SP,244,SP,206,120; SIN(X) AND
BYTE (8)73,121,SP,201,SP,207,120,73,121,EOS; COS(X)
CS46: BYTE (8)22,SP,61,50,50,47,SP,54; I NEED
BYTE (8)61,47,54,71,54,47,70,44; INDIVIDUAL
BYTE (8)57,SP,241,SP,244,SP,44,SP,253,EOS; VALUES ...
CS47: BYTE (8)22,57,57,50,52,44,57,SP; ILLEGAL SET
BYTE (8)66,50,67,SP,62,51,SP,241; OF VALUES FOR
BYTE (8)CS,20,EOS; ITERATION
CS48: BYTE (8)67,62,SP,9,SP,66,54,52; TO 9 SIG
BYTE (8)61,54,51,54,46,44,61,67; NIFICANT
BYTE (8)SP,47,54,52,54,67,66,EOS; DIGITS
CS49: BYTE (8)CS,25,251,SP,57,44,45,50; PLEASE LIMIT STEP
BYTE (8)57,66,SP,CS,26,EOS; LABELS
CS50: BYTE (8)CS,25,61,70,60,45,50,65; PLEASE LIMIT NRS.
BYTE (8)66,SP,CS,26,EOS; TO NINE DIGITS
CS51: BYTE (8)16,53,EOS; EH
CS52: BYTE (8)CS,15,61,62,67,53,54,61; I HAVE NOTHING
BYTE (8)52,SP,67,62,SP,47,62,EOS; TO DO
CS53: BYTE (8)CS,25,CS,24,62,51,SP,54; PLEASE LIMIT
BYTE (8)61,47,54,46,50,66,SP,67; NR. OF INDICES
BYTE (8)62,SP,1,0,EOS; TO TEN
CS54: BYTE (8)CS,25,CS,24,62,51,SP,63; PLEASE LIMIT
BYTE (8)44,65,44,60,50,67,50,65; NR. OF PARAMS
BYTE (8)66,SP,67,62,SP,1,0,EOS; TO TEN
CS55: BYTE (8)22,SP,46,44,61,153,67,SP,EOS; I CAN'T #
CS56: BYTE (8)CS,27,50,73,63,65,50,66; I CAN'T EXPRESS
BYTE (8)66,SP,71,44,57,70,50,SP; VALUE IN
BYTE (8)243,SP,74,62,70,65,SP,253,EOS; YOUR FORM
CS57: BYTE (8)CS,27,60,44,56,50,SP,62; I CAN'T MAKE
BYTE (8)70,67,SP,74,62,70,65,SP; YOUR FIELDS
BYTE (8)51,54,50,57,47,66,SP,243; IN THE FORM
BYTE (8)SP,67,53,50,SP,253,EOS;
CS58: BYTE (8)243,SP,265,SP,EOS; IN FORMULA#
CS59: BYTE (8)27,70,60,45,50,65,141,62; NUMBER-OF-TIMES
BYTE (8)51,141,266,SP,CS,23,135,SP,0,EOS; MUST BE ...
CS60: BYTE (8)CS,16,CS,17,270,EOS; CAN'T FIND FILE
CS61: BYTE (8)CS,16,CS,17,271,EOS; CAN'T FIND ITEM
CS62: BYTE (8)CS,25,22,15,153,66,SP,67;
BYTE (8)62,SP,5,SP,57,50,67,67,50,65,66,SP;
BYTE (8)200,143,201,SP,47,54,52,54,67,66,EOS;
; PLEASE LIMIT ID'S TO 5 LETTERS AND/OR DIGITS
CS63: BYTE (8)60,70,66,67,SP,45,50,SP;
BYTE (8)63,62,66,54,67,54,71,50;
BYTE (8)SP,54,61,67,50,52,50,65,SP,134,SP,EOS;
; MUST BE POSITIVE INTEGER <=
CS64: BYTE (8)274,SP,CS,24,CS,32,CS,34,EOS;
; FILE NUMBER MUST BE ...
CS65: BYTE (8)22,67,50,60,SP,CS,24,CS,32,CS,34,EOS;
; ITEM NUMBER MUST BE ..
CS66: BYTE (8)42,62,70,SP,53,44,71,50; U HAVEN'T
BYTE (8)61,153,67,SP,67,62,57,47; TOLD ME WHAT
BYTE (8)SP,60,50,SP,72,53,44,67; FILE TO
BYTE (8)SP,270,SP,67,62,SP,70,66,50,EOS; USE
CS67: BYTE (8)22,153,71,50,SP,65,70,61; I'VE RUN
BYTE (8)SP,62,70,67,SP,62,51,SP; OUT OF
BYTE (8)270,SP,66,63,44,46,50,EOS; FILE SPACE
CS68: BYTE (8)34,62,60,50,67,53,54,61; SOMETHING'S
BYTE (8)52,153,66,SP,72,65,62,61;
BYTE (8)52,DOT,EOS; WRONG.
CS69: BYTE (8)CS,33,SP,35,65,74,SP,44; SOMETHING'S WRONG.
BYTE (8)52,44,54,61,EOS; TRY AGAIN.
CS70: BYTE (8)CS,33,SP,34,44,74,SP,44; SOMETHING'S WRONG.
BYTE (8)52,44,54,61,EOS; SAY AGAIN.
CS71: BYTE (8)CS,33,SP,CS,27,44,46,46; SOMETHING'S WRONG.
BYTE (8)50,66,66,SP,67,53,50,SP; I CAN'T
BYTE (8)270,66,EOS; ACCESS THE FILES.
CS72: BYTE (8)31,57,50,44,66,50,SP,47; PLEASE DELETE
BYTE (8)54,66,46,44,65,47,SP,67; THE ITEM
BYTE (8)53,50,SP,271,SP,201,SP,70; OR USE A NEW
BYTE (8)66,50,SP,44,SP,61,50,72; ITEM NR.
BYTE (8)SP,271,SP,61,70,60,45,50,65,EOS;
CS73: BYTE (8)31,57,50,44,66,50,SP,70;
BYTE (8)66,50,SP,63,44,65,50,61;
BYTE (8)66,SP,62,65,SP,45,65,44;
BYTE (8)46,56,50,67,66,SP,67,62;
BYTE (8)SP,66,50,67,141,62,51,51;
BYTE (8)SP,44,60,45,54,52,70,62;
BYTE (8)70,66,SP,50,64,70,44,57;
BYTE (8)66,SP,66,54,52,61,66,EOS;
CS74: BYTE (8)CS,15,44,EOS; I HAVE A
SUBTTL ST53
; USED TO CONVERT BYTE INDICES TO POINTERS
XWD 41000,0;
XWD 341000,1;
XWD 241000,1;
XWD 141000,1;
XWD 41000,1;
ST53: XWD 341000,2;
XWD 241000,2;
ST53X: XWD 141000,2;
SUBTTL; T51 -- DESCRIPTORS FOR TEMINAL BYTES
; T51 IS SOMETIMES CALLED T58
; USED MAINLY BY P51
;
T51: XWD -1,1; 0
XWD -1,1; 1
XWD -1,1; 2
XWD -1,1; 3
XWD -1,1; 4
XWD -1,1; 5
XWD -1,1; 6
XWD -1,1; 7
XWD -1,1; 8
XWD -1,1; 9
XWD 0,V+0; A (UC)
XWD 0,V+2; B
XWD 0,V+4; C
XWD 0,V+6; D
XWD 0,V+10; E
XWD 0,V+12; F
XWD 0,V+14; G
XWD 0,V+16; H
XWD 0,V+20; I
XWD 0,V+22; J
XWD 0,V+24; K
XWD 0,V+26; L
XWD 0,V+30; M
XWD 0,V+32; N
XWD 0,V+34; O
XWD 0,V+36; P
XWD 0,V+40; Q
XWD 0,V+42; R
XWD 0,V+44; S
XWD 0,V+46; T
XWD 0,V+50; U
XWD 0,V+52; V
XWD 0,V+54; W
XWD 0,V+56; X
XWD 0,V+60; Y
XWD 0,V+62; Z
XWD 0,V+64; A (LC)
XWD 0,V+66; B
XWD 0,V+70; C
XWD 0,V+72; D
XWD 0,V+74; E
XWD 0,V+76; F
XWD 0,V+100; G
XWD 0,V+102; H
XWD 0,V+104; I
XWD 0,V+106; J
XWD 0,V+110; K
XWD 0,V+112; L
XWD 0,V+114; M
XWD 0,V+116; N
XWD 0,V+120; O
XWD 0,V+122; P
XWD 0,V+124; Q
XWD 0,V+126; R
XWD 0,V+130; S
XWD 0,V+132; T
XWD 0,V+134; U
XWD 0,V+136; V
XWD 0,V+140; W
XWD 0,V+142; X
XWD 0,V+144; Y
XWD 0,V+146; Z
XWD 10,14; BAD
XWD 10,14; BAD -- BREAK CODE FOR COMMENTARY STRINGS!
REPEAT 20,<XWD -1,3; EOC>
XWD 2,0; (
XWD 10,0; )
XWD 2,1; [
XWD 10,1; ]
XWD 3,2; ABVAL
XWD 2,0; ALPHA
XWD 10,0; OMEGA1
XWD 10,3; OMEGA2
T51.6: XWD 7,13; =
T51.61: XWD 7,14; NOT =
XWD 7,15; <
XWD 7,16; >
XWD 7,17; <=
XWD 7,20; >=
XWD 10,14; BAD
XWD 10,14; BAD
T51.1: XWD 4,3; +
T51.2: XWD 4,4; -
XWD 4,5; TIMES
XWD 4,6; /
XWD 4,7; *
XWD 10,14; BAD
XWD 10,14; BAD
T51.31: XWD 10,15; UC TAB
XWD 10,7; PG
XWD 10,7; CR
XWD 10,15; LC TAB
XWD 10,11; '
T51.10: XWD 10,12; "
XWD -1,2; UNDERSCORE
T51.16: XWD 10,14; #
SYN T51.16,T51.7;
XWD 6001,LINE; $
XWD -1,1; .
T51.4: XWD 10,2; ;
T51.23: XWD 10,3; ;
SYN T51.4,T51.22; END OF CONDITIONAL ITEM
T51.14: XWD 10,4; :
XWD 10,6; ?
T51.5: XWD 10,10; EOS
T51.8: XWD 10,5; PERIOD
XWD 10,2; SPECIAL COMMA
XWD -1,0; 1 SPACE
XWD -1,0; 2 SPACES
XWD -1,0; 3
XWD -1,0; 4
XWD -1,0; 5
XWD -1,0; 6
XWD -1,0; 7
XWD -1,0; 8 SPACES
T51.3: XWD 6,11; AND
XWD 6,12; OR
XWD 5,10; NOT
XWD 4001,0; SQRT
XWD 4001,4; LOG
XWD 4001,2; EXP
XWD 4001,6; SIN
XWD 4001,10; COS
XWD 4001,12; ARG
XWD 4001,14; IP
XWD 4001,16; FP
XWD 4001,20; DP
XWD 4001,22; XP
XWD 4001,24; SGN
XWD 5001,2; MAX
XWD 5001,3; MIN
XWD 11,0; SET
T51.20: XWD 11,1; LET
T51.17: XWD 11,2; DO
T51.19: XWD 11,3; TYPE
XWD 11,4; DELETE
XWD 11,5; LINE
XWD 11,6; PAGE
T51.18: XWD 11,7; CANCEL
XWD 11,10; GO
XWD 11,11; TO
XWD 11,12; DONE
XWD 11,13; STOP
XWD 11,14; DEMAND
T51.15: XWD 11,15; FORM (DECLARATIVE)
XWD 2011,2; STEPS
XWD 2011,1; PARTS
XWD 2011,3; FORMS
XWD 2011,5; VALUES
XWD 3011,0; ALL
T51.13: XWD 4011,2; IN
T51.12: XWD 4011,3; FOR
XWD 4011,0; IF
XWD 5011,1; SIZE
XWD 5011,2; TIME
XWD 5011,3; USERS
T51.25: XWD 1011,2; STEP
T51.26: XWD 1011,1; PART
T51.21: XWD 1011,3; FORM
XWD 5001,0; SUM
XWD 2011,4; FORMULAS
XWD 5001,1; PRODUCT
T51.9: XWD 4011,1; SPECIAL IF
XWD 4001,26; TV
XWD 11,16; PARENTHETICAL DO
XWD 11,17; PARENTHETICAL CANCEL
XWD 1,FALSE;
XWD 1,TRUE;
T51.32: XWD 1011,4; FORMULA
T51.24: XWD 4011,4; TIMES
XWD 5001,4; FIRST
T51.27: XWD 1011,7; FILE
T51.29: XWD 1011,6; ITEM
T51.28: XWD 4011,5; AS
XWD 11,20; RELEASE
XWD 11,21; FILE (VERB)
XWD 11,22; RECALL
XWD 11,23; USE
XWD 11,24; QUIT
T51.30: XWD 4011,6; LIST
T51.35: XWD 7001,UMIN; TIMER
T51.33: XWD 4011,7; BE
T51.34: XWD 4011,10; SPARSE
XWD 11,25; RESET
SUBTTL T47 -- FUNCTION HEADERS
DEFINE LSMFT(P,Q,R);
<XWD 0,P;
XWD Q,R;>
;
T47: XWD 0,SP6; SQRT
T47.1: XWD 1,1;
LSMFT SP7,1,1; EXP
LSMFT SP8,1,1; LOG
LSMFT SP9,1,1; SIN
LSMFT SP10,1,1; COS
LSMFT SP11,2,1; ARG
LSMFT SP12,1,1; IP
LSMFT SP13,1,1; FP
LSMFT SP14,1,1; DP
LSMFT SP15,1,1; XP
LSMFT SP16,1,1; SGN
LSMFT SP19,1,1; TV
T47.2: LSMFT SP20,-1,1; SUM
LSMFT SP21,-1,1; PRODUCT
LSMFT SP17,-1,1; MAX
LSMFT SP18,-1,1; MIN
SUBTTL ; VARIOUS TABLES FOR MAIN PROGRAMS
; TABLE OF OPERATOR WEIGHTS
; LEFT HALF = LEFT WEIGHT
; RIGHT HALF = RIGHT WEIGHT
T53: OCT 0; (
OCT 0; LEFT BRACKET
OCT 0; ABVAL BAR
XWD 60,60; +
XWD 60,60; -
XWD 70,70; TIMES
XWD 70,70; /
XWD 110,110; *
XWD 40,0; NOT
XWD 30,30; AND
XWD 20,20; OR
XWD 50,50; =
XWD 50,50; NOT =
XWD 50,50; LESS
XWD 50,50; GREATER
XWD 50,50; NOT GREATER
XWD 50,50; NOT LESS
XWD 100,100; UNARY PLUS
XWD 100,100; UNARY MINUS
XWD 10,0; BACK STOP
PAGE;
; TABLE OF ASSOCIATES FOR SELECTED OPERATORS
T54: XWD 10,0; )
XWD 10,1; RIGHT BRACKET
XWD 3,2; ABVAL BAR
XWD 4,21; UNARY PLUS
XWD 4,22; UNARY MINUS
PAGE;
; T55 -- OPERATOR ACTIONS ON LEAVING CONTEXT II
T55: PJ E5; (
PJ E5; LEFT BRACKET
PJ E5; ABVAL
JRST P47; +
JRST P47; -
JRST P47; TIMES
JRST P47; /
JRST P47; *
PJ E5; NOT
JRST P45; AND
JRST P45; OR
JRST T55X; =
JRST P49.1; NOT =
JRST P46; LESS
JRST P46; GREATER
JRST P46; NOT GREATER
JRST P46; NOT LESS
PJ E5; UNARY PLUS
PJ E5; UNARY -
PJ E5; BACK STOP
T55X: CN CP,K49; GOVERNED BY RHS EVALUATION?
PJ E60; DO NOT LIKE IT!
CN CP,K50;
PJ E60;
CN CP,K51;
PJ E5;
J P49.1;
PAGE;
; T56 -- MAIN PROCESSORS FOR OPS
T56: JRST MP1; (
JRST MP1; LEFT BRACKET
JRST MP2; ABVAL
JRST MP3; +
JRST MP3; -
JRST MP3; TIMES
JRST MP3; /
JRST MP3; *
JRST MP6; NOT
JRST MP5; AND
JRST MP5; OR
JRST MP7; =
JRST MP7; NOT =
JRST MP7; LESS
JRST MP7; GREATER
JRST MP7; NOT GREATER
JRST MP7; NOT LESS
JRST MP4; UNARY PLUS
JRST MP4; UNARY -
JRST MP8; BACK-STOP
PAGE;
; T57 -- SUB PROCESSORS FOR OPS
T57: PJ E5; (
PJ E5; LEFT BRACKET
TLZ A1,400000; ABVAL
PUSHJ CR,SP1; +
PUSHJ CR,SP2; -
PUSHJ CR,SP3; TIMES
PUSHJ CR,SP4; /
PUSHJ CR,SP5; *
XOR A1,TRUE; NOT
AND A1,B1; AND
IOR A1,B1; OR
CAIE B,0; =
CAIN B,0; NOT =
CAIL B,0; LESS
CAIG B,0; GREATER
CAILE B,0; NOT GREATER
CAIGE B,0; NOT LESS
PUSHJ CR,SP1.2; UNARY PLUS
PUSHJ CR,T57.2; UNARY MINUS
PJ E5; BACK-STOP CHARACTER
T57.2: XOR A1,MASK8;
CN A1,MASK8;
SETZ A1,0; GUARD AGAINST MINUS ZERO
J SP1.2;
SUBTTL T59
; SWITCH TO V-ROUTINES
T59: J V1; SET
J V2; LET
J V4; DO
J V3; TYPE
J V5; DELETE
J V6; LINE
J V7; PAGE
J V8; CANCEL
J V9; GO
J V10; TO
J V11; DONE
J V12; STOP
J V13; DEMAND
PJ E5; FORM
J V4A; PARENTHETICAL DO
J V8A; PARENTHETICAL CANCEL
J D57; RELEASE
J D58; FILE
J D59; RECALL
J D56; USE
J V15; QUIT
J V16; RESET
SUBTTL T60
; TABLE OF INDENTATION STRINGS
BYTE (8)177,177,170,165;
BYTE (8)177,177,165;
BYTE (8)177,176,165;
BYTE (8)177,175,165;
BYTE (8)177,174,165;
BYTE (8)177,173,165;
BYTE (8)177,172,165;
BYTE (8)177,171,165;
BYTE (8)177,170,165;
BYTE (8)177,165,
BYTE (8)176,165,
BYTE (8)175,165,
BYTE (8)174,165,
BYTE (8)173,165,
BYTE (8)172,165,
BYTE (8)171,165,
BYTE (8)170,165,
BYTE (8)165,
T60: XWD 41000,T60-2;
EXTERN T61
END
Reference in New Issue View Git Blame Copy Permalink