Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50516/bascom.mac
There are no other files named bascom.mac in the archive.
 
IFNDEF NOCODE,<NOCODE==0>	;NOCODE=1 : JUST DEFINE SYMBOLS
 
IFE NOCODE,<
TITLE BASCOM	    COMPILE/LOAD PHASE
>
IFN NOCODE,<
UNIVERSAL   BSYCOM
>
 
 
	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	.JB41
	JSR	UUOH
 
	LOC	.JBINT
	TRPLOC
 
	LOC	.JBVER
	BYTE	(3)VWHO(9)VBASIC(6)VMINOR(18)VEDIT

IFE NOCODE,<
	RELOC
	HISEG
>
IFN NOCODE,<LOC 400010>
 
 
	INTERN STACEI,STAFLO,RELCEI,RELFLO

	EXTERN NEGONE
	EXTERN AFLAG,ERR,ERL,ERRGO,ERRCNT,LINADR
	EXTERN ERLB,ERRB
	EXTERN ACTBL,APPEND,ARAROL,ARATOP,ARGROL,ASCIIB,ATANB,BGNTIM
	EXTERN BLOCK,CADROL,CATFLG,CEARG,CECAD,CECOD,CECON,CEFAD,CEFCL
	EXTERN CEFOR,CEGSB,CEIL,CELAD,CELIN,CELIT,CENTRY,CENXT
	EXTERN CEPTM,CEREF,CESAD,CESEX,CESLT,CESTM,CESVR,CETMP,CEVSP
	EXTERN CHAERR,CHAFL2,CHAFLG,CHAHAN,CHAXIT,CHKIMG,CHRB
	EXTERN CLOGB,CLSFIL,CNER1,CODROL,COMTIM,CONROL,COSB
	EXTERN COTB,CRLF,CRTVAL,DATAFF,DATEB,DAYB,DETER,DEVBAS,DOINPT
	EXTERN DOREAD,EIFLOT,ELSFLG,ELSEAD,ENDIMG,EOF,EXP3.0,EXPB,EXTD
	EXTERN EXP1.0,EXP2.0,ECHOB
	EXTERN FADROL,FCLROL,FCNROL,FILCNT,FILD,FILDIR,FILTYP,FPPN
	EXTERN FIXPNT,FLTPNT
	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,LDDTNH,LEFTB,LENB,LETSW,LEXECT,LINEB
	EXTERN LINROL,LITROL,LOCLOF,LOGB,LOGNEG,LSAVE,LUXIT
	EXTERN MARERR,MARGAL,MARGIN,MARGN,MASAPP,MIDB,MINFLG,MTIME
	EXTERN MIXFLG,MASTST
	EXTERN MULLIN,NEWOL1,NOTLIN,NUMCOT,NUMRES,ODF,OLDCOD
	EXTERN ONCESW,ONGFLG,OPNFIL,OPNFLG,OUTSET,PAGE,PAGEAL
	EXTERN PAGLIM,PAKFLG,PIB,PLIST,POINT,POSB,PRDLER,PSAV,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,THNCNT,THNELS,TIMEB,TMPLOW
	EXTERN TMPPNT,TMPROL,TOPSTG,TRNFL2,TRNFLG,TRPLOC,TRUTH,TTYPAG
	EXTERN TYPE,FTYPE,PFLAG
	EXTERN UUOH,VALB,VARFRE,VARROL,VPAKFL,VRFBOT,VRFSET
	EXTERN INLNFG
	EXTERN VRFTOP,VSPROL,WRIPRI,WRPRER,WRREFL,XCTON,XRES
	EXTERN .JBFF,.JBREL,.JBSA

;	VIRTUAL ARRAY LOW SEGMENT EXTERNALS

	EXTERN VIRSIZ,VIRDIM,FLVIR,CEVIR,VIRROL
	EXTERN VIRBLK,VIRWRD


	XLIST
	IFN	BASTEK,<
	LIST
;
;	BASTEK CONDITIONAL CODE
;
	EXTERN INIPLT,PAGPLT,LINPLT,ORGPLT,STRPLT,WHRPLT,MOVPLT,NOORG
	EXTERN CURPLT,SAVPLT,PLTOUT,PLTIN
;
;	END BASTEK CONDITION CODE
;
	XLIST
	>
	LIST

	EXTERN LBASIC,UXIT
	BASIC=LBASIC
	EUXIT=UXIT

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

	EXTERN BUMPRL,CLOB,CLOSUP,CPOPJ,CPOPJ1,DATCHK,ERACOM
	EXTERN ERRMS2,ERRMS3,ERRMSG,EVANUM,FILNAM,FILNMO,GETNU
	EXTERN GETNUM,INLMES,LOCKOF,LOCKON,NXCH,NXCHD,OPENUP
	EXTERN OUCH,PANIC1,PRESS,PRINT,PRNNAM,QSA,QSELS,QST,RPUSH
	EXTERN SCN2,SCN3,SCNLT1,SCNLT2,SCNLT3,SEARCH,TTYIN

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


	INTERN RUNNH
IFN NOCODE,<
IF2,<	END>
>
DEFINE FAIL (A,AC)<
	XLIST
	XWD	001000+AC'00,[ASCIZ \A\]
	LIST
>
%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
 
	MAXUUO=1
 
 
 
UUOHAN: PUSH	P,UUOH		;RETURN ADDRS ON PUSH-DOWN LIST
	LDB	X1,[POINT 9,40,8]
IFL MAXUUO-37,<
	CAILE	X1,MAXUUO
	HALT			;ILLEGAL UUO.
>
UUOTBL:
	JRST	.(X1)
	JRST	FAILER
STAFLO:
	Z	XCHAN+20000(SIXBIT /   CHA/)
	Z	XCLOSE+60000(SIXBIT /   CLO/)
	Z	XDATA+40000(SIXBIT /   DAT/)
	Z	XDEF+40000(SIXBIT /   DEF/)
	Z	XDIM(SIXBIT /   DIM/)
	Z	XELS+20000(SIXBIT /   ELS/)
	Z	XEND+20000(SIXBIT /   END/)
	Z	XFILE+40000(SIXBIT/   FIL/)
	Z	XFNEND+60000(SIXBIT /   FNE/)
	Z	XFOR+20000(SIXBIT /   FOR/)
	Z	XGOSUB+60000(SIXBIT /   GOS/)
	Z	XGOTO+60000(SIXBIT /   GOT/)
	Z	XIF+20000(SIXBIT /   IF /)
	Z	XINPUT+60000(SIXBIT /   INP/)
	Z	XLET+20000(SIXBIT /   LET/)
	Z	XMAR+60000(SIXBIT /   MAR/)
	Z	XMAT+20000(SIXBIT /   MAT/)
	Z	XNEXT+60000(SIXBIT /   NEX/)
	Z	XNOP+60000(SIXBIT /   NOP/)
	Z	XNOQ+60000(SIXBIT /   NOQ/)
	Z	XON+20000(SIXBIT /   ON /)
	Z	XOPEN+60000(SIXBIT /   OPE/)
	Z	XPAG+60000(SIXBIT /   PAG/)
	Z	XPAUSE+60000(SIXBIT/   PAU/)
	XLIST
	IFN	BASTEK,<
	LIST
;
;	BASTEK CONDITIONAL CODE
;
	Z	XPLO+60000(SIXBIT/   PLO/)
;
;	END BASTEK CONDTIONAL CODE
;
	XLIST
>
	LIST
	Z	XPRINT+60000(SIXBIT /   PRI/)
	Z	XQUO+60000(SIXBIT /   QUO/)
	Z	XRAN+60000(SIXBIT /   RAN/)
	Z	XREAD+60000(SIXBIT /   REA/)
	Z	XREM(SIXBIT /   REM/)
	Z	XREST+20000(SIXBIT /   RES/)
	Z	XRETRN+60000(SIXBIT /   RET/)
	Z	XSCRAT+60000(SIXBIT/   SCR/)
	Z	XSET+20000(SIXBIT /   SET/)
	Z	XSTOP+60000(SIXBIT /   STO/)
	Z	XUNTIL+60000(SIXBIT /   UNT/)
	Z	XWHILE+60000(SIXBIT /   WHI/)
	Z	XWRIT+60000(SIXBIT/   WRI/)
STACEI:
 
 
	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) <
	<SIXBIT /X/>
>
 
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:
 
ILLIN:	ASCIZ	/
? Illegal line reference in RUN(NH) or CHAIN/
 
 
	SUBTTL	INITIALISE COMPILATION

RUNNH:	MOVEI	R,STAROL	;SETUP STAROL
	MOVEI	X1,STAFLO	;GET THE FLOOR
	MOVEM	X1,FLOOR(R)	;SET IT
	MOVEI	X1,STACEI	;GET THE CEIL
	MOVEM	X1,CEIL(R)	;SET IT
	MOVEI	R,RELROL	;SETUP RELROL
	MOVEI	X1,RELFLO	;GET THE FLOOR
	MOVEM	X1,FLOOR(R)	;SET IT
	MOVEI	X1,RELCEI	;GET THE CEIL
	MOVEM	X1,CEIL(R)	;SET IT
	MOVEI	X1,^D9		;CHAIN ENTRY POINT.
RUNNH1: SETZM	ACTBL-1(X1)
	SETZM	FILD-1(X1)
	SETZM	EXTD-1(X1)
	SETZM	FPPN-1(X1)
	SOJG	X1,RUNNH1
	SETOM	VRFSET
	SETOM	COMTIM
	SETZM	MULLIN		;INITIALIZE MULTI-LINE SWITCH
	SETZM	FUNAME		;AND FN NAME
	SETZM	FILCNT
	SKIPN	CHAFLG
	JRST	RNLAB1		;NO.
	MOVE	P,PLIST
	PUSHJ	P,TTYIN
RNLAB1:	SKIPE	SWAPSS		;SET THE CORE CRUNCHING FLAG IF
	SETOM	PAKFLG		;THIS IS A SWAPPING SYSTEM.
	PUSHJ	P,LOCKON	;PROTECT REST OF COMPILATION
	PUSHJ	P,PRESS 	;GUARANTEE SOURCE DOESN'T MOVE!!!
	MOVEI	X1,CODROL	;COMPILE TIME.
	MOVEM	X1,TOPSTG	;TXT,LIN,CODROLS ARE STODGY. OTHERS MOVE.
	MOVEI	R,LINROL
	PUSHJ	P,SLIDRL	;SLIDE LINROL DOWN NEXT TO TXTROL.
RUNER1: MOVEM	X2,FLCOD
	MOVEM	X2,CECOD	;CODROL IS ALSO PACKED IN PLACE.
	MOVEI	X1,CODROL	;PREPARE TO CLOBBER ALL ROLLS ABOVE CODROL
	MOVE	T,.JBREL		;USE THIS VALUE.
	PUSHJ	P,CLOB		;DO THE CLOBBERING.
	MOVEI	F,0		;CLEAR COMPILATION FLAGS
	SKIPE	CHAFLG		;CHAINING?
	JRST	RUNER0		;YES, DON'T DISTURB THE TIME.
	MOVEI	T,0		;SET UP AC FOR RUNTIM.
	RUNTIM	T,		;GET TIME OF START.
	MOVEM	T,MTIME 	;SAVE TIME AT START OF RUNER
RUNER0: SETOM	RUNFLA
	SETZM	DATAFF		;CLEAR DATA FLAG
	SETOM	TMPLOW	;NO TEMPORARIES USED YET.
 
	MOVEI	F,REFROL	;CREATE A ROLL OF ZEROS
	PUSHJ	P,ZERROL
 
;NOW MARK THIS ROLL TO SHOW WHAT PARTS OF THIS PROG ARE INSIDE OF FUNCTIONS:
 
LUKDEF:	MOVEI	A,LUKD0		;SET RETURN TO LOOK FOR DEF
LUKD0:	PUSHJ	P,NXLINE	;PREPARE TO READ A LINE
	PUSHJ	P,QSA		;LOOK FOR DEFFN
	ASCIZ	/DEFFN/
	JRST	LUKD1A		;NOT FOUND, LOOK FOR DIM
	PUSHJ	P,SCNLT1	;BUILD FN NAME
	PUSHJ	P,DIGIT		;SCAN OFF ANY DIGIT
	PUSHJ	P,DOLLAR	;CHECK FOR STRING FUNCTION
	CAIA			;IT IS, DON'T CHECK FOR %
	PUSHJ	P,PERCNT	;INTEGER FUNCTION
	HLLZ	B,A		;STORE FN NAME IN B
	SKIPA	A,[XWD Z LUKD2] ;SET RETURN TO LOOK FOR FNEND
LUKD1:	PUSHJ	P,NXCH		;GET NEXT CHAR
	TLNE	C,F.TERM	;LINE TERMINATOR
	JRST	LUKD9		;YES, MULTI-LINE DEF
	TLNN	C,F.EQAL	;EQUALS SIGN
	JRST	LUKD1		;NO, KEEP LOOKING FOR ONE OR THE OTHER
	MOVEI	A,LUKD0		;LOOK FOR DEFFN WHEN DONE WITH DIM
	JRST	LUKD9		;CHECK FOR ANY DIMS
LUKD1A:	PUSHJ	P,QSA		;LOOK FOR THE DIM
	ASCIZ	/DIM/
	JRST	LUKD9		;NOT FOUND, SKIP TO NEXT LINE
	HLLOS	(G)		;MARK LINE AS CONTAINING DIM
	JRST	LUKD3		;DO NEXT LINE
LUKD9:	PUSHJ	P,LUKEND	;FIND LINE TERMINATOR
	JRST	LUKD1A		;GO LOOK FOR A DIM
LUKD2:	MOVEI	A,LUKD2A	;LOOK FOR FNEND AFTER LINE
LUKD2A:	PUSHJ	P,NXLINE	;PREPARE TO READ A LINE
	HLLM	B,(G)		;MARK LINE AS WITHIN DEF
LUKD4:	PUSHJ	P,QSA		;LOOK FOR FNEND
	ASCIZ	/FNEND/
	JRST	LUKD5		;NOT FOUND, GO LOOK FOR DIM
LUKD24:	MOVEI	A,LUKD0		;LOOK FOR DEF NEXT
	JRST	LUKD3		;FNEND MUST BE LAST IN LINE
LUKD5:	PUSHJ	P,QSA		;LOOK FOR DIM
	ASCIZ	/DIM/
	CAIA			;NOT FOUND, DON'T MARK
	HLLOS	(G)		;MARK LINE AS CONTAINING DIM
	PUSHJ	P,LUKEND	;LOOK FOR LINE TERMINATOR
	JRST	LUKD4		;GO LOOK FOR FNEND
LUKEND:	PUSHJ	P,NXCH		;GET A CHARACTER
	CAME	C,[XWD F.APOS,"'"] ;COMMENT
	TLNE	C,F.CR		;OR CARRIAGE RETURN
	JRST	LUKD3A		;END OF LINE, START ANOTHER ONE
	TLNN	C,F.TERM	;IS IT A LINE TERMINATOR?
	JRST	LUKEND		;NO, KEEP LOOKING
	POPJ	P,		;YES, RETURN
LUKD3A:	POP	P,X1		;CLEAN PUSH DOWN STACK
LUKD3:	AOBJN	L,(A)		;DO NEXT LINE IF IT EXITS
 
 
;FINISHED MARKING FUN LINES. NOW SET UP A CLEAR LADROL...
RUNER2: MOVEI	F,LADROL
	PUSHJ	P,ZERROL
 
	PUSH	P,L		;SAVE LINE POINTER
	MOVE	L,FLREF		;START SCANNING REFROL
FIXDIM:	CAML	L,CEREF		;ENTIRE ROLL SCANNED?
	JRST	FIXDON		;YES, WE ARE DONE
	HRRZ	A,(L)		;CHECK IF THIS LINE CONTAINS A DIM
	HLLZS	(L)		;CLEAR IT IN CASE IT WAS SET
	SKIPN	A		;IF NON-ZERO, DIM COMING UP
	AOJA	L,FIXDIM	;NO DIMS, CHECK NEXT LINE
	SUB	L,FLREF		;MAKE IT A POINTER TO LINROL
	PUSHJ	P,NXLINE	;PREPARE TO READ THE LINE
	ADD	L,FLREF		;RESTORE L
FXDIMA:	PUSHJ	P,QSA		;CHECK FOR DIM
	ASCIZ	/DIM/
	JRST	FXDIM4		;NONE THERE, GO TO TERMINATOR
	PUSHJ	P,QSA		;CHECK OR FULL DIMENSION
	ASCIZ	/ENSION/
	JFCL			;WHO CARES
	CAME	C,[XWD F.STR,"#"] ;VIRTUAL ARRAY DIM?
	JRST	FXDIM4		;NO, SCAN TO TERMINATOR
	PUSHJ	P,NXCH		;EAT THE #
	PUSHJ	P,GETNUM	;EVALUATE NUMBER
	JRST	FXDERR		;NONE THERE
	CAILE	N,9		;CAN'T BE GREATER THAN 9
	JRST	FXDERR		;GIVE ERROR
	TLNN	C,F.COMA	;COMMA MUST FOLLOW
	JRST	FXDERR		;IT DIDN'T
FXDIM0:	PUSHJ	P,NXCH		;EAT WHATEVER CHARACTER IS IN C
	HRRI	F,ARAROL	;ASSUME NUMERIC ARRAY
	TLNN	C,F.LETT	;MUST HAVE LETTER
	JRST	FXDERR		;SIMPLE SHIT, GIVE ERROR
	PUSHJ	P,SCNLT1	;BUILD ARRAY NAME
	PUSHJ	P,DIGIT		;CHECK FOR A DIGIT
	PUSHJ	P,DOLLAR	;NOW CHECK FOR A DOLLAR
	JRST	FXDIM1		;FOUND ONE, STRING ARRAY
	PUSHJ	P,PERCNT	;CHECK FOR INTEGER SPEC
	CAIA			;F ALREADY SET FOR NUMERIC
FXDIM1:	HRRI	F,SVRROL	;FLAG F FOR STRING
	TLO	A,1		;MAKE NAME UNIQUE FOR ARRAY
	MOVEI	R,VARROL	;SEARCH VARROL FOR THIS ARRAY
	PUSHJ	P,SEARCH	;DO THE SEARCH
	CAIA			;NOT FOUND, GOOD CONTINUE
	JRST	FXDERR		;VARIABLE DIMENSIONED TWICE
	PUSHJ	P,REGA2		;REGISTER THE ARRAY
	CAIE	C,"("		;( MUST BE PRESENT
	JRST	FXDERR		;NOT THERE
	ADD	B,FLOOR(F)	;POINT B TO ARA(SVR)ROL
	MOVEI	X1,400000	;MARK AS VIRTUAL
	HRLM	X1,(B)		;AND STORE IN ARRAY
FXDIM2:	PUSHJ	P,NXCH		;GET A CHARACTER
	TLNE	C,F.TERM	;LINE TERMINATOR?
	JRST	FXDERR		;YES, TOO SOON
	TLNN	C,F.RPRN	;CLOSING PAREN?
	JRST	FXDIM2		;NO, KEEP SCANNING
FXDIM3:	PUSHJ	P,NXCH		;GET A CHARACTER
	CAME	C,[XWD F.APOS,"'"] ;REST OF LINE A COMMENT
	TLNE	C,F.CR		;OR END OF LINE
	AOJA	L,FIXDIM	;YES, DO NEXT LINE
	TLNE	C,F.COMA	;ANOTHER ARRAY COMING UP?
	JRST	FXDIM0		;YES, PROCESS IT
	TLNN	C,F.TERM	;HOW ABOUT A LINE TERMINATOR?
	JRST	FXDIM3		;NO, KEEP LOOKING
	PUSHJ	P,NXCH		;EAT THE TERMINATOR
	JRST	FXDIMA		;AND SEE IF WE HAVE ANOTHER DIM
FXDIM4:	PUSHJ	P,NXCH		;GET A CHARACTER
	CAME	C,[XWD F.APOS,"'"] ;COMMENT?
	TLNE	C,F.CR		;OR CARRAIGE RETURN
	AOJA	L,FIXDIM	;YES, END OF LINE, DO NEXT
	TLNN	C,F.TERM	;TERMINATOR?
	JRST	FXDIM4		;NO, KEEP SCANNING
	PUSHJ	P,NXCH		;YES, EAT IT
	JRST	FXDIMA		;AND LOOK FOR NEXT DIM
FXDERR:	CLEARM	RUNFLA		;FOUND AN ERROR, DON'T PRODUCE ANY CODE
	CAML	L,CEREF		;CHECKED ALL OF REFROL
	JRST	FIXDON		;YES, NOW BEGIN ABORTED COMPILATION
	HLLZS	(L)		;CLEAR DIM FLAG IN REFROL
	AOJA	L,FXDERR	;AND CHECK NEXT
FIXDON:	POP	P,L		;RESTORE LINE POINTER
 
	SUBTTL	PROCESS EACH LINE

;SO FAR, WE HAVE SET UP LADROL FOR ADDRESSES & CHAINS FOR LABLES
;ALSO, L IS A WORD TO AOBJN & COUNT THROUGH LINES.
;BEGIN COMPILATION OPERATIONS FOR EACH LINE
 
EACHLN: MOVE	P,PLIST 	;FIX P LIST IN CASE LAST INST FAILED
	PUSHJ	P,LOCKOF	;CHECK REENTER REQUEST
	PUSHJ	P,LOCKON
	MOVE	X1,TMPLOW
	MOVEM	X1,TMPPNT	;NO UNPROTECTED TEMPORARIES USED YET.
	SETZM	LETSW
	SETZM	LOGNEG		;
	CLEARM	AFLAG		;CLEAR A FLAG
	CLEARM	PFLAG		;CLEAR % SEEN FLAG
	SETZM	TRNFLG		;NOT YET SEEING MAT TRN.
	SETZM	INLNFG		;CLEAR INPUT LINE FLAG
	SETZM	REGPNT		;REG IS FREE
	SETZM	PSHPNT		;NO "PUSH" INSTS GENERATED YET
	SETOM	VRFSET
	SKIPN	FUNAME		;IN MIDST OF MULTI-LINE FUNCTION
	JRST	ECLAB1
	MOVMS	VRFSET
	JRST	EACHL2
ECLAB1:	MOVE	X1,FLARG	;NO FUNCTION ARGS YET
	MOVEM	X1,CEARG
EACHL2:	SKIPN	MULLIN		;SKIP IF MULTI-STATEMENT
	JRST	ECHL2A		;
	MOVE	D,T		;
	JRST	ECHL2B		;
ECHL2A:	CLEARM	THENAD		;ZERO THEN ADDRESS
	CLEARM	ELSEAD		;ZERO ELSE ADDRESS
	CLEARM	THNCNT		;CLEAR COUNT OF THEN'S
	CLEARM	ELSFLG		;CLEAR SINGLE WORD THEN/ELSE
	SETZM	THNELS		;CLEAR CONDITIONAL FLAG
	PUSHJ	P,NXLINE	;SET UP POINTER TO THIS LINE.
ECHL2B:	MOVSI	A,(SIXBIT /REM/) ;PREPARE FOR COMMENT
	CAIE	C,":"		;IMAGE = REM.
	JRST	EACHL4
	SKIPE	MULLIN		;MULTI-LINE ?
	FAIL<? Image must be first in line>
	JRST	EACHL1
EACHL4: CAMN	C,[XWD F.APOS,"'"]
	JRST	EACHL1		;JUST COMMENT
	TLNE	C,F.TERM	;ANY OTHER TERMINATOR
	JRST	NXSM4		;IS IGNORED
	TLNN	C,F.LETT	;? FIRST CHAR A LETTER
	JRST	ILLINS		;NO, GRIPE
	PUSHJ	P,SCNLT1	;SCAN FIRST LTR
	CAMN	C,[XWD	F.STR,"%"] ;NEXT LETTER % ?
	JRST	ELILET		;MUST BE LET OR ERROR
	CAIE	C,"("
	TLNE	C,F.EQAL+F.DIG+F.DOLL+F.COMA ;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
	CAIE	X1,(SIXBIT /FN/) ;ELIDED LET FNX=  ?
	JRST	EACHL3		;NO.
	PUSHJ	P,SCNLT3
	JRST	ILLINS
	TLNE	C,F.DIG		;CHECK FOR MAYBE DIGIT
	PUSHJ	P,NXCH		;YES, EAT IT
	TLNN	C,F.EQAL	;IS FOURTH CHAR AN '=' SIGN?
	CAMN	C,[XWD F.STR,"%"] ;OR A PERCENT
	JRST	ELILET		;YES, ELIDED STATEMENT
	TLNE	C,F.DOLL	;OR A $
	JRST	ELILET
	JRST	EACHL1		;NO, BETTER BE FNEND.
 
EACHL3: PUSHJ	P,SCNLT3	;ASSEMBLE THIRD LETTER OF STATEMENT IN A
	JRST	ILLINS		;THIRD CHAR WAS NOT A LETTER
	CAMN	A,[624555000000] ;FIX FOR REM
	HRRZ	C,C		;TWO LINES.
	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.
 
	MOVE	X1,CECOD	;PUT REL ADDRS IN LADROL
	SUB	X1,FLCOD
	MOVE	X2,FLLAD
	ADDI	X2,(L)
	SKIPN	MULLIN		;DONT STORE IF MULTI
	HRLM	X1,(X2)
	HRLI	D,(JUMP)
	MOVEM	D,SORCLN	;SAVE SOURCE LINE NUMBER
	SETOM	JFCLAD		;NO JFCL YET
	TRZN   A,20000		;EXECUTABLE?
	JRST	EACHL6
	SKIPN	NOTLIN		;OR ARE WE DELETING LINE NOS
	SKIPE	MULLIN		;OR WITHIN MULTI
	JRST	EACHL7
	MOVE	D,[JSP A,LINADR] ;NUMBER IN SORCLN.
	PUSHJ	P,BUILDI
	MOVE	D,SORCLN	;
	PUSHJ	P,BUILDI	;GENERATE IT NOW
EACHL7:	CAIN	A,40000+XNEXT	;AND NEXT
	JRST	EACHL6		;NEED NO JFCL
	MOVSI	D,(JFCL)
	PUSHJ	P,BUILDI	;SET JFCL FOR HANDLING MODIFIERS
	MOVEM	B,JFCLAD	;STORE ADDRESS
EACHL6: MOVE	X1,A
 
	TRZN	X1,40000	;MORE TO COMMAND?
	SOJA	X1,EACHL5	;NO. JUST DISPATCH
	PUSHJ	P,QST		;CHECK REST OF COMMAND
	JRST	ILLINS
 
EACHL5: JRST	1(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,FLCOD
	MOVSI	X2,(JRST)	;PUT JRST
	SKIPE	SAVRUN
	TLO	X2,(4,) 	;OR HALT
	SKIPE	RUNFLA		;STILL RUNNING
	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	B,FLCOD 	;ADDRESSES
	PUSHJ	P,FIXADR
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	CECOD		;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,CECOD 	;NEXT CODE
	MOVE	X1,JAROUN	;JUMP AROUND LOC
	PUSHJ	P,FIXADR	;JUMP INTO NEXT
	SETOM	JAROUN		;NO MORE JUMP AROUND
	MOVE	X1,FTYPE	;GET TYPE OF FOR LOOP
	MOVEM	X1,TYPE		;SET UP FOR NEXT
	PUSHJ	P,NEXCOD	;NEXT CODE
	JRST	MODMOR		;LOOK FOR MORE
 
SAVCEN: MOVE	X1,CECOD
	SUB	X1,FLCOD	;NEW CENTRY
	EXCH	X1,(P)		;SAVE IT
	JRST	(X1)
 
OLDCEN: PUSHJ	P,HALJRS	;JRST TO OLD CENTRY
	MOVE	X1,CENTRY
	ADD	X1,FLCOD
	EXCH	X1,B
	PUSHJ	P,FIXADR	;SET ADDRESS
	MOVE	B,X1
	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,FLCOD
	MOVE	X1,JFCLAD	;JUMP TO MODIFIERS
	PUSHJ	P,FIXADR	;SET ADDRESS
	SKIPGE	X1,JAROUN	;LAST JUMP AROUND
	JRST	NXSM3		;NONE THERE
	MOVE	B,CECOD 	;NEXT STMNT
	PUSHJ	P,FIXADR	;FOR JUMP AROUND
 
NXSM3:	TLNE	C,F.TERM	;SEEN TERMINATOR YET
	JRST	NXSM2		;
	PUSHJ	P,QSELS		;ELSE THERE
	JRST	ERTERM
	MOVEM	T,MULLIN
	JRST	NXSM1		;
 
NXSM4:	SKIPE	MULLIN		;IGNORE IF MULTI
	JRST	NXSM2		;
	MOVE	X1,CECOD	;CALCULATE OFFSET OF LAST
	SUB	X1,FLCOD	;WORD OF CODE GENERATED
	MOVE	X2,FLLAD	;MUST STORE IN LADROL
	ADDI	X2,(L)		;
	HRLM	X1,(X2)		;

NXSM2:	SETZM	MULLIN		;END, UNSET MULTI-LINE
	MOVEI	D,"\"		;WAS IT
	CAIE	D,(C)		;BACKSLASH ?
	JRST	NXSM1		;NO, REALLY NEXT LINE
	MOVEM	T,MULLIN	;YES, SET MULTI-LINE
	PUSHJ	P,NXCH		;GET NEXT CHAR
 
NXSM1:	SKIPE	AFLAG		;SHOULD WE CLEAR VRFBOT BECAUSE OF V. A.
	JRST	NXSM1A		;YES, DO IT
	SKIPE	VRFSET
	JRST	NXTST1
NXSM1A:	MOVE	D,[SETZM VRFBOT]
	PUSHJ	P,BUILDI
 
 
;ENTER HERE FROM ERROR ROUTINE
 
NXTST1:	SKIPE	MULLIN		;FINISHED LINE ?
	JRST	EACHLN		;NO
	SKIPLE	X1,THENAD	;STILL UNDER THEN ?
	PUSHJ	P,LNKTHN	;LINK ALL THENAD'S
	SKIPLE	X1,ELSEAD	;ANY ELSE ADDRESSES
	PUSHJ	P,LNKTHN	;LINK THE ELSES
NXTST2:	AOBJN	L,EACHLN
NOEND:	MOVEI	T,NOEND1	;IF NONE, DIDNT SEE END
	JRST	ERRMSG
NOEND1: ASCIZ	/
? No END instruction/
 
LNKTHN:	SKIPN	RUNFLA		;STILL PRODUCING CODE?
	POPJ	P,		;NO, JUST RETURN
	MOVE	B,CECOD		;FILL IN WITH NEXT STATEMENT ADDRESS
LNKTH1:	ADD	X1,FLCOD	;MAKE X1 AND ADDRESS TO FLCOD
	HRRZ	X2,(X1)		;PICK UP LINK
	HRRM	B,(X1)		;FIX JRST TO NEXT STATEMENT
	JUMPE	X2,CPOPJ	;ANOTHER LINK?
	MOVE	X1,X2		;YES, SET X1
	JRST	LNKTH1		;AND FIX ADDRESS
 
 
;END OF COMPILE/EXECUTE PHASE
 
 
SUBTTL	PROGRAM "LOADER"
;HERE AFTER END STATEMENT
 
LINKAG:
	SETZM	VIRWRD		;EXECUTE SEGMENTS NEEDS VIRWRD, MAKE
	SETZM	VIRSIZ		;
				;SURE IT IS ZERO
	SKIPE	RUNDDT##
	JRST	LDDTNH
	SKIPN	SAVRUN		;MAKING SAV CODE ?
	JRST	LKS1		;NO, BACK TO MAINSTREAM
	HRLZ	L,FLLIN 	;SET UP L
	HRR	L,CELIN 	;TO SWEEP
	MOVS	N,L		;LINE ROLL
	SUB	L,N
	SKIPGE	DATAFF		;DATA SEEN ?
	HLLZM	L,DATAFF	;NOW WILL BE FIRST IN LINROL
	ADDI	L,-1
LKS2:	PUSHJ	P,NXLINE	;SET UP LINE
	PUSHJ	P,QSA		;WAS IT DATA
	ASCIZ	/DATA/
	PUSHJ	P,[MOVE B,FLLIN ;NO
		ADDI	B,(L)	;GET ITS #
		MOVEI	R,LINROL ;SET UP FOR LINROL
		MOVSI	D,1	;REDUCE COUNT
		SKIPGE	DATAFF	;IF ANY
		ADDM	D,DATAFF ;OF DATA LINES
		PUSHJ	P,ERACOM ;AND ZAP IT
		POPJ	P,]
	ADDI	L,-1		;BACK TO PREVIOUS LINE
	JUMPLE	L,LKS2
	MOVE	L,FLCOD 	;GET CURRENT CODE FLOOR, SAVE
	MOVEM	L,OLDCOD	;FLAG TO PRESS THIS IS SAVE
	PUSHJ	P,PRESS
	SKIPA	R,[Z	LINROL] ;SLIDE THE ROLLS
LKS1:
	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.
 
	SKIPN	SAVRUN		;MAKING SAV FILE ?
	JRST	LKS3		;NO
	MOVE	L,FLCOD 	;YES, NEW CODE FLOOR
	MOVE	X1,L
	SUB	X1,OLDCOD	;CODE OFFSET
LKS4:	CAMN	L,CECOD 	;FINISHED ?
	JRST	LKS3		;YES
	HLRZ	X2,(L)		;NO, GET INSTRUCTION
	CAIN	X2,(HALT)	;HALT ?
	TLZA	X1,(4,) 	;YES (FROM FOR) - TO JRST
	CAIN	X2,(SOJG LP,)	;ALL LOOP ?
	ADDM	X1,(L)		;YES FIX UP
	TLO	X1,(4,)
	AOJA	L,LKS4		;AND LOOK FOR MORE
 
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	;IS IT VIRTUAL
	JRST	LK2B		;YES, IGNORE
	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,LKLAB3	;IMPLICIT 2-DIM ARRAY?
	HRRI	X2,^D11
	MOVEI	X1,^D121
LKLAB3:	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		;THIS UNDOCUMENTED CODE IS
	JRST	LK2C		;DEC EDIT # 166
	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 VARIABLE 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	[MOVEI T,PANIC1
		JRST ERRMSG]
LK37:	ADD	E,CETMP 	;CALCULATE TOP OF ARRAY SPACE.
	MOVEM	E,SVRTOP	;SAVE IT.
	MOVEM	E,VARFRE	;THIS IS ALSO FIRST FREE WORD.
 
	SKIPN	SAVRUN		;MAKING SAV CODE ?
	JRST	LK4		;NO
	HRLM	E,.JBSA 	;SAVE F.F. IN .JBSA
	HRRM	E,.JBFF 	;AND .JBFF
 
 
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
	LDB	C,[POINT 7,A,13]
	JUMPE	C,LNK0B1
	PUSHJ	P,OUCH
LNK0B1:	TLNN	A,4		;INTEGER?
	JRST	LNK0B2		;NO
	MOVEI	C,"%"		;YES, OUTPUT
	PUSHJ	P,OUCH		;A %
	JRST	LNK0B3		;AND CONTINUE
LNK0B2:	TLNN	A,10		;STRING?
	JRST	LNK0B3		;NO
	MOVEI	C,"$"		;YES, OUTPUT
	PUSHJ	P,OUCH		;A $
LNK0B3:	SKIPE	CHAFL2
	PUSHJ	P,ERRMS3
	PUSHJ	P,INLMES
	ASCIZ	/
/
	AOJA	T,LINK0A
 
LINK0C: MOVE	B,FLFOR ;UNSAT FORS?
LNK0C1:	CAML	B,CEFOR
	JRST	LINK0D
	PUSHJ	P,INLMES
	ASCIZ	/? FOR without NEXT/
	MOVE	L,(B)		;GET POINTER TO LINE NUMBER
	SKIPN	SAVRUN		;MAKING SAVE FILE ?
	JRST	LNK0C2		;NO
	PUSHJ	P,INLMES	;YES, NO LINE NUMBER
	ASCIZ	/
/
	JRST	LNK0C3
LNK0C2:	PUSHJ	P,FAIL2
LNK0C3:	ADDI	B,5		;MORE UNSAT FORS?
	JRST	LNK0C1
 
 
LINK0D: SKIPG	DATAFF		;WAS DATA OMITTED?
	JRST	LINK0E		;NO
	PUSHJ	P,INLMES
	ASCIZ	/
? No DATA/
	SKIPE	CHAFL2
	PUSHJ	P,ERRMS3
LINK0G: 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	[MOVEI T,ILLIN
 
		JRST ERRMSG]
 
	SUB	B,FLOOR(R)
	MOVEM	B,RUNLIN
	ADD	B,FLREF 	;IS NOT WITHIN A MULTI-LINE DEF.
	SKIPN	(B)
	JRST	LINK0F
	MOVEI	T,ILLIN
	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
	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
	PUSHJ	P,LINKU1
 
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
	PUSHJ	P,LINKU1
 
 
LINK6:	MOVE	T,FLGSB 	;LINK GOSUB REFS
	MOVE	T1,CEGSB
	PUSHJ	P,LINKU1
	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,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
	PUSHJ	P,BLTZER
 
	SKIPN	SAVRUN		;MAKING SAV CODE ?
	JRST	LEXECT		;NO, JUST EXECUTE
	MOVEI	X1,START	;YES,GET START ADDRESS
	HRRM	X1,.JBSA	;AND SET IT UP
	HLRZ	X1,.JBSA	;FIRST FREE LOC
	TRO	X1,1777 	;ADJUST TO K BOUND
	CAMN	X1,.JBREL	;SIZE RIGHT ?
	JRST	LSAVE		;YES, GO SAVE
	CORE	X1,		;NO, CONTRACT
	HALT			;IMPOSSIBLE ERROR
	JRST	LSAVE		;GO SAVE
 
;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
 
LINKU1:	MOVE	A,T	;ORIGIN STARTS AT FLOOR
	MOVEI	B,1		;ONE WORD PER ENTRY IN ROLE
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
 
SLIDRL: MOVE	X2,CEIL(R)
	HRRZ	X1,CEIL-1(R)	;SLIDE ROLL DOWN  NEXT TO LOWER ROLL
	ADD	X2,X1
	HRL	X1,FLOOR(R)	;SET UP BLT TO MOVE ROLL
	SUB	X2,FLOOR(R)
	HRRZM	X1,FLOOR(R)	;SET NEW ROLL FLOOR
	BLT	X1,(X2)
	MOVEM	X2,CEIL(R)
	POPJ	P,
;ROUTINE TO MAKE A ROLL OF ZEROS =IN LNTH TO LINROL.
ZERROL: MOVE	R,F
	MOVE	E,CELIN 	;COMPUTE LENGTH OF ROLL
	SUB	E,FLLIN
	JUMPE	E,NOEND 	;NOTHING TO DO
 
	MOVN	L,E		;SAVE FOR LINE CNTR.
	MOVSI	L,(L)
	PUSHJ	P,BUMPRL	;ADD TO (EMPTY) ROLL
	MOVE	T,FLOOR+(F)	;CLEAR IT TO 0S
 
	SETZM	(T)
	HRL	T,T
	ADDI	T,1
	MOVE	T1,CEIL+(F)
	CAILE	T1,(T)		;SUPPRESS BLT IF ONLY 1 LINE
	BLT	T,-1(T1)
	POPJ	P,
BLTZER: HRL	X1,X1		;ZERO OUT CORE
	SETZM	(X1)
	AOJ	X1,
	BLT	X1,-1(X2)
	POPJ	P,
 
SUBTTL	STATEMENT GENERATORS
 
 
;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	;CHECK CORE REQUIREMENTS
	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,[HRLZI N,5]
	PUSHJ	P,BUILDI
	MOVE	D,[AOS N]
	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
	SKIPE	SAVRUN		;MAKING SAV CODE ?
	FAIL <? CHAIN with line arg in SAVFIL(NL)>
	PUSHJ	P,NXCH
	PUSHJ	P,FORMLN	;YES.
	PUSHJ	P,CHKINT	;WE WANT AN INTEGER
	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,"%"]
	PUSHJ	P,NXCH
	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 VECTOR?
	MOVSI	D,(VECFIN)	;NO, SET FOR INTEGER
	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
	CAIA		
	JRST	ILFORM
	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		;REAL VECTOR?
	MOVSI	D,(VECPIN)	;NO, SET FOR INTEGER
	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	;NOW CHANGE ACTBL TO FILD
	PUSHJ	P,BUILDI	;AND PRODUCE [SETZM FILD-1(LP)]
	TLNN	C,F.COMA	;MORE ?
	JRST	NXTSTA		;NO
	PUSHJ	P,GETCNA	;GET EM
	JRST	XCLOS0
 
;DATA STATEMENT
 
;<DATA STA>::= DATA <DEC NBR!STRING> [,<DEC NBR!STRING>...]
 
;NOTE:	A DATA STRING ::= "  <ANY CHARS EXCEPT CR,LF>  "
;	OR	::= <A LETTER><ANY CHARS EXCEPT COMMA OR APOST,CR,LF>
 
;NO CODE IS GENERATED FOR A DATA STATEMENT
;RATHER, THE DATA STATEMENT IN THE SOURCE
;TEXT ARE REREAD AT RUN TIME.
XDATA:	ASCIZ	/A/
	SKIPL	DATAFF		;ALREADY SEEN DATA?
	MOVEM	L,DATAFF	;NO.  REMEMBER WHERE FIRST ONE IS
	SETZM	INPFLA
	PUSHJ	P,DATCHK	;CHECK FOR LEGAL DATA
	FAIL	<? DATA not in correct form>
	SKIPE	MULLIN		;WITHIN MULTI-LINE ?
	FAIL	<? DATA must be first in line>
	JRST	NXTSTA
 
 
;DEF STATEMENT
 
;<DEF STA> ::= DEF FN<LETTER>(<ARGUMENT>) = <EXPRESSION>
 
;GENERATED CODE IS:
;	JRST	<A>		;JUMP AROUND DEF
;	XWD	0,0		;CONTROL WORD
;	MOVEM	N,(B)		;SAVE ARGUMENT IN TEMPORARY
;	...
;	(EVALUATE EXPRESSION)
;	JRST	RETURN		;GO TO RETURN SUBROUTINE
;<A>:	...			;INLINE CODING CONTINUES...
 
;SEE GOSUB STATEMENT FOR USE OF CONTROL WORD.
 
;DURING EXPRESSION EVALUATION, LOCATION
;FUNARG CONTAINS ASCII REPRESENTATION OF ARGUMENT NAME.
;ROUTINES CALLED BY FORMLN CHECK FOR USE OF ARGUMENT AND RETURN POINTER
;TO FIRST WORD ON TEMPORARY ROLL.
 
;PRIOR TO GEN OF FIRST EXPRESSION EVALUATION, THE "REAL" TEMPORARY
;ROLL IS SAVED ON "STMROL" AND AN EMPTY "TEMROL" IS CREATED.
;AFTERWARDS, THE NEW "TEMROL" ENTRIES ARE ADDED TO THE PERMANENT
;TEMPORARY ROLL "PTMROL" AND "TEMROL" IS RESTORED.
;THUS EACH DEFINED FUNCTION HAS ITS OWN SET OF TEMPORARIES
;AND CANNOT CONFLICT WITH TEMPORARIES USED BY THE EXPRESSION
;BEING EVALUATED AT THE POINT OF THE CALL.
 
;NOTE. SPECIAL CASE:  CHECK FOR FUNCTION DEF AS LAST LINE OF PROGRAM
;SUPPRESSES GEN OF "JRST" INSTR.  COMPILATION WILL FAIL
;("NO END STATEMENT"); HOWEVER THE WORD AFTER LADROL WOULD BE
;CLOBBERED IF "JRST" WERE GENNED.
 
XDEF:	ASCIZ	/FN/		;HANDLE THE FN PART AUTOMATICALLY
	SKIPE	FUNAME		;ARE WE IN MIDST OF MULTI-LINE DEF?
	FAIL <? Nested DEF>
	MOVEI	D,1
	MOVEM	D,VRFSET
	MOVSI	D,(JFCL)	;MAKE SURE NOT FIRST WRD OF CODE
	MOVE	X1,CECOD
	CAMG	X1,FLCOD
	PUSHJ	P,BUILDI
	TLNN	C,F.LETT	;MAKE SURE LETTER FOLLOWS.
	JRST	ERLETT
	PUSHJ	P,SCNLT1	;SCAN FCN NAME.
	PUSHJ	P,DIGIT		;CHECK FOR A DIGIT
	HRLZI	F,-1		;MARK NUMERIC FOR NOW
	PUSHJ	P,DOLLAR	;CHECK FOR $
	TLZA	F,-2		;MARK STRING, NO % POSSIBLE
	PUSHJ	P,PERCNT	;CHECK FOR A PERCENT
	PUSH	P,A		;SAVE FCN NAME WITH COUNT OF ZERO ARGUMENTS
	MOVEM	A,FUNAME	; FN'NAME IN BODY OF FUNCTION
	MOVE	X1,TYPE		;SAVE THE TYPE OF
	MOVEM	X1,FTYPE	;THE FUNCTION IN FTYPE
 
 
;ADD FUNCTION NAME TO FCNROL
 
XDEF1:	MOVEI	R,FCNROL	;LOOK FOR FCN NAME IN FCNROL
	PUSHJ	P,SEARCH
	JRST	XDLAB1
	SETZM	FUNAME
	FAIL	<? Function defined twice>
XDLAB1:	MOVEI	E,1		;ADD TO FCNROL
	PUSHJ	P,OPENUP
	ADD	A,CECOD ;CONSTRUCT PNTR TO CONTROL WORD
	SUB	A,FLCOD ;STORE IN FCNROL ENTRY.
	ADDI	A,1
	MOVEM	A,(B)
 
	MOVE	B,L		;GET JRST DESTINATION
	AOBJP	B,XDLAB2
	PUSHJ	P,HALJRS
XDLAB2:	MOVEM	B,FUNSTA
	CLEAR	D,		;BUILD ZERO CONTROL WORD
	PUSHJ	P,BUILDI
	PUSH	P,D		;AND ARGUMENT TYPE MASK
	MOVEI	D,1		;SET UP FOR ARG BITS.
 
;SCAN FOR ARGUMENT NAME.
 
XDEF2:	CAIE	C,"("	;ANY ARGUMENTS?
	JRST	XDEF4		;NO
 
XDEF2A: PUSHJ	P,NXCHK 	;SKIP "("
	PUSHJ	P,SCNLT1	;ASSEMBLE ARGUMENT NAME
	PUSHJ	P,DIGIT		;SEE IF DIGIT FOLLOWS
	PUSHJ	P,DOLLAR	;CHECK FOR STRING
	JRST	XDEF5A		;
	PUSHJ	P,PERCNT	;CHECK FOR INTEGER
	TLNN	A,4		;IS IT?
	JRST	XDEF5		;NO, MARK AS REAL
	IORM	D,(P)		;MARK ONE BIT
	JRST	XDEF5A		;GO TO MARK NEXT
XDEF5:	IORM	D,(P)		;MARK AS REAL
	LSH	D,2		;SET FOR NEXT ARG
	JRST	XDEF5B		;
XDEF5A:	LSH	D,1		;SKIP A BIT
	IORM	D,(P)		;MARK FOR STRING
	LSH	D,1		;SET FOR NEXT ARG
XDEF5B:	SKIPN	D		;ANY BITS LEFT ?
	FAIL	<? Too many function arguments>
	MOVEI	R,ARGROL	;NOW ADD THIS NAME TO THE ARGUMENT LIST
	MOVE	B,FLARG 	;NOW CHECK ARGROL, FOR TWO IDENTICAL ARGS
XDEF2C: CAML	B,CEARG
	JRST	XDEF2D
	CAME	A,(B)
	AOJA	B,XDEF2C
	SETZM	FUNAME
	JRST	GRONK
 
XDEF2D: MOVEI	E,1		;ADD NEW ARG TO ROLL
	PUSHJ	P,OPENUP
	MOVEM	A,(B)
	AOS	-1(P)		;COUNT THE ARGUMENT
	TLNE	C,F.COMA	;ANY MORE ARGS?
	JRST	XDEF2A		;YES
 
XDEF3:	TLNN	C,F.RPRN	;FOLLOWING PARENTHESIS?
	JRST	[SETZM	FUNAME
		JRST	ERRPRN] ;NO.
	PUSHJ	P,NXCHK 	;YES. SKIP IT.
XDEF4:	PUSHJ	P,ARGCHK	;CHECK FOR RIGHT NUMBER OF ARGUMENTS
 
 
;GEN CODE TO EVALUATE EXPRESSION.
 
	MOVE	X1,FLTMP	;SAVE TEMP ROLL AS STMROL
	MOVEM	X1,FLSTM
	MOVEM	X1,CETMP	;AND EMPTY TMPROL
	MOVE	X1,TMPLOW	;SAVE TEMP POINTER
	MOVEM	X1,FUNLOW
	SETOM	TMPLOW
	SETOM	TMPPNT
	TLNN	C,F.EQAL	;MULTI LINE FN?
	JRST	XDEFM		;YES
	PUSHJ	P,NXCHK 	;NO. SKIP EQUAL SIGN
	SETZM	FUNAME		;SIGNAL THAT THIS IS NOT A MULTI-LINE FN
 
	PUSHJ	P,FORMLU	;GEN THE EXPRESSION
	PUSH	P,B		;SAVE B
	PUSHJ	P,CMIXER	;
	POP	P,B		;RESTORE B
	PUSHJ	P,EIRGNP	;GET IT IN REG
 
;NOW BUILD AN INSTRUCTION THAT WILL TELL RETURN HOW MANY ARGS TO POP
;OFF THE PUSH LIST
 
	POP	P,B		;DITCH ARGUMENT TYPE MASK
	POP	P,B		;ARGCHK PUT THE ADDRESS OF A CONSTANT IN HERE
XDEFE:	MOVSI	D,(MOVE T,)
	PUSHJ	P,BUILDA
	MOVE	X2,CETMP	;RESTORE TMPROL, SAVE TEMPORARIES FOR FCN
	MOVE	X1,CESTM
	MOVEM	X2,CEPTM
	MOVEM	X2,FLTMP
	MOVEM	X1,CETMP
	MOVEM	X1,FLSTM
 
	HRRE	X1,FUNLOW	;RESTORE TMPLOW
	MOVEM	X1,TMPLOW
	HRRZ	X1,FUNSTA	;-1(X1) IS LOC OF JRST AROUND FUNCTION
	ADD	X1,FLCOD
	HRRZ	X2,CECOD	;JRST TO THE NEXT INST TO BE CODED
	ADDI	X2,1
	HRRM	X2,(X1)
 
	MOVE	D,[JRST FRETRN]
	JRST	XRET1		;USE RETURN CODE TO BUILD INST
 
XDEFM:
	SKIPE	MULLIN		;MULTI STATEMENT ?
	FAIL<? DEFINE must be first in line>
	POP	P,X1		;DITCH ARGUMENT TYPE MASK
	POP	P,X1	 ;MULTI-LINE DEF. SAVE THE ARGCOUNT PARAMETER FOR FNEND
	HRLM	X1,FUNSTA
	MOVE	X1,CEFOR		;SAVE NUMBER OF ACTIVE FORS
	SUB	X1,FLFOR		;FOR A CHECK OF FORS HALF IN DEF
	HRLM	X1,FUNLOW
 
	TLNE	C,F.CR
	JRST	NXTSTA
	MOVE	D,[JSP A,LINADR]
	PUSHJ	P,BUILDI
	MOVE	D,SORCLN
	PUSHJ	P,BUILDI
	JRST	NXTSTA
 
 
;DIM STATEMENT
;<DIM STA> ::= DIM <LETTER>[$](<NUMBER>[,<NUMBER>])[,<LETTER>[$](<NUMBER>[,<NUMBER>])...]
 
;FOR EACH ARRAY, HAVE ONE-WORD ENTRY IN VARROL
;WHICH POINTS TO THREE-WORD ENTRY IN ARAROL
;WHOSE FORMAT IS:
;	(<LENGTH OF ARRAY>)<PNTR>
;	(<LEFT DIM>+1)<RIGHT DIM>+1
;THE THIRD WORD IS .LT. 0 IF THE MATRIX IS SET EQUAL TO ITS OWN TRN,
;GT.0 IF THIS IS THE FAKE MATRIX USED FOR TMP STORAGE DURING MATA=
;TRN(A), OTHERWISE IT IS 0.
 
;DURING COMPILATION, <PNTR> IS CHAIN OF REFERENCES.
;DURING EXECUTION, <PNTR> IS ADDRS OF FIRST WORD.
 
XDIM:	PUSHJ	P,QSA
	ASCIZ	/ENSION/
	JFCL	
	PUSH	P,AFLAG		;SAVE A FLAG
	CLEARM	VIRDIM		;ASSUME NOT VIRTUAL ARRAY
	CAME	C,[XWD F.STR,"#"] ;IS IT VIRTUAL ARRAY
	JRST	XDIMA		;NO, CARRY ON
	PUSHJ	P,NXCH		;EAT THE #
	MOVEI	N,1		;INITIALIZE STARTING WORD
	MOVEM	N,VIRSIZ	;TO ONE
	MOVEM	N,VIRWRD	;SET CURRENT WORD TO ONE
	CLEARM	VIRBLK		;CURRENT BLOCK IS ZERO
	CLEARM	IFFLAG		;CLEAR TYPE FLAG
	PUSHJ	P,GETNUM	;GET THE CHANNEL
	CAIA			;ERROR
	CAILE	N,^D9		;MUST BE LESS THAN 10
XDLAB3:	FAIL	<? Illegal channel specified>
	JUMPE	N,XDLAB3		;CAN'T BE ZERO EITHER
	MOVEM	N,VIRDIM	;SAVE CHANNEL
	TLNN	C,F.COMA	;NEED A COMMA NOW
	JRST	ERCOMA		;AND WE DIDN'T GET IT
	PUSHJ	P,NXCHK		;GET FIRST CHARACTER OF VARIABLE
XDIMA:	SETZI	F,		;ALLOW STRING VECTORS.
	PUSHJ	P,ARRAY 	;REGISTER ARRAY NAME
	CAIE	A,5		;STRING VECTOR? ELSE..
	JUMPN	A,GRONK 	;NON-0 RESULT FLAG-SYNTAX ERROR.
	CAIE	C,"("		;CHECK OPENING PAREN
	JRST	ERLPRN
	ADD	B,FLOOR(F)	;COMPUTE LOC OF ROLL ENTRY
	SKIPLE	X1,1(B) 	;DIMENSION FLAG SHOULD BE 0 OR -1 OR -2.
	FAIL	<? Variable dimensioned twice>
	MOVEM	X1,TEMLOC
	PUSHJ	P,NXCHK 	;SKIP PARENTHESIS
	PUSHJ	P,GETNU ;FIRST DIMENSION
	JRST	GRONK		;NOT A NUMBER
	JUMPN	N,XDLAB4
	SETZM	TEMLOC
XDLAB4:	TLNE	N,-1		;WITHIN RANGE
	FAIL	<? Dimensions too large>
	HRRZ	D,N		;SAVE FIRST DIM
	AOBJN	D,XDLAB5	;D::= XWD <FIRST DIM+1>,1
XDLAB5:	MOVSM	D,1(B)		;STORE IN ARAROL (IN CASE 1 DIM)
	MOVEI	N,1		;IN CASE ONE DIMENSION
	TLNN	C,F.COMA	;TWO DIMS?
	JRST	XDIM1		;NO
	PUSHJ	P,NXCHK 	;YES. SKIP COMMA.
	PUSHJ	P,GETNU ;GET SECOND DIM
	JRST	GRONK		;NOT A NUMBER
	JUMPN	N,XDLAB6
	SETZM	TEMLOC
XDLAB6:	TLNE	N,-1
	FAIL	<? Dimensions too large>
	ADDI	N,1
	HRL	D,N		;NOW D HAS XWD <COLS+1>,<ROWS+1>
	MOVSM	D,1(B)		;STORE IN ROLL SWAPPED
	MOVNI	X1,2
	CAMN	X1,TEMLOC
	FAIL	<? Vector cannot be matrix>
XDIM1:	TLNN	C,F.RPRN	;RIGHT PAREN?
	JRST	ERRPRN		;NO, GIVE ERROR
	PUSHJ	P,NXCH		;GET NEXT CHARACTER
	IMULI	N,(D)		;CALCULATE SIZE OF THE ARRAY
	SKIPN	VIRDIM		;VIRTUAL ARRAY?
	JRST	XDIM8		;NO, JUST STORE SIZE
	PUSH	P,T		;SAVE T
	SUB	B,FLOOR(F)	;MAKE B AN OFFSET TO ARRAY ROLLS
	PUSH	P,B		;AND SAVE IT
	MOVEI	A,0		;NEED TWO ZERO LOCATIONS
	MOVEI	R,VIRROL	;IN THE VIRTUAL ARRAY ROLL
	PUSHJ	P,RPUSH		;GET FIRST LOCATION
	PUSHJ	P,RPUSH		;GET SECOND LOCATION
	SOJ	B,		;POINT TO FIRST LOCATION
	JUMPGE	F,XDIM4		;STRING VIRTUAL ARRAY?
	SKIPLE	IFFLAG		;NUMERIC FOLLOWING NUMERIC?
	JRST	XDIM3		;NO, MUST HAVE FOLLOWED A STRING
;
;	NUMERIC ARRAY FOLLOWING NUMERIC ARRAY
;
	SKIPN	X1,VIRBLK	;FIRST BLOCK OF FILE
	JRST	XDIM2		;YES, JUST USE VIRWRD
	IMULI	X1,^D128	;128 WRODS PER BLOCK
	SUBI	X1,2		;EXCEPT FOR FIRST BLOCK
XDIM2:	ADD	X1,VIRWRD	;PLUS PARITALLY FILLED BLOCK
XDIM2A:	MOVEM	X1,(B)		;STORE RANDOM RECORD NUMBER FOR PETE
	IDIVI	N,^D128		;NUMBER OF BLOCKS NEEDED FOR THIS ARRAY
	ADD	T,VIRWRD	;ADD PARTIAL BLOCK
	SKIPN	VIRBLK		;FIRST BLOCK?
	ADDI	T,2		;REMEMBER THE TWO WORDS
	IDIVI	T,^D128		;TWO PARTIALS EQUAL ONE BLOCK
	ADDM	T,VIRBLK	;COULD BE
	SKIPN	VIRBLK
	SUBI	T1,2
	MOVEM	T1,VIRWRD	;SAVE PARTIAL WORD BLOCK POINTER
	ADDM	N,VIRBLK	;ADD IN BLOCKS NEEDED
	JRST	XDIM7		;FIX UP CHANNEL NUMBER
;
;	NUMERIC FOLLOWING A STRING ARRAY
;
XDIM3:	MOVE	X1,VIRBLK	;CURRENT BLOCK NUMBER
	IMULI	X1,^D128	;NUMBER OF WORDS USED
	SOJ	X1,		;LESS TWO IN FIRST BLOCK
	MOVEI	X2,1		;START NEW BLOCK
	MOVEM	X2,VIRWRD	;STARTS AT FIRST WORD
	AOS	VIRBLK		;STEP TO NEXT BLOCK
	JRST	XDIM2A		;FIX UP FOR NEXT ARRAY
;
;	HERE FOR STRING ARRAY
;
XDIM4:	MOVEM	N,VIRSIZ	;SAVE SIZE OF ARRAY
	MOVEI	N,^D16		;DEFAULT SIZE FOR STRING IS 16
	TLNN	C,F.EQAL	;SIZE GIVEN?
	JRST	XDIM4B		;NO, USE DEFALUT
	PUSHJ	P,NXCH		;EAT THE EQUALS
	PUSHJ	P,GETNU		;GET THE SIZE
	FAIL	<? Illegal string size>
	MOVEM	T,-1(P)		;RESET T
	CAIG	N,^D128		;WITHIN LIMITS
	SOJGE	N,XDLAB7	;NOT ZERO
	FAIL	<? Illegal string size>
XDLAB7:	JFFO	N,XDLAB8		;
	MOVEI	T,^D35		;
XDLAB8:	MOVNS	T		;NEGATE T
	MOVSI	N,400000	;SETUP FOR SHIFT
	LSH	N,1(T)		;SHIFT ONE FOR CORRECT POWER
XDIM4B:	HRLM	N,1(B)		;PUT STRING SIZE IN VIRROL
	SKIPLE	IFFLAG		;FOLLOWING A NUMERIC?
	JRST	XDIM6		;NO, SEE IF WE CAN FIT IN A RECORD
	SKIPN	VIRBLK		;STILL IN FIRST BLOCK
	AOS	VIRBLK		;YES, MAKE IT ONE
XDIM5:	AOS	X1,VIRBLK		;START NEW BLOCK
	MOVEI	X2,1		;AND FIRST WORD
	MOVEM	X2,VIRWRD	;OF NEW BLOCK
	HRLM	X2,(B)		;SAVE BYTE COUNT
	HRRM	X1,(B)		;AND BLOCK COUNT IN VIRROL
	IMUL	N,VIRSIZ	;NUMBER OF BYTES NEEDED
XDIM5A:	IDIVI	N,^D512		;NUMBER OF BLOCKS NEEDED
	AOJ	T,		;POINT TO NEXT RECORD
	MOVEM	T,VIRWRD	;SAVE PARTIAL WORD FILL
	ADDM	N,VIRBLK	;UPDATE BLOCK COUNT
	JRST	XDIM7		;SETUP CHANNEL
XDIM6:	MOVEI	X1,^D513	;BLOCK SIZE + 1
	SUB	X1,VIRWRD	;NUMBER OF WROD LEFT
	IDIV	X1,N		;CAN REOCRDS FIT IN
	JUMPN	X2,XDIM5	;NOT EVENLY, START A NEW BLOCK
	MOVE	T,VIRBLK	;CURRENT BLOCK
	HRL	T,VIRWRD	;GET BYTE COUNT
	MOVEM	T,(B)		;SAVE IN VIRROL
	IMUL	N,VIRSIZ	;CHARACTER SIZE
	SUBI	N,^D513		;PLUS FULL BLOCK + 1
	ADD	N,VIRWRD	;LESS SPACE ALREADY USED
	AOS	VIRBLK		;POINT TO NEXT BLOCK
	JRST	XDIM5A		;CARRY ON
XDIM7:	MOVE	X1,VIRDIM	;GET CHANNEL NUMBER
	HRRM	X1,1(B)		;STORE IN VIRROL
	MOVEM	F,IFFLAG	;SAVE TYPE FOR THIS ARRAY
	SUB	B,FLVIR		;MAKE B AN OFFSET
	TRO	B,400000	;FLAG IT AS VIRTUAL ARRAY
	POP	P,X1		;GET BACK ARRAY ROLL OFFSET
	ADD	X1,FLOOR(F)	;MAKE IT ABSOLUTE
	HRLM	B,(X1)		;STORE IN ARRAY ROLL
	POP	P,T		;RESTORE T
	JRST	XDIMFN		;FINISH THE DIMENSIONS
XDIM8:	CAILE	N,377777	;CHECK MAXIMUM DIMENSION SIZE
	FAIL	<? Dimensions too large>
	HRLM	N,0(B)		;STORE IN ROLL
XDIMFN:	TLNN	C,F.COMA
	JRST	XDMFN1		;NO, DONE WITH THIS STATEMENT.
	PUSHJ	P,NXCHK 	;SKIP THE COMMA.
	JRST	XDIMA		;KEEP SCANNING.
XDMFN1:	POP	P,AFLAG		;RESTORE A FLAG
	JRST	NXTSTA		;NEXT STATEMENT
 
 
; ELSE STATEMENT
 
 
XELS:	MOVEM	T,MULLIN	;SAVE POINTER
	PUSHJ	P,QSA		;CHECK FOR FULL ELSE
	ASCIZ	/E/
	JRST	ILLINS		;ILLEGAL INSTRUCTION
	SOSGE	THNCNT		;IS ELSE LEGAL?
	FAIL	<? ELSE without THEN>
	SKIPE	ELSFLG		;SINGLE WORD THEN
	JRST	XELS0		;YES, SKIP THEN FIX
	MOVE	X1,THENAD	;PICK UP THEN LINKAGE
	MOVE	B,CECOD		;ADDRESS FOR ELSE CLAUSE
	AOJ	B,		;
	SKIPN	RUNFLA		;STILL RUNNING?
	JRST	XELS0		;NO, CONTINUE
	ADD	X1,FLCOD	;POINT TO CODROL
	HRRZ	X2,(X1)		;PICK UP NEW LINK
	MOVEM	X2,THENAD	;SAVE IT
	HRRM	B,(X1)		;SET THEN ADDRESS
XELS0:	TLNE	C,F.DIG		;LINE NUMBER?
	JRST	ELSGO		;SPECIAL TREATMENT
	SKIPE	ELSFLG		;SINGLE WORD THEN?
	JRST	XELS1		;YES, NO JRST NEXT STATEMENT ADDRESS
	PUSHJ	P,HALJRS	;JRST TO NEXT STATEMENT
	PUSHJ	P,FIXELS	;FIX LINK FOR ELSEAD'S
XELS1:	CLEARM	ELSFLG		;NO MORE SINGLE WORD THENS
	TLNE	C,F.TERM	;TERMINATOR ?
	FAIL	<? Illegal ELSE>
	JRST	NXSM1		;NEXT STATEMENT
ELSGO:	MOVSI	D,(CAIA)	;SKIP FROM THEN
	SKIPN	ELSFLG		;UNLESS SINGLE WORD
	PUSHJ	P,BUILDI	;
	PUSHJ	P,XGOFR		;HANDLE THE LINE NUMBER
	SETZM	ELSFLG		;UNSET SINGLE WORD THEN
	TLNN	C,F.CR		;CARRIAGE RETURN
	CAMN	C,[XWD F.APOS,"'"] ;
	JRST	NXSM2		;YES, DONE WITH STATEMENT
	PUSHJ	P,QSELS		;ELSE NEXT
	JRST	ERTERM		;NO, THEN SHOULD BE TERMINATOR
	JRST	NXTSTA		;NEXT STATEMENT
FIXTHN:	SKIPN	RUNFLA		;STILL RUNNING?
	POPJ	P,		;NO, RETURN
	SKIPN	X1,THENAD	;FIRST IN LINK?
	JRST	FIXTH1		;NO, JUST SAVE THENAD
	ADD	B,FLCOD		;POINT TO CODROL
	HRRM	X1,(B)		;NO, MAKE LINK
	SUB	B,FLCOD		;BACK TO OFFSET
FIXTH1:	MOVEM	B,THENAD	;SAVE POINTER
	POPJ	P,		;RETURN
FIXELS:	SKIPN	RUNFLA		;STILL RUNNING?
	POPJ	P,		;NO, JUST RETURN
	SKIPN	X1,ELSEAD	;FIRST IN LINK?
	JRST	FIXEL1		;NO, JUST SAVE ELSEAD
	ADD	B,FLCOD		;
	HRRM	X1,(B)		;NO, MAKE LINK
	SUB	B,FLCOD		;
FIXEL1:	MOVEM	B,ELSEAD	;SAVE POINTER
	POPJ	P,		;RETURN
 
;END STATEMENT
 
;<END STA> ::= END
 
XEND:	MOVE	X1,FLLIN	;CHECK THAT IT IS LAST STA
	ADDI	X1,1(L)
	CAMN	X1,CELIN
	TLNN	C,F.CR
	FAIL	<? END is not last>
 
	SKIPN	FUNAME
	JRST	XEND1
	PUSHJ	P,INLMES
	ASCIZ	/
? No FNEND for DEF FN/
	MOVEI	T,FUNAME
	SETZ	D,
	PUSHJ	P,PRINT
	SKIPE	CHAFL2		;CHAINING?
	JRST	ERRMS2		;YES.
	PUSHJ	P,INLMES
	ASCIZ/
/
	JRST	LUXIT
 
XEND1:	SKIPE	THNELS		;UNDER THEN OR ELSE ?
	FAIL	<? END under conditional>
	MOVE	D,[JRST EUXIT]	;COMPILE TERMINAL EXIT
	PUSHJ	P,BUILDI
	JRST	LINKAG		;GO FINISH UP AND EXECUTE
 
 
;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 OR FLOAT IT
	JRST	XFOR4+1		;
XFOR2:	HLRZ	X1,B		;CASE OF A POSITIVE
	ANDI	X1,ROLMSK	;CONSTANT, FORCE THE
	CAIN	X1,CADROL	;UPPERBOUND TO BE
	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
	JRST	XFOR6
	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+1		;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,CECOD	;NEXT LOC
	SUB	X1,FLCOD
	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
 
 
FIXADR:	SKIPN	RUNFLA		;GOING TO RUN
	POPJ	P,		;NO, JUST RETURN
	ADD	X1,FLCOD	;FIX CODROL ADDRESS
	HRRM	B,(X1)		;FIX JRST ADDRESS
	POPJ	P,		;RETURN
HALJRS: SKIPE	SAVRUN		;MAKING SAV CODE ?
	SKIPA	D,[HALT]	;HALT MARKS FOR RELOCATION
	MOVSI	D,(JRST)	;ELSE JRST
	PUSHJ	P,BUILDI
	POPJ	P,
 
 
;FNEND STATEMENT
 
;<FNEND STA> ::= FNEND
 
XFNEND: ASCIZ /ND/
	SKIPN	A,FUNAME	;MUST FOLLOW A MULTI-LINE FN DEF
	FAIL <? FNEND before DEF>
	SKIPE	THNELS		;CANT BE CONDITIONAL
	FAIL <? FNEND under conditional>
	SETZM	FUNAME		;SIGNAL END OF FN
	TLO	A,2		;ASSEMBLE THE SCALAR NAME OF THE RESULT
	HRLI	F,-1		;MARK NUMERIC FOR NOW
	TLNE	A,10		;WAS IT STRING ?
	TLZA	F,-2		;YES
	PUSHJ	P,[AOS	(P)	;NO, REGISTER SCALAR
		JRST	SCAREG]
	PUSHJ	P,STRREG	;REGISTER STRING
	PUSHJ	P,EIRGNP	;GET THE RESULT IN REG
	HLRZ	B,FUNSTA	;RECOVER THE ADDRESS OF THE ARGUMENT COUNT
	HRLI	B,CADROL
	HLRZ	X1,FUNLOW	;THIS IS # OF WDS IN FORROL AT START OF DEF
	ADD	X1,FLFOR
	CAME	X1,CEFOR	;ARE ALL NEXTS INSIDE OF DEF COMPLETE?
	FAIL <? FNEND before NEXT>
	TLNE	C,F.TERM	;E.O.L. ?
	CAMN	C,[XWD	F.APOS,"\"] ;AND NOT MULTI
	FAIL<? FNEND not last in line>
	JRST	XDEFE		;FINISH UP END OF FN
 
 
 
;GOSUB STATEMENT XLATE
 
XGOSUB: ASCIZ	/UB/
	SETZM	ONGFLG		;NOT ON ---- GOSUB
XGOSU:	SKIPE	FUNAME
	FAIL	<? GOSUB within DEF>
XGOS:	PUSHJ	P,GETNUM	;READ STATEMENT NUMBER
	FAIL	<? Illegal line reference>
	HRLZ	A,N
	MOVEI	R,LINROL	;LOOK UP LINE NO
	PUSHJ	P,SEARCH
	FAIL	<? Undefined line number >,1
	SUB	B,FLLIN 	;SUCCESS.  SAVE REL LOC IN LINROL
	HRLZ	A,B
	MOVEI	R,GSBROL
	PUSHJ	P,SEARCH
	CAIA		
	JRST	XGOS1
	MOVEI	E,1
	PUSHJ	P,OPENUP
	MOVEM	A,(B)
XGOS1:	SUB	B,FLGSB
	HRLI	B,GSBROL
	MOVSI	D,(GOSUB)
	PUSHJ	P,BUILDA
	SKIPE	ONGFLG
	TLNN	C,F.COMA	;MORE ARGS FOR ON ---- GOSUB ?
	JRST	NXTSTA
	PUSHJ	P,NXCHK
	JRST	XGOS
 
 
 
;GOTO STATEMENT
 
XGOTO:	ASCIZ	/O/
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
 
	MOVE	X1,FLREF
	ADD	X1,B
	MOVE	X1,(X1)
	CAME	X1,FUNAME	;BOTH MUST BE ZERO OR SAME FUNCTION.
	FAIL	<? Illegal line reference >,1
	MOVE	D,CECOD
	CAME	D,FLCOD
	JRST	XGO1
	PUSH	P,B		;SPECIAL FIX FOR LOADER,
	MOVSI	D,(JFCL)	;IN CASE GO IS FIRST INSTRUCTION.
	PUSHJ	P,BUILDI
	POP	P,B
 
XGO1:	HRLI	B,LADROL
	MOVSI	D,(JRST)
	PUSHJ	P,BUILDA	;BUILD INSTR
	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 CONDITIONAL
	TLNN	C,F.DIG 	;NEXT CHAR A DIGIT ?
	JRST	IFCGO		;NO
	PUSHJ	P,XGOFR 	;USE GOTO CODE TO GEN JRST INSTR
	SETOM	ELSFLG		;MARK SINGLE WORD THEN
	TLNN	C,F.CR		;END OF LINE
	CAMN	C,[XWD F.APOS,"'"] ;
	JRST	NXSM1		;YES
	PUSHJ	P,QSELS		;CHECK FOR ELSE
	JRST	ERTERM
	MOVEM	T,MULLIN	;SAVE POINTER
	JRST	NXSM1		;NEXT STATEMENT
IFCGO:	PUSHJ	P,REVSEN	;REVERSE LOGIC
	PUSHJ	P,HALJRS	;JRST/HALT AROUND THEN CODE
	PUSHJ	P,FIXTHN	;FIX THENAD LINKAGE
	JRST	NXSM1
 
 
IFCCOD:	PUSHJ	P,FORMLB	;
	MOVE	X2,CECOD	;LAST CODE GENERATED
	HLRZ	X1,-1(X2)	;CHECK FOR POSSIBLE OPTIMIZATION
	CAIE	X1,(SETO)	;WAS TDZA AND SETO GENERATED?
	JRST	IFCOD1		;NO, THEN MUST TEST TRUTH VALUE
	MOVE	B,X2		;NEW ADDRESS
	SUBI	B,2		;YES, REMOVE THE TWO INSTRUCTIONS
	MOVEM	B,CECOD		;BY SETTING NEW CEIL
	SOJ	B,		;LAST CODE GENERATED ADDRESS
	SUB	B,FLCOD		;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:	SKIPN	RUNFLA		;STILL GOING TO RUN?
	POPJ	P,		;NO, JUST RETURN
	ADD	B,FLCOD 	;ADDRESS OF LAST RELATION
	MOVE	D,(B)		;CAM??/SKIP? INSTRUCTION
	TLC	D,4000		;REVERSE SENSE
	MOVEM	D,(B)		;PUT BACK
	SUB	B,FLCOD		;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:	CLEARM	INPPRI		;SET FLAG NOT TTY INPUT
	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, DON'T CHECK FOR OUTPUT STRING
	SETOM	INPPRI		;FLAG, STRING CAN BE OUTPUT
	TLNN	C,F.QUOT	;IS THERE A STRING TO OUTPUT
	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, 
	TLNE	F,-2		;WAS IT 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, CARRAY ON
	PUSH	P,D		;SAVE D
	PUSH	P,B		;SAVE B
	MOVE	D,[SETOM INLNFG] ;FLAG INPUT LINE
	PUSHJ	P,BUILDI	;GEN IT
	POP	P,B		;RESTORE B
	POP	P,D		;RESTORE D
	TLNN	C,F.TERM	;ONLY ON STRING PER INPUT LINE
	FAIL	<? Line input takes only one string>
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
;
;	HERE TO HANDLE STRING CONSTANT ON INPUT
;
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 FIX 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
 
 
 
;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	;CHANGE MARGAL TO 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	;GET CHANNEL AND CHECK DELIMITER
XMAR5:	PUSHJ	P,FORMLN
	PUSHJ	P,EIRGEN
	PUSHJ	P,CHKINT	;MUST BE INTEGER
	MOVE	D,[PUSHJ P,PAGE]
	SKIPN	TABLE
	HRRI	D,MARGN		;CHANGE PAGE TO MARGN
	PUSHJ	P,BUILDI
	PUSHJ	P,CHKDEL	;CHECK FOR DELIMITER
	JRST	XMAR1		;FOUND ONE
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,FLCOD		;ADDRESS OF STRING UUO
	HLLZ	D,0(B)		;GET THE UUO
	PUSHJ	P,CHKFMT	;CHECK FORMAT CHARACTER
XMAT2B: TLNN	D,140
	JRST	GRONK		;FAIL IF ILLEGAL
	HLLM	D,0(B)		;RETURN STRING UUO
	TLNE	C,F.TERM	;IS FORMAT CHAR FOLLOWED BY END OF STA?
	JRST	NXTSTA		;YES.
	JRST	XMAT2A		;PROCESS NEXT ARRAY NAME
 
 
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 ARRAY 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

VCTOR:	PUSHJ	P,ARRAY		;REGISTER ARRAY OR VECTOR
	CAIE	A,5		;STRING ?
	JUMPN	A,CPOPJ		;NO, ARRAY ?
	MOVE	X2,1(X1)	;YES
	JUMPG	X2,CPOPJ
	MOVNI	X2,2
	MOVEM	X2,1(X1)
	POPJ	P,		;RETURN
 
;<MAT SCALE STA> ::= MAT <LETTER>=(<EXPRESSION>)*<LETTER>
 
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
	MOVEM	X1,FTYPE	;SAVE THE TYPE
	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
	CAME	X1,FTYPE
	JRST	MTYERR
	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
 
 
;<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		;
	TLO	D,400		;
	PUSH	P,D
	HRLI	F,777777
	PUSHJ	P,ARRAY
	JUMPN	A,GRONK
	PUSHJ	P,MATCHK	;CHECK THAT ITS NOT VIRTUAL
	MOVE	X1,TYPE
	CAME	X1,FTYPE
	JRST	MTYERR
	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
	MOVEM	X1,FTYPE	;
	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
	TLO	D,400
	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
	CAME	X1,FTYPE
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
	MOVE	D,[MOVEI N,1]
	PUSHJ	P,BUILDI	;BUILD INST TO GET SCAL FACTOR
	POP	P,B		;GET SOURCE MAT BACK
	PUSH	P,[MATSCA]
	JRST	XMAT9B
 

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		;CHECK IF UNDER THEN-ELSE
	FAIL	<? NEXT under conditional>
XNEX0:	TLNN	C,F.TERM	;NEXT WITHOUT ARGUMENT?
	JRST	XNEX3		;YES, FOR-NEXT LOOP
	MOVE	X1,CEFOR		;CHECK UNSAT WHILE/UNTIL
	CAMG	X1,FLFOR	;ANYTHING ON FOR ROLL
	FAIL	<? NEXT without WHILE/UNTIL>
	SETO	X2,		;MAKE SURE THIS IS A UNTIL/WHILE
	CAME	X2,-3(X1)	;INDUCTION VARIABLE -1
	CAMN	X2,-2(X1)	;INCREMENT -1
	CAIA			;YES, ALL IS SWELL
	FAIL	<? Illegal NEXT statement>
	PUSHJ	P,POPFOR	;GET TEMPORARY PROTECTION
	MOVEM	B,TMPLOW	;SHOULD NOT HAVE BEEN CHANGED
	MOVEM	B,TMPPNT	;
	PUSHJ	P,POPFOR	;REMOVE -1 FOR INCREMENT
	PUSHJ	P,POPFOR	;REMOVE -1 FOR INDUCTION
	PUSHJ	P,POPFOR	;GET JRST ADDRESSES
	PUSH	P,[Z NXTSTA]	;SET UP THE RETURN
	JRST	XNEX5		;LET FOR-NEXT CODE HANDLE 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 ISN'T WHILE/UNTIL
	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		;
	MOVSI	D,(ADD)		;
	PUSHJ	P,BUILDA
	PUSHJ	P,POPFOR	;GET JRST POINTER
XNEX5:	SKIPN	RUNFLA		;STILL MAKING CODE ?
	JRST	XNEX2		;NO, DO NOT FOOL WITH ADDRESSES
	MOVE	A,FLCOD 	;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,FLCOD 	;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,
 
 
 
;
;	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 NOPAGE 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,FLCOD		;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
 
 
;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,QSA
	ASCIZ	/ERRORGOTO/
	JRST	XON5
	SKIPE	FUNAME		;WITHIN FN DEF ?
	FAIL	<? ON ERROR GOTO within DEF>
	TLNN	C,F.TERM	;ANY ARGUMENT?
	JRST	XON3		;YES, TEST IT OUT
XON4:	SKIPE	NOTLIN		;MAKING SAVFILNL ?
	FAIL	<? Retroactive ON ERROR GO TO in SAVFILNL>
	MOVE	D,[CLEARM ERRGO]
	PUSHJ	P,BUILDI
	MOVE	D,[SKIPE ERR]
	PUSHJ	P,BUILDI
	MOVE	D,[JRST ERRCNT]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
XON3:	PUSHJ	P,GETNUM
	FAIL	<? Illegal line reference>
	JUMPE	N,XON4
	PUSHJ	P,XGOGT
	MOVSI	D,(MOVEI N)
	ADD	B,FLCOD
	HLLM	D,(B)
	MOVE	D,[MOVEM N,ERRGO]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
XON5:	PUSHJ	P,FORMLN	;EVALUATE INDEX
	PUSHJ	P,EIRGNP	;GET IN REG
	PUSHJ	P,CHKINT	;MUST HAVE INTEGER
	MOVE	D,[JSP A,XCTON]
	PUSHJ	P,BUILDI	;BUILD THE RUNTIME CALL
	SETZI	D,		;BUILD ADDRESS OF NEXT STATEMENT
	MOVE	B,L
	AOBJP	B,XOLAB1	;DONT BUILD IF LAST STATEMENT
	HRLI	B,LADROL
	PUSHJ	P,BUILDA
XOLAB1:	TLNE	C,F.COMA	;SKIP OPTIONAL COMMA.
	PUSHJ	P,NXCH
	PUSHJ	P,QSA
	ASCIZ	/GOSUB/
	JRST	XONA
	SETOM	ONGFLG
	JRST	XGOSU
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	NXTSTA		;NO
	PUSHJ	P,NXCHK 	;YES. SKIP COMMA
	JRST	XON1		;PROCESS NEXT LINE NUMBER
 
 
;FILE AND FILES STATEMENTS.
;
;FILES STATEMENTS SET UP INFORMATION FOR THE LOADER, AS FOLLOWS:
;THE ACTBL ENTRY IS +1 FOR SEQ. ACCESS FILES, -1 FOR R.A. FILES.
;THE STRLEN ENTRY CONTAINS THE RECORD LENGTH FOR STRING R.A.
;FILES (OR 0 IF THE STRING R.A. FILE DID NOT SPECIFY A
;RECORD LENGTH) AND 400000,,0 FOR NUMERIC R.A. FILES.  THE
;BLOCK ENTRY CONTAINS THE SOURCE STATEMENT LINE NUMBER IN CASE THE
;LOADER NEEDS IT FOR AN ERROR MESSAGE.
 
XFILE:	ASCIZ	/E/
	PUSHJ	P,QSA
	ASCIZ	/S/		;FILE OR FILES?
	JRST	FILEE		;FILE.
XFIL1:	MOVEI	B,";"		;FILES.
	CAIE	B,(C)
	TLNE	C,F.COMA
	JRST	XFIL10
	PUSHJ	P,FILNMO	;GET FILENAME.
	JUMP	SAVE1
	AOS	A,FILCNT
	CAILE	A,9
	FAIL	<? Too many files>
	MOVEI	D,9
	MOVE	X1,FILDIR
XFIL2:	MOVE	X2,FILDIR+1
XFIL3:	CAMN	X1,FILD-1(D)	;SEARCH FOR DUPLICATE FILE SPECS.
	CAME	X2,EXTD-1(D)
	JRST	XFIL4
	MOVE	X2,FILDIR+3	;NAME.EXT MATCHES, TRY PPN
	CAMN	X2,FPPN-1(D)
	JRST	XFIL5		;ALL MATCH, ERROR
	SOJG	D,XFIL2		;TRY MORE
	SKIPA	X2,FILDIR+1
XFIL4:	SOJG	D,XFIL3
	JRST	XFIL35
XFIL5:	PUSHJ	P,INLMES
	ASCIZ	/
? File /
	PUSHJ	P,PRNNAM
	PUSHJ	P,INLMES
	ASCIZ	/ on more than one channel/
	PUSH	P,C
	PUSHJ	P,FAIL2
	POP	P,C
XFIL35: MOVEM	X1,FILD-1(A)
	MOVEM	X2,EXTD-1(A)
	MOVE	X2,FILDIR+3
; Delete [4]	MOVEM	X2,FPPN(A)
	MOVEM	X2,FPPN-1(A)	;[4] SAVE NAME, EXT AND PPN.
	MOVE	X2,L		;SAVE SOURCE LINE
	ADD	X2,FLLIN	;NUMBER IN CASE THE
	HLRZ	X2,(X2) 	;LOADER NEEDS IT.
	MOVEM	X2,BLOCK-1(A)
	MOVEI	B,"%"		;TYPE OF FILE--
	CAIE	B,(C)
 
	JRST	XFIL36
	HRLZI	B,400000	;R.A. NUMERIC.
	MOVEM	B,STRLEN-1(A)
	PUSHJ	P,NXCH
	JRST	XFIL39
XFIL36: TLNN	C,F.DOLL
	JRST	XFIL37
	PUSHJ	P,NXCH		;R.A. STRING.
	SETZ	B,
	TLNN	C,F.DIG 	;GET THE RECORD LENGTH.
	JRST	XFIL32
	PUSHJ	P,XFIL30
	SKIPLE	B
	CAILE	B,^D132
	JRST	XFILER
	JRST	XFIL32
XFIL30: ADDI	B,-60(C)
	PUSHJ	P,NXCH
	TLNN	C,F.DIG
	POPJ	P,
	IMULI	B,^D10
	JRST	XFIL30
XFIL32: MOVEM	B,STRLEN-1(A)
	JUMPE	B,XFIL39
	MOVEI	X1,4(B)
	IDIVI	X1,5
	ADDI	X1,1
	HRLM	X1,STRLEN-1(A)
XFIL39: SETOM	ACTBL-1(A)	;MAKE ACTBL ENTRY = -1 FOR R.A.
	JRST	XFIL7
XFIL37: AOS	ACTBL-1(A)	;MAKE ACTBL ENTRY = +1 FOR SEQ. ACCESS.
XFIL7:	TLNE	C,F.TERM
	JRST	NXTSTA
	MOVEI	B,";"
	CAIE	B,(C)
	TLNE	C,F.COMA
	JRST	XFIL8
 
	JRST	ERSCCM
XFIL10: AOS	B,FILCNT
	CAILE	B,9
	FAIL	<? Too many files>
XFIL8:	PUSHJ	P,NXCH
	TLNN	C,F.TERM
	JRST	XFIL1
XFIL9:	AOS	B,FILCNT
	CAILE	B,9
	FAIL	<? Too many files>
	JRST	NXTSTA
 
 
XOPEN:	ASCIZ	/N/
	SETOM	OPNFLG
	JRST	FILEE8		;SKIP LINE NO OUTPUT
FILEE:
	SETZM	OPNFLG
	SKIPN	NOTLIN		;LINE NOS SUPPRESSED ?
	SKIPE	MULLIN		;OR WITHIN MULTI
	JRST	FILEE8		;IN EITHER CASE, DONT SAVE LINE #
	MOVE	D,[JSP A,LINADR]
	PUSHJ	P,BUILDI	;
	MOVE	D,SORCLN	;
	PUSHJ	P,BUILDI	;
	MOVSI	D,(JFCL)	;SET UP JFCL
	PUSHJ	P,BUILDI
	MOVEM	B,JFCLAD	;RECORD
FILEE8:	PUSHJ	P,CHKCR1	;CHECK CORE REQUIREMENTS
FILEE0:	SETOM FILTYP		;FILE TYPE UNKNOWN
	SKIPE	OPNFLG		;OPEN OR FILE ?
	JRST	FILOP0		;OPEN
FILOP2:	MOVEI	B,-1		;ASSUME R. A.
	CAIN	C,":"		;IS IT?
	JRST	FILEE2		;YES, CARRY ON
	SETZ	B,		;HOW ABOUT SEQ. ACC.
	CAMN	C,[XWD F.STR,"#"] ;IF # IT IS
	JRST	FILEE2		;GOT IT
	SKIPE	OPNFLG		;OPEN?
	CAME	C,[XWD F.STR,"@"] ;AND IS IT VIRTUAL
	JRST	ERCHAN		;NEITHER OF THE ABOVE, ERROR
	SETZM	FILTYP
	AOSA	FILTYP		;SET FILTYP TO 1
FILEE2:	PUSHJ	P,FILSET
	PUSHJ	P,GETCNA
	SKIPE	OPNFLG		;NO DELIMITER IN OPEN
	JRST	FILOP9
	CAIE	C,":"		;SKIP DELIMITER.
	TLNE	C,F.COMA
	CAIA		
	JRST	ERCLCM
	PUSHJ	P,NXCH
FILOP9:	MOVSI	D,(HRREI N,)	;SETUP FOR FILTYP SETTING
	HRR	D,FILTYP	;GET TYPE CODE
	PUSHJ	P,BUILDI	;BUILDI IMMEDIATE
	MOVE	D,[MOVEM N,FILTYP] ;FETCH TYPE STORE INSTRUCTION
	PUSHJ	P,BUILDI
	MOVE	D,[SKIPE ACTBL-1(LP)]
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,CLSFIL]
	PUSHJ	P,BUILDI
	SKIPE	OPNFLG		;OPEN ?
	JRST	FILOP5		;YES, FINISHED

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	;HANDLE STRING ARGUMENT
	SKIPE	OPNFLG		;OPEN ?
 
	JRST	FILOP1		;YES, GO DO FOR INPUT/OUTPUT
	MOVE	D,[PUSHJ P,OPNFIL]
	PUSHJ	P,BUILDI
	PUSHJ	P,CHKDEL	;CHECK FOR SEPARATOR
	JRST	FILEE0		;FOUND ONE
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
	PUSHJ	P,XFIL30	;GET RECORD SIZE
	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	;MARK 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 THE 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 ?
FILERR:	FAIL	<? Illegal OPEN stmnt>
	SOS	INPOUT
FILOP3: PUSHJ	P,QSA
	ASCIZ	/ASFILE/
	FAIL	<? Illegal OPEN stmnt>
	JRST	FILOP2		;GET CHANNEL
 
FILOP5: MOVE	D,[PUSHJ P,OPNFIL]
	PUSHJ	P,BUILDI	;OPEN FILE
	SKIPG	FILTYP		;VIRTUAL ARRAY SPEC
	SKIPN	X1,INPOUT	;MODE SPECIFIED ?
	JRST	NXTSTA		;NO
	JUMPG	X1,FILOP6	;YES, WHICH
	HRRI	D,SCATH
	SKIPE	FILTYP		;OUTPUT, SCRATCH, RANDOM ?
	HRRI	D,RANSCR		;CHANGE SCATH TO RANSCR
	PUSHJ	P,BUILDI
FILPLT:	TLNN	C,F.TERM	;END OF STATEMENT
	SKIPN	OPNFLG		;OR FILE(S) STATEMENT
	JRST	NXTSTA		;NEXT STATEMENT
	PUSHJ	P,QSA		;CHECK FOR "TO PLOT"
	ASCIZ	/TOPLOT/
	JRST	NXTSTA
	SKIPE	FILTYP		;SEQ.?
	JRST	FILERR		;NO, ERROR
	MOVE	D,[MOVEM LP,PLTIN] ;ASSUME INPUT PLOTTING
	SKIPG	INPOUT		;OUTPUT PLOTTING?
	HRRI	D,PLTOUT	;YES
	PUSHJ	P,BUILDI	;GENERATE
	JRST	NXTSTA		;NEXT STATEMENT
FILOP6: SKIPE	FILTYP		;INPUT, RESTORE, RANDOM ?
	JRST	FILOP7		;YES
	HRRI	D,XRES
	PUSHJ	P,BUILDI
	JRST	FILPLT		;CHECK FOR PLOTTING
FILOP7: MOVNI	A,5		;RANDOM
FILOP8: MOVE	D,RESCOD+5(A)
	PUSHJ	P,BUILDI
	AOJL	A,FILOP8
	JRST	NXTSTA
XREM:	SETZM	MULLIN		;COMMENT ENDS LINE
	JRST	NXTST1
 
 
;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	;CHECK FOR SEPARATOR
	JRST	SRAER5		;FOUND ONE
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	;GET CHANNEL AND CHECK DELIMETER
	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	;CHECK FOR SEPARATOR
	JRST	XSET		;FOUND ONE
 
SETCOD: JUMPLE	N,SETERR	;SOME OF THE CODE GENERATED.
	CAIGE	N,1
	JRST	SETERR
	MOVEM	N,POINT-1(LP)
;
;PAUSE STATEMENT
;
XPAUSE:	ASCIZ	/SE/
	MOVE	D,[INCHRW N]	;INPUT CHARACTER , WAIT
	PUSHJ	P,BUILDI	;GENERATE IT
	TLNN	C,F.TERM	;TERMINATOR?
	FAIL	<? Illegal PAUSE statement>
	JRST	NXTSTA		;YES, DO NEXT
	XLIST
	IFN	BASTEK,<
	LIST
;
;PLOT FUNCTION GENERATOR
;
XPLO:	ASCIZ	/T/
XPLOA:	PUSHJ	P,QSA		;CHECK FOR FUNCTION
	ASCIZ	/LINE(/		;LINE?
	JRST	XPLOT1		;NO, TRY DIFFERENT ONE
	SETOM	NOORG		;FLAG FOR LINE (NOT ORIGIN)
XPLOTA:	CLEARM	PSHPNT		;NO ARGUMENTS YET
XPLAB1:	PUSHJ	P,DO1ARG	;DO AN ARGUMENT
	TLNE	C,F.COMA	;ANOTHER ARGUMENT?
	JRST	XPLAB1		;YES, DO IT
	MOVEI	X1,2		;ASSUME ORIGIN (TWO ARGUMENTS)
	SUB	X1,PSHPNT	;LESS NUMBER WE COLLECTED
	CAME	X1,NOORG	;0 - ORIGIN ,-1 LINE
	JRST	ARGCH0		;ARGUMENTS DON'T MATCH
	MOVE	D,[PUSHJ P,ORGPLT] ;ORIGIN?
	SKIPE	NOORG		;ORIGIN?
	HRRI	D,LINPLT
	PUSHJ	P,BUILDI	;BUILD PUSHJ CALL
	JRST	XPLFN1		;GO SEE IF ANOTHER PLOT FUNCTION
DO1ARG:	TLNE	C,F.COMA	;IS IT A COMMA?
	PUSHJ	P,NXCHK		;SWALLOW CHARACTER IN C
	SETZM	PFLAG		;CLEAR % SEEN FLAG
	PUSHJ	P,FORMLN	;GENERATE NUMERIC ARGUMENT IN REG
	JUMPGE	B,XPLAB2	;POSITIVE ARG
	PUSHJ	P,EIRGP1	;NO, MAKE NEGATVIE
XPLAB2:	PUSHJ	P,CHKINT
	MOVSI	D,(PUSH Q,)	;BUILD ARGUMENT PUSH
	PUSHJ	P,BUILDA		;
	AOS	PSHPNT
	POPJ	P,
XPLOT1:	PUSHJ	P,QSA		;TRY ANOTHER FUNCTION
	ASCIZ	/STRING(/	;STRING?
	JRST	XPLOT2		;NO, TRY AGAIN
	CLEARM	PSHPNT		;NO ARGUMENTS YET
	PUSHJ	P,DO1ARG	;DO FIRST ARGUMENT
	TLNN	C,F.COMA	;ANOTHER ONE?
	JRST	ARGCH0		;SHOULD HAVE BEEN
	PUSHJ	P,DO1ARG	;DO SECOND ARGUMENT
	TLNN	C,F.COMA	;ANOTHER ONE?
	JRST	ARGCH0		;SHOULD HAVE BEEN
	MOVE	D,[PUSHJ P,STRPLT] ;PUSHJ TO STRPLT
	PUSHJ	P,BUILDI	;GENERATE IT
	MOVSI	D,(CLEAR LP,)	;TTY OUTPUT
	PUSHJ	P,BUILDI	;GENERATE IT
	MOVE	D,[PUSHJ P,OUTSET] ;SETUP FOR OUTPUT TO TTY
	PUSHJ	P,BUILDI	;GENERATE IT
	PUSHJ	P,NXCHK		;SWALLOW THE COMMA
	PUSHJ	P,FORMLS	;GENERATE STRING ARGUMENT
	MOVSI	D,(PRSTR 2,)	;STRING OUTPUT W/ NO CARRIAGE MOVEMENT
	PUSHJ	P,BUILDA	;GENERATE WITH ADDRESS IN B
	MOVE	D,[PUSHJ P,MOVPLT] ;MOVE THE ALPHA CURSOR
	PUSHJ	P,BUILDI	;GENERATE IT
	JRST	XPLFN1		;SEE IF ANOTHER FUNCTION
XPLOT2:	PUSHJ	P,QSA		;CHECK ANOTHER FUNCTION
	ASCIZ	/ORIGIN(/	;ORIGIN?
	JRST	XPLOT3		;NO, TRY, TRY AGAIN
	CLEARM	NOORG		;FLAG FOR ORIGIN
	JRST	XPLOTA		;TREAT LIKE LINE
XPLOT3:	PUSHJ	P,QSA		;CHECK ANOTHER FUNCTION
	ASCIZ	/PAGE/		;PAGE?
	JRST	XPLOT4		;NO, TRY, TRY, TRY AGAIN
	MOVE	D,[PUSHJ P,PAGPLT] ;PUSHJ TO PAGPLT
	JRST	XPLT4A		;GO TO GENERATE
XPLOT4:	PUSHJ	P,QSA		;ANOTHER TIME
	ASCIZ	/INIT/		;INIT?
	JRST	XPLOT5		;TRY, TRY, TRY, TRY AGAIN
	MOVE	D,[PUSHJ P,INIPLT] ;PUSHJ TO INIPLT
XPLT4A:	PUSHJ	P,BUILDI	;GENERATE CODE IN D
	JRST	XPLFIN		;CHECK FOR ANOTHER FUNCTION
XPLOT5:	PUSHJ	P,QSA		;CHECK FOR FUNCTION
	ASCIZ	/WHERE(/	;WHERE?
	JRST	XPLOT6		;TRY LAST ONE
	MOVE	D,[JSP A,WHRPLT] ;FOR WHERE
	PUSHJ	P,BUILDI	;GENERATE IT
XPLT5A:	PUSHJ	P,DOSARG	;DO SCALAR ARGUMENT
	TLNN	C,F.COMA	;ONE MORE ARGUMENT?
	JRST	ERCOMA		;NOPE
	PUSHJ	P,DOSARG	;DO ANOTHER SCALAR ARGUMENT
	JRST	XPLFN1		;GO FOR NEXT
XPLOT6:	PUSHJ	P,QSA		;IS IS CURSOR
	ASCIZ	/CURSOR(/	;
	JRST	XPLOT7		;TRY SAVE
	MOVE	D,[JSP A,CURPLT] ;
	PUSHJ	P,BUILDI	;
	PUSHJ	P,DOSARG	;
	TLNN	C,F.COMA	;
	JRST	ERCOMA		;
	JRST	XPLT5A		;LET WHERE CODE HANDLE LAST TWO ARGS.
XPLOT7:	PUSHJ	P,QSA		;TRY SAVE
	ASCIZ	/SAVE(/
	FAIL	<? Illegal PLOT function>
	PUSHJ	P,GETCN2	;GET CHANNEL
	MOVE	D,[PUSHJ P,SAVPLT] ;DO SSAVE PLOT
	PUSHJ	P,BUILDI	;GENERATE IT
XPLFN1:	TLNN	C,F.RPRN	;ENDED WITH ')'
	JRST	ERRPRN		;NO, GIVE ERROR
	PUSHJ	P,NXCHK		;SWALLOW THE ')'
XPLFIN:	PUSHJ	P,CHKDEL	;CHECK FOR SEPARATOR
	JRST	XPLOA		;FOUND ONE
DOSARG:	TDZ	F,F		;
	TLNE	C,F.COMA	;HAVE A COMMA
	PUSHJ	P,NXCHK		;EAT THE ','
	SETZM	PFLAG		;CLEAR % SEEN FLAG
	PUSHJ	P,REGLTR	;SINGLE ARGUMENT
	CAIE	A,1		;SCALAR?
	JRST	ILVAR		;CAN ONLY BE
	MOVSI	D,(JUMP 2,)	;USE A JUMP
	SKIPGE	TYPE		;WANTS RESULTS IN FLOTING?
	TLZ	D,100		;NO, MARK FOR INTEGER
	PJRST	BUILDA		;
	XLIST
>
	LIST
 
 
;
;	UNTIL AND WHILE - NEXT LOOP STATEMENT
;
XUNTIL:	ASCIZ	/IL/		;REST OF UNTIL
	SETOM	LOGNEG		;REVERSE SENSE OF WHILE
	JRST	XWHILE+2	;AND GO
XWHILE:	ASCIZ	/LE/		;REST OF WHILE
	SETZM	LOGNEG		;NO REVERSING NEEDED
	MOVE	X1,CECOD	;WHERE SHOULD NEXT RETURN TO
	SUB	X1,FLCOD	;TO FIRST STATEMENT OF UNTIL/WHILE
	SOJ	X1,		;
	HRLM	X1,FORPNT	;SAVE IT
	PUSHJ	P,IFCCOD	;GO HANDLE THE CONDITIONAL
	PUSHJ	P,REVSEN	;YES, REVERSE SENSE
	PUSHJ	P,HALJRS	;JRST TO NEXT+1
	HRRM	B,FORPNT	;SAVE FOR NEXT CODE
	MOVE	A,L		;SAVE STATEMENT IN CASE OF ERROR
	MOVEI	R,FORROL	;PUSH IT ONTO THE FORROL
	PUSHJ	P,RPUSH		;
	MOVE	A,FORPNT	;PUSH JRST POINTER ONTO FORROL
	PUSHJ	P,RPUSH		;
	SETO	A,		;DUMMY TWO -1'S
	PUSHJ	P,RPUSH		;
	PUSHJ	P,RPUSH		;
	MOVE	A,TMPLOW	;GET TEMP PROTECTION
	PUSHJ	P,RPUSH		;DUMMY SAVE
	JRST	NXTSTA		;ALL DONE
;
;WRITE AND PRINT STATEMENTS
;CAUSES DATA TO BE OUTPUT TO THE DISK OR TTY.
 
XWRIT:	ASCIZ /TE/
	SETOM	WRREFL
	JRST	XWLAB1
XPRINT: ASCIZ	/NT/
	SETZM	WRREFL
XWLAB1:	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	;CHECK FOR SEPARATOR
	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,XWRMX1	;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,XWLAB2
	POPJ	P,
XWLAB2:	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	;MODIFIER THERE ?
	CAIA			;NO
	JRST	XWRI7		;YES, HANDLE AS TERMINATOR
	SETZM	PFLAG		;NEW EXPRESSION, CLEAR % SEEN
	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,";"
	CAIA		
	JRST	XWRI7
	PUSHJ	P,NXCH
	TLNN	C,F.TERM	;HIT A TERMINATOR?
	JRST	XWRI5
XWRI7:	MOVE	D,[PUSHJ P,ENDIMG]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
 
 
XPRRAN: PUSHJ	P,GENTP1	;R.A. STATEMENT.
	PUSHJ	P,FORMLB
	MOVEM	F,IFFLAG
	JRST	XPRRN2
	PUSHJ	P,NXCH
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	;CHECK FOR SEPARATOR
	JRST	XPRRN1		;FOUND ONE
 
 
 
XPRI1:	SKIPE	WRREFL
	JRST	GRONK
	MOVSI	D,(SETZ LP,)	;TTY.
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,OUTSET]
	PUSHJ	P,BUILDI
XPRI0:	PUSHJ	P,KWSAMD	;MODIFIER FOLLOWS ?
	TLNE	C,F.TERM	;NON-USING STATEMENTS FROM HERE ON.
	JRST	XPCRLF
	CAIA
XPRI2:	PUSHJ	P,KWSAMD	;MODIFIER ?
 
	CAIA			;NO
	JRST	NXTSTA		;YES, GO HANDLE
	PUSHJ	P,QSA
	ASCIZ /TAB/		;TAB FIELD?
	CAIA				;NO, ASSUME EXPRESSION OR DELIMITER.
	JRST	XPRTAB		;YES, DO THE TAB
	TLNN	C,F.COMA
	CAIN	C,";"
	JRST	PRNDEL
	CAIE	C,74		;LEFT ANGLE BRACKET
	JRST	PRNEXP
 
;PRINT DELIMITER.
 
PRNDEL: MOVSI	D,(PRDL)
	PUSHJ	P,CHKFMT
	PUSHJ	P,BUILDI
	JRST	XPRFIN
 
;PRINT EXPRESSION
 
PRNEXP:	SETZM	PFLAG		;NEW EXPRESSION, CLEAR % SEEN
	PUSHJ	P,FORMLB	;GEN THE EXPRESSION
	MOVSI	D,(PRSTR)	;STR.
	JUMPGE	F,PRNEX1	;OR WAS IT NO. ?
	PUSHJ	P,GPOSNX	;MOVE TO REG IF UNCOMPLEMENTED OR INDEXED.
	MOVSI	D,(PRNM)	;SET UP OP CODE
PRNEX1:	PUSHJ	P,CHKFMT	;SET FORMAT CODE
	SKIPGE	TYPE		;IS IT REAL?
	TLO	D,400		;NO, MARK BIT AS INTEGER
	PUSHJ	P,BUILDA	;GEN PRINT UUO
	JRST	XPRFIN		;GO FOR MORE
 
 
 
;PRINT TAB
 
XPRTAB: PUSHJ	P,FORMLN	;EVALUATE TAB SUBEXPRESSION
	PUSHJ	P,EIRGNP	;MOVE IT INTO REG
	PUSHJ	P,CHKINT	;MUST HAVE INTEGER
	MOVSI	D,(PRNTB)	;CALL THE TAB INTERPRETER
XPRTA1: PUSHJ	P,CHKFMT
	PUSHJ	P,BUILDI	;YES, BUILD THE INST.
XPRFIN: TLNE	C,F.TERM	;CR AT END OF LINE?
	JRST	NXTSTA
	JRST	XPRI2		;NO.  GO FOR MORE
 
;HERE FOR PRINT WITH NO ARGUMENTS.  GEN CARRIAGE RETURN.
 
XPCRLF: MOVE	D,[SETZM 40]
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,PRDLER]
	PUSHJ	P,BUILDI
	MOVE	D,[PUSHJ P,CRLF]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
 
 
;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,
 
 
;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/		;REMAINDER OF RANDOM STATEMENT
	PUSHJ	P,QSA		;DID USER INCLUDE FULL STATEMENT
	ASCIZ	/IZE/
	JFCL			;WHO CARES
	MOVE	D,[PUSHJ P,RANDER] ;FETCH RUNTIME RANDOMIZER CALL
	PUSHJ	P,BUILDI	;BUILD IMMEDIATE
	JRST	NXTSTA		;THAT'S ALL, FOLKS
 
;RESTORE STATEMENTS.
 
XREST:	PUSHJ	P,QSA		;CHECK FOR RESUME
	ASCIZ	/UME/
	JRST	XRESTA
XRESM:	MOVE	D,[SKIPN ERR]
	PUSHJ	P,BUILDI
	MOVSI	D,(JRST)
	PUSHJ	P,BUILDI
	PUSH	P,B
	MOVE	D,[MOVE P,PSAV] ;WANT TO RESTORE P
	PUSHJ	P,BUILDI	;GENERATE INSTRUCTION TO DO SO
	MOVE	D,[SETZM ERR]
	PUSHJ	P,BUILDI
	TLNN	C,F.CR
	JRST	XRESM2
XRESM1:	SKIPE	NOTLIN		;SAVFILNL?
	FAIL	<? RESUME without argument in SAVFILNL>
	MOVE	D,[SOS X1,ERL]
	PUSHJ	P,BUILDI
	MOVE	D,[SETZM ERL]
	PUSHJ	P,BUILDI
	MOVE	D,[JRST @X1]
	PUSHJ	P,BUILDI
XRSM1A:	POP	P,X1
	ADD	X1,FLCOD
	MOVE	B,CECOD
	SKIPE	RUNFLA
	HRRM	B,(X1)
	JRST	NXTSTA
XRESM2:	PUSHJ	P,GETNUM
	FAIL	<? Illegal line reference>
	JUMPE	N,XRESM1
	MOVE	D,[SETZM ERL]
	PUSHJ	P,BUILDI
	PUSHJ	P,XGOGT
	JRST	XRSM1A
XRESTA:	PUSHJ	P,QSA
	ASCIZ	/TORE/
	JRST	ILLINS
	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	;CHECK FOR SEPARATOR
	JRST	XRES3		;FOUND ONE
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
 
 
 
 
;RETURN STATEMENT XLATE
 
XRETRN: ASCIZ	/URN/
	SKIPE	FUNAME
	FAIL	<? RETURN within DEF>
	MOVE	D,[JRST RETURN]
XRET1:	PUSHJ	P,BUILDI	;XDEF ENTERS HERE TO COMPLETE A FN DEF.
	JRST	NXTSTA
 
 
 
;STOP STATEMENT
 
XSTOP:	ASCIZ	/P/
	MOVE	D,[JRST EUXIT]
	PUSHJ	P,BUILDI
	JRST	NXTSTA
 
 
;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,REGFRE	;MAKE SURE REGISTER IS FREE
	PUSHJ	P,CFORM0	;GET OBJECT OF NOT
	PUSHJ	P,SETFNO	;MUST BE NUMERIC
	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
	CLEARM	MIXFLG		;CLEAR MIX FLAG
	PUSHJ	P,CMIXM		;CHECK FOR MIXED MODE
	SKIPE	MIXFLG		;WAS A MIX MADE?
	JRST	CRFM2A		;YES, DON'T SWITCH
	TLNN	B,ROLMSK	;IS RIGHT SIDE ALREADY IN REG
	JRST	CFORM3		;YES, COMPARE WITH LEFT SIDE
	PUSHJ	P,EXCHG		;GET LEFT SIDE IN REG
CRFM2A:	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
	SETOM	TYPE		;COMPARISION RESULTS IN INTEGER
	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
	CLEARM	MIXFLG		;CLEAR MIX FLAG
	PUSHJ	P,CMIXM		;CHECK FOR MIXED MODE
	SKIPGE	(P)		;IS SECOND FACTOR A DIVISOR?
	SKIPE	MIXFLG		;OR WAS A MIX MADE
	CAIA			;YES, REG IS OK
	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	;MARK NUMERIC IF LEGAL
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		;SUBEXPRESSION CANNOT BE L. H.
	PUSH	P,F		;SAVE TYPE FLAG F
	PUSHJ	P,FORMLB	;GEN THE SUBEXPRESSION
	POP	P,X1		;RETURN TYPE CODE
	TLNN	X1,-1		;WAS TYPE DECLARED?
	JRST	FSUBX1		;NO, SO DON'T CHECK
	XOR	X1,F		;CHECK FOR MIXED MODE
	JUMPL	X1,SETFER	;MIXED MODE
FSUBX1:	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	;MARK NUMERIC IF LEGAL
	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.
	JRST	FNUM4
 
FNUM3:	MOVEI	R,CONROL	;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
 
 
;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
	SKIPN	FUNAME		;WITHIN FUNCTION?
	SETOM	AFLAG		;NO, MARK A FLAG
XARF2:	JUMPE	B,XARFFN
	SKIPGE	F
	MOVSI	D,(ARFET2)
	HRRZ	X1,(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
	SKIPL	F		;STRING VECTOR?
	PUSHJ	P,SITGEN	;YES,SAVE ADDRESS POINTER
	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
	PUSHJ	P,NXCHK
	PUSH	P,LETSW
	MOVMS	LETSW
	PUSHJ	P,XFORMB	;GEN THE ARGUMENT IN REG
	POP	P,LETSW
	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 ?
	FAIL	<? Too many function arguments>
	PUSH	P,D		;SAVE AGAIN
	SKIPGE	B
	PUSHJ	P,EIRGP1
	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		;GET BACK 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)		;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...
	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: MOVEI	E,1		;ADD FCN REF TO FADROL
	PUSHJ	P,OPENUP
	MOVEM	N,(B)
	POPJ	P,
 
;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 TYPE
	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.
	CLEARM	TYPE
	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
	SETOM	TYPE
XINF01: TLNN	C,F.RPRN
	JRST	ERRPRN
	PUSHJ	P,NXCH
	POP	P,D
	HRRZI	D,(D)
	ADD	D,[PUSHJ P,3]
	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 NOT INCLUDED
	PUSHJ	P,NXCH		;EAT THE "("
	PUSHJ	P,XFORMN	;ONLY NUMERIC EXPRESSION ALLOWED
	PUSHJ	P,EIRGEN	;MAKE SURE EXPRESSION IS IN REG.
	SKIPGE	TYPE		;IS THE EXPRESSION INTEGER?
	JRST	CRTBI1		;YES, JUST SET CRTVAL
	MOVE	D,[PUSHJ P,FIXPNT] ;HAVE TO FIX CRTVAL
	PUSHJ	P,BUILDI	;GENERATE THE FIXPNT INSTRUCTION
CRTBI1:	MOVE	D,[EXCH N,CRTVAL] ;SET CRTVAL, RETURN OLD VALUE
	SETOM	TYPE		;CRT IS INTEGER FUNCTION
	JRST	INLIOU		;CHECK FOR ")", GENERATE INSTUC. IN D
;
;	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,"("		;NEED AN ARGUMENT
	JRST	ARGCH0
	PUSHJ	P,NXCH
	PUSHJ	P,GETNUM	;GET LINE NUMBER
	FAIL	<? Illegal line reference>
	MOVE	D,N
	HRLZ	A,N		;CHECK IT OUT
	MOVEI	R,LINROL
	PUSHJ	P,SEARCH
	FAIL	<? Undefined line number >,1
	HRLI	D,(MOVEI N,)	;OKAY, SET IT UP
	SETOM	TYPE
	JRST	INLIOU

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 0 IS ZERO
	PUSHJ	P,BUILDI	;GENERATE IT
	SETOM	TYPE		;FUNCTION IS INTEGER
	MOVE	D,[PUSHJ P,SGNB##] ;CALL SIGN FUNCTION
	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,XFORMB
	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,XFORMB
	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
	TLZ	D,100		;NO, AC IS ZERO
	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	;CHECK THAT LETTER IS NEXT
	JRST	ERLETT		;IT WAS NOT
REGLTR: PUSHJ	P,SCNLT1	;LTR TO A, LEFT JUST 7 BIT
	HRRI	F,SCAROL	;ASSUME SCALAR
	SETZM	TYPE		;ASSUME REAL
	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 PERCENT
	PUSHJ	P,SETFNO	;MARK NUMERIC IF LEGAL
	CAIN	C,"("
	JRST	REGARY
 
;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?
	JRST	REGL2		;NO
 
	HRRZ	D,(B)		;YES.  GET PNTR TO SCAROL
	JRST	REGL3
 
REGL2:	MOVEI	E,1		;ADD TO SCALAR ROLL OR VSPROL
	PUSHJ	P,OPENUP
	ADD	A,CEIL(F)	;COMPUTE PNTR TO ROLL
	SUB	A,FLOOR(F)
	HRRZ	D,A		;SAVE ROLL POINTER
	MOVEM	A,(B)
	MOVEI	R,(F)	;PUT NULL ENTRY ON ROLL
	MOVEI	A,0
	PUSHJ	P,RPUSH
 
;	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
	JRST	REGA2		;NOT ALREADY USED
	HRRZ	D,(B)		;GET POINTER TO ARAROL
	JRST	REGA3		;ALREADY USED
 
REGA2:	MOVEI	E,1		;ADD NEW ARRAY NAME TO VARIABLE ROLL
	PUSHJ	P,OPENUP
	ADD	A,CEIL(F)	;COMPUTE ARRAY OR STRING VECTOR ROLL POINTER
	SUB	A,FLOOR(F)
	ORI	A,400000	;SET ARRAY FLAG
	MOVEM	A,(B)
	HRRZ	D,A		;SAVE ARAROL POINTER
	MOVEI	R,(F)		;THREE ZEROS ON ARAROL (NULL ENTRY)
	MOVEI	A,0
	PUSHJ	P,RPUSH
	PUSHJ	P,RPUSH
	PUSHJ	P,RPUSH
 
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 ?
	JRST	ARRAY2		;YES, HANDLE STRING
	PUSHJ	P,PERCNT	;PERCENT ?
ARRAY0:	PUSHJ	P,SETFNO	;MARK NUMERIC IF LEGAL
	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 matrix,>
 
REGSTR:	PUSHJ	P,SETFST	;MARK STRING IF LEGAL
	HRRI	F,VSPROL	;POINTER WILL GO ON VARIABLE SPACE ROLL
	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	GRONK		;NO
RGSLX1:
	PUSHJ	P,NXCHD
	AOJA	A,REGSL1
REGSL2: 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 	;PUSH POINTER ONTO LITERAL ROLL
	POP	P,E
	IDIVI	E,5
	JUMPE	E,REGSL3
	MOVEI	R,SLTROL	;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
	DPB	C,[POINT 7,A,13] ;YES, STORE IT
	JRST	NXCH		;AND SKIP IT

DOLLAR:	TLNN	C,F.DOLL	;IS IT A $ ?
	AOSA	(P)		;NO, SKIP
	TLOA	A,10		;YES, MARK IT
	POPJ	P,		;RETURN
	SETZM	TYPE
	JRST	NXCHK		;GOBBLE IT

PERCNT:	SETZM	TYPE		;ASSUME REAL
	CAME	C,[XWD F.STR,"%"]	;IS IT A PERCENT?
	POPJ	P,		;RETURN
	SETOM	TYPE		;MARK AS INTEGER
	TLO	A,4		;YES, MARK IT
	SETOM	PFLAG
	JRST	NXCHK		;NEXT CHARACTER
 
;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;  ARRAY 1;  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:
KWADIF:	ASCIZ	/THEN/
	ASCIZ	/GOTO/
KWAAMD:			;ALL POSSIBLE MODIFIERS
	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
	ASCIZ	/IFOR/		;I FOR THERE ?
	POPJ	P,		;NO, ALL'S WELL
	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	;MARK NUMERIC IF LEGAL
	JRST	REGL1
 
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	;MARK NUMERIC IF LEGAL
	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	;CHECK CORE REQUIREMENTS
	POP	P,X1
REGF10: MOVEI	C,4	;$ IN SIXBIT.
	IDPB	C,X1
	PUSHJ	P,NXCH
	PUSHJ	P,SETFST	;MARK STRING IF LEGAL
REGF6:	CAMN	A,[SIXBIT/VAL   /]
	PUSHJ	P,CHKCOR	;CHECK CORE REQUIREMENTS
REGF0:	MOVEI	R,IFNFLO
REGF7:	CAMN	A,(R)
	JRST	REGF8		;FOUND FN.
	AOJ	R,RGLAB1
RGLAB1:	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	;CHECK CORE REQUIREMENTS
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 PERCENT
	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
	CAMN	A,FUNAME	;IS THIS THE NAME OF THE CURRENT MULTI-LINE FN?
	JRST	REGFNA		;YES. REGISTER IT AS A SCALAR
	MOVE	D,A		;NO, REAL FUNCTION CALL.  SAVE NAME FOR ARGCHK
	MOVMS	LETSW
	MOVEI	R,FCLROL	;FUNCTION CALL ROLL
	PUSHJ	P,SEARCH	;USED THIS ONE YET?
	CAIA		
	JRST	REGFC1		;ALREADY SEEN A REF
	MOVEI	E,1
	PUSHJ	P,OPENUP
	MOVEM	A,(B)
	PUSHJ	P,REGFC1	;SET B UP FOR KLUDGE TEST
	MOVE	X1,FLSEX	;FIX UP SAVED FCN REFS
REGFC0: CAML	X1,CESEX	;KLUDGE!!!
	JRST	REGFC1+1
	HLRZ	X2,(X1) 	;GET THE ROLL NUMBER
	CAIN	X2,FCLROL	;FCLROL?
	CAMLE	B,(X1)		;YES. IS SEXREF NOW WRONG?
	AOJA	X1,REGFC0	;NO
	AOS	(X1)		;YES. CORRECT IT
	AOJA	X1,REGFC0
 
REGFC1: SUB	B,FLFCL
	HRLI	B,FCLROL
	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,
 
REGFNA: TLO	A,2		;CREATE SPECIAL NAME FOR CURRENT FUNC.
	SKIPGE	F		;NUMERIC ?
	JRST	SCAREG		;REGISTER IT AS A SCALAR
	JRST	STRREG		;NO, REGISTER AS STRING
 
 
 
	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	;HARD LUCK, NUMERIC SPECIFIED
	HRLI	F,1		;SET STRING
	SETZM	TYPE
	POPJ	P,

;PUSHPR - PUSH PARTIAL RESULT ON SEXROL
 
PUSHPR: MOVEI	R,SEXROL
	MOVE	A,B		;SAVE POINTER IN A
	SKIPE	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 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 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
	CLEAR	B,
	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
	CLEAR	B,
	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,PTMROL
	JRST	SITGN1
 
;SITGEN - STORE IN TEMP GEN
 
SITGEN: MOVEI	R,TMPROL
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,STLAB1
	MOVSI	D,(MOVNM N,)
STLAB1:	CAIE	R,TMPROL	;STORE ON TMPROL?
	JRST	SITG2		;NO. USE PTMROL
	AOS	B,TMPPNT	;WHICH TEMP TO USE?
	MOVE	X1,FLTMP
	ADD	X1,B
	CAML	X1,CETMP	;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,FLPTM
	JRST	SITG1		;FINISH CONSTRUCTING ADRESS POINTER
;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: SKIPN	RUNFLA		;ARE WE GOING TO RUN?
	POPJ	P,		;NO, JUST RETURN
	MOVEI	E,1
	MOVEI	R,CODROL
	PUSHJ	P,BUMPRL
	MOVEM	D,(B)
	SUB	B,FLCOD
	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: SKIPN	RUNFLA		;ARE WE GOING TO RUN?
	POPJ	P,		;NO.  DONT BUILD
	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,CECOD	;LOC+1 OF THE INSTR
	POP	P,X2		;COMPUTE ADDRS LOCATION
	LDB	R,[POINT 17,X2,17]
	ADD	X2,FLOOR(R)
	MOVE	R,(X2)		;GET NEXT ADDRS IN CHAIN
	HRRM	R,-1(X1)	;STORE IT IN THE INSTR
	SUB	X1,FLCOD
	SUBI	X1,1
	HRRM	X1,(X2) 	;STORE CURR ADDRS IN ROLL PNTD TO
	POPJ	P,
 
 
	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		;SHOULD BE SOMETHING 
	POPJ	P,
THGOTS: PUSHJ	P,QSA
	ASCIZ /GOTO/
THGERR:	FAIL <? THEN or GO TO were expected>
	TLNE	C,F.DIG 	;DIGIT FOLLOWS ?
	POPJ	P,		;
ERDIGQ:	PUSHJ	P,FALCHR
	ASCIZ	/a digit or "/

 
;ERROR RETURNS
 
ILFORM: FAIL	<? Illegal formula>
ILVAR:	FAIL	<? Illegal variable>
GRONK:	FAIL	<? Illegal format>
ILLINS:	FAIL	<? Illegal statement keyword>
 
 
;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	/"/
ERTERM: PUSHJ	P,FALCHR
	ASCIZ	/a line terminator or '/
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
	SKIPN	RUNFLA
	JRST	FAL1
	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
	CAIA		
	JRST	FALFF
	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/
	PUSHJ	P,FAIL2
	JRST	NXTST1
 
 
;COMPILATION ERROR MESSAGES FROM FAIL UUOS.
 
 
FAILER: SKIPN	RUNFLA		;IS THIS THE FIRST ERROR IN COMPILATION?
	JRST	FAIL0		;NO.
	PUSHJ	P,INLMES	;YES. SETUP <CRLF> TO FOLLOW HEADING.
	ASCIZ /
/
FAIL0:	PUSHJ	P,FAIL1
	JRST	NXTST1
 
FAIL1:	MOVE	T,40
FAILR:	MOVEI	D,0
	PUSHJ	P,PRINT
	LDB	X1,[POINT 4,40,12]	;IS AC FIELD NONZERO?
	JUMPE	X1,FAIL2
	MOVE	T,N			;ATTACH NUMBER IN 'N' TO MSG
	PUSHJ	P,PRTNUM
FAIL2:	PUSHJ	P,INLMES
	ASCIZ / in line /
	MOVE	T,L
	ADD	T,FLLIN
	HLRZ	T,(T)
	PUSHJ	P,PRTNUM
	SKIPE	CHAFL2		;CHAINING?
	PUSHJ	P,ERRMS3
	PUSHJ	P,INLMES
	ASCIZ	/
/
	SETZM	RUNFLA
	SETZM	MULLIN		;DELETE MULTI-LINE
	POPJ	P,
 
;GET NEXT CHAR, BUT CHECK FOR ILLEGAL CHARS (CHARS THAT COULD ONLY BE IN A STRING)
NXCHK:	PUSHJ	P,NXCH
	TLNE	C,F.STR
	FAIL	<? Illegal character>
	POPJ	P,
 
 
;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)
 
 
;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,XFORMN
	PUSHJ	P,EIRGNP
	PUSHJ	P,CHKINT	;NEED AN INTEGER
	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,XFORMS	;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
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
	SETOM	MIXFLG		;MARK A MIX MADE
	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

;ROUTINE TO START READING NEXT LINE OF PROGRAM
NXLINE: MOVE	T,FLLIN
	ADDI	T,(L)
	MOVE	T,(T)
	MOVS	D,T		;SAVE LINE START
	HRLI	T,440700
	MOVE	G,FLREF 	;SETUP REFROL REFERENCE.
	ADDI	G,(L)
	JRST	NXCH
 
 
 
PRTNUM: IDIVI	T,^D10
	JUMPE	T,PRTN1
	PUSH	P,T1
	PUSHJ	P,PRTNUM
	POP	P,T1
PRTN1:	MOVEI	C,60(T1)
	AOS	NUMCOT
	JRST	OUCH
 
 
	END