Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50516/basddt.mac
There are no other files named basddt.mac in the archive.
	TITLE	BASDDT

	SEARCH	S
 
SUBTTL		PARAMETERS AND TABLES
 
;***COPYRIGHT 1969,1970,1971,1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
 
;VERSION 17E	2-OCT-74/NA
;VERSION 17D	4-MAY-73/KK
;VERSION 17C	2-JAN-73/KK
;VERSION 17B	25-JUL-72/KK
;VERSION 17A	10-FEB-1972/KK
;VERSION 17	15-OCT-1971/KK
;VERSION 16	5-APR-1971/KK
;VERSION 15	17-AUG-1970/KK
;VERSION 14	16-JUL-1970/AL/KK
;VERSION 13	15-SEP-1969
 
 
 
	LOC	.JBINT
	TRPLOC
 
	LOC	.JBVER
	BYTE	(3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT

	LOC	.JB41
	JSR	UUOH
	RELOC
	HISEG
 
 

	EXTERN ERR,ERL,ERRGO,ERRCNT,LINADR,ERLB,ERRB
	EXTERN TYPE,FTYPE,PFLAG,AFLAG,INLNFG
	EXTERN FLTPNT,FIXPNT

	EXTERN EXP1.0,EXP2.0
	EXTERN ACTBL,APPEND,ARAROL,ARATOP,ARGROL,ASCIIB,ATANB,BGNTIM
	EXTERN BLOCK,CADROL,CATFLG,CEARG,CECAD,CECOD,CECON,CEFCL
	EXTERN CEFOR,CEGSB,CEIL,CELAD,CELIN,CELIT,CENTRY,CENXT
	EXTERN CEPTM,CESAD,CESEX,CESLT,CESTM,CESVR,CETMP,CEVSP
	EXTERN CHAERR,CHAFL2,CHAFLG,CHAHAN,CHAXIT,CHKIMG,CHRB
	EXTERN CLOGB,CLSFIL,CNER1,CODROL,COMTIM,COMTOP,CONROL,CORINC
	EXTERN COSB,COTB,CRLF,CRTVAL,DATAFF,DATEB,DAYB,DETER,DEVBAS,DOINPT
	EXTERN DOREAD,D1E14,D1EM18,DECTAB,ECHOB,LIBFLG
	EXTERN EIFLOT,ELSEAD,ELSFLG,ENDIMG,EOF,EXECUT,EXP3.0,EXPB,EXTD
	EXTERN FADROL,FCLROL,FCNROL,FILCNT,FILD,FILDIR,FILTYP,FPPN
	EXTERN FIXB,FLARA,FLARG,FLCAD,FLCOD,FLCON,FLFAD,FLFCL,FLFOR
	EXTERN FLGSB,FLLAD,FLLIN,FLLIT,FLNXT,FLOOR,FLPTM,FLREF
	EXTERN FLSAD,FLSCA,FLSEX,FLSLT,FLSTM,FLSVR,FLTMP,FNMX0
	EXTERN FNMXER,FORCAR,FORPNT,FORROL,FRETRN,FTRUTH,FUNAME
	EXTERN FUNLOW,FUNSTA,GSBROL,HPOS,IFFLAG,IFIX,IMGLIN
	EXTERN INPFLA,INPOUT,INPPRI,INSEQ,INSET,INSTRB,INTB,JAROUN,JFCLAD
	EXTERN KWDIND,LADROL,LASREC,LEFTB,LENB,LETSW,LEXECT,LINEB
	EXTERN LINROL,LITROL,LOCLOF,LOGB,LOGNEG,LSAVE,LUXIT
	EXTERN MARERR,MARGAL,MARGIN,MARGN,MASAPP,MASTST,MIDB,MINFLG,MTIME
	EXTERN MULLIN,NEWOL1,NOTLIN,NUMCOT,NUMRES,ODF,IFIFG,OLDCOD
	EXTERN ONCESW,ONGFLG,OPNFIL,OPNFLG,OUTSET,PAGE,PAGEAL
	EXTERN PAGLIM,PAKFLG,PIB,PLIST,POINT,POSB,PRDLER,PRTNUM,PSHPNT
	EXTERN PSHROL,PTMROL,QSKIP,QST,QUOTBL,RANDER,RANSCR,REAINP
	EXTERN REFROL,REGPNT,REINER,RELNEG,RELROL,RENFLA,RESTON
	EXTERN RETURN,RIGHTB,RNDB,RNNUMO,RNSTRO,ROLMSK,RUNFLA,RUNLIN
	EXTERN SADROL,SAVACS,SAVE1,SAVRUN,SCAROL,SCATH,SCNIMN,SCNIMS
	EXTERN SETCOR,SETERR,SEVEN,SEXROL,SINB,SLEEPB,SLTROL,SORCLN,SPACEB
	EXTERN SQRTB,STAROL,START,STRB,STRLEN,SVRBOT,SVRROL,SVRTOP
	EXTERN SWAPSS,TABLE,TANB,TEMLOC,TEMP1,THENAD,TIMEB,TMPLOW
	EXTERN THNCNT,THNELS
	EXTERN TMPPNT,TMPROL,TOPSTG,TRNFL2,TRNFLG,TRPLOC,TRUTH,TTYPAG
	EXTERN UUOH,VALB,VARFRE,VARROL,VPAKFL,VRFBOT,VRFSET
	EXTERN VRFTOP,VSPROL,WRIPRI,WRPRER,WRREFL,XCTON,XRES
	EXTERN .JBFF,.JBREL,.JBSA

	EXTERN	PLTIN,PLTOUT

;	VIRTUAL ARRAY LOW SEGMENT EXTERNALS

	EXTERN FLVIR,CEVIR,VIRROL,VIRDIM,VIRSIZ
	EXTERN LBASIC,UXIT
	BASIC=LBASIC
	EUXIT=UXIT

;******	EXTERNALS FROM BASLIB (COMLIB)

	EXTERN CPOPJ,CPOPJ1,DATCHK,ERACOM
	EXTERN ERRMS3,FILNAM,FILNMO,GETNU,GOSR2
	EXTERN GETNUM,INLINE,INLMES,LOCKOF,LOCKON,NXCH,NXCHD
	EXTERN OUCH,PRINT,PRNNAM,QSA,QST
	EXTERN SCNLTN,SEARCH,TTYIN

;******		END EXTERNALS FROM BASLIB (COMLIB)


	EXTERN DDCODE,DDSTRT,DDTFLG,RUNDDT,.USREL,.DDREL,.DDFF,.DDSA
	EXTERN .DDTMP,DDTCOD,CETXT,FLTXT,PAKFLA,ROLTOP,CEDON
	EXTERN CEFAD,FLFAD,CEREF,FLDON,DERRGO,NOLINE
	EXTERN DPTROL,DTPROL,FLDPT,FLDTP,CEDPT,CEDTP
	EXTERN DLTROL,FLDLT,CEDLT,DITROL,FLDIT,CEDIT
	EXTERN STMROL,DONROL,FLVAR,CEVAR,CESCA
	EXTERN DDTERR,ONGADR,FIXCON,GOSBER

	INTERN DDTGO,DPANIC

DEFINE FAIL (A,AC)<
	XLIST
	JRST	[PUSHJ P,INLMES
		ASCIZ \A\
	IFN AC,< MOVE T,N
		PUSHJ P,PRTNUM>
		JRST NXTST3]
	LIST
>
	DEFINE ERROM(A,B)
<	ASCIZ	B>
%OPD=1	;OPDEF UUO COUNTER
DEFINE OPCNT (A)<
%OPD=%OPD+1
IFG %OPD-37,<PRINTX <TOO MANY UUO'S>>
OPDEF A [<%OPD>B8]>
	OPCNT	PRNM
	OPCNT	PRDL
	OPCNT	PRNTB
	OPCNT	GOSUB
	OPCNT	ARFET1
	OPCNT	ARFET2
	OPCNT	ARSTO1
	OPCNT	ARSTO2
	OPCNT	ARSTN1
	OPCNT	ARSTN2
	OPCNT	DATA
	OPCNT	ADATA1
	OPCNT	ADATA2
	OPCNT	SDIM
	OPCNT	MATRD
	OPCNT	MATPR
	OPCNT	MATSCA
	OPCNT	MATCON
	OPCNT	MATIDN
	OPCNT	MATTRN
	OPCNT	MATINV
	OPCNT	MATADD
	OPCNT	MATSUB
	OPCNT	MATMPY
	OPCNT	MATZER
	OPCNT	STRUUO
	OPCNT	SVRADR
	OPCNT	PRSTR
	OPCNT	DONFOR
	OPCNT	MATINP
 
DDTFLO:
	Z	XBAS-400000+600000(SIXBIT/   BAS/)
	Z	XCHAN-400000+200000(SIXBIT/   CHA/)
	Z	XCLOSE-400000+600000(SIXBIT/   CLO/)
	Z	XCONT-400000(SIXBIT/   CON/)
	Z	XDEC-400000(SIXBIT/   DEC/)
	Z	XELSE-400000+200000(SIXBIT/   ELS/)
	Z	XEND-400000+200000(SIXBIT/   END/)
	Z	XFOR-400000+200000(SIXBIT/   FOR/)
	Z	XGOSUB-400000+600000(SIXBIT/   GOS/)
	Z	XGOTO-400000+600000(SIXBIT/   GOT/)
	Z	XIF-400000+200000(SIXBIT/   IF /)
	Z	XINPUT-400000+600000(SIXBIT/   INP/)
	Z	XLET-400000+200000(SIXBIT/   LET/)
	Z	XLIST-400000(SIXBIT/   LIS/)
	Z	XMAR-400000+600000(SIXBIT/   MAR/)
	Z	XMAT-400000+200000(SIXBIT/   MAT/)
	Z	XNEXT-400000+600000(SIXBIT/   NEX/)
	Z	XNOP-400000+600000(SIXBIT/   NOP/)
	Z	XNOQ-400000+600000(SIXBIT/   NOQ/)
	Z	XON-400000+200000(SIXBIT/   ON /)
	Z	XOPEN-400000+600000(SIXBIT/   OPE/)
	Z	XPAG-400000+600000(SIXBIT/   PAG/)
	Z	XPRINT-400000+600000(SIXBIT/   PRI/)
	Z	XQUO-400000+600000(SIXBIT/   QUO/)
	Z	XRAN-400000+600000(SIXBIT/   RAN/)
	Z	XREAD-400000+600000(SIXBIT/   REA/)
	Z	XREM-400000(SIXBIT/   REM/)
	Z	XREST-400000+200000(SIXBIT/   RES/)
	Z	XSCRAT-400000+600000(SIXBIT/   SCR/)
	Z	XSET-400000+200000(SIXBIT/   SET/)
	Z	XSTART-400000(SIXBIT/   STA/)
	Z	XSTOP-400000(SIXBIT/   STO/)
	Z	XUNTIL-400000+600000(SIXBIT/   UNT/)
	Z	XWHILE-400000+600000(SIXBIT/   WHI/)
	Z	XWRIT-400000+600000(SIXBIT/   WRI/)
DDTCEI:
 
 
	OPDEF	STRSTO	[STRUUO 1,]
	OPDEF	STRIF	[STRUUO 2,]
	OPDEF	STRIN	[STRUUO 3,]
	OPDEF	VECFRL	[STRUUO 4,]
	OPDEF	VECPRL	[STRUUO 5,]
	OPDEF	STOCHA	[STRUUO 6,]
	OPDEF	VECFIN	[STRUUO 7,]
	OPDEF	VECPIN	[STRUUO 10,]
	OPDEF	PJRST	[JRST 0]
 
 
;TABLE OF INTRINSIC FUNCTIONS
 
DEFINE ZZZ. (X) <
	XLIST
	<SIXBIT /X/>
	LIST
>
 
IFNFLO:
	ZZZ.	(ABS)
	ZZZ.	(ASC)
	ZZZ.	(ASCII)
	ZZZ.	(ATN)
	ZZZ.	(CHR$)
	ZZZ.	(CLOG)
	ZZZ.	(COS)
	ZZZ.	(COT)
	ZZZ.	(CRT)
	ZZZ.	(DATE$)
	ZZZ.	(DAY$)
	ZZZ.	(DET)
	ZZZ.	(ECHO)
	ZZZ.	(ERL)
	ZZZ.	(ERR)
	ZZZ.	(EXP)
	ZZZ.	(FIX)
	ZZZ.	(FLOAT)
	ZZZ.	(INSTR)
	ZZZ.	(INT)
	ZZZ.	(LEFT$)
	ZZZ.	(LEN)
	ZZZ.	(LINE)
	ZZZ.	(LL)
	ZZZ.	(LN)
	ZZZ.	(LOC)
	ZZZ.	(LOF)
	ZZZ.	(LOG)
	ZZZ.	(LOGE)
	ZZZ.	(LOG10)
	ZZZ.	(MID$)
	ZZZ.	(NUM)
	ZZZ.	(NUM$)
	ZZZ.	(PI)
	ZZZ.	(POS)
	ZZZ.	(RIGHT$)
	ZZZ.	(RND)
	ZZZ.	(SGN)
	ZZZ.	(SIN)
	ZZZ.	(SLEEP)
	ZZZ.	(SPACE$)
	ZZZ.	(SQR)
	ZZZ.	(SQRT)
	ZZZ.	(STR$)
	ZZZ.	(TAN)
	ZZZ.	(TIM)
	ZZZ.	(TIME$)
	ZZZ.	(VAL)
IFNCEI:
 
 
%FN=1
	DEFINE ZZZ. (X) <
	XLIST
	OPDEF ZZZZ. [%FN]
	ZZZZ.
	%FN=%FN+1
	LIST
>
 
	DEFINE	ZTYPE (A,B,C),<
	XLIST
	BYTE	(9)A,B(18)C
	LIST
>

IF2FLO:	ZZZ.	(ABS)
	ZZZ.	(ASC)
	ZTYPE	4,1,ASCIIB
	ZTYPE	2,2,ATANB
	ZTYPE	1,4,CHRB
	ZTYPE	2,2,CLOGB
	ZTYPE	2,2,COSB
	ZTYPE	2,2,COTB
	ZZZ.	(CRT)
	ZTYPE	1,0,DATEB
	ZTYPE	1,0,DAYB
	ZZZ.	(DET)
	ZTYPE	4,4,ECHOB
	ZTYPE	4,0,ERLB
	ZTYPE	4,0,ERRB
	ZTYPE	2,2,EXPB
	ZTYPE	4,2,FIXB
	ZZZ.	(FLTBI)
	XWD	IF31,INSTRB
	ZTYPE	4,2,INTB
	XWD	IF32,LEFTB
	ZTYPE	4,1,LENB
	ZTYPE	4,0,LINEB
	ZZZ.	(LL)
	ZTYPE	2,2,LOGB
	ZZZ.	(LOC)
	ZZZ.	(LOF)
	ZTYPE	2,2,LOGB
	ZTYPE	2,2,LOGB
	ZTYPE	2,2,CLOGB
	XWD	IF33,MIDB
	ZZZ.	NUM
	ZTYPE	1,2,STRB
	ZZZ.	(PI)
	ZTYPE	1,4,POSB
	XWD	IF32,RIGHTB
	ZTYPE	2,0,RNDB
	ZZZ.	(SGN)
	ZTYPE	2,2,SINB
	ZTYPE	4,4,SLEEPB
	ZTYPE	1,4,SPACEB
	ZTYPE	2,2,SQRTB
	ZTYPE	2,2,SQRTB
	ZTYPE	1,2,STRB
	ZTYPE	2,2,TANB
	ZZZ.	(TIM)
	ZTYPE	1,0,TIMEB
	ZTYPE	2,1,VALB
IF2CEI:
 
 
IF31:	XWD 3		;ARG BLOCK FOR INSTR
	XWD -1,-1
	XWD 0,+1
	XWD 0,+1
 
 
IF32:	XWD 2		;ARG BLOCK FOR LEFT$, RIGHT$.
	XWD 0,+1
	XWD 0,-1
 
IF33:	XWD 3		;ARG BLOCK FOR MID$
	XWD 0,+1
	XWD 0,-1
	XWD -1,-1
 
 
;TABLE OF RELATIONS FOR IFSXLA
 
DEFINE ZZZ. (X,Y)<
OPDEF ZZZZ.	[X]
		ZZZZ.	(Y)>
RELFLO: ZZZ.	3435B11,CAMGE
	ZZZ.	3436B11,CAMN
	ZZZ.	   74B6,CAMG
	ZZZ.	3635B11,CAMLE
	ZZZ.	75B6,CAME
	ZZZ.	   76B6,CAML

RELCEI:
 
 
DDTGO:	SKIPE	DDTERR		;HERE FROM ERROR
	JRST	NXTST4		;YES, TREAT LIKE COMPILATION ERROR
	MOVEI	R,STAROL	;DUMMY UP STAROL
	MOVEI	X1,DDTFLO	;WITH DDT STATEMENTS
	MOVEM	X1,FLOOR(R)	;SET FLOOR
	MOVEI	X1,DDTCEI	;AND CEIL
	MOVEM	X1,CEIL(R)	;ALL DONE
	MOVEI	R,RELROL	;MUST ALSO USE THIS RELROL
	MOVEI	X1,RELFLO	;NEW FLOOR
	MOVEM	X1,FLOOR(R)	;SET IT
	MOVEI	X1,RELCEI	;NEW CEIL
	MOVEM	X1,CEIL(R)	;SET IT
	CLEARM	DDTFLG		;NO BREAKS YET
	MOVEI	R,SCAROL	;OPEN UP SCAROL
	MOVEI	E,5		;WITH FIVE LOCATIONS
	PUSHJ	P,BUMPRL	;DO IT
	MOVEI	R,VARROL	;NOW OPEN UP VARROL
	MOVEI	E,5		;WITH FIVE CORRESPONDING LOCATIONS
	PUSHJ	P,BUMPRL	;DO IT
	MOVE	X1,CESCA	;CEIL OF SCAROL
	SUB	X1,FLSCA	;LESS FLOOR GIVES SIZE
	SOJ	X1,		;CORRECT
	HRLI	X1,777760	;LARGEST "ASCII" VARIABLE NAME
	MOVE	X2,CEVAR	;START OF FIVE LOCATIONS
	MOVE	A,CESCA		;GET CEIL TO ZERO
	MOVEI	B,5		;LOOP COUNTER
DDTSCA:	MOVEM	X1,-1(X2)	;STORE IT
	SUB	X1,[XWD 20,1]	;DECREMENT LOCATION AND VARIABLE NAME
	SOJ	X2,		;DECREMENT VARROL POINTER
	CLEARM	-1(A)		;ZERO LOCATION
	SOJ	A,		;DECREMENT SCAROL LOCATION
	SOJG	B,DDTSCA	;ALL FIVE DONE?
SUBTTL	BASDDT "LOADER"
 
LINKAG:	MOVEI	R,CONROL	;SLIDE RUNTIME ROLLS DOWN INTO PLACE.
LKLAB1:	PUSHJ	P,SLIDRL
	CAIGE	R,TMPROL
	AOJA	R,LKLAB1	;SLIDE NEXT ROLL.
	MOVEM	X2,VARFRE	;FIRST FREE LOC IS CEIL OF TMPROL.
;
;	GET ARRAY REQUIREMENTS
;
LKS3:	MOVE	E,CETMP ;CHECK ARRAY REQUIREMENTS
	MOVE	T,FLARA
	SETZM	TRNFL2
	SETZM	TRNFLG
	JRST	LK2A
 
LK1:	HLRZ	X1,(T)		;KNOW SIZE?
	TRNE	X1,400000	;VIRTUAL
	JRST	LK2B		;YES, IGNORE IT
	JUMPN	X1,LK2		;YES, JUMP
	SKIPG	2(T)		;DON'T SET UP FAKE MATRIX
	JRST	LKLAB2		;YET, BUT REMEMBER WHICH ONE
	MOVEM	T,TRNFLG	;IT IS.
	JRST	LK2
LKLAB2:	MOVSI	X2,^D11 	;(11,1) IS STANDARD DIM
	AOJ	X2,
	MOVEI	X1,^D11
	MOVE	A,1(T)
	AOJN	A,LKLAB4	;IMPLICIT 2-DIM ARRAY?
	HRRI	X2,^D11
	MOVEI	X1,^D121
LKLAB4:	MOVEM	X2,1(T)
	HRLM	X1,(T)		;STORE SIZE
LK2:	ADD	E,X1		;ADD LENGTH TO IT
	SKIPL	2(T)
	JRST	LK2B
	CAMLE	X1,TRNFL2	;TRNFL2 CONTAINS THE SPACE NEEDED
	MOVEM	X1,TRNFL2	;BY THE LRGST ARRAY SET = ITS OWN TRN.
LK2B:	ADDI	T,3		;ON TO NEXT ENTRY
LK2A:	CAME	T,FLSVR
	JRST	LK2C
	SKIPN	X2,TRNFLG
	JRST	LK2D
	MOVE	X1,TRNFL2
	HRLM	X1,(X2)
	ADD	E,X1
LK2D:	MOVEM	E,SVRBOT
LK2C:	CAMGE	T,CESVR
	JRST	LK1
 
LK3:	SETOM	VPAKFL		;DONT TRY TO PRESS VARAIBLE SPACE NOW!
	SUB	E,CESVR 	;WE NEED THIS MANY LOCS
LK35:	MOVE	X1,VARFRE	;IS THERE ROOM FOR (E) LOCS?
	ADDI	X1,(E)
	CAMGE	X1,.JBREL
	JRST	LK37
	TLNN	X1,-1		;TOO BIG FOR A PDP10 ?
	CORE	X1,
	JRST	[PUSHJ	P,INLMES
		ASCIZ	/
? Out of room/
		JRST	ERRMSG]
;
;	GET SPACE FOR DDT
;
LK37:	ADD	E,CETMP		;CALCULATE TOP OF ARRAY SPACE
	MOVEM	E,SVRTOP
	MOVEM	E,VARFRE	;FIRST FREE WORD
	MOVE	X1,.JBREL	;HIGH NOW
	MOVEM	X1,.USREL	;USER HIGH
	AOJ	X1,		;START OF BASDDT
	MOVEM	X1,.DDSA	;SAVE IT
	ADDI	X1,17		;START FOR DDT
	MOVEM	X1,.DDTMP	;ROOM FOR AC'S
	AOJ	X1,		;START FOR BASDT CODE
	MOVEM	X1,DDTCOD	;SAVE IT
	ADDI	X1,^D100
	MOVEM	X1,.DDFF
	ADD	X1,CELAD	;ESTIMATE HOW MUCH CORE WE NEED
	SUB	X1,FLVAR	;TO MOVE VARROL THRU LADROL
	CORE	X1,		;GET K FOR DDT
	JRST	[PUSHJ	P,INLMES
		ASCIZ	/
? Out of room/
		JRST	ERRMSG]
	MOVE	X1,.JBREL
	MOVEM	X1,.DDREL
LK4:	MOVE	T,FLFCL
	MOVEI	R,FCNROL
LINK0A: CAML	T,CEFCL
	JRST	LINK0C		;NO MORE FCN CALLS
	HLLZ	A,(T)		;LOOK UP FUNCTION
	PUSHJ	P,SEARCH
	JRST	LINK0B		;UNDEFINED
	MOVE	A,(B)		;DEFINED.  GET ADDRESS.
	HRLM	A,(T)
	AOJA	T,LINK0A
 
 
LINK0B: SETZM	RUNFLA
	PUSHJ	P,INLMES
	ASCIZ	/
? Undefined function -- FN/
	LDB	C,[POINT 7,A,6]
	PUSHJ	P,OUCH
	SKIPE	CHAFL2
	PUSHJ	P,ERRMS3
	PUSHJ	P,INLMES
	ASCIZ	/
/
	AOJA	T,LINK0A
 
LINK0C: MOVE	B,FLFOR ;UNSAT FORS?
	CAML	B,CEFOR
	JRST	LINK0D
	SETZM	RUNFLA		;RETURN TO BASIC
	PUSHJ	P,INLMES
	ASCIZ	/? FOR without NEXT in line /
	MOVE	T,(B)		;GET LINE
	ADD	T,FLLIN
	HLRZ	T,(T)
	PUSHJ	P,PRTNUM	;PRINT IT
	SKIPE	CHAFL2
	PUSHJ	P,ERRMS3
	PUSHJ	P,INLMES
	ASCIZ	/
/
	ADDI	B,5		;MORE UNSAT FORS?
	JRST	LINK0C+1
; 
LINK0D: SKIPG	DATAFF		;WAS DATA OMITTED?
	JRST	LINK0E		;NO
	PUSHJ	P,INLMES
	ASCIZ	/
? No DATA/
	SKIPE	CHAFL2
	PUSHJ	P,ERRMS3
	SETZM	RUNFLA
LINK0E: SKIPGE	RUNLIN		;LINE NUMBER ARG IN RUN(NH) COMMAND?
	JRST	LINK0F		;NO.
	HRLZ	A,RUNLIN	;YES.  MAKE SURE IT EXISTS AND
	MOVEI	R,LINROL
	PUSHJ	P,SEARCH
	JRST	[PUSHJ	P,INLMES
		ASCIZ	/
? Illegal line reference in RUN(NH) or CHAIN/
		JRST	ERRMSG]
 
	SUB	B,FLOOR(R)
	MOVEM	B,RUNLIN
	ADD	B,FLREF 	;IS NOT WITHIN A MULTI-LINE DEF.
	SKIPE	(B)
	JRST	[PUSHJ	P,INLMES
		ASCIZ	/
? Illegal line reference in RUN(NH) or CHAIN/
		JRST	ERRMSG]
LINK0F: SKIPN	RUNFLA		;GO INTO EXECUTION?
	JRST	LUXIT		;NO
	MOVE	C,FLCOD
;CODE ROLL IS IN PLACE.  C CONTAINS ITS FLOOR
 
LINK0:	MOVE	T,FLFCL 	;LINK FCN CALLS
	MOVE	T1,CEFCL
	MOVE	A,FLCOD
	MOVEI	B,0
	PUSHJ	P,LINKUP
 
LINK1A: MOVE	T,FLARA 	;LINK ARRAY REFS
	MOVE	T1,CESVR
	MOVE	A,T
	MOVEI	B,3
	PUSHJ	P,LINKUP
 
LINK1B: MOVE	T,FLARA 	;STORE ARRAY ADDRESSES IN ARAROL
	MOVE	G,CETMP
	JRST	LINK1D
LINK1C: HLRZ	X1,(T)		;GET ARRAY LENGTH
	TRNE	X1,400000	;VIRTUAL
	JRST	LINK1E		;YES, IGNORE IT
	HRRM	G,(T)		;STORE ABS ADDRS
	ADD	G,X1		;COMPUTE ADDRS OF NEXT ARRAY
LINK1E:	ADDI	T,3		;GO TO NEXT ENTRY
LINK1D: CAMGE	T,T1
	JRST	LINK1C
 
 
LINK1:	MOVE	T,FLCAD 	;LINK CONST REFS
	MOVE	T1,CECAD
	MOVE	A,FLCON
	MOVEI	B,1
	PUSHJ	P,LINKUP
 
LINK2:	MOVE	T,FLPTM 	;LINK TEMPORARY REFS (PERM AND TEMP)
	MOVE	T1,CETMP
	MOVE	A,T
	MOVEI	B,1
	PUSHJ	P,LINKUP
 
LINK3:	MOVE	T,FLLAD 	;LINK GOTO DESTINATIONS
	MOVE	T1,CELAD
	MOVE	A,FLCOD
	MOVEI	B,0
	PUSHJ	P,LINKUP
 
LINK4:	MOVE	T,FLSCA 	;LINK SCALARS
	MOVE	T1,CEVSP
	MOVE	A,T
	MOVEI	B,1
	PUSHJ	P,LINKUP
 
 
LINK6:	MOVE	T,FLGSB 	;LINK GOSUB REFS
	MOVE	T1,CEGSB
	MOVE	A,T
	MOVEI	B,1
	PUSHJ	P,LINKUP
	MOVE	T,FLGSB
LINK7:	CAML	T,T1		;PUT SUBRTN ADDRSES IN GSBROL
	JRST	LINK8
	HLRZ	X1,(T)
	ADD	X1,FLLAD
	HLRZ	X1,(X1)
	ADD	X1,C
	MOVEM	X1,(T)
	AOJA	T,LINK7
 
LINK8:	MOVE	T,FLNXT 	;LINK REVERSE REFS IN FORS
	MOVE	T1,CENXT
	MOVE	A,FLCOD
	MOVEI	B,0
	PUSHJ	P,LINKUP
 
LINK9:	MOVE	T,FLLIT 	;LINK LITROL TO SLTROL.
LINK91: CAML	T,CELIT
	JRST	LINK92
	HRRZ	A,(T)
	ADD	A,FLSLT
	HRRM	A,(T)
	AOJA	T,LINK91
LINK92: MOVE	T,FLSAD 	;LINK POINTERS TO LITROL
	MOVE	T1,CESAD
	MOVE	A,FLLIT
	MOVEI	B,1
	PUSHJ	P,LINKUP
	SKIPGE	X1,RUNLIN	;GET LOC TO START BEFORE
	JRST	LINKZ		;LADROL IS ZEROED.
	ADD	X1,FLLAD
	HLRZ	X1,(X1)
	ADD	X1,FLCOD
	MOVEM	X1,RUNLIN
 
LINKZ:	MOVE	X1,.DDFF
	MOVEM	X1,FLSEX
	MOVEM	X1,CESEX
	AOS	.DDFF
	MOVEI	R,VARROL
	PUSHJ	P,SAVROL
	MOVE	X1,.DDFF
	MOVEM	X1,CEARG
	MOVEM	X1,FLARG
	AOS	.DDFF
	MOVEI	R,REFROL
	PUSHJ	P,SAVROL
	MOVEI	R,FCNROL
	PUSHJ	P,SAVROL
	MOVE	X1,.DDFF
	AOS	.DDFF
	MOVEM	X1,FLFCL
	MOVEM	X1,CEFCL
	MOVEI	R,FADROL
	PUSHJ	P,SAVROL
	MOVE	X1,.DDFF
	AOS	.DDFF
	MOVEM	X1,FLCAD
	MOVEM	X1,CECAD
	MOVEI	R,LADROL
	PUSHJ	P,SAVROL
	MOVEI	R,ROLTOP
	HRLZI	X1,FLSAD
	HRRI	X1,FLFOR
	MOVE	X2,.DDFF
	MOVEM	X2,FLSAD
	BLT	X1,FLOOR(R)
	HRLZI	X1,CESAD
	HRRI	X1,CEFOR
	MOVEM	X2,CESAD
	BLT	X1,CEIL(R)
	PUSH	P,TOPSTG	;SAVE TOPSTG
	MOVEI	R,STMROL	;NEW TOPSTG
	MOVEM	R,TOPSTG	;
	PUSHJ	P,PRESS		;MOVE ALL ROLLS AS FAR DOWN AS WE CAN
	POP	P,TOPSTG	;RESTORE TOPSTG
	PUSHJ	P,ZSTOR		;ZERO OUT STORAGE
 
	SKIPGE	A,RUNLIN	;START AT DIFFERENT LINE
	HRRZ	A,FLCOD		;NO
	MOVEM	A,DDSTRT	;SAVE PROGRAM START
	MOVEI	A,DDFRST	;PSEUDO START
	MOVEM	A,RUNLIN	;FAKE OUT BASDDT
	JRST	EXECUT		;GO DO EXECUTE STUFF NOW
;SUBROUTINE TO LINK ROLL ENTRIES
 
;CALL WITH A=ORG OF VALUE ROLL, B=INCREMENT (0 IF EXPLICIT REL LOC)
;T=FLOOR OF SRC ROLL, T1=CEIL OF SRC ROLL
 
LINKUP: MOVE	X2,A
	MOVSI	X1,C
 
LNKP1:	CAML	T,T1		;FINISHED ROLL?
	POPJ	P,
	HRRZ	A,(T)		;FIRST LOC IN CHAIN
	JUMPN	B,LKLAB5	;EXPLICIT ADDRS?
	HLRZ	X2,(T)		;YES.  COMPUTE IT
	ADD	X2,C
LKLAB5:	JUMPE	A,LNKP3 	;SPECIAL CASE--CHAIN VOID
 
LNKP2:	HRR	X1,A		;ONE LINK IN CHAIN
	HRRZ	A,@X1
	HRRM	X2,@X1
	JUMPN	A,LNKP2
 
LNKP3:	JUMPN	B,LKLAB6	;EXPLICIT ADDRS?
	AOJA	T,LNKP1 	;YES, JUST BUMP ROLL PNTR
LKLAB6:	ADD	T,B		;NO, ADD EXPLICIT INCREMENT
	ADD	X2,B		;  (ALSO TO DEST ROLL)
	JRST	LNKP1
 
ZSTOR:	MOVE	X1,FLSCA	;ZERO OUT SCALARS AND STRING VARS
	MOVE	X2,CEVSP
	PUSHJ	P,BLTZER
	MOVE	X1,CETMP	;ZERO OUT ARRAY ELEMENTS AND STRING VECTORS.
	MOVE	X2,ARATOP
BLTZER: HRL	X1,X1		;ZERO OUT CORE
	SETZM	(X1)
	AOJ	X1,
	BLT	X1,-1(X2)
	POPJ	P,
;
;	SAVE ROLL FOR DDT
;
SAVROL:	MOVE	X2,CEIL(R)	;START SAVING HERE
	MOVE	X1,.DDFF	;PUT IT HERE
	ADD	X2,X1		;
	HRL	X1,FLOOR(R)	;SET UP BLT TO MOVE ROLL
	SUB	X2,FLOOR(R)	;AMOUNT NEEDED TO SAVE
	HRRZM	X1,FLOOR(R)	;NEW FLOOR
	BLT	X1,(X2)		;SAVE IT
	MOVEM	X2,CEIL(R)	;NEW CEIL
	MOVEM	X2,.DDFF	;NEW FREE FOR DDT
	POPJ	P,
;
;	SLIDE ROLL INTO PLACE FOR RUNTIME
;
SLIDRL:	MOVE	X2,CEIL(R)	;END SAVE HERE
	HRRZ	X1,CEIL-1(R)	;SLIDE ROLL DOWN NEXT TO LOWER ROLL
	ADD	X2,X1
	HRL	X1,FLOOR(R)	;SET UP BLT TO SLIDE ROLL
	SUB	X2,FLOOR(R)	;AMOUNT NEEDED
	HRRZM	X1,FLOOR(R)	;NEW FLOOR
	BLT	X1,(X2)		;SAVE IT
	MOVEM	X2,CEIL(R)	;NEW CEIL
	POPJ	P,
SUBTTL	IMMEDIATE MODE PROCESSOR
DDFRST:	MOVE	A,DDSTRT	;GET PROGRAM START
	MOVEM	A,RUNLIN	;RESTORE
	SETOM	DDSTRT		;FORCE START
	PUSHJ	P,INLMES	;SO TELL USER
	ASCIZ	/[BASDDT execution]

/
	OUTPUT			;SEND THE MESSAGE
	SETZM	MULLIN		;IN CASE END WAS ON MULTI-LINE
	JRST	EACHLN		;START DDT
DDTBRK:	MOVEM	A,DDSTRT	;POP-OFF RETURN
	MOVEM	A,SORCLN	;SAVE SOURCE LINE NUMBER
	MOVE	N,.DDSA		;SAVE THE AC'S HERE
	BLT	N,@.DDTMP	;ALL 17
	MOVE	X1,ERRGO	;SAVE ANY ON ERROR LABEL
	MOVEM	X1,DERRGO	;FOR RESTORATION
	CLEARM	ERRGO		;DO NOT PROCESS ON ERROR IN DDT MODE
	SETOM	NOLINE		;DO NOT PRINT LINE # ON ERROR
	MOVEI	X1,STMROL
	MOVEM	X1,TOPSTG
	CLEARM	ODF		;SETUP FOR OUTPUT TO TTY
	PUSHJ	P,INLMES	;TELL USER A STOP
	ASCIZ	/<STOP># /
	MOVE	T,SORCLN
	HRRZ	T,(T)		;GET LINE NUMBER
	PUSHJ	P,PRTNUM	;PRINT LINE #
	PUSHJ	P,PCRLF
EACHLN:	SETOM	VRFSET		;
	SETZM	INLNFG		;CLEAR INPUT LINE FLAG
	CLEARM	ODF		;
	CLEARM	IFIFG		;SETUO FOR TTY INPUT
	CLEARM	AFLAG		;CLEAR A FLAG
	SETZM	LOGNEG		;
	CLEARM	PFLAG		;CLEAR P FLAG
	SKIPN	MULLIN
	JRST	ECHL2A
	MOVE	D,T
	JRST	EACHL2
ECHL2A:	CLEARM	THENAD
	CLEARM	THNCNT
	CLEARM	ELSFLG
	CLEARM	ELSEAD
	SETZM	THNELS
ECHLN1:	MOVEI	C,">"
	PUSHJ	P,OUCH
	OUTPUT
	HRRZS	RUNDDT
	PUSHJ	P,INLINE
	HRROS	RUNDDT
	TLNE	C,F.TERM	;JUST A TERMINATOR
	JRST	ECHLN1		;YES, FORGET IT
	MOVS	D,T		;SAVE LINE POINTER
EACHL2:	TLNN	C,F.LETT	;MUST BE  A LETTER
	JRST	ILLINS
	PUSHJ	P,SCNLT1	;SCAN FIRST LTR
	CAMN	C,[XWD F.STR,"%"]
	JRST	ELILET		;
	CAIE	C,"("
	TLNE	C,F.EQAL+F.COMA+F.DIG+F.DOLL ;ELIDED LETTER?
	JRST	ELILET		;YES.  POSSIBLE ASSUMED "LET"
	PUSHJ	P,SCNLT2	;SCAN SECOND LETTER.
 
	JRST	ILLINS		;SECOND CHAR WAS NOT A LETTER.
	MOVS	X1,A
	CAIE	X1,(SIXBIT /IF/)
	CAIN	X1,(SIXBIT /ON/)
	JRST	EACHL1
 
EACHL3: PUSHJ	P,SCNLT3	;ASSEMBLE THIRD LETTER OF STATEMENT IN A
	JRST	ILLINS		;THIRD CHAR WAS NOT A LETTER
	JRST	EACHL1
 
ELILET: MOVSI	A,(SIXBIT /LET/) ;ASSUME A "LET" STATEMENT.
	SKIPE	T,MULLIN	;MULLIN HAS PTR IF MULTI
	JRST	ELILT1
	MOVS	T,D		;GO BACK TO THE FIRST LETTER.
	HRLI	T,440700
ELILT1: PUSHJ	P,NXCHK
 
;HERE, FIRST 3 LTRS OF VERB (SIXBIT) ARE IN A.	USE TBL LOOKUP AND DISPATCH.
 
EACHL1: MOVEI	R,STAROL
	PUSHJ	P,SEARCH	;LOOK IN STATEMENT TYPE TABLE
	JRST	ILLINS		;NO SUCH, GO BITCH
	HRRZ	A,(B)		;FOUND.
EACHL6: MOVE	X1,A
	SETOM	JFCLAD		;NO JFCL YET
	SKIPN	MULLIN
	JRST	EACHLA
	SKIPN	DDCODE
	FAIL	<? Cannot mix statements>
	JRST	EACHL7
EACHLA:	CLEARM	DDCODE		;ASSUME NO CODE PRODUCER
	TRNN	X1,200000	;CODE PRODUCER?
	JRST	EACHL7
	SKIPN	DDTFLG
	FAIL	<? Program not STARTed>
	MOVE	B,DDTCOD
	MOVEM	B,DDCODE
EACHL7:	TRZE	X1,200000	;BASDDT INSTRUCTION?
	JRST	EACHL9		;NO
	SKIPE	MULLIN		;ANY CODE PRODUCERS?
	FAIL	<? Cannot mix statements>
	JRST	EACHL8		;CONTINUE
EACHL9:	MOVSI	D,(JFCL)	;SET JFCL FOR HANDLING MODIFIERS
	PUSHJ	P,BUILDI	;DO THE GENERATION
	MOVEM	B,JFCLAD	;STORE ADDRESS
EACHL8:	TRNN	X1,400000	;MORE TO COMMAND?
	SOJA	X1,EACHL5	;NO. JUST DISPATCH
	PUSHJ	P,QST		;CHECK REST OF COMMAND
	JRST	ILLINS
	TRZ	X1,400000	;CLEAR HIGH-ORDER BIT
 
EACHL5: JRST	400001(X1)
 
;HERE ON END OF STATEMENT XLATION
 
NXTSTA:
	TLNE	C,F.TERM	;END OF LINE ?
	JRST	NXSM2		;YES, GO CHECK TERMINATOR
	PUSHJ	P,QSELS 	;ELSE ?
	JRST	MODSEK		;NO, SEEK MODIFIER
	MOVEM	T,MULLIN	;YES, MARK MULTI
	JRST	NXSM1		;GO HANDLE
MODSEK: PUSHJ	P,KWSMOD	;NO, LOOK FOR MODIFIERS
	JRST	ERTERM		;NONE, GO BITCH
	SKIPGE	X1,JFCLAD	;WAS IT EXECUTABLE ?
	FAIL	<? Modifier with non-executable stmnt>
	AOS	X1
	MOVEM	X1,CENTRY	;BEG OF STMNT CODE
	SOS	X1
	ADD	X1,DDTCOD
	MOVSI	X2,(JRST)	;PUT JRST
	MOVEM	X2,(X1) 	;IN PLACE OF JFCL
	SETOM	JAROUN		;NO JUMP AROUND ADDRESS YET
MODLOO: PUSHJ	P,HALJRS	;JRST AROUND MODIFIER
	MOVE	X1,JAROUN	;GET OLD JUMP AROUND
	MOVEM	B,JAROUN	;SAVE NEW
	JUMPL	X1,MODNOJ	;NO OLD ONE
	ADD	X1,DDTCOD	;ADJUST
	ADD	B,DDTCOD 	;ADDRESSES
	PUSHJ	P,FIXADR	;FIX JUMP
MODNOJ: MOVE	X1,KWDIND	;GET MODIFIER
	SUBI	X1,KWAMOD	;INDEX
	CAIN	X1,7		;FIX UP FOR
	AOJ	X1,		;(ONLY ONE WORD LONG)
	LSH	X1,-1
	JRST	@MODIFY(X1)	;GO MODIFY
 
MODIFY: JRST	MODWHC		;WHILE
	JRST	MODUTC		;UNTIL
	JRST	MODIFC		;IF
	JRST	MODUSC		;UNLESS
	JRST	MODFOC		;FOR
 
MODWHC: SETZM	LOGNEG		;WHILE
	CAIA
MODUTC: SETOM	LOGNEG		;UNTIL=NOT WHILE
	SETOM	JAROUN		;NO JUMP AROUND
	SOS	DDCODE		;OVERWRITE IT
	JRST	MODCON		;EVALUATE CONDITION
 
 
MODIFC: SETZM	LOGNEG		;IF
	CAIA
MODUSC: SETOM	LOGNEG		;UNLESS=NOT IF
MODCON: PUSHJ	P,SAVCEN	;SET NEW CENTRY
	PUSHJ	P,IFCCOD	;GENERATE CONDITIONAL
	PUSHJ	P,OLDCEN	;JRST TO OLD CENTRY
	JRST	MODMOR		;LOOK FOR MORE
 
MODFOC: PUSHJ	P,SAVCEN	;SAVE NEW CENTRY
	PUSHJ	P,FORCOD	;GENERATE FOR CODE
	PUSHJ	P,OLDCEN	;GO TO OLD CENTRY
	MOVE	B,DDCODE 	;NEXT CODE
	MOVE	X1,JAROUN	;JUMP AROUND LOC
	ADD	X1,DDTCOD
	PUSHJ	P,FIXADR	;JUMP INTO NEXT
	SETOM	JAROUN		;NO MORE JUMP AROUND
	MOVE	X1,FTYPE	;TYPE OF FOR INDEX
	MOVEM	X1,TYPE		;SAVE FOR NEXT CODE
	PUSHJ	P,NEXCOD	;NEXT CODE
	JRST	MODMOR		;LOOK FOR MORE
 
SAVCEN: MOVE	X1,DDCODE
	SUB	X1,DDTCOD	;NEW CENTRY
	EXCH	X1,(P)		;SAVE IT
	JRST	(X1)
 
OLDCEN: PUSHJ	P,HALJRS	;JRST TO OLD CENTRY
	ADD	B,DDTCOD
	MOVE	X1,CENTRY
	ADD	X1,DDTCOD
	HRRM	X1,(B)		;SET ADDRESS
	POP	P,X1		;RETURN ADDRESS
	POP	P,CENTRY	;NEW CENTRY
	JRST	(X1)
 
MODMOR: PUSHJ	P,KWSMOD	;MORE MODIFIERS ?
	SKIPA	B,CENTRY	;NO, GET LAST CENTRY
	JRST	MODLOO		;YES, DO THEM
	ADD	B,DDTCOD
	MOVE	X1,JFCLAD	;JUMP TO MODIFIERS
	ADD	X1,DDTCOD
	PUSHJ	P,FIXADR	;SET ADDRESS
	SKIPGE	X1,JAROUN	;LAST JUMP AROUND
	JRST	NXSM3		;NONE THERE
	ADD	X1,DDTCOD
	MOVE	B,DDCODE 	;NEXT STMNT
	PUSHJ	P,FIXADR	;FOR JUMP AROUND
 
NXSM3:	TLNE	C,F.TERM	;SEEN TERMINATOR YET
	JRST	NXSM2		;
	PUSHJ	P,QSELS		;
	JRST	ERTERM		;NO, ABOUT TIME
	MOVEM	T,MULLIN
	JRST	NXSM1
 
NXSM2:	SETZB	L,MULLIN		;END, UNSET MULTI-LINE
	MOVEI	D,"\"		;WAS IT
	CAIE	D,(C)		;BACKSLASH ?
	SOJA	L,NXSM1		;NO, REALLY NEXT LINE
	MOVEM	T,MULLIN	;YES, SET MULTI-LINE
	PUSHJ	P,NXCH		;GET NEXT CHAR
	MOVEI	D,"\"
	CAIE	D,(C)
	JRST	NXSM1
	MOVEM	T,MULLIN		;SAVE POINTER
	PUSHJ	P,NXCH
	MOVE	B,DDCODE
	SKIPE	X1,THENAD	;ANY THENS ?
	PUSHJ	P,LNKTHN	;YES, FIX THEM UP
	SKIPE	X1,ELSEAD	;ANY ELSES ?
	PUSHJ	P,LNKTHN	;FIX THEM TOO
	SETZM	THNCNT		;AND SET BACK ALL THE POINTERS
	CLEARM	THENAD
	SETZM	ELSEAD
	SETZM	THNELS
 
NXSM1:	SKIPGE	AFLAG		;
	JRST	NXSM2A		;
	SKIPE	VRFSET
	JRST	NXTST1
NXSM2A:	MOVE	D,[SETZM VRFBOT]
	PUSHJ	P,BUILDI
 
 
;ENTER HERE FROM ERROR ROUTINE
 
NXTST1:	SKIPE	MULLIN		;FINISHED LINE ?
	JRST	EACHLN		;NO
	MOVE	B,DDCODE 	;FIX UP THENS JRST
	SKIPE	X1,THENAD
	PUSHJ	P,LNKTHN	;FIX ADDRESS
	SKIPE	X1,ELSEAD	;AND ELSES TOO, IF ANY
	PUSHJ	P,LNKTHN
NXTST2:	JUMPE	L,EACHLN
NXSM1A:	SKIPN	DDCODE
	JRST	EACHLN
	MOVE	D,[JRST	NXTEND]
	PUSHJ	P,BUILDI
	MOVE	B,FLFOR
	CAMGE	B,CEFOR
	FAIL	<? FOR without NEXT>
	PUSH	P,T
	PUSH	P,C
	MOVE	C,DDTCOD
	MOVE	T,FLCAD
	MOVE	T1,CECAD
	MOVE	A,FLDON
	MOVEI	B,1
	PUSHJ	P,LINKUP
	MOVE	T,FLDPT
	MOVE	T1,CEDTP
	MOVE	A,T
	MOVEI	B,1
	PUSHJ	P,LINKUP
	MOVE	T,FLDIT
LNKDD1:	CAML	T,CEDIT
	JRST	LNKDD2
	HRRZ	A,(T)
	ADD	A,FLDLT
	HRRM	A,(T)
	AOJA	T,LNKDD1
LNKDD2:	MOVE	T,FLSAD
	MOVE	T1,CESAD
	MOVE	A,FLDIT
	MOVEI	B,1
	PUSHJ	P,LINKUP
	POP	P,C
	POP	P,T
	JRST	@DDTCOD
NXTST4:	MOVE	N,TOPSTG	;ERROR OCCURRED FROM USER PROGRAM
	CAIE	N,CODROL	;IF NOT STMROL, IT DID
	JRST	NXTST3		;NO, MUST BE FOR BASDDT CODE
	MOVE	N,.DDSA		;HAVE TO SAVE AC'S
	BLT	N,@.DDTMP	;SAVE 'EM ALL
	SETOM	DDSTRT		;DO NOT ALLOW CONTINUE
	MOVEI	N,STMROL	;RESET TOPSTG FOR BASDDT
	MOVEM	N,TOPSTG	;SO WE DON'T DESTROY WHAT WE NEED
	SETOM	NOLINE		;DO NOT PRINT LINE # ON ERROR
NXTST3:	CLEARM	MULLIN
	CLEARM	ODF		;OUTPUT TO TTY
	CLEARM	IFIFG		;INPUT TO TTY
	CLEARM	DDTERR		;CLEAR ERROR FLAG
	PUSHJ	P,PCRLF
NXTEND:	PUSHJ	P,CLEAN
	JRST	EACHLN
CLEAN:	MOVEI	R,FORROL
	MOVE	X1,CEIL-1(R)
	HRLZI	X2,FLOOR(R)
	HRRI	X2,FLOOR+1(R)
	MOVEM	X1,FLOOR(R)
	BLT	X2,FLDTP
	HRLZI	X2,CEIL(R)
	HRRI	X2,CEIL+1(R)
	MOVEM	X1,CEIL(R)
	BLT	X2,CEDTP
	CLEARM	@FLOOR(R)
	SETOM	TMPPNT
	MOVE	X1,FLCAD
	MOVEM	X1,CECAD
	MOVE	X1,FLSAD
	MOVEM	X1,CESAD
	POPJ	P,
FIXADR:	HRRM	B,(X1)		;YES, FIX ADDRESS
	POPJ	P,		;RETURN
LNKTHN:	ADD	X1,DDTCOD	;FIX X1
	HRRZ	X2,(X1)		;PICK UP THE LINK
	HRRM	B,(X1)		;FIX ADDRESS
	JUMPE	X2,CPOPJ	;ANOTHER LINK
	MOVE	X1,X2		;YES, SET X1
	JRST	LNKTHN		;AND CONTINUE
SUBTTL	STATEMENT GENERATORS

;
;	DEFINE BASDDT
;
XBAS:	ASCIZ	/DDT/
	MOVE	D,[JRST NXTEND]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
;CHAIN STATEMENT.
;
;CHAIN HAS TWO FORMS:
;
;	CHAIN DEV:FILENM.EXT, LINE NO.
;   OR
;	CHAIN <STRING EXPRESSION>, LINE NO.
;
;IN EACH CASE, ",LINE NO." IS OPTIONAL.
;
;XCHAIN IS REACHED FROM XCHAN.
 
XCHAIN: PUSHJ	P,QSA
	ASCIZ	/IN/
	JRST	ILLINS
	PUSHJ	P,CHKCR1
	TLNN	C,F.DIG+F.LETT
	JRST	XCHAI1
	MOVEI	A,5
	PUSH	P,T
	PUSH	P,C
XCHA0:	PUSHJ	P,NXCH
	TLNE	C,F.DIG+F.LETT
	SOJG	A,XCHA0
	JUMPN	A,XCHA01
	PUSHJ	P,NXCH
XCHA01: SETZ	A,
	TLNN	C,F.COMA+F.TERM+F.PER
	CAIN	C,":"
	SETO	A,
	POP	P,C
	POP	P,T
	JUMPE	A,XCHAI1
XCHAI2: PUSHJ	P,FILNAM	;PROCESS FORM 1.
	JUMP	CATFLG
	MOVSI	D,(HRLZI N,)	;THE CODE BEING GENERATED
	HLR	D,CATFLG	;IS DESCRIBED IN MEMO
	PUSHJ	P,BUILDI	;#100-365-033-00.
	MOVSI	D,(HRRI N,)
	HRR	D,CATFLG
	PUSHJ	P,BUILDI
	MOVE	D,[MOVEM N,NEWOL1]
	PUSHJ	P,BUILDI
	MOVSI	D,(HRLZI N,)
	HLR	D,FILDIR
	PUSHJ	P,BUILDI
	MOVSI	D,(HRRI N,)
	HRR	D,FILDIR
 
	PUSHJ	P,BUILDI
	MOVE	D,[MOVEM N,FILDIR]
	PUSHJ	P,BUILDI
	MOVSI	D,(HRLZI N,)
	HLR	D,FILDIR+1
	PUSHJ	P,BUILDI
	MOVE	D,[MOVEM N, FILDIR+1]
	PUSHJ	P,BUILDI
	MOVE	D,[SETZM FILDIR+2]
	PUSHJ	P,BUILDI
	SKIPN	DEVBAS
	JRST	XCHA21
	MOVE	D,[MOVE N,[XWD 5,1]]
	PUSHJ	P,BUILDI
	MOVE	D,[MOVEM N,FILDIR+3]
	PUSHJ	P,BUILDI
	MOVE	D,[SETOM DEVBAS]
XCHA20: PUSHJ	P,BUILDI
	JRST	XCHAI5		;GO LOOK FOR LINE NO. ARG.
XCHA21:	SKIPN	FILDIR+3
	JRST	XCHA22
	MOVSI	D,(HRLZI N,)
	HLR	D,FILDIR+3
	PUSHJ	P,BUILDI
	MOVSI	D,(HRRI N,)
	HRR	D,FILDIR+3
	PUSHJ	P,BUILDI
	SKIPA	D,[MOVEM N,FILDIR+3]
XCHA22:	MOVE	D,[SETZM FILDIR+3]
	PUSHJ	P,BUILDI
	MOVE	D,[SETZM DEVBAS]
	JRST	XCHA20
XCHAI1:	PUSHJ	P,MASCHK
XCHAI7: MOVE	D,[PUSHJ P,CHAHAN]
	PUSHJ	P,BUILDI
XCHAI5: TLNE	C,F.TERM	;LINE NO. ARG?
	JRST	XCHAI6		;NO.
	TLNN	C,F.COMA
	JRST	ERTERM
	PUSHJ	P,NXCH
	PUSHJ	P,FORMLN	;YES.
	PUSHJ	P,CHKINT
	MOVE	D,[JUMPL N,CHAERR]
	PUSHJ	P,BUILDI
	MOVE	D,[CAILE N,303237]
	PUSHJ	P,BUILDI
	MOVE	D,[JRST CHAERR]
	PUSHJ	P,BUILDI
	SKIPA	D,[MOVEM N,RUNLIN]
XCHAI6: MOVE	D, [SETOM RUNLIN]
	PUSHJ	P,BUILDI
 
	MOVE	D, [SETOM CHAFLG]
	PUSHJ	P,BUILDI
	MOVE	D,[JRST CHAXIT]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
 
 
;CHANGE STATEMENT
 
; CHANGE <VECTOR> TO <STRING>
;		OR
;CHANGE <STRING> TO <VECTOR>
 
;COMPILES A FETCH AND PUT WHICH INTERFACE WITH THE "PUTSTR" ROUTINE
 
XCHAN:	PUSHJ	P,QSA		;CHANGE OR CHAIN?
	ASCIZ	/NGE/
	JRST	XCHAIN		;NOT CHANGE.
	TLNN	C,F.LETT
	JRST	XCHAN1
	PUSH	P,C
	PUSH	P,T
	PUSHJ	P,NXCH
	TLNE	C,F.DIG
	PUSHJ	P,NXCH
	CAMN	C,[XWD F.STR,"%"] ;PERCENT?
	PUSHJ	P,NXCH		;YES, EAT IT
	PUSHJ	P,QSA
	ASCIZ	/TO/
	JRST	XCHAN3
	POP	P,T
	POP	P,C
	HRLI	F,0
	PUSHJ	P,VECTOR
	JUMPN	A,GRONK
	MOVSI	D,(VECFRL)
	SKIPGE	TYPE		;REAL?
	MOVSI	D,(VECFIN)
	PUSHJ	P,BUILDA	;GENERATE VECTOR FETCH
	PUSHJ	P,QSF		;"TO" MUST FOLLOW
	ASCIZ /TO/
	HRLI	F,1
	TLNN	C,F.LETT
	JRST	ERLETT
	PUSHJ	P,ATOM
	CAIE	A,5
	CAIN	A,6
	JRST	XCLAB1
	JRST	ILFORM
XCLAB1:	MOVSI	D,(STOCHA)
XCHAN2: PUSHJ	P,BUILDA	;BUILD APPROPRIATE STORE UUO
	JRST	NXTSTA
 
XCHAN3: POP	P,T
	POP	P,C
XCHAN1: PUSHJ	P,FORMLS	;PROCESS STRING NAME
	PUSHJ	P,EIRGNP
	PUSHJ	P,QSF
	ASCIZ /TO/
	HRLI	F,0
	PUSHJ	P,VECTOR	;REGISTER VECTOR NAME
	JUMPN	A,GRONK
	MOVSI	D,(VECPRL)
	SKIPGE	TYPE
	MOVSI	D,(VECPIN)
	JRST	XCHAN2		;GO BUILD STORE UUO
;
;	 CLOSE STATEMENT
;
XCLOSE: ASCIZ	/SE/
	PUSHJ	P,GETCN2	;GET CHANNEL NO
XCLOS0: MOVE	D,[PUSHJ P,CLSFIL]
	PUSHJ	P,BUILDI
	MOVE	D,[SETZM ACTBL-1(LP)]
	PUSHJ	P,BUILDI
	HRRI	D,FILD-1
	PUSHJ	P,BUILDI
	TLNN	C,F.COMA	;MORE ?
	JRST	NXTSTA		;NO
	PUSHJ	P,GETCNA	;GET EM
	JRST	XCLOS0
;
;	CONTINUE FROM BREAKPOINT REQUEST
;
XCONT:	PUSHJ	P,QSA		;DID HE INCLUDE "T"
	ASCIZ	/T/
	JFCL			;WHO CARES
	SKIPN	DDTFLG		;SHOULD HE CONTINUE
	FAIL	<? Program not STARTed>
	TLNN	C,F.CR		;JUST CONTINUE
	JRST	XCONT1		;NO, NEED LINE NUMBER
	SKIPGE	DDSTRT		;CAN CONTINUE
	FAIL	<? Cannot CONTINUE without line number>
	JRST	XCONT2		;CONTINUE
XCONT1:	PUSHJ	P,GETLIN	;GET THE LINE REFERENCE
	HRRZM	A,DDSTRT	;FOR RETURN
XCONT2:	MOVEI	R,CODROL
	MOVEM	R,TOPSTG
	MOVE	X1,DERRGO	;RESTORE ERRGO
	MOVEM	X1,ERRGO	;FROM DERRGO
	CLEARM	NOLINE		;REMOVE BREAK POINT FLAG
	HRLZ	N,.DDSA		;MUST RESTORE AC'S
	BLT	N,17		;RESTORE THEM
	SETOM	PFLAG		;
	JRST	@DDSTRT		;CONTINUE
XCONT3:	HRRZ	N,(A)		;GET GOTO ADDRESS
	HRRZM	N,DDSTRT
	PUSHJ	P,CLEAN
	JRST	XCONT2		;RELEASE BREAK AND GO
XCONT6:	MOVE	P,@.DDTMP	;RESTORE ORIGINAL P
	MOVE	N,A		;RETURN ADDRESS -1
	AOJ	N,		;RETURN HERE
	PUSH	P,N		;SET UP RETURN
	JRST	XCNT4A		;RESUME
XCONT4:	MOVE	P,@.DDTMP	;RESTORE ORIGINAL P
	PUSH	P,@ONGADR	;PUSH RETURN ADDRESS
XCNT4A:	MOVE	N,(A)
	HRLI	N,(GOSUB)	;SET UP GOSUB
	MOVEM	N,40		;FAKE UUO
	MOVEI	R,CONROL
	MOVEM	R,TOPSTG
	HRLZ	N,.DDSA
	BLT	N,16
	PUSH	P,[XWD 0,XCONT5]
	SETOM	PFLAG		;
	CLEARM	NOLINE		;REMOVE BREAKPOINT FLAG
	JRST	GOSBER
XCONT5:	MOVE	N,.DDSA
	BLT	N,@.DDTMP
	MOVEI	X1,STMROL
	MOVEM	X1,TOPSTG
	SETZM	PFLAG		;
	SETOM	NOLINE		;BACK IN BREAK POINT CODING
	POPJ	P,
;
;	END STATEMENT
;
XEND:	TLNN	C,F.CR
	FAIL	<? END is not last>
	SKIPE	THNELS
	FAIL	<? END under conditional>
	MOVE	D,[JRST DDTXIT]		;COMPILE TERMINATE EXIT
	PUSHJ	P,BUILDI	;GENERATE IT
	JRST	NXTSTA		;GO FOR NEXT
;
DDTXIT:	CLEARM	RUNDDT		;NO MORE DDT
	CLEARM	DDTFLG		;NO MORE BREAKS
	CLEARM	NOLINE		;REMOVE BREAKPOINT FLAG
	JRST	EUXIT		;EXIT
;
;	DECLARE STATEMENT
;
XDEC:	PUSHJ	P,QSA		;DID HE INCLUDE FULL COMMAND
	ASCIZ	/LARE/
	JFCL			;WHO CARES
XDECA:	TLNN	C,F.LETT	;DID WE SEE A LETTER?
	FAIL	<? Illegal scalar name>
	PUSHJ	P,SCNLT1	;LTR TO A, LEFT JUSTIFY, 7 BIT
	PUSHJ	P,DIGIT		;CHECK FOR DIGIT
	PUSHJ	P,PERCNT	;CHECK FOR PERCENT
	TLNN	C,F.COMA	;SEPARATOR?
	TLNE	C,F.TERM	;OR TERMINATOR?
	JRST	XDEC1		;YES, GO BUILD
	FAIL	<? Illegal scalar name>
XDEC1:	MOVEI	R,VARROL	;SETUP TO SEARCH VARROL
	PUSHJ	P,SEARCH	;IS IT THERE?
	CAIA			;NOT THERE, TREMENDOUS
	FAIL	<? Already defined>
XDEC1A:	PUSH	P,B		;SAVE LOCATION FOR NEW VARIABLE
	PUSH	P,A		;SAVE NEW VARIABLE NAME
	MOVSI	A,777660	;BASDDT VARAIABLE NAME
XDEC2:	PUSHJ	P,SEARCH	;IS IT THERE?
	JRST	XDEC3		;NOT THERE
	POP	P,A		;GET NEW VARIABLE NAME
	HRR	A,(B)		;GET ITS LOCATION
	POP	P,X1		;GET LOCATION TO STORE  NEW VARIABLE
	CAMN	B,X1		;SAME
	JRST	XDEC3A		;YES
XDEC3B:	MOVE	X2,-1(B)	;MOVE ROLL DOWN
	MOVEM	X2,(B)		;ONE WORD MOVED
	SOJ	B,		;DECREMENT ADDRESS
	CAME	B,X1		;LAST ONE MOVED
	JRST	XDEC3B		;NO, DO NEXT
XDEC3A:	MOVEM	A,(B)		;STASH IT
	TLNE	C,F.TERM	;TERMINATOR
	JRST	NXTSTA		;GO FOR NEXT
	PUSHJ	P,NXCHK		;SWALLOW COMMA
	JRST	XDECA		;GO AGAIN
XDEC3:	CAML	A,[XWD 777760,0] ;ALL LOCATIONS TRIED?
	FAIL	<? No more temporary locations>
	ADD	A,[XWD 20,0]	;NEXT VARIABLE
	JRST	XDEC2		;CONTINUE
; ELSE STATEMENT
 
 
XELSE:	MOVEM	T,MULLIN	;SAVE POINTER
	PUSHJ	P,QSA
	ASCIZ	/E/
	JRST	ILLINS
	SOSGE	THNCNT		;IS ELSE LEGAL?
	FAIL	<? ELSE without THEN>
	SKIPE	ELSFLG		;SINGLE WORD THEN
	JRST	XELS0		;YES, SKIP ADDRESS FIX
	MOVE	X1,THENAD	;PICK UP THEN LINKAGE
	ADD	X1,DDTCOD
	MOVE	B,DDCODE 	;ADDRESS FOR THENS JRST
	AOJ	B,		;ALLOW FOR ELSES JRST OR CAIA
	HRRZ	X2,(X1)
	MOVEM	X1,THENAD	;SAVE IT
	HRRM	B,(X1)
	MOVEM	X2,THENAD
XELS0:	TLNE	C,F.DIG 	;DIGIT
	JRST	ELSGO		;YES, LET GO TO HANDLE IT
	SKIPE	ELSFLG		;SINGLE WORD THEN
	JRST	XELS1		;YES,
	PUSHJ	P,HALJRS	;NO, GEN HALT/JRST
	PUSHJ	P,FIXELS	;FIX THE ELSE
XELS1:	CLEARM	ELSFLG		;CLEAR FLAG
	JRST	NXSM1		;AND DO NEXT STMNT
 
ELSGO:	MOVSI	D,(CAIA)	;SKIP FROM THEN
	SKIPN	ELSFLG		;UNLESS IT WAS A JRST
	PUSHJ	P,BUILDI
	PUSHJ	P,XGOFR		;DO GOTO CODE
	SETZM	ELSFLG		;UNSET SINGLE WORD THEN
	TLNN	C,F.CR		;END OF LINE?
	CAMN	C,[XWD F.APOS,"'"]
	JRST	NXSM2		;YES, END IT ALL
	PUSHJ	P,QSELS		;LOOK FOR ELSE
	JRST	ERTERM
	JRST	NXTSTA		;NEXT STATEMENT
FIXTHN:	SKIPN	X1,THENAD
	JRST	FIXTH1
	ADD	B,DDTCOD
	HRRM	X1,(B)
	SUB	B,DDTCOD
FIXTH1:	MOVEM	B,THENAD
	POPJ	P,
FIXELS:	SKIPN	X1,ELSEAD
	JRST	FIXEL1
	ADD	B,DDTCOD
	HRRM	X1,(B)
	SUB	B,DDTCOD
FIXEL1:	MOVEM	B,ELSEAD
	POPJ	P,
;
;	FOR STATEMENT
;
;CALCULATE INITIAL, STEP, AND FINAL VALUES
;
;SET INDUCTION VARIABLE TO INITIAL VALUE
;AND JUMP TO END IF IND VAR .GT. FINAL
;INCREMENTING IS HANDLED AT CORRESPONDING NEXT.
 
;FIVE WORD ENTRY PLACED ON FORROL FOR USE
;BY CORRESPONDING NEXT STATEMENT:
 
;	CURRENT VALUE OF L (FOR "FOR WITHOUT NEXT" MESSAGE)
;<ADRS FOR NEXT TO JRST TO>,< ADRS OF JRST TO END OF NEXT>
;	<POINTER TO INDUCTION VARIABLE>
;	<POINTER TO INCREMENT>
;	<CURRENT VALUE OF TMPLOW>
 
 
XFOR:	SKIPE	THNELS		;UNDER THEN OR ELSE
	FAIL	<? Illegal FOR use>
	PUSHJ	P,FORCOD	;GO GENERATE CODE
	TLNN	C,F.TERM	;MODIFIERS ILLEGAL IN FOR
	FAIL	<? Illegal FOR use>
	JRST	NXTSTA		;DO NEXT STMNT
 
FORCOD: TLNN	C,F.LETT	;MAKE SURE VARIABLE IS FIRST.
	JRST	ERLETT
	HRLI	F,777777
	PUSHJ	P,REGLTR	;REGISTER ON SCAROL
	CAIE	A,1		;BETTER BE SCALAR
	JRST	ILVAR
	TLNN	C,F.EQAL	;BETTER HAVE EQUAL
	JRST	EREQAL
	MOVE	X1,TYPE		;GET TYPE FOR 'FOR'
	MOVEM	X1,FTYPE	;SAVE IT
	PUSHJ	P,NXCHK 	;SKIP EQUAL SIGN.
	PUSH	P,B		;SAVE THE VARIABLE POINTER
	PUSHJ	P,FORMLN	;GEN THE INITIAL VALUE
	PUSHJ	P,EIRGNP
	PUSHJ	P,CMIXER	;
	MOVSI	D,(MOVEM N,)	;GEN STORE INITIAL IN VARIABLE
	MOVE	B,(P)
	PUSHJ	P,BUILDA
	SETZ	B,		;GET A ZERO WORD
	PUSH	P,B		;PUT IT ON STACK FOR INCREMENT
	PUSH	P,B		;PUT IT ON STACK FOR UPPER BOUND
 
FORELS: PUSHJ	P,KWSFOR	;LOOK FOR FOR KEYWORDS
	JRST	FORSET		;NO MORE
	MOVE	X1,KWDIND	;INDEX TO KEYWORD
	SUBI	X1,KWAFOR-1
	LSH	X1,-1
	JRST	@FRKEYS(X1)	;GO HANDLE KEYWORD ELEMENT
 
FRKEYS: JRST	FORTOC		;TO
	JRST	FORBYC		;BY OR STEP
	JRST	FORWHC		;WHILE
	JRST	FORUNC		;UNTIL
 
 
FORTOC: SKIPE	(P)		;SEEN TO ALREADY ?
	FAIL	<? Illegal FOR use>
	PUSHJ	P,FORMLN	;GEN THE UPPER BOUND.
	JUMPL	B,XFOR4 	;EXCEPT FOR THE SPECIAL
	MOVE	X1,FTYPE	;
	CAMN	X1,TYPE		;
	JRST	XFOR2		;
	PUSHJ	P,EIRGEN	;PUT IT IN A REGISTER
	PUSHJ	P,CHKTYP	;FIX OF FLOAT IT
	JRST	XFOR4+1		;
XFOR2:	HLRZ	X1,B		;CASE OF A POSITIVE
	ANDI	X1,ROLMSK	;CONSTANT, FORCE THE
	CAIE	X1,CADROL	;UPPERBOUND TO BE
	CAIN	X1,CONROL	;
	JRST	XFLAB1		;STORED IN A
XFOR4:	PUSHJ	P,EIRGEN	;PERMANENT
	PUSHJ	P,SIPGEN	;TEMPORARY.
XFLAB1:	MOVEM	B,(P)		;REMEMBER WHERE IT IS
	JRST	FORELS		;GO FOR NEXT KEYWORD
 
FRBY1:	MOVEM	C,FORCAR	;SAVE CHAR
	MOVEM	T,FORPNT	;AND POINTER
	MOVE	T,[POINT 7,[BYTE (7)"1",15]]
				;IMPLICIT "STEP1"
	PUSHJ	P,NXCH		;PULL IN 1
	CAIA
FORBYC: SETZM	FORCAR		;FLAG EXPLICIT STEP
	SKIPE	-1(P)		;ALREADY SEEN INCRE ?
	FAIL	<? Illegal FOR use>
	PUSHJ	P,FORMLN	;XLATE AND GEN INCREMENT
	SETZM	CATFLG		;CATFLG=0 SAYS STEP IS NOT A CONSTANT.
	HLRZ	X1,B
	ANDI	X1,ROLMSK
	CAIE	X1,CADROL
	CAIN	X1,CONROL
	JRST	XFLAB2
	JRST	XFOR6
XFLAB2:	MOVE	X1,FTYPE	;
	CAMN	X1,TYPE		;
	JRST	XFOR5		;
	PUSHJ	P,EIRGEN	;
	PUSHJ	P,CHKTYP	;
	JRST	XFOR7		;
XFOR5:	SETOM	CATFLG		;EXCEPT FOR THE SPECIAL
	JRST	XFOR7		;CASE OF A CONSTANT,
XFOR6:	PUSHJ	P,EIRGEN	;SAVE THE STEP VALUE
	MOVE	X1,FTYPE	;
	CAME	X1,TYPE		;
	PUSHJ	P,CHKTYP	;
XFOR7:	PUSHJ	P,SIPGEN	;IN A PERMANENT TEMP.
	MOVEM	B,-1(P) 	;REMEMBER WHERE IT IS
	SKIPN	FORCAR		;EXPLICIT STEP ?
	JRST	FORELS		;YES, NEXT KEYWORD
	MOVE	C,FORCAR	;NO, RESTORE CHAR
	MOVE	T,FORPNT	;AND POINTER
	JRST	FORTER		;GENERATE TERMINATE CODE
 
FORSET: SKIPN	(P)		;SEEN UPPER BOUND
	FAIL	<? Illegal FOR use>
	MOVMM	P,LOGNEG	;MAKE LOGNEG + TO FLAG NO COND
	JRST	XFOR1		;GO CHECK STEP
 
FORUNC: SETOM	LOGNEG		;FLAG LOGICAL NEGATION
	CAIA
FORWHC: SETZM	LOGNEG		;STRAIGHT LOGIC
XFOR1:	SKIPN	-1(P)		;SEEN INCREMENT
	JRST	FRBY1		;NO, GENERATE 1
FORTER: SKIPN	(P)		;SEEN UPPER BOUND ?
	JRST	FORCTR		;NO, JUST LOGIC
	MOVE	B,-2(P) 	;GET INDUCTION VAR IN REG
	PUSHJ	P,EIRGEN
	SKIPE	CATFLG
 
	JRST	XFOR3
	MOVE	B,-1(P) 	;GET THE INCREMENT POINTER
	MOVSI	D,(DONFOR)	;BUILD DONFOR EXCEPT FOR A
	PUSHJ	P,BUILDA	;CONSTANT STEP.
 
XFOR3:	MOVE	X1,-1(P)
	MOVE	B,(P)		;BUILD COMPARE INSTR (IT
	MOVSI	D,(CAMLE N,)	;DOESN'T MATTER WHAT IT
	SKIPGE	X1		;IS IF DONFOR IS THERE).
	MOVSI	D,(CAMGE)
	PUSHJ	P,BUILDA
	HRLM	B,FORPNT	;STORE CAM ADR FOR NEXT
	JRST	FORCTZ		;CHECK IF LOGIC NEEDED TOO
 
FORCTR: MOVE	X1,DDCODE	;NEXT LOC
	SUB	X1,DDTCOD
	HRLM	X1,FORPNT	;FOR NEXT TO JRST TO
	SETCMM	LOGNEG		;REVERSE LOGIC
	JRST	FORLOG		;GO DO LOGIC
 
FORCTZ: SKIPLE	LOGNEG		;ANY LOGIC ?
	JRST	FORZZZ		;NO, REALLY GO FINISH UP
	MOVNI	A,4
FORCOP: MOVE	D,FORRUN+4(A)
	PUSHJ	P,BUILDI	;COPY LOGIC STORE CODE
	AOJL	A,FORCOP
FORLOG: MOVE	B,-2(P) 	;GET INDUCTION VAR
	MOVSI	D,(MOVEM N,)	;GENERATE STORE
	PUSHJ	P,BUILDA
	PUSHJ	P,IFCCOD	;GO GENERATE LOGIC CODE
	MOVE	D,[SKIPN FTRUTH] ;LOGIC TRUE, WAS CAM ?
	SKIPE	(P)		;NO UPPER BOUND ?
	PUSHJ	P,BUILDI
 
FORZZZ: POP	P,B		;POP OFF UPPER BOUND
	PUSHJ	P,HALJRS	;BUILD HALT OR JRST TO NEXT+1
	HRRM	B,FORPNT	;TELL NEXT WHERE IT IS
	MOVE	B,-1(P) 	;INDUCTION VAR
	MOVSI	D,(MOVEM N,)	;STORE CODE
	SKIPLE	LOGNEG		;IF NO LOGIC
	PUSHJ	P,BUILDA
	MOVE	A,L		;SAVE L FOR POSSIBLE ERROR MSG
	MOVEI	R,FORROL
	PUSHJ	P,RPUSH
	MOVE	A,FORPNT	;GET JRST POINTERS
	PUSHJ	P,RPUSH 	;ON FOR STACK
	POP	P,FORPNT
	POP	P,A		;AND INDUCTION VAR
	PUSHJ	P,RPUSH
	MOVE	A,FORPNT	;AND INCREMENT
	PUSHJ	P,RPUSH
	MOVE	A,TMPLOW	;SAVE PROT LEVEL  TO BE RESTORED BY NEXT
	PUSHJ	P,RPUSH
	MOVE	A,TMPPNT	;PROTECT TEMPS USED BY THIS "FOR"
	MOVEM	A,TMPLOW	;IN THE RANGE OF THE FOR.
	POPJ	P,
 
 
 
FORRUN: TDZA	X1,X1		;RUN-TIME LOGIC STORE
	SETO	X1,
	MOVEM	X1,FTRUTH
	SKIPE	FTRUTH		;SKIP STORE IF LOOP OVER
 
 
HALJRS:	MOVSI	D,(JRST)	;ELSE JRST
	PUSHJ	P,BUILDI
	POPJ	P,
;GOSUB STATEMENT XLATE
 
XGOSUB: ASCIZ	/UB/
	SETZM	ONGFLG
XGOS:	MOVE	D,[JSP A,XCONT6] ;
	SKIPE	ONGFLG		;
	HRRI	D,XCONT4	;
	PUSHJ	P,BUILDI	;
	PUSHJ	P,GETLIN	;GET THE LINE REFERENCE
	MOVE	D,FLGSB		;MAKE SEARCH OF GSBROL
XGOS1A:	CAML	D,CEGSB		;LOOKED AT ALL
	FAIL	<? Undefined GOSUB>
	CAME	A,(D)		;IS THIS IT
	AOJA	D,XGOS1A	;NO, CHECK NEXT
	HRLI	D,(JFCL)	;BUILD FAKE GOSUB UUO
	PUSHJ	P,BUILDI	;GENERATE IT
	SKIPN	ONGFLG
	JRST	NXTSTA
	TLNN	C,F.COMA
	JRST	XON2
	PUSHJ	P,NXCHK
	JRST	XGOS
 
 
 
;GOTO STATEMENT
 
XGOTO:	ASCIZ	/O/
	PUSHJ	P,QSA
	ASCIZ	/BASDDT/
	JRST	XGOFIN
	JRST	XBAS+1
XGOFIN: PUSH	P,[Z NXTSTA]	;BUILD GOTO AND END STA
XGOFR:	PUSHJ	P,GETNUM	;BUILD GOTO AND RETURN
	FAIL	<? Illegal line reference>
XGOGT:	HRLZ	A,N		;LOOK FOR DESTINATION
	MOVEI	R,LINROL
	PUSHJ	P,SEARCH
	FAIL	<? Undefined line number >,1
	SUB	B,FLLIN		;NOW CHECK FOR JUMP INTO/OUTOF FUNCTION
	PUSH	P,B
	ADD	B,FLREF
	PUSH	P,(B)		;SAVE REF TO GO TO LINE
	MOVE	A,SORCLN
	HRLZ	A,(A)
	PUSHJ	P,SEARCH
	JFCL			;IMPOSSIBLE ERROR
	SUB	B,FLLIN
	ADD	B,FLREF		;GET THAT TO CURRENT LINE
	POP	P,X1
	CAME	X1,(B)		;SAME ?
	FAIL	<? Illegal line reference >,1
	MOVE	D,[JSP A,XCONT3] ;TO RELEASE BREAKPOINT
	PUSHJ	P,BUILDI	;GENERATE
	POP	P,B		;RESTORE B
	HRLI	B,LADROL
	MOVSI	D,(JFCL)	;NO-OP
	PUSHJ	P,BUILDA
	POPJ	P,
;
;	IF STATEMENT
;
;<IF STA>::=IF <NUM FORMULA> <RELATION> <NUM FORMULA> THEN <LINE NUMBER>
;	OR
;	::= IF <STRING FORMULA><RELATION><STRING FORMULA> THEN <LINE NUMBER>
;	OR
;	::=IF END <CHANNEL SPEC> THEN <LINE NUMBER>
 
 
;RELATION IS LOOKED UP IN TABLE (RELROL)
;WHICH RETURNS INSTRUCTION TO BE EXECUTED
;IF ONE OF THE EXPRESSIONS BEING COMPARED IS
;IN THE REG, THAT ONE WILL BE COMPARED AGAINST
;THE OTHER IN MEMORY.  IF NECESSARY, THE
;INSTRUCTION IS CHANGED TO ITS CONTRAPOSITIVE
;BY FUDGING BITS IN THE OP CODE
 
;IF STATEMENT
 
XIF:	PUSHJ	P,QSA
	ASCIZ/END/
	JRST	IFSX7		;HERE FOR NORMAL IF STATEMENTS.
	CAIE	C,":"		;HERE FOR IF END STATEMENT.
	JRST	XIF1		;SEQ. ACCESS IF END.
	PUSHJ	P,GETCNA	;R.A. IF END.
	MOVNI	A,4
XIF2:	MOVE	D,IFNCOD+4(A)
	PUSHJ	P,BUILDI
	AOJL	A,XIF2
	JRST	IFSX5
 
IFNCOD: SKIPL	ACTBL-1(LP)	;CODE GENERATED.
	JRST	FNMXER
	MOVE	N,LASREC-1(LP)
	CAMGE	N,POINT-1(LP)
 
XIF1:	CAME	C,[XWD F.STR,"#"]
	JRST	ERCHAN
	PUSHJ	P,GETCNA
	MOVE	D,[PUSHJ P,EOF]
	PUSHJ	P,BUILDI
	HRLOI	D,(TROA)
	PUSHJ	P,BUILDI
	HRLZI	D,(SETZ)
	PUSHJ	P,BUILDI
	HRLZI	D,(SKIPE)
	PUSHJ	P,BUILDI
	JRST	IFSX5
IFSX7:	SETZM	LOGNEG		;DO NOT NEGATE LOGIC
	PUSHJ	P,IFCCOD	;GENERATE IF CODE
IFSX5:	TLNE	C,F.COMA	;SKIP OPTIONAL COMMA.
	PUSHJ	P,NXCH
	PUSHJ	P,THENGO	;LOOK FOR "THEN" OR "GOTO"
	AOS	THNCNT		;UP THEN COUNT
	SETOM	THNELS		;MARK REST OF LINE UNDER CONDITIONAL
	TLNN	C,F.DIG 	;NEXT CHAR A DIGIT ?
	JRST	IFCGO		;NO
	PUSHJ	P,XGOFR 	;USE GOTO CODE TO GEN JRST INSTR
	SETOM	ELSFLG		;SINGLE WORD THEN FLAG
	TLNN	C,F.CR		;END OF LINE?
	CAMN	C,[XWD F.APOS,"'"]
	JRST	NXSM1		;YES, DON'T LOOK FOR ELSE
	PUSHJ	P,QSELS 	;ELSE THERE TOO ?
	JRST	ERTERM
	MOVEM	T,MULLIN	;YES, MARK MULTI
	JRST	NXSM1		;AND LET STATEMENT HANDLER DO IT
IFCGO:	PUSHJ	P,REVSEN	;REVERSE LOGIC
	PUSHJ	P,HALJRS	;JRST/HALT AROUND THEN CODE
	PUSHJ	P,FIXTHN	;FIX THEN ADDRESS
	JRST	NXSM1
 
 
IFCCOD:	PUSHJ	P,FORMLB	;
	MOVE	X2,DDCODE	;LAST CODE GENERATED
	HLRZ	X1,-1(X2)	;CHECK FOR POSSIBLE OPTIMIZATION
	CAIE	X1,(SETO)	;WAS TDZA AND SETO GENERATED?
	JRST	IFCOD1		;NO, MUST TEST TRUTH VALUE
	MOVE	B,X2		;NEW ADDRESS
	SUBI	B,2		;YES, REMOVE THE TWO INSTRUCTIONS
	MOVEM	B,DDCODE	;BY SETTING NEW CEIL
	SOJ	B,		;LAST CODE GENERATED ADDRESS
	SUB	B,DDTCOD	;CHANGE TO OFFSET
	SKIPL	LOGNEG		;DOUBLE REVERSE = NOTHING
	PUSHJ	P,REVSEN	;
	POPJ	P,		;RETURN
IFCOD1:	MOVSI	D,(SKIPE)	;SKIP IF TRUE
	PUSHJ	P,BUILDA	;GENERATE THE SKIPN
	SKIPL	LOGNEG		;NEED REVERSE LOGIC
	POPJ	P,		;AND RETURN
REVSEN: ADD	B,DDTCOD 	;ADDRESS OF LAST RELATION
	MOVE	D,(B)		;CAM??/SKIP? INSTRUCTION
	TLC	D,4000		;REVERSE SENSE
	MOVEM	D,(B)		;PUT BACK
	SUB	B,DDTCOD	;RESTORE B
	POPJ	P,
 
;
;	INPUT AND READ STATEMENT GENERATOR
;
;	     IN THE FOLLOWING CODE, WRREFL IS FIRST USED AS A FLAG
;	FOR READ (-1) AND INPUT (0).  AT XINP1, WRREFL IS THEN USED
;	TO FLAG SEQUENTIAL ACCESS (0) AND RANDOM ACCESS (-1).
;
XREAD:	ASCIZ	/D/		;REMAINDER OF READ STATEMENT
	SETOM	WRREFL		;FLAG READ, NOT INPUT
	JRST	XINPT0		;PRODUCE SET UP CODE
;
XINPUT:	ASCIZ	/UT/		;REMAINDER OF INPUT STATEMENT
	CLEARM	WRREFL		;FLAG INPUT, NOT READ
	PUSHJ	P,QSA		;CHECK FOR INPUT LINE
	ASCIZ	/LINE/
	JRST	XINPT0		;NO
	SETOM	INLNFG		;YES, FLAG IT
XINPT0:	SETZM	INPPRI		;NOT INPUT FROM TTY
	CAIN	C,":"		;RANDOM ACCESS?
	JRST	XINRAN		;YES, HANDLE IT SEPARATELY
	CAME	C,[XWD F.STR,"#"] ;SEQUENTIAL ACCESS?
	JRST	XINP5		;NO, MUST BE JUST READ OR INPUT
	PUSHJ	P,GETCNB	;GENERATE CODE FOR CHANNEL AND SCAN DELIMITER
	MOVE	D,[PUSHJ P,INSET] ;FETCH INSTRUCTION FOR SETTING INPUT
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	MOVEI	D,REAINP-1	;GENERATE CODE TO CHECK FOR
	PUSHJ	P,GENTYP	;MIXING READ# WITH INPUT#
	MOVE	D,[JRST REINER] ;FAILURE RETURN
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	MOVE	D,[PUSHJ P,DOINPT] ;FETCH DO INPUT INSTRUCTION
	JRST	XINP0		;GO HANDLE ARGUUMENT LIST
;
;	CODING FOR READ, AND INPUT
;
XINP5:	MOVSI	D,(CLEAR LP,)	;NON DISK INPUT/READ, CHANNEL IS ZERO
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	SKIPN	INLNFG		;INPUT LINE?
	SKIPE	WRREFL		;INPUT?
	JRST	XINP5A		;NO, CARRY ON
	SETOM	INPPRI		;STRING OUTPUT IS NOW LEGAL
	TLNN	C,F.QUOT	;IS THERE ONE COMING UP
	JRST	XINP5A		;NO
XINP5L:	PUSHJ	P,XINOUT	;YES, DO IT
	SKIPA	D,[PUSHJ P,INSEQ] ;SUPPRESS QUERY
XINP5A:	MOVE	D,[PUSHJ P,INSET] ;FETCH INSTRUCTION FOR INPUT SETTING
	PUSHJ	P,BUILDI	;BUILDI IMMEDIATE
	MOVE	D,[PUSHJ P,DOINPT] ;ASSUME THIS IS INPUT
	SKIPN	WRREFL		;WERE WE RIGHT?
	JRST	XINP0		;YES, SKIP DATA CHECK FOR READ
	SKIPL	DATAFF		;CHECK IF WE HAVE SEEN DATA
	HLLOS	DATAFF		;WE HAVE NOT, FLAG THAT DATA IS NEEDED
	HRRI	D,DOREAD	;CHANGE DOINPT TO DOREAD
XINP0:	PUSHJ	P,BUILDI	;BUILD IMMEDIATE, TO DO READ OR INPUT
	CLEARM	WRREFL		;CHANGE FLAG FOR SEQUENTIAL ACCESS
;
;	GENERATE CODE FOR THE ARGUMENT LISTS
;
XINP1:	CLEAR	F,		;STRINGS AND NUMERICS MAY BE INPUT
	PUSHJ	P,REGCLT	;GET VARIABLE IN ARGUMENT LIST
	SKIPN	INLNFG		;INPUT LINE?
	JRST	XINP91		;NO, CONTINUE
	TLNE	F,-2		;MUST BE A STRING
	FAIL	<? String line input only>
XINP91:	SKIPN	IFFLAG		;HAS TYPE OF INPUT BEEN DECLARED
	MOVEM	F,IFFLAG	;NO, MAKE TYPE = FIRST VARIABLE'S TYPE
	SKIPN	WRREFL		;SEQUENTIAL ACCESS?
	JRST	XINP9		;YES, STRINGS AND NUMERICS ARE LEGAL
	XOR	F,IFFLAG	;CHECK TYPE OF THIS VARIABLE
	JUMPGE	F,XINP9		;AGAINST TYPE OF FIRST
	FAIL	<? Mixed strings and numbers>
XINP9:	JUMPE	A,XINP2		;VARIABLE IS A NUMERIC ARRAY
	CAIG	A,4		;POSSIBLY A STRING?
	JRST	XINP1A		;NO, BETTER BE SCALAR, CHECK IT OUT
	CAILE	A,6		;IS IT IN FACT A STRING?
	JRST	ILFORM		;NO, BAD FORMAT
;
;	CODE FOR STRING VARIABLES
;
XINP6:	PUSHJ	P,FLET2		;FINISH REGISTERING THE STRING
	MOVEI	X1,3		;FLAG TO USE STRING UUOS
XINP6A:	HRLZ	D,INUUO(X1)	;ASSUME RANDOM ACCESS, GET INPUT UUO FOR IT
	SKIPN	WRREFL		;IS IT?
	HLLZ	D,INUUO(X1)	;NO, GET FOR SEQUENTIAL ACCESS
	SKIPGE	TYPE		;INTEGER?
	TLO	D,400		;YES, MARK IT
	SKIPN	INLNFG		;INPUT LINE?
	JRST	XINP6B		;NO, CONTINUE
	TLNN	C,F.TERM	;CAN ONLY BE ONE
	FAIL	<? Line input takes only one string>
	PUSH	P,B		;SAVE ADDRESS
	PUSH	P,D		;SAVE OP CODE
	MOVE	D,[SETOM INLNFG] ;FLAG FOR INPUT LINE
	PUSHJ	P,BUILDI	;GEN IT
	POP	P,D		;RESTORE OPCODE
	POP	P,B		;RESTORE ADDRESS
XINP6B:	PUSHJ	P,BUILDA	;BUILD UUO WITH ADDRESS IN B
	JRST	XINP3		;CHECK FOR MORE ARGUMENTS IN LIST
;
;	HERE FOR SCALAR, MAKE SURE IT IS
;
XINP1A:	CAIE	A,1		;IS IT A SCALAR?
	JRST	ILVAR		;NO, ILLEGAL VARIABLE
	CLEAR	X1,		;FLAG TO USE SCALAR UUOS
	JRST	XINP6A		;BUILDI THE INPUT/READ UUO
;
;	HERE FOR ARRAY/VECTOR
;
XINP2:	PUSH	P,B		;SAVE ADDRESS OF ARRAY/VECTOR
	PUSHJ	P,XARG		;GO GET THE SUBSCRIPTS
	HRLZ	D,INUUO+1	;ASSUME RANDOM ACCESS FOR 1-DIM
	SKIPN	WRREFL		;IS IT RANDOM ACCESS?
	HLLZ	D,INUUO+1	;NO, CHANGE TO SEQUENTIAL ACCESS
	JUMPE	B,XINP2A	;IS IT 1-DIM OR 2-DIM?
	HRRZ	X1,(P)		;2-DIM, GET POINTER TO ARAROL
	ADD	X1,FLARA	;ADD IN FLOOR FOR ADDRESS
	SKIPN	1(X1)		;HAS DIM FOR THIS VARIABLE BEEN DECLARED?
	SETOM	1(X1)		;NO, MARK AS 2-DIM
	HRLZ	D,INUUO+2	;GET RANDOM ACCESS UUO FOR 2-DIM
	SKIPN	WRREFL		;GUESS RIGHT?
	HLLZ	D,INUUO+2	;NO, CHANGE TO SEQUENTIAL ACCESS
XINP2A:	EXCH	B,(P)		;EXCH # OF SUBSCRIPTS WITH VARIABLE ADDRESS
	SKIPGE	TYPE		;INTEGER?
	TLO	D,400		;YES, MARK IT
	PUSHJ	P,BUILDA	;BUILD INPUT UUO WITH ADDRESS IN B
	POP	P,B		;RESTORE # OF SUBSCRIPTS
	PUSHJ	P,GENARG	;GENERATE THE JUMPS FOR THE SUBSCRIPTS
;
;	END OF ONE VARIABLE
;
XINP3:	PUSHJ	P,CHKDEL	;CHECK FOR DELIMITER, RETURN IF FOUND
	SKIPE	INPPRI		;SHOULD WE CHECK FOR STRING?
	TLNN	C,F.QUOT	;YES, IS THERE ONE?
	JRST	XINP1		;NO, PROCESS NEXT VARIABLE IN LIST
	JRST	XINP5L		;YES, PROCESS AND RE-SETUP TTY
XINOUT:	MOVE	D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT
	PUSHJ	P,BUILDI	;BUILDI IMMEDIATE
	PUSHJ	P,FORMLS	;GET THE STRING
	MOVSI	D,(PRSTR)	;SETUP STRING OUTPUT UUO
	PUSHJ	P,CHKFMT	;HANDLE THE DELIMITER
	PUSHJ	P,BUILDA	;OUTPUT STRING WITH ADDRESS IN B
	CAIN	C,"_"		;WANT TO SUPPRESS QUERY
	JRST	NXCH		;YES, GOBBLE _ AND DO IT
	AOS	(P)		;NO, SKIP
	POPJ	P,		;RETURN
;
;	HERE FOR RANDOM ACCESS INPUT/READ
;
XINRAN:	SKIPE	INLNFG		;INPUT LINE?
	FAIL	<? Line input illegal in r.a.>
	PUSHJ	P,GENTP1	;PROCESS CHANNEL, DELIMITER AND PRODUCE
				;CODE TO CHECK IF FILE IS R. A.
	CLEARM	IFFLAG		;CLEAR TYPE FLAG
	SETOM	WRREFL		;FLAG RANDOM ACCESS, NOT SEQUENTIAL
	JRST	XINP1		;PROCESS ARGUMENT LIST
;
;	INPUT/READ UUOS
;
INUUO:	DATA	(DATA 1,)	;FOR SCALARS
	ADATA1	(DATA 2,)	;FOR 1-DIM
	ADATA2	(DATA 3,)	;FOR 2-DIM
	STRIN	(DATA 4,)	;FOR STRINGS
 
 
;
;	LET STATEMENT
;
XLET:	SETOM	LETSW		;LOOK FOR A LHS.
	PUSHJ	P,FORMLB
	MOVEM	F,IFFLAG	;STORE TYPE (STR OR NUM) IN IFFLAG.
	SKIPL	LETSW		;IF NOT LHS, GIVE REASONABLE ERROR
	JRST	GRONK
	TLNN	C,F.EQAL+F.COMA	;MUST BE A RHS OR ANOTHER LHS.
	JRST	EREQAL
 
XLET0:	SKIPL	LETSW		;FAIL IF THIS FORMULA IS NOT A VARIABLE.
	JRST	GRONK
	SKIPGE	IFFLAG		;STR?
	JRST	XLLAB1		;NO.
	PUSHJ	P,PUSHPR	;YES. REMEMBER ADDR OF RESULT POINTER.
	JRST	XLET1
XLLAB1:	CAIE	A,1		;FOR NUM LETS, IF THE LHS IS A LIST OR
	JRST	XLET1		;TABLE, FORMLA HAS STORED AC B AND A
	PUSH	P,[EXP 1]	;FLAG ON PLIST. IF THE LHS IS A SCALAR,
	SKIPGE	TYPE		;IT IS AN INTEGER?
	TLO	B,100000	;YES, MARK IT AS SUCH
	PUSH	P,B		;PUT THE FLAG AND AC B ON PLIST HERE.
XLET1:	PUSHJ	P,NXCHK 	;SKIP EQUAL SIGN.
	SOS	LETSW		;COUNT THIS LHS, AND
	PUSHJ	P,FORMLB	;LOOK FOR ANOTHER.
	XOR	F,IFFLAG
	JUMPGE	F,XLET1A
	FAIL	<? Mixed strings and numbers>
XLET1A: TLNE	C,F.EQAL+F.COMA	;IF NO =, TEMP. ASSUME THIS IS A RHS.
	JRST	XLET0
 
	MOVMS	LETSW		;FINISHED SCANNING.
	SOS	LETSW
	SKIPL	IFFLAG		;STRING LET STA?
	JRST	XLET4		;YES.
 
	PUSHJ	P,EIRGEN	;NO, GET RESULT IN REG
	MOVEM	B,TEMP1 	;SAVE THE NEGATIVE RESULT CHECK
XLET1B: MOVE	D,[MOVEM N, (MOVNM N,)]
	SKIPG	-1(P)		;FLAGS ON PLIST ARE --
	MOVE	D,[ARSTO1 N, (ARSTN1 N,)] ; 0 FOR LIST
	SKIPL	-1(P)			  ; 1 FOR SCALAR
	JRST	XLET2			  ; -1 FOR TABLE.
	MOVE	D,[ARSTO2 N, (ARSTN2 N,)]
	MOVE	X1,0(P) 	;DEFAULT ARRAY SIZE (10,10)
	ADD	X1,FLARA
	SKIPN	1(X1)
	SETOM	1(X1)
XLET2:	SKIPGE	TEMP1		;CHECK FOR NEGATIVE RESULT
	MOVS	D,D		;NEGATIVE. GET CORRECT INSTR.
	PUSH	P,D		;SAVE OPCODE
	SKIPL	TYPE		;IS IT AN INTEGER?
	JRST	XLET3		;NO,
	MOVE	B,-1(P)		;GET TYPE OF OPERAND
	TLZE	B,100000	;ALSO AN INTEGER?
	JRST	XLET5		;YES, NOTHING TO DO
	CLEARM	TYPE		;TYPE IS NOW REAL
	MOVE	D,[PUSHJ P,FLTPNT] ;MUST FLOAT IT
	PUSHJ	P,BUILDI	;GENERATE IT
	JRST	XLET5		;ALL DONE
XLET3:	MOVE	B,-1(P)		;
	TLZN	B,100000	;
	JRST	XLET5		;
	SETOM	TYPE		;TYPE IS NOW INTEGER
	MOVE	D,[PUSHJ P,FIXPNT]
	PUSHJ	P,BUILDI	;
XLET5:	POP	P,D		;RESTORE MOVEM OPCODE
	POP	P,B		;RESTORE RESULT PNTR
	TLZ	B,100000	;CLEAR TYPE FLAG
	PUSHJ	P,BUILDA	;BUILD STORE INSTR
	POP	P,B		;CHECK TRASH FROM PUSHLIST.
	JUMPG	B,XLET2B	;ARRAY REF?
	PUSHJ	P,GENARG	;YES. GEN ARGS FIRST.
XLET2B: SOSLE	LETSW
	JRST	XLET1B		;THERE IS ANOTHER LHS.
	JRST	NXTSTA
 
 
XLET4:	PUSHJ	P,EIRGNP
	PUSHJ	P,POPPR 	;GET ADDRESS OF LEFT HALF POINTER BACK
	PUSH	P,B
	MOVSI	D,(STRSTO)	;BUILD THE STRING MOVE INSTRUCTION.
	PUSHJ	P,BUILDA
	POP	P,B
	SOSLE	LETSW
	JRST	XLET4		;THERE IS ANOTHER LHS.
	JRST	NXTSTA
;
;	LIST BREAKPOINTS
;
XLIST:	PUSHJ	P,QSA		;DID SHE INCLUDE T
	ASCIZ	/T/		;WHO CARES
	JFCL	
	TLNN	C,F.TERM	;TERMINATOR?
	FAIL	<? LIST takes no argument>
	PUSH	P,T		;SAVE BYTE POINTER
	PUSH	P,C		;SAVE CURRENT CHARACTER
	PUSHJ	P,INLMES	;LABEL
	ASCIZ	/STOPs:/
	MOVE	X1,FLLAD	;START SEARCHING AT LADROL
XLIST1:	CAML	X1,CELAD	;ALL LOOKED AT?
	JRST	XLIST3		;YES, RETURN
	HRRE	A,(X1)		;GET FIRST LINE
	JUMPGE	A,XLIST2	;STOP HERE?
	MOVE	B,X1		;GET ADDRESS IN LADROL
	SUB	B,FLLAD		;ELEMENT IN LADROL
	ADD	B,FLLIN		;ADDRESS IN LINROL
	HLRZ	T,(B)		;GET STATEMENT NUMBER
	MOVEI	C,11
	PUSHJ	P,OUCH
	PUSHJ	P,PRTNUM	;PRINT IT
XLIST2:	AOJA	X1,XLIST1	;CONTINUE
XLIST3:	PUSHJ	P,PCRLF		;OUTPUT <CR><LF>
	POP	P,C		;RESTORE C
	POP	P,T		;RESTORE T
	JRST	NXTSTA		;GO FOR NEXT
;
;	MARGIN AND MARGIN ALL STATEMENTS.
;
;THIS ROUTINE IS ALSO USED BY THE PAGE AND PAGE ALL STATEMENTS,
;SINCE THEY GENERATE IDENTICAL CODE, EXCEPT FOR THE PUSHJ AT
;THE END OF THE CODE FOR EACH ARGUMENT.  FOR A DESCRIPTION OF THE
;CODE GENERATED, SEE MEMO #100-365-033-00.
 
XMAR:	ASCIZ	/GIN/
	SETZM	TABLE		;TELLS THAT THIS IS REALLY MARGIN (ALL).
XMAR0:	PUSHJ	P,QSA		;ENTRY POINT FOR PAGE (ALL).
	ASCIZ	/ALL/
	JRST	XMAR6		;MARGIN OR PAGE.
	TLNE	C,F.TERM	;MARGIN ALL OR PAGE ALL.
	JRST	ERDIGQ		;ALL MUST HAVE ARG.
	PUSHJ	P,FORMLN	;GENERATE CODE FOR THE ARG.
	PUSHJ	P,EIRGEN
	PUSHJ	P,CHKINT	;MUST BE INTEGER
	MOVE	D,[PUSHJ P,MARGAL]
	SKIPE	TABLE
	HRRI	D,PAGEAL
	PUSHJ	P,BUILDI
	JRST	NXTSTA
 
XMAR6:	TLNE	C,F.TERM
	JRST	ERDIGQ
XMAR1:	HRRZ	A,C
	CAIE	A,"#"		;CHANNEL SPECIFIER?
	JRST	XMAR2		;NO, MUST BE TTY.
	PUSHJ	P,GETCNB
XMAR5:	PUSHJ	P,FORMLN
	PUSHJ	P,EIRGEN
	PUSHJ	P,CHKINT	;MUST BE INTEGER
	MOVE	D,[PUSHJ P,PAGE]
	SKIPN	TABLE
	HRRI	D,MARGN
	PUSHJ	P,BUILDI
	PUSHJ	P,CHKDEL
	JRST	XMAR1
XMAR2:	HRLZI	D,(MOVEI LP,)
	PUSHJ	P,BUILDI
	JRST	XMAR5
;MAT STATEMENT
 
;MAT STATEMENTS DIVIDE INTO A NUMBER OF DIFFERENT
;STATEMENTS (MAT READ, ...)   THESE POSSIBILITIES ARE TESTED
;ONE AT A TIME BY CALLS TO QSA.
 
;<MAT READ STA> ::= MAT READ <LETTER>[(<EXP>,<EXP>)] [,<LETTER>[(<EXP>,<EXP>...]]
 
XMAT:	HLLI	F,		;ALLOW STRINGS FOR READ,PRINT,INPUT
	PUSHJ	P,QSA		;MAT READ?
	ASCIZ /READ/
	JRST	XMAT2		;NO.  GO TRY MAT PRINT
XMAT1:	HRLI	F,0
	PUSHJ	P,ARRAY 	;GET ARRAY NAME
	CAIE	A,5		;STRING VECTOR?
	JUMPN	A,GRONK
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVSI	D,(MATRD)
	SKIPL	DATAFF		;DATA SEEN?
	HLLOS	DATAFF		;NO.  SET NO DATA FLAG
	PUSHJ	P,XMACOM	;GO CHECK DIMENSIONS AND BUILD UUO.
	TLNN	C,F.COMA	;IS THERE ANOTHER ARRAY TO READ?
	JRST	NXTSTA		;NO.
	PUSHJ	P,NXCHK 	;YES. SKIP COMMA
	TLNE	C,F.TERM	;END OF ARRAY LIST?
	JRST	NXTSTA		;YES.
	JRST	XMAT1
 
;<MAT PRINT STA>::= MAT PRINT <LETTER>[(<EXP>,<EXP>)] [[;!,] <LETTER>[(<EXP>,<EXP>)...]
 
XMAT2:	PUSHJ	P,QSA		;MAT PRINT?
	ASCIZ	/PRINT/
	JRST	XMAT3		;NO. MUST HAVE VARIABLE NAME.
XMAT2A: HRLI	F,0
	PUSHJ	P,ARRAY 	;REGISTER NAME
	CAIE	A,5		;STRING VECTOR?
	JUMPN	A,GRONK
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVSI D,(MATPR)
	PUSHJ	P,XMACOM	;GO CHECK DIMENSIONS AND BUILD UUO
	ADD	B,DDTCOD	;
	HLLZ	D,0(B)		;ADDRESS OF MAT UUO
	PUSHJ	P,CHKFMT	;CHECK FORMAT CHARACTER
XMAT2B: TLNN	D,140
	JRST	GRONK		;FAIL IF ILLEGAL
	HLLM	D,0(B)		;RESTORE WITH CORRECT AC FIELD
	TLNE	C,F.TERM	;IS FORMAT CHAR FOLLOWED BY END OF STA?
	JRST	NXTSTA		;YES.
	JRST	XMAT2A		;PROCESS NEXT ARRAY NAME
 
;<MAT SCALE STA> ::= MAT <LETTER>=(<EXPRESSION>)*<LETTER>
 
XMAT3:	PUSH	P,[Z NXTSTA]	;ALL REMAINING MAT STATEMENTS MAY HAVE
				;ONE OPERAND, BUT NOT A LIST OF THEM.
	PUSHJ	P,QSA
	ASCIZ /INPUT/
	JRST	XMAT3A
	PUSHJ	P,VCTOR		;REGISTER VECTOR NAME
	CAIE	A,5		;STRING VECTOR?
	JUMPN	A,GRONK 	;OR NUMBER VECTOR?
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVSI	D,(MATINP)	;YES. BUILD MAT INPUT
	SKIPGE	TYPE		;IS IT INTEGER?
	TLO	D,400		;YES, SET THE BIT
	JRST	BUILDA
 
 
XMAT3A: HRLI	F,-1		;REMAINING MATOPS CANT HAVE STRINGS.
	PUSHJ	P,ARRAY 	;REGISTER THE VARIABLE
	JUMPN	A,GRONK 	;CHECK FOR ILLEGAL ARRAY NAME.
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVE	X1,TYPE		;SAVE THE TYPE
	MOVEM	X1,FTYPE	;FOR MIXED MODE CHECK
	TLNN	C,F.EQAL	; CHECK FOR EQUAL SIGN.
	JRST	EREQAL
	PUSHJ	P,NXCHK 	;SKIP EQUAL.
	CAIE	C,"("	;SCALAR MULTIPLE?
	JRST	XMAT4		;NO
	PUSHJ	P,NXCHK 	;SKIP PARENTHESIS
	PUSH	P,B
	PUSHJ	P,FORMLN	;YES.  GEN MULTIPLE
	MOVE	X1,TYPE		;GET TYPE OF SCALAR
	CAME	X1,FTYPE	;SAME MODE?
	JRST	MTYERR		;NO, ERROR
	PUSHJ	P,EIRGNP
	PUSHJ	P,QSF		;SKIP MULTIPLY SIGN
	ASCIZ	/)*/
	MOVE	X1,[MATSCA]	;SET UP OP CODE
	SKIPGE	FTYPE		;FLOATING SCALE
	TLO	X1,400		;NO, MARK AS INTEGER
	PUSH	P,X1		;PUSH IT
	JRST	XMAT9A

VCTOR:	PUSHJ	P,ARRAY		;REGISTER ARRAY OR VECTOR
	CAIE	A,5		;STRING ?
	JUMPN	A,CPOPJ		;NO, ARRAY ?
	MOVE	X2,1(X1)	;YES, ONE OR THE OTHER
	JUMPG	X2,CPOPJ
	MOVNI	X2,2
	MOVEM	X2,1(X1)
	POPJ	P,
 
 
;<MAT SETUP STA> ::= MAT ZER!CON!IDN <LETTER>[(<EXPRESSION>,<EXPRESSION>)]
 
XMAT4:	PUSHJ	P,QSA		;MAT ZER?
	ASCIZ /ZER/
	JRST	XMAT5		;NO.
	MOVSI	D,(MATZER)	;YES.
	JRST	XMACOM
 
XMAT5:	PUSHJ	P,QSA		;MAT CON?
	ASCIZ /CON/
	JRST	XMAT6
	MOVSI	D,(MATCON)	;YES.
	JRST	XMACOM
 
XMAT6:	PUSHJ	P,QSA		;MAT IDN?
	ASCIZ /IDN/
	JRST	XMAT7		;NO
	MOVSI	D,(MATIDN)	;YES.
 
;COMMON GEN FOR MAT ZER,CON,IDN,REA
 
XMACOM:	SKIPGE	TYPE		;IS IT INTEGER?
	TLO	D,400		;YES, MARK IT
	CAIE	C,"("		;EXPLICIT DIMENSIONS?
	JRST	XMAT9D		;NO.
	PUSH	P,B		;SAVE B,D.
	PUSH	P,D
	PUSHJ	P,XARG		;TRANSLATE ARGUMENTS
	PUSH	P,B		;SAVE COUNT OF ARGUMENTS
	MOVE	B,-2(P) 	;GET BACK THE REGISTRY OF THE ARRAY.
	MOVSI	D,(SDIM)	;BUILD SDIM INSTR.
	PUSHJ	P,BUILDA
	POP	P,B		;GET THE ARGUMENT COUNT.
	JUMPN	B,XMACO1	;ONE ARG OR TWO?
	PUSHJ	P,GENAFN	;ONE.  FAKE DIMENSIONS OF (N,0).
	MOVE	D,[JUMP 2,ONCESW]
	PUSHJ	P,BUILDI
	JRST	XMAT9C
 
XMACO1: PUSHJ	P,GENAR0	;GEN ARGS
	JRST	XMAT9C		;RESTORE AC,S AND BUILD.
 
XMACMI:
 
;<MAT FCN STA> ::= MAT<LETTER> = INV!TRN (<LETTER>)
 
XMAT7:	PUSHJ	P,QSA		;MAT INV?
	ASCIZ	/INV(/
	JRST	XMAT8		;NO
	MOVSI	D,(MATINV)	;YES. GET OP CODE.
	JRST	XMITCM
 
XMAT8:	PUSHJ	P,QSA		;MAT TRN?
	ASCIZ	/TRN(/
	JRST	XMAT9		;NO.
	MOVSI	D,(MATTRN)	;YES. GET OP CODE.
	MOVEM	B,TRNFLG
 
XMITCM: PUSH	P,B		;FINISH MAT INV,TRN.
	SKIPGE	TYPE		;IS IT INTEGER?
	TLO	D,400		;ES, MARK IT
	PUSH	P,D
	HRLI	F,777777
	PUSHJ	P,ARRAY
	JUMPN	A,GRONK
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVE	X1,TYPE		;GET THE TYPE
	CAME	X1,FTYPE	;MIXED MODE?
	JRST	MTYERR		;YES, FLAG ERROR
	HLRZ	X1,(P)		;GET THE OPCODE
	TRZ	X1,400		;CLEAR INTEGER BIT (IF ANY)
	CAIE	X1,(MATTRN)	;MAT INV?
	SKIPL	TYPE		;YES, INTEGER?
	CAIA			;NO, ONWARD
	FAIL	<? Cannot invert integer matrix>
	PUSHJ	P,QSF
	ASCIZ	/)/
	CAME	B,TRNFLG
	JRST	XMAT9B
	ADD	B,FLOOR(F)	;THIS IS MAT A = TRN (A).
	SETOM	2(B)		;MARK A.
	MOVE	B,TRNFLG	;FAKE IT OUT BY USING AN
	MOVSI	D,(MOVEI T1,)	;INVISIBLE MATRIX FOR TEMPORARY
	PUSHJ	P,BUILDA	;STORAGE.
	HRLZI	A,552640
	PUSHJ	P,ARRAY0
	POP	P,D
	PUSH	P,B
	ADD	B,FLOOR(F)
	AOS	2(B)
	MOVE	B,(P)
	PUSHJ	P,BUILDA
	JRST	XMAT11
 
 
;<MAT OPERATOR STA>::=MAT <LETTER>=<LETTER>+!-!*<LETTER>
 
XMAT9:	PUSH	P,B		;SAVE RESULT LOCATION
	MOVE	X1,TYPE		;SAVE THE TYPE
	MOVEM	X1,FTYPE	;FOR MIXED MODE CHECK
	HRLI	F,777777
	PUSHJ	P,ARRAY
	JUMPN	A,GRONK
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVEI	D,0		;LETTER FOLLOWED BY OPERATOR
	TLNN	C,F.PLUS+F.MINS+F.STAR
	JRST	XMAT10		;NO OPERATOR. MUST BE MAT COPY
	TLNN	C,F.MINS+F.STAR
	MOVSI	D,(MATADD)
	TLNN	C,F.PLUS+F.STAR
	MOVSI	D,(MATSUB)
	TLNN	C,F.PLUS+F.MINS
	MOVSI	D,(MATMPY)
	SKIPGE	TYPE		;IS IT INTEGER?
	TLO	D,400		;YES, MARK IT
	PUSH	P,D		;SAVE OPERATION
	PUSHJ	P,NXCHK 	;SKIP OPERATOR
	MOVSI	D,(MOVEI T,)	;GEN T:= ADRS OF FIRST ARRAY
 
	PUSHJ	P,BUILDA	;ENTER HERE FROM SCALAR MULTIPLE
 
XMAT9A: HRLI	F,777777
	PUSHJ	P,ARRAY 	;SECOND ARRAY
	JUMPN	A,GRONK 	;NOT ARRAY NAME
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVE	X1,TYPE		;CHECK FOR MIXED MODE
	CAME	X1,FTYPE	;TYPES MATCH?
MTYERR:	FAIL	<? Cannot mix modes in matrix operations>
 
;ENTER HERE FROM MAT INV, TRN
 
XMAT9B: MOVSI	D,(MOVEI T1,)
	PUSHJ	P,BUILDA
XMAT9C: POP	P,D
	POP	P,B
XMAT9D: JRST	BUILDA	  ;RETURN TO NXTSTA (OR TO PROCESS NEXT ITEM IN PRINT,READ, OR INPUT LIST.)
 
XMAT10: PUSH	P,B		;FOR MAT COPY, FAKE MAT B=(1)*A
XMAT11: MOVE	D,[MOVSI N,(1.0)];PUT CONSTANT 1.0 IN REG FOR SCALE
	SKIPGE	FTYPE		;INTEGER MATRIX?
	MOVE	D,[MOVEI N,1]	;YES, SET UP INTEGER 1
	PUSHJ	P,BUILDI	;BUILD INST TO GET SCAL FACTOR
	POP	P,B		;GET SOURCE MAT BACK
	PUSH	P,[MATSCA]
	JRST	XMAT9B
;
;	QUOTE, NOQUOTE AND NOPAGE STATEMENTS
;
;	     THE FOLLOWING CODE GENERATES CODE TO HANDLE THE VARIOUS
;	TTY AND DSK FILE SETTINGS.  THE INSTRUCTION SKELETON IS
;	SETUP IN AC N.  THE INSTRUCTION TO SET THE TTY WILL
;	ONLY BE GENERATED ONCE NO MATTER HOW MANY TIMES IT IS REFERENCED
;
XQUO:	ASCIZ	/TE/		;REMAINDER OF QUOTE STATEMENT
	MOVE	N,[SETOM QUOTBL] ;FETCH QUOTE INSTRUCTION
	JRST	XNOP8		;HANDLE THE ARGUMENT LIST
;
XNOQ:	ASCIZ	/UOTE/		;REMAINDER OF NOQUOTE STATEMENT
	MOVE	N,[CLEARM QUOTBL] ;FETCH NOQUOTE INSTRUCTION
	JRST	XNOP8		;HANDLE THE ARGUMENT LIST
;
XNOP:	ASCIZ	/AGE/		;REMAINDER OF NOPAGE STATEMENT
	MOVE	N,[SETOM PAGLIM] ;FETCH INSTRUCTION
XNOP8:	MOVEM	N,TABLE		;SAVE THE SETTING INSTRUCTION
	PUSHJ	P,QSA		;CHECK FOR ALL
	ASCIZ	/ALL/
	JRST	XNOP9		;NOT THERE, ARGUMENTS SHOULD FOLLOW
	MOVE	D,[MOVEI LP,9]	;FETCH INSTR. TO BEGIN AT CHANNEL 9
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	MOVE	D,TABLE		;GET THE SETTING INSTRUCTION
	TLO	D,16		;MASK IN AC 16 AS THE INDEX
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	ADD	B,DDTCOD	;CALCULATE ADDRESS OF SETTING INSTRUCTION
	MOVSI	D,(SOJG LP,)	;FETCH INSTR. TO LOOP THRU ALL 9 CHANNELS
	HRR	D,B		;PUT IN THE ADDRESS
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	JRST	NXTSTA		;ALL DONE
XNOP9:	CLEARM	TTYPAG		;FLAG, WE HAVEN'T SET TTY YET
	TLNE	C,F.TERM	;ANY ARGUMENTS?
	JRST	XNOP1		;NO, MEANS TTY, DO IT
XNOP2:	TLNN	C,F.COMA	;CHECK FOR POSSIBLE NULL ARGUMENT
	CAIN	C,";"		;WHICH MEANS TTY
	JRST	XNOP5		;IS NULL, SET TTY
XNOP6:	CAMN	C,[XWD F.STR,"#"] ;DID USER INCLUDE OPTIONAL #
	PUSHJ	P,NXCH		;YES, EAT IT
	PUSHJ	P,GETCN2	;HANDLE THE CHANNEL SPECIFIER
	MOVE	D,TABLE		;FETCH THE SETTING INSTRUCTION
	TLO	D,16		;MASK IN AC 16 AS AN INDEX
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	PUSHJ	P,CHKDEL	;CHECK FOR A DELIMITER, RETURN IF FOUND
XNOP3:	TLNN	C,F.TERM	;NULL ARGUMENT?
	JRST	XNOP2		;NO, LOOK FOR CHANNEL
XNOP0:	SKIPE	TTYPAG		;HAS TTY BEEN SET ALREADY
	JRST	NXTSTA		;YES, JUST RETURN
XNOP1:	MOVE	D,TABLE		;FETCH THE SETTING INSTRUCTION
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	JRST	NXTSTA		;ALL DONE
XNOP5:	PUSHJ	P,NXCH		;EAT THE DELIMITER IN C
	SKIPE	TTYPAG		;HAS TTY BEEN SET?
	JRST	XNOP3		;YES, DON'T DO IT AGAIN
	MOVE	D,TABLE		;FETCH SETTING INSTRUCTION
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	SETOM	TTYPAG		;FLAG, THE TTY HAS BEEN SET
	JRST	XNOP3		;PROCESS NEXT ARGUMENT
;
;	PAGE AND PAGE ALL STATEMENTS.
;
;CODE FOR THESE STATEMENTS IS COMPILED BY THE MARGIN AND
;MARGIN ALL ROUTINE, XMAG, WHICH SEE.
 
XPAG:	ASCIZ	/E/
	SETOM	TABLE
	JRST	XMAR0
;
;	RANDOM IZE STATEMENT
 
XRAN:	ASCIZ /DOM/
	PUSHJ	P,QSA
	ASCIZ	/IZE/
	JFCL	
	MOVE	D,[PUSHJ P,RANDER]
	PUSHJ	P,BUILDI		;BUILD CALL TO RUNTIME RANDOMIZER
	JRST	NXTSTA

MATCHK:	SKIPGE	(X1)		;WAS IT VIRTUAL
	FAIL	<? MAT function on virtual array>
	POPJ	P,
;
;	NEXT STATEMENT
;
;<NEXT STA> ::= NEXT <SCALAR>
 
;EXPECT TO FIND 5-WORD ENTRY ON TOP OF FORROL
;DESCRIBING INDUCTION VARIABLE AND LOOP ADDRESS
 
XNEXT:	ASCIZ /T/
	SKIPE	THNELS		;UNDER THEN OR ELSE ?
	FAIL	<? NEXT under conditional>
XNEX0:	TLNN	C,F.TERM	;NEXT WITHOUT ARGUMENT?
	JRST	XNEX3		;NO, FOR-NEXT LOOP
	MOVE	X1,CEFOR	;UNSAT UNTIL/WHILE LOOP
	CAMG	X1,FLFOR	;CHECK FOR ROLL
	FAIL	<? NEXT without WHILE/UNTIL>
	SETO	X2,		;MAKE SURE THIS IS UNTIL/WHILE LOOP
	CAME	X2,-3(X1)	;-1 FOR INDUCTION VARIABLE
	CAMN	X2,-2(X1)	;-1 FOR INCREMENT
	CAIA			;ALL'S QUIET ON THE EASTERN FRONT
	FAIL	<? Illegal NEXT statement>
	PUSHJ	P,POPFOR	;RETURN TEMP PROTECTION
	MOVEM	B,TMPLOW	;SHOULD NOT CHANGE
	MOVEM	B,TMPPNT	;
	PUSHJ	P,POPFOR	;DUMMY INCREMENT
	PUSHJ	P,POPFOR	;DUMMY INDUCTION
	PUSHJ	P,POPFOR	;LOPP JRST ADDRESSES
	PUSH	P,[Z NXTSTA]	;SET UP RETURN
	JRST	XNEX4		;LET NEXT CODE HANDLE THE JRSTS
XNEX3:	TLNN	C,F.LETT
	FAIL	<? Illegal NEXT arg>
	HRLI	F,777777
	PUSHJ	P,REGLTR
	CAIE	A,1		;BETTER BE SCALAR
	FAIL	<? Illegal NEXT arg>
	MOVE	X1,CEFOR	;UNSAT FOR?
	CAMLE	X1,FLFOR
	CAME	B,-3(X1)	;CHECK INDUCTION VARIABLE
	FAIL	<? NEXT without FOR>
	SETO	X2,		;MAKE SURE THIS IS WHILE/UNTIL LOOP
	CAME	X2,-3(X1)	;
	CAMN	X2,-2(X1)
	FAIL	<? Illegal NEXT statement>
	PUSHJ	P,NEXCOD	;GO GENERATE NEXT CODE
	TLNN	C,F.COMA	;STACKED NEXT?
	JRST	XNEX1		;NO.
	PUSHJ	P,NXCH		;YES.
	JRST	XNEX0
XNEX1:	TLNE	C,F.TERM	;MODIFIERS ILLEGAL IN NEXT
	JRST	NXTSTA
	FAIL	<? Illegal NEXT use>
 
NEXCOD: PUSHJ	P,POPFOR
	MOVEM	B,TMPLOW	;RESTORE PREVIOUS LEVEL OF TEMPORARY PROTECTION
	MOVEM	B,TMPPNT	;BECAUSE THIS IS THE END OF THE "FOR" RANGE .
	PUSHJ	P,POPFOR	;GEN INCREMENT TO REG
	PUSHJ	P,EIRGEN
	PUSHJ	P,POPFOR	;FADR TO INDUCTION VAR
	MOVSI	D,(FADR)
	SKIPGE	TYPE		;INTEGER?
	MOVSI	D,(ADD)		;YES, DO INTEGER ADD
	PUSHJ	P,BUILDA
	PUSHJ	P,POPFOR	;GET JRST POINTER
XNEX4:	MOVE	A,DDTCOD 	;GET CODE FLOOR
	HRLS	A		;IN BOTH SIDES
	ADD	A,B		;E.A.OF NEXT'S JRST,LOC OF FOR'S JRST
	PUSHJ	P,HALJRS	;GEN HALT/JRST BACK TO FOR
	ADD	B,DDTCOD 	;LOC OF INST
	HLRM	A,(B)		;SET E.A
	AOS	B
	HRRM	B,(A)		;FORS JRST TO NEXT STMNT
XNEX2:	PUSHJ	P,POPFOR	;POP OFF THE SAVED VALUE OF L
	POPJ	P,		;RETURN
 
 
 
 
;SUBR TO POP TOP OF FORROL. USED ONLY BY XNEXT.
 
POPFOR: SOS	X1,CEFOR	;POP TOP OF FORROL
	MOVE	B,(X1)
 
	POPJ	P,
;
;	ON STATEMENT
;
;<ON STA> ::= ON <EXPRESSION> GOTO!THEN <STA NUMBER> [,<STA NUMBER>...]
 
;CREATES A CALL TO A RUNTIME ROUTINE THAT CHECKS THE RANGE OF THE ARGUMENT
;AND RETURNS TO THE APPROPRIATE JRST:
;	JSP	A,XCTON
;	Z	(ADDRESS OF NEXT STATEMENT)
;	<NEST OF>
;	<GOTO'S >
 
XON:	PUSHJ	P,FORMLN	;EVALUATE INDEX
	PUSHJ	P,EIRGNP	;GET IN REG
	PUSHJ	P,CHKINT	;MUST BE INTEGER
	MOVE	D,[JSP A,DCTON]
	PUSHJ	P,BUILDI	;BUILD THE RUNTIME CALL
	CLEAR	D,		;DUMMY INSTR. FOR NOW
	PUSHJ	P,BUILDI	;GENERATE IT
	ADD	B,DDTCOD	;ADDRESS OF THUS DUMMY
	MOVEM	B,ONGADR	;SAVE IT
	TLNE	C,F.COMA	;SKIP OPTIONAL COMMA.
	PUSHJ	P,NXCH
	PUSHJ	P,QSA
	ASCIZ	/GOSUB/
	JRST	XONA
	SETOM	ONGFLG
	JRST	XGOS
XONA:	PUSHJ	P,THENGO	;TEST FOR "THEN" OR "GOTO"
 
XON1:	PUSHJ	P,XGOFR 	;BUILD A JRST TO THE NEXT NAMED STATEMENT
	TLNN	C,F.COMA	;MORE?
	JRST	XON2		;NO
	PUSHJ	P,NXCHK 	;YES. SKIP COMMA
	JRST	XON1		;PROCESS NEXT LINE NUMBER
XON2:	MOVE	B,DDCODE	;NEXT ADDRESS
	MOVEM	B,@ONGADR	;SET UP LIMIT
	JRST	NXTSTA		;GO FOR NEXT
DCTON:	JUMPLE	N,DCTON1	;LEGAL ARGUMENT FOR ON
	MOVEM	A,ONGADR	;SAVE UPPER LIMIT
	HRRZ	T,N
	JUMPE	T,DCTON1
	ASH	T,1
	ADDI	T,(A)
	CAMGE	T,(A)
	JRST	-1(T)
DCTON1:	FAIL	<? ON evaluated out of range>
;
;	OPEN STATEMENT
;
XOPEN:	ASCIZ	/N/
	SETOM	FILTYP		;FILE TYPE UNKNOWN
	SETOM	OPNFLG
FILEE8:	MOVE	D,[PUSHJ P,SETCOR]
	PUSHJ	P,BUILDI
	SETZM	VRFSET
FILOP0:	TLNN	C,F.QUOT
	JRST	FILE21
	PUSH	P,C
	PUSH	P,T
	PUSHJ	P,QSKIP
	JRST	ERQUOT
	TLNN	C,F.PLUS	;CHECK FILE SPEC UNLESS CONCATENATION
	JRST	FILEE4
FILE20:	POP	P,T
	POP	P,C
FILE21:	PUSHJ	P,MASCHK	;GET FILENAME
	JRST	FILOP1		;YES, GO DO FOR INPUT/OUTPUT
FILEE4: MOVE	C,-1(P)		;CHECK SYNTAX OF ARG NOW, SINCE IT IS A CONSTANT.
	MOVE	T,(P)
	PUSHJ	P,NXCH
	PUSHJ	P,FILNMO	;FILENM.EXT FORM?
	JUMP	SAVE1
	SETZ	B,		;ASSUME SEQUENTIAL
	TLNE	C,F.QUOT
	JRST	FILEE7
	TLNE	C,F.DOLL	;TYPE $ OR %?
	JRST	FILE45		;$.
	CAME	C,[XWD F.STR,"%"]
	JRST	ERDLPQ
	PUSHJ	P,NXCH		;%.
	TLNN	C,F.QUOT
	JRST	ERQUOT
	JRST	FILEE6
FILE45:	PUSHJ	P,NXCH
	TLNN	C,F.DIG
	JRST	XFILR1
FILEE5:	ADDI	B,-60(C)
	PUSHJ	P,NXCH
	TLNN	C,F.DIG
	JRST	FILE55
	IMULI	B,^D10
	JRST	FILEE5
FILE55:	SKIPLE	B
	CAILE	B,^D132
XFILER: FAIL	<? String record length < 1 or > 132>
XFILR1: TLNN	C,F.QUOT
	JRST	ERDIGQ
FILEE6:	MOVEI	B,-1		;SET R.A.
FILEE7:	PUSHJ	P,FILSET	;SET FILE TYPE
	JRST	FILE20		;BACK TO MAIN CODE

FILSET:	SKIPGE	FILTYP		;ALREADY SET ?
	MOVEM	B,FILTYP	;NO, SET IT
	CAME	B,FILTYP	;YES, IS IT SAME
	FAIL	<? Mixed r.a. and seq.>
	POPJ	P,		;ALL WELL, RETURN
 
 
 
FILOP1: SETZM	INPOUT		;NO SPECIFIER
	PUSHJ	P,QSA
	ASCIZ	/FOR/		;SPECIFIER ?
	JRST	FILOP3		;NO
	PUSHJ	P,QSA
	ASCIZ	/INPUT/ 	;INPUT ?
	JRST	FILOP4		;NO
	AOS	INPOUT		;YES, FLAG
	JRST	FILOP3		;GO CARRY ON
FILOP4: PUSHJ	P,QSA
	ASCIZ	/OUTPUT/	;OUTPUT ?
	FAIL	<? Illegal OPEN stmnt>
	SOS	INPOUT
FILOP3: PUSHJ	P,QSA
	ASCIZ	/ASFILE/
FILERR:	FAIL	<? Illegal OPEN stmnt>
FILOP2:	MOVEI	B,-1		;ASSUME R. A.
	CAIN	C,":"		;CORRECT?
	JRST	FILEE2		;YES
	SETZ	B,		;ASSUME SEQ. ACC.
	CAMN	C,[XWD F.STR,"#"] ;RIGHT?
	JRST	FILEE2		;YES
	CAME	C,[XWD F.STR,"@"] ;VIRTUAL ARRAY
	JRST	ERCHAN		;GIVE ERROR
	SETZM	FILTYP
	AOSA	FILTYP
FILEE2:	PUSHJ	P,FILSET
	PUSHJ	P,GETCNA
FILOP9:	MOVSI	D,(HRREI N,)
	HRR	D,FILTYP
	PUSHJ	P,BUILDI
	MOVE	D,[MOVEM N,FILTYP]
	PUSHJ	P,BUILDI
	MOVE	D,[SKIPE ACTBL-1(LP)]
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,CLSFIL]
	PUSHJ	P,BUILDI
FILOP5: MOVE	D,[PUSHJ P,OPNFIL]
	PUSHJ	P,BUILDI	;OPEN FILE
	SKIPG	FILTYP		;VIRTUAL ARRAY
	SKIPN	X1,INPOUT	;MODE SPECIFIED ?
	JRST	NXTSTA		;NO
	JUMPG	X1,FILOP6	;YES, WHICH
	MOVE	D,[PUSHJ P,SCATH]
	SKIPE	FILTYP		;OUTPUT, SCRATCH, RANDOM ?
	MOVE	D,[PUSHJ P,RANSCR]
	PUSHJ	P,BUILDI
FILPLT:	TLNE	C,F.TERM	;TERMINATOR
	JRST	NXTSTA		;NEXT STATEMENT
	PUSHJ	P,QSA
	ASCIZ	/TOPLOT/
	JRST	NXTSTA
	SKIPE	FILTYP
	JRST	FILERR
	MOVE	D,[MOVEM LP,PLTIN]
	SKIPG	INPOUT
	HRRI	D,PLTOUT
	PUSHJ	P,BUILDI
	JRST	NXTSTA
FILOP6: SKIPE	FILTYP		;INPUT, RESTORE, RANDOM ?
	JRST	FILOP7		;YES
	MOVE	D,[PUSHJ P,XRES]
	PUSHJ	P,BUILDI
	JRST	FILPLT
FILOP7: MOVNI	A,5		;RANDOM
FILOP8: MOVE	D,RESCOD+4(A)
	PUSHJ	P,BUILDI
	AOJL	A,FILOP8
	JRST	NXTSTA
;
;	UNTIL WHILE LOOP
;
XUNTIL:	ASCIZ	/IL/
	SETOM	LOGNEG		;REVERSE SENSE OF LOGIC
	JRST	XWHILE+2	;ONWARD
XWHILE:	ASCIZ	/LE/
	SETZM	LOGNEG		;STRAIGHT FORWARD LOGIC
	MOVE	X1,DDCODE	;WHERE TO GO
	SUB	X1,DDTCOD	;
	SOJ	X1,		;
	HRLM	X1,FORPNT	;SAVE IT
	PUSHJ	P,IFCCOD	;HANDLE CONDITIONAL
	PUSHJ	P,REVSEN	;YES, DO IT
	PUSHJ	P,HALJRS	;NEXT RETURNS
	HRRM	B,FORPNT	;SAVE FOR NEXT CODE
	MOVE	A,L		;SAVE STATEMENT FOR POSSIBLE ERROR
	MOVEI	R,FORROL	;SAVE ON FOR ROLL
	PUSHJ	P,RPUSH		;
	MOVE	A,FORPNT	;SAVE JRST POINTER ON FORROL
	PUSHJ	P,RPUSH		;
	SETO	A,		;DUMMY INDUCTION AND INCREMENT
	PUSHJ	P,RPUSH		;
	PUSHJ	P,RPUSH		;
	MOVE	A,TMPLOW	;SAVE TEMP PROTECTION
	PUSHJ	P,RPUSH	;
	JRST	NXTSTA		;ALL DONE
;
;	PRINT AND WRITE STATEMENT
;
XWRIT:	ASCIZ	/TE/
	SETOM	WRREFL
	JRST	XPLAB1
XPRINT:	ASCIZ	/NT/		;REST OF COMMAND
	CLEARM	WRREFL
XPLAB1:	CAIN	C,":"
	JRST	XPRRAN		;R.A. STATEMENT.
	PUSHJ	P,QSA
	ASCIZ	/USING/
	JRST	XWRI1
	CAME	C,[XWD F.STR,"#"] ;USING STATEMENT. IMAGE NEXT?
	JRST	XWRI2		;YES.
	PUSHJ	P,XWRCHA	;NO, CHANNEL NEXT.
	PUSHJ	P,CHKDL1	;
	PUSHJ	P,XWRIMG	;IMAGE MUST BE NEXT.
	JRST	XWRI5		;GO TO GEN THE ARGS AND FINISH.
XWRI2:	PUSHJ	P,XWRIMG	;GET IMAGE.
	JRST	XWRI6		;MUST BE TTY STATEMENT, GET ARGS & FINISH.
 
XWRI1:	CAME	C,[XWD F.STR,"#"]
	JRST	XPRI1		;NOT USING, NOT #, MUST BE SIMPLE PRINT.
	PUSHJ	P,XWCHA 	;CHANNEL.
	TLNE	C,F.TERM
	JRST	XPRI0		;NOT USING STATEMENT - GO TO PRINT# OR WRITE#.
	TLNN	C,F.COMA
	CAIN	C,":"
	PUSHJ	P,NXCH
	TLNE	C,F.TERM
	JRST	XPRI0		; ''
	PUSHJ	P,QSA
	ASCIZ	/USING/
	JRST	XPRI0		; ''
	MOVE	D,[PUSHJ P,IMGLIN]
	PUSHJ	P,BUILDI
	PUSHJ	P,XWRIMG	;GET IMAGE.
	JRST	XWRI5		;GO TO GEN ARGS AND FINISH.
 
XWRIMG: TLNE	C,F.DIG 	;HANDLE IMAGE.
	JRST	XWRIM2		;LINE NUMBER FORM.
 
XWRIM1: PUSHJ	P,FORMLS
	PUSHJ	P,EIRGNP
	TLNN	C,F.COMA
	JRST	ERCOMA
	PUSHJ	P,NXCH
	JRST	XWRIM4
XWRIM2: PUSH	P,C		;LINE NUMBER FORM.
	PUSH	P,T
	PUSHJ	P,GETNUM	;GET THE NUMBER.
	JFCL	
	TLNN	C,F.COMA
	JRST	ERCOMA
XWRIM3: POP	P,D
	POP	P,D
	HRLZ	A,N
	MOVEI	R,LINROL	;SEARCH FOR THE LINE IT SPECIFIES.
	PUSHJ	P,SEARCH
	FAIL	<? Undefined line number >,1
	PUSH	P,T
	MOVE	B,(B)
	HRRZI	T,(B)
	HRLI	T,440700
XWRIM7: ILDB	C,T		;LOOK FOR A LEADING ":", WHICH
	CAIN	C,":"		;SAYS--THIS IS REALLY AN IMAGE LINE.
	JRST	XWRIM8
	CAIE	C," "
	CAIN	C,11
	JRST	XWRIM7
	FAIL	<? Specified line is not an image>
XWRIM8: SETZ	A,
	PUSHJ	P,NXCHD
	PUSH	P,C
	PUSH	P,T
	TLNE	C,F.CR
	FAIL	<? No characters in image>
	AOJ	A,		;PUT THE IMAGE IN THE TABLE
XWRMX1: PUSHJ	P,NXCHD 	;OF STRING CONSTANTS.
	TLZN	C,F.CR		;<CR> OR <LF> ?
	AOJA	A,XWRMX1	;NO
	CAIN	C,12		;<LF> ?
	JRST	XWRMX1		;YES
	MOVEI	E,4(A)
	MOVN	A,A
	HRLI	A,(A)
	MOVE	T,CESLT
	SUB	T,FLSLT
	HRRI	A,(T)
 
	MOVEI	R,LITROL
	PUSH	P,E
	PUSHJ	P,RPUSH
	POP	P,E
	IDIVI	E,5
	MOVEI	R,SLTROL
	PUSHJ	P,BUMPRL
	POP	P,T
	POP	P,C
	HRLI	B,440700
XWRIM9: CAIN	C,15
	JRST	XWRM10
	CAIE	C,12		;SKIP <LF>
	IDPB	C,B
	ILDB	C,T
	JRST	XWRIM9
XWRM10: MOVEI	R,SADROL
	MOVEI	A,
	PUSHJ	P,RPUSH
	SUB	B,FLSAD
	HRLI	B,SADROL
	MOVSI	D,(MOVE N,)
	PUSHJ	P,BUILDA
	POP	P,T
	PUSHJ	P,NXCH
XWRIM4: MOVE	D,[PUSHJ P,CHKIMG]
 
	JRST	BUILDI
 
XWRCHA: TDZA	D,D		;DISK STATEMENT.
XWCHA:	SETO	D,
	PUSH	P,D
	PUSHJ	P,GETCNA
	MOVE	D,[PUSHJ P,OUTSET]
	PUSHJ	P,BUILDI
	MOVEI	D,WRIPRI-1
	PUSHJ	P,GENTYP
	MOVE	D,[JRST WRPRER]
	PUSHJ	P,BUILDI
	SKIPN	WRREFL
	JRST	XWCHA1
	MOVE	D,[MOVE N,MARGIN(LP)]
	PUSHJ	P,BUILDI
	MOVE	D,[CAMGE N,SEVEN]
	PUSHJ	P,BUILDI
	MOVE	D,[JRST MARERR]
	PUSHJ	P,BUILDI
XWCHA1: POP	P,D
	JUMPE	D,XPLAB2
	POPJ	P,
XPLAB2:	MOVE	D,[PUSHJ P,IMGLIN]
	JRST	BUILDI
 
XWRI6:	MOVSI	D,(SETZ LP,)
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,OUTSET]
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,IMGLIN]
	PUSHJ	P,BUILDI
XWRI5:	PUSHJ	P,KWSAMD	;LOOK FOR MODIFIER
	CAIA			;NONE
	JRST	XWRI7		;ONE, HANDLE AS TERMINATOR
	SETZM	PFLAG		;CLEAR % SEEN FLAG
	PUSHJ	P,FORMLB	;GEN THE ARGS.
	PUSHJ	P,EIRGNP
	MOVE	D,[PUSHJ P,FLTPNT]
	SKIPGE	TYPE		;FLOAT IT IF NECESSARY
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,SCNIMN]
	SKIPL	F
	MOVE	D,[PUSHJ P,SCNIMS]
	PUSHJ	P,BUILDI
	TLNN	C,F.COMA
	CAIN	C,";"
	JRST	XPLAB3
	JRST	XWRI7
XPLAB3:	PUSHJ	P,NXCH
	TLNN	C,F.TERM	;CHECK FOR TERMINATOR
	JRST	XWRI5
XWRI7:	MOVE	D,[PUSHJ P,ENDIMG]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
 
 
XPRRAN:	PUSHJ	P,GENTP1
	PUSHJ	P,FORMLB
	MOVEM	F,IFFLAG
	JRST	XPRRN2
XPRRN1:	PUSHJ	P,FORMLB
	XOR	F,IFFLAG
	JUMPGE	F,XPRRN2
	FAIL	<? Mixed strings and numbers>
XPRRN2: PUSHJ	P,EIRGNP
	MOVE	D,[PUSHJ P,RNNUMO]
	SKIPL	IFFLAG
	HRRI	D,RNSTRO
	PUSHJ	P,BUILDI
	PUSHJ	P,CHKDEL
	JRST	XPRRN1
XPRI1:	SKIPE	WRREFL
	JRST	GRONK
	MOVSI	D,(SETZ LP,)	;TTY OUTPUT
	PUSHJ	P,BUILDI	;GENERATE
	MOVE	D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT
	PUSHJ	P,BUILDI	;GENERATE
XPRI0:	PUSHJ	P,KWSAMD	;MODIFIER FOLLOWS?
	TLNE	C,F.TERM	;LINE TERMINATOR?
	JRST	XPCRLF		;YES, JUST WANTS <CR><LF>
	CAIA
XPRI2:	PUSHJ	P,KWSAMD	;MODIFIER
	CAIA		;NO
	JRST	NXTSTA		;YES, GO HANDLE
	PUSHJ	P,QSA		;TAB FIELD?
	ASCIZ	/TAB/
	JRST	XPLAB4
	JRST	XPRTAB		;YES, GO HANDLE
XPLAB4:	TLNN	C,F.COMA	;SEPARATOR?
	CAIN	C,";"		;SEMI-COLON?
	JRST	PRNDEL		;YES, PRINT DELIMETER
	CAIE	C,74		;LEFT ANGLE BRACKET?
	JRST	PRNEXP		;NO, PRINT EXPRESSION
;
;	PRINT DELIMETER
;
PRNDEL:	MOVSI	D,(PRDL)	;UUO NEEDED FOR DELIMETER
	PUSHJ	P,CHKFMT	;CHECK THE FORMAT
	PUSHJ	P,BUILDI	;GENERATE
	JRST	XPRFIN		;SEE IF MORE
;
;	PRINT EXPRESSION
;
PRNEXP:	SETZM	PFLAG		;CLEAR % SEEN FLAG
	PUSHJ	P,FORMLB	;GENERATE THE FORMULA
	JUMPL	F,XPLAB5
	MOVSI	D,(PRSTR)
	JRST	XPLAB6
XPLAB5:	PUSHJ	P,GPOSNX	;MOVE TO REGISTER (IF NEEDED)
	MOVSI	D,(PRNM)	;SET UP UUO
XPLAB6:	PUSHJ	P,CHKFMT	;CHECK FORMAT
	SKIPGE	TYPE		;INTEGER?
	TLO	D,400		;YES, MARK IT
	PUSHJ	P,BUILDA	;GENERATE PRINT UUO
	JRST	XPRFIN		;GO FOR MORE
;
;	PRINT TAB
;
XPRTAB:	PUSHJ	P,FORMLN	;EVALUATE TAB SUBEXPRESSION
	PUSHJ	P,EIRGNP	;MOVE IT INTO REG
	MOVSI	D,(PRNTB)	;CALL THE TAB INTERPRETER
XPRTA1:	PUSHJ	P,CHKFMT	;CHECK THE FORMAT
	PUSHJ	P,BUILDI	;BUILD THE INST.
;
;	END OF ONE ARGUMENT
;
XPRFIN:	TLNE	C,F.TERM	;TERMINATOR?
	JRST	NXTSTA		;YES, TERMINATE
	JRST	XPRI2		;LOOP FOR NEXT
;
XPCRLF:	MOVE	D,[CLEARM 40]	;NO UUO
	PUSHJ	P,BUILDI	;GENERATE
	MOVE	D,[PUSHJ P,PRDLER] ;DO SETUP
	PUSHJ	P,BUILDI	;GENERATE
	MOVE	D,[PUSHJ P,CRLF] ;DO <CR><LF>
	PUSHJ	P,BUILDI	;GENERATE
	JRST	NXTSTA		;GO TERMINATE

;
;	REMOVE A BREAKPOINT
;
XREM:	PUSHJ	P,QSA		;DID HER INCLUDE FULL COMMAND
	ASCIZ	/OVE/		;
	JFCL			;WHO CARES
	TLNN	C,F.TERM	;REMOVING ALL
	JRST	XREM3		;NO, ONE AT A TIME
	PUSH	P,T		;SAVE BYTE POINTER
	PUSH	P,C		;SAVE CURRENT CHARACTER
	MOVE	X1,FLLAD	;START AT FLOOR OF LADROL
	MOVEI	R,LADROL	;SETUP R
XREM1:	CAML	X1,CELAD	;ALL LOOKED AT
	JRST	XREM2A		;YES, RESTORE T AND C
	HRRE	A,(X1)		;GET LINE FLAG
	JUMPGE	A,XREM2		;NO BREAKPOINT HERE
	HLLZS	(X1)		;CLEAR BREAKPOINT
	HLRZ	B,(X1)		;GET REL CODE ADDRESS
	ADD	B,FLCOD		;ADD IN BASE OF CODE
	MOVE	A,[JSP A,LINADR] ;RESTORE THIS INSTR.
	MOVEM	A,(B)		;DO IT
XREM2:	AOJA	X1,XREM1	;DO NEXT
XREM2A:	POP	P,C		;BACK COMES C
	POP	P,T		;AND T
	JRST	NXTSTA		;GO FOR NEXT COMMAND
XREM3:	PUSHJ	P,GETLIN	;GET THE LINE REFERENCE
	HLLZS	(B)		;CLEAR BREAKPOINT
	MOVE	B,[JSP A,LINADR] ;RESTORE THIS INSTR.
	MOVEM	B,(A)		;DO IT
	TLNN	C,F.COMA	;MORE TO COME
	JRST	NXTSTA		;NOPE, GO HOME
	PUSHJ	P,NXCHK		;SWALLOW THIS COMMA
	JRST	XREM3		;CONTINUE
;
;	RESTORE STATEMENTS.
;
XREST:	PUSHJ	P,QSA		;RESUME?
	ASCIZ	/UME/
	JRST	XRESTA		;NO, MAYBE RESTORE
	FAIL	<? RESUME not available - please use CONT>
XRESTA:	PUSHJ	P,QSA		;CHECK FOR RESTORE
	ASCIZ	/TORE/
	JRST	ILLINS		;ILLEGAL INSTRUCTION
	TLNN	C,F.DOLL+F.STAR+F.TERM
	CAMN	C,[XWD F.STR,"%"]
	JRST	XREST1
XRES3:	CAIN	C,":"
	JRST	XRES5		;R.A. ARG.
	CAMN	C,[1000000043]
	PUSHJ	P,NXCH
	PUSHJ	P,GETCN2	;RESTORE# STATEMENT.
	MOVE	D,[PUSHJ P,XRES]
	PUSHJ	P,BUILDI
XRES6:	PUSHJ	P,CHKDEL
	JRST	XRES3
 
XRES5:	PUSHJ	P,GETCNA	;R.A. ARG.
	MOVNI	A,5
XRES7:	MOVE	D,RESCOD+5(A)
	PUSHJ	P,BUILDI
	AOJL	A,XRES7
	JRST	XRES6
 
RESCOD: SKIPGE	X1,ACTBL-1(LP)	;SOME OF THE CODE GENERATED.
	CAME	X1,NEGONE##	;
	JRST	FNMXER
	MOVEI	N,1
	MOVEM	N,POINT-1(LP)
 
 
XREST1: MOVE	D,[PUSHJ P,RESTON] ;DATA RESTORE STATEMENT.
	CAMN	C,[XWD F.STR,"%"]
	JRST	XRES2
	TLNN	C,F.STAR+F.DOLL
	SOJA	D,XRES1
	TLNE	C,F.DOLL	;RESTORE ONLY STRINGS?
	ADDI	D,1
XRES2:	PUSHJ	P,NXCHK 	;SKIP $ OR * OR %
XRES1:	PUSHJ	P,BUILDI
	JRST	NXTSTA
;
;	SCRATCH STATEMENT
;
;FORMAT
;     SCRATCH Q4,Q7,Q8
;WHERE Q IS # OR :. Q MAY BE OMITTED, IN WHICH CASE # IS ASSUMED.
 
XSCRAT: ASCIZ /ATCH/
SRAER5: CAIN	C,":"
	JRST	SRAER3		;R.A. ARGUMENT.
	CAMN	C,[XWD F.STR,"#"] ;SEQ. ACCESS ARGUMENT.
	PUSHJ	P,NXCH
	PUSHJ	P,GETCN2
	MOVE	D,[PUSHJ P,SCATH]
SRAER4: PUSHJ	P,BUILDI	;BUILD SCRATCH
	PUSHJ	P,CHKDEL
	JRST	SRAER5
 
SRAER3: PUSHJ	P,GETCNA	;R.A. ARGUMENT.
	MOVE	D,[PUSHJ P,RANSCR]
	JRST	SRAER4
;
;	SET STATEMENT
;
;FORMAT
;	SET :N,NUMERIC FORMULA, :N,NUMERIC FORMULA...
;
;WHERE N IS A DIGIT FROM 1 TO 9, THE ":" IS OPTIONAL, THE COMMA
;FOLLOWING N MAY BE REPLACED BY A COLON, AND THE COMMA
;FOLLOWING THE FORMULA MAY BE REPLACED BY A SEMICOLON.
 
XSET:	PUSHJ	P,GENTP1
	PUSHJ	P,FORMLN	;GET VALUE FOR POINTER.
	PUSHJ	P,EIRGNP
	PUSHJ	P,CHKINT	;MUST BE INTEGER?
	MOVNI	A,4
XSET2:	MOVE	D,SETCOD+4(A)
	PUSHJ	P,BUILDI
	AOJL	A,XSET2
	PUSHJ	P,CHKDEL
	JRST	XSET
 
SETCOD: JUMPLE	N,SETERR	;SOME OF THE CODE GENERATED.
	CAIGE	N,1
	JRST	SETERR
	MOVEM	N,POINT-1(LP)
;
;	START USER'S PROGRAM
;
XSTART:	PUSHJ	P,QSA		;DID SHE INCLUDE EVERYTHING
	ASCIZ	/RT/
	JFCL			;JUST LIKE A WOMAN
	TLNN	C,F.TERM	;JUST START
	JRST	XSTRT1		;NO, DO LINE NUMBER STUFF
	SETOM	DDTFLG		;
	SETOM	PFLAG		;
	PUSHJ	P,ZSTOR		;ZERO STORAGE
	CLEARM	NOLINE
	JRST	@RUNLIN		;START UP
XSTRT1:	PUSHJ	P,GETLIN		;GET THE LINE REFERENCE
	PUSHJ	P,ZSTOR		;ZERO STORAGE
	HRRZM	A,DDSTRT	;SAVE FOR START
	SETOM	DDTFLG		;
	MOVEI	R,CODROL	;RESET TOP STODGY ROOL
	MOVEM	R,TOPSTG	;FOR NON BASDDT
	CLEARM	NOLINE		;NO BREAK POINTS
	SETOM	PFLAG		;TURN ON P FLAG
	JRST	@DDSTRT		;START THE PROGRAM
;
;	SET A BREAKPOINT
;
XSTOP:	PUSHJ	P,QSA		;DID HE INCLUDE P
	ASCIZ	/P/
	JFCL			;WHO CARES
XSTOP1:	PUSHJ	P,GETLIN	;GET THE LINE REFERENCE
	MOVE	X1,[JSP A,DDTBRK] ;GET BREAK INSTRUCTION
	CAMN	X1,(A)		;ALREADY SET?
	JRST	XSTOP2		;YES, DON'T SET AGAIN
	HLLOS	(B)		;MARK AS BREAK
	MOVEM	X1,(A)		;FOR THIS STATEMENT
XSTOP2:	TLNN	C,F.COMA	;MORE TO COME?
	JRST	NXTSTA		;THAT'S ALL
	PUSHJ	P,NXCHK		;SCAN OFF COMMA
	JRST	XSTOP1		;DO NEXT

SUBTTL	SERVICE ROUTINES

;
;CHECK FORMAT CHAR (PRINT AND MAT PRINT)
 
CHKFMT:	PUSHJ	P,KWSAMD	;DELIMITER THERE ? (IMPLIES CR)
	TLNE	C,F.TERM
	TLO	D,40		;CR ... AC = 1
	CAIN	C,";"		;SC ... AC = 2
	TLO	D,100		;CMA ... AC = 3
	TLNE	C,F.COMA	;<PA> ... AC = 4
	TLO	D,140
	CAIE	C,74		;LEFT ANGLE BRACKET
	JRST	CHKFM2
	HRRZ	C,(P)
	CAIN	C,XMAT2B	;MAT STATEMENT CANNOT USE
	JRST	GRONK		;<PA>.
	PUSHJ	P,NXCH
	PUSHJ	P,QSA
;< TO RECTIFY ANGLE BRACKET COUNT
	ASCIZ	/PA>/
	JRST	GRONK
	TLO	D,200
	POPJ	P,
CHKFM2: TLNN	D,140		;WAS THERE A FMT CHAR?
	TLO	D,100		;NO. ASSUME ";"
	CAIE	C,";"
	TLNE	C,F.COMA	;SKIP FMT CHAR IF THERE WAS ONE.
	JRST	NXCHK		;YES.  SKIP
	POPJ	P,

;
;	GET NEXT CHARACTER AND CHECK FOR LEGALITY
;
NXCHK:	PUSHJ	P,NXCH		;GET NEXT CHARACTER
	TLNE	C,F.STR		;LEGAL
	FAIL	<? Illegal character>
	POPJ	P,		;RETURN

;SCAN INITIAL LETTER, LETTER IS PLACED LEFT
;JUSTIFIED IN A, 7-BIT ASCII.
 
SCNLT1: HRRZ	A,C
	ROT	A,-7
	JRST	NXCH
 
;SCAN SECOND LETTER, NON-SKIP RETURN IF NOT LETTER.
;MAKE 7-BIT LETTER LEFT JUST IN A
;INTO 6-BIT. THAN PUT 6-BIT CURRENT LETTER IN A.
 
SCNLT2: TLNN	C,F.LETT
	POPJ	P,
SCN2:	TLNN	A,400000	;ENTER HERE TO PROCESS NON-LETTER CHARS
	TLZA	A,200000
	TLO	A,200000
	LSH	A,1
	MOVE	X1,[POINT 6,A,5]
	JRST	SCNLTN
 
 
;ENTER HERE TO SCAN SECOND CHAR EVEN IF BOTH ARE NOT LETTERS.
 
 
;SCAN THIRD LETTER, NON-SKIP IF NOT LETTER.
;PUT 6-BIT LETTER TO 3RD 6-BIT FIELD IN A.
 
SCNLT3: TLNN	C,F.LETT
	POPJ	P,
SCN3:	MOVE	X1,[POINT 6,A,11]
	JRST	SCNLTN		;CONTINUE

QSELS:	AOS	(P)		;ASSUME SUCCESS
	PUSH	P,C		;SAVE CHAR
	PUSH	P,T		;AND POINTER
	PUSHJ	P,QSA
	ASCIZ	/ELSE/		;ELSE THER ?
	SOS	-2(P)		;NO
	POP	P,T		;RESTORE
	POP	P,C		;ACS
	POPJ	P,

ILLINS:	FAIL	<? Illegal instruction>

;GEN CODE TO EVALUATE FORMULA
;POINTER TO (POSSIBLY NEGATIVE) RESULT RETURNED IN B
 
;THIS LOOP HANDLES SUMS OF TERMS, CALLS TERM TO HANDLE PRODUCTS
;AND SO ON
;THE ENTRY POINT FORMLN REGARDS ONLY NUMERIC FORMULAS AS LEGAL.
;THE ENTRY POINT FORMLS REGARDS ONLY STRING FORMULAS AS LEGAL.
;THE ENTRY POINT FORMLB WILL ACCEPT EITHER A STRING OR A NUMERIC FORMULA.
;THE ENTRY POINT FORMLU EXPECTS THE LEGALITY TO BE DEFINED EXTERNALLY.
 
FORMLS:	HRLZI	F,1		;ONLY STRINGS ARE LEGAL
	JRST	FORMLU		;HANDLE THE EXPRESSION
FORMLB:	TDZA	F,F		;EITHER IS LEGAL, FIRST COME, FIRST SERVED
FORMLN:	SETOI	F,		;ONLY NUMERICS ARE LEGAL

FORMLU:	SETZM	TYPE		;ASSUME EXPRESSION IS REAL IN CASE OF STRING
	PUSHJ	P,CFORM		;CHECK FOR COMPARISONS
;
;	CHECK FOR BOOLEAN LOGIC
;
BTERM1:	PUSHJ	P,KWSCIF	;CHECK FOR BOOLEAN KEYWORDS
	POPJ	P,		;NONE FOUND, RETURN
	MOVE	X1,KWDIND	;GET INDEX TO KEYWORD
	SUBI	X1,KWACIF	;MAKE AN OFFSET FOR OPCODE
	PUSH	P,X1		;AND SAVE IT
	MOVMS	LETSW		;CANNOT BE L. H. OF LET
	JUMPGE	F,SETFER	;MUST BE NUMERIC
	PUSHJ	P,GPOSGE	;GUARANTEE A POSITIVE OPERAND
	PUSHJ	P,PUSHPR	;SAVE IT ON SEXROL
	MOVEI	F,(F)		;
	PUSHJ	P,CFORM		;CHECK FOR COMPARISONS
	TLNE	B,ROLMSK	;IS RIGHT SIDE OPERAND IN REG?
	JUMPGE	F,SETFER	;ILLEGAL IF STRING
	PUSHJ	P,REGFRE	;NO, MAKE SURE REGISTER IS FREE
	PUSHJ	P,EIRGNP	;GET OPERAND IN REG
	PUSHJ	P,POPPR		;GET RIGHT SIDE OPERAND BACK
	POP	P,X1		;GET OPCODE INDEX BACK
	MOVE	D,BOCODE(X1)	;PICK UP CORRECT BOOLEAN OPCODE
	PUSHJ	P,BUILDA	;DO THE INSTRUCTION
	CLEAR	B,		;EXPRESSION IN REG, AND POSITIVE
	JRST	BTERM1		;CHECK FOR ANOTHER BOOLEAN
;
BOCODE:	AND	N,		;AND
	IOR	N,		;OR
	IOR	N,		;IOR
	XOR	N,		;XOR
	EQV	N,		;EQV
	ORCM	N,		;IMP
;
CFORM:	PUSHJ	P,QSA		;CHECK FOR UNARY "NOT"
	ASCIZ	/NOT/
	JRST	CFORM0		;NO NOT, CHECK <,>,=, ETC.
	MOVMS	LETSW		;CANNOT BE L. H.
	PUSHJ	P,SETFNO	;MUST BE NUMERIC
	PUSHJ	P,REGFRE	;MAKE SURE REGISTER IS FREE
	PUSHJ	P,CFORM0	;GET OBJECT OF NOT
	TLNE	B,MINFLG	;OUTSTANDING "-"?
	PUSHJ	P,EIRGNP	;YES, NEGATE IT
	MOVSI	D,(SETCM)	;COMPLEMENT THE BASTARD
	PUSHJ	P,BUILDA	;DO THE INSTRUCTION
	CLEAR	B,		;EXPRESSION IN REG, AND POSITIVE
	POPJ	P,		;AND RETURN
;
CFORM0:	PUSHJ	P,FORM		;CHECK FOR ARITHMETIC FORMULA
;
CFORM1:	MOVEI	X1,76		;CHECK FOR POSSIBLE COMPARISONS
	CAIN	X1,(C)		;RIGHT ANGLE BRACKET
	JRST	CFORM2		;YES, COMPARISION COMING UP
	MOVEI	X1,74		;LEFT ANGLE BRACKET?
	CAIN	X1,(C)		;YES? NO?
	JRST	CFORM2		;YES, COMPARISION
	SKIPGE	LETSW		;ARE WE ON L. H. OF LET?
	POPJ	P,		;YES, LET AN "=" PASS
	TLNN	C,F.EQAL	;EQUAL SIGNS?
	POPJ	P,		;NO, RETURN
CFORM2:	MOVMS	LETSW		;CAN'T BE L. H.
	PUSHJ	P,GPOSGE	;MAKE SURE WE HAVE CORRECT SIGN
	PUSHJ	P,PUSHPR	;AND SAVE IT
	PUSHJ	P,SCNLT1	;CHARACTER TO "A" IN SEVEN BIT
	MOVEI	X1,76		;CHECK FOR TWO WORD COMPARISION
	CAIE	X1,(C)		;RIGHT ANGLE BRACKET
	TLNE	C,F.EQAL	;OR EQUALS SIGN?
	PUSHJ	P,SCN2		;YES, COMBINE IN "A" IN SIXBIT
	JFCL			;IGNORE ERROR RETURN
	MOVEI	R,RELROL	;SEARCH RELROL FOR
	PUSHJ	P,SEARCH	;FOR THIS RELATION
	FAIL	<? Illegal relation>
	HRLZ	D,(B)		;PICK UP THE OPCODE
	PUSH	P,D		;AND SAVE IT
	PUSHJ	P,FORM		;GET NEXT ARITHMETIC FORMULA
	PUSHJ	P,GPOSGE	;GET CORRECT SIGN
	PUSHJ	P,CMIXM		;CHECK FOR MIXED MODE
	TLNN	B,ROLMSK	;IS RIGHT SIDE ALREADY IN REG
	JRST	CFORM3		;YES, COMPARE WITH LEFT SIDE
	PUSHJ	P,EXCHG		;GET LEFT SIDE IN REG
	MOVE	D,(P)		;GET THE OPCODE
	TLNE	D,1000		;EQUAL OR NOT EQUAL
	TLC	D,6000		;NO, REVERSE SENSE OF COMPARISION
	MOVEM	D,(P)		;RESTORE OPCODE
CFORM3:	JUMPGE	F,CFORM4	;STRING COMPARISON
	PUSHJ	P,EIRGNP	;NO, GET OPERAND IN REG
	PUSHJ	P,POPPR		;GET NEXT OPERAND
	POP	P,D		;GET BACK THE OPCODE
	PUSHJ	P,BUILDA	;DO THE INSTRUCTION
	JRST	CFORM5		;AND CONTINUE
CFORM4:	PUSHJ	P,EIRGNP	;GET OPERAND IN REG
	PUSHJ	P,POPPR		;GET BACK SECOND OPERAND
	MOVSI	D,(STRIF)	;OPCODE FOR STRING COMPARISON
	PUSHJ	P,BUILDA	;DO THE INSTRUCTION
	POP	P,D		;GET BACK COMARISON OPCODE
	PUSHJ	P,BUILDI	;AND COMPARE WITH REG
CFORM5:	MOVSI	D,(TDZA)	;FALSE RESULT
	PUSHJ	P,BUILDI	;DO THE INSTRUCTION
	MOVSI	D,(SETO)	;TRUE RESULT
	PUSHJ	P,BUILDI	;DO THE INSTRUCTION
	CLEAR	B,		;RESULT IN REG
	HRLI	F,-1		;NUMERIC RESULT
	JRST	CFORM1		;AND START ALL OVER AGAIN
;
;	ALTERNATE ENTRY POINTS FOR FORML? WHEN LOGICAL
;	EXPRESSION ARE ILLEGAL
;
XFORMS:	HRLZI	F,1		;FOR STRINGS ONLY
	JRST	XFORMU		;CARRY ON
XFORMB:	TDZA	F,F		;BOTH ARE LEGAL
XFORMN:	SETOI	F,		;ONLY NUMERICS
XFORMU:	SETZM	TYPE		;TYPE DECLARED EXTERNALLY


FORM:	PUSHJ	P,TERM		;GET FIRST TERM
 
;ENTER HERE FOR MORE SUMMANDS
 
FORM1:	TLNN	C,F.PLUS+F.MINS ;IS BREAK PLUS OR "-"?
	POPJ	P,		;NO, SO DONE WITH FORMULA
	MOVMS	LETSW		;THIS CANT BE LH(LET)
	JUMPL	F,FORM3
	TLNN	C,F.MINS
	JRST	FORM2
	PUSHJ	P,SETFNO	;MARK NUMERIC IF LEGAL
	JRST	FORM3
FORM2: PUSHJ	P,EIRGNP
	PUSHJ	P,CHKCOR	;CHECK CORE REQUIREMENTS
	PUSHJ	P,MASCK1	;HANDLE STRING EXPRESSION
	PUSHJ	P,TERM
	PUSHJ	P,EIRGNP
	MOVE	D,[PUSHJ P,APPEND]
	PUSHJ	P,BUILDI
	SETZ	B,
	TLNN	C,F.PLUS
	POPJ	P,
	JRST	FORM2
FORM3:	PUSHJ	P,PUSHPR	;PART RESLT TO SEXROL
	PUSHJ	P,TERM		;GEN SECOND TERM
	PUSHJ	P,CMIXM		;CHECK FOR MIXED MODE
	TLNE	B,ROLMSK	;IS SECOND TERM IN REG?
	PUSHJ	P,EXCHG 	;NO.  LETS DO FIRST TERM FIRST
	PUSHJ	P,EIRGEN	;FIRST SUMMAND TO REG
	PUSH	P,B		;SAVE SIGN INFORMATION
 
	PUSHJ	P,POPPR 	;GET SECOND SUMMAND
	SKIPGE	(P)		;IS CONTENT OR REG NEGATIVE?
	TLC	B,MINFLG	;YES, NEGATE SECOND SUMMAND
	SKIPL	TYPE		;INTEGER?
	JRST	FORM4		;NO, DO REAL
	MOVSI	D,(ADD N,)	;ASSUME POSITIVE
	SKIPGE	B		;IS IT
	MOVSI	D,(SUB N,)
	PUSHJ	P,BUILDA	;BUILDI THE INSTRUCTION
	JRST	FORM5		;CONTINUE
FORM4:	MOVSI	D,(FADR N,)	;FETCH INSTRUCTION
	PUSHJ	P,BUILDS	;BUILD ADD OR SUB INSTR
FORM5:	POP	P,B		;REG PNTR WITH SIGN
	AND	B,[XWD MINFLG,0]
	JRST	FORM1		;GO LOOK FOR MORE SUMMANDS
 
 
;LOOP TO GEN CODE FOR MULTIPLY AND DIVIDE
;CALLS FACTOR TO HANDLE EXPRESSIONS INVOLVING ONLY INFIX OPS AND "^"
 
TERM:	PUSHJ	P,FACTOR	;GEN FIRST FACTOR
 
;ENTER HERE FOR MORE FACTORS
 
TERM1:	TLNN	C,F.STAR+F.SLSH ;MUL OR DIV FOLLOWS?
	POPJ	P,		;NO, DONE WITH TERM.
	PUSHJ	P,SETFNO	;MARK NUMERIC IF LEGAL
	MOVMS	LETSW		;THIS CANT BE LH(LET)
	HRRZS	0(P)		;SET MUL FLAG.
	TLNN	C,F.STAR	;IS IT MULTIPLY?
	HRROS	0(P)		;NO. SET DIV FLAG
TERM2:	PUSHJ	P,NXCHK 	;SKIP OVER CONNECTIVE
	PUSHJ	P,PUSHPR	;STASH PARTIAL RESULT ON SEXROL
	PUSHJ	P,FACTOR	;GEN NEXT FACTOR
	PUSHJ	P,CMIXM		;CHECK FOR MIXED MODE
	SKIPGE	(P)		;IS SECOND FACTOR A DIVISOR?
	PUSHJ	P,SITGEN	;YES. IT CANNOT STAY IN REG.
	TLNE	B,ROLMSK	;IS SECOND FACTOR IN REG?
	PUSHJ	P,EXCHG 	;NO. LETS GET FIRST FACTOR.
	MOVE	X1,CESEX	;PEEK AT DIVISOR OR SECOND FACTOR.
	MOVE	X2,-1(X1)
	TLZE	X2,MINFLG	;IS IT MINUS?
	TLC	B,MINFLG	;YES. CHANGE SIGNS OF BOTH.
	MOVEM	X2,-1(X1)	;NOW DIVISION OR SECOND FACTOR IS PLUS.
	PUSHJ	P,EIRGEN	;GEN FIRST FACTOR OR DIVIDEND
	PUSH	P,B		;SAVE SIGN INFORMATION
	PUSHJ	P,POPPR 	;GET SECOND OPERAND
	MOVSI	D,(FMPR N,)	;GET CORRECT INSTRUCTION
	SKIPGE	-1(P)
	MOVSI	D,(FDVR N,)
	SKIPGE	TYPE		;INTEGER?
	ADD	D,[XWD 34000,0] ;YES, MAKE IDIV OR IMUL
	PUSHJ	P,BUILDA	;BUILD MUL OR DIV INSTR
	POP	P,B		;REG PNTR WITH SIGN
	JRST	TERM1		;GO LOOK FOR MORE FACTORS
 
 
;GEN CODE FOR ATOMIC FORMULAS, EXPONENTIATION, AND INFIX SIGNS
;SIGN IS STASHED IN LH OF PUSH-DOWN LIST WORD WITH RETURN ADDRS
;EXPLICIT SIGN IS NOT USED UNTIL AFTER EXPONENTIATION
;IS CHECKED FOR.
 
 
FACTOR: PUSH	P,C		;STASH SIGN IN PUSH LIST.
	TLNN	C,F.MINS	;EXPLICIT MINUS SIGN?
	JRST	FACT2		;NO.
	PUSHJ	P,SETFNO	;MARK NUMERIC IF LEGAL
	TLC	C,F.PLUS+F.MINS ;YES. PRETEND IT WAS PLUS CALLING ATOM.
	MOVMS	LETSW		;AND THIS CANNOT BE LH OF LET.
 
FACT2:	PUSHJ	P,ATOM		;GEN FIRST ATOM
 
 
FACT2A: CAIN	C,"^"		;EXPONENT FOLLOWS?
	JRST	FACT3A		;YES.
	TLNN	C,F.STAR	;MAYBE.
	JRST	SNOEXI		;NO.  GO NOTE SIGN AND RETURN.
	MOVEM	T,X1
	PUSHJ	P,NXCHK
	TLNE	C,F.STAR
	JRST	FACT3A		;YES.
	MOVE	T,X1		;NO.  GO NOTE SIGN AND RETURN.
	MOVE	C,[XWD F.STAR, "*"]
	JRST	SNOEXI
FACT3A:	PUSHJ	P,SETFNO	;MARK NUMERIC IF LEGAL
	MOVMS	LETSW		;THIS CANT BE LH(LET)
	PUSHJ	P,NXCHK 	;YES.  SKIP EXPONENTIATION SIGN
	PUSHJ	P,PUSHPR	;STASH BASE ON SEXROL
	PUSHJ	P,ATOM		;GEN THE EXPONENT
	PUSHJ	P,EXCHG 	;EXCHANGE BASE AND EXPONENT
	PUSHJ	P,EIRGNP	;GET POSITIVE BASE IN REG
	SKIPGE	TYPE		;FLOATING BASE?
	JRST	FACT5A		;NO, DO INTEGER EXP
	PUSHJ	P,POPPR		;GET EXPONENT
	MOVSI	D,(MOVE 1,)	;WILL MOVE IT TO AC 1
	PUSHJ	P,BUILDS	;GENERATE CORRECT SIGN
	MOVE	D,[PUSHJ P,EXP3.0] ;ASSUME FLOATING EXP
	SKIPGE	TYPE		;IS IT?
	HRRI	D,EXP2.0	;NO, USE EXPS.0
	SETZM	TYPE		;ANSWER IS FLOATING
	JRST	FACT6A		;CONTINUE
FACT5A:	MOVE	X1,CESEX	;PEEK AT EXP
	MOVE	X2,-1(X1)	;
	TLNE	X2,100000	;FLOATING EXP?
	JRST	FACT5B		;NO INT ** INT
	MOVE	D,[PUSHJ P,FLTPNT] ;FLOAT THE BASE
	PUSHJ	P,BUILDI	;
	PUSHJ	P,POPPR		;GET THE EXPONENT
	MOVSI	D,(MOVE 1,)	;PUT IN AC 1
	PUSHJ	P,BUILDS	;CORRECT SIGN
	MOVE	D,[PUSHJ P,EXP3.0] ;
	JRST	FACT6A		;CARRY ON
FACT5B:	PUSHJ	P,POPPR		;
	MOVSI	D,(MOVE 1,)	;
	PUSHJ	P,BUILDS	;
	MOVE	D,[PUSHJ P,EXP1.0] ;
FACT6A:	PUSHJ	P,BUILDI	;BUILD CALL TO EXPONENTIATION ROUTINE
	MOVEI	B,0		;ANSWER LANDS IN REG
	JRST	FACT2A
 
 
;SIGN NOTE AND EXIT
;COMPLEMENT SIGN IF "-" AND APPROPRIATE FLAGS ON PD LIST.
;THEN RETURN FROM SUBROUTINE.
 
SNOEXI: POP	P,X1
	TLNE	X1,F.MINS		;IS SAVED SIGN MINUS?
 
	TLC	B,MINFLG		;YES. COMPLEMENT
	POPJ	P,
 
 
;GEN CODE FOR SIGNED ATOM.
 
ATOM:	PUSH	P,C		;SAVE SIGN INFO.
	TLNE	C,F.PLUS	;EXPLICIT SIGN?
	JRST	ATOM1
	TLNN	C,F.MINS
	JRST	ATOM2
	PUSHJ	P,SETFNO	;CHECK LEGALITY
ATOM1:	PUSHJ	P,NXCHK 	;YES. SKIP SIGN
ATOM2:	TLNE	C,F.LETT	;LETTER?
	JRST	FLETTR		;YES. VARIABLE OR FCN CALL.
	TLNE	C,F.DIG+F.PER	;NUMERAL OR DECIMAL POINT?
	JRST	FNUMBR		;YES. LITERAL OCCURRENCE OF NUMBER
	TLNE	C,F.QUOT
	JRST	REGSLT		;STR CONSTANT.
	CAIE	C,"("		;SUBEXPRESSION?
	JRST	ILFORM		;NO.  ILLEGAL FORMULA
 
FSUBEX: PUSHJ	P,NXCHK 	;SUBEXPR IN PARENS.  SKIP PAREN
	MOVMS	LETSW		;CANNOT BE L. H.
	PUSHJ	P,FORMLU	;GEN THE SUBEXPRESSION
	TLNN	C,F.RPRN	;BETTER HAVE MATCHING PAREN
	JRST	ILFORM		;NO.  GRONK.
	PUSHJ	P,NXCHK 	;SKIP PARENTHESIS
	JRST	SNOEXI		;GO TEST SIGN AND RETURN.
 
 
;HERE WHEN ATOMIC FORMULA IS A NUMBER
 
FNUMBR:	PUSHJ	P,SETFNO	;CHECK LEGALITY
	MOVMS	LETSW
	PUSH	P,F
	SETZM	TYPE		;ASSUME REAL
	PUSHJ	P,EVANUM	;EVALUATE NUMBER (IN N)
	FAIL	<? Illegal constant>
	POP	P,F
	MOVE	X1,0(P) 	;GET SIGN FLAG
	CAIE	C,"^"		;EXPONENT FOLLOWS?
	TLNN	X1,F.MINS	;OR IS IT PLUS ANYWAY?
	JRST	FNUM1		;YES.  DONT FUDGE SIGN
	TLNN	C,F.STAR	;CHECK FOR OTHER KIND OF EXPONENT.
	JRST	FNUM5		;NO, NOT THIS KIND OF EXP EITHER.
	MOVEM	T,B
	PUSHJ	P,NXCH
	MOVE	T,B
	TLNE	C,F.STAR
	JRST	FNUM1		;YES, EXPONENT.
	MOVE	C,[XWD F.STAR,"*"]
FNUM5:	MOVN	N,N		;NEGATE NUMBER
	SETZM	0(P)		;AND CLEAR SIGN INFO.
 
 
FNUM1:	MOVE	B,FLCON ;SEARCH CONSTANT ROLL
FNUM2:	CAML	B,CECON ;(UNSORTED--CANT USE SEARCH)
	JRST	FNUM3		;NOT FOUND
	CAME	N,(B)		;THIS ONE?
	AOJA	B,FNUM2 	;NO. GO TO NEXT.
	SUB	B,FLCON ;FOUND. CALC REL ADDRESS IN CONROL.
	HRLI	B,CONROL
	JRST	SNOEXI
FNUM3:	MOVE	B,FLDON
FNUM3A:	CAML	B,CEDON
	JRST	FNUM3B
	CAME	N,(B)
	AOJA	B,FNUM3A
	SUB	B,FLDON
	JRST	FNUM4
FNUM3B:	MOVEI	R,DONROL	;PUSH ON CONROL
	MOVE	A,N
	PUSHJ	P,RPUSH
	MOVEI	R,CADROL	;PUT ADDRS ON CONST ADDRS ROLL
	MOVEI	A,0
	PUSHJ	P,RPUSH
	SUB	B,FLCAD 	;GET REL ADDRS
 
FNUM4:	HRLI	B,CADROL	;MAKE POINTER
	JRST	SNOEXI		;GO LOOK AT SIGN AND RETURN.
 
NNUM:	PUSH	P,[EXP 1]	;REGISTER THE CONSTANT IN "N"
	JRST	FNUM1
;ROUTINE TO EVALUATE NUMBER
;T: PNTR TO FIRST CHAR, C: FIRST CHAR
;NON-SKIP IS FAIL RETURN
;RETURN NUMBER IN N
 
 
;N: ACCUM NBMR, B: SCA FAC, D: DIG CNT, USE FLGS IN LEFT OF F
 
 
EVANUM: SETZB	N,B		;CLEAR ACS
	MOVEI	D,8
	MOVEI	F,(F)		;CLEAR LH OF F
 
 
	TLNE	C,F.PLUS	;SKIP +
	JRST	EVAN1
	TLNN	C,F.MINS	;CHECK FOR -
	JRST	EVAN2		;NO
	TLO	F,F.MIN 	;SET MINUS FLG
EVAN1:	PUSHJ	P,NXCH
EVAN2:	TLNN	C,F.DIG 	;DIGIT?
	JRST	EVAN3		;NO
 
 
	TLO	F,F.NUM 	;DIGIT SEEN FLAG
	JUMPE	N,EVAN2A	;DONT COUNT LEADING ZEROS
	SOJG	D,EVAN2A	;COUNT DIGIT,  GO ACCUM IF OK
;			REST OF DIGITS ARE INSIGNIFIGANT.
	AOJA	B,EVAN2B	;LEAD OR TRAIL 0, FUDGE SCA FAC
 
 
EVAN2A: IMULI	N,^D10		;ACCUMULATE DIGIT
	ADDI	N,-60(C)
EVAN2B: TLNE	F,F.DOT 	;DECIMAL SEEN?
	SUBI	B,1		;YES.  COUNT DOWN SCALE FACT
	JRST	EVAN1		;GO TO NEXT CHAR
 
 
EVAN3:	TLNN	C,F.PER 	;NOT DIGIT.  DEC PNT?
	JRST	EVAN4		;NO.
	TLOE	F,F.DOT 	;YES, SET FLG & CHK ONLY ONE
	POPJ	P,		;2 DEC PNTS
	JRST	EVAN1
 
 
EVAN4:	TLNN	F,F.NUM 	;DID WE SEE A DIGIT?
	POPJ	P,		;NO.  WHAT A LOUSY NUMBER
	MOVEI	X1,"E"
	CAIE	X1,(C)		;EXPLICIT SCALE FACTOR?
	JRST	EVAN8		;NO
	PUSH	P,T
	PUSH	P,C
EV2:	PUSHJ	P,NXCH		;DO LOOK AHEAD
	TLNE	C,F.PLUS	;SCALE FACTOR SIGN
	JRST	EVAN5
	TLNN	C,F.MINS
	JRST	EVAN6
	TLO	F,F.MXP
EVAN5:	PUSHJ	P,NXCH
EVAN6:	TLNN	C,F.DIG 	;CHK FOR DIGIT
	JRST	EVAN6A
	POP	P,A
	POP	P,A
	MOVEI	A,-60(C)	;SAVE FIRST EXPON DIGIT
EV4:	PUSHJ	P,NXCH
	TLNN	C,F.DIG 	;IS THERE A SECOND DIGIT
	JRST	EVAN7		;NO
	IMULI	A,^D10		;YES.  ACCUMULATE IT
	ADDI	A,-60(C)
EV5:	PUSHJ	P,NXCH		;DO LOOK AHEAD
 
 
EVAN7:	TLNE	F,F.MXP 	;NEG EXPON?
	MOVN	A,A		;YES.  NEGATE IT
	ADD	B,A		;ADD TO SCALE FACTOR
	JRST	EVAN8
EVAN6A:	POP	P,C
	POP	P,T
EVAN8:	JUMPN	B,EVAN8F
	TLNE	F,F.DOT
	JRST	EVAN8F
	CAME	C,[XWD F.STR,"%"] ;PERCENT
	JRST	EVAN9		;NO, CHECK PFLAG
	SETOM	PFLAG		;% SEEN
	PUSHJ	P,NXCH		;EAT THE %
EVAN9A:	SETOM	TYPE		;TYPE IS INTEGER
	JRST	CPOPJ1		;
EVAN9:	SKIPGE	PFLAG		;WAS A PERCENT SEEN?
	JRST	EVAN9A		;YES, THEN THIS IS INTEGER
EVAN8F:	JUMPE	N,CPOPJ1	;IGNORE SCALE IF NUMBER IS 0
EVAN8A: MOVE	X1,N		;)
	IDIVI	X1,^D10 	;)REMOVE ANY TRAILING ZEROS
	JUMPN	X2,EVAN8B	;)  IN MANTISSA.  (REASON:
	MOVE	N,X1		;)  SO THAT, E.G., .1,
	AOJA	B,EVAN8A	;)  .10, .100, ..., ARE THE SAME)
EVAN8B: TLO	N,233000	;FLOAT N
	FAD	N,[0]
	SETZM	LIBFLG		;CLEAR OVER/UNDERFLOW FLAG.
EVAN8C: CAIGE	B,^D15		;SCALE UP IF .GE. 10^15
	JRST	EVAN8D
	SUBI	B,^D14		;SUBTRACT 14 FROM SCALE FACTOR
	FMPR	N,D1E14 	;MULTIPLY BY 10^14
	JRST	EVAN8C		;GO LOOK AT SCALE AGAIN
EVAN8D: CAML	B,[EXP -^D4]	;SCALE DOWN IF .LT. 10^-4
	JRST	EVAN8E
 
 
	ADDI	B,^D18		;ADD 18 TO SCALE
	FMPR	N,D1EM18	;MULTIPLY BY 10^-18
	JRST	EVAN8D		;GO LOOK AT SCALE AGAIN
EVAN8E: FMPR	N,DECTAB(B)	;SCALE N
	TLNE	F,F.MIN 	;MINUS?
	MOVN	N,N		;YES.  NEGATE IT
	SKIPE	LIBFLG		;SKIP IF NO OVER/UNDERFLOW.
	JRST	CPOPJ
	JRST	CPOPJ1		;SUCCESS RETURN, NUMBER IN N

;FLAGS USED BY EVANUM

	F.NUM==200000		;DIGIT SEEN
	F.MIN==100000		;MINUS SEEN
	F.MXP==40000		;MINUS EXPONENT
	F.DOT==20000		;DECIMAL POINT SEEN
 
 
;XLATE AND GEN ATOMIC FORMULA BEGINNING WITH LETTER
 
FLETTR: PUSHJ	P,REGLTR
FLET1:	JRST	.+1(A)
	JRST	XARFET		;ARRAY REF
	JRST	SNOEXI		;SCALAR.  JUST RETURN
	JRST	XINFCN		;INTRINSIC FCN
	JRST	XDFFCN		;DEFINED FCN
	JRST	ILVAR
	JRST	XARFET		;STRING VECTOR. PROCESS WITH ARRAY CODE!
	JRST	SNOEXI		;POINTER IS IN B FOR BUILDING.
FLET2:	PUSH	P,[EXP 1]	;PUSH AN IMPLICIT PLUS SIGN ON PLIST
	JRST	FLET1		;FINISH REGISTERING VARIABLE.
 
XARFET: PUSH	P,A
	PUSH	P,B
	PUSH	P,TYPE		;SAVE TYPE OF ARRAY
	PUSHJ	P,REGFRE	;FREE REG
	PUSHJ	P,XARG
	JUMPG	F,XARF1 	;STRING VECTOR?
	SKIPL	LETSW		;NO, IS IT LH OF ARRAY-LET?
	JRST	XARF1		;DO A FETCH AS USUAL.
	TLNN	C,F.EQAL+F.COMA	;IS IT DEFINITELY LH OF ARRAY-LET?
	JRST	XARF1		;NO.
 
	POP	P,TYPE		;RESTORE THE TYPE
	POP	P,X1		;YES. DON'T FETCH! RETURN TO LH(LET)
	POP	P,A
	SUB	P,[XWD 10,10]	;ADJUST THE PUSHLIST TO ESC FORMLS
	MOVE	A,1(P)
	PUSH	P,B		;SAVE THE ARGUMENT FLAG
	SKIPGE	TYPE		;IS ARRAY INTEGER?
	TLO	X1,100000	;YES, MARK IT AS SUCH
	PUSH	P,X1		;SAVE THE ARRAY POINTER
	JRST	(A)
 
XARF1:	POP	P,TYPE		;RESTORE THE TYPE
	MOVSI	D,(ARFET1)
	JUMPL	F,XARF2		;STR VECTOR?
	MOVSI	D,(SVRADR)	;YES. FETCH STRING POINTER ADDRESS.
	HRRZ	X1,(P)		;OFFSET TO SVRROL
	MOVE	X2,FLOOR(F)	;FLOOR OF SVRROL
	ADD	X2,X1		;PLUS OFFSET
	MOVE	X1,(X2)		;GET FIRST ENTRY IN SVRROL
	TLNE	X1,(1B0)	;VIRTUAL STRING VECTOR
	TLNE	C,F.EQAL+F.COMA	;IS THIS A LH OF LET
	JRST	XARF2		;NOT VIRTUAL OR LH
	SETOM	AFLAG		;NO, MARK A FLAG
XARF2:	JUMPE	B,XARFFN
	SKIPGE	F
	MOVSI	D,(ARFET2)
	HRRZ	X1,0(P)		;MARK DOUBLE ARRAY
	ADD	X1,FLOOR(F)
	SKIPN	1(X1)
	SETOM	1(X1)
XARFFN: EXCH	B,0(P)
	PUSHJ	P,BUILDA
	POP	P,B
	PUSH	P,TYPE		;SAVE THE TYPE
	PUSHJ	P,GENARG
	POP	P,TYPE		;RESTORE THE TYPE
	MOVEI	B,0		;REG POINTER
	JUMPL	F,XALAB1	;STRING VECTOR?
	PUSHJ	P,SITGEN	;YES,SAVE ADDRESS POINTER
XALAB1:	POP	P,A
	JRST	SNOEXI
 
 
;GEN FUNCTION CALLS
 
XDFFCN:	PUSH	P,F		;SAVE FCN TYPE
	PUSH	P,D		;SAVE FCN NAME
	SETZ	D,		;BEGIN MASK AT ZERO
	PUSH	P,D		;SET UP ARGUMENT TYPE MASK
	PUSHJ	P,REGFRE	;SAVE ANY SUBEXPRESSION
	PUSHJ	P,PUSHPR	;SAVE FUNCTION LOCATION
	MOVE	D,[PUSHJ P,SAVACS]
	PUSHJ	P,BUILDI
	CAIE	C,"("		;ANY ARGS?
	JRST	XDFF2		;NO
	MOVEI	D,1		;SET UP FOR ARG BITS.
	PUSH	P,D		;SAVE IT
	SETZM	PSHPNT		;INITIALIZE COUNT OF PUSH INSTS GENNED
XDFF1:	SETZM	PFLAG		;CLEAR % SEEN FLAG
	PUSHJ	P,NXCHK
	PUSH	P,LETSW
	MOVMS	LETSW
	PUSHJ	P,FORMLB	;GEN THE ARGUMENT IN REG
	POP	P,LETSW		;RESTORE LET SWITCH
	POP	P,D		;GET BACK ARGUMENT BITS
	JUMPGE	F,XDFF1B	;STRING?
	SKIPL	TYPE		;NO, INTEGER?
	JRST	XDFF1A		;NO, MARK REAL
	IORM	D,(P)		;SET ONE BIT
	JRST	XDFF1B		;MARK SECOND BIT
XDFF1A:	IORM	D,(P)		;MARK REAL
	LSH	D,2		;SET FOR NEXT ARG
	JRST	XDFF1C		;AND CONTINUE
XDFF1B:	LSH	D,1		;SKIP A BIT
	IORM	D,(P)		;MARK IT
	LSH	D,1		;SET UP FOR NEXT ARG
XDFF1C:	SKIPN	D		;TOO MANY ARGUMENTS NOW
	FAIL	<? Too many function arguments>
	PUSH	P,D		;RESAVE
	SKIPGE	B		;IN REGISTER?
	PUSHJ	P,EIRGP1	;YES, TAKE IT OUT
	MOVSI	D,(PUSH Q,)	;BUILD ARGUMENT PUSH
	PUSHJ	P,BUILDA
	AOS	PSHPNT		;COUNT THE PUSH
	AOS	-2(P)		;ALSO SAVE THE COUNT FOR CHECK OF ARGS
	TLNE	C,F.COMA		;MORE ARGS?
	JRST	XDFF1		;YES
 
	TLNN	C,F.RPRN	;CHECK FOR MATCHING PAREN
	JRST	ERRPRN
	SETZM	PSHPNT		;RESET THE PUSH COUNT AGAIN
	PUSHJ	P,NXCHK 	;SKIP PAREN
	POP	P,X1		;DITCH ARGUMENT TYPE MASK BIT
XDFF2:	PUSHJ	P,ARGCHK	;CHECK FOR RIGHT NUMBER OF ARGUMENTS
	POP	P,X1		;GET RID OF ARGUMENT TYPE MASK
	POP	P,X1		;GET RID OF POINTER TO ARG# CONSTANT
	PUSHJ	P,POPPR 	;GET BACK FUNCTION LOC
	MOVSI	D,(GOSUB)
	PUSHJ	P,BUILDA	;GEN THE CALL
	MOVEI	B,0		;ANSWER IS IN REG
	POP	P,F		;RETURN FCN TYPE
	JRST	SNOEXI
 
;ROUTINE TO CHECK NUMBER OF ARGUMENTS AND CREATE A CONSTANT TO POP THEM
;OFF THE PUSH LIST.  CALLED WITH	XWD FCNAME,# OF ARGS
;AT LOCATION -1(P)	RETURNS WITH A POINTER TO CONSTANT
;AT THAT LOCATION.
 
ARGCHK:	MOVE	N,-1(P)		;AND THEIR TYPE MASK
	PUSHJ	P,NNUM		;REGISTER AS CONSTANT
	MOVE	N,-2(P)		;GET FCN NAME IN L.H.
	MOVEM	B,-2(P)		;AND SAVE CONSTANT ADDRESS
	HRR	N,B		;ASSEMBLE FADROL ENTRY...
	HLRZS	B		;CHECK FOR CONSTANT IN CONROL
	CAIE	B,CONROL	;IS IT?
	JRST	ARGCH0		;TOO BAD
	HLLZ	A,N		;SETUP SEARCH ARGUMENT
	MOVEI	R,FADROL	; XWD FCNAME,CONSTANT ADDRESS
	PUSHJ	P,SEARCH
	JRST	ARGCH1		;FIRST TIME FCN SEEN. PUT ENTRY IN ROLL
	CAMN	N,(B)		;FCN SEEN BEFORE. SAME NUMBER  OF ARGS?
	POPJ	P,
 
	SETZM	FUNAME
ARGCH0: FAIL	<? Incorrect number or type of arguments>
 
ARGCH1:	FAIL	<? Undefined symbol>
 
;INTRINSIC FUNCTION GENERATOR.
 
 
XINFCN:	PUSH	P,FTYPE		;SAVE TYPE OF SUBEXPRESSION
	PUSH	P,B		;SAVE FUNCTION LOC AND FLAGS
	PUSHJ	P,REGFRE	;PROTECT ANY PARTIAL RESULT
	MOVE	B,(P)		;GET THE FLAG BITS
	TLNN	B,777777	;INLINE CODE PRODUCER?
	JRST	XINF4		;YES, TYPED INTERNALLY
	TLNE	B,777		;ANY ARGUMENTS?
	JRST	XINF2		;YES, HANDLE ARGUMENTS
	CAIE	C,"("		;OPTIONAL ARGUMENT
	JRST	XINF1		;NO, SET TPE
	PUSHJ	P,NXCH		;EAT A "("
	PUSH	P,F		;SAVE F
	PUSHJ	P,FORMLB	;DO THE ARGUMENT
	POP	P,F		;RESTORE F
XINF0:	TLNN	C,F.RPRN	;ARGUMENT LIST ENDS WITH )
	JRST	ERRPRN		;IT DIDN'T
	PUSHJ	P,NXCH		;EAT THE )
XINF1:	POP	P,D		;GET FUNCTION LOC. AND FLAGS
	CLEARM	TYPE		;ASSUME FUNCTION TYPE IS NON-INTEGER
	TLNE	D,4000		;IS IT INTEGER?
	SETOM	TYPE		;YES, SET THE TYPE
	HRLI	D,(PUSHJ P,)	;GENERATE THE PUSHJ
XINF11:	PUSHJ	P,BUILDI	; DO THE INSTRUCTION
	CLEAR	B,		;CLEAR ADDRESS
	POP	P,FTYPE		;RESTORE PREVIOUS TYPE
	JRST	SNOEXI		;AND RETURN
;
;	HERE FOR FUNCTIONS WITH ARGUMENTS AND NO INLINE
;
XINF2:	CAIE	C,"("		;NEEDS ARGUMENTS
	JRST	ARGCH0		;NONE GIVEN
	PUSH	P,F		;SAVE TYPE OF SUBEXPRESSION
	SKIPGE	B		;HAS SPECIAL ARGUMENT BLOCK
	JRST	XINF21		;YES, HANDLE SEPARATELY
	LDB	X1,[POINT 9,B,17]; GET TYPE OF ARGUMENT
	SETOM	FTYPE		;ASSUME IT SHOULD BE INTEGER
	CAIE	X1,4		;SHOULD IT BE?
	CLEARM	FTYPE		;NO, SET FOR NON-INTEGER
	CAIE	X1,1		;SHOULD ARGUMENT BE A STRING?
	SETO	X1,		;NO, SET TYPE FOR NUMERIC
	HRL	F,X1		;SET TYPE FOR FORMLU
	MOVEI	X1,1		;ONE ARGUMENT NEEDED
	JRST	XINF22		;CODE THE FUNCTION
;
;	HERE FOR FUNCTIONS WITH SPECIAL ARGUMENT BLOCK
;
XINF21:	HLRZ	D,B		;ADDRESS OF ARG BLOCK
	MOVE	X1,(D)		;NUMBER OF ARGUMENTS TO EXPECT
	CAIN	X1,3		;3? I. E. INSTR OR MID$
	JRST	XINF3		;YES, MIGHT BE TWO ARGUMENTS
XINF20:	HRLZ	F,1(D)		;GET ARGUMENT TYPE FOR FORMLU
	SETOM	FTYPE		;NUMERICS SHOULD ALWAYS BE INTEGER
;
XINF22:	PUSH	P,X1		;SAVE NUMBER OF ARGUMENTS
	PUSH	P,D		;AND FUNCTION LOC AND FLAGS
	PUSHJ	P,NXCH		;EAT THE SEPARATOR    , OR (
	PUSHJ	P,XFORMU	;GENERATE THE ARGUMENT
	PUSHJ	P,EIRGNP	;MAKE SURE ITS IN REG
	JUMPG	F,XINF23	;STRING ARGUMENT?
	MOVE	X1,FTYPE	;NO, CHECK THE TYPE
	CAME	X1,TYPE		;MATCHING?
	PUSHJ	P,CHKTYP	;NO, FIX OR FLOAT IT
	CAIA			;AND SKIP STRING CHECK
XINF23:	PUSHJ	P,MASCK1	;STORE ARGUMENT IN MASAPP
	POP	P,D		;BACK WITH FUNCTION LOC AND FLAGS
	POP	P,X1		;AND NUMBER OF ARGUMENTS
	SOJN	X1,XILAB1	;ALL ARGUMENTS PROCESSED
	POP	P,F		;YES, RESTORE SUBEXPRESSION TYPE
	JRST	XINF0		;AND FINISH UP
XILAB1:	TLNN	C,F.COMA	;NEED A COMMA
	JRST	ERCOMA		;NONE THERE
	AOJA	D,XINF20	;DO NEXT
XINF3:	SKIPG	1(D)
	JRST	XINF31
	PUSHJ	P,XINST1	;MID$.
	PUSHJ	P,XINNUM
	POP	P,F		;RESTORE F.
	CLEARM	TYPE		;MID$ IS REAL
	TLNN	C,F.COMA
	JRST	XINF0A
	MOVE	D,[PUSH P,N]
	PUSHJ	P,BUILDI
	PUSHJ	P,XINNM1
	HRLI	F,1		;RESTORE F.
	JRST	XINF01
XINF31: PUSHJ	P,NXCH		;INSTR.
	PUSHJ	P,CHKCOR	;CHECK CORE REQUIREMENTS
	PUSHJ	P,XFORMB
	PUSHJ	P,EIRGNP
	JUMPG	F,XINF34
	SKIPL	TYPE		;IS IT INTEGER
	PUSHJ	P,GENINT	;NO, FIX IT
	MOVE	D,[PUSH P,N]
	PUSHJ	P,BUILDI
	JRST	XINF32
XINF34:	PUSHJ	P,MASCK1	;HANDLE STRING EXPRESSION
	PUSHJ	P,XINSTR
	POP	P,F
	SETOM	TYPE		;INSTR IS INTEGER
	JRST	XINF0A
XINF32: PUSHJ	P,XINSTR
	PUSHJ	P,XINSTR
	POP	P,F
XINF01: TLNN	C,F.RPRN
	JRST	ERRPRN
	PUSHJ	P,NXCH
	POP	P,D
	HRRZI	D,(D)
	ADD	D,[PUSHJ P,3]
	SETOM	TYPE		;INSTR IS INTEGER
	JRST	XINF11
 
XINSTR: TLNN	C,F.COMA	;SUBR FOR STR ARG.
 
	JRST	ERCOMA
XINST1: PUSHJ	P,NXCH
	PJRST	MASCHK		;HANDLE STRING ARGUMENT
 
XINNUM: TLNN	C,F.COMA	;SUBR FOR NUMERIC ARGUMENT.
	JRST	ERCOMA
XINNM1: PUSHJ	P,NXCH
	PUSHJ	P,XFORMN
	JRST	CHKINN		;CHECK TYPE
XINF0A:	TLNN	C,F.RPRN
	JRST	ERRPRN
	PUSHJ	P,NXCH
	POP	P,D
	HRLI	D,(PUSHJ P,)
	JRST	XINF11
 
XINF4:	POP	P,B
	POP	P,FTYPE		;RESTORE FTYPE
	JRST	.(B)		;IN LINE CODE.
	JRST	ABSBI
	JRST	ASCBI
	JRST	CRTBI
	JRST	DETBI
	JRST	FLTBI
	JRST	LLBI
	JRST	LOCBI
	JRST	LOFBI
	JRST	NUMBI
	JRST	PIBI
	JRST	SGNBI
	JRST	TIMBI
 
 
;IN LINE FUNCTION GENERATORS.
 
ABSBI:	CAIE	C,"("		;ABS FUNCTION.
	JRST	ARGCH0
	PUSHJ	P,NXCH
	PUSHJ	P,XFORMN
	PUSHJ	P,EIRGNM
	TLNN	C,F.RPRN
	JRST	ERRPRN
	JRST	INLIO2
INLIOU: TLNN	C,F.RPRN
	JRST	ERRPRN
INLIO0: PUSHJ	P,BUILDI
INLIO2: PUSHJ	P,NXCH
INLIO1: MOVEI	B,0
	JRST	SNOEXI
 
 
ASCBI:	CAIE	C,"("		;ASC FUNCTION.
	JRST	ARGCH0
	SETZ	X2,
	PUSHJ	P,NXCHD
	TLNN	C,F.RPRN
	JRST	ASCB11
	PUSH	P,T
	PUSHJ	P,NXCH
	TLNN	C,F.RPRN
	JRST	ASCBI0
	POP	P,T
	JRST	ASCBI3
ASCB11: TLNN	C,F.SPTB
	JRST	ASCBI3
	MOVE	X1,C		;BLANKS AND TABS.
ASCBI1: PUSHJ	P,NXCHD 	;IF ONLY BLANKS ARE
	TLNE	C,F.RPRN	;PRESENT, THE ARG IS A
	JRST	ASCBI2		;BLANK.  IF ONLY BLANKS
	TLNE	C,F.CR		;AND TABS ARE PRESENT, THE
ASCBI0: FAIL	<? Illegal argument for ASC function> ;ARG IS
	TLNN	C,F.SPTB	;A TAB. O'E, THE BLANKS
	JRST	ASCBI3		;AND TABS ARE IGNORED.
	CAME	C,X1
	CAMN	C,X2
	JRST	ASCBI1
	MOVE	X2,C
	JRST	ASCBI1
ASCBI2: MOVE	C,X1
	JUMPE	X2,ASLAB1
	MOVE	C,[XWD F.SPTB,11]
ASLAB1:	PUSH	P,T
	HRRZ	A,C
	PUSHJ	P,NXCH
	TLNE	C,F.RPRN
	JRST	ASCB21
	POP	P,T
	ROT	A,-7
 
	JRST	ASCBI5
ASCB21: POP	P,T
	HRLZI	A,500000
	JRST	ASCBI5
 
ASCBI3: PUSHJ	P,SCNLT1
	TLNE	C,F.RPRN
	JRST	ASCBI5		;1 CHAR ARG.
	TLNE	C,F.TERM
	JRST	ILFORM
	PUSHJ	P,SCN2
	JUMP
	TLNE	C,F.RPRN
	JRST	ASCBI6		;2 CHAR CODE.
	TLNE	C,F.TERM
	JRST	ILFORM
	PUSHJ	P,SCN3
	JUMP
	TLNN	C,F.RPRN
	JRST	ERRPRN
	JRST	ASCBI6		;THREE CHAR CODE.
 
ASCBI5: PUSH	P,N		;SET UP IN LINE CODE.
	LDB	N,[POINT 7,A,6]
ASCB51:	HRR	D,N
	POP	P,N
ASCB52: HRLI	D,(MOVEI N,)
	SETOM	TYPE
	JRST	INLIO0		;EXIT.
 
ASCBI6: PUSH	P,N		;SEARCH.
	HLRZ	A,A
	MOVEI	X1,ASCFLO
	ADDI	X1,1
ASCBI7: HLRZ	X2,-1(X1)
	CAIN	A,(X2)
	JRST	ASCBI8
	HRRZ	X2,-1(X1)
	CAIN	A,(X2)
	JRST	ASCBI9
	CAIGE	X1,ASCCEI
	AOJA	X1,ASCBI7
	JRST	ASCBI0
ASCBI8: SUBI	X1,ASCFLO
	MOVEI	N,2(X1)
	CAIG	X1,^D10
	MOVEI	N,-1(X1)
	JRST	ASCB51
ASCBI9: SUBI	X1,ASCFLO
	MOVEI	N,22(X1)
	CAIN	X1,^D15
	MOVEI	N,^D127
	JRST	ASCB51
 
 
 
;TABLE OF CODES FOR THE ASC FUNCTION.
 
ASCFLO: SIXBIT	/NULDC3/
	SIXBIT	/SOHDC4/
	SIXBIT	/STXNAK/
	SIXBIT	/ETXSYN/
	SIXBIT	/EOTETB/
	SIXBIT	/ENQCAN/
	SIXBIT	/ACKEM /
	SIXBIT	/BELSUB/
	SIXBIT	/BS ESC/
	SIXBIT	/HT FS /
	SIXBIT	/CR GS /
	SIXBIT	/SO RS /
	SIXBIT	/SI US /
	SIXBIT	/DLESP /
	SIXBIT	/DC1DEL/
	SIXBIT	/DC2   /
ASCCEI:
 
 
;
;	CRT FUNCTION
;
CRTBI:	CAIE	C,"("		;CRT TAKES AN ARGUMENT
	JRST	ARGCH0		;BUT NONE GIVEN
	PUSHJ	P,NXCH		;EAT THE "("
	PUSHJ	P,XFORMN	;CRT NEEDS NUMERIC ARGUMENT
	PUSHJ	P,EIRGEN	;MOVE ARGUMENT VALUE INTO REG.
	SKIPGE	TYPE		;IS ARGUMENT INTEGER?
	JRST	CRTBI1		;YES, NO CONVERSION NEEDED
	MOVE	D,[PUSHJ P,FIXPNT] ;MUST FIX ARGUMENT
	PUSHJ	P,BUILDI	;DO IT
CRTBI1:	MOVE	D,[EXCH N,CRTVAL] ;SET CRTVAL, RETURN OLD VALUE
	SETOM	TYPE
	JRST	INLIOU		;GENERATE INSTRUC., CHECK FOR ")"
;
;	DET FUNCTION
;
DETBI:	CAIN	C,"("		;DET FUNCTION.
	JRST	ARGCH0		;NO ARGUMENTS
	MOVE	D,[MOVE N,DETER]
	SETZM	TYPE		;REAL FUNCTION
	PUSHJ	P,BUILDI
	JRST	INLIO1
FLTBI:	CAIE	C,"("		;NEEDS AN ARGUMENT
	JRST	ARGCH0		;NONE THERE
	PUSHJ	P,NXCHD		;EAT THE (
	PUSHJ	P,XFORMN	;GET NUMERIC ARGUMENT
	PUSHJ	P,EIRGEN	;MOVE TO REG
	MOVE	D,[PUSHJ P,FLTPNT] ;TO FLOAT
	SKIPL	TYPE		;IS IT ALREADY REAL?
	MOVSI	D,(JFCL)	;YES, DUMMY FLOAT
	JRST	INLIOU		;ALL DONE

LLBI:	CAIE	C,"("		;MUST HAVE ARG
	JRST	ARGCH0
	PUSHJ	P,NXCH
	PUSHJ	P,GETNUM	;GET IT
	FAIL	<? Illegal line reference>
	MOVE	D,N		;STASH NO
	HRLZ	A,N		;AND CHECK ITS VALIDITY
	MOVEI	R,LINROL
	PUSHJ	P,SEARCH
	FAIL	<? Undefined line number >,1
	HRLI	D,(MOVEI N,)	;GEN INST.
	SETOM	TYPE
	JRST	INLIOU		;AND GO AWAY
 
LOCBI:	SETZM	LOCLOF		;LOC FUNCTION.
LOCBI1: CAIE	C,"("		;LOF ENTERS HERE.
	JRST	ARGCH0
	PUSHJ	P,NXCH
	CAIN	C,":"
	PUSHJ	P,NXCH
	PUSHJ	P,GETCN0
	HRLZI	D,(MOVE X1,)
	PUSHJ	P,BUILDI
	MOVE	D,[SKIPGE X2,ACTBL-1(X1)]
	PUSHJ	P,BUILDI
	MOVE	D,[CAME X2,NEGONE]
	PUSHJ	P,BUILDI
	MOVE	D,[JRST FNMX0]
	PUSHJ	P,BUILDI
	MOVE	D,[MOVE N,POINT-1(X1)]
	SKIPE	LOCLOF
	MOVE	D,[MOVE N,LASREC-1(X1)]
	SETOM	TYPE
	JRST	INLIOU
 
LOFBI:	SETOM	LOCLOF		;LOF FUNCTION.
	JRST	LOCBI1
 
 
 
NUMBI:	CAIN	C,"("		;NUM FUNCTION.
	JRST	ARGCH0		;NO ARGUMENTS
	MOVE	D,[MOVE N,NUMRES]
	PUSHJ	P,BUILDI
	SETOM	TYPE
	JRST	INLIO1
 
PIBI:	SETZM	TYPE
	MOVE	D,[MOVE N,PIB]
	PUSHJ	P,BUILDI
	JRST	INLIO1
SGNBI:	CAIE	C,"("		;SGN FUNCTION.
	JRST	ARGCH0
	PUSHJ	P,NXCH
	PUSHJ	P,XFORMN
	PUSHJ	P,EIRGNP
	MOVSI	D,(SKIPE N)	;SIGN OF ZERO IS ZERO
	PUSHJ	P,BUILDI	;GENERATE INSTRUCTION TO DO SO
	MOVE	D,[PUSHJ P,SGNB##] ;CALL SGN FUNCTION
	SETOM	TYPE
	JRST	INLIOU
 
 
TIMBI:	MOVSI	D,(SETZ N,)	;TIM FUNCTION.
	PUSHJ	P,BUILDI
	MOVE	D,[RUNTIM N,]
	PUSHJ	P,BUILDI
	MOVE	D,[SUB N,BGNTIM]
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,EIFLOT]
	PUSHJ	P,BUILDI
	MOVE	D,[FDVRI N,212764]
	PUSHJ	P,BUILDI
	SETZM	TYPE
	JRST	INLIO1
;ROUTINE TO XLATE ARGUMENTS
;RETURNS WITH ARGS ON SEXROL.  B IS O IF ONE ARG, -1 IF TWO.
 
XARG:	PUSHJ	P,NXCHK 	;SKIP PARENTHESIS.
	PUSH	P,LETSW 	;SAVE LETSW WHILE TRANSL ARGS
	MOVMS	LETSW		;THE COMMA FOLLOWING AN ARG IS NOT LH(LET)!
	PUSH	P,F
	PUSHJ P,FORMLB
	JUMPL	F,XARG0
XARG3:	FAIL	<? Nested string vectors>
XARG0:	POP	P,F
	PUSHJ	P,GPOSNX
	PUSHJ	P,SITGEN
	PUSHJ	P,PUSHPR
	MOVEI	B,0
	TLNN	C,F.COMA	;COMMA FOLLOWS?
	JRST	XARG1		;NO. ONE ARG.
	PUSHJ	P,NXCHK 	;YES GEN AND SAVE SECOND ARG
	PUSH	P,F
	PUSHJ	P,FORMLB
	JUMPG	F,XARG3
	POP	P,F
	PUSHJ	P,GPOSNX
	PUSHJ	P,SITGEN
	PUSHJ	P,PUSHPR
	MOVNI	B,1		;DBL ARG FLAG
XARG1:	POP	P,LETSW 	;RESTORE LETSW
	TLNN	C,F.RPRN	;MUST HAVE PARENTHESIS
	JRST	ERRPRN
	JRST	NXCHK		;IT DOES. SKIP PAREN AND RETURN.
 
 
;ROUTINE TO GEN ARGUMENTS
 
GENARG: JUMPE	B,GENAFN	;ONE OR TWO ARGS?
GENAR0: PUSHJ	P,POPPR 	;TWO
	PUSHJ	P,EXCHG
	PUSHJ	P,GENAF1
 
GENAFN: PUSHJ	P,POPPR
GENAF1: MOVSI	D,(JUMP 2,)
	SKIPGE	TYPE		;REAL OR INTEGER
	TLZ	D,100		;INTEGER, CLEAR REAL BIT
	JRST	BUILDA
 
 
;ROUTINE TO ANALYZE NEXT ELEMENT
;CALL:	PUSHJ	P,REGLTR
;RETURNS ROLL PNTR IN B, CODE IN A
;CODE IS: 0-ARRAY, 1-SCALAR, 2-INTRINSIC FCN, 3-DEFINED FCN, 4-FAIL
;		5-STRING VECTOR, 6-STRING VARIABLE, 7-STRING LITERAL.
 
REGCLT:	TLNN	C,F.LETT	;IS IT A LETTER?
	JRST	ERLETT		;NO, GIVE NEED A LETTER ERROR
REGLTR: PUSHJ	P,SCNLT1	;LTR TO A, LEFT JUST 7 BIT
	HRRI	F,SCAROL	;ASSUME SCALAR
	TLNE	C,F.LETT	;ANOTHER LETTER?
	JRST	REGFCN		;YES.  GO LOOK FOR FCN REF
	PUSHJ	P,DIGIT		;ADD IN DIGIT IF ANY
	PUSHJ	P,DOLLAR	;STRING VARIABLE?
	JRST	REGSTR		;YES, REGISTER IT
	PUSHJ	P,PERCNT	;CHECK FOR PERCNT
	PUSHJ	P,SETFNO	;AND CHECK LEGALITY
	CAIN	C,"("		;POSSIBLE ARRAY
	JRST	REGARY		;YES, REGISTER ARRAY
 
;RETURN HERE IF REGARY SAYS NOT ARRAY
;RETURN HERE IF REGFCN SAYS FOLLOWED BY KEYWORD.
 
REGL1:	TLNE	A,1		;IS THIS A SCALAR?
	JRST	REGL1A		;NO. DON'T LOOK FOR FCN ARGUMENT
	MOVE	B,FLARG 	;IS THIS A FN ARG?
RELAB1:	CAML	B,CEARG 	;SEARCH UNORDERED ARGROL
	JRST	REGL1A		;NOT A FN ARG
	CAME	A,(B)
	AOJA	B,RELAB1	;TRY NEXT ROLL ENTRY.
 
	JRST	FARGRF		;YES
REGL1A: MOVEI	R,VARROL	;NO. SCALAR
	PUSHJ	P,SEARCH	;IN VARIABLE ROLL?
	FAIL	<? Undefined symbol>
	HRRZ	D,(B)		;YES.  GET PNTR TO SCAROL
 
;	B ::= REL LOC OF ROLL ENTRY
 
REGL3:	MOVE	B,D		;B ::= REL LOC OF ROLL ENTRY
 
	TLO	B,(F)		;MAKE ROLL POINTER AND SKIP
	JRST	REGSCA
 
;COME HERE ON REF TO FCN ROL
 
;CALCULATE ADDRESS OF THIS FUNCTION ARGUMENT.
FARGRF: SUB	B,CEARG ;NOW ADDRESS IS -NN FOR FIRST ARG, -1 FOR NNTH ARG, ETC
	HRLI	B,PSHROL
 
REGSCA: MOVEI	A,1		;CODE SAYS SCALAR
	POPJ	P,		;RETURN
 
SCAREG: HRRI	F,SCAROL	;REGISTER THE CONTENTS OF A AS SCALAR
	JRST	REGL1A
 
 
STRREG:	HRRI	F,VSPROL	;REGISTER AS STRING
	PUSHJ	P,REGL1A	;
	JRST	REGS1		;FIX TYPE CODE

REGARY:	HRRI	F,ARAROL	;NUMERICAL ARRAY GOES ON ARAROL
 
REGA1:	TLO	A,1		;MAKE ARRAY NAME DIFFERENT FROM SCALAR
	MOVEI	R,VARROL	;LOOK FOR VARIABLE NAME
	PUSHJ	P,SEARCH
	FAIL	<? Undefined array>
	HRRZ	D,(B)		;GET POINTER TO ARAROL
REGA3:	MOVE	B,D		;RECONSTRUCT PNTR
	ANDI	B,377777	;B := REL ADDRS IN ARRAY ROLL
	HRLI	B,(F)	;B := POINTER TO ENTRY ON ROLL
	MOVEI	A,0		;ARRAY CODE
	POPJ	P,
;SUBROUTINE TO REGISTER ARRAY NAME.
;(USED BY DIM,MAT)
 
ARRAY:	HRRI	F,ARAROL		;ASSUME ITS NOT A STRING
	TLNN	C,F.LETT
	JRST	REGFAL
	SETZM	TYPE		;ASSUME REAL
	PUSHJ	P,SCNLT1	;NAME TO A
	PUSHJ	P,DIGIT		;GET DIGIT IF ANY
	PUSHJ	P,DOLLAR	;DOLLAR FOLLOWS?
	JRST	ARRAY2		;YES, HANDLE STRING
	PUSHJ	P,PERCNT	;PERCENT?
ARRAY0:	PUSHJ	P,SETFNO	;CHECK FOR LEGALITY
	PUSHJ	P,REGARY	;FINISH REGISTERING
ARRAY1:	MOVE	X1,B		;SET DEFAULT TO 2-DIM ARRAY
	ADD	X1,FLOOR(F)
	SKIPN	1(X1)
	SETOM	1(X1)
	POPJ	P,
 
ARRAY2:	PUSHJ	P,SETFST	;MARK STRING IF LEGAL
	PUSHJ	P,REGSVR	;REGISTER STRING VECTOR
	JRST	ARRAY1		;SET DEFAULT, IF NECESSARY
 
VECTOR: PUSHJ	P,ARRAY 	;REGISTER VECTOR
	CAIE	A,5		;WAS A STRING REGISTERED?
	JUMPN	A,CPOPJ 	;WAS AN ARRAY REGISTERED?
	MOVE	X2,1(X1)
	JUMPG	X2,VELAB1	;EXPLICIT DIMENSION?
	MOVNI	X2,2		;NO.  CALL IT A VECTOR OF UNKNOWN DIM.
	MOVEM	X2,1(X1)
	POPJ	P,
VELAB1:	TLNE	X2,777776	;IS THIS A ROW VECTOR?
	TRNN	X2,777776	;OR A COLUMN VECTOR?
	POPJ	P,		;YES.
	FAIL <? Use vector, not array,>
 
REGSTR:	PUSHJ	P,SETFST	;MARK STRING IF LEGAL
	HRRI	F,VSPROL	;POINTER WILL GO ON VSPROL
	CAIN	C,"("		;IS IT A STRING VECTOR?
	JRST	REGSVR		;YES.
	PUSHJ	P,REGL1 	;REGISTER STRING.
	JRST	REGS1		;FIX VARIABLE TYPE CODE.
 
REGSLT: MOVMS	LETSW		;STR LIT.
	PUSHJ	P,SETFST	;MARK STRING IF LEGAL
	PUSHJ	P,NXCHD
	PUSH	P,C
	PUSH	P,T
	SETZ	A,
REGSL1: TLNE	C,F.QUOT	;COUNT CHARACTERS.
	JRST	REGSL2
	TLZN	C,F.CR	;<CR> OR <LF> ?
	JRST	RGSLX1		;NO
	CAIN	C,12		;<LF> ?
	SOSA	A		;YES, IGNORE
	JRST	ERQUOT		;NO
RGSLX1:	PUSHJ	P,NXCHD
	AOJA	A,REGSL1
REGSL2:	CAILE	A,^D132		;TOO LONG ?
	FAIL	<? String literal too long>
	MOVEI	E,4(A)
	MOVN	A,A
	HRLI	A,(A)
	MOVE	T,CEDLT
	SUB	T,FLDLT
	HRRI	A,(T)
	MOVEI	R,DITROL
	PUSH	P,E
	PUSHJ	P,RPUSH 	;PUSH POINTER ONTO LITERAL ROLL
	POP	P,E
	IDIVI	E,5
	JUMPE	E,REGSL3
	MOVEI	R,DLTROL	;SET UP SLTROL.
	PUSHJ	P,BUMPRL
REGSL3: POP	P,T
	POP	P,C
	TLZ	C,777777
	HRLI	B,440700
REGSL4: CAIN	C,42
	JRST	REGSL5
	CAIE	C,12		;SKIP <LF>
	IDPB	C,B
	ILDB	C,T
	JRST	REGSL4
REGSL5: PUSHJ	P,NXCH
	MOVEI	R,SADROL	;MOVE LITROL ADDRESS ON STR-LIT-ADR ROLL
	MOVEI	A,0
	PUSHJ	P,RPUSH
	SUB	B,FLSAD ;GET REL ADRESS
	HRLI	B,SADROL	;SET UP POINTER.
	MOVEI	A,7
	JRST	SNOEXI
 
REGSVR: HRRI	F,SVRROL	;REGISTER STRING VECTOR
 
	PUSHJ	P,REGA1 	;REGISTER AS AN ARRAY
 
REGS1:	CAIE	A,4		;DID REGISTRATION FAIL?
	ADDI	A,5		;NO. FIX TYPE CODE.
	POPJ	P,
DIGIT:	TLNN	C,F.DIG		;DIGIT FOLLOWS?
	POPJ	P,		;NO, RETURN
	DPB	C,[POINT 7,A,13] ;YES, STORE IT
	JRST	NXCH		;GET NEXT CHARACTER AND RETURN
DOLLAR:	TLNN	C,F.DOLL	;IS IT A $?
	AOSA	(P)		;NO, SKIP RETURN
	TLOA	A,10		;YES, MARK IT
	POPJ	P,		;RETURN
	SETZM	TYPE
	JRST	NXCHK		;GET NEXT CHARACTER AND RETURN
PERCNT:	SETZM	TYPE		;ASSUME REAL
	CAME	C,[XWD F.STR,"%"]
	POPJ	P,		;RETURN
	TLO	A,4		;YES, MARK IT
	SETOM	TYPE		;MARK AS INTEGER
	SETOM	PFLAG		;WE SAW A %
	JRST	NXCHK		;GET NEXT
 
;NOTE:	IF THE SAME VARIABLE NAME IS USED AS A SCALAR, ARRAY,
;	STRING VECTOR, AND STRING, IT WILL BE DISTINGUISHED IN "VARROL"
;	BY THE FOLLOWING 4-BIT ENDINGS:
;	SCALAR 0 OR 4;  ARRAY 1 OR 5;  STRING 10;  STRING VECTOR 11.
 
 
;TABLE OF MIDSTATEMENT KEYWORDS:
 
KWTBL:
KWAALL:
KWACIF: 			;COMBINED IF KEYWORDS
	ASCIZ	/AND/
	ASCIZ	/OR/
	ASCIZ	/IOR/
	ASCIZ	/XOR/
	ASCIZ	/EQV/
	ASCIZ	/IMP/
KWZCIF:
	ASCIZ	/THEN/
	ASCIZ	/GOTO/
KWAAMD:
	ASCIZ	/ELSE/
KWAFOR: 			;FOR STMT KEYWORDS
	ASCIZ	/TO/
	ASCIZ	/STEP/
	ASCIZ	/BY/
KWAMOD: 			;MODIFIER KEYWORDS
	ASCIZ	/WHILE/
	ASCIZ	/UNTIL/
KWZFOR: 			;END OF FOR KEYWORDS
	ASCIZ	/IF/
	ASCIZ	/UNLESS/
	ASCIZ	/FOR/
KWZMOD:
	ASCIZ	/USING/
KWAONG:
	ASCIZ	/GOSUB/
KWZAMD:
KWZALL:
KWTTOP:
 
;GENERATE SERVICE ROUTINE FOR VARIOUS KEYWORD SEARCHES
	DEFINE KWSBEG(U)
<	IRP U
<KWS'U:	PUSHJ	P,KWSTUP
	MOVEI	X1,KWA'U
	MOVEI	X2,KWZ'U-1
	JRST	KWDSR1 > >
 
	KWSBEG<ALL,CIF,FOR,MOD,AMD>
 
 
 
KWDSR1: PUSH	P,X2		;SAVE X2 FROM QST
	PUSHJ	P,QST		;LOOK FOR NEXT
	JRST	KWDSR2		;NOT THERE
	POP	P,X2		;RESTORE X2
	AOS	-4(P)		;FOUND, SKIP RETURN
	HRRZM	X1,KWDIND	;SAVE INDEX
	CAIN	X2,KWZALL-1	;SEARCHING ALL KEYWORDS ?
	JRST	KWDSR3		;YES, JUST RETURN
	POP	P,X2		;NO, THROW AWAY
	POP	P,X2		;CHAR & COUNTER
	JRST	KWDSR5		;TO CONTINUE SCAN
KWDSR3: POP	P,T		;RESTORE POINTER
	POP	P,C		;AND CHAR
KWDSR5: POP	P,X2		;X2
	POP	P,X1		;AND X1
	POPJ	P,		;RETURN
KWDSR2: POP	P,X2		;RESTORE X2
	MOVE	T,(P)		;GET BACK POINTER
	MOVE	C,-1(P) 	;AND CHAR
	CAIE	X2,(X1) 	;FINISHED ?
	AOJA	X1,KWDSR1	;NO, TRY AGAIN
	JRST	KWDSR3		;YES, GO BACK

KWSTUP:	EXCH	X1,(P)		;SAVE X1, GET RETURN ADDRESS
	PUSH	P,X2		;SAVE X2
	PUSH	P,C		;SAVE CHAR
	PUSH	P,T		;AND POINTER
	PUSH	P,X1		;AND RETURN ADDRESS
	PUSHJ	P,QSA		;WAS I FOR THERE
	ASCIZ	/IFOR/
	POPJ	P,		;NO, ALL CLEAR
	POP	P,X2		;YES, RECTIFY PDL
	JRST	KWDSR3		;AND IGNORE IT
 
;REGISTER FUNCTION NAME
;FIRST LETTER HAS BEEN SCANNED
 
 
;IT IS POSSIBLE THAT WE HAVE SCANNED A ONE-LETTER VARIABLE NAME
;FOLLOWED BY ONE OF THE KEYWORDS "TO" , "THEN", OR "STEP".
;FIRST WE LOOK AHEAD TO SEE IF THIS IS SO;
;IF IT IS WE GO BACK TO SCALAR CODE.
 
REGFCN:	PUSHJ	P,KWSALL	;LOOK FOR KEYWORDS
	JRST	REGFX1		;NONE FOUND
	PUSHJ	P,SETFNO	;CHECK NUMERIC LEGALITY
	JRST	REGL1
 
	XLIST
	LIST
REGFX1:
;HAVE DETERMINED THAT WE MUST BE SCANNING A FUNCTION NAME
;IF SYNTAX IS LEGAL.
 
;WE SCAN THE SECOND LETTER AND CHECK FOR
;INTRINSIC OR DEFINED FUNCTION.
 
	PUSHJ	P,SCNLT2
	JRST	REGFAL		;NOT A LETTER
	CAMN	A,[SIXBIT /FN/] ;DEFINED FUNCTION?
	JRST	REGDFN		;YES. GO REGISTER DEFINED NAME.
 
;HERE WE HAVE FN NAME NOT BEGINNING WITH "FN"
;LOOK FOR IT IN TABLE OF INTRINSIC FUNCTIONS.
 
	MOVE	X1,[POINT 6,A,11] ;CONSTRUCT WHOLE NAME.
	MOVEI	R,4
REGF4:	TLNN	C,F.LETT
	JRST	REGF5
REGF41:
	PUSHJ	P,KWSALL	;LOOK FOR KEYWORDS
	CAIA			;NONE
	JRST	REGF9		;FOUND
	TLNN	C,F.LCAS
	TRC	C,40
	IDPB	C,X1
 
	PUSHJ	P,NXCH
	SOJG	R,REGF4
REGF9:	PUSHJ	P,SETFNO	;CHECK NUMERIC LEGALITY
	JRST	REGF6
REGF5:	TLNN	C,F.DIG
	JRST	REGF51
	CAME	A,[SIXBIT/LOG   /]
	CAMN	A,[SIXBIT/LOG1  /]
	JRST	REGF41
REGF51: TLNN	C,F.DOLL
	JRST	REGF9
	PUSH	P,X1
	PUSHJ	P,CHKCOR
	POP	P,X1
REGF10: MOVEI	C,4	;$ IN SIXBIT.
	IDPB	C,X1
	PUSHJ	P,NXCH
	PUSHJ	P,SETFST	;CHECK STRING LEGALITY
REGF6:	CAMN	A,[SIXBIT/VAL   /]
	PUSHJ	P,CHKCOR
REGF0:	MOVEI	R,IFNFLO
REGF7:	CAMN	A,(R)
	JRST	REGF8		;FOUND FN.
	AOJ	R,
	CAIGE	R,IFNCEI
	JRST	REGF7
	JRST	REGFAL
REGF8:	SUBI	R,IFNFLO
	MOVE	B,IF2FLO(R)	;GET ENTRY IN 2ND TABLE.
	MOVMS	LETSW		;CAN'T BE LH(LET)
	MOVEI	A,2		;INTRINSIC FCN CODE.
	POPJ	P,		;RETURN "XINFCN" DOES ITS OWN ")" CHECK.
 
 
;HERE TO REGISTER DEFINED FUNCTION NAME
;THE "FN" HAS ALREADY BEEN SCANNED
 
;SCAN IDENTIFYING LETTER AND PUTTING ENTRY IN
;FUNCTION CALL ROLL
 
REGDFN:	PUSHJ	P,CHKCOR
REGDF0:	PUSHJ	P,SCNLT1	;PUT FUNCTION NAME IN A
	PUSHJ	P,DIGIT		;CHECK FOR A DIGIT
	PUSHJ	P,PERCNT	;CHECK FOR A PERCENT
	TLNE	A,4		;NO DOLLAR POSSIBLE IF PERCNT
	JRST	REGDF1		;
	PUSHJ	P,DOLLAR	;DOLLAR THERE
	PUSHJ	P,[AOS  (P)	;YES
		   JRST SETFST]	;REGISTER STRING IF LEGAL
REGDF1:	PUSHJ	P,SETFNO	;MARK NUMERIC IF LEGAL
	MOVE	D,A		;NO, REAL FUNCTION CALL.  SAVE NAME FOR ARGCHK
	MOVMS	LETSW
	MOVEI	R,FCNROL	;FUNCTION CALL ROLL
	PUSHJ	P,SEARCH	;USED THIS ONE YET?
	FAIL	<? Undefined function>
REGFC1: SUB	B,FLOOR(R)
	HRLI	B,FCNROL
	MOVEI	A,3		;DEFINED FCN CODE
	POPJ	P,		;DON'T CHECK FOR () YET
 
CHKPRN: CAIE	C,"("
REGFAL: MOVEI	A,4		;FAIL IF NO PAREN
	POPJ	P,
 
 
 
 
	SUBTTL	SUBROUTINES USED BY GEN ROUTINES
 
;SETFNO  - SET PARTIAL RESULT NUMERIC IF LEGAL
SETFNO:	SKIPGE	F		;RETURN IF NUMERIC ALREADY
	POPJ	P,		;
	TLOE	F,-1		;SET NUMERIC, ANY OTHER BITS SET?
SETFER:	FAIL	<? Mixed strings and numbers>
	POPJ	P,
;SETFST - SET PARTIAL RESULT STRING IF LEGAL
SETFST:	JUMPL	F,SETFER	;CAN'T - NUMERIC SPECIFIED
	HRLI	F,1		;MARK STRING
	SETZM	TYPE
	POPJ	P,		;RETURN
;PUSHPR - PUSH PARTIAL RESULT ON SEXROL
 
PUSHPR: MOVEI	R,SEXROL
	MOVE	A,B		;SAVE POINTER IN A
	SKIPGE	TYPE		;REAL OR INTEGER?
	TLO	A,100000	;INTEGER
	PUSHJ	P,RPUSH
	SUB	B,FLSEX ;MAKE POINTER
	TLZ	A,100000	;
	TLNN	A,ROLMSK	;IS IT A POINTER TO REG?
	HRROM	B,REGPNT	;YES, SET POINTER FOR SITGEN TO USE
	POPJ	P,
 
;POPPR - POP PARTIAL RESULT FROM SEXROL
 
POPPR:	MOVEI	R,SEXROL
	MOVE	B,CESEX
	SUBI	B,1		;COMPUTE ADDRS OF TOP OF SEXROL
	PUSH	P,(B)		;SAVE THE CONTENT
	MOVEI	E,1
	PUSHJ	P,CLOSUP
	POP	P,B		;POPPED POINTER TO B
	CLEARM	TYPE		;
	TLZE	B,100000	;
	SETOM	TYPE		;
POPPFN: TLNN	B,ROLMSK	;POINTER TO REG?
	SETZM	REGPNT		;YES.  CLEAR MEMORY
	POPJ	P,
;EXCHG - EXCHANGE CURRENT PNTR WITH TOP OF SEXROL
 
EXCHG:	MOVE	X1,CESEX
	MOVEI	X2,-1(X1)	;FIX PNTR IF REG SAVED
	SUB	X2,FLSEX
	TLNN	B,ROLMSK
	HRROM	X2,REGPNT
	SKIPGE	TYPE		;IS IT AN INTEGER
	TLO	B,100000	;YES MARK IT
	EXCH	B,-1(X1)
	CLEARM	TYPE		;ASSUME REAL
	TLZE	B,100000	;IS IT AN INTEGER
	SETOM	TYPE		;YES, SET THE TYPE
	JRST	POPPFN		;GO FIX PNTR IF REG POPPED
 
;REGFRE - GUARANTEE THAT NO PART RESULT IS IN REG
 
REGFRE: SKIPN	REGPNT	;SUBEXP IN THE REG?
	POPJ	P,		;NO
	MOVE	X1,FLSEX	;YES.  COMPUTE WHERE
	ADD	X1,REGPNT
	EXCH	B,(X1)		;GET THE POINTER, SAVE CURR PNTR
	PUSH	P,TYPE		;SAVE THE TYPE
	CLEARM	TYPE		;ASSUME REAL
	TLZE	B,100000	;IS IT AN INTEGER
	SETOM	TYPE		;YES, REMEMBER IT
	PUSHJ	P,SITGEN	;STORE IN TEMP
	MOVE	X1,FLSEX	;RECOMPUTE LOC IN SEXROL
	ADD	X1,REGPNT
	SKIPGE	TYPE		;IS IT AN INTEGER
	TLO	B,100000	;YES, MARK IT
	POP	P,TYPE		;RESTORE OLD TYPE
	EXCH	B,(X1)
	SETZM	REGPNT		;CLOBBER REGPNT SINCE REG IS EMPTY
	POPJ	P,
 
 
;GPOSGE - GUARANTEE POSITIVE GEN
 
GPOSGE: JUMPGE	B,CPOPJ 	;RETURN IF ALREADY POSITIVE
				;FALL INTO EIRGEN
 
;EIRGEN - EXP IN REG GEN
 
EIRGEN: TLNN	B,ROLMSK	;ALREADY IN REG?
	POPJ	P,		;DO NOTHING
ERGNFN: PUSHJ	P,REGFRE	;FREE UP REG
	MOVSI	D,(MOVE N,)	;GET MOVE INSTR
EIRGM2: PUSHJ	P,BUILDS	;BUILD MOVE INSTR
	MOVEI	B,0		;POSITIVE REG POINTER
	POPJ	P,
 
;EIRGNP - EXP IN REG GEN POSITIVE
 
EIRGNP: JUMPGE	B,EIRGEN	;POSITIVE?
EIRGP1: TLNE	B,ROLMSK	;NO. IN REG?
	JRST	ERGNFN		;NO.  GO MOVE
	MOVSI	D,(MOVN N,)	;YES,NEGATIVE N
EIRGM3: PUSHJ	P,BUILDI
	MOVEI	B,0		;POSITIVE REG PNTR
	POPJ	P,
 
;EIRGNM -- GEN MAG.
EIRGNM: TLNN	B,ROLMSK
	JRST	EIRGM1
	TLZ	B,400000
	PUSHJ	P,REGFRE
	MOVSI	D,(MOVM N,)
	JRST	EIRGM2
EIRGM1: MOVSI	D,(MOVM N,)
	JRST	EIRGM3
 
;SIPGEN - STORE IN PERMANENT TEM GEN
 
SIPGEN: MOVEI	R,DPTROL
	JRST	SITGN1
 
;SITGEN - STORE IN TEMP GEN
 
SITGEN: MOVEI	R,DTPROL
SITGN1: TLNE	B,ROLMSK	;IS EXPR IN REG?
	POPJ	P,		;NO.  DONT DO ANYTHING
	MOVEI	A,0		;PREPARE ZERO TO PUSH ON ROLL
	MOVSI	D,(MOVEM N,)	;GET CORRECT INSTR
	JUMPGE	B,SILAB1
	MOVSI	D,(MOVNM N,)
SILAB1:	CAIE	R,DTPROL	;STORE ON TMPROL?
	JRST	SITG2		;NO. USE PTMROL
	AOS	B,TMPPNT	;WHICH TEMP TO USE?
	MOVE	X1,FLDTP
	ADD	X1,B
	CAML	X1,CEDTP	;NEED MORE TMP SPACE?
 
	PUSHJ	P,RPUSH ;YES.  PUSH A ZERO ONTO TMPROL
	MOVE	B,TMPPNT	;CONSTRUCT TMP ROLL POINTER
SITG1:	HRLI	B,(R)
	PUSH	P,B	;SAVE ADRESS POINTER
	PUSHJ	P,BUILDA	;BUILD STORE INSTR
	POP	P,B		;RECONSTRUCT POINTER
	POPJ	P,
 
SITG2:	PUSHJ	P,RPUSH 	;PUSH A ZERO ONTO PTMROL
	SUB	B,FLDPT
	JRST	SITG1		;FINISH CONSTRUCTING ADRESS POINTER
	SUBTTL UTILITY SUBROUTINES
 
;ROUTINE TO QSA FOR "THEN" OR "GOTO" (USED IN "IF", "ON" STATEMENTS)
THENGO: PUSHJ	P,QSA
	ASCIZ /THE/
	JRST	THGOTS
	MOVEM	T,MULLIN	;SET MULTI-LINE
	PUSHJ	P,QSA
	ASCIZ	/N/
	JRST	THGERR		;BAD SPELLING !
	TLNE	C,F.TERM
	JRST	THGERR
	POPJ	P,
THGOTS: PUSHJ	P,QSA
	ASCIZ /GOTO/
THGERR:	FAIL <? Illegal format where the words THEN or GO TO were expected>
	TLNE	C,F.DIG 	;DIGIT FOLLOWS ?
	POPJ	P,
	PUSHJ	P,QSA
	ASCIZ	/BASDDT/
	JRST	ERDIGQ
	JRST	XBAS+1
 
;ERROR RETURNS
 
ILFORM: FAIL	<? Illegal formula>
ILVAR:	FAIL	<? Illegal variable>
GRONK:	FAIL	<? Illegal format>
 
 
;COMPILATION ERROR MESSAGES OF THE FORM:
;	? A &1 WAS SEEN WHERE A &2 WAS EXPECTED
;WHERE &1 AND &2 ARE APPROPRIATE MESSAGES OR CHARACTERS.
 
ERCHAN: PUSHJ	P,FALCHR
	ASCIZ	/# or :/
ERNMSN: PUSHJ	P,FALCHR
	ASCIZ	/#/
ERDLPQ: PUSHJ	P,FALCHR
	ASCIZ	/$ or % or "/
ERQUOT: PUSHJ	P,FALCHR
	ASCIZ	/"/
ERDIGQ: PUSHJ	P,FALCHR
	ASCIZ	/a digit or "/
ERTERM: PUSHJ	P,FALCHR
	ASCIZ	/a line terminator or apostrophe/
ERLETT: PUSHJ	P,FALCHR
	ASCIZ	/a letter/
ERLPRN: PUSHJ	P,FALCHR
	ASCIZ	/(/
ERRPRN: PUSHJ	P,FALCHR
	ASCIZ	/)/
EREQAL: PUSHJ	P,FALCHR
	ASCIZ	/=/
ERCOMA: PUSHJ	P,FALCHR
	ASCIZ	/,/
ERSCCM: PUSHJ	P,FALCHR
	ASCIZ	/; or ,/
ERCLCM: PUSHJ	P,FALCHR
 
	ASCIZ	/: or ,/
 
FALCHR: PUSH	P,C
	PUSHJ	P,INLMES
	ASCIZ	/
/
FAL1:	PUSHJ	P,INLMES
	ASCIZ	/? /
	POP	P,C
	MOVEI	C,(C)
	CAIE	C,11
	CAIN	C,40
	JRST	FALSPT
	CAIL	C,12
	CAILE	C,15
	JRST	FALAB1
	JRST	FALFF
FALAB1:	CAIL	C,41
	CAILE	C,172
	JRST	FALNON
	PUSHJ	P,OUCH
	JRST	FAL2
FALNON: PUSHJ	P,INLMES
	ASCIZ	/A non-printing character/
	JRST	FAL2
FALFF:	PUSHJ	P,INLMES
	ASCIZ	/A FF,LF,VT, or CR/
	JRST	FAL2
FALSPT: PUSHJ	P,INLMES
	ASCIZ	/A space or tab/
FAL2:	PUSHJ	P,INLMES
	ASCIZ	/ was seen where /
	MOVE	T,(P)
	PUSH	P,ODF
	SETZM	ODF
	SETZ	D,
	PUSHJ	P,PRINT 	;PRINT EXPECTED CHAR OR MESSAGE.
	POP	P,ODF
	SETZM	HPOS
	POP	P,T		;CLEAN UP PLIST.
 
	PUSHJ	P,INLMES
	ASCIZ	/ was expected/
	JRST	NXTST3
 
;QUOTE SCAN OR FAIL
;CALL WITH INLINE PATTERN
;GO TO GRONK IF NO MATCH
 
QSF:	POP	P,X1
	PUSHJ	P,QST
	JRST	GRONK
	JRST	1(X1)
 
 
CMIXM:	MOVE	X1,CESEX	;PEEK AT FIRST OPERAND
	MOVE	X2,-1(X1)	;ITS ADDRESS
	SKIPL	TYPE		;
	JRST	CMIXM2		;NO, CHECK SECOND OPERAND
	TLZE	X2,100000	;IS SECOND OPERAND INTEGER?
	POPJ	P,		;YES, NO CONVERSION
	TLNE	X2,ROLMSK	;IS THE REGISTER FREE
	JRST	CMIXM1		;YES, USE IT
CMIXM3:	PUSH	P,B		;SAVE B
	PUSHJ	P,REGFRE	;FREE THE REGISTER
	POP	P,B		;GIVE US B
CMIXM1:	PUSHJ	P,EIRGEN	;GET THE OPERAND
	SETZM	TYPE		;MAKE TYPE REAL
	PUSH	P,B		;SAVE SIGN INFO
	MOVE	D,[PUSHJ P,FLTPNT] ;
	PUSHJ	P,BUILDI	;MUST FLOAT IT
	POP	P,B		;RETURN SIGN INFO
	AND	D,[XWD MINFLG,0] ;JUST RETURN SIGN
	POPJ	P,		;AND RETURN
CMIXM2:	TLZN	X2,100000	;IS SECOND OPERAND INTEGER
	POPJ	P,		;YES, NOTHING TO DO
	TLNN	B,ROLMSK	;IS REGISTER FREE
	PUSHJ	P,SITGEN	;STORE IT IN TEMP
	PUSHJ	P,EXCHG		;EXCHANGE REGISTERS
	JRST	CMIXM1		;NOW FLOAT IT

CMIXER:	MOVE	X1,TYPE		;GET THE TYPE
	CAMN	X1,FTYPE	;A MATCH?
	POPJ	P,		;YES, RETURN
CHKTYP:	MOVE	D,[PUSHJ P,FIXPNT]
	SKIPL	FTYPE		;
	HRRI	D,FLTPNT	;
	PJRST	BUILDI		;
CHKINN:	PUSHJ	P,EIRGNP
	CAIA
CHKINT:	PUSHJ	P,EIRGEN
CHKIN1:	SKIPGE	TYPE		;IS IT AN INTEGER?
	JRST	CHKIN2		;YES, NOTHING TO DO
GENINT:	MOVE	D,[PUSHJ P,FIXPNT] ;NO, FIX IT
	PUSHJ	P,BUILDI	;OUT WITH IT
	SETOM	TYPE		;SET TYPE TO INTEGER
CHKIN2:	CLEAR	B,		;CLEAR B
	POPJ	P,		;RETURN
;ROUTINES TO GENERATE CODE FOR THE CHANNEL SPECIFIER.
 
GETCNB:	PUSHJ	P,NXCH
GETCNC:	PUSHJ	P,GETCN2
CHKDL1:	TLNN	C,F.COMA
	CAIN	C,":"
	PJRST	NXCH
	JRST	ERCLCM
GETCN0: PUSHJ	P,FORMLN
	PUSHJ	P,EIRGNP
	PUSHJ	P,CHKINT	;
	MOVSI	D,(CAILE N,)
	PUSHJ	P,BUILDI
	HRRI	D,9
	PUSHJ	P,BUILDI
	MOVE	D,[JRST CNER1]
	JRST	BUILDI
 
GETCNA: PUSHJ	P,NXCH
GETCN2: PUSHJ	P,GETCN0
	MOVE	D,[MOVE LP,N]
	JRST	BUILDI
CHKDEL:	TLNN	C,F.COMA
	CAIN	C,";"
	PJRST	NXCH
	JRST	NXTSTA
GENTYP:	HRLI	D,(SKIPN (16))
	PUSHJ	P,BUILDI
	HRLI	D,(SETOM (16))
	SKIPN	WRREFL
	HRLI	D,(AOS (16))
	PUSHJ	P,BUILDI
	HRLI	D,(SKIPL (16))
	SKIPN	WRREFL
	HRLI	D,(SKIPG (16))
	PJRST	BUILDI
GENTP1:	CAIN	C,":"
	PUSHJ	P,NXCH
	PUSHJ	P,GETCNC
	MOVE	D,[SKIPL ACTBL-1(LP)]
	PUSHJ	P,BUILDI
	MOVE	D,[JRST FNMXER]
	PJRST	BUILDI
CHKCOR:	SKIPGE	VRFSET
CHKCR1:	SKIPE	FUNAME
	POPJ	P,
	CLEARM	VRFSET
	MOVE	D,[PUSHJ P,SETCOR]
	PJRST	BUILDI
MASCHK:	PUSHJ	P,FORMLS	;GEN STRING EXPRESSION IN REG
	PUSHJ	P,EIRGNP	;CHECK REG
MASCK1:	MOVE	D,[PUSHJ P,MASTST]
	PUSHJ	P,BUILDI
	MOVE	D,[AOS T,MASAPP] ;
	PUSHJ	P,BUILDI
	MOVE	D,[MOVEM N,(T)]
	PJRST	BUILDI

GETLIN:	PUSHJ	P,GETNUM	;GET A LINE NUMBER
	FAIL	<? Illegal line reference>
	HRLZ	A,N		;IS IT DEFINED?
	MOVEI	R,LINROL	;DON'T KNOW, SEARCH LINROL
	PUSHJ	P,SEARCH	;WELL, IS IT?
	FAIL	<? Undefined line number>
	SUB	B,FLLIN		;FIND POSTION IN LADROL
	ADD	B,FLLAD		;THIS IS IT
	HLRZ	A,(B)		;GET REL CODE ADDRESS
	ADD	A,FLCOD		;ADD START OF REL CODE
	POPJ	P,		;RETURN

;GPOSNX - GUARANTEE POSITIVE AND UNINDEXED GEN
 
GPOSNX: TLNE	B,400000+PSHROL ;NEGATIVE OR INDEXED BY (P)?
	PUSHJ	P,EIRGNP	;YES. FORCE INTO REG
	POPJ	P,
 
 
BUILDP: TLO	D,Q		;INSTRUCTION IS INDEXED BY PLIST POINTER
	SUB	B,PSHPNT	;ADJUST THE ADDRESS FOR ANY PUSH INSTS GENNED BY
	ADDI	B,1
	HRR	D,B		;A CURRENT FN CALL
 
;ROUTINE TO ADD CODE TO CODROL.
;A WORD IS ASSUMED IN D
;RETURN REL ADDRS IN B
 
BUILDI:	MOVE	B,DDCODE
	CAMLE	B,FLSEX
	FAIL	<? Not enough room>
	AOS	DDCODE
	MOVEM	D,(B)
	SUB	B,DDTCOD
	POPJ	P,
 
 
;BUILD SIGNED INSTRUCTION WITH ADDRESS
;CHECK SIGN IN B AND CHANGE UP CODE BITS
 
BUILDS: JUMPGE	B,BUILDA	;POSITIVE?
	TLC	D,010000	;NO.  CHANGE MOVE TO MOVN,ETC.
				;FALL INTO BUILDA
 
 
;BUILDA - BUILD INSTRUCTION WITH LINKED ADDRESS
;INSTRUCTION SKELETON IS IN D, ADDRESS POINTER IS IN B
 
BUILDA:	TLZE	B,PSHROL		;SPECIAL TEST FOR ROLL WITH ABSOLUTE ADDRESSES
	JRST	BUILDP		;YES, PSHROL. DO BUILDI INDEXED BY (Q)
	TLZ	B,400000
	JUMPE	B,BUILDI	;ITEM IS IN REG . USE ADDRESS ZERO
	PUSH	P,B		;SAVE THE POINTER
	PUSHJ	P,BUILDI	;ADD INSTR WITH 0 ADDRS TO CODE
	MOVE	X1,DDCODE	;LOC+1 OF THE INSTR
	POP	P,X2		;COMPUTE ADDRS LOCATION
	LDB	R,[POINT 17,X2,17]
	ADD	X2,FLOOR(R)
	JRST	.-6(R)
	DEFINE	JRSTBL(A),<
	XLIST
	JRST	BLD'A
	LIST
>
	JRSTBL	CON
	HALT
	HALT
	JRSTBL	ARA
	JRSTBL	SVR
	HALT
	HALT
	JRSTBL	SCA
	JRSTBL	VSP
	HALT
	JRSTBL	TMP
	HALT
	HALT
	JRSTBL	VAR
	HALT
	HALT
	JRSTBL	FCN
	HALT
	HALT
	JRSTBL	CAD
	JRSTBL	LAD
	JRSTBL	SAD
	HALT
	HALT
	JRSTBL	DON
	JRSTBL	DLT
	JRSTBL	DIT
	JRSTBL	DPT
	JRSTBL	DTP
BLDDON:
BLDTMP:
BLDSCA:
BLDVSP:
BLDSVR:
BLDARA:
BLDVAR:
BLDCON:	HRRM	X2,-1(X1)
	POPJ	P,
BLDFCN:	HRRZ	B,(X2)
	ADD	B,FLCOD
	HRRM	B,-1(X1)
	POPJ	P,
BLDLAD:	HLRZ	A,(X2)
	ADD	A,FLCOD
	HRRM	A,-1(X1)
	POPJ	P,
BLDDLT:
BLDDIT:
BLDDPT:
BLDDTP:
BLDSAD:
BLDCAD:	MOVE	R,(X2)
	HRRM	R,-1(X1)
	SUB	X1,DDTCOD
	SUBI	X1,1
	HRRM	X1,(X2)
	POPJ	P,

PCRLF:	PUSH	P,C
	MOVEI	C,15
	PUSHJ	P,OUCH
	MOVEI	C,12
	PUSHJ	P,OUCH
	OUTPUT
	POP	P,C
	POPJ	P,

;SUBROUTINES FOR GENERAL ROLL MANIPULATION
 
CLOSUP: MOVN	X1,E		;COMPUTE NEW END OF ROLL
	ADDB	X1,CEIL(R)	;AND STORE IT
	MOVE	X2,B		;CONSTRUCT BLT WORD
	ADD	X2,E
	MOVS	X2,X2
	HRR	X2,B
	BLT	X2,-1(X1)	;MOVE DOWN TOP OF ROLL
	POPJ	P,
 
OPEN2:	MOVE	X2,E		;IS THERE ROOM ABOVE THIS STODGY ROLL?
	ADD	X2,CEIL(R)	;THE NEW CEILING
	CAMLE	X2,FLOOR+1(R)
	JRST	OPENU0		;NO ROOM, PACK OTHER ROLLS UP
	ADDM	E,CEIL(R)	;THERE IS ROOM, INCREMENT CEILING
	POPJ	P,
 
OPENU0: SUB	B,FLOOR(R)
	PUSHJ	P,PANIC
	ADD	B,FLOOR(R)
 
OPENUP: CAMG	R,TOPSTG	;OPEN UP THE TOP STODGY ROLL?
	JRST	OPEN2		;YES. OPEN UPWARDS, NOT DOWN
	MOVN	X2,E
	MOVE	X1,TOPSTG	;DO NOT MOVE STODGY ROLLS
	ADD	X2,FLOOR+1(X1)
	CAMGE	X2,CEIL+0(X1)
	JRST	OPENU0		;NEED MORE ROOM
	HRL	X2,FLOOR+1(X1)	;CONSTRUCT BLT WORD
	SUB	B,E		;FIRST WORD OF GAP
	BLT	X2,-1(B)	;MOVE ROLLS DOWN
 
	MOVEI	X1,1(X1)	;ADJUST POINTERS FOR ROLLS JUST BLT'D.
	MOVN	X2,E
OPEN1:	ADDM	X2,FLOOR(X1)
	CAML	X1,R
	POPJ	P,
	ADDM	X2,CEIL(X1)
	AOJA	X1,OPEN1
 
 
;RPUSH - PUSH A ON TOP OF DESIGNATED ROLL
 
RPUSH:	MOVEI	E,1
	PUSHJ	P,BUMPRL	;MAKE ROOM
 
	MOVEM	A,(B)		;STORE WORD
	POPJ	P,
 
;ROUTINE TO ADD TO END OF ROLL
;E CONTAINS SIZE, R CONTAINS ROLL NUMBER
 
BUMPRL: MOVE	B,CEIL(R)
	ADD	B,E
	CAIE	R,ROLTOP
	SKIPA	X1,FLOOR+1(R)
	HRRZ	X1,.JBREL
	CAMLE	B,X1
	JRST	BUMP1
	EXCH	B,CEIL(R)
	POPJ	P,
 
BUMP1:	MOVE	B,CEIL(R)
	CAIN	R,SEXROL
	JRST	BULAB1
	JRST	OPENUP
BULAB1:	ADDI	E,^D10		;***EXTRA 10 LOCS
	PUSHJ	P,OPENUP
	MOVNI	X1,^D10 	;TAKE BACK THE 10 LOCS
	ADDM	X1,CEIL(R)
	POPJ	P,

;DPANIC - ROUTINE FOR BASDDT CORE EXPANSION

DPANIC:	MOVE	C,.DDSA		;START OF BASDDT SEGMENT
	ADD	C,CORINC	;PLUS EXPANSION FACTOR
	HRL	C,.DDSA		;SET UP BLT
	MOVE	T,.JBREL	;HIGH ADDRESS
	BLT	C,(T)		;MOVE IT
	SKIPN	DDCODE		;IN MIDST OF BASDDT CODE
	JRST	DPN5		;NO, THEN DON'T MOVE
	MOVE	C,DDTCOD
	ADD	C,CORINC
	MOVE	T,DDCODE	;LAST INSTR.
	ADD	T,CORINC	;PLUS CORE EXPANSION FACTOR
DPN7:	CAML	C,T		;ALL MOVED?
	JRST	DPN5		;YES, NOW ZERO OLD BASDDT AREA
	HRRZ	T1,(C)		;GET ADDRESS OF INSTR.
	CAML	T1,DDTCOD	;WITHIN GENERATED CODE
	CAMLE	T1,.JBREL	;
	JRST	DPN8		;NO
	ADD	T1,CORINC	;ADJUST BY CORE FACTOR
	HRRM	T1,(C)		;PUT BACK
DPN8:	AOJA	C,DPN7		;DO NEXT
DPN5:	HRL	C,.DDSA		;START OF OLD BASDDT AREA
	HRR	C,.DDSA		;SET UP FOR BLT
	AOJ	C,		;IT'S DONE
	CLEARM	@.DDSA		;CLEAR FIRST LOCATION
	MOVE	T,.DDREL	;END OF BASDDT AREA
	BLT	C,(T)		;ZAP IT
	MOVEI	C,SEXROL
	MOVE	T,CORINC
DPN3:	CAILE	C,ROLTOP
	JRST	DPN2
	ADDM	T,FLOOR(C)
	ADDM	T,CEIL(C)
	AOJA	C,DPN3
DPN2:	MOVE	C,17
DPN2A:	CAMN	C,PLIST
	JRST	DPN6
	HRRZ	T1,(C)
	CAML	T1,DDTCOD
	CAMLE	T1,.JBREL
	JRST	DPN2B
	HLRZ	T,(C)
	TRZ	T,3740		;MASK OUT PROCESSOR-DEPENDENT BITS
	CAIE	T,(CAM)
	JRST	DPN2B
	ADD	T1,CORINC
	HRRM	T1,(C)
DPN2B:	SUB	C,[XWD 1,1]
	JRST	DPN2A
DPN6:	MOVE	C,CORINC	;CORE EXPANSION FACTOR
	ADDM	C,.DDFF		;UPDATE .DDFF
	ADDM	C,DDTCOD	;UPDATE DDTCOD
	ADDM	C,.DDSA		;UPDATE .DDSA
	ADDM	C,.DDTMP	;UPDATE .DDTMP
	ADDM	C,.DDREL	;UPDATE .DDREL
DPN4:	MOVE	C,.DDSA		;NEW BASDDT AREA
	SOJ	C,		;NEW HIGH FOR USER
	MOVEM	C,.USREL	;SET IT
	POPJ	P,
;PANIC - ROUTINE TO COMPRESS CORE
 
PANIC:	PUSHJ	P,PRESS 	;COMPRESS MEMORY
	MOVE	X2,TOPSTG	;IS THERE ROOM BETWEEN STODGY AND
	MOVE	X1,FLOOR+1(X2)	;MOVEABLE ONES?
	SUB	X1,CEIL(X2)
	CAML	X1,E		;ENOUGH ROOM?
	POPJ	P,
 
	MOVE	X1,.JBREL	;EXPAND BY 1K
	ADDI	X1,2000
	CORE	X1,
	JRST	[PUSHJ	P,INLMES
		ASCIZ	/
? Out of room/
		JRST	ERRMSG]
	MOVE	X1,.JBREL
	MOVEM	X1,.DDREL
	JRST	PANIC		;OK.  GO MOVE ROLLS
 
PANIC1: ERROM(60,</
? Out of room/>)
 
PRESS:	PUSH	P,G		;SAVE AC
	PUSH	P,A
;ROUTINE TO MOVE ROLLS UP
 
PRESS5:	MOVEI	G,ROLTOP	;HIGHEST MOVABLE ROLL
	MOVE	X1,.JBREL	;X1 IS PREVIOUS FLOOR
				;NOTE: TOP WORD OF USR CORE IS LOST
 
PRESS6: MOVE	X2,CEIL(G)	;GET OLD CEIL AND FLOOR
	MOVE	A,FLOOR(G)
	SUBI	X2,1		;SET UP X2 FOR POP LOOP
	ORCMI	X2,777777
	MOVEM	X1,CEIL(G)	;NEW CEILING
 
PRESS7: CAILE	A,(X2)		;DONE?
	JRST	PRESS8
	POP	X2,-1(X1)	;MOVE ONE WORD
	SOJA	X1,PRESS7
 
PRESS8: MOVEM	X1,FLOOR(G)	;NEW FLOOR
	SOS	G		;GO TO NEXT LOWER ROLL
	CAMLE	G,TOPSTG	;IS THIS ROLL MOVEABLE?
	JRST	PRESS6		;YES. GO PRESS IT.
PRES9A: POP	P,A
PRESS9: POP	P,G	;RESTORE G
	POPJ	P,	;RETURN

ERRMSG:	SETZM	RUNDDT	;CANT RUN DDT
	SETOM	NOLINE	;NO LINE NUMBER TO OUTPUT
	JRST	GOSR2

	END