Google
 

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