Trailing-Edge
-
PDP-10 Archives
-
BB-F493Z-DD_1986
-
10,7/interp.mac
There are 5 other files named interp.mac in the archive. Click here to see a list.
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