TITLE	BASIC	V010
SUBTTL		PARAMETERS AND TABLE

;***COPYRIGHT 1969, 1970, 1971, 1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***

	JOBVER=137
	LOC	JOBVER
	OCT 10

IFNDEF PURESW,<PURESW==1>

;CONDITIONAL ASSEMBLY PARAMETERS
;  THE VERSION OF BASIC SUPPLIED BY APPLIED LOGIC CORPORATION
;  IS ASSEMBLED WITH THE PARAMETERS BELOW SET TO -1.  APPLIED
;  LOGIC CORPORATION HAS NOT NECESSARILY TESTED VERSIONS OF
;  BASIC ASSEMBLED OTHERWISE AND DOES NOT GUARANTEE TO
;  MAINTAIN ANY SUCH VERSIONS.

FTRND=-1		;-1 IF RANDOM FACILITY, ELSE 0
FTMAT=-1		;-1 IF MATRIX FACILITY, ELSE 0
FTSTR=-1		;-1 IF STRING FACILITY, ELSE 0

IFE PURESW,< RELOC >
IFN PURESW,< HISEG >

;AC DEFINITIONS
			;PRINCIPAL USES:

N=0			;RUNTIME ACCUMULATOR REGISTER
T=1			;POINTER TO NXCH
T1=2
A=3			;SEARCH ARGUMENT
B=4			;POINTER AFTER SEARCH
C=5			;XWD CHARACTER-FLAGS,CHAR
D=6			;BUILD INSTS HERE
F=7			;FLAGS
E=10
G=11
R=12			;POINTER TO ROLL BEING USED
X1=13			;)
X2=14			;)TEMP REGS
Q=15			;PUSHDOWN LIST FOR FNX ARGS.
L=16
LP=16
P=17			;PUSHDOWN LIST


STAFLO:
	Z	XCHAN+60000(SIXBIT /   CHA/)
	Z	XDATA+40000(SIXBIT /   DAT/)
	Z	XDEF+40000(SIXBIT /   DEF/)
	Z	XDIM+0(SIXBIT /   DIM/)
	Z	XEND+0(SIXBIT /   END/)
	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/)
IFN FTMAT,<
	Z	XMAT+20000(SIXBIT /   MAT/)
>
	Z	XNEXT+60000(SIXBIT /   NEX/)
	Z	XON+20000(SIXBIT /   ON /)
	Z	XPRINT+60000(SIXBIT /   PRI/)
IFN FTRND,<
	Z	XRAN+60000(SIXBIT /   RAN/)
>
	Z	XREAD+60000(SIXBIT /   REA/)
	Z	NXTST1+0(SIXBIT /   REM/)
	Z	XREST+40000(SIXBIT /   RES/)
	Z	XRETRN+60000(SIXBIT /   RET/)
	Z	XSTOP+40000(SIXBIT /   STO/)
STACEI:
;TABLE OF BASIC COMMANDS

DEFINE YYY (A,B)<
	EXP	SIXBIT /A/ + 'A'ER + 'B'0000>

CMDFLO: YYY DEL,4
	YYY LEN,4
	YYY LIS,4
	YYY NEW
	YYY OLD
	YYY REN,4
	YYY REP,4
	YYY RES,4
	YYY RUN
	YYY SAV,4
	YYY SCR,4
	YYY SYS,4
	YYY WEA,4
CMDCEI:
;CHARACTER TYPE TABLE.
;FLAGS IN LEFT HALF OF CTTAB+<LETTER> FOR <LETTER> BELOW 100,
;FLAGS IN RIGHT HALF OF CTTAB+<LETTER-100> OTHERWISE.

DEFINE WWW (FL,VAL)<
	XLIST
FL=<	Z	0,(VAL)>
	LIST>

WWW F.APOS,1B0		;	'
WWW F.COMA,1B1		;	,
WWW F.CR,1B2		;	<RETURN,	OR	LF,VT,FFEED>
WWW F.DIG,1B3		;	<NUMERAL>
WWW F.DOLL,1B17
WWW F.EQAL,1B4		;	=
WWW F.ESC,1B5		;	<ESCAPE	OR	ALTMODE>
WWW F.LCAS,1B6		;	<LOWER	CASE	LETTER>
WWW F.LETT,1B7		;	<LOWER	OR	UPPER	CASE	LETTER>
WWW F.STR,1B8		;	(
WWW F.MINS,1B9		;	-
WWW F.PER,1B10		;	.
WWW F.PLUS,1B11		;	+
WWW F.QUOT,1B12		;	"
WWW F.RPRN,1B13		;	)
WWW F.SLSH,1B14		;	/
WWW F.STAR,1B15		;	*
WWW F.SPTB,1B16		;	<SPACE	OR	TAB>

F.NU=0			;ASCII CODES THAT ARE TREATED AS NULLS.
F.OTH=0			;OTHER CHARACTERS ANALYSED BY BASIC WITHOUT THE USE OF FLAGS.

F.TERM=F.CR+F.APOS	;EITHER TERMINATES THE ANALYZABLE PORTION OF A BASIC STATEMENT.

CTTAB:
	XWD	F.NU,	F.STR	;NULL	, @
	XWD	F.STR,	F.LETT	;	, A
	XWD	F.STR,	F.LETT	;	, B
	XWD	F.STR,	F.LETT	;	, C
	XWD	F.STR,	F.LETT	;	, D
	XWD	F.STR,	F.LETT	;	, E
	XWD	F.STR,	F.LETT	;	, F
	XWD	F.STR,	F.LETT	;	, G
	XWD	F.STR,	F.LETT	;	, H
	XWD	F.SPTB,	F.LETT	;TAB	, I
	XWD	F.CR,	F.LETT	;LF	, J
	XWD	F.CR,	F.LETT	;VER.TAB, K
	XWD	F.CR,	F.LETT	;FFEED	, L
	XWD	F.CR,	F.LETT	;CR	, M
	XWD	F.STR,	F.LETT	;	, N
	XWD	F.STR,	F.LETT	;	, O
	XWD	F.STR,	F.LETT	;	, P
	XWD	F.STR,	F.LETT	;	, Q
	XWD	F.STR,	F.LETT	;	, R
	XWD	F.STR,	F.LETT	;	, S
	XWD	F.STR,	F.LETT	;	, T
	XWD	F.STR,	F.LETT	;	, U
	XWD	F.STR,	F.LETT	;	, V
	XWD	F.STR,	F.LETT	;	, W
	XWD	F.STR,	F.LETT	;	, X
	XWD	F.STR,	F.LETT	;	, Y
	XWD	F.STR,	F.LETT	;	, Z
	XWD	F.ESC,	F.STR	;ESC	, [
	XWD	F.STR,	F.STR	;	, \
	XWD	F.STR,	F.STR	;	, ]
	XWD	F.STR,	F.OTH	;	, ^
	XWD	F.STR,	F.OTH	;	, _
	XWD	F.SPTB,	F.STR		;SPACE	, <ACCENT GRAVE>
	XWD	F.STR,	F.LETT+F.LCAS	;	!	, <LOWER CASE>	A
	XWD	F.QUOT,	F.LETT+F.LCAS	;	"	, <LOWER CASE>	B
	XWD	F.STR,	F.LETT+F.LCAS	;	#	, <LOWER CASE>	C
	XWD	F.DOLL,	F.LETT+F.LCAS	;	$	, <LOWER CASE>	D
	XWD	F.STR,	F.LETT+F.LCAS	;	%	, <LOWER CASE>	E
	XWD	F.OTH,	F.LETT+F.LCAS	;	&	, <LOWER CASE>	F
	XWD	F.APOS,	F.LETT+F.LCAS	;	'	, <LOWER CASE>	G
	XWD	F.OTH,	F.LETT+F.LCAS	;	(	, <LOWER CASE>	H
	XWD	F.RPRN,	F.LETT+F.LCAS	;	)	, <LOWER CASE>	I
	XWD	F.STAR,	F.LETT+F.LCAS	;	*	, <LOWER CASE>	J
	XWD	F.PLUS,	F.LETT+F.LCAS	;	+	, <LOWER CASE>	K
	XWD	F.COMA,	F.LETT+F.LCAS	;	,	, <LOWER CASE>	L
	XWD	F.MINS,	F.LETT+F.LCAS	;	-	, <LOWER CASE>	M
	XWD	F.PER,	F.LETT+F.LCAS	;	.	, <LOWER CASE>	N
	XWD	F.SLSH,	F.LETT+F.LCAS	;	/	, <LOWER CASE>	O
	XWD	F.DIG,	F.LETT+F.LCAS	;	0	, <LOWER CASE>	P
	XWD	F.DIG,	F.LETT+F.LCAS	;	1	, <LOWER CASE>	Q
	XWD	F.DIG,	F.LETT+F.LCAS	;	2	, <LOWER CASE>	R
	XWD	F.DIG,	F.LETT+F.LCAS	;	3	, <LOWER CASE>	S
	XWD	F.DIG,	F.LETT+F.LCAS	;	4	, <LOWER CASE>	T
	XWD	F.DIG,	F.LETT+F.LCAS	;	5	, <LOWER CASE>	U
	XWD	F.DIG,	F.LETT+F.LCAS	;	6	, <LOWER CASE>	V
	XWD	F.DIG,	F.LETT+F.LCAS	;	7	, <LOWER CASE>	W
	XWD	F.DIG,	F.LETT+F.LCAS	;	8	, <LOWER CASE>	X
	XWD	F.DIG,	F.LETT+F.LCAS	;	9	, <LOWER CASE>	Y
	XWD	F.OTH,	F.LETT+F.LCAS	;	:	, <LOWER CASE>	Z
	XWD	F.OTH,	F.STR		;	;	, <LEFT	BRACE>
	XWD	F.OTH,	F.STR		;	<	, <VERTICAL BAR>
	XWD	F.EQAL,	F.STR		;	=	, <RIGHT BRACE>
	XWD	F.OTH,	F.STR		;	>	, <TILDE>
	XWD	F.STR,	F.STR		;	?	, <RUBOUT>
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	(GOSUB)
	OPCNT	(ARFET1)
	OPCNT	(ARFET2)
	OPCNT	(ARSTO1)
	OPCNT	(ARSTO2)
	OPCNT	(ARSTN1)
	OPCNT	(ARSTN2)
	OPCNT	(DATA)
	OPCNT	(ADATA1)
	OPCNT	(ADATA2)
	OPCNT	(SDIM)
IFN FTMAT,<
	OPCNT	(MATRD)
	OPCNT	(MATPR)
	OPCNT	(MATSCA)
	OPCNT	(MATCON)
	OPCNT	(MATIDN)
	OPCNT	(MATTRN)
	OPCNT	(MATINV)
	OPCNT	(MATADD)
	OPCNT	(MATSUB)
	OPCNT	(MATMPY)
	OPCNT	(MATZER)
>
	OPCNT	(PRNTB)
IFN FTSTR,<
	OPCNT	(STRUUO)
	OPCNT	(SVRADR)
	OPCNT	(PRSTR)
>
	OPCNT	(DONFOR)
	OPCNT	(MATINP)

MAXUUO=%OPD

UUOHAN: PUSH	P,UUOH		;RETURN ADDRS ON PUSH-DOWN LIST
	LDB	X1,[POINT 9,40,8]
UUOTBL: JRST	.(X1)

	JRST	FAILER
	JRST	PRNMER
	JRST	PRDLER
	JRST	GOSBER
	JRST	AFT1ER
	JRST	AFT2ER
	JRST	AST1ER
	JRST	AST2ER
	JRST	ASN1ER
	JRST	ASN2ER
	JRST	DATAER
	JRST	ADT1ER
	JRST	ADT2ER
	JRST	SDIMER
IFN FTMAT,<
	JRST	MTRDER
	JRST	MTPRER
	JRST	MTSCER
	JRST	MTCNER
	JRST	MTIDER
	JRST	MTTNER
	JRST	MTIVER
	JRST	MTADER
	JRST	MTSBER
	JRST	MTMYER
	JRST	MTZRER
>
	JRST	PRNTBR
IFN FTSTR,<
	JRST	SUUOEX
	JRST	SAD1ER
	JRST	PRSTRR
>
	JRST	FORCOM
	JRST	MATIN
IFN FTSTR,<
SUUOEX:
	LDB X1,[POINT 4,40,12]		;STRING UUOS USE THE AC FIELD
	CAILE X1,MASUUO			;AS AN EXTENSION OF THE OPCODE.
	HALT .
UUOSTR:	JRST	.(X1)
	JRST	GETSTR
	JRST	STRCHA
	JRST	IFSTR
	JRST	SDATAE
	JRST	GETVEC
	JRST	PUTVEC
MASUUO=.-UUOSTR-1
	OPDEF	STRIN	[STRUUO 1,]	;33040
	OPDEF	STRSTO	[STRUUO 2,]	;33100
	OPDEF	STRIF	[STRUUO 3,]	;33140
	OPDEF	STOCHA	[STRUUO 4,]	;33200
	OPDEF	VECFET	[STRUUO 5,]	;33240
	OPDEF	VECPUT	[STRUUO 6,]	;33300
>;ASSEMBLE ABOVE IF INCLUDING STRING FACILITY
;TABLE OF INTRINSIC FUNCTIONS

IFNFLO:
	Z	ABSB+0(SIXBIT /   ABS/)
	Z	ATANB+0(SIXBIT /   ATN/)
	Z	COSB+0(SIXBIT /   COS/)
	Z	COTB+0(SIXBIT /   COT/)
	Z	DETB+40000(SIXBIT /   DET/)
	Z	EXPB+0(SIXBIT /   EXP/)
	Z	INTB+0(SIXBIT /   INT/)
	Z	LOGB+0(SIXBIT /   LOG/)
	Z	NUMB+40000(SIXBIT /   NUM/)
IFN FTRND,<
	Z	RANB+40000(SIXBIT /   RND/)
>
	Z	SGNB+0(SIXBIT /   SGN/)
	Z	SINB+0(SIXBIT /   SIN/)
	Z	SQRTB+0(SIXBIT /   SQR/)
	Z	TANB+0(SIXBIT /   TAN/)
IFNCEI:

;TABLE OF RELATIONS FOR IFSXLA

DEFINE ZZZ. (X,Y)<
OPDEF ZZZZ.	[X]
		ZZZZ.	(Y)>
RELFLO: ZZZ.	3435B11,CAML
	ZZZ.	3436B11,CAME
	ZZZ.	   74B6,CAMLE
	ZZZ.	3635B11,CAMG
	ZZZ.	75B6,CAMN
	ZZZ.	   76B6,CAMGE
RELCEI:

BASIC:	CALLI
	MOVE	P,PLIST
	SETOM	RENFLA
	SKIPN	ONCESW
	JRST	BASI1
	SETZM	ONCESW
	HLRZ	T,JOBSA
	MOVEM	T,FLTXT
	MOVEM	T,CETXT
	MOVE	T,JOBREL
	MOVEM	T,FLLIN
	MOVEM	T,CELIN
	HRLM	T,JOBSA
	HRRZI	T,REENTR
	HRRM	T,JOBREN
	SETOM	174
	JFOV	.+1
	JRST	.+1
	JFOV	.+2
	SETZM	174
BASI1:	PUSHJ	P,TTYIN		;SET UP BUFFERS AND INIT TTY
	SKIPE	CURNAM
	JRST	UXIT
	SETZM	RUNFLA
ASKNEW:	PUSHJ	P,INLMES
	ASCIZ	/
NEW OR OLD--/
FIXUP:	OUTPUT
	MOVEI	X1,OVFLCM		;IGNORE OVFLOW DURING COMMANDS.
	HRRM	X1,JOBAPR
	MOVEI	X1,10		;SETUP ARITH OVFLOW TRAP
	CALL	X1,[SIXBIT /APRENB/]
	MOVEI	X1,TXTROL
	MOVEM	X1,TOPSTG	;EDIT TIME. ONLY TXTROL IS STODGY.
				;OTHER ROLLS MOVE.
	MOVE	T,CELIN	;CLOBBER ALL COMPILE ROOLS WITH "CELIN"
	MOVEI	X1,LINROL	;PROTECT TXTROL +LINROL FROM CLOBBER:
	PUSHJ	P,CLOB
				;FALL INTO MAINLP
;MAIN LOOP FOR EDITOR/MONITOR

MAINLP:	MOVE	P,PLIST
	PUSHJ	P,LOCKOF	;TURN OFF REENTR LOCK
	PUSHJ	P,INLINE	;READ A LINE
	PUSHJ	P,GETNUM	;LOOK FOR SEQUENCE NO
	JRST	COMMAN		;NONE.	GO INTERPRET COMMAND
	SKIPN	CURNAM		;MAKE SURE THERE IS A CURRENT FILE NAME
	JRST	ASKNEW

;HERE, WE HAVE SEQUENCED LINE INPUT.  NUMBER IS IN N,
;POINTER TO FIRST CHAR AFTER NUMBER IS IN T

	PUSHJ	P,LOCKON
	PUSHJ	P,ERASE
	PUSHJ	P,INSERT
	PUSHJ	P,LOCKOF
	JRST	MAINLP

;HERE ON COMMAND

COMMAN:	MOVEI	R,CMDROL
	TLNE	C,F.TERM	;TEST FOR NULL COMMAND
	JRST	MAINLP
	PUSHJ	P,SCNLT1	;SCAN COMMAND
	PUSHJ	P,SCNLT2
	JRST	COMM1		;SECOND CHAR NOT A LETTER
	PUSHJ	P,SCNLT3
	JRST	COMM1		;THIRD CHAR NOT A LETTER

;NOW THE FIRST THREE LETTERS OF THE COMMAND ARE PACKED IN LH OF A.

	PUSHJ	P,SEARCH	;LOOK FOR COMMAND
	JRST	COMM1		;NOT FOUND
	HRRZ	X1,(B)
	SKIPE	CURNAM
	JRST	COM1
	CAIE	X1,OLDER
	CAIN	X1,NEWER
	JRST	COM1
	JRST	ASKNEW
COM1:	TRZN	X1,40000
	JRST	(X1)
	PUSHJ	P,QST
	JRST	COMM1
	JRST	1(X1)

;DELETE (DEL) ROUTINE
DELER:	ASCIZ	/ETE/
	TLNE	C,F.TERM
	JRST	BADDEL
	PUSHJ	P,LIMITS
	MOVE	A,FRSTLN
	MOVS	B,LASTLN
	CAIN	B,1
	MOVEM	A,LASTLN
	PUSHJ	P,DELL1
	JRST	N,UXIT
DELL1:	MOVE	A,FLLIN		;FIND FIRST LINE TO DELETE
DELL2:	CAML	A,CELIN
	POPJ	P,		;TEHRE IS NONE
	HLRZ	N,(A)		;GET LINE NO
	CAMLE	N,LASTLN	;DONE?
	POPJ	P,
	CAMGE	N,FRSTLN
	AOJA	A,DELL2
	PUSHJ	P,LOCKON
	PUSHJ	P,ERASE
	PUSHJ	P,LOCKOF
	JRST	DELL1

;WEAVE COMMAND
WEAER:	ASCIZ	/VE/
	SETZM	BADGNN
	PUSHJ	P,FILNAM
	JUMP	N,WEAV
	OPEN	N,WEAVI
	JRST	NOGETD
	LOOKUP	FILDIR
	JRST	NOGETF
GETT2:	INBUF	1
GETT1:	PUSHJ	P,INLINE+1
	PUSHJ	P,GETNUM
	JRST	BADGET
	MOVEM	N,BADGNN
	PUSHJ	P,LOCKON
	PUSHJ	P,ERASE
	PUSHJ	P,INSERT
	PUSHJ	P,LOCKOF
	JRST	GETT1

;LENGTH OF PROGRAM IN CORE.

LENER:	ASCIZ	/GTH/
	PUSHJ	P,LOCKON
	PUSHJ	P,PRESS
	PUSHJ	P,LOCKOF
	MOVE	T,CETXT
	SUB	T,FLTXT
	IMULI	T,5
	PUSHJ	P,PRTNUM
	PUSHJ	P,INLMES
	ASCIZ	/ CHARACTERS/
	PUSHJ	P,PCRLF
	JRST	N,FIXUP

;ROUTINE TO LIST FILE

LISER:	ASCIZ	/T/
	SETZI	F,		;ASSUME NO HEADINER DESIRED.
	PUSHJ	P,QSA
	ASCIZ	/NH/
	SETOI	F,		;HEADER IS DESIRED, OR CMD ERROR
	PUSHJ	P,LIMITS
	JUMPE	F,LIST1		;SKIP HEADING-
	PUSHJ	P,INLMES	;NO, PRINT IT.
	ASCIZ /

/
	PUSHJ	P,LIST01		;TYPE THE HEADING
	PUSHJ	P,INLMES		;AND A FEW BLANK LINES
	ASCIZ /



/
	JRST N,LIST1
LIST01:	PUSH P,T		;SAVE POINTER TO INPUT LINE
	PUSH P,C		;SAVE CURRENT CHAR.
	HLRZ T,CURDEV
	CAIN T,(SIXBIT /DSK/)	;PRINT DEVICE ONLY IF UNCOMMON.
	JRST LIST02
	HRLZ T,T
	TRO T,320000
	PUSHJ P,PRNSIX		;PRINT THE DEVICE NAME
LIST02:	MOVE T,CURNAM
	PUSHJ P,PRNSIX
	HLRZ T,CUREXT		;DONT PRINT EXT. UNLESS UNCOMMON
	CAIN T,(SIXBIT /BAS/)
	JRST LIST03
	TLO T,16		;INSERT SIXBIT "." BEFORE EXT
	PUSHJ P,PRNSIX
LIST03:	PUSHJ P,TABOUT		;EXECUTE A FORMAT ","
	CALL X2,[SIXBIT /TIMER/]
	IDIVI X2,^D3600
	IDIVI X2,^D60
	MOVEI A,":"		;THE SEPARATION CHAR BETWEEN FIELDS.
	PUSHJ P,PRDE2
	PUSHJ P,TABOUT			;ANOTHER FORMAT ","
	CALL X2,[SIXBIT /DATE/]
	IDIVI X2,^D31
	AOJ Q,
	MOVE X1,X2
	IDIVI X1,^D12
	AOJ X2,
	MOVEI A,57
	ADDI X1,^D64
	EXCH X1,X2
	EXCH X2,Q
	PUSHJ P,PRNS2
	POP P,C
	POP P,T
	POPJ P,
LIST1:	MOVE A,FLLIN
LIST2:	CAML A,CELIN
	JRST N,LIST3
	HLRZ T,(A)
	CAMG T,LASTLN
	CAMGE T,FRSTLN
	AOJA A,LIST2
	PUSHJ P,PRTNUM
LIST25:	MOVE T,(A)
	MOVEI D,15		;QUOTE CHAR
	PUSHJ P,PRINT
	PUSHJ P,INLMES
	ASCIZ /
/
	AOJA A,LIST2
LIST3:	CLOSE
	JRST BASIC
NEWER:	SETZM	OLDFLA		;FLAG WOULD BE -1 FOR "OLD" REQUEST.
	PUSHJ	P,INLMES
	ASCIZ /NEW /
	JRST	NEWOLD
OLDER:	SETOM	OLDFLA
	PUSHJ	P,INLMES
	ASCIZ /OLD /
NEWOLD:	PUSHJ	P,INLMES
	ASCIZ /FILE NAME--/
	OUTPUT
	PUSHJ	P,INLINE
	PUSHJ	P,FILNAM
	JUMP	NEWOL1
	SKIPN	OLDFLA
	JRST	NEWOL2
	OPEN	SPEC
	JRST	NOGETD
	SKIPE	OLDFLA
	JRST	NEWOL3
	LOOKUP	FILDIR
	JRST	NEWOL2
NEWOL3:	LOOKUP	FILDIR
	JRST	NOGETF
NEWOL2:	MOVE	C,[XWD	F.CR,15]
	PUSHJ	P,LIMIT1
	PUSHJ	P,SCRER1
	PUSHJ	P,NAMOVE	;ACCEPT NEW CURRENT FILNAME
	MOVE	X1,NEWOL1
	MOVEM	X1,CURDEV
	SKIPE	OLDFLA
	JRST	GETT2		;OLD FILE. FINISH BY GETTING IT.
	JRST	BASIC
	;ROUTINE TO CHANGE CURRENT NAME

RENER:	ASCIZ /AME/
	TLNN	C,F.TERM	;IS THERE A NAME TO RENAME TO?
	JRST	N,RENA1		;YES
	PUSHJ	P,INLMES	;PROMPT USER FOR A NAME
	ASCIZ /FILE NAME--/
	OUTPUT
	PUSHJ	P,INLINE	;THERE BETTER BE A NAME NOW.
RENA1:	PUSHJ	P,FILNAM	;REQUEST FOR NEW FILE
	JUMP	CURDEV		;SAVE DEVICE IN CURNAM
	TLNN	C,F.TERM
	JRST	COMM1
	PUSHJ	P,NAMOVE	;SET CURINFO FROM FILDIR
	JRST	UXIT
				;ROUTINE TO SAVE NEW COPY OR AN OLD FILE
REPER:	ASCIZ /LACE/
	SETOM	OLDFLA
	JRST	SAVFIL
;ROUTINE TO RENUMBER THE BASIC PROGRAM THAT IS IN CORE.
;THE COMMAND IS
;	RESEQUENCE NN,MM,LL
;WHERE NN IS THE FIRST NUMBER AND LL IS THE STEP VALUE.
;IF OMITTED, LL, OR BOTH NUMBERS=10

;ALL LINE NUMBERS LESS THAN MM WILL NOT BE RESEQUENCED. MM MUST NOT
;BE GREATER THAN NN

;A NUMBER IS A LINE NUMBER IF:
;IT IS THE FIRST ATOM ON A LINE.
;	IT FOLLOWS AN ATOM BEGINNING WITH THE LETTERS:
;		"GOS"	OR   "GOT"   OR	  "THE"
;ALSO, AFTER THE ATOM "GOTO" HAS BEEN IDENTIFIED, THE NUMBER

;FOLLOWING A COMMA IS A LINE NUMBER.
;REENTRY IS NOT ALLOWED DURING "RESEQUENCE".

RESER:	ASCIZ /EQUENCE/
	PUSHJ	P,LIMITS
	MOVE	LASTLN		;GET THE SECOND NUMBER(::=LOWEST)
	HRRZM	N,LOWEST
	MOVEI	N,^D10		;IF FIRST ARG=0, ASSUME FIRST LINE=10
	SKIPN	FRSTLN
	MOVEM	N,FRSTLN
	TLNN	C,F.COMA	;IS THERE A THIRD ARG (THE INCREMENT)?
	JRST	RES1		;NO. LET INCREMENT =^D10
	PUSHJ	P,NXCH
	PUSHJ	P,GETNUM
	JRST	COMM1
RES1:	MOVEM	N,LASTLN
	HRLZ	A,LOWEST	;SEARCH FOR FIRST LINE TO CHANGE
	MOVEI	R,LINROL
	PUSHJ	P,SEARCH
	JFCL
	CAMN	B,FLLIN		;RESEQ ALL LINES?
	JRST	SEQ0		;YES
	HLRZ	N,-1(B)		;NO. MAKE SURE LINE ORDER WILL NOT CHANGE
	CAML	N,FRSTLN
	JRST	RESERR
SEQ0:	MOVN	X2,B
	ADD	X2,CELIN	;THIS IS THE NUMBER OF LINES TO RESEQ
	SUBI	X2,1
	IMUL	X2,LASTLN
	ADD	X2,FRSTLN
	CAILE	X2,^D99999
	JRST	N,SEQOV
	PUSHJ	P,LOCKON	;DONT ALLOW REENTRY.
	MOVE	E,CELIN		;COMPUTE NUMBER OF LINES
	SUB	E,B
	JUMPE	E,UXIT		;NOTHING TO RENUMBER
	MOVN	LP,E
	MOVSI	LP,(LP)
	SUB	B,FLLIN
	MOVEM	B,LOWSTA
	HRR	LP,B
	PUSH	P,LP		;SAVE LP FOR SECOND LOOP.
	HRL	B,B
	SUB	LP,B

;THE LOOP THAT COPIES EACH LINE FOLLOWS:
SEQ2:	MOVE	D,[POINT 7,LINB0]	;BUILD EACH LINE IN LINB0. THEN RESINSERT IT.
	MOVEM	D,SEQPNT
	HRRZ	F,LP
	ADD	F,FLLIN
	HRRZ	T,(F)
	HRLI	T,440700	;POINTER TO OLD LINE IS IN G
				;F USED AS A FLAG REGISTER FOR " ' ETC.
;THE FLAGS ARE
			REST.F=1	;COPY  THE REST (APOST SEEN)
			TOQU.F=2	;COPY TO QUOTE SIGN
			COMM.F=4	;LINE NUMBER FOLLOWS ANY COMMA
			NUM.F=10	;NEXT NUMBER IS LINE NUMBER

;THE CHARACTER/ATOM LOOP:
SEQ3:	PUSHJ	P,NXCHS		;GET NEXT CHAR, EVEN IF SPACE OR TAB
SEQ31:	TLNE	C,F.CR
	JRST	SEQCR
	TLNE	C,F.QUOT	;TEST FOR QUOTE CHAR
	TLCA	F,TOQU.F	;REVERSE QUOTE SWITCH AND COPY THIS CHAR
	TLNE	F,TOQU.F
	JRST	SEQCPY
	TLNE	C,F.APOS
	TLOA	F,REST.F	;APOST SEEN, COPY REST
	TLNE	F,REST.F
	JRST	SEQCPY
	MOVE	G,T		;SAVE POINTER
	TLNN	F,NUM.F		;EXPECTING A LINE NUMBER?
	JRST	SEQ4		;NO. LOOK FOR KEYW ATOMS
	TLNN	C,F.DIG
	JRST	SEQCPY
	JRST	SEQNUM
SEQ4:	TLNE	F,COMM.F
	TLNN	C,F.COMA
	JRST	SEQ5
	TLO	F,NUM.F		;THIS COMMA IMPLIES NUMBER TO FOLLOW
	JRST	SEQCPY
SEQ5:	PUSHJ	P,ALPHSX	;PUT NEXT ALL-LETTER ATOM IN A
	MOVEI	B,SEQTND-SEQTBL	;SET INDEX FOR TABLE OF KEYWORDS PRECEDIING LINE NUMBERS
	MOVE	T,G		;RESET CHAR POINTER TO START OF ATOM.
	CAMN	A,SEQTBL(B)
	TLOA	F,NUM.F+COMM.F	;WE FOUND A KEYBOARD
	SOJGE	B,.-2
	LDB	C,T
SEQCPY:	IDPB	C,SEQPNT
	JRST	SEQ3

SEQTBL:	SIXBIT /GOSUB/
	SIXBIT /GOTO/
SEQTND:	SIXBIT /THEN/

SEQNUM:	PUSH	P,G		;SAVE POINTER IN CASE OF "GLOBAL" LINE NUMBER
	PUSHJ	P,GETNUM
	HALT	.
	CAMGE	N,LOWEST
	JRST	SEQT1		;DONT RESEQ THIS NUMBER
	MOVEI	R,LINROL
	HRLZ	A,N
	PUSHJ	P,SEARCH
	JRST	SEQBAD
	SUB	B,FLLIN
	SUB	B,LOWSTA
	IMUL	B,LASTLN
	ADD	B,FRSTLN	;THIS IS THE NEW LINE NUMBER
	MOVE	X1,B
	PUSHJ	P,MAKNUM	;DEPOSITE THE NUMBER IN LINB0
	POP	P,X1		;CLEAR PLIST A LITTLE
	TLZ	F,NUM.F
	LDB	C,T
	PUSHJ	P,NXCHD
	JRST	N,SEQ31
SEQBAD:	MOVE	T,N
	PUSHJ	P,PRTNUM
	PUSHJ	P,INLMES
	ASCIZ / IN LINE /
	HLRZ	T,0(7)
	PUSHJ	P,PRTNUM
	PUSHJ	P,PCRLF
SEQT1:	POP	P,1
	LDB	C,1
	TLZ	F,10
	JRST	SEQCPY

SEQCR:	IDPB	C,SEQPNT
	HLRZ	N,(F)
	PUSHJ	P,ERASE		;ERASE OLD LINE COPY
	MOVE	T1,SEQPNT	;POINT TO END OF LINE FOR NEWLIN
	PUSHJ	P,NEWLIN	;INSERT NEW ONE WITH OLD LINE NUMBER
	AOBJN	LP,SEQ2		;DO NEXT LINE
	POP	P,LP
	ADD	LP,FLLIN
	MOVE	N,FRSTLN
	HRLM	N,(LP)
	ADD	N,LASTLN
	AOBJN	LP,.-2
	JRST	N,UXIT		;FINISHED. ALLOW REENTRY.

SEQOV:	PUSHJ P,INLMES
	ASCIZ /COMMAND ERROR (LINE NUMBERS MAY NOT EXCEED 99999)
/
	JRST N,FIXUP
;ROUTINE TO SAVE PROGRAM

SAVER:	ASCIZ	/E/
	SETZM	OLDFLA		;SAVE "NEW" FILE ONLY
SAVFIL:	PUSHJ	P,FILNAM
SAVER0:	JUMP	SAVEX
	PUSHJ	P,LIMITS
	OPEN	SAVI
	JRST	NOGETD
	PUSHJ	P,LOCKON
	SKIPE	OLDFLA
	JRST	SAVE1
	LOOKUP	FILDIR
	JRST	SAVE2
	JRST	NOTNEW
SAVE1:	LOOKUP	FILDIR
	JRST	NOGETF
SAVE2:	CLOSE
	SETZM	N,FILDIR+2
	ENTER	FILDIR
	JRST	NOSAVE
	OUTBUF	1
	JRST	LIST1
;ROUTINE TO CLEAR TXTROL.

SCRER:	ASCIZ /ATCH/
	PUSH	P,[EXP UXIT]
SCRER1:	MOVE	X1,FLTXT	;WIPE OUT LINROL AND TXTROL
	MOVEM	X1,CETXT
	MOVE	X1,FLLIN
	MOVEM	X1,CELIN
	POPJ	P,

;ROUTINE TO RETURN TO THE SYSTEM.

SYSER:	ASCIZ /TEM/
	CALLI	12		;EXIT

SUBTTL	       COMMAND SUBROUTINES

;ROUTINE TO PICK UP FILE NAME AND SET UP FOR DSK ACTION.
;THE FLAG COPFLG IS EXPLAINED AT THE COPY ROUTINE COPER.


FILNAM:	POP	P,B		;COPER ENTERS HERE, WITH COPFLG = -1.
	PUSHJ	P,FILNMO
FILN7:	PUSHJ	P,ATOMSX
	MOVEI	Q,":"
	CAIE	Q,(C)
	JRST	N,FILN1
	MOVEM	A,@(B)
	JRST	N,FILN1A
FILN1:	TLNN	C,F.PER		;PERIOD SEEN?
	JRST	N,FILN2
	JUMPE	A,COMM1
	CAIE	X2,FILDIR
	JRST	N,COMM1
	MOVEM	A,FILDIR
	MOVEI	X2,FILDIR+1
FILN1A:	PUSHJ	P,NXCH
	JRST	N,FILN7
FILN2:	JUMPN	A,FILN3
	HRRZ	A,B
	CAIN	A,SAVER0
	CAIE	X2,FILDIR
	JRST	N,COMM1
	SKIPN	A,CURNAM
	JRST	N,COMM1
	MOVEM	A,(X2)
	HLLZ	A,CUREXT
	HLR	A,CURDEV
	PUSHJ	P,FILNM1
	CAIA
FILN3:	MOVEM	A,(X2)
	MOVEI	A,DRMBUF
	MOVEM	A,JOBFF
	JRST	1(B)

;ROUTINE TO CONVERT NEXT ATOM TO SIXBIT

ALPHSX:	SKIPA	D,[Z (F.LETT)]
ATOMSX:	HRLZI	D,F.DIG+F.LETT
	TLZ	B,777777	;SET LH OF A+1 TO 0
	MOVEI	A,0
	MOVE	X1,[POINT 6,A]
ATOMS1:	TDNN	C,D
	POPJ	P,
	PUSHJ	P,SCNLTN	;PACK THIS LETTER INTO A.
	JFCL			;SCNLTN HAS SKIP RETURN.
	TLNE	X1,770000
	JRST	N,ATOMS1
	POPJ	P,
FILNMO:	MOVEI	A,(SIXBIT /DSK/)
	HRLI	A,(SIXBIT /BAS/)
FILNM1:	HRLZM	A,@(B)
	HLLZM	A,FILDIR+1
	MOVEI	X2,FILDIR
	POPJ	P,

NAMOVE:	MOVE	X1,FILDIR
	MOVEM	X1,CURNAM
	MOVE	X1,FILDIR+1
	MOVEM	X1,CUREXT
	POPJ	P,

;ROUTINES TO SET LINE LIMITS
LIMITS:	TLNE	C,F.TERM
	JRST	LIMIT1
	PUSHJ	P,QSA
	ASCIZ	/--/
	JRST	.+1
	PUSHJ	P,GETNUM
LIMIT1:	MOVEI	N,0
	MOVEM	N,FRSTLN
	TLNE	C,F.TERM
	JRST	LIMIT2
	TLNN	C,F.COMA
	JRST	N,COMM1
	PUSHJ	P,NXCH
	PUSHJ	P,GETNUM
LIMIT2:	MOVSI	N,1
	MOVEM	N,LASTLN
	POPJ	P,

;A NONPRINTING ROUTINE SIMILAR TO PRTNUM:

MAKNUM:	IDIVI	X1,^D10
	JUMPE	X1,MAKN1
	PUSH	P,X2
	PUSHJ	P,MAKNUM
	POP	P,X2
MAKN1:	MOVEI	X2,60(X2)
	IDPB	X2,SEQPNT
	POPJ	P,
;ROUTINE TO ERASE LINE.	 LINE NO IN N.

ERASE:	HRLZ	A,N		;LOOK FOR LINE
	MOVEI	R,LINROL
	PUSHJ	P,SEARCH
	POPJ	P,			;NONE.	GO TO INSERTION

	MOVE	D,(B)		;PICK UP LOC OF LINE
	HRLI	D,440700		;MAKE BYTE POINTER
	MOVEI	T1,0		;TO USE IN DEPOSITING
ERAS1:	ILDB	C,D		;GET CHAR
	DPB	T1,D		;CLOBBER IT
	CAIE	C,15		;CARRIAGE RET?
	JRST	ERAS1		;NO.  GO FOR MORE

	SETOM	PAKFLA		;MARK FACT THAT THERE IS A HOLE

	MOVEI	E,1		;REMOVE ENTRY FROM LINE TABLE
	JRST	CLOSUP

;HERE WE HAVE A LINE OF INPUT AND THERE IS NO EXISTING LINE

INSERT:	MOVE	T1,[POINT 7,LINB0]
	MOVE	T,G		;RESTORE PNTR TO 1ST CHR
INSE2:	ILDB	C,T		;GET NEXT CHAR
	CAIN	C,15		;CHECK FOR CAR RET
	JRST	N,INSE4
	IDPB	C,T1
	JRST	N,INSE2

INSE4:	JUMPL	T1,CPOPJ	;CR SEEN.  DONE IF JUST DELETION
	IDPB	C,T1		;STORE THE CR
	MOVEI	C,0		;CLEAR REST OF WORK
	TLNE	T1,760000
	JRST	.-3
	JRST	N,NEWLIN

;AT THIS POINT, N CONTAINS A LINE NUMBER AND LINB0 CONTAINS
;A NON-EMPTY INSERTED LINE.  T1 CONTAINS ADDRESS OF LAST
;WORD OF THE LINE.

NEWLIN:	MOVEI	T1,(T1)		;COMPUTE LINE LENGTH
	SUBI	T1,LINB0-1

	ADD	T1,CETXT	;COMPUTE NEW CEILING OF TEXT ROLL
	CAMGE	T1,FLLIN	;ROOM FOR LINE PLUS LINROL ENTRY?
	JRST	NEWL1		;YES
	SUB	T1,CETXT	;ASK FOR MORE CORE
	MOVE	E,T1
	ADDI	E,1
	PUSHJ	P,PANIC
	ADD	T1,CETXT

NEWL1:	MOVE	D,CETXT	;LOC OF NEW LINE
	MOVE	T,D		;CONSTRUCT BLT PNTR
	HRLI	T,LINB0
	BLT	T,-1(T1)	;MOVE THE LINE
	MOVEM	T1,CETXT	;STORE NEW CEILING


;HERE, LINE IS IN PLACE, ITS LOC IN D, LINE NUMBER IN N.
;MUST STILL PUT LINE NUMBER IN LINROL.

NEWNBR:	PUSH	P,D		;*****JUST IN CASE*****
	MOVEI	R,LINROL
	HRLZ	A,N
	PUSHJ	P,SEARCH
	JRST	.+2
	HALT	.		;*****IMPOSSIBLE CONDITION*****

	MOVEI	E,1
	PUSHJ	P,OPENUP	;MAKE ROOM FOR IT
	POP	P,D		;*****OTHER HALF OF JUST IN CASE*****
	HRRI	A,(D)		;CONTRUCT LINROL ENTRY
	MOVEM	A,(B)		;STORE ENTRY
	POPJ	P,		;ALL DONE

COMM1:	PUSHJ	P,INLMES
	ASCIZ /WHAT?
/
COMM1A:	SKIPE	CURNAM
	JRST	FIXUP
	JRST	ASKNEW
BADDEL:	PUSHJ P,INLMES
	ASCIZ /DELETE COMMAND MUST SPECIFY WHICH LINES TO DELETE
/
	JRST	COMM1A
NOSAVE:	PUSHJ	P,TTYIN
	PUSHJ	P,INLMES
	ASCIZ /NO ROOM IN DIRECTORY/
	OUTPUT
	JRST	BASIC
NOGETF:	PUSHJ	P,TTYIN
	PUSHJ	P,INLMES
	ASCIZ /FILE NOT SAVED/
        OUTPUT
	JRST	BASIC
TTYIN:	MOVEI	T,TTYBUF		;SET UP TTY BUFFS
	MOVEM	T,JOBFF
	INIT	1
	SIXBIT	/TTY/
	XWD	TYO,TYI
	HALT	.-3
	INBUF	1
	OUTBUF	1
	POPJ	P,

BADGET:	MOVEI	T,BADMSG
	MOVE	X1,[POINT 7,BADGNN]
	MOVEM	X1,SEQPNT
	MOVE	X1,BADGNN			;LAST GOOD LINE NUMBER
	TLNN	X1,-1			;HAS IT BEEN CHANGED ALREADY?
	PUSHJ P,MAKNUM		;NO, MAKE THE NUMBER
	CALL	T,[SIXBIT /DDTOUT/]
	MOVEI	T,CRLFMS
	CALL	T,[SIXBIT /DDTOUT/]
	JRST	GETT1

NOGETD:	PUSHJ	P,TTYIN
	PUSHJ	P,INLMES
	ASCIZ /NO SUCH DEVICE/
	OUTPUT
	JRST	BASIC
NOTNEW:	PUSHJ	P,TTYIN
	PUSHJ	P,INLMES
	ASCIZ /DUPLICATE FILE NAME. REPLACE OR RENAME/
	OUTPUT
	JRST	BASIC
RESERR:	PUSHJ	P,INLMES
	ASCIZ /COMMAND ERROR (YOU MAY NOT OVERWRITE LINES OR CHANGE THEIR ORDER)
/
	OUTPUT
	JRST	BASIC
RUNER:	MOVEI	A,0
	CAIA	N,QSA		;IS IT RUNNH
	ASCIZ /NH/
	MOVEI	A,1		;NO, PRINT HEADING
	TLNN	C,F.TERM	;IS THERE A LINE NUMBER ARGUMENT?
	JRST	COMM1
	JUMPE	A,RUNNH		;SHALL WE PRINT THE HEADING?
	PUSHJ	P,INLMES
	ASCIZ /
/
	PUSHJ	P,LIST01		;PRINT HEADING SANS <RETURN>
	OUTPUT
	PUSHJ	P,INLMES
	BYTE (7) 15,12,12
RUNNH:	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.
	JRST	RUNER1

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,

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,JOBREL		;USE THIS VALUE.
	PUSHJ	P,CLOB		;DO THE CLOBBERING.
	MOVEI	F,0		;CLEAR COMPILATION FLAGS
	MOVEI	T,0		;SET UP AC FOR RUNTIM.
	CALL	T,[SIXBIT /RUNTIM/]	;GETY TIME OF START.
	MOVEM	T,MTIME		;SAVE TIME AT START OF RUNER
	MOVEM	T,RUNFLA
	SETZM	N,DATAFF
	SETOM	N,TMPLOW
	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,LUKDEF+1	;SCAN FOR NEXT "DEF" STA
	PUSHJ	P,NXLINE	;PREPARE TO READ THE NEXT LINE
	PUSHJ	P,LUKD4
	MOVEI	X1,[ASCIZ/DEFFN/]
	PUSHJ	P,QST		;IS IT A "DEF" STA?
	JRST	N,LUKD3		;NO. GO ON TO NEXT LINE

	HRRZ	B,C		;YES. SAVE FN NAME.

	MOVEI	A,LUKD2
LUKD1:	PUSHJ	P,NXCH		;NOW LOOK FOR EQUAL SIGN
	TLNE	C,F.TERM
	JRST	N,LUKD3		;NO EQUAL. ITS A MULTILINE DEF.
	TLNN	C,F.EQAL
	JRST	N,LUKD1		;TRY NEXT CHAR.
	JRST	N,LUKD3-1	;ITS A ONE LINE DEF. IGNORE IT.

LUKD2:	MOVEI	A,LUKD2+2		;MARK EVERY LINE OF TIS MULTILINE FNT.
	ROT	B,-7		;PUT FUNCTION NAME IN FIRST CHAR POISTION
	PUSHJ	P,NXLINE
	MOVEM	B,(G)		;NOW THIS LINE CONTAINS THE NAME OF ITS FN.
	PUSHJ	P,LUKD4
	MOVEI	X1,[ASCIZ /FNEND/]
	PUSHJ	P,QST		;END OF THE FN?
	CAIA
	MOVEI	A,LUKDEF+1	;YES. SCAN FOR NEXT DEF.

LUKD3:	AOBJN	L,(A)		;GET NEXT LINE, IF THERE IS ONE
	JRST	RUNER2
LUKD4:	POP	P,D
	TLNE	C,F.TERM
	JRST	LUKD5
	PUSHJ	P,QSA
	ASCIZ /REM/
	JRST	(D)
LUKD5:	AOS	(G)
	JRST	LUKD3

;FINISHED MARKING FUN LINES. NOW SET UP A CLEAR LADROL...
RUNER2:	MOVEI	F,LADROL
	PUSHJ	P,ZERROL
	JRST	EACHLN

;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,
;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	N,LETSW
	SETZM	N,REGPNT
	SETZM	N,PSHPNT
	SETOM	N,IFFLAG
	SKIPE	N,FUNAME
	JRST	EACHL2
	MOVE	X1,FLARG
	MOVEM	X1,CEARG
EACHL2:	PUSHJ	P,NXLINE	;SET UP POINTER TO THIS LINE.
	MOVSI	A,(SIXBIT /REM/)	;PREPARE FOR COMMENT
	TLNE	C,F.TERM	;NULL STATEMENT?
	JRST	EACHL1		;YES. ELIDED "REM" (FIRST CHAR WAS A APOSTROPHE)
	PUSHJ	P,SCNLT1		;SCAN FIRST LTR
	CAIE	C,"("
	TLNE	C,F.EQAL+F.DIG+F.DOLL	;ELIDED LETTER?
	JRST	ELILET		;YES.  POSSIBLE ASSUMED "LET"
	PUSHJ	P,SCNLT2		;SCAN SECOND LETTER.
	JRST	ILLINS		;SECOND CHAR WAS NOT A LETTER.
	MOVS	X1,A
	CAIE	X1,(SIXBIT /IF/)
	CAIN	X1,(SIXBIT /ON/)
	JRST	EACHL1
	CAIE	X1,(SIXBIT /FN/)	;ELIDED LET FNX=  ?
	JRST	EACHL3		;NO.
	PUSHJ	P,SCNLT3
	JRST	N,ILLINS
	TLNE	C,F.EQAL	;IS FOURTH CHAR AN '=' SIGN?
	JRST	ELILET		;YES, ELIDED STATEMENT
	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
	JRST	EACHL1

ELILET:	MOVSI	A,(SIXBIT /LET/)	;ASSUME A "LET" STATMENT.
	MOVS	T,D			;GO BACK TO THE FIRST LETTER.
	HRLI	T,440700
	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	Q,CECOD		;PUT REL ADDRS IN LADROL
	SUB	Q,FLCOD
	MOVE	X2,FLLAD
	ADDI	X2,(L)
	HRLM	Q,(X2)
	HRLI	D,(MOVEI L,)
	TRZE	A,20000		;EXECUTABLE?
	PUSHJ	P,BUILDI

	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:	TLNE	C,1000
	FAIL	<ILLEGAL CHARACTER>
	JRST	1(X1)
;HERE ON END OF STATEMENT XLATION

NXTSTA:	TLNN	C,F.TERM
	JRST	GRONK


;ENTER HERE FROM ERROR ROUTINE

NXTST1:	AOBJN	LP,EACHLN
NOEND:	PUSHJ	P,INLMES
	ASCIZ /
NO END INSTRUCTION
/

UXIT:	SETZM	RUNFLA
	SKIPE	MTIME
	PUSHJ	P,PTIME
	PUSHJ	P,TTYIN
	PUSHJ	P,INLMES
	ASCIZ /
READY
/
	JRST N,FIXUP
SUBTTL	       PROGRAM "LOADER"
;HERE AFTER END STATEMENT

LINKAG:	MOVEI	R,CONROL	;SLIDE RUNTIME ROLLS DOWN INTO PLACE.
	PUSHJ	P,SLIDRL
	CAIGE	R,TMPROL
	AOJA	R,.-2		;SLIDE NEXT ROLL
	MOVEM	X2,VARFRE	;FIRST FREE LOC IS CEIL OF TMPROL.

	MOVE	E,CETMP	;CHECK ARRAY REQUIREMENTS
	MOVE	T,FLARA
	JRST	LK2A

LK1:	HLRZ	X1,(T)		;KNOW SIZE?
	JUMPN	X1,LK2		;YES, JUMP
	MOVSI	X2,^D11		;(11,1) IS STANDARD DIM.
	AOJ	X2,
	MOVEI	X1,^D11
	MOVE	Q,1(T)
	CAMGE	T,FLSVR	;DEFAULT SIZE OF STRING VECTORS IS (11,1)
	AOJE	Q,.+2		;IMPLICIT 2-DIM ARRAY?
	JRST	N,.+3
	HRRI	X2,^D11
	MOVEI	X1,^D121
	MOVEM	X2,1(T)
	HRLM	X1,(T)		;STORE SIZE
LK2:	ADD	E,X1		;ADD LENGTH TO IT
	ADDI	T,2		;ON TO NEXT ENTRY
	CAMG	T,FLSVR		;IS THIS ONE A STRING VECTOR?
	JRST	LK2A		;NO.
	HLRZ	X2,-1(T)		;LOOK AT FIRST DIMENSION
	SOJLE	X2,LK2A		;IS IT 1(AND THUS A VECTOR)?
	HRRZ	X2,-1(T)	;NO. LOOK AT SECOND DIMENSION
	SOJLE	X2,LK2A		;IS IT 1(AND THUS A VECTOR)?
	SETZM	RUNFLA		;NO. FATAL ERROR.
	PUSHJ	P,INLMES
	ASCIZ /STRING VECTOR IS 2-DIM ARRAY
/
LK2A:	CAMN	T,FLSVR		;BEGINNING OF SVRROL SCAN?
	MOVEM	E,SVRBOT		;YES, REMEMBER BOTTOM OF VECTOR POINTERS
	CAMGE	T,CESVR
	JRST	LK1

	SETOM	VPAKFL		;DONT TRY TO PRESS VARAIBLE SPACE NOW!
	SUB	E,CESVR		;WE NEED THIS MANY LOCS
	PUSHJ	P,VCHCK1
	ADD	E,CETMP		;CALCULATE TOP OF ARRAY SPACE.
	MOVEM	E,SVRTOP	;SAVE IT.
	MOVEM	E,VARFRE	;THIS IS ALSO FIRST FREE WORD.

	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]
	ADDI	C,40
	PUSHJ	P,OUCH
	PUSHJ	P,INLMES
	ASCIZ /
/
	AOJA	T,LINK0A
LINK0C:	MOVE	B,FLFOR	;UNSAT FORS?
	CAML	B,CEFOR
	JRST	LINK0D
	MOVEI	T,[ASCIZ /FOR WITHOUT NEXT/]
	MOVE	L,(B)		;GET POINTER TO LINE NUMBER
	PUSHJ	P,FAILR		;PRINT ERROR MSG
	ADDI	B,5		;MORE UNSAT FORS?
	JRST	LINK0C+1
LINK0D:	SKIPG	DATAFF
	JRST	LINK0E
	PUSHJ	P,INLMES
	ASCIZ /NO DATA/
	SETZM	RUNFLA
LINK0E:	SKIPN	RUNFLA		;GO INTO EXECUTION?
	JRST	UXIT		;NO

	MOVE	C,FLCOD

;CODE ROLL IS IN PLACE.	 C CONTAINS ITS FLOOR

	MOVE	T,FLFCL	;LINK FCN CALLS
	MOVE	T1,CEFCL
	MOVE	A,FLCOD
	MOVEI	B,0
	PUSHJ	P,LINKUP

	MOVE	T,FLARA	;LINK ARRAY REFS
	MOVE	T1,CESVR
	MOVE	A,T
	MOVEI	B,2
	PUSHJ	P,LINKUP

	MOVE	T,FLARA	;STORE ARRAY ADDRESSES IN APAROL
	MOVE	G,CETMP
	JRST	N,LINK1D
LINK1C:	HLRZ	X1,(T)		;GET ARRAY LENGTH
	HRRM	G,(T)		;STORE ABS ADDRS
	ADD	G,X1		;COMPUTE ADDRS OF NEXT ARRAY
	ADDI	T,2		;GO TO NEXT ENTRY
LINK1D:	CAMGE	T,T1
	JRST	N,LINK1C

LINK1:	MOVE	T,FLCAD	;LINK CONST REFS
	MOVE	T1,CECAD
	MOVE	A,FLCON
	MOVEI	B,1
	PUSHJ	P,LINKUP

LINK2:	MOVE	T,FLPTM	;LINK TEMPORARY REFS (PERM AND TEMP)
	MOVE	T1,CETMP
	MOVE	A,T
	MOVEI	B,1
	PUSHJ	P,LINKUP

LINK3:	MOVE	T,FLLAD	;LINK GOTO DESTINATIONS
	MOVE	T1,CELAD
	MOVE	A,FLCOD
	MOVEI	B,0
	PUSHJ	P,LINKUP

LINK4:	MOVE	T,FLSCA	;LINK SCALARS
	MOVE	T1,CEVSP
	MOVE	A,T
	MOVEI	B,1
	PUSHJ	P,LINKUP

LINK6:	MOVE	T,FLGSB	;LINK GOSUB REFS
	MOVE	T1,CEGSB
	MOVE	A,T
	MOVEI	B,1
	PUSHJ	P,LINKUP
	MOVE	T,FLGSB
LINK7:	CAML	T,T1		;PUT SUBRTN ADDRSES IN GSBROL
	JRST	N,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

	MOVE	T,FLSAD		;LINK POINTERS TO LITROL
	MOVE	T1,CESAD
	MOVE	A,FLLIT
	MOVEI	B,1
	PUSHJ	P,LINKUP

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,SVRTOP
	PUSHJ	P,BLTZER

	SETZM	N,FMTPNT
	SETZM	N,FCNLNK
	PUSHJ	P,RESTOR
	MOVEI	R,0
	PUSHJ	P,PCRLF
	PUSHJ	P,PCRLF
	SETZM	N,INPFLA
	SETZM	N,TABVAL
	SETOM	N,NUMRES
	SETZB	N,STRFCN
IFN FTRND,<
	PUSHJ	P,WRANB
>
	MOVEI	X1,OVTRAP
	HRRM	X1,JOBAPR
	PUSHJ	P,LOCKOF
	JRST	N,@FLCOD

;SUBROUTINE TO LINK ROLL ENTRIES

;CALL WITH A=ORG OF VALUE ROLL, B=INCREMENT (0 IF EXPLICIT REL LOC)
;T=FLOOR OF SRC ROLL, T1=CEIL OF SRC ROLL


LINKUP:	MOVE	X2,A
	MOVSI	X1,C

LNKP1:	CAML	T,T1		;FINISHED ROLL?
	POPJ	P,
	HRRZ	Q,(T)		;FIRST LOC IN CHAIN
	JUMPN	B,.+3		;EXPLICIT ADDRS?
	HLRZ	X2,(T)		;YES.  COMPUTE IT
	ADD	X2,C
	JUMPE	Q,LNKP3		;SPECIAL CASE--CHAIN VOID

LNKP2:	HRR	X1,Q		;ONE LINK IN CHAIN
	HRRZ	Q,@X1
	HRRM	X2,@X1
	JUMPN	Q,LNKP2

LNKP3:	JUMPN	B,.+2		;EXPLICT ADDRS?
	AOJA	T,LNKP1		;YES, JUST BUMP ROLL PNTR
	ADD	T,B		;NO, ADD EXPLICIT INCREMENT
	ADD	X2,B		;  (ALSO TO DEST ROLL)
	JRST	N,LNKP1

BLTZER:	HRL	X1,X1		;ZERO OUT CORE
	SETZM	N,(X1)
	AOJ	X1,
	BLT	X1,-1(X2)
	POPJ	P,

IFN FTSTR,<
;CHANGE STATEMENT

; CHANGE <VECTOR> TO <STRING>
;		OR
;CHANGE <STRING> TO <VECTOR>

;COMPILES A FETCH AND PUT WHICH INTERFACE WITH THE "PUTSTR" ROUTINE
>

XCHAN:	ASCIZ	/NGE/		;CHANGE?
	HRLI	F,1
	TLNE	C,40
	JRST	XCHAN1
	PUSHJ	P,VECTOR
	CAIN	A,4
	JRST	GRONK
	JUMPE	A,.+3
	PUSHJ	P,FLET2
	JRST	XCHAN3
	MOVSI	D,(VECFET)
	PUSHJ	P,BUILDA
	PUSHJ	P,QSF
	ASCIZ	/TO/
	PUSHJ	P,FORMLB
	MOVSI	D,(STRSTO)
XCHAN2:	SKIPE	N,IFFLAG
	JRST	ILFORM
	PUSHJ	P,BUILDA
	JRST	NXTSTA
XCHAN1:	PUSHJ	P,FORMLB
XCHAN3:	PUSHJ	P,FLET3
	PUSHJ	P,QSF
	ASCIZ /TO/
	PUSHJ	P,VECTOR
	MOVSI	D,(VECPUT)
	JRST	XCHAN2
;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
	PUSHJ	P,DATCHK
	FAIL	<DATA NOT IN CORRECT FORM>
	JRST	NXTSTA

;SUBROUTINE TO CHECK DATA LINE
;ALSO CALLED AT RUN TIME TO CHECK INPUT LINE
;(NOTE.. <RETURN> NOT CHECKED AFTER INPUT LINE)


DATCHK:	TLNN	C,F.LETT+F.QUOT	;LETTER OR QUOT SIGN FIRST
	JRST	DATCH2		;NO, EVALUATE NUMBER
	PUSH	P,[DATCH3]	;YES, ASSUME STRING AND SKIP OVER
	JRST	N,SKIPDA
DATCH2:	PUSHJ	P,EVANUM
DATCH3:	POPJ	P,
	CAIE	C,"&"		;IF "&", ASSUME MATINPUT TERM
	TLNE	C,F.TERM	;MORE?
	JRST	CPOPJ1		;NO. RETURN
	TLNN	C,F.COMA	;DID FIELD END CORRECTLY?
	POPJ	P,		;NO ERROR
	PUSHJ	P,NXCH		;YES. SKIP COMMA
	JRST	N,DATCHK
;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>
	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	GRONK
	PUSHJ	P,SCNLT1	;SCAN FCN NAME.
	PUSH	P,A		;SAVE FCN NAME WITH COUNT OF ZERO ARGUMENTS
	MOVEM	A,FUNAME	; FN'NAME IN BODY OF FUNCTION
;ADD FUNCTION NAME TO FCNROL

	MOVEI	R,FCNROL	;LOOK FOR FNC NAME IN FCNROL
	PUSHJ	P,SEARCH
	JRST	.+2
	FAIL	<FUNCTION DEFINED TWICE>
	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,.+1		;DONT GEN JRST IF LAST LINE OF SOURCE.
	MOVSI	D,(JRST)
	PUSHJ	P,BUILDI	;GEN JRST INSTR.
	MOVEM	B,FUNSTA	;REMEMBER WHERE THIS JRST IS
	MOVEI	D,0		;BUILD ZERO CONTROL WORD
	PUSHJ	P,BUILDI

;SCAN FOR ARGUMENT NAME.

	CAIE	C,"("	;ANY ARGUMENTS?
	JRST	XDEF4		;NO

XDEF2:	PUSHJ	P,NXCHK		;SKIP "("
	PUSHJ	P,SCNLT1	;ASSEMBLE ARGUMENT NAME
	TLNN	C,F.DIG
	JRST	.+3
	DPB	C,[POINT 7,A,13]
	PUSHJ	P,NXCHK

	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	N,XDEF2D
	CAMN	A,(B)
	JRST	GRONK
	AOJA	B,XDEF2C

XDEF2D:	MOVEI	E,1		;ADD NEW ARG TO ROLL
	PUSHJ	P,OPENUP
	MOVEM	A,(B)
	AOS	(P)		;COUNT THE ARGUMENT
	TLNE	C,F.COMA	;ANY MORE ARGS?
	JRST	XDEF2		;YES

	TLNN	C,F.RPRN	;FOLLOWING PARENTHESIS?
	JRST	GRONK		;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	N,XDEFM		;YES
	PUSHJ	P,NXCHK		;NO. SKIP EQUAL SIGN
	SETZM	N,FUNAME	;SIGNAL THAT THIS IS NOT A MULTI-LINE FN

	PUSHJ	P,FORMLN	;GET THE EXPRESSION
	PUSHJ	P,EIRGNP

;NOW BUILD AN INSTRUCTION THAT WILL TELL RETURN HOW MANY ARGS TO POP
;OFF THE PUSH LIST

	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 FNC
	MOVE	Q,CESTM
	MOVEM	X2,CEPTM
	MOVEM	X2,FLTMP
	MOVEM	Q,CETMP
	MOVEM	Q,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 N,FRETRN]
	JRST	N,XRET1		;USE RETURN CODE TO BUILD INST

XDEFM:	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
	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 < 0 IF THE MATRIX IS SET EQUAL TO ITS OWN TRN,
;>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:	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	GRONK
	ADD	B,FLOOR(F)	;COMPUTE LOC OF ROLL ENTRY
	SKIPLE	1(B)		;DIMENSION FLAG SHOULD BE 0 OR -1 OR -2
	FAIL	<VARIABLE DIMENSIONED TWICE>
	PUSHJ	P,NXCHK		;SKIP PARENTHESIS
	PUSHJ	P,GETNU	;FIRST DEMENSION
	JRST	GRONK		;NOT A NUMBER
	HRRZ	D,N		;SAVE FIRST DIM
	AOBJN	D,.+1		;D::= XWD <FIRST DIM+1>,1
	MOVEM	D,1(B)		;STORE IN ARAROL (IN CASE 1 DIM)
	MOVEI	N,1		;IN CASE ONE DIMENSION
	TLNN	C,F.COMA	;TWO DIMS?
	JRST	N,XDIM1		;NO
	PUSHJ	P,NXCHK		;YES. SKIP COMMA.
	JUMPN	A,GRONK		;STRING VECTOR HAS TWO DIMS?
	PUSHJ	P,GETNU	;GET SECOND DIM
	JRST	GRONK		;NOT A NUMBER
	ADDI	N,1
	HRL	D,N		;NOW D HAS XWD <COLS+1>,<ROWS+1>
	MOVSM	D,1(B)		;STORE IN ROLL SWAPPED
XDIM1:	IMULI	N,(D)		;COMPUTE LENGTH OF ARRAY
	HRLM	N,0(B)		;STORE IN ROLL

	TLNN	C,F.RPRN	;CHECK CLOSING PAREN
	JRST	GRONK
	PUSHJ	P,NXCHK		;LOOK FOR COMMA
	TLNN	C,F.COMA
	JRST	NXTSTA		;NO. DONE WITH THIS STATEMENT.
	PUSHJ	P,NXCHK		;SKIP THE COMMA.
	JRST	XDIM
;END STATEMENT

;<END STA> ::= END

XEND:	MOVE	X1,FLLIN	;CHECK THAT IT IS LAST STA
	ADDI	X1,1(L)
	CAME	X1,CELIN
	FAIL	<END IS NOT LAST>

	MOVE	D,[JRST UXIT]	;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 > 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)
;<REL.	ADRS IN CODROL OF JUST TO END OF-NEXT>
;	<POINTER TO INDUCTION VARIABLE>
;	<POINTER TO INCREMENT>
;	<CURRENT VALUE OF TMPLOW>


XFOR:	TLNN	C,F.LETT	;MAKE SURE VARIABLE IS FIRST.
	JRST	GRONK
	MOVE	A,L		;SAVE L FOR POSSIBLE ERROR MSG
	MOVEI	R,FORROL
	PUSHJ	P,RPUSH
	PUSHJ	P,REGLTR	;REGISTER ON SCAROL
	CAIN	A,1		;BETTER BE SCALAR
	TLNN	C,F.EQAL	;BETTER HAVE EQUAL
	JRST	GRONK
	PUSHJ	P,NXCHK		;SKIP EQUAL SIGN.
	PUSH	P,B		;SAVE THE VARIABLE POINTER
	PUSHJ	P,FORMLN	;GEN THE INITIAL VALUE
	PUSHJ	P,EIRGNP
	MOVSI	D,(MOVEM N,)	;GEN STORE INITIAL IN VARIABLE
	MOVE	B,(P)
	PUSHJ	P,BUILDA
	PUSHJ	P,QSF		;LOOK FOR "TO"
	ASCIZ	/TO/
	PUSHJ	P,FORMLN	;GEN THE UPPER BOUND.
	PUSHJ	P,GPOSGE	;PERMANENT
	PUSHJ	P,SIPGEN	;TEMPORARY.
	PUSH	P,B		;REMEMBER WHERE IT IS
	TLNN	C,F.TERM	;IS THERE A STEP CLAUSE?
	JRST	XFOR2		;LOOK FOR EXPLICIT "STEP"
	MOVE	T,[POINT 7,[BYTE (35)"STEP1"(7)15]]
	PUSHJ	P,NXCHK		;GET "S" IN CASE OF CR		;IMPLICIT "STEP1"
XFOR2:	PUSHJ	P,QSF		;LOOK FOR "STEP"
	ASCIZ /STEP/

	PUSHJ	P,FORMLN	;XLATE AND GEN INCREMENT
	PUSHJ	P,SIPGEN	;SAVE STEP
	EXCH	B,0(P)		;EXCH WITH TOP OF ROL
	PUSH	P,B		;SAVE LOC OF UPPER BOUND
	MOVE	B,-2(P)		;GET INDUCTION VAR IN REG
	PUSHJ	P,EIRGEN
	MOVE	B,-1(P)
	HLRZ	X1,B
	ANDI	X1,377777
	CAIN	X1,31
	JRST	XFOR3
	MOVSI	D,(DONFOR)
	PUSHJ	P,BUILDA
XFOR3:	MOVE	X1,-1(P)
	POP	P,B		;BUILD COMPARE INSTR (IT
	MOVSI	D,(CAMLE N,)	;DOESN'T MATTER WHAT IT
	SKIPGE	N,X1		;IS IF DONFOR IS THERE).
	MOVSI	D,(CAMGE)
	PUSHJ	P,BUILDA
	MOVSI	D,(JRST)	;DUMMY JRST INSTRUCTION
	PUSHJ	P,BUILDI

	MOVE	A,CECOD
	SUB	A,FLCOD		;SAVE LOC FOR NEXT'S JRST
	SKIPE	N,RUNFLA	;WHAT JRST ACUTALLY
	MOVEI	A,-2(A)		;NO. DONT ALLOW SPACE FOR IT.
	MOVEI	R,FORROL
	PUSHJ	P,RPUSH
	POP	P,A
	EXCH	A,(P)
	PUSHJ	P,RPUSH		;SAVE INDUCTION VARIABLE
	EXCH	A,(P)		;GET INCREMENT
	PUSHJ	P,RPUSH
	POP	P,B		;GET POINTER TO INDUCTION VARIABLE.
	MOVSI	D,(MOVEM N,)	;BUILD THE STORE THAT WILL BE USED
	PUSHJ	P,BUILDA	;BY NEXT.

	MOVEI	R,FORROL
	MOVE	A,TMPLOW	;SAVE THIS LEVEL OF PROTECTION TO BE RESTORED
	PUSHJ	P,RPUSH
	MOVE	A,TMPPNT	;PROTECT TEMPS USED BY THIS "FOR"
	MOVEM	A,TMPLOW	;IN THE RANGE OF THE FOR.
	JRST	N,NXTSTA
;FNEND STATEMENT

;<FNEND STA> ::= FNEND

XFNEND:	ASCIZ /ND/
	SKIPN	A,FUNAME	;MUST FOLLOW A MULTI-LINE FN DEF
	FAIL <FNEND BEFORE DEF>
	SETZM	FUNAME		;SIGNAL END OF FN
	TLO	A,(177B13)	;ASSEMBLE THE SCALAR NAME OF THE RESULT
	PUSHJ	P,SCAREG	;REGISTER IT AS A SCALAR
	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>
	JRST	XDEFE

;GOSUB STATEMENT XLATE

XGOSUB:	ASCIZ	/UB/
	PUSHJ	P,GETNUM	;READ STATEMENT NUMBER
	JRST	GRONK
	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
	JRST	N,.+2
	JRST	N,XGOS1
	MOVEI	E,1
	PUSHJ	P,OPENUP
	MOVEM	A,(B)
XGOS1:	SUB	B,FLGSB
	HRLI	B,GSBROL
	MOVSI	D,(GOSUB)
	PUSHJ	P,BUILDA
	JRST	N,NXTSTA


;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 >
	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
	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>


;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,FORMLB	;LEFT SIDE, MY BE A STRING
	PUSHJ	P,GPOSGE	;SAVE TYPE.
	PUSHJ	P,PUSHPR	;MAKE SURE IT IS POSITIVE
	PUSHJ	P,SCNLT1	;SAVE IT
	MOVEI	X1,">"
	CAIE	X1,(C)		;NEXT CHAR ">"?
	TLNE	C,F.EQAL	;OR "="?
	PUSHJ	P,SCN2		;PUT TWO CHAR RELATION IN A(SIXBIT)
	JFCL
	MOVEI	R,RELROL	;RELATION TABLE
	PUSHJ	P,SEARCH
	FAIL	<ILLEGAL RELATION>
	HRLZ	D,(B)		;SAVE RELATION INSTR
	PUSH	P,D
	PUSHJ	P,FORMLB	;RIGHT SIDE, MAY ALSO BE A STRING
	SKIPN	IFFLAG
	FAIL <MIXED STRINGS AND NUMBERS>
	PUSHJ	P,GPOSGE
	TLNN	B,ROLMSK	;IS RIGHT SIDE IN REG?
	JRST	IFSX4		;YES, LEAVE IT
	PUSHJ	P,EXCHG		;NO. SWAP WITH LEFT SIDE.
	MOVE	D,(P)		;FUDGE INSTRUCTION FOR CONTRAPOSITIVE RELATION
	TLNE	D,1000		;(EQUAL, NOT EQUAL DON'T CHANGE.)
	TLC	D,6000		;(OTHERS DO).
	MOVEM	D,(P)

IFSX4:
IFN FTSTR,<
	SKIPL	IFFLAG		;NUMERIC COMPARE?
	JRST	IFSX6		;NO, STRING.
>
	PUSHJ	P,EIRGNP	;MOVE TO REG
	PUSHJ	P,POPPR		;GET OTHER SIDE BACK
	POP	P,D		;GET STASHED OP CODE
	PUSHJ	P,BUILDA	;BUILD COMPARE INSTRUCTION
IFSX5:	PUSHJ	P,THENGO	;LOOK FOR "THEN" OR "GOTO"
	JRST	N,XGOFIN	;USE GOTO CODE TO GEN JRST INSTR

IFN FTSTR,<
IFSX6:	PUSHJ	P,FLET3
	PUSHJ	P,POPPR		;GET OTHER ONE BACK
	MOVSI	D,(STRIF)	;STRING COMPARE UUO
	PUSHJ	P,BUILDA	;COMPARE UUO WITH OTHER STRING ADDRESS
	POP	P,D
	PUSHJ	P,BUILDI	;BUILD THE RELATION
	JRST	N,IFSX5		;FINISH UP (THE OTHER STR POINTER WILL BE IN N)
>;ASSEMBLE ABOVE IF INCLUDING STRING FACILITY
;INPUT STATEMENT

;<INPUT STA> ::= INPUT (<SCALAR> ! <ARRAY REF>)[,(<SCALAR>!<ARRAY REF>)...]


XINPUT:	ASCIZ /UT/
	MOVE	D,[PUSHJ P,DOINPT]
XINP0:	PUSHJ	P,BUILDI	;CONTRUCT SETUP INSTR
XINP1:	TLNN	C,F.LETT	;CHECK THAT LETTER IS NEXT.
	JRST	GRONK
	SETZI	F,		;STRINGS MAY BE INPUT
	PUSHJ	P,REGLTR	;GET VARIABLE
	JUMPE	A,XINP2
	CAIG	A,4		;STRING VARIABLE?
	JRST	XINP1A		;NO
IFN FTSTR,<
	CAIG	A,6		;VARIABLE?
	JRST	XINP6		;YES
>

	JRST	ILFORM		;NO, ATTEMPT TO BOMB A LITERAL

XINP1A:	CAILE	A,1		;ONLY ARRAY AND SCALAR ALLOWED
	JRST	ILVAR
	MOVSI	D,13000
	PUSHJ	P,BUILDA
	JRST	N,XINP3
XINP2:	PUSH	P,B		;SAVE VARIABLE POINTER
	PUSHJ	P,XARG		;XLATE ARGS
	MOVSI	D,14000
	JUMPE	B,XINP2A
	HRRZ	X1,(P)		;GET ADDRESS OF VARIABLE 2-WD BLOCK
	ADD	X1,FLARA
	SKIPN	1(X1)		;MARK	2-DIM
	SETOM	1(X1)
	MOVSI	D,15000
XINP2A:	EXCH	B,(P)		;SAVE NO OF ARGS, GET VARIABLE
	PUSHJ	P,BUILDA	;BUILD DATA INSTR
	POP	P,B		;GET NO OF ARGS
	PUSHJ	P,GENARG

XINP3:	TLNN	C,F.COMA	;MORE?
	JRST	NXTSTA		;NO
	PUSHJ	P,NXCHK		;YES. SKIP COMA
	JRST	XINP1
IFN FTSTR,<
XINP6:	PUSHJ	P,FLET2		;STRING. FINISH REGISTERING
	MOVSI	D,33200
	PUSHJ	P,BUILDA	;BUILD, WITH ADDRESS
	JRST	XINP3
>
;LET STATEMENT

XLET:	TLNN	C,2000
	JRST	GRONK
	SETZI	F,
	SETOM	LETSW		;LOOK FOR A LHS.
XLET0B:	PUSHJ	P,FORMLB
	SKIPGE	LETSW		;FAIL IF THIS FORMULA IS NOT A VARIABLE
	TLNN	C,220000
	JRST	XLET0A
	SKIPL	IFFLAG
	JRST	XLET3
	PUSH	P,[EXP 1]	;FLAG ON PLIST. IF THE LHS IS A SCALER,
	PUSH	P,B		;PUT THE FLAG AND AC B ON PLIST HERE.
XLET0:	PUSHJ	P,NXCHK		;SKIP EQUAL SIGN.
	SOS	LETSW		;COUNT THIS LHS, AND
	JRST	XLET0B		;LOOK FOR ANOTHER.
XLET0A:	MOVMS	LETSW		;FINISHED SCANNING
	SOSG	LETSW
	JRST	GRONK
	SKIPL	E,IFFLAG	;STRING LET STA?
	JRST	XLET3A		;YES.

	PUSHJ	P,EIRGEN	;NO, GET RESULT IN REG
	MOVEM	B,TEMP1		;SAVE THE NEGATIVE RESULT CHECK
XLET1:	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,(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.
	POP	P,B		;RESTORE RESULT PNTR
	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	XLET1		;THERE IS ANOTHER LHS.
	JRST	NXTSTA

XLET3:	PUSHJ	P,PUSHPR
	JRST	N,XLET0
XLET3A:	CAME	E,LETSW
	FAIL	<MIXED STRINGS AND NUMBERS>
XLET4:	PUSH	P,B
	PUSHJ	P,FLET3
	PUSHJ	P,POPPR
	MOVSI	D,(STRSTO)	;BUILD THE STRING MOVE INSTRUCTION.
	PUSHJ	P,BUILDA
	POP	P,B
	SOSLE	LETSW
	JRST	XLET4		;THERE IS ANOTHER LHS.
	JRST	NXTSTA
IFN FTMAT,<
;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,PRINT
	PUSHJ	P,QSA		;MAT READ?
	ASCIZ	/READ/
	JRST	XMAT2		;NO.  GO TRY MAT PRINT
XMAT1:	PUSHJ	P,ARRAY		;GET ARRAY NAME
	CAIE	A,5		;STRING VECTOR?
	JUMPN	A,GRONK
	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	N,NXTSTA	;YES.
	JRST	N,XMAT1

;<MAT PRINT STA>::= MAT PRINT <LETTER>[(<EXP>,<EXP>)] [[;!,] <LETTER>[(<EXP>,<EXP>)...]

XMAT2:	PUSHJ	P,QSA		;MAT PRINT?
	ASCIZ /PRINT/
	JRST	N,XMAT3		;NO. MUST HAVE VARIABLE NAME.
XMAT2A:	PUSHJ	P,ARRAY		;REGISTER NAME
	CAIE	A,5		;STRING VECTOR?
	JUMPN	A,GRONK
	MOVSI D,(MATPR)
	PUSHJ	P,CHKFMT
	TLNN	D,140
	JRST	GRONK		;FAIL IF ILLEGAL
	PUSHJ	P,XMACOM	;GO CHECK DIMENSIONS AND BUILD UUO
	TLNE	C,F.TERM	;IS FORMAT CHAR FOLLOWED BY END OF STA?
	JRST	NXTSTA		;YES.
	JRST	XMAT2A

;<MAT SCALE STA> ::= MAT <LETTER>=(<EXPRESSION>)*<LETTER>

XMAT3:	PUSH	P,[Z NXTSTA]	;ALL REMAINING MAT STATEMENTS MAY HAVE
				;ONE OPERAND, BUT NOT A LIST OF THEM.
	PUSHJ	P,QSA
	ASCIZ /INPUT/
	JRST	XMAT3A
	PUSHJ	P,VECTOR	;REGISTER VECTOR NAME
	CAIE	A,5		;STRING VECTOR?
	JUMPN	A,GRONK		;OR NUMBER VECTOR?
	MOVSI	D,(MATINP)	;YES. BUILD MAT INPUT
	JRST	BUILDA


XMAT3A:	HRLI	F,-1		;REMAINING MATOPS CANT HAVE STRINGS.
	PUSHJ	P,ARRAY		;REGISTER THE VARIABLE
	JUMPN	A,GRONK		;CHECK FOR ILLEGAL ARRAY NAME.
	TLNN	C,F.EQAL	; CHECK FOR EQUAL SIGN.
	JRST	GRONK
	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
	PUSHJ	P,EIRGNP
	PUSHJ	P,QSF		;SKIP MULTIPLY SING
	ASCIZ /)*/
	PUSH	P,[MATSCA]	;GET OP CODE.
	JRST	N,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:	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 REGISTERY 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?
	MOVE	D,[JUMP T1,ONCESW]	;ONE. FAKE DIMENSIONS OF (0,N)
	PUSHJ	P,BUILDI
	SETZI	B,

XMACO1:	PUSHJ	P,GENARG		;GEN ARGS
	JRST	XMAT9C		;RESTORE AC,S AND BUILD

;<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
XMITCM:	PUSH	P,B		;FINISH MAT INV,TRN.
	PUSH	P,D
	PUSHJ	P,ARRAY
	JUMPN	A,GRONK
	PUSHJ	P,QSF
	ASCIZ /)/
	JRST	XMAT9B
;<MAT OPERATOR STA>::=MAT <LETTER>=<LETTER>+!-!*<LETTER>

XMAT9:	PUSH	P,B		;SAVE RESULT LOCATION
	PUSHJ	P,ARRAY
	JUMPN	A,GRONK
	MOVEI	D,0		;LETTER FOLLOWED BY OPERATOR
	TLNN	C,F.PLUS+F.MINS+F.STAR
	JRST	N,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)
	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:	PUSHJ	P,ARRAY		;SECOND ARRAY
	JUMPN	A,GRONK		;NOT ARRAY NAME

;ENTER HERE FROM MAT INV, TRN

XMAT9B:	MOVSI	D,(MOVEI T1,)
	PUSHJ	P,BUILDA
XMAT9C:	POP	P,D
	POP	P,B
XMAT9D:	PUSHJ	P,BUILDA
	POPJ	P,		;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
	MOVE	D,[MOVSI N,(1.0)];PUT CONSTANT 1.0 IN REG FOR SCALE
	PUSHJ	P,BUILDI	;BUILD INSTR TO GET SCAL FACTOR
	POP	P,B		;GET SOURCE MAT BACK
	PUSH	P,[MATSCA]
	JRST	N,XMAT9B
>;ASSEMBLE ABOVE IF INCLUDING MATRIX FACILITY
;;NEXT STATEMENT

;<NEXT STA> ::= NEXT <SCALAR>

;EXPECT TO FIND 5-WORD ENTRY ON TOP OF FORROL
;DISCRIBING INDUCTION VARIABLE AND LOOP ADDRESS

;WORD IS PUSHED ON NXTROL OF FOLLOWING FORM:
;	(<REL ADRS OF TOP OF LOOP>) <REL ADRS OF JRST TO IT>
;THIS WORD USED TO FIX UP REFERENCE AT END OF
;COMPILATION
XNEXT:	ASCIZ /T/
	PUSHJ	P,REGLTR
	CAIE	A,1		;BETTER BE SCALAR
	JRST	GRONK
	MOVE	X1,CEFOR	;UNSAT FOR?
	CAMG	X1,FLFOR
	FAIL	<NEXT WITHOUT FOR>
	CAME	B,-3(X1)	;CHECK INDUCTION VARIABLE
	FAIL	<NEXT WITHOUT FOR>

	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)
	PUSHJ	P,BUILDA
	PUSHJ	P,POPFOR	;GET LOC OF RETURN

	MOVEI	X1,1(B)		;ADD TO ADDRESS CHAIN OF NEXT WORD
	ADD	X1,FLCOD
	MOVE	X2,L
	AOBJP	X2,XNEX2	;DONT LINK IF LAST STATEMENT!
	ADD	X2,FLLAD
	MOVE	Q,(X2)
	HRRM	Q,(X1)
	MOVEI	Q,1(B)
	HRRM	Q,(X2)

XNEX2:	MOVSI	A,(B)		;ADD WORD TO NXTROL FOR LINKAGE
	MOVEI	R,NXTROL
	PUSHJ	P,RPUSH
	SUB	B,FLNXT
	HRLI	B,NXTROL
	MOVSI	D,(JRST)	;BUILD JRST INSTR
	PUSHJ	P,BUILDA
	PUSHJ	P,POPFOR	;POP OFF THE SAVED VALUE OF L
	JRST	NXTSTA
;SUBR TO POP TOP OF FORROL. USED ONLY BY XNEXT.


POPFOR:	SOS	X1,CEFOR	;POP TOP OF FORROL
	MOVE	B,(X1)
	POPJ	P,


;ON STATEMENT

;<ON STA> ::= ON <EXPRESSION> GOTO!THEN <STA NUMBER> [,<STA NUMBER>...]

;CREATES A CALL TO A RUNTIME ROUTINE THAT CHECKS THE RANGE OF THE ARGUMENT
;AND RETURNS TO THE APPROPRIATE JRST:
;	JSP	A,XCTON
;	Z	(ADDRESS OF NEXT STATEMENT)
;	<NEST OF>
;	<GOTO'S >


XON:	PUSHJ	P,FORMLN	;EVALUTE INDEX
	PUSHJ	P,EIRGNP	;GET IN REG
	MOVE	D,[JSP Q,XCTON]
	PUSHJ	P,BUILDI	;BUILD THE RUNTIME CALL
	SETZI	D,		;BUILD ADDRESS OF NEXT STATEMENT
	MOVE	B,L
	AOBJP	B,.+3		;DONT BUILD IF LAST STATEMENT
	HRLI	B,LADROL
	PUSHJ	P,BUILDA
	PUSHJ	P,THENGO	;TEST FOR "THEN" OR "GOTO"

XON1:	PUSHJ	P,XGOFR		;BUILD A JRST TO THE NEXT NAMED STATMENT
	TLNN	C,F.COMA	;MORE?
	JRST	N,NXTSTA	;NO
	PUSHJ	P,NXCHK		;YES. SKIP COMMA
	JRST	N,XON1		;PROCESS NEXT LINE NUMBER
;PRINT STATEMENTS CAUSES DATA TO BE OUTPUT TO THE DISK OR TTY.

XPRINT:	ASCIZ /NT/
	TLNE	C,F.TERM
	JRST	N,XPCRLF
XPRI1:	SETOM	IFFLAG
	TLNE	C,40
	JRST	N,XPRTA2
	PUSHJ	P,QSA
	ASCIZ	/TAB/		;TAB FIELD?
	CAIA			;NO, ASSUME EXPRESSION OR DELIMENTER.
	JRST	XPRTAB		;YES, DO THE TAB
	TLNE	C,F.COMA
	JRST	N,XPRI2
	PUSHJ	P,FORMLB
	SKIPL	N,IFFLAG
	JRST	N,PRNDEL
	PUSHJ	P,GPOSNX
	MOVSI	D,(PRNM)	;SET UP OP CODE
	PUSHJ	P,CHKFMT	;SET FORMAT CODE
	PUSHJ	P,BUILDA	;GEN PRINT UUO
	JRST	XPRFIN
XPRI2:	MOVE	D,[PRNTB  ONCESW]
	JRST	XPRTA1

;PRINT TAB

XPRTAB:	PUSHJ	P,FORMLN	;EVALUATE TAB SUBEXPRESSION
	PUSHJ	P,EIRGNP	;MOVE IT INTO REG
	MOVSI	D,(PRNTB)	;CALL THE TAB INTERPRETER
XPRTA1:	PUSHJ	P,CHKFMT
	PUSHJ	P,BUILDI	;YES, BUILD THE INST.
	JRST	XPRFIN
XPRTA2:	PUSH	P,T
	PUSHJ	P,QSKIP
	JRST	GRONK
	MOVSI	D,3000
	PUSHJ	P,CHKFMT
	PUSHJ	P,BUILDI
	POP	P,D
	PUSHJ	P,BUILDI
XPRFIN:	TLNE	C,F.TERM	;CR AT END OF LINE?
	JRST	NXTSTA
	JRST	XPRI1

;HERE FOR PRINT WITH NO ARGUMENTS.  GEN CARRIAGE RETURN.

XPCRLF:	MOVE	D,[PUSHJ P,PCRLF]
	PUSHJ	P,BUILDI
	JRST	NXTSTA

;CHECK FORMAT CHAR (PRINT AND MAT PRINT)

CHKFMT:	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
	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,

PRNDEL:	MOVSI	D,(PRSTR)
	PUSHJ	P,CHKFMT
	PUSHJ	P,BUILDA
	JRST	XPRFIN
;RANDOM IZE STATEMENT

IFN FTRND,<
XRAN:	ASCIZ /DOM/
	PUSHJ	P,QSA
	ASCIZ /IZE/
	JFCL
	TLNN	C,F.TERM
	JRST	N,ILLINS
	MOVE	D,[PUSHJ P,RANDER]
	PUSHJ	P,BUILDI		;BUILD CALL TO RUTIME RANDOMIZER
	JRST	N,NXTSTA
>;ASSEMBLE ABOVE IF INCLUDING RANDOM FACILITY


;READ STATEMENT


XREAD:	ASCIZ /D/
	SKIPL	DATAFF		;DATA SEEN YET?
	HLLOS	DATAFF	;NO.  SET NO DATA FLAG
	MOVE	D,[PUSHJ P,DOREAD]
	JRST	XINP0		;GO FINISH WITH INPUT CODE

;RESTORE STATEMENTS.


XREST:	ASCIZ /TORE/
	MOVE	D,[PUSHJ P,RESTON]
	TLNN	C,F.STAR+F.DOLL
	SOJA	D,XRES1
	TLNE	C,F.DOLL	;RESTORE ONLY STIRNGS?
	ADDI	D,1
	PUSHJ	P,NXCHK		;SKIP $ OR *
XRES1:	PUSHJ	P,BUILDI
	JRST	NXTSTA


;RETURN STATEMENT XLATE


XRETRN:	ASCIZ /URN/
	MOVE	D,[JRST RETURN]
XRET1:	PUSHJ	P,BUILDI	;XDEFS ENTERS HERE TO COMPLETE A FN DEF.
	JRST	N,NXTSTA



;STOP STATEMENT

XSTOP:	ASCIZ /P/
	MOVE	D,[JRST UXIT]
	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.

FORMLB:	SETZI	F,
	TLNE	C,40
	JRST	N,REGSL1
	TLNN	C,2000
FORMLN:	SETOI	F,
	PUSHJ	P,TERM		;GET FIRST TERM

;ENTER HERE FOR MORE SUMMANDS

FORM1:	TLNN	C,F.PLUS+F.MINS
	POPJ	P,
	MOVMS	N,LETSW		;THIS CANT BE LH(LET)
	TLO	F,777777
	PUSHJ	P,PUSHPR	;PART RESLT TO SEXROL
	PUSHJ	P,TERM		;GET SECOND TERM
	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
	MOVSI	D,(FADR N,)	;FETCH INSTRUCTION
	PUSHJ	P,BUILDS	;BUILD ADD OR SUB INSTR
	POP	P,B		;REG PNTR WITH SIGN
	AND	B,[XWD MINFLG,0]
	JRST	FORM1
;LOOP TO GEN CODE FOR MULTIPLY AND DIVIDE
;CALLS FACTOR TO HANDLE EXPRESSIONS INVOLVING ONLY INFIX OPS AND "^"


TERM:	PUSHJ	P,FACTOR

;ENTER HERE FOR MORE FACTORS

TERM1:	TLNN	C,F.STAR+F.SLSH	;MUL OR DIV FOLLOWS?
	POPJ	P,		;NO, DONE WITH TERM.
	MOVMS	LETSW		;THIS CANT BE LH(LET)
	TLO	F,777777
	HRRZS	0(P)		;SET MUL FLAG.
	TLNN	C,F.STAR	;IS IT MULTIPLY?
	HRROS	0(P)		;NO. SET DIV FLAG
	PUSHJ	P,NXCHK		;SKIP OVER CONNECTIVE
	PUSHJ	P,PUSHPR	;STASH PARTIAL RESULT ON SEXROL
	PUSHJ	P,FACTOR	;GET NEXT FACTOR
	SKIPGE	(P)		;IS SECOND FACTOR A DIVISOR?
	PUSHJ	P,SITGEN	;YES. IT CANNOT STAY IN REG.
	TLNE	B,ROLMSK	;IS SECOND FACTOR IN REG?
	PUSHJ	P,EXCHG		;NO. LETS GET FIRST FACTOR
	MOVE	X1,CESEX	;PEEK AT DIVISOR OR SECOND FACTOR.
	MOVE	X2,-1(X1)
	TLZE	X2,MINFLG	;IS IT MINUS?
	TLC	B,MINFLG	;YES. CHANGE SIGNS OF BOTH.
	MOVEM	X2,-1(X1)	;NOW DIVISOR 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,)
	PUSHJ	P,BUILDA	;BUILD MUL OR DIV INSTR
	POP	P,B		;REG PNTR WITH SIGN
	JRST	N,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.
	TLNE	C,F.MINS
	TLC	C,F.PLUS+F.MINS	;YES. PRETEND IT WAS PLUS CALLING ATOM.

	PUSHJ	P,ATOM		;GEN FIRST ATOM

FACT2A:	CAIE	C,"^"		;EXPONENT FOLLOWS?
	JRST	SNOEXI		;NO.  GO NOTE SIGN AND RETURN.
	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
	PUSHJ	P,POPPR		;GET EXPONENT IN AC1
	MOVSI	D,(MOVE 1,)
	PUSHJ	P,BUILDS
	MOVE	D,[PUSHJ P,EXP3.0]
	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+F.MINS
	PUSHJ	P,NXCHK		;YES. SKIP SIGN
	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
	CAIE	C,F.SLSH+F.QUOT	;STR CONSTANT.
	JRST	ILFORM		;NO.  ILLEGAL FORMULA

	PUSHJ	P,NXCHK		;SUBEXPR IN PARENS.  SKIP PAREN
	PUSHJ	P,FORMLN	;GEN THE SUBEXPRESSION
	TLNN	C,F.RPRN	;BETTER HAVE MATCHING PAREN
	JRST	ILFORM		;NO.  GRONK.
	PUSHJ	P,NXCHK		;SKIP PARENTHESIS
	JRST	N,SNOEXI	;GO TEST SIGN AND RETURN

FNUMBR:	PUSHJ	P,EVANUM	;EVALUATE NUMBER (IN N)
	FAIL <ILLEGAL CONSTANT>
	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
	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	N,SNOEXI	;GO LOOK AT SIGN AND RETURN

NNUM:	PUSH	P,[EXP 1]	;REGISTER THE CONSTANT IN "N"
	JRST	N,FNUM1
;XLATE AND GEN ATOMIC FORMULA BEGINNING WITH LETTER

FLETTR:	PUSHJ	P,REGLTR
FLET1:	CAILE	A,4
	AOS	IFFLAG
	JRST	.+1(A)
	JRST	XARFET		;ARRAY REF
	JRST	SNOEXI		;SCALAR.  JUST RETURN
	JRST	XINFCN		;INTRINSIC FCN
	JRST	XDFFCN		;DEFINED FCN
	JRST	ILVAR
IFN FTSTR,<
	JRST	XARFET
	JRST	XINF3+1
	JRST	XINF3
>
FLET2:	PUSH	P,[EXP 1]	;PUSH AN IMPLICIT PLUS SIGN ON PLIST
	JRST	FLET1		;FINISH REGISTERING VARIABLE.

FLET3:	SKIPGE	IFFLAG
	POPJ	P,
	MOVSI	D,33040
	JRST	N,BUILDA

XARFET:	PUSH	P,B
	PUSH	P,F
	PUSHJ	P,REGFRE	;FREE REG
	PUSHJ	P,XARG
	POP	P,F
	SKIPGE	IFFLAG
	SKIPL	LETSW		;IS IT LH OF ARRAY-LET?
	JRST	XARF1
	TLNN	C,220000	;IS IT DEFINITELY LH OF ARRAY-LET?
	JRST	XARF1		;NO.

	POP	P,X1
	SUB	P,[XWD 6,6]	;ADJUST THE PUSHLIST TO ESC FORMLS
	PUSH	P,B		;SAVE THE ARGUMENT FLAG
	PUSH	P,X1		;SAVE THE ARRAY POIUNTER
	JRST	N,XLET0

XARF1:	PUSH	P,B
	MOVSI	D,(ARFET1)
IFN	FTSTR,<
	SKIPL	IFFLAG		;STR VECTOR?
	MOVSI	D,(SVRADR)	;YES. FETCH STRING POINTER ADDRESS.
>
	JUMPE	B,XARFFN
	SKIPL	IFFLAG
	FAIL <STRING VECTOR HAS 2 DIMS>
	MOVSI	D,(ARFET2)
	MOVE	X1,-1(P)	;MARK DOUBLE ARRAY
	ADD	X1,FLOOR(F)
	SKIPN	1(X1)
	SETOM	1(X1)
XARFFN:	POP	P,B
	EXCH	B,0(P)
	PUSHJ	P,BUILDA
	POP	P,B
	PUSHJ	P,GENARG
	MOVEI	B,0		;REG POINTER
	SKIPL	IFFLAG		;STRING VECTORS?
	PUSHJ	P,SITGEN	;YES,SAVE ADDRESS POINTER
	JRST	N,SNOEXI
;GEN FUNCTION CALLS

XDFFCN:	PUSH	P,D		;SAVE FCN NAME
	PUSHJ	P,REGFRE	;SAVE ANY SUBEXPRESSION
	PUSHJ	P,PUSHPR	;SAVE FUNCTION LOCATION
	CAIE	C,"("		;ANY ARGS?
	JRST	N,XDFF2		;NO
	SETZM	PSHPNT		;INITIALIZE COUNT OF PUSH INSTS GENNED
XDFF1:	PUSHJ	P,NXCHK
	PUSHJ	P,FORMLN	;GEN THE ARGUMENT IN REG
	PUSHJ	P,GPOSGE
	MOVSI	D,(PUSH P,)	;BUILD ARGUMENT PUSH
	PUSHJ	P,BUILDA
	AOS	PSHPNT		;COUNT THE PUSH
	AOS	(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	GRONK
	SETZM	PSHPNT		;RESET THE PUSH COUNT AGAIN
	PUSHJ	P,NXCHK		;SKIP PAREN

XDFF2:	PUSHJ	P,ARGCHK	;CHECK FOR RIGHT NUMBER OF ARGUMENTS
	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
	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:	HRRZ	N,-1(P)
	HRL	N,N		;N NOW CONTAINS THE CONSTANT TO SUBTRACT FROM P
	PUSHJ	P,NNUM		;REGISTER THIS CONSTANT
	MOVE	N,-1(P)		;GET FCN NAME
	MOVEM	B,-1(P)		;SAVE ADDREESS OF CONSTANT
	HRR	N,B		;ASSEMBLER 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
	CAME	N,0(B)		;FCN SEEN BEFORE. SAVE NUMBER OF ARGS.
	FAIL	<INCORRECT NUMBER OF ARGUMENTS>
	POPJ	P,

ARGCH1:	MOVEI	E,1		;ADD FCN REF TO FADROL
	PUSHJ	P,OPENUP
	MOVEM	N,(B)
	POPJ	P,

;INTRINSIC FUNCTION GENERATOR.
XINFCN:	PUSH	P,B		;SAVE FCN LOC
	PUSHJ	P,REGFRE	;PROTECT ANY PARTIAL RESULTS
	CAIN	C,50
	JRST	N,XINF1
	TRNN	B,40000
	FAIL	<INCORRECT NUMBER OF ARGUMENTS>
	JRST	N,XINF2
XINF1:	PUSHJ	P,NXCHK
	PUSHJ	P,FORMLN
	PUSHJ	P,EIRGNP
	PUSHJ	P,XARG1+1
XINF2:	POP	P,D
	TRZ	D,40000
	HRLI	D,260740
	PUSHJ	P,BUILDI
	MOVEI	B,0
	JRST	SNOEXI
XINF3:	PUSH	P,[EXP 1]
	JRST	SNOEXI
;ROUTINE TO XLATE ARGUMENTS
;RETURNS WITH ARGS ON SEXROL.  B IS O IF ONE ARG, -1 IF TWO.

XARG:	PUSHJ	P,NXCHK		;SAVE PARENTHESIS.
	PUSH	P,LETSW		;SAVE LETSW WHILE TRANSL ARGS
	MOVMS	LETSW		;THE COMMA FOLLOWING AN ARG IS NOT LH(LET)!
	PUSHJ	P,FORMLN
	PUSHJ	P,GPOSNX
	PUSHJ	P,SITGEN
	PUSHJ	P,PUSHPR
	MOVEI	B,0
	TLNN	C,F.COMA	;COMMA FOLLOWS?
	JRST	N,XARG1		;NO. ONE ARG.
	PUSHJ	P,NXCHK		;YES GEN AND SAVE SECOND ARG
	PUSHJ	P,FORMLN
	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	N,ILFORM
	JRST	N,NXCHK		;IT DOES. SKIP RPAREN AND RETURN.

;ROUTINE TO GEN ARGUMENTS

GENARG:	JUMPE	B,GENAFN		;ONE OR TWO ARGS?
	PUSHJ	P,POPPR		;TWO
	PUSHJ	P,EXCHG
	PUSHJ	P,GENAF1

GENAFN:	PUSHJ	P,POPPR
GENAF1:	MOVSI	D,(JUMP 2,)
	JRST	N,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.

REGLTR:	PUSHJ	P,SCNLT1	;LTR TO A, LEFT JUST 7 BIT
	HRRI	F,SCAROL	;ASSUME SCALAR
	TLNE	C,F.LETT	;ANOTHER LETTER?
	JRST	REGFCN		;YES.  GO LOOK FOR FCN REF
	TLNN	C,F.DIG		;DIGIT FOLLOWS?
	JRST	REGARY		;NO, GO CHECK FOR ARRAY
	DPB	C,[POINT 7,A,13];ADD DIGIT TO NAME
	PUSHJ	P,NXCHK		;GO ON TO NEXT CHAR
IFN FTSTR,<
	TLNE	C,F.DOLL	;STRING VARIABLE?
	JRST	REGSTR		;YES. REGISTER IT.
>

;RETURN HERE IF REGARY SAYS NOT ARRAY
;RETURN HERE IF REGFCN SAYS FOLLOWED BY KEYWORD.

REGL1:	TLNE	A,17		;IS THIS A SCALAR?
	JRST	REGL1A		;NO. DON'T LOOK FOR FCN ARGUMENT
	MOVE	B,FLARG		;IS THIS A FN ARG?
	CAML	B,CEARG		;SEARCH UNORDERED ARGROL
	JRST	REGL1A		;NOT A FN ARG
	CAME	A,(B)
	AOJA	B,.-3		;TRY NEXT ROLL ENTRY.

	JRST	FARGRF		;YES
REGL1A:	MOVEI	R,VARROL	;NO. SCALAR
	PUSHJ	P,SEARCH	;IN VARIABLE ROLL?
	JRST	N,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:	MOVEI	F,SCAROL	;REGISTER THE CONTENTS OF A AS SCALAR
	JRST	REGL1A
REGARY:	CAIE	C,"("
	TLNE	C,F.DOLL	;ARRAY OR POSSIBLE SRVECTOR REF?
	CAIA
	JRST	REGL1
	TLNE	C,F.DOLL
	JRST	REGSTR
REGA0:	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	N,REGA2		;NOT ALREADY USED
	HRRZ	D,(B)		;GET POINTER TO ARAROL
	JRST	N,REGA3

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)
	IORI	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

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
	PUSHJ	P,SCNLT1	;NAME TO A
	TLNE	C,F.DOLL	;STRING VECTOR?
	JRST	N,ARRAY2	;YES, HANDLE DIFFERENTLY
	PUSHJ	P,REGA0
ARRAY1:	MOVE	X1,B		;FINISH REGISTERING
	ADD	X1,FLOOR(F)
	SKIPN	1(X1)
	SETOM	1(X1)
	POPJ	P,

ARRAY2:	PUSHJ	P,NXCHK
	CAIN	C,50
	JRST	N,ARRAY3
	TLNE	F,1
	JRST	REGSTR
ARRAY3:	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,.+4		;EXPLICIT DIMENSION?
	MOVNI	X2,777776	;NO.  CALL IT A VECTOR OF UNKNONW DIM.
	MOVEM	X2,1(X1)
	POPJ	P,
	JUMPLE	X2,CPOPJ
	TLNE	X2,777776	;IS THIS A ROW VECTOR?
	TRNN	X2,777776	;OR A COLUMN VECTOR?
	POPJ	P,		;YES.
	FAIL <USE VECTOR, NOT ARRAY,>

IFN FTSTR,<
REGSTR:	JUMPL	F,GRONK
	TLO	A,10		;MAKE STRING NAME DIFFERENT FROM OTHER NAMES.
	HRRI	F,VSPROL	;POINT WILL GO ON VARIABLE SPACE ROLL
	TLNE	C,F.DOLL	;SKIP DOLLAR SIGN?
	PUSHJ	P,NXCHK		;SKIP DOLLAR SIGN
	CAIN	C,"("	;IS IT A STRING VECTOR?
	JRST	REGSVR		;YES.
	PUSHJ	P,REGL1		;FIX VARIABLE TYPE CODE.
	JRST	REGS1

REGSL1:	MOVEI	R,11
	AOS	IFFLAG
	MOVE	A,1
	PUSHJ	P,RPUSH
	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.
	PUSHJ	P,QSKIP
	JRST	GRONK
	JRST	XINF3
>

QSKIP:	PUSHJ	P,NXCH		;SKIP TO NEXT QUOTE CHAR.
	TLNE	C,F.CR		;TERMINAL QUOTE MISSING?
	POPJ	P,		;YES
	TLNN	C,F.QUOT	;END OF STRING?
	JRST	QSKIP		;NO, GO ON.
	PUSHJ	P,NXCH		;YES. GET NEXT CHAR AND RETURN.
	JRST	CPOPJ1

IFN FTSTR,<
REGSVR:	HRRI	F,SVRROL	;REGISTER STRING VECTOR
	TLO	A,11		;MAKE NAME DIFFERENT FROM THE OTHERS
	TLNE	C,F.DOLL	;DOLLAR SIGN?
	PUSHJ	P,NXCHK		;YES, SKIP IT

	PUSHJ	P,REGA1		;REGISTER AS AN ARRAY

REGS1:	CAIE	A,4		;DID REGISTRATION FAIL?
	ADDI	A,5		;NO. FIX TYPE CODE.
	POPJ	P,
>

;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:	ASCII /GOTO/
	ASCII /STEP/
	ASCII /THEN/
	ASCII /TO/
	Z

;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:	PUSH	P,C		;SAVE T,C AROUND LOOK-AHEAD.
	PUSH	P,T
	MOVEI	X1,KWTBL	;TBL OF KEYWORDS

REGF1:	PUSHJ	P,QST	;TEST THIS KEYWORD.
	JRST	N,REGF2
	POP	P,T
	POP	P,C
	JRST	REGL1

REGF2:	MOVEI	X1,1(X1)	;NOT CURRENT KEYWORD
	MOVE	T,(P)		;RESTORE POINTERS DESTROYED BY QST
	MOVE	C,-1(P)
	SKIPE	(X1)		;MORE TO TEST?
	JRST	REGF1	;YES
	POP	P,T	;NO, NOT KEYWORD.
	POP	P,C
;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.

	PUSHJ	P,SCNLT3
	JRST	REGFAL
	MOVEI	R,4
	PUSHJ	P,SEARCH
	JRST	REGFAL
	MOVMS	LETSW		;CAN'T BE LH(LET)
	HRRZ	B,(B)
	MOVEI	A,2		;INTRINSIC FCN CODE.
	POPJ	P,		;RETURN "XINFNC" 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,SCNLT1	;PUT FUNCTION NAME IN A
	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
	MOVEI	R,FCLROL	;FUNCTION CALL ROLL
	PUSHJ	P,SEARCH	;USED THIS ONE YET?
	JRST	.+2
	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	N,REGFC1+1
	HLRZ	X2,(X1)		;GET THE ROLL NUMBER
	CAIN	X2,FCLROL	;FCLROL?
	CAMLE	B,(X1)		;YES. IS SEXREF NOW WRONG?
	AOJA	X1,REGFC0
	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,(177B13)	;CREATE SPECIAL NAME FOR CURRENT FUNCTION
	JRST	N,SCAREG	;REGISTER IT AS A SCALAR
      SUBTTL  SUBROUTINES USED BY GEN ROUTINES

;PUSHPR - PUSH PARTIAL RESULT ON SEXROL

PUSHPR:	MOVEI	R,SEXROL
	MOVE	A,B		;SAVE POINTER IN A
	PUSHJ	P,RPUSH
	SUB	B,FLSEX	;MAKE POINTER
	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
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
	EXCH	B,-1(X1)
	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
	PUSHJ	P,SITGEN	;STORE IN TEMP
	MOVE	X1,FLSEX	;RECOMPUTE LOC IN SEXROL
	ADD	X1,REGPNT
	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
	PUSHJ	P,BUILDS	;BUILD MOVE INSTR
	MOVEI	B,0		;POSITIVE REG POINTER
	POPJ	P,

;EIRGNP - EXP IN REG GEN POSITIVE

EIRGNP:	JUMPGE	B,EIRGEN	;POSITIVE?
	TLNE	B,ROLMSK	;NO. IN REG?
	JRST	ERGNFN		;NO.  GO MOVE
	MOVSI	D,(MOVN N,)	;YES,NEGATIVE N
	PUSHJ	P,BUILDI
	MOVEI	B,0		;POSITIVE REG PNTR
	POPJ	P,

;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,.+2
	MOVSI	D,(MOVNM N,)
	CAIE	R,TMPROL	;STORE ON TMPROL?
	JRST	N,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 Z 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,P		;INSTRUCTION IS INDEXED BY PLIST POINTER
	SUB	B,PSHPNT	;ADJUST THE ADDRESS FOR ANY PUSH INSTS GENNED BY
	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.  DONT GEN CODE
	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,10000		;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 ADDRESS
	JRST	BUILDP		;YES. PSHROL. DO BUILDI INDEXED BY (Q)
	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	Q,(X2)		;GET NEXT ADDRS IN CHAIN
	HRRM	Q,-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
;SUBROUTINES FOR GENERAL ROLL MANIPULATION

CLOSUP:	MOVN	X1,E		;COMPUTE NEW END OF ROLL
	ADDB	X1,CEIL(R)	;AND STORE IT
	MOVE	X2,B		;CONSTRUCT BLT WORD
	ADD	X2,E
	MOVS	X2,X2
	HRR	X2,B
	BLT	X2,-1(X1)		;MOVE DOWN TOP OF ROLL
	POPJ	P,

CLOB:	MOVEI	T1,COMTOP	;ROUTINE TO CLOBBER ALL MOVEABLE ROLLS.
	MOVEM	T,FLOOR(T1)
	MOVEM	T,CEIL(T1)
	CAILE	T1,1(X1)	;DO NOT CLOBBER ROLLS <=(X1)
	SOJA	T1,CLOB+1
	POPJ	P,



OPEN2:	MOVE	X2,E		;IS THERE ROOM ABOVE THIS STODGY ROLL?
	ADD	X2,CEIL(R)	;THE NEW CEILING
	CAMLE	X2,FLOOR+1(R)
	JRST	N,OPENU0	;NO ROOM, PACK OTHER ROLLS UP
	ADDM	E,CEIL(R)	;THERE IS ROOM, INCREMENT CEILING
	POPJ	P,

OPENU0:	SUB	B,FLOOR(R)
	PUSHJ	P,PANIC
	ADD	B,FLOOR(R)

OPENUP:	CAMG	R,TOPSTG	;OPEN UP THE TOP STODGY ROLL?
	JRST	N,OPEN2		;YES.  OPEN UPWARDS, NOT DOWN
	MOVN	X2,E
	MOVE	Q,TOPSTG	;DO NOT MOVE STODGY ROLLS
	ADD	X2,FLOOR+1(Q)
	CAMGE	X2,CEIL+0(Q)
	JRST	N,OPENU0	;NEED MORE ROOM
	HRL	X2,FLOOR+1(Q)	;CONTRUCT BLT WORD
	SUB	B,E		;FIRST WORD OF GAP
	BLT	X2,-1(B)	;MOVE ROLLS DOWN

	MOVEI	X1,1(Q)		;ADJUST POINTERS FOR ROLLS JUST BLT'D
	MOVN	X2,E
OPEN1:	ADDM	X2,FLOOR(X1)
	CAML	X1,R
	POPJ	P,
	ADDM	X2,CEIL(X1)
	AOJA	X1,OPEN1


;RPUSH - PUSH A ON TOP OF DESIGNATED ROLL

RPUSH:	MOVEI	E,1
	PUSHJ	P,BUMPRL	;MAKE ROOM
	MOVEM	A,(B)		;STORE WORD
	POPJ	P,

;ROUTINE TO ADD TO END OF ROLL
;E CONTAINS SIZE, R CONTAINS ROLL NUMBER

BUMPRL:	MOVE	B,CEIL(R)
	ADD	B,E
	CAIE	R,ROLTOP
	SKIPA	X1,FLOOR+1(R)
	HRRZ	X1,JOBREL
	CAMLE	B,X1
	JRST	N,BUMP1
	EXCH	B,CEIL(R)
	POPJ	P,
BUMP1:	MOVE	B,CEIL(R)
	CAIE	R,CODROL
	CAIN	R,SEXROL
	JRST	N,.+2
	JRST	N,OPENUP
	ADDI	E,^D10		;***EXTRA 10 LOCS
	PUSHJ	P,OPENUP
	MOVNI	X1,^D10	;TAKE BACK THE 10 LOCS
	ADDM	X1,CEIL(R)
	POPJ	P,


;BINARY SEARCH OF SORTED ROLL
;CALL WITH KEY IN A
;RETURN IN B ADDRS OF FIRST
;ENTRY NOT LESS THAN KEY
;SKIP RETURN IF LEFT SIDES EQUAL

SEARCH:	MOVE	B,FLOOR(R)
	SKIPA	X1,CEIL(R)
SEAR1:	MOVEI	B,1(X2)
	CAIGE	B,(X1)
	JRST	SEAR2
	CAML	B,CEIL(R)
	POPJ	P,
	JRST	SEAR3

SEAR2:	MOVEI	X2,@X1
	ADD	X2,B
	ASH	X2,-1
	CAMLE	A,(X2)
	JRST	SEAR1
	HRRI	X1,0(X2)
	CAIGE	B,0(X1)
	JRST	SEAR2

SEAR3:	HLLZ	Q,(B)
	CAMN	Q,A
	AOS	(P)
	POPJ	P,

;ROUTINE TO QSA FOR "THEN" OR "GOTO" (USED IN "IF", "ON" STATEMENTS)
THENGO:	PUSHJ	P,QSA
	ASCIZ /THEN/
	CAIA
	POPJ	P,
	PUSHJ	P,QSA
	ASCIZ /GOTO/
	FAIL	<ILLEGAL FORMAT>
	POPJ	P,

;COMMON SUBROUTINE RETURNS

CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,

;ERROR RETURNS

ILFORM:	FAIL	<ILLEGAL FORMULA>
ILVAR:	FAIL	<ILLEGAL VARIABLE>
GRONK:	FAIL	<ILLEGAL FORMAT>
ILLINS:	FAIL	<ILLEGAL INSTRUCTION>


;COMPILATION ERROR


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 /
	MOVE	T,L
	ADD	T,FLLIN
	HLRZ	T,(T)
	PUSHJ	P,PRTNUM
	PUSHJ	P,INLMES
	ASCIZ	/
/
	SETZM	RUNFLA
	POPJ	P,

;ROUTINES TO ALLOW AND DELAY REENTRY.
;LOCKON TEMPORARILY PREVENTS REENTRY
;LOCKOF ALLOWS REENTRY AND REENTERS IF THERE IS A STANDING REQUEST
;REENTR MAKES A REENTRY OR MAKES A REQUEST AND CONTINUES

LOCKON:	SKIPGE	RENFLA
	SETZM	RENFLA		;TURN ON REENETER PROTECT
	POPJ	P,
LOCKOF:	SKIPLE	RENFLA
	JRST	BASIC		;ACT ON OLD REENTER REQUEST
	SETOM	RENFLA		;ALLOW REENTER
	POPJ	P,
REENTR:	SKIPGE	RENFLA
	JRST	BASIC
	AOS	RENFLA
	JRST	2,@JOBOPC
;ROUTINE TO READ CHARACTER, SKIPPING BLANKS
;CALL:	MOVE	T,<POINTER TO CHAR BEFORE FIRST>
;	PUSHJ	P,NXCH
;	...	RETURN, C:= (<FLAGS>)CHARACTER

NXCHS:	ILDB	C,T	;DOESNT SKIP TAB OR BLANK
NXCHD:	CAIE	C," "
	CAIN	C,11
	POPJ	P,
	CAIA		;SKIP INTO NXCH
NXCH:	ILDB	C,T	;FETCH NEXT CHARACTER
	HLL	C,CTTAB(5)
	TRNE	C,100
	HRL	C,CTTAB-100(5)
	TLNE	C,F.SPTB	;SPACE OR TAB?
	JRST	N,NXCH	;YES. IGNORE
	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,

;SCAN INITIAL LETTER, LETTER IS PLACED LEFT
;JUSTIFIED IN A, 7-BIT ASCII.

SCNLT1:	HRRZ	A,C
	ROT	A,-7
	JRST	NXCH

;SCAN SECOND LETTER, NON-SKIP RETURN IF NOT LETTER.
;MAKE 7-BIT LETTER LEFT JUST IN A
;INTO 6-BIT. THAN PUT 6-BIT CURRENT LETTER IN A.

SCNLT2:	TLNN	C,F.LETT
	POPJ	P,
SCN2:	TLNN	A,400000		;ENTER HERE TO PROCESS NON-LETTER CHARS
	TLZA	A,200000
	TLO	A,200000
	LSH	A,1
	MOVE	X1,[POINT 6,A,5]
	JRST	SCNLTN

;ENTER HERE TO SCAN SECOND CHAR EVEN IF BOTH ARE NOT LETTERS.


;SCAN THIRD LETTER, NON-SKIP IF NOT LETTER.
;PUT 6-BIT LETTER TO 3RD 6-BIT FIELD IN A.

SCNLT3:	TLNN	C,F.LETT
	POPJ	P,0
	MOVE	X1,[POINT 6,A,11]

;NOW PUT 6-BIT LETTER INTO A, ADJUSTING LOWER CASE, INCREMENTING POINTER.

SCNLTN:	TLNN	C,F.LCAS
	TRC	C,40
	IDPB	C,X1
	AOS	(P)
	JRST	NXCH
;QUOTE SCAN AND TEST
;CALL WITH PATTERN ADDRS IN X1
;SKIP IF EQUAL. C,T UPDATED TO LAST CHAR SCANNED.
QST:	HRLI	X1,440700	;MAKE BYTE PNTR TO PATTERN
QST1:	ILDB	X2,X1		;GET PATTERN CHAR
	JUMPE	X2,CPOPJ1	;DONE ON NULL
	SUBI	X2,(C)
	JUMPE	X2,.+4		;DO CHARACTERS MATCH?
	TLNE	C,F.LCAS	;NO. LOWER CASE LETTER?
	CAME	X2,[ EXP -40]	;YES. SAME LETTER OF ALPHABET?
	JRST	QST2		;NO. MATCH FAILS
	PUSHJ	P,NXCH
	JRST	QST1
QST2:	ILDB	X2,X1		;ON FAIL
	JUMPN	X2,.-1		;SKIP TO NULL
	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)

;QUOTE SCAN WITH ANSWER
;CALL WITH INLINE PATTERN
;SKIP ON SUCCESS		;ON FAIL, RETURN WITH C,T RESTORED

QSA:	POP	P,X1		;GET PATTERN ADDRESS
	PUSH	P,C		;SAVE C,T
	PUSH	P,T
	PUSHJ	P,QST		;SAVE STRING
	JRST	.+2
	JRST	QSA1		;MATCH
	POP	P,T		;NO MATCH.  BACK UP
	POP	P,C
	JRST	1(X1)

QSA1:	POP	P,14
	POP	P,14
	JRST	2(X1)

;ROUTINE TO READ NEXT INTEGER FROM SCANNED LINE
;CALL:	MOVE	T,POINTER TO FIRST CHAR
;	PUSHJ	P,GETNUM
;	...	FAIL RETURN
;	...	SUCCESS RETURN, INTEGER IN N

GETNU:	TDZA	X1,X1		;GET A NUMBER OF ANY LENGTH
GETNUM:	MOVEI	X1,5		;GET A NUMBER OF AT MOST 5 DIGS
	TLNN	C,F.DIG		;NUMERAL?
	POPJ	P,		;NO.  FAIL RETURN
	MOVEI	N,-60(C)	;YES.  ACCUMULATE FIRST DIGIT
GETN1:	MOVE	G,T		;SAVE PNTR FOR USE BY INSERT
	PUSHJ	P,NXCH		;GET NEXT CHAR
	SOJE	X1,CPOPJ1	;EXIT IF FIVE DIGITS ALREADY
	TLNN	C,F.DIG		;NUMERAL?
	JRST	CPOPJ1		;NO.  RETURN.
	IMULI	N,^D10		;YES.  ACCUMULATE NUMBER
	ADDI	N,-60(C)
	JRST	GETN1		;GO FOR MORE
;ROUTINE TO READ A LINE INTO LINB0
;CALL:	PUSHJ	P,INLINE

INLINE:	SETOM	TYI+2
	MOVE	T,[POINT 7,LINB0]
	MOVEI	T1,0
	JRST	N,INLI1A

INLI1:	ILDB	C,TYI+1		;GET CHAR
	CAIN	C,15		;CR??
	JRST	INLI1A
	JUMPE	C,INLI1A
	CAIN	C,"_"		;DELETE?
	JRST	INLI3		;YES
	CAIE	C,30
	CAIN	C,FUNSTA
	JRST	N,INLI4
	CAIE	C,21		;IGNORE XON,XOFF
	CAIN	C,23
	SOJA	T1,INLI1A
	CAIG	C,14		;LINE TERMINATOR?
	CAIGE	C,12
	CAIA
	JRST	INLI2		;YES.  GO FINISH UP
	CAIGE	T1,^D94		;ROOM FOR CHAR+1 MORE?
	IDPB	C,T		;STORE CHAR
INLI1A:	SOSLE	TYI+2		;MORE INPUT?
	AOJA	T1,INLI1	;YES.  BUMP COUNT AND GO GET MORE
	INPUT
	STATZ	20000
	JRST	BASIC
	STATO	740000
	AOJA	T1,INLI1
	PUSHJ	P,TTYIN
	PUSHJ	P,INLMES
	ASCIZ	/SYSTEM ERROR/
	JRST	N,BASIC
INLI2:	MOVEI	C,15		;DONE.	PUT CR IN BFR
	IDPB	C,T
	MOVE	T,[POINT 7,LINB0]
	SETZM	HPOS
	JRST	NXCH
INLI3:	JUMPE	T1,INLI1A	;BACKARROW HANDLER, IGNORE IF AT LEFT
	MOVEI	C,4
	IBP	T
	SOJG	C,.-1
	SUBI	T1,2
	SOJA	T,INLI1A
INLI4:	MOVEI	T,INLI5
	CALL	T,[SIXBIT /DDTOUT/]
	JRST	INLINE
INLI5:	ASCIZ	/ DELETED
/

;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
;PRINTING SUBROUTINES

;PRINT TO QUOTE CHAR
;CALL:	MOVE	T,<ADDRS OF MSG>
;	MOVE	D,<QUOTE CHAR>
;	PUSHJ	P,PRINT
;CALL:	MOVE	T,<ADDRS OF MSG>
;	MOVE	D,<QUOTE CHAR>
;	PUSHJ	P,PRINT
;ALTERNATE CALL: PRINT1, IF BYTE PNTR IN T.


PRINT:	HRLI	T,440700
PRINT1:	ILDB	C,T
	CAMN	C,D
	POPJ	P,
	PUSHJ	P,OUCH		;OUTPUT THE CHAR
	JRST	PRINT1
OUCH:	SOSG	TYO+2
	OUTPUT
	IDPB	C,TYO+1
	CAIE	C,12
	AOSA	HPOS
	SETZM	HPOS
	POPJ	P,
;ROUTINE TO PRINT SIXBIT CHARACTERS IN ACCUM "T".
;IGNORES BLANKS.


PRNSIX:	MOVE T1,[POINT 6,T]
	ILDB	C,T1
	JUMPE	C,PRNS1		;SKIP A BLANK
	ADDI	C,40
	PUSHJ	P,OUCH
PRNS1:	TLNE	T1,770000		;ALL SIX PRINTED?
	JRST	PRNSIX+1
	POPJ	P,
PRNS2:	JUMPE	X1,PRDE2
	MOVE	T,X1
	PUSHJ	P,PRDE1
	MOVE	C,A
	PUSHJ	P,OUCH
;SPECIAL DECIMAL PRINT ROUTINE.  PRINTS X1,X2 AS DECIMAL NUMBERS
;SEPARATED BY THE CHARACTER IN ACCUM "A".
;IF X1 OR X2 ARE ZERO, THEY PRINT AS "00".

PRDE2:	MOVE	T,X2
	PUSHJ	P,PRDE1
	MOVE	C,A
PRDE2A:	PUSHJ	P,OUCH
	MOVE	T,Q
	MOVEI	A,177
PRDE1:	MOVEI	C,"0"		;A ONE DIGIT NUMBER?
	CAIG	T,^D9
	PUSHJ	P,OUCH		;YES. PUT OUT LEADING ZERO.
	JRST	PRTNUM
PTIME:	SKIPE	N,174
	SKIPN	MTIME
	POPJ	P,
RTIME:	PUSHJ	P,INLMES
	ASCIZ	/

TIME:  /
	CALL	X2,[SIXBIT /RUNTIM/]	;GET TIME NOW.
	SUB	X2,MTIME		;GET ELAPSED TIME.
	IDIVI	X2,^D10			;REMOVE THOUSANDS.
	IDIVI	X2,^D100		;SECS TO X1, THENTS AND HUNDREDS TO X2.
	MOVE	T,X2			;OUTPUT THE
	JUMPE	X2,.+2
	PUSHJ	P,PRTNUM		;SECONDS.
	MOVEI	C,"."			;OUTPUT ., THE TENTHS,
	PUSHJ	P,PRDE2A		;AND THE HUNDREDTHS.
	PUSHJ	P,INLMES
	ASCIZ / SECS.
/
	SETZM	MTIME
	OUTPUT
	POPJ	P,

;NUMBER PRINTER (PRINTS INTERGER IN T)


PRTNUX:	TDZA	X1,X1
PRTNX1:	MOVE	X1,B
	MOVEI	X1,5(X1)
	PUSHJ	P,CHROOM
	PUSHJ	P,PSIGN
PRTNUM:	IDIVI	T,^D10
	JUMPE	T,PRTN1
	PUSH	P,T1
	PUSHJ	P,PRTNUM
	POP	P,T1
PRTN1:	MOVEI	C,60(T1)
	JRST	OUCH
PSIGN:	MOVEI	C," "		;PRINT "SIGN" (BLANK OR MINUS)
	JUMPGE	N,.+2
	MOVEI	C,55
	JRST	OUCH


;MESSAGE PRINTER

INLMES:	EXCH	T,(P)		;GET MSG ADR AND SAVE T.
	MOVEI	D,0		;END ON NULL
	PUSHJ	P,PRINT
	EXCH	T,(P)
	JRST	CPOPJ1		;RTN AFTER MSG.
	SUBTTL CORE COMPRESSION AND EXPANSION
;PANIC - ROUTINE TO COMPRESS CORE

PANIC:	PUSHJ	P,PRESS		;COMPRESS MEMORY
	MOVE	Q,TOPSTG	;IS THERE ROOM BETWEEN STODGY AND
	MOVE	X1,FLOOR+1(Q)	;MOVEABLE ONES?
	SUB	X1,CEIL(Q)
	CAML	X1,E		;ENOUGH ROOM?
	POPJ	P,

	MOVE	X1,JOBREL	;EXPAND BY 1K
	ADDI	X1,2000
	CALL	X1,[SIXBIT /CORE/]
	JRST	N,PANIC1
	JRST	N,PANIC
PANIC1:	PUSHJ	P,INLMES
	ASCIZ	/OUT OF ROOM/
	JRST	N,UXIT

PRESS:	PUSH	P,G		;SAVE AC
	SKIPN	PAKFLA		;ARE LINES PACKED?
	JRST	PRESS5		;YES
	SETZM	PAKFLA

	MOVE	X1,FLTXT	;LOOK FOR EMPTY SPACE
PRESS2:	CAML	X1,CETXT	;THROUGH LOOKING?
	JRST	PRESS5
	SKIPE	(X1)		;A FREE WORD?
	AOJA	X1,PRESS2	;NO

	MOVEI	X2,1(X1)	;YES
PRESS3:	CAML	X2,CETXT
	JRST	PRESS4		;FREE TO END
	SKIPN	(X2)
	AOJA	X2,PRESS3

	SUB	X1,X2		;X1 :=-LNG OF MOVE
	MOVE	Q,FLLIN
PRES3A:	CAML	Q,CELIN		;MOVE DOWN THE REFERENCES
	JRST	PRES3B		;IN THE LINE ROLL
	HRRZ	G,(Q)
	CAML	G,X2
	ADDM	X1,(Q)
	AOJA	Q,PRES3A

PRES3B:	MOVE	G,CETXT		;MOVE DOWN THE TEXT ROLL
	ADD	G,X1
	MOVEM	G,CETXT
	ADD	X1,X2
	HRL	X2,X1
	MOVSS	X2
	BLT	X2,-1(G)
	JRST	PRESS2

PRESS4:	MOVE	Q,X1

;ROUTINE TO MOVE ROLLS UP

	SUB	Q,X1
	ADDM	Q,CETXT
PRESS5:	MOVEI	G,ROLTOP	;HIGHEST MOVABLE ROLL
	MOVE	X1,JOBREL	;X1 IS PREVIOUS FLOOR
				;NOTE: TOP WORD OF USR CORE IS LOST

PRESS6:	MOVE	X2,CEIL(G)	;GET OLD CEIL AND FLOOR
	MOVE	Q,FLOOR(G)
	SUBI	X2,1		;SET UP X2 FOR POP LOOP
	ORCMI	X2,777777
	MOVEM	X1,CEIL(G)	;NEW CEILING

PRESS7:	CAILE	Q,(X2)		;DONE?
	JRST	N,PRESS8
	POP	X2,-1(X1)	;MOVE ONE WORD
	SOJA	X1,PRESS7

PRESS8:	MOVEM	X1,FLOOR(G)	;NEW FLOOR
	SOS	G		;GO TO NEXT LOWER ROLL
	CAMLE	G,TOPSTG	;IS THIS ROLL MOVEABLE?
	JRST	PRESS6		;YES. GO PRESS IT.
PRESS9:	POP	P,G	;RESTORE G
	POPJ	P,	;RETURN

;THIS ROUTINE OBTAINS SPACE IN THE "FREE CORE AREA" FOR REAL STRINGS,
;APPEND BLOCKS, THE TEMPORARY STRINGS WHICH ARE THE RESULTS OF
;STRING FUNCTIONS, AND BUFFERS FOR DATA FILES. IT HAS SIX ENTRY POINTS:
;VCHCKC AND VCHCKW FOR REAL STRINGS, VCHTSC AND VCHTSW FOR TEMPORARY
;STRINGS, VCHAPP FOR APPEND BLOCKS, AND VCHBUF FOR DATA FILES.
;STRINGS HAVE TWO ENTRY POINTS SO THAT THEY MAY REQUEST SPACE IN UNITS
;OF EITHER CHARACTERS OR WORDS.	 THE REQUEST IS IN AC T.  NO OTHER
;AC'S ARE DESTROYED. THE LOCATION OF THE LOWER BOUND OF THE OBTAINED
;SPACE IS RETURNED IN AC T.


VCHCKC:	MOVEI	E,25
	SKIPG	G
	PUSHJ	P,VCHCK9
VCHCK1:	MOVE	X1,VARFRE
	ADD	X1,E
	CAMGE	X1,JOBREL
	POPJ	P,
	SKIPE	VPAKFL
	JRST	N,VCHCK2
	PUSHJ	P,VCHCK3
	JRST	N,VCHCK1
VCHCK2:	MOVE	X1,JOBREL
	ADDI	X1,2000
	CALL	X1,[SIXBIT /CORE/]
	JRST	N,PANIC1
	JRST	N,VCHCK1
VCHCK3:	PUSH	P,G
	PUSH	P,E
	MOVE	G,SVRTOP
VCHCK4:	HRRZI	X2,-1
	MOVE	Q,FLVSP
	SETZI	X1,0
VCHCK5:	CAML	Q,SVRTOP
	JRST	N,VCHCK7
	CAMN	Q,CEVSP
	MOVE	Q,SVRBOT
	HRRZ	E,(Q)
	JUMPE	E,VCHCK6
	CAML	E,G
	CAMG	X2,E
VCHCK6:	AOJA	Q,VCHCK5
	MOVE	X1,Q
	MOVE	X2,E
	AOJA	Q,VCHCK5
VCHCK7:	JUMPE	X1,VCHCKE
	HLRE	E,(X1)
	JUMPN	E,VCHCK8
	SETZM	N,(X1)
	JRST	N,VCHCK4
VCHCK8:	HRL	G,(X1)
	MOVN	C,E
	CAIL	C,1000
	MOVEI	C,0
	ADDI	C,4
	IDIVI	C,5
	MOVE	E,C
	ADDI	E,(G)
	HRRZ	X2,(X1)
	CAIN	X2,(F)
	HRRM	G,F
	HRRM	G,(X1)
	BLT	G,(E)
	AOS	G,E
	MOVEM	E,VARFRE
	JRST	N,VCHCK4
VCHCKE:	POP	P,E
	SETOM	N,VPAKFL
	JRST	N,PRESS9
SUBTTL DECIMAL NUMBER EVALUATE/PRINT
;ROUTINE TO EVALUATE NUMBER
;T: PNTR TO FIRST CHAR, C: FIRST CHAR
;NON-SKIP IS FAIL RETURN
;RETURN NUMBER IN N

;N: ACCUM NBMR, B: SCA FAC, D: DIG CNT, USE FLGS IN LEFT OF F

EVANUM:	SETZB	N,B		;CLEAR ACS
	MOVEI	D,8
	MOVEI	F,0(F)		;CLEAR LH OF F

	TLNE	C,F.PLUS	;SKIP +
	JRST	EVAN1
	TLNN	C,F.MINS	;CHECK FOR -
	JRST	EVAN2		;NO
	TLO	F,F.MIN		;SET MINUS FLG
EVAN1:	PUSHJ	P,NXCH
EVAN2:	TLNN	C,F.DIG		;DIGIT?
	JRST	N,EVAN3
	TLO	F,F.NUM		;DIGIT SEEN FLAG
	JUMPE	N,EVAN2A	;DONT COUNT LEADING ZEROS
	SOJG	D,EVAN2A	;COUNT DIGIT,  GO ACCUM IF OK
;			REST OF DIGITS ARE INSIGNIFIGANT.
	AOJA	B,EVAN2B	;LEAD OR TRAIL 0, FUDGE SCA FAC

EVAN2A:	IMULI	N,^D10		;ACCUMULATE DIGIT
	ADDI	N,-60(C)
EVAN2B:	TLNE	F,F.DOT		;DECIMAL SEEN?
	SUBI	B,1		;YES.  COUNT DOWN SCALE FACT
	JRST	EVAN1		;GO TO NEXT CHAR

EVAN3:	TLNN	C,F.PER		;NOT DIGIT.  DEC PNT?
	JRST	EVAN4		;NO.
	TLOE	F,F.DOT		;YES, SET FLG & CHK ONLY ONE
	POPJ	P,		;2 DEC PNTS
	JRST	EVAN1
EVAN4:	TLNN	F,F.NUM		;DID WE SEE A DIGIT?
	POPJ	P,		;NO.  WHAT A LOUSY NUMBER

	MOVEI	X1,"E"
	CAIE	X1,(C)		;EXPLICIT SCALE FACTOR?
	JRST	EVAN8		;NO
	PUSHJ	P,NXCH		;DO LOOK AHEAD
	TLNE	C,F.PLUS	;SCALE FACTOR SIGN
	JRST	EVAN5
	TLNN	C,F.MINS
	JRST	EVAN6
	TLO	F,F.MXP
EVAN5:	PUSHJ	P,NXCH
EVAN6:	TLNN	C,F.DIG		;CHK FOR DIGIT
	POPJ	P,
	MOVEI	A,-60(C)	;SAVE FIRST EXPON DIGIT
	PUSHJ	P,NXCH
	TLNN	C,F.DIG		;IS THERE A SECOND DIGIT
	JRST	EVAN7		;NO
	IMULI	A,^D10		;YES.  ACCUMULATE IT
	ADDI	A,-60(C)
	PUSHJ	P,NXCH		;DO LOOK AHEAD

EVAN7:	TLNE	F,F.MXP		;NEG EXPON?
	MOVN	A,A		;YES. NEGATE IT
	ADD	B,A		;ADD TO SCALE FACTOR
EVAN8:	JUMPE	N,CPOPJ1	;IGNORE SCALE IF NUMBER IS ZERO
EVAN8A:	MOVE	X1,N		;)
	IDIVI	X1,^D10		;)REMOVE ANY TRAILING ZEROS
	JUMPN	X2,EVAN8B	;)  IN MANTISSA.. (REASON:
	MOVE	N,X1		;)  SO THAT, E.G.,   .1,
	AOJA	B,EVAN8A	;)  .10, .100,... ARE THE SAME)
EVAN8B:	MOVM	A,B
	CAILE	A,46
	POPJ	P,
	TLO	N,233000	;FLOAT N
	FAD	N,[0]
	JOV	.+1		;CLEAR OVER/UNDERLFOW FLAG
EVAN8C:	CAIGE	B,^D15		;SCALE UP IF .GE. 10^15
	JRST	EVAN8D
	SUBI	B,^D14		;SUBTRACT 14 FROM SCALE FACTOR
	FMPR	N,D1E14		;MULTIPLY BY 10^14
	JRST	EVAN8C		;GO LOOK AT SCALE AGAIN
EVAN8D:	CAML	B,[EXP -^D4]	;SCALE DONW IF .LT. 10^-4
	JRST	N,EVAN8E
	ADDI	B,^D18		;ADD 18 TO SCALE
	FMPR	N,D1EM18	;MULTIPLY BY 10^-18
	JRST	N,EVAN8D	;GO LOOK AT SCALE AGAIN
EVAN8E:	FMPR	N,DECTAB(B)	;SCALE N
	TLNE	F,F.MIN		;MINUS
	MOVN	N,N		;YES.  NEGATE IT.
	JOV	CPOPJ
	JRST	CPOPJ1		;SUCCESS RETURN, NUMBER IN N
;ROUTINE TO PRINT NUMBER

OUTNUM:	SETOM	STRFCN
	MOVM	T,N
	JUMPE	T,PRTNUX
	PUSH	P,E		;DO NOT CLOBBER E (FOR MATRIX)
	MOVEI	E,0		;CHANGE IN EXPONENT
OUTN1A:	CAMG	T,D1E14		;SCALE IF .GT. 10^14
	JRST	OUTN1B
	ADDI	E,^D18		;ADD 18 TO SCALE
	FMPR	T,D1EM18	;AND MULTIPLY BY 10^-18
	JRST	OUTN1A
OUTN1B:	CAML	T,D1EM4		;SCALE IF .LT. 10^-4
	JRST	OUTN1C
	SUBI	E,^D14		;SUBTRACT 14 FROM SCALE
	FMPR	T,D1E14		;AND MULT BY 10^14
	JRST	OUTN1B		;GOT SEE IF MORE SCALING
OUTN1C:	MOVE	A,T		;LOOK UP IN DEC ROLL
	MOVEI	R,DECROL
	PUSHJ	P,SEARCH
	JFCL			;DONT CARE IF FOUND
	CAME	A,(B)		;FUDGE BY 1 IF EXACT MATCH
	SUBI	B,1
	SUBI	B,DECTAB	;FIND DIST FROM MIDDLE
	JUMPN	E,OUTN2		;(NOT INTEGER IF WE SCALED)
	CAIGE	B,^D8		;CHK 8 DIG NUMBER
	CAIGE	B,0
	JRST	OUTN2
	CAML	T,FIXCON	;IS THIS 2^26?
	JRST	OUTN1D		;YES, ITS 27 BIT INT.
	MOVE	X1,T
	FAD	X1,FIXCON	;INTEGER?
	FSB	X1,FIXCON
	CAME	X1,T
	JRST	OUTN2		;NOT SUCH (LOST FRACTIONAL PART)
	FAD	T,FIXCON	;SUCH.	FIX NUMBER
	TLZ	T,377400
OUTN1D:	TLZ	T,377000	;(IN CASE 27-BIT INTEGER)
	POP	P,E		;RESTORE E
	JRST	PRTNX1

OUTN2:	FDVR	T,DECTAB(B)	;GET MANTISSA
	FMPR	T,DECTAB+5
	FADR	T,FIXCON
	TLZ	T,377400	;FIX
	CAMGE	T,[EXP ^D1000000]
	JRST	.+3
	IDIVI	T,^D10		;ROUNDING MADE 7 DIGITS
	ADDI	B,1		;MAKE IT 6 AGAIN
	CAIL	T,^D100000	;ROUNDING MADE 5 DIGITS?
	JRST	.+3
	IMULI	T,^D10		;YES.  MAKE 6 AGAIN
	SUBI	B,1
	ADDB	B,E		;ADD TOGETHER TWO PARTS OF SCALE
	AOJL	E,.+2		;BETWEEN 10^-1 AND 10^6?
	CAILE	E,6
	SKIPA	E,[EXP 1]		;NO. PRINT 1 DIG BEFORE POINT
	PUSHJ	P,CHKNEF	;PRINT WITHOUT EXP (CHK ROOM FOR ^8 SP)
	PUSHJ	P,CHKEF		;PRINT WITH EXP (CHK ROOM FOR ^14 SP)
	PUSHJ	P,PSIGN		;PRINT "SIGN"
	JUMPN	E,OUTN3		;SHOULD DEV. POINT PRECEDE NUMER?
	MOVEI	C,"0"		;YES,SEND OUT LEADING ZERO.
	PUSHJ	P,OUCH
	PUSHJ	P,DNPRN2
OUTN3:	PUSHJ	P,DNPRNT	;GO PRINT NUMBER WITH DECIMAL

;HERE TO PRINT EXPONENT


	POP	P,E		;RESTORE E
	JUMPE	B,CPOPJ
	PUSHJ	P,INLMES
	MOVEM	T1,@N
	MOVEI	C,"+"
	JUMPGE	B,.+2		;SPIT OUT SIGN
	MOVEI	C,"-"
	PUSHJ	P,OUCH
	MOVM	T,B		;USE PRTNUM TO PRINT EXPON
	JRST	N,PRTNUM


;SUBROUTINE USED BY OUTNUM TO PRINT DECIMAL NUMBER.  PRINTS
;SIX DIGITS (INTEGER IN T) WITH CONTENTS(E) DIGITS
;TO THE LEFT OF DECIMAL POINT

DNPRNT:	MOVEI	D,-1		;SIGNAL TRAILING ZERO UNLESS...
	JUMPE	B,.+2		;E-NOTATION
	MOVEI	D,0
DNPRN0:	IDIVI	T,^D10		;GET LAST DIGIT
	JUMPE	T,DNPRN1	;IS IT FIRST?
	JUMPN	T1,.+2		;NON ZERO DIGIT?
	SKIPA	T1,D		;NO, STASH ZERO OR TRAILZERO
	MOVEI	D,0		;YES. TRAILER IS OVER.
	HRLM	T1,(P)		;NO.  STASH DIGIT
	PUSHJ	P,DNPRN0	;CALL DNPRNT RECURSIVELY
	HLRE	T1,(P)		;RESTORE DIGIT
	JUMPGE	T1,.+3		;ORDINARY DIGIT?
	JUMPLE	E,CPOPJ		;NO, TRAILZERO. AFTER DECIMAL POINR?
	MOVEI	T1,0		;NO, STASH A ZERO.

DNPRN1:	MOVEI	C,60(T1)	;PRINT DIGIT
	PUSHJ	P,OUCH
	SOJN	E,CPOPJ		;COUNT DIGITS.	PRINT NEXT?
DNPRN2:	MOVEI	C,"."		;YES. PRINT POINT
	JRST	N,OUCH

;CHECK FOR ROOM ON A LINE FOR E-FORM NUMBER:
CHKEF:	MOVEI	X1,^D14		;NEED 14 SP TO PRINT THIS NUMBER
	PUSH	P,B		;SAVE EXPONENT
	PUSHJ	P,CHROOM
	POP	P,B
	POPJ	P,
CHKNEF:	MOVEI	X1,^D9
	PUSHJ	P,CHROOM
	MOVEI	B,0		;NO EXPONENT.
	JRST	CPOPJ1		;SKIP-RTN

;POWER-OF-TEN TABLE.

D1EM18:	OCT	105447113564	;10^-18

DECFLO:
D1EM4:	OCT	163643334273
	OCT	167406111565
	OCT	172507534122
	OCT	175631463146
DECTAB:	DEC	1.0		;10^0
	DEC	1.0E1
	DEC	1.0E2
	DEC	1.0E3
	DEC	1.0E4
	DEC	1.0E5
	DEC	1.0E6
	DEC	1.0E7
	OCT	1.0E8
	DEC	1.0E9
	DEC	1.0E10
	DEC	1.0E11
	OCT	250721522451	;10^12
	OCT	254443023471
D1E14:	OCT	257553630410	;10^14
DECCEI:

MAXEXP=^D38
DECFIX:	EXP 225400000000
FIXCON:	EXP 233400000000

;FLAGS USED BY DECIMAL READER/PRINTER

F.NUM=200000	;DIGIT SEEN
F.MIN=100000	;MINUS SEEN
F.MXP=40000	;MINUS EXPONENT
F.DOT=20000	;DECIMAL POINT SEEN
      SUBTTL RUN-TIME ROUTINES

;RUN-TIME GOSUB ROUTINES

GOSBER:	MOVE	X1,@40
	MOVE	R,FCNLNK
	HRLM	R,@40		;SAVE PRECEDING CALL
	MOVE	R,40		;FETCH CURRENT CALL
	MOVEM	R,FCNLNK
	TRNN	X1,777777	;IF FCN, BEGINS AT CTRL WRD + 1
	HRRI	X1,1(R)
	TLNN	X1,777777	;CHECK RECURSIVE CALL
	JRST	(X1)

	PUSHJ	P,INLMES	;RECURSIVE CALL
	ASCIZ /SUBROUTINE OR FUNCTION CALLS ITSELF IN /
GOSR2:	PUSH	P,[EXP UXIT]	;PRINT LINE NUMBER AND END EXECUTION
GOSR3:	MOVE	T,LP
	PUSHJ	P,PRTNUM
	PUSHJ	P,INLMES
	ASCIZ /
/
	POPJ	P,

FORCOM:	HRRZI	X1,313000	;RUNTIME COMPARE FIX-DONT USE IF CONN
	SKIPGE	@40
	HRRZI	X1,315000	;SET UP COMPARE FOR ENTIRE LOOP
	HRLM	X1,@(P)
	POPJ	P,

XCTON:	JUMPLE	N,XCTON1	;IS ON ARGUMENT <=0?
	FAD	N,FIXCON
	HRRZ	T,N		;GET INTEGER PART
	JUMPE	T,XCTON1
	ADDI	T,(Q)		;GET THE "GOTO" ADDRESS
	CAMGE	T,(Q)		;IS IT IN RANGE?
	JRST	@(T)		;YES, GOGO

XCTON1:	PUSHJ	P,INLMES
	ASCIZ /ON EVALUATED OUT OF RANGE IN /
	JRST	GOSR2

;HERE ON OVFLOW ERROR
OVTRAP:	PUSH	P,X1		;SAVE THIS REG IN CASE FALSE ALARM.
	MOVEI	X1,10
	CALL	X1,[SIXBIT /APRENB/]
	HRRZ	X1,JOBTPC	;GET TRAP ADDRESS.
	CAML	X1,FLCOD	;TRAP IN USER PROG?
	CAMLE	X1,CECOD
	JRST	OVFLCM		;NO. FALSE TRAP.(NOT BY USER)
	MOVE	X1,JOBTPC	;GET TRAP FLAGS.
	SKIPE	N,174
	JRST	OVTR0
	TLNE	X1,(1B11)	;UNDERFLOW?
	JRST	UNTRAP		;YES
	TLNE	X1,(1B12)	;ZERO DIVIDE?
	JRST	DVTRAP		;YES
	TLNN	X1,(1B3)
	JRST	OVFLCM		;NOT OVFLOW EITHER. IGNORE
OVTR0:	PUSHJ	P,INLMES
	ASCIZ /OVERFLOW IN /
	SKIPL	N		;NEG OVFLOW?
OVTR2:	HRLOI	N,377777	;LRG NUMBER
	SKIPG	N
	MOVE	N,MIFI
OVTR1:	PUSHJ	P,GOSR3
OVFLCM:	POP	P,X1
	JRST	N,@JOBTPC

UNTRAP:	PUSHJ	P,INLMES
	ASCIZ /UNDERFLOW IN /
	SETZI	N,		;RESULT IS ZERO.
	JRST	OVTR1
DVTRAP:	PUSHJ	P,INLMES
	ASCIZ /DIVISION BY ZERO IN /
	JRST	OVTR2

RETURN:	SETZI	T,0		;GOSUB RETURN, NOTHING ON PLIST
FRETRN:	MOVE	R,FCNLNK
	JUMPE	R,BADRET	;CHECK RETURN TOO FAR
	MOVS	X1,(R)		;FETCH LINK BACK
	HRRZS	(R)		;MARK SUBR NOT IN USE
	MOVEI	R,(X1)
	MOVEM	R,FCNLNK
	POP	P,X2		;SAVE REAL RETURN LOCATION
	SUB	P,T		;POP ANY ARGUMENTS OFF THE PUSH LIST
	JRST	(X2)		;RETURN

BADRET:	PUSHJ	P,INLMES
	ASCIZ /RETURN BEFORE GOSUB IN /
	JRST	N,GOSR2

IFN FTRND,<
;RUN-TIME RANDOMIZER
RANDER:	CALL	N,[SIXBIT /MSTIME/]
	IMUL	N,N		;USE THE 31 LOW ORDER BITS OF MILLISECS IN DAY ^2
	TLZ	N,760000
	JRST	WRANB		;PRINT RANDOM FCN AND RETURN.
>;ASSEMBLE ABOVE IF INCLUDING RANDOM FACILITY

DOREAD:	MOVE	R,[XWD NXREAD,PREAD]
	SETZM	N,INPFLA
	POPJ	P,0
DOINPT:	SETZM	N,PINPUT
	SETZM	N,IFIFG
	MOVE	R,[XWD NXINPT,PINPUT]
	POP	P,INPFLA
	JRST	N,@INPFLA

;ROUTINE TO GET A DATA WORD

DATAER:	SKIPN	T,(R)		;MORE ON SAME LINE?
	JRST	DATR1		;NO
	PUSHJ	P,NXCH		;PUT FIRST CHAR OF NEXT NUMBER IN C
DATAE0:	PUSHJ	P,EVANUM
	PUSHJ	P,SSKIP
	MOVEM	N,@40
	TLNE	C,500000
	SETZI	T,0
	MOVEM	T,(R)		;STORE THE DATA WORD.
DATR0:	POP	P,X1
	SKIPN	T		;END OF A LINE?
	SKIPN	INPFLA		;YES, IS THIS INPUT
	JRST	(X1)		;NO, RETURN
	MOVEM	X1,INPFLA	;YES, RESTART NEXT ERROR FROM HERE.
	JRST	(X1)

DATR1:	MOVS	X1,R		;DISPATCH ADDRS FOR MORE DATA
	JRST	(X1)

;ROUTINE TO GET A DATA STRING

IFN FTSTR,<
SDATAE:	MOVE	T,1(R)		;GET CURRENT LINE POINTER
	SKIPE	INPFLA		;INPUT,INSTRUCTION?
	MOVE	T,(R)		;YES, SHARE POINTER WITH NUMBER DATA
	SKIPN	T		;MOVE ON CURRENT STRING DATA LINE?
	JRST	SDATR1		;NO. HUNT FOR NEXT DATA LINE
	PUSHJ	P,NXCH		;GET FIRST CHAR
SDAT1:	PUSHJ	P,REDSTR	;READ THE STRING AND STORE IT
	PUSHJ	P,SSKIP		;BAD STRING
	TLNE	C,F.TERM
	SETZI	T,
	MOVEM	T,1(R)		;SAVE STRING DATA POINTER.
	SKIPE	INPFLA		;INPUT?
	MOVEM	T,(R)		;YES , SHARE POINTER
	JRST	DATR0

SDATR1:	MOVS	X1,R		;DISPATCH ADDRESS FOR STRING DATA..
	JRST	1(X1)
>;ASSEMBLE ABOVE IF INCLUDING STRING FACILITY

;GET AN ARRAY DATA WORD

ADT1ER:	PUSH	P,40		;DATAER NEEDS STORE LOC
	SETZM	40
	PUSHJ	P,DATAER
	POP	P,40
	JRST	AST1ER	;GO STORE THE WORD

ADT2ER:	PUSH	P,40
	SETZM	40
	PUSHJ	P,DATAER
	POP	P,40
	JRST	AST2ER

;GO TO NEXT LINE OF DATA

NXREAD:	TDZA	Q,Q		;GET NEXT DATA LINE FOR NUMBER ITEM
	MOVEI	Q,1		;GET NEXT DATA LINE FOR STRING ITEM
NSRSTR:	MOVE	T,DATLIN(Q)	;GET NXT DATA LINE NO
	AOBJP	T,NXRE2		;JUMP IF OUT OF DATA
	MOVEM	T,DATLIN(Q)
	HRRZ	T,(T)		;GET ADDRS OF SOURCE LINE
	HRLI	T,440700
	PUSHJ	P,NXCH
	PUSHJ	P,QSA		;LOOK FOR "DATA"
	ASCIZ	/DATA/
	JRST	NSRSTR
IFN FTSTR,<
	JUMPG	Q,SDAT1		;GO GET STRING?
>
	JRST	DATAE0		;NO, GO GET NUMBER
;REQUEST NEXT LINE OF INPUT

NXVINP:	SETOI	Q,		;GET LINE AND RETURN TO "MATIN"
	JRST	NXIN1
NXINPT:	TDZA	Q,Q		;GET A LINE OF INPUT; NUMBER ITEM NEXT
	MOVEI	Q,1
NXIN1:	SKIPN	IFIFG
	JRST	NXIN2
	PUSHJ	P,INLMES
	ASCIZ /NOT ENOUGH INPUT--ADD MORE
/
NXIN2:	PUSHJ	P,INLMES
	ASCIZ / ?/
	OUTPUT
	MOVE	T,[POINT 7,LINB0]
	MOVEM	T,PINPUT
	PUSHJ	P,INLINE	;READ THE LINE AND GET FIRST CHAR.
	TLNE	C,F.CR		;NULL LINE?
	JUMPL	Q,CPOPJ1	;YES. ALLOW THIS ON MAT INPUT
	PUSHJ	P,DATCHK	;CHECK
	JRST	INPERP
	JUMPE	Q,DATAER	;GET NUMBER ITEM
IFN FTSTR,<
	JUMPG	Q,SDATAE		;GET STRING ITEM
>
	POPJ	P,
INPERP:	POP	P,X1		;GET RID OF CALL TO NXVINP!
INPERR:	PUSHJ	P,INLMES
	ASCIZ /INPUT DATA NOT IN CORRECT FORM--RETYPE LINE
/
	SETZM	PINPUT
INPER1:	HRRZ	X1,INPFLA
	JRST	(X1)		;START LINE OVER.
;RESTORE DATA POINTER

RESTOR:	PUSHJ	P,RESTOS	;RESTORE BOTH NUMBER AND STRINGS
RESTON:	TDZA	X1,X1		;RESTORE NUMERIC DATA
RESTOS:	MOVEI	X1,1		;RESTORE STRINGS
	MOVE	T,DATAFF
	ADD	T,FLLIN
	SUB	T,[XWD 1,1]
	MOVEM	T,DATLIN(X1)
	SETZM	PREAD(X1)		;CLEAR CURRENT LINE POINTER
	POPJ	P,

NXRE2:	PUSHJ	P,INLMES	;OUT OF DATA
	ASCIZ /OUT OF DATA IN /
	HRRZ	T,L
	PUSHJ	P,PRTNUM
	PUSHJ	P,INLMES
	ASCIZ /
/
	JRST	UXIT

;RUNTIME MAT INPUT ROUTINE

MATIN:	PUSHJ	P,DOINPT	;SET INPUT LOOP
	HRRZ	X1,40		;GET VECTOR 2-WD BLOCK ADDRESS
	HRRZ	X2,(X1)		;GET ADDRESS OF FIRST ELEMENT
	MOVEM	X2,NUMRES	;SAVE THIS VALUE FOR COUNTING ELEMENT LATER
	HLRZ	X1,(X1)		;GET MAXIMUM VECTOR SIZE
	ADD	X1,X2		;UPPER BOUND OF VECTOR
	MOVEM	X1,ELETOP	;SAVE FOR COMPARISION LATER
	HRRM	X2,40		;SET UP ELEMENT ADDRESS FOR DATA ROUTINES

MATIN1:	MOVEI	X1,MATIN4	;POINT "INPUT ERR" TO SPECIAL ROUTINE
	HRL	X1,40		;REMEMBER FIRST ELEMENT ON LINE
	MOVEM	X1,INPFLA
	PUSHJ	P,NXVINP	;INPUT THE LINE

MATIN5:	CAIA		;THERE IS ANOTHER ELEMENT.
	JRST	MATIN6	;NULL LINE. NO MORE ELEMENTS.
	HRRZ	X1,40		;MAY WE ACCEPT ANOTHER ELEMENT?
	CAML	X1,ELETOP
	JRST	MATIN3		;NO
	AOS	40		;POINT TO NEXT ELEMENT
	PUSH	P,[EXP MATIN2]	;YES. SETUP RETURN FROMDATA ROUTINE
IFN FTSTR,<
	CAML	X1,SVRBOT	;NUMBER OR STRING VECTOR?
	JRST	SDATAE		;STRING
>
	JRST	DATAER		;NUMBER

MATIN2:	SETOM	IFIFG
	TLNE	C,F.COMA	;END OF INPUT?
	JRST	MATIN5
	TLNE	C,F.TERM
	JRST	MATIN6
	CAIN	C,"&"
	JRST	MATIN1
	JRST	INPERR
MATIN3:	PUSHJ	P,INLMES
	ASCIZ /TOO MANY ELEMENTS -- RETYPE LINE
/
	JRST	INPER1

MATIN4:	HLRZ	X1,INPFLA
	HRRM	X1,40
	JRST	MATIN1

MATIN6:	HRRZ	X1,40
	SUB	X1,NUMRES
	TLO	X1,233400
	FSB	X1,FIXCON
	MOVEM	X1,NUMRES
	POPJ	P,

IFN FTSTR,<
REDSTR:	TLNN	C,F.LETT+F.QUOT
	POPJ	P,
	AOS	(P)		;THIS IS A LEGITIMATE STRING
	PUSH	P,G
	PUSH	P,E
	PUSHJ	P,GETSTR
	PUSHJ	P,VCHCKC
	MOVEI	Q,F.COMA+F.TERM	;ASSUME A STRING WITHOUT QUOTES
	TLNN	C,F.QUOT	;IS IT A QUOT STRING?
	JRST	REDS1
	MOVEI	Q,F.QUOT
	PUSHJ	P,NXCHS		;SKIP QUOTE
REDS1:	SETZI	X2,		;INITIALIZE COUNT.
	SKIPE	(F)		;NEW STRING?
	SETZM	VPAKFL		;NO, GARBAGE NEW EXISTS
	HRR	F,VARFRE
	HRRM	F,@N
REDS2:	TLNE	C,(Q)
	JRST	REDS3
	IDPB	C,F		;STORE A CHAR
	PUSHJ	P,NXCHS
	SOJA	X2,REDS2
REDS3:	TLNE	C,F.QUOT
	PUSHJ	P,NXCH
	HRRZ	X1,F		;GET NEW FREE LOCATION
	POP	P,E
	POP	P,G
	JRST	REDS8

SSKIP:	SKIPE	INPFLA		;IS THIS INPUT OR READ?
	JRST	SSKP1		;INPUT. CANT SKIP ANY FIELDS
	PUSHJ	P,SKIPDA	;SKIP OVER A DATA FIELD
	HALT	.		;IMPOSSIBLE ERROR
	POP	P,X1
	TLNE	C,F.TERM	;END OF DATA LINE?
	JRST	-4(X1)		;YES. FORCE DATA SEARCH
	JRST	-3(X1)		;RETURN TO DATAERR OR SDATAE

SSKP1:	ADD	P,[XWD -2,-2]	;CLEAN UP PUSH LIST
	JRST	INPERR

;ROUTINE THAT SKIPS OVER ONE DATA FIELD
SKIPDA:	TLNE	C,F.QUOT	;QUOTE STRING?
	JRST	QSKIP		;YES, USE QSKIP ROUTINE
	TLNE	C,F.COMA+F.TERM	;FIELD TERMINATOR?
	JRST	,CPOPJ1
	PUSHJ	P,NXCH
	JRST	.-3
>;ASSEMBLE ABOVE IF INCLUDING STRING FACILITY

IFE FTSTR,<
SKIPDA: POPJ	P,	;STRINGS NOT ALLOWED. DATA ERROR
SSKIP:	ADD	P,[XWD -2,-2]	;CLEAN UP PUSHLIST
	JRST	INPERR
>

PRDLER:	PUSHJ	P,FIRCHK
	SETZM	N,STRFCN
	MOVEI	D,42
	MOVE	T,@(P)
	AOS	N,(P)
	PUSHJ	P,PRINT1
FINPNT:	MOVE	X1,FMTPNT	;FINISH WITH CR?
	CAIE	X1,1
	JRST	N,PCRLF1
PCRLF:	PUSHJ	P,INLMES	;ROUTINE TO END A LINE.
	ASCIZ /
/
	SETZM	N,STRFCN
	SETZM	TABVAL
PCRLF1:	OUTPUT
	POPJ	P,

;RUN-TIME NUMBER PRINTER

PRNMER:	PUSHJ	P,TABBR
	MOVE	N,@40		;GET THE NUMBER
	PUSHJ	P,OUTNUM
	AOS	TABVAL		;CAUSE A SPACE TO FOLLOW NUMBER.
	JRST	FINPNT

PRNTBR:	PUSHJ	P,TABBR
	SKIPGE	B,TABVAL
	JUMPLE	N,FINPNT
	FAD	N,FIXCON
	TLZ	N,377400
	SUB	N,HPOS
	SUB	N,4
	JUMPLE	N,FINPNT
	ADDM	N,TABVAL
	JRST	N,FINPNT
FIRCHK:	PUSHJ	P,TABBR
	MOVEI	X1,0
;TAB CONTROL

;"TABBR" ANALYSES THE LAST FORMAT CHARACTER USING "TABB0", "TABB1", AND
;"TABB3", WHICH HANDLE THE <PA>, COMMA, AND SEMICOLON, RESPECTIVELY.
;"TABVAL" CONAINS THE NUMBER OF SPACES WAITING TO BE TYPED OUT
;(OR IS NEGATIVE IF A <RETURN> MUST FOLLOW.)


CHROOM:	MOVE	B,TABVAL
	ADD	X1,B		;TOTAL SPACE NEEDED FOR FIELD
	ADD	X1,HPOS
	CAIL	X1,113
	JRST	PCRLF		;NO ROOM, GO TO NEXT LINE
	JUMPL	B,PCRLF
	JUMPE	B,CPOPJ		;NO SPACING TO DO.
	MOVEI	C," "		;HERE TO PUT OUT SPACES
	PUSHJ	P,OUCH
	SOJG	B,.-2
	SETZM	TABVAL
	POPJ	P,

TABBR:	LDB	X1,[POINT 4,40,12]
	EXCH	X1,FMTPNT	;GET OLD POSITION AND SAVE NEW FORMAT
TABB1:	MOVE	A,TABVAL
	JUMPL	A,SETCR
	ADD	A,HPOS
	JRST	.+1(X1)
	POPJ	P,		;NO FMT CHAR
	POPJ	P,		;<CR> WAS TYPED WHEN FIRST SEEN.
	JRST	TABB3		;SEMICOLON
	CAILE	A,74
	JRST	SETCR
	IDIVI	A,^D15
	JUMPE	B,TABB2
	SUBI	B,^D15
	MOVNS	B
TABB2:	ADDB	B,TABVAL
	POPJ	P,

TABB3:	CAILE	A,112
	JRST	N,SETCR
	AOSGE	N,STRFCN
	AOS	N,TABVAL
	POPJ	P,

SETCR:	SETOM	TABVAL		;FORCE <RETURN TO BE NEXT>
	POPJ	P,
TABOUT:	MOVEI	X1,3
	PUSHJ	P,TABB1
	JRST	FIRCHK+1
IFN FTSTR,<
	SUBTTL	RUN-TIME STRING MANIPULATION ROUTINES.


;GETSTR IS CALLED WITH THE ADDRESS OF A POINTER IN REG.
;THE ROUTINE SETS UP THE POINTER IN F, AND THE NEGATIVE COUNT OR
;(FOR LITERAL STRINGS) A POSITIVE QUANTITY IN G. (G=0 IF NULL STRING)

GETSTR:	PUSHJ	P,PNTADR	;GET ADDRESS OF STRING POINTER
	MOVE	F,@N
	HLRE	G,F		;PUT NEGATIVE CHAR LENGTH IN G, IF NOT APP BLK OR 0.
	JUMPG	G,CPOPJ
	HRLI	F,440700	;NOTAPP BLK, INITIALIZE POINTER.
	POPJ	P,

;ROUTINE TO SET UP A NUMBER VECTOR INSTEAD OF A STRING
GETVEC:	HRRZ	F,@40		;THE LEFT SIDE OF (F) IS ZERO, IMPLYING VECTOR ADR,
	MOVE	G,(F)		;GET VECTOR LENGTH
	JUMPL	G,GETVF		;NEGATIVE?
	FAD	G,FIXCON	;FIX THE LENGTH
	TLZ	G,777400
	HLRZ	X1,@40		;DOES THE LENGTH EXCEED VECTOR BOUNDS?
	MOVNS	G
	ADD	X1,G
	JUMPLE	X1,GETVF
	AOJA	F,CPOPJ		;NO. POINT TO FIRST "CHAR" AND RETURN

GETVF:	PUSHJ	P,INLMES
	ASCIZ /IMPOSSIBLE VECTOR LENGTH IN /
	JRST	GOSR2

GETC0:	SETZI	G,
GETCH:	SETZI	C,
	JUMPE	G,CPOPJ
	ILDB	C,F
	JUMPG	G,.+2
	AOJA	G,CPOPJ1
	CAIN	C,42		;CHECK IF "
	JRST	GETC0
	JRST	CPOPJ1

;ROUTINE TO GET NEXT VECTOR ELE AS A CHARACTER
GETEL:	AOJG	G,CPOPJ		;IS THERE ANOTHER ELEMENT?
	MOVE	C,(F)		;YES. GET IT
	JUMPL	C,GETELF		;TOO SMALL TO BE AN ASCII
	LDB	Q,[POINT 8,C,8]		;GET EXPONENT
	TLZ	C,777000		;TURN IT OFF
	LSH	C,-233(Q)		;SHIFT INTO INTEGER POSISITON
	TRNN	C,777600
	AOJA	F,CPOPJ1		;BUMP ELEMENT POINTER AND RETURN

GETELF:	PUSHJ	P,INLMES
	ASCIZ /NON-ASCII CHAR SEEN IN /
	JRST	GOSR2

;ROUTINE TO STORE "NUMERIC" CHARS INTO A STR.
STRCHA:	PUSHJ	P,PNTADR
	PUSHJ	P,VCHCKC
	SKIPE	N,@N
	SETZM	N,VPAKFL
	MOVE	X1,VARFRE
	MOVEM	X1,@N
	HRLI	X1,440700
	SETZI	X2,
STRCH1:	PUSH	P,[XWD STRCH2]
	TLNN	F,777777
	JRST	GETEL
	JRST	GETCH
STRCH2:	JRST	REDS8
	HRRM	X1,VARFRE
	IDPB	C,X1
	SOJA	X2,STRCH1

REDS8:	HRLM	X2,@N
	AOJ	X1,
	HRRM	X1,VARFRE
	POPJ	P,

PUTVEC:	HRRZ	X1,@40
	MOVE	N,X1
	HLRZ	X2,@40
PUTV1:	PUSHJ	P,GETCH
	JRST	PUTV2
	SOJL	X2,PUTVF
	TLO	C,233400	;YES. FLOAT IT
	FSB	C,FIXCON
	MOVEM	C,1(X1)
	AOBJP	X1,PUTV1	;COUNT CHARS IN LEFT HALF OF X1

PUTV2:	HLRZ	X1,X1		;GET SIZE
	HRLI	X1,233400	;FLOAT IT
	FSB	X1,FIXCON
	MOVEM	X1,@N		;FIRST ELEMENT GETS SIZE
	POPJ	P,

PUTVF:	PUSHJ P,INLMES
	ASCIZ /NO ROOM FOR STRING IN /
	JRST	N,GOSR2

; COMPARE TWO STRINGS.
IFSTR:	PUSH	P,F
	PUSH	P,G
	PUSHJ	P,GETSTR
	POP	P,T1
	POP	P,T
IFST1:	PUSHJ	P,GETPCH	;GET PAIR OF CHARS IN (A) AND (C)
	JUMPG	Q,IFST3		;HAVE BOTH STRINGS ENDED?
	JUMPE	Q,IFST2		;HAS ONE STRING ENDED?
	CAMN	C,A		;ARE THESE TWO CHARS THE SAME?
	JRST	IFST1		;YES. LOOK AT NEXT PAIR

IFST2:	SETOI	Q,		;CHECK BOTH STRINGS FOR TRAILING BLANKS
	CAIN	C," "		;IS THIS CHAR A BLANK?
	PUSHJ	P,IFST4		;YES, GO CHECK STRING
	PUSHJ	P,EXCH6		;LOOK AT OTHER STRING
	AOJLE	Q,.-3

IFST3:	HLLZ	X1,@(P)	;GET RELATION
	AOS	(P)
	IOR	X1,[Z A,C]	;SETUP COMPARE
	XCT	X1
	POPJ	P,		;RETURN AND "GOTO"
	JRST	CPOPJ1		;RETURN AND STAY IN LINE

IFST4:	PUSHJ	P,GETCH
	POPJ	P,
	CAIN	C," "		;IS NEXT CHAR A BLANK?
	JRST	N,IFST4		;YES KEEP LOOKING
	MOVEI	C," "		;NO. USE BLANK FOR COMPARE
	POPJ	P,

;ROUTINE TO GET A PAIR OF CHARS
GETPCH:	SETOI	Q,		;COUNT TERMINATED STRINGS IN X2
	PUSHJ	P,GETCH
	AOJ	Q,
	PUSHJ	P,EXCH6
	PUSHJ	P,GETCH
	AOJ	Q,
EXCH6:	EXCH	T,F
	EXCH	T1,G
	EXCH	A,C
	POPJ	P,

;PRSTRR PRINTS A STRING WHOSE POINTER IS ADDRESSED IN (40)

PRSTRR:	PUSH	P,G
	PUSHJ	P,PNTADR
	PUSHJ	P,GETSTR
	PUSHJ	P,FIRCHK
	SETZM	N,STRFCN
PRST1:	PUSHJ	P,GETCH
	JRST	PRST2
	PUSHJ	P,OUCH
	JRST	PRST1
PRST2:	POP	P,G
	JRST	FINPNT
VCHCK9:	MOVN	X1,G
	ADDI	X1,4
	IDIVI	X1,5
	MOVE	E,X1
	POPJ	P,
>;ASSEMBLE ABOVE FOR STRINGS

IFN FTSTR,<
;ROUTINE TO PUT ADDRESS OF POINTER IN REG
PNTADR:	HRRZ	N,40		;GET UUO ADDRESS
	MOVE	X1,@N
	JUMPGE	X1,CPOPJ	;ALL DONE IF THIS IS 0 OR AN APP BLK.
	TLNN	X1,377777	;ALL DONE IF THIS IS NEGATIVE COUNT
	HRRZ	N,X1
	POPJ	P,
>;ASSEMBLE ABOVE IF INCLUDING STRING FACILITY

SAD1ER:	MOVE	D,[JRST SADEND]	;FETCH ADR OF ARRAY ELEMENT
	JRST	AFT1ER+1

ASN1ER:	MOVE	D,[MOVNM N,(A)]	;NEGATIVE ARRAY STORE
	JRST	AFT1ER+1
AST1ER:	SKIPA	D,[MOVEM N,(A)]	;POSITIVE ARRAY STORE
AFT1ER:	MOVSI	D,A(MOVE N,)	;ARRAY FETCH
	MOVEI	A,0		;PSEUDO LEFT HALF
	MOVE	B,40		;ARRAY ADDRESS
	HRRZ	C,1(B)		;TRY RIGHT DIMENSION
	TRNN	C,777776	;ROW VECTOR?
	HLRZ	C,1(B)		;NO, MUST BE COLUMN VECTOR
	JRST	AFT2C		;FINISH UP WITH 2-DIM CODE

ASN2ER:	MOVE	D,[MOVNM N,(A)]	;NEGATIVE ARRAY STORE
	JRST	N,.+3
AST2ER:	SKIPA	D,[MOVEM N,(A)]	;POSITIVE ARRAY STORE
AFT2ER:	MOVSI	D,A(MOVE N,)	;ARRAY FETCH
	MOVE	B,40		;ARRAY ADDRESS
	HLRZ	C,1(B)		;LEFT DIMENSION
	PUSHJ	P,SUBSCR	;GET AND FIX SUBSCRIPT IN E
	HRRZ	A,1(B)
	IMUL	A,E		;LEFT SCRIPT TIMES RIGHT DIM!
	HRRZ	C,1(B)		;RIGHT DIMENSION
AFT2C:	PUSHJ	P,SUBSCR	;GET AND FIX SUBSCRIPT IN E
	ADD	A,E		;ADD TO LEFT DIM
	ADD	A,(B)		;ADD ARRAY ADDRS
	XCT	D		;DO THE OPERATION
	POPJ	P,		;RETURN

IFN	FTSTR,	<
SADEND:	HRRZI	N,(A)		;PUT STRING VECTOR POINTER ADDRESS IN N
	TLO	N,(1B0)		;MAKE IT LOOK LIKE AN ADDRESS, NOT A POINTER
	POPJ	P,
>
;ROUTINE TO FETCH AND CHECK SUBSCRIPT

;CALL:	MOVE	C,DIMENSION
;	PUSHJ	P,SUBSCR


SUBSCR:	MOVE	E,@-1(P)		;GET SUBSCRIPT
	AOS	N,-1(P)		;SKIP ARGUMENT
	MOVE	E,(E)
	FAD	E,[XWD 233400,0];FIX SUBSCRIPT
	TLZ	E,777400
	CAMGE	E,C		;CHECK DIMENSION
	POPJ	P,
				;ON ERROR, FALL INTO DIMERR


;DIMENSION ERR ROUTINE



DIMERR:	PUSHJ	P,INLMES
	ASCIZ /DIMENSION ERROR IN /
	JRST	GOSR2
      SUBTTL  MATRIX OPERATION RUN-TIME ROUTINES

IFN FTMAT, <
;SET MATRIX DIMENSION -- SDIM UUO


SDIMER:	MOVSI	C,1		;DONT FAIL IN SUBSCR
	PUSHJ	P,SUBSCR	;FIRST DIM
	HRLZ	A,E		;SAVE IT
	PUSHJ	P,SUBSCR	;SECOND DIM
	HRR	A,E
	AOBJP	A,MS0CHK		;GO CHECK DIMS AND STORE THEM
>
IFN FTMAT, <
;MATRIX OPERATION SETUP ROUTINE
;USE ENTRY POINT MS2 IF 2 ARGS, MS1 IF 1 ARG, MS0 OR MS0CHK IF 0 ARGS.
;ALL ENTRIES EXPECT MS0 EXCEPT DIMENSION [XWD ROWS,COLS]
;  OF DESTINATION TO BE SET UP IN A AND CHECK FOR ROOM
;  AND SET DIMENSION OF DESTINATION.
;AT CALL, LOCATION 40 CONTAINS THE ADDRS OF DESTINATION DOPE VECTOR,
;  RIGHT SIDE OF T1 CONTAINS ADDRS OF DOPE VECTOR FOR ARG 1
;  RIGHT SIDE OF T CONTAINS ADDRS OF DOPE VECTOR FOR ARG 2
;RIGHT SIDES OF T1,T,B ARE REPLACED WITH ADDRESSES OF ELEMENTS 0,0
;  OF ARG 1, ARG 2, DEST, RESPECTIVELY, WITHOUT CHANGING LEFT SIDES,
;  AND THE RESULTS ARE STORED IN TEMP1, TEMP2, AND TEMP3, RESPECTIVELY.
;THE MAXIMUM ROW NUMBER OF DEST IS STORED IN SB1M1, THE MAXIMUM
;  COLUMN NUMBER OF DEST IS STORED IN SB2M1
;E, T1, AND G ARE SET TO FIRST ROW NUMBER, FIRST COL NUMBER,
;  AND RELATIVE LOCATION OF FIRST ELEMENT, RESPECTIVELY
;IT IS INTENDED THAT E, T1, G, TEMP1, TEMP2, TEMP3 BE SET UP FOR
;  IMMEDIATE CALL TO MLP, AND THAT ELEMENTS OF FIRST
;  ARGUMENT, SECOND ARGUMENT, AND DESTINATION BE ACCESSED
;  BY INDIRECT ADDRESSING THROUGH TEMP1, TEMP2, AND TEMP3, RESPECTIVELY.


MS2:	HRR	T,(T)		;ADDRS OF FIRST ARG
MS1:	HRR	T1,(T1)		;ADDRS OF SECOND OR ONLY ARG
MS0CHK:	HRR	B,40		;DOPE VECTOR OF DEST
	HLLZ	X1,A		;CHECK NEW DIMENSION
	IMULI	X1,(A)		;X1 := (TOTAL SIZE)0
	CAMLE	X1,0(B)		;IS THERE ROOM IN ARRAY?
	JRST	DIMERR		;NO.  DIMENSION ERROR
	MOVEM	A,1(B)		;STORE NEW DIMENSION

MS0:	HRR	B,40		;ENTER HERE FOR NO DIM CHECK
	MOVE	A,1(B)		;FETCH DIMENSIONS
	SUB	A,[XWD 1,1]	;E := (MAX ROW)MAX COL
	HLRZM	A,SB1M1		;FIRST DIMENSION -1
	HRRZM	A,SB2M1		;SECOND DIMENSION -1

	HRR	B,(B)		;ADDRS OF DEST (LEAVE IN B FOR MINV)
	MOVEM	T1,TEMP1	;STORE FIRST XCT INSTRUCTION
	MOVEM	T,TEMP2		;STORE SECOND XCT INSTRUCTION
	MOVEM	B,TEMP3		;STORE THIRD XCT INSTRUCTION

;NOW SETUP E, T1, AND G FOR "MLP"

	SKIPE	E,SB1M1		;MORE THEN 0'TH ROW?
	MOVEI	E,1		;YES.  USE FIRST
	SKIPE	T1,SB2M1		;MORE THAN 0'TH COL
	MOVEI	T1,1		;YES.  USE FIRST
	MOVE	G,SB2M1		;CALCUATE FIRST ELT OF RESLT
	ADDI	G,1
	IMULI	G,(E)
	ADDI	G,(T1)
	POPJ	P,
>
IFN FTMAT, <
;MATRIX OPERATION MAIN LOOP

;ON CALLING, T, T1, G ARE SET UP TO ROW NUMBER, COL NUMBER, AND
;  REL LOC OF CURRENT ELEMENT IN DESTINATION MATRIX.
;MLP EXECUTES THE CONTENT OF TEMP1, TEMP2, TEMP3 FOR EACH
;  ELEMENT OF CURRENT ROE.  AT END OF ROW, MLP RETURNS
;  WITHOUT SKIP TO ALLOW ONCE-PER-ROW OPERATIONS TO BE PERFORMED.
;  WHEN ALL ROWS HAVE BEEN PROCESSED, MLP RETURNS WITH SKIP.
;NOTE SPECIAL CODING SO THAT ROW AND COLUMN VECTORS ARE
;  HANDLED CORRECTLY.

MLP:	XCT	TEMP1
	XCT	TEMP2
	XCT	TEMP3

	ADDI	G,1
	CAMGE	T1,SB2M1
	AOJA	T1,MLP
	SKIPE	SB2M1		;MORE THAN A 0'TH COL?
	AOJA	G,.+2		;YES.  SKIP 0'TH COL
	TDZA	T1,T1		;NO. SET TO USE 0'TH COL
	MOVEI	T1,1		;YES AGAIN.  SET TO USE COL 1.

	CAML	E,SB1M1		;ALL ROWS USED?
	AOS	(P)		;YES.  SET FOR SKIP RETURN
	AOJA	E,CPOPJ		;BUMP ROW AND RETURN
>
IFN FTMAT,<
;MATRIX READ ROUTINE

;SET UP AND CALL MLP. FOR EACH ELEMENT, THE FOLLOWING
;ARE PERFORMED:
;	TEMP1:	PUSHJ	P,MTRELT
;	TEMP2:	...	;(SKIPPED)
;	TEMP3:	MOVEM	N,<DEST>(G)
;MTRELT READS A NUMBER INTO N

MTRDER:	MOVE	T1,[PUSHJ P,MTRELT]
	PUSHJ	P,DOREAD
	HRRZ	X1,@40		;GET ADDRESS OF ZEROTH ELEMENT.
	CAML	X1,SVRBOT	;IS THIS A STRING VECTOR?
	JRST	MTRDS		;ELEMENTS WILL BE STRINGS.
	HRLI	B,G(MOVEM N,)
MTRD1:	PUSHJ	P,MS0		;SET UP FOR LOOP
	SETZM	40		;NOP THE STORE THAT DATAER USES
MTRD2:	PUSHJ	P,MLP		;EXECUTE LOOP
	JRST	.-1		;NO ACTION ON ROW
	POPJ	P,

;ROUTINE CALLED BY MTRDER TO PRINT AN ELEMENT

MTRELT:	PUSHJ	P,DATAER
	JRST	CPOPJ1

MTRDS:	MOVSI	T1,(SKIPA)
	MOVSI	B,G(STOCHA)
	JRST	MTRD1

;MATRIX PRINT ROUTINE

;SET UP AND CALL MLP:
;	TEMP1:	PUSH	P,T
;	TEMP2:	PRNM	<FORMAT CODE>,<DEST>(G)
;	TEMP3:	POP	P,T
MTPRER:	MOVE	T1,[PUSH P,T1]	;TO SAVE T1 AROUND PRNM
	PUSHJ	P,MS0		;SET UP FOR LOOP
	HLL	B,40		;PICK UP UUO AC FIELD
	TLZ	B,777000	;CONSTRUCT PRNM INSTR
	SKIPE	SB1M1		;COLUMN VECTOR?
	SKIPN	SB2M1
	JRST	.+3		;YES. ALLOW <CR> FORMAT
	TLNN	B,(Z 16,)	;OH, NO.  TREAT <RET> FORMAT ==<COMA> FORMAT.
	HRLI	B,(Z 3,)
	HRRZ	X1,@40
	CAMGE	X1,SVRBOT	;NUMBER ARRAY?
	TLO	B,G(PRNM)	;YES, SETUP NUMBER UUO
	CAML	X1,SVRBOT	;STRING ARRAY?
	TLO	B,G(PRSTR)	;YSE SEUP STRING PRINT UUO.$
	MOVEM	B,TEMP2		;SET UP TEMP2 AND TEMP3
	MOVE	X1,[POP P,T1]
	MOVEM	X1,TEMP3
MTP1D:	PUSHJ	P,MTP3D		;TOW BLANK LINES
MTP2D:	PUSHJ	P,MLP
	JRST	MTP4D
MTP3D:	PUSHJ	P,PCRLF
	PUSHJ	P,PCRLF
	POPJ	P,
MTP4D:	SKIPE	SB1M1		;VECTOR OR ARRAY?
	SKIPN	SB2M1
	JRST	MTP2D		;ARRAY... SPACE BETW ROWS
	JRST	MTP1D		;VECTOR...DONT SPACE BETW ROWS
>
IFN FTMAT, <
;MATRIX ADD AND SUBTRACT ROUTINES

;SET UP AND CALL MLP:
;	TEMP1:	MOVE	N,<ARG 2>(G)	;OR MOVN
;	TEMP2:	FADR	N,<ARG 1>(G)
;	TEMP3:	MOVEM	N,<DEST>(G)
MTADER:	TLOA	T1,G(MOVE N,)		;MAKE ADD INSTR (T LOADED WITH MOVEI)
MTSBER:	HRLI	T1,G(MOVN N,)		;MAKE SUBTRACT INSTR
	HRLI	T,G(FADR N,)		;FETCH
	HRLI	B,G(MOVEM N,)
	MOVE	A,1(T)		;GET AND CHECK DIMENSIONS OF ARGS
	CAME	A,1(T1)
	JRST	DIMERR
	PUSHJ	P,MS2		;SET UP MATRIX LOOP
	JRST	MTRD2		;FINISH -- NO EACH ROW RTN

;MATRIX SCALE ROUTINE

;SET UP AND CALL MLP:
;	TEMP1:	MOVE	A,<ARG 1>(G)
;	TEMP2:	FMPR	A,N
;	TEMP3:	MOVEM	A,<DEST>(G)

MTSCER:	HRLI	T1,G(MOVE A,)
	MOVSI	T,(FMPR A,N)
MTSC1:	HRLI	B,G(MOVEM A,)
	MOVE	A,1(T1)
	PUSHJ	P,MS1
	JRST	MTRD2
>
IFN FTMAT, <
;MATRIX ZERO, IDENTITY, AND ONE ROUTINES

;SET UP AND CALL MLP:
;		..IDEN..	..ZERO..	..ONE..
;	TEMP1:	SETZM@TEMP3	SETZM @TEMP3	CAIA
;	TEMP2:	CAMN T,T1	CAIA		...
;	TEMP3:	MOVEM A,<DEST>(G)......................


MTIDER:	SKIPA	T,[CAMN E,T1]
MTZRER:	MOVSI	T,(CAIA)
	SKIPA	T1,[SETZM @TEMP3]
MTCNER:	MOVSI	T1,(CAIA)
	HRLI	B,G(MOVEM D,)
	MOVSI	D,(DEC 1.0)	;CONSTANT 1.0 TO STORE
	JRST	N,MTRD1		;GO FINISH WITH READ CODE


;MATRIX TRANSPOSE ROUTINE

;SET UP AND CALL MLP:
;A CONTAINS RELATIVE LOC OF CURRENT ELE IN SOURCE
;	TEMP1 : FETCH SOURCE ELEMENT
;	TEMP2 : UPDATE SOURCE INDEX
;	TEMP3 : STORE DESTINATION ELEMENT



MTTNER:	MOVS	A,1(T1)		;FETCH DESTINATION DIMENSION
	HRLI	T1,200003
	HLRZ	T,A		;E := ADDI A,<NBR ROWS>
	HRLI	T,(ADDI A,)
	HRLI	B,G(MOVEM N,)
	PUSHJ	P,MS1		;SET UP CHK DIMENSION

MTTN1:	MOVE	A,SB1M1		;A := <NBR ROWS>*COL + ROW
	ADDI	A,1
	IMUL	A,T1
	ADD	A,E

	PUSHJ	P,MLP		;MOVE A ROW
	JRST	MTTN1
	POPJ	P,
>

IFN FTMAT, <
;MATRIX MULTIPLY ROUTINE

;SET UP AND CALL MLP
;FOR EACH ELEMENT OF DESTINATION MATRIX, CALL SUBROUTINE
;	MYELT TO FORM THE DOT PRODUCT OF THE APPROPRIATE ROW AND COLUMN


MTMYER:	MOVE	A,1(T)		;CHECK DIMENSIONS
	HLRZ	D,1(T1)		;D := INNER DIMENSION
	CAIE	D,(A)		;SAVE AS FIRST ARG?
	JRST	DIMERR		;NO
	HRR	A,1(T1)

	HRLI	T1,T1(MOVEI X2,)	;TO COMPUTE ADDRESS OF 1ST ELT 2ND ARG
	HRLI	T,(MOVEI X1,)	;DITTO 1ST ARG
	HRLI	B,G(MOVEM N,)	;STORE INSTR
	PUSHJ	P,MS2		;SETUP NEW DIMENSIONS AND MLP ARGS
	MOVEI	X1,1(A)		;PREPARE TO SKIP ROW ZERO IF..
	CAIE	D,1		;INNER DIM=1?
	ADDM	X1,TEMP1
	MOVE	B,[PUSHJ P,MYELT]	;CALL TO ELT COMPUTATION
	EXCH	B,TEMP2

	CAIE	D,1		;INNER DIM 1?  (IE PROD OF VECTORS)
	ADDI	B,1		;NO.  SKIP 0'TH COL OF 1'ST ARG
	JUMPE	E,MTMY2		;DONT SKIP FIRST ROW IF ONLY 1

MTMY1:	ADDM	D,B		;NEXT ROW OF FIRST ARG
MTMY2:	PUSHJ	P,MLP
	JRST	MTMY1
	POPJ	P,

;SUBROUTINE TO COMPUTE ELEMENT OF PRODUCT
;X1 CONTAINS ADDRS OF 1ST ELT OF 1ST ARG FOR DOT PRODUCT,
;  AFTER FIRST XCT BELOW, X2 CONTAINS ADDRS OF SAME FOR 2ND ARG

MYELT:	XCT	B
	MOVEI	N,0		;TO ACCUMULATE DO PRODUCT
	MOVEI	C,-1(D)	;NUMER OF ADDS= REAL INNER DIMENSION

MYEL1:	MOVE	Q,(X1)		;PRODUCT OF 2 ELTS
	FMPR	Q,(X2)
	FADR	N,Q		;ADD INTO DOT PRODUCT
	ADDI	X2,1(A)		;NEXT ROW OF 2ND ARG
	SOJLE	C,CPOPJ		;DONE?
	AOJA	X1,MYEL1	;NO.   TO NEXT ELT
>
	SUBTTL	RUN-TIME MATRIX INVERTER

IFN FTMAT, <
;SUBROUTINE TO CALL MATRIX INVERTER

MTIVER:	MOVS	A,1(T1)		;MAKE SURE SQUARE MATRIX
	CAME	A,1(T1)
	JRST	N,DIMERR

	HRLI	T1,G(SKIPA A,)	;MOVE DESTINATION
	PUSHJ	P,MTSC1		;(USE MTCNER CODE)
	SKIPE	SB1M1	;GO INVERT UNLESS ONLY ELT IS (0,0)
	JRST	MINVB

	SUBI	B,3
	MOVEM	B,TEMP3		;ONLY ELEMENT IS (0,0)
	AOS	SB1M1		;FOOL MINV INTO THINGING ITS (1,1)
	JRST	MINVB

;THIS PORTION OF THE MAT INVERSE PROG RUNS IN ACS 0-7

JLOOP:
	PHASE	0

ZERO:	CAMN	JX,NT		;SKIP SAME COL
	JRST	JXIT
	MOVE	TAC,@TEMP1	;A(I,J)=A(I,J)+A(NT,J)*A(I,NT)
	FMPR	TAC,(KX)	;***
MOD:	FADRM	TAC,0(JX)	;ADDR MODIFIED BY OUTER LOOP
JXIT:	CAMGE	JX,SB1M1	;LOOP DONE?
	AOJA	JX,ZERO
	JRST	IXIT		;YES RETURN

	DEPHASE

;SOME AC DEFS FOR MINV

NT=10		;OUTERMOST LOOP INDEX
IX=11		;I SUBSCRIPT
JX=12		;J SUBSCRIPT
KX=13		;SCRATCH INDEX REG
LX=14		;    "	   "	"
TAC=15
TAC1=16		;   "	(MUST BE SAVE & RESTORED)
>
IFN FTMAT, <
;MAIN ROUTINE ENTERS HERE TO SET UP REGS
;ROUTINE EXPECTS	1) ARRAY ADDR IN TEMP3
;			2) ORDER OF ARRAY IN SB1M1
;ROUTINE USES	1) VECT1 & VECT2 AS SCRATCH
;		2) SB2M1 AS CNT OF ELEMENTS / ROW

MINVB:	HRRZS	TEMP3		;MAKE SURE ADDR ONLY
	MOVE	TAC,SB1M1	;GET ORDER
	ADDI	TAC,1		;ADD ONE FOR 0'TH ROW & COL
	MOVEM	TAC,SB2M1	;SAVE IN SB2
	PUSH	P,TAC1
	MOVSI	TAC,(1.0)	;INIT DETERM.
	MOVEM	TAC,DETER
	HRLZI	TAC,JX		;SET INDEX REG IN
	HLLZM	TAC,TEMP1	;TEMP1 FOR INDIRECT
	MOVE	TAC,[XWD JLOOP,ZERO]
	BLT	TAC,7		;PUT JLOOP INTO ACS

	MOVEI	NT,1		;INITIALIZE OUTER LOOP
MINVLP:	MOVE	TAC,NT
	IMUL	TAC,SB2M1	;CALC (NT,NT) SUBSCR
	ADD	TAC,NT
	ADD	TAC,TEMP3	;***
	MOVEM	TAC,TEMP2	;SAVE IT FOR LATER
	CAMN	NT,SB1M1	;LAST ITER?
	JRST	FOUND1		;SAVE SEARCH STUFF
	MOVM	TAC,(TAC)	;GET A(NT,NT)
	MOVE	IX,NT		;INITIALIZE SEARCH

LUPI:	MOVE	KX,SB2M1	;CALC I INDEX
	IMUL	KX,IX
	ADD	KX,TEMP3	;***
	MOVE	JX,NT		;INIT J INDEX
LUPJ:	MOVE	LX,KX
	ADD	LX,JX		;FINISH INDEX FOR ELEMENT
	MOVM	LX,(LX)		;GET IT
	CAMGE	LX,TAC		;IS IT LARGER THAN PRESENT
	JRST	LUPEND		;NO
	MOVE	TAC,LX		;YES SAVE IT
	MOVEM	IX,VECT1(NT)	;AND INDEXES
	MOVEM	JX,VECT2(NT)
LUPEND:	CAMGE	JX,SB1M1	;END OF J LOOP LOGIC
	AOJA	JX,LUPJ
	CAMGE	IX,SB1M1
	AOJA	IX,LUPI
>
IFN FTMAT, <
	PUSHJ	P,FSWAP
FOUND1:	MOVE	TAC,@TEMP2	;GET PIVOT ELEMENT
	JUMPE	TAC,SING	;TEST FOR SINGULARITY.
	MOVEM	TAC,PIVOT	;SAVE IT
	FMPRM	TAC,DETER	;PERPETUATE DETERM
	MOVSI	TAC,(1.0)	;1./A(NT,NT)
	FDVRM	TAC,PIVOT	;***

	MOVEI	IX,1		;SET UP I
ILOOP:	CAMN	IX,NT		;SKIP SAME ROW
	JRST	IXIT		;AS PIVOT ROW
	MOVE	LX,SB2M1	;CALCUATE ALL ROW OFFSETS
	IMUL	LX,IX
	ADD	LX,TEMP3	;LX= IX*N+A
	MOVE	KX,LX
	ADD	KX,NT		;KX=LX+NT
	MOVN	TAC,PIVOT	;GET -PIVOT
	FMPRM	TAC,(KX)	;A(I,NT)=A(I,NT)/(-A(NT,NT))
	MOVEI	JX,1		;SET J LOOP START
	MOVE	TAC,SB2M1
	IMUL	TAC,NT
	ADD	TAC,TEMP3	;TAC=NT*N+A
	HRRM	TAC,TEMP1	;STORE FOR @TMEP1(JX)
	HRR	MOD,LX	;SAT ADDR IN INNER LOOP
	JRST	ZERO		;GO

IXIT:	CAMGE	IX,SB1M1	;RETURN HERE FROM ACS
	AOJA	IX,ILOOP
	MOVEI	JX,1		;SET LOOP FOR LAST COL
	MOVE	TAC,PIVOT	;GET PIVOT
LCOL:	FMPRM	TAC,@TEMP1	;A(NT,J)=A(NT,J)/A(NT,NT)
	CAMGE	JX,SB1M1	;DONE
	AOJA	JX,LCOL
	MOVEM	TAC,@TEMP2	;A(NT,NT)=PIVOT
	CAMGE	NT,SB1M1	;INVERSE DONE?
	AOJA	NT,MINVLP
>
IFN FTMAT, <
;HERE WHEN INVERSE DONE PUT MATRIX BACK TOGETHER

	MOVE	NT,SB1M1	;DO LOOP IN REVERSE ORDER
INVFIX:	SOJLE	NT,OUT		;FINISHED
	PUSHJ	P,BSWAP		;SWAP ROW - COL IN REV.
	JRST	INVFIX
BSWAP:	MOVE	KX,VECT2(NT)
	MOVE	LX,VECT1(NT)	;SET REGS
	JRST	SWAP
FSWAP:	MOVE	KX,VECT1(NT)
	MOVE	LX,VECT2(NT)
SWAP:	MOVE	TAC1,NT
	IMUL	TAC1,SB2M1	;CALC BOTH ROW OFFSETS
	IMUL	KX,SB2M1
	ADD	TAC1,TEMP3
	ADD	KX,TEMP3	;***
	MOVEI	JX,1
	HRLI	TAC1,JX
	HRLI	KX,JX
SWP1:	MOVE	TAC,@TAC1	;EXCHANGE ITEMS IN ROWS
	EXCH	TAC,@KX
	MOVEM	TAC,@TAC1
	CAMGE	JX,SB1M1
	AOJA	JX,SWP1
	MOVEI	IX,1
	MOVE	TAC1,NT
	MOVE	KX,SB2M1
	ADD	KX,TEMP3	;GET COL ADDR
	HRLI	TAC1,KX
	HRLI	LX,KX
SWP2:	MOVE	TAC,@LX
	EXCH	TAC,@TAC1
	MOVEM	TAC,@LX
	CAML	IX,SB1M1	;CHECK DONE
	POPJ	P,		;RETURN
	ADD	KX,SB2M1	;TO NEXT COL
	AOJA	IX,SWP2

;HERE TO RETURN OR MAKE SINGULAR

SING:	SETZB	ZERO,DETER
OUT:	POP	P,TAC1
DETB:	MOVE	ZERO,DETER
	POPJ	P,

ABSB:	MOVMS	N,N
	POPJ	P,
>
	SUBTTL	INTRINSIC FUNCTIONS (ADAPTED FROM LIB4 V.005)

;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B2-A3(Z+B3)**-1)**-1)**-1)
;WHERE Z=X^2, IF 0<X<=1

;IF X>1, THEN ATAN(X) = PI/2 - ATAN(1/X)
;IF X>1, THEN RH(A) =-1, AND LH(A) = -SGN(X)
;IF X<1, THEN RH(A) = 0, AND LH(A) =  SGN(X)

ATANB:				;ENTRY TO ARCTANGENT ROUTINE
	MOVM	T, N		;GET ABSF OF ARGUMENT
	CAMG	T, A1		;IF A<2^33, THEN RETURN WITH...
	POPJ	P,		;ATAN(X)=X
	HLLO	B, N		;SAVE SIGN, SET PH(A) = -1
	CAML	T, A2		;IF A>2^33, THEN RETURN WITH
	JRST	N, AT4		;ATAN(X) = PI/2
	MOVSI	T1, (1.0)	;FORM 1.0 IN T1
	CAMG	T, T1		;IS ABSF(X)>1.0?
	TRZA	B, -1		;IF T .E. 1.0, THEN RH(A) = 0
	FDVM	T1, T		;B IS REPLACED BY 1.0/B
	TLC	B, (B)		;XOR SIGN WITH .G. 1.0 INDICATOR
	MOVEM	T, C3		;SAVE THE ARGUMENT
	FMP	T, T		;GET B^2
	MOVE	T1, KB3		;PICK UP N CONSTANT
	FAD	T1, T		;ADD B^2
	MOVE	N, KA3		;ADD IN NEXT CONSTANT
	FDVM	N, T1		;FORM -A3/(B^2 + B3)
	FAD	T1, T		;ADD B^2 TO PARTIAL SUM
	FAD	T1, KB2		;ADD B2 TO PARTIAL SUM
	MOVE	N, KA2		;PICK UP -A2
	FDVM	N, T1		;DIVIDE PARTIAL SUM BY -A2
	FAD	T1, T		;ADD B^2 TO PARTIAL SUM
	FAD	T1, KB1		;ADD  B1 TO PARTIAL SUM
	MOVE	N, KA1		;PICK UP A1
	FDV	N, T1		;DIVIDE PARTIAL SUM BY A1
	FAD	N, KB0		;ADD B0
	FMP	N, C3		;MULTIPLY BY ORIGINAL ARGUMENT
	TRNE	B, -1		;CHECK .G. 1.0 INDICATOR
	FSB	N, PIOT		;ATAN(N) = -(ATAN(1/A)-PI/2)
	CAIA			;SKIP
AT4:	MOVE	N, PIOT		;GET PI/2 AS ANSWER
NEGANS:	SKIPGE	B		;LH(A)= -SGN(T) IF B>1.0
	MOVNS	N		;NEGATE ANSWER
	POPJ	P,		;EXIT

A1:	145000000000		;2**-33
A2:	233000000000		;2**33
KB0:	176545543401		;0.1746554388
KB1:	203660615617		;6.762139240
KB2:	202650373270		;3.316335425
KB3:	201562663021		;1.448631538
KA1:	202732621643		;3.709256262
KA2:	574071125540		;-7.106760045
KA3:	600360700773		;-0.2647686202
PIOT:	201622077325		;PI/2
;FLOATING POINT TRUNCATION FUNCTION
;TRUNCATES FRACTIONAL PART OF FLOATING POINT NUMBER
;AND RETURNS ANSWER AS N FLOATING POINT NUMBER. THE
;ALGORITHM MAKES USE OF THE NORMALIZING PROPERTIES OF FAD.
;ROUTINE EXITS WITH (T)=ZERO IF NUMBER WAS AN INTEGER.

INTB:
	MOVE	B,N		;SAVE ARGUMENT
	MOVMS	N		;GET ABSF(ARG)
	SKIPGE	B		;NEGATIVE?
	FAD	N,ALMST1	;YES. MAKE AINT[-2.3]=-3 ETC.
	CAML	N,MOD1		;IS ARGUMENT<=2**26?
	JRST	NEGANS		;YES; IT MUST BE AN INTERGER ALREADY
	FAD	N,MOD1
	FSB	N,MOD1		;NOW FRACTIONAL PART HAS BEEN LOST.
	JRST	NEGANS		;CHECK SIGN AND EXIT.

MOD1:	XWD 233400,000000	; 2**26

ALMST1:	XWD 200777,777777	;1.0-<SMALLEST QUANTITY>

;FLOATING POINT SINGLE PRECISION LOGARITHM FUNCTION
;LOG(ABSF(X)) IS CALCULATED BY THE SUBROUTINE, AND AN
;ARGUMENT OF ZERO IS RETURNED AS MINUS INFINITY. THE ALGORITHM IS

;LOGE(X) = (I + LOG2(F))*LOGE(2)
;WHERE X = (F/2)*2^(I+1), AND LOG2(F) IS GIVEN BY
;LOG2(F) = C1*Z + C3*Z^3 + C5*Z^5 - 1/2
;AND Z = (F-SQRT(2))/(F+SQRT(2))

LOGB:
	JUMPL	N, ALOGB1
LOGB0:	MOVMS	N, N		;USE ABSOLUTE VALUE
	JUMPE	N, LZERO		;CHECK FOR ZERO ARGUMENT
	CAMN	N, ONE		;CHECK FOR 1.0 ARGUMENT
	JRST	ZERANS		;IT IS 1.0 RETURN ZERO ANS.
	ASHC	N, -33		;SEPARATE FRACTION FROM EXPONENT
	ADDI	N, 211000	;FLOAT THE EXPONENTY AND MULT. BY 2
	MOVSM	N, C3		;NUMBER NOW IN CORRECT FL. FORMAT
	MOVSI	N, 567377	;SET UP -401.0 IN N
	FADM	N, C3		;SUBTRACT 401 FORM EXP.*2
	ASH	T, -10		;SHIFT FRACTION FOR FLOATING
	TLC	T, 200000	;FLOAT THE FRACTION PART
	FAD	T, L1		;B = T-SQRT(2.0)/2.0
	MOVE	N, T		;PUT RESULTS IN N
	FAD	N, L2		;A = N+SQRT(2.0)
	FDV	T, N		;B = B/A
	MOVEM	T, SX		;STORE NEW VARIABLE IN LZ
	FMP	T, T		;MULTIPLY BY Z^2
	MOVE	N, L3		;PICK UP FIRST CONSTANT
	FMP	N, T		;MULTIPLY BY Z^2
	FAD	N, L4		;ADD IN NEXT CONSTANT
	FMP	N, T		;MULTIPLY BY Z^2
	FAD	N, L5		;ADD IN NEXT CONSTANT
	FMP	N, SX		;MULTIPLY BY Z
	FAD	N, C3		;ADD IN EXPONENT TO FORM LOG2(X)
	FMP	N, L7		;MULTIPLY TO FORM LOGE(X)
	POPJ	P,		;EXIT
LZERO:	PUSHJ	P,INLMES
	ASCIZ /LOG OF ZERO IN /
	PUSHJ	P,GOSR3
	MOVE	N,MIFI
	POPJ	P,
ZERANS:	SETZI	N,		;MAKE ARG ZERO
	POPJ	P,

;CONSTANTS FOR ALOGB


ONE:	201400000000
L1:	577225754146		;-0.707106781187
L2:	201552023632		;1.414213562374
L3:	200462532521		;0.5989786496
L4:	200754213604		;0.9614706323
L5:	202561251002		;2.8853912903
ALOGB1:	PUSH	P,N		;SAVE ARGUMENT
	PUSHJ	P,INLMES
	ASCIZ /LOG OF NEGATIVE NUMBER IN /
	PUSHJ	P,GOSR3		;PRINT LINE NUMBER
	POP	P,N		;GET ARGUMENT
	JRST	LOGB0
L7:	200542710300		;0.69314718056
MIFI:	XWD 400000,000001	;GOAL POSTS. LARGEST NEGATIVE NUMBER.
NUMB:	MOVE	N,NUMRES
	POPJ	P,
SGNB:
	JUMPE	N,ZERANS	;RETURN ZERO ANSWER
	MOVE	B,N
	MOVSI	N,(1.0)		;RETURN 1.0
	JRST	NEGANS		;CHECK IF MINUS RESULT

;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
;THE ARGUMENT IS IN RADIANS.
;ENTRY POINTS ARE SIN AND COS.
;COS CALLS SIN TO CALCULATE SIN(PI/2 + X)

;THE ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
;THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
;THE QUADRANT OF THE ORIGINAL ARGUMENT
;000 - 1ST QUADRANT
;001 - 2ND QUADRANT, X=-(X-PI)
;010 - 3RD QUADRANT, X=-(X-PI)
;011 - 4TH QUADRANT, X=X-3*PI/2-PI/2
;THE ALGORITHM USES N MODIFIED TAYLOR SERIES TO CALCULATE
;THE SINE OF THE NORMALIZED ARGUMENT.


COSB:				;ENTRY TO COSINE RADIANS ROUTINE
	FADR	N, PIOT		;ADD PI/2
				;FALL INTO SINE ROUTINE

SINB:				;ENTRY TO SINE RADIANS ROUTINE
	MOVE	T, N		;PICK UP THE ARGUMENT IN T
	MOVEM	T, SX		;SAVE IT
	MOVMS	T		;GET ABSF OF ARGUMENT
	CAMG	T, SP2		;SINX = X IF X<2^-10
	POPJ	P,		;EXIT WITH ANS=ARG
	FDV	T, PIOT		;DIVIDE X BY PI/2
	CAMG	T, ONE		;IS X/(PI/2) < 1.0?
	JRST	S2		;YES, ARG IN 1ST QUADRANT ALREADY
	MULI	T, 400		;NO, SEPARATE FRACTION AND EXP.
	ASH	T1, -202(T)	;GET X MODULO 2PI
	MOVEI	T, 200		;PREPARE FLOATING FRACTION
	ROT	T1, 3		;SAVE 3 BITS TO DETERMINE QUADRANT
	LSHC	T, 33		;ARGUMENT NOW IN RANHGE (-1,1)
	FAD	T, SP3		;NORMALIZE THE ARGUMENT
	JUMPE	T1, S2		;REDUCED TO FIRST QUAD IF BITS 00
	TLCE	T1, 1000		;SUBTRACT 1.0 FROM ARG IF BITS ARE
	FSB	T, ONE		;01 OR 11
	TLCE	T1, 3000		;CHECK FOR FIRST QUADRANT, 01
	TLNN	T1, 3000		;CHECK FOR THIRD QUADRANT, 10
	MOVNS	N, T		;01,12

S2:	SKIPGE	SX		;CHECK SIGN OF ORIGINAL ARG
	MOVNS	T		;SIN(-X) = -SIN(X)
	MOVEM	T, SX		;STORE REDUCED ARGUMENT
	FMPR	T, T		;CALCULATE X^2
	MOVE	N, SC9		;GET FIRST CONSTANT
	FMP	N, T		;MULTIPLY BY X^2
	FAD	N, SC7		;ADD IN NEXT CONSTANT
	FMP	N, T		;MULTIPLY BY X^2
	FAD	N, SC5		;ADD IN NEXT CONSTANT
	FMP	N, T		;MULTIPLY BY X^2
	FAD	N, SC3		;ADD IN NEXT CONSTANT
	FMP	N, T		;MULTIPLY BY X^2
	FAD	N, PIOT		;ADD IN LAST CONSTANT
	FMPR	N, SX		;MULTIPLY BY X
	POPJ	P,		;EXIT


SC3:	577265210372		;-0.64596371106
SC5:	175506321276		;0.07968967928
SC7:	606315546346		;0.00467376557
SC9:	164475536722		;0.00015148419

SP2:	170000000000		;2**-10
SP3:	0			;0
CD1:	90.0
SCD1:	206712273406
;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS
;CALCULATED. THE ARGUMENT IS WRITTEN IN THE FORM
;	X=	F*(2**2B)	WHERE 0<F<1
;SQRT(X) IS THEN CALCULATED AS (SQRT(X))*(2**B)
;SQRT(F) IS CALCULATED BY N LINEAR APPROXIMATION, THE NATURE
;OF WHICH DEPENDS ON WHETHER 1/4 < F < 1/2 OR 1/2 < F < 1,
;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD.

SQRTB:	MOVE	T, N		;PICK UP THE ARGUMENT IN T
SQRTB0:	JUMPL	T, SQRMIN	;SQRT OF NEGATIVE NUMBER?
	JUMPE	T, ZERANS	;CHECK FOR AGUMENT OF ZERO
	ASHC	T, -33		;PUT EXPONENT IN T, FRACTION IN T1
	SUBI	T, 201		;SUBTRACT 201 FROM EXPONENT
	ROT	T, -1		;CUT EXP IN HALF, SAVE ODD BIT
	HRRM	T, EX1		;SAVE FOR FUTURE SCALING OF ANS
				;IN FSC N,. INSTRUCTION
	LSH	T, -43		;GET BIT SAVED BY PREVIOUS INST.
	ASH	T1, -10		;PUT FRACTION IN PROPER POSITION
	FSC	T1, 177(T)	;PUT EXPONENT OF FRACT TO -1 OR 0
	MOVEM	T1, N		;SAVE IT. 1/4 < F < 1
	FMP	T1, SQCON1(T)	;LINEAR FIRST APPROX,DEPENDS ON
	FAD	T1, SQCON2(T)	;WHETHER 1/4<F<1/2 OR 1/2<F<1.
	MOVE	T, N		;START NEWTONS METHOD WITH FRAC
	FDV	T, T1		;CACULATE X(0)/X(1)
	FAD	T1, T		;X(1) + X(0)/X(1)
	FSC	T1, -1		;1/2(X(1) + X(0)/X(1))
	FDV	N, T1		;X(0)/X(2)
	FADR	N, T1		;X(2) + X(0)/X(2)
	XCT	EX1
	POPJ	P,		;EXIT

SQCON1:	0.8125			;CONSTANT, USED IF 1/4<FRAC<1/2
	0.578125		;CONSTANT, USED IF 1/2<FRAC<1
SQCON2:	0.302734		;CONSTANT, USED IF 1/4<FRAC<1/2
	0.421875		;CONSTANT, USED IF 1/2<FRAC<1

SQRMIN:	PUSH	P,T	;SAVE ARG
	PUSHJ	P,INLMES
	ASCIZ /SQRT OF NEGATIVE NUMBER IN /
	PUSHJ	P,GOSR3		;PRINT LINE NUMBER
	POP	P,T		;GET ARG
	MOVMS	T
	JRST	SQRTB0		;USE ABSOLUTE VALUE

;TAN - SINGLE PRECISION TANGENT ROUTINE.
;
;BASED ON ACM ALGORITHM 229, (COMM. ACM, 7, MAY 1964, J. MORELOCK).

;METHOD:
;
;TAN(N*(PI/2)+A) = -(1/TAN(A)) IF N IS ODD,
;TAN(N*(PI/2)+A) = TAN(A) IF N IS EVEN.
;
;/A/ IS <= 0.5*(PI/2).

;ON ENTRY, THE ARG IS IN AC N.
;ON EXIT, THE ANSWER IS IN AC N.

;COTAN (X)=TAN(PI/2-X)

COTB:	MOVNS	N		;CALCULATE -X...
	FADR	N,PIOT		;PLUS PI/2
TANB:	MOVEM	N,PIVOT
	PUSHJ	P,COSB
	JUMPE	N,TANB1
	EXCH	N,PIVOT
	PUSHJ	P,SINB
	FDVR	N,PIVOT
	POPJ	P,
TANB1:	PUSHJ	P,INLMES
	ASCIZ 'TAN OF PI/2 OR COTAN OF ZERO IN '
	JRST	410317
;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION
;THE ARGUMENT IS RESTRICTED TO THE FOLLOWING RANGE
;	-88.028<X<88.028
;IF X<-88.028, THE PROGRAM RETURNS ZERO AS THE ANSWER
;IF X>88.028, THE PROGRAM RETURNS +INFINITY AS THE ANSWER
;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS:
;EXP(X) = 2**(X*LOG(B)BASE2) = 2**(M+F)
;WHERE M IS AN INTEGER AND F IS N FRACTION
;2**M IS CALCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT
;OF THE RESULT OF 2**F. 2**F IS CALCULATED AS

;2**F = 2(0.5+F(A+B*F^2 - F-C(F^2 + D)**-1)**-1

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
;	PUSHJ	P, EXP
;
;THE ARGUMENT IS IN N
;THE ANSWER IS RETURNED IN ACCUMULATOR N

EXPB:				;ENTRY TO EXPONENTIAL ROUTINE
	MOVE	T, N		;PICK UP THE ARGUMENT IN T
	MOVM	N, T		;GET ABSF(X)
	CAMLE	N, E7		;IS ARGUMENT IN PROPER RANGE?
	JRST	N, EXTOLG	;EXP TO LARGE.;##MSG +CON OR STOP?

	SETZM	N, ES2		;INITIALIZE ES2
	MULI	T, 400		;SEPARATE FRACTION AND EXPONENT
	TSC	T, T		;GET N POSITIVE EXPONENT
	MUL	T1, E5		;FIXED POINT MULTIPLY BY LOG2(B)
	ASHC	T1, -242(T)	;SEPARATE FRACTION AND INTEGER
	AOSG	T1		;ALGORITHM CALLS FOR MULT. BY 2
	AOS	T1		;ADJUST IF FRACTION WAS NEGATIVE
	HRRM	T1, EX		;SAVE FOR FUTURE SCALING
	ASH	A, -10		;MAKE ROOM FOR EXPONENT
	TLC	A, 200000	;PUT 200 IN EXPONENT BITS
	FADB	A, ES2		;NORMALIZE, RESULTS TO A AND ES2
	FMP	A, A		;FORM X^2
	MOVE	N, E2		;GET FIRST CONSTANT
	FMP	N, A		;E2*X^2 IN N
	FAD	A,E4		;ADD E4 TO RESULTS IN A
	MOVE	T, E3		;PICK UP E3
	FDV	T, A		;CALCULATE E3/(F^2 + E4)
	FSB	N, T		;E2*F^2-E3(F^2 + E4)**-1
	MOVE	T1, ES2		;GET F AGAIN
	FSB	N, T1		;SUBTRACT FROM PARTIAL SUM
	FAD	N, E1		;ADD IN E1
	FDVM	T1, N		;DIVIDE BY F
	FAD	N,E6		;ADD 0.5
	XCT	EX		;SCALE THE RESULTS
	POPJ	P,		;EXIT

E1:	204476430062		;9.95459578
E2:	174433723400		;0.03465735903
E3:	212464770715		;617.97226953
E4:	207535527022		;87.417497202
E5:	270524354513		;LOG(B),  BASE	2
E6:	0.5
E7:	207540071260		;88.028
EXTOLG:	PUSHJ P,INLMES
	ASCIZ /EXP TOO LARGE IN /
	PUSHJ P,GOSR3
	JRST	LRGNS1
;SINGLE PRECISION EXP.2 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER TO A FIXED
;POINT POWER. THE CALCULATION IS A**B, WHERE T IS OF THE FORM

;	T=Q(0) + Q(1)*2 + Q(2)*4 + ...WHERE Q(I)=0 OR 1

;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE IS
;CALLED. THE ANSWER IS RETURNED IN ACCUMULATOR N.
;EXP.2 IS CALLED ONLY BY EXP.3.	 IT IS GUARANTEED THAT THE
;BASE AND THE EXPONENT ARE NON-ZERO.


EXP2.0:	JUMPE	N,FEXP3
	MOVSI	T1,(1.0)
	JUMPGE	T,FEXP2
	MOVMS	N,T		;ABSOLUTE VALUE
	PUSHJ	P,FEXP2
	MOVSI	T,(1.0)
	FDVM	T,N
	POPJ	P,
FEXP1:	FMP	N,N		;FORM A**N, FLOATING POINT
	LSH	T,-1		;SHIFT EXPONENT FOR NEXT BIT
FEXP2:	TRZE	T,1		;IS THE BIT ON?
	FMP	T1,N		;YES, MULTIPLY ANSWER BY A**N
	JUMPN	T,FEXP1		;UPDATE A**N UNLESS ALL THOUGH
	MOVE	N,T1		;PICK UP RESULT FROM T1
	POPJ	P,		;EXIT
FEXP3:	SKIPN	N,T
	MOVSI	N,(1.0)
	POPJ	P,

;SINGLE PRECISION FORTRAN IV EXP.3 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER RAISED TO A
;FLOATING POINT POWER. THE CALCULATION IS
;	A**B= EXP(B*LOG(N))

;IF THE EXPONENT IS AN INTEGER THE
;RESULT WILL BE COMPUTED USING "EXP2.0" .

;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
;	PUSHJ	P, EXP3.0
;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR (N+1) WHEN THE ROUTINE
;IS CALLED. THE RESULT IS RETURNED IN ACCUMULATOR N.




EXP3.0:	JUMPE	T,EXP3A		;IS EXPONENT ZERO?
	JUMPE	N,EXP3B		;IS BASE ZERO?
EXP3A0:	MOVM	A,T		;SET UP ABS VAL OF EXPON FOR SHIFTING
	JUMPL	N,EXP3C		;IS BASE NEGATIVE?
EXP3A1:	MOVEI	T1,0		;CLEAR AC T1 TO ZERO
	LSHC	T1,11		;SHIFT 9 PLACES LEFT
	SUBI	T1,200		;TO OBTAIN SHIFTING FACTOR
	JUMPLE	T1,EXP3GO
	HRR	B,T1
	MOVEI	T1,0
	LSHC	T1,0(B)
	JUMPN	A,EXP3GO
	SKIPGE	T		;YES, WAS  IT NEG. ?
	MOVNS	T1		;YES, NEGATE IT
	MOVE	T,T1		;MOVE INTEGER INTO T
	JRST	EXP2.0		;OBTAIN RESULT USING EXP2.0
EXP3GO:	PUSH	P,T		;SAVE EXPONENT
	PUSHJ	P,LOGB		;CALCULATE LOG OF N
	FMPR	N,(P)		;CALCULATE B*LOG(N)
	PUSHJ	P,EXPB		;CALCULATE EXP(B*LOG(N))
	POP	P,T
	POPJ	P,		;RETURN

EXP3A:	MOVSI	N,(1.0)		;ANSWER IS 1.0
	POPJ	P,

EXP3B:	JUMPGE	T,ZERANS
	PUSHJ	P,INLMES
	ASCIZ /ZERO TO A NEGATIVE POWER IN /
	PUSHJ	P,GOSR3
LRGNS1:	HRLOI	N,377777	;LARGEST ANSWER
	POPJ	P,

EXP3C:	MOVE	X1,A
	FAD	X1,FIXCON
	FSB	X1,FIXCON
	CAMN	A,X1
	JRST	EXP3A1		;NEGATIVE BASE, INTEGRAL POWER
	PUSH	P,N		;SAVE ARGUMENTS
	PUSH	P,T
	PUSHJ	P,INLMES
	ASCIZ /ABSOLUTE VALUE RAISED TO POWER IN /
	PUSHJ	P,GOSR3
	POP	P,T
	POP	P,N
	MOVMS	N
	JRST	EXP3A0

      SUBTTL  RUN-TIME RANDOM NUMBER ROUTINES

IFN FTRND, <
;;WRANB -- PSEUDO-RANDOM RESET/WARMUP
; PUSHJ P,WRANB
;
;THE ARG IS IN ACCUMULATOR A
;
; 1.	USES STANDARD BASIC "PUSHJ" CALLING SEQUENCE.
; 2.	W IS A BIT VECTOR (BITS 05-35 SIGNIFICANT).
; 3.	RETURNS NO USEFUL VALUE IN AC Z.
; 4.	CREATES A BASIS OF "NNN" VECTORS AT VRANT IN VRAN,
;	BASED ON THE WARMUP ARGUMENT W. (STANDARD VALUE
;	IS W=0.) RESETS VRAN'S OWN INDEX. USES VRAN LOCATIONS
	;		VRANR	; VRAN OWN INDEX RESET VALUE.
	;		VRANW	; VRAN'S WARMUP CONSTANT.
	;		VRANT	; VRAN'S VECTOR-TABLE.
	;		VRANN	; NEGATIVE TABLE LENGTH.
; 5.	FORTRAN AC ASSIGNMENTS ARE
;	N=00	; FUNCTION-VALUE RETURN AC.
;	T=1	; SCRATCH AC.
;	P=17	; PUSHDOWN LIST
;	T1=2	; INDEX AC.
;	A=3	; INDEX AC.
; 6.	WRAN MAY BE USED FREELY TO REPEAT A PREVIOUSLY GENERATED
;	SEQUENCE (BY CALLING WRAN WITH THE PREVIOUSLY USED VALUE
;	FOR W), OR TO CAUSE THE GENERATION OF A COMPLETELY NEW
;	SEQUENCE (BY CALLING WRAN WITH A NEW VALUE FOR W).


	...=0	; ELLIPSIS (FOR CONVENIENCE).
>

WRANB:	XOR	N,VRANW		;   ADJUST,
	TLZ	N,(37B4)	;   IGNORE BITS 00-04
	JUMPE	N,WRANB		;   REJECT 0.
	MOVSI	T1,777771		; ESTABLISH OUTER LOOP.
WRAN2:	MOVNI	A,6	;ESTABLISH INNER LOOP.
WRAN3:	MOVE	T,N		; COPY ARGUMENT,
	ROT	T,13		;  POSITION BITS 05-10 FOR
	XOR	T,N		;  MOD 2 SUM WITH BITS 30-35.
	ROT	T,-6		; USE RESULT AS NEW
	LSHC	N,6		;  ARGUMENT BITS 30-35
	AOJN	A,WRAN3		; SIX BYTES DONE? NO, BACK.
	MOVEM	N,VRANT(T1)	; YES, ARGUMENT IS BASIS VECTOR.
	AOBJN	T1,WRAN2		; "NNN" VECTORS DONE? NO, BACK.
	MOVE	N,VRANR		; RESET VRAN OWN INDEX.
	MOVEM	N,VRANX		; (AFTER RESTORING AC'S!)
	POPJ	P,			; RETURN (OVER "ARG").

;FRANB -- FLOATING-POINT PSEUDO-RANDOM GENERATOR.

; PUSHJ P,FRANB
;
; 1.	USES STANDARD BASIC "PUSHJ" CALLING SEQUENCE.
; 3.	RETURNS IN AC N A FLOATING-POINT NUMBER AS AN
;	INSTANCE OF A REAL RANDOM VARIABLE UNIFORMLY
;	DISTRIBUTED ON THE OPEN INTERVAL (0,1).
; 4.	REQUIRES THE VECTOR GENERATOR FUNCTION VRAN.
;VRAN
; 5.	FORTRAN AC ASSIGNMENTS ARE
RANB:
FRAN1:	PUSHJ	P,VRANB		; GET RANDOM VECTOR,
	LSH	N,-9		;  SCALE TO MANTISSA,
	JUMPE	N,FRAN1		;  REJECT ZERO.
	TLO	N,(1B1)		; FORCE EXPONENT OF 2^0.
	FAD	N,[1B1]		;  NORMALIZE.
	POPJ	P,		; RETURN (IGNORE "ARG").
IFN FTRND, <
;VRAN7B -- 36-BIT PSEUDO-RANDOM GENERATOR.

;; NAME SHOULD ALWAYS BE
;; "VRANXX", WHERE "XX" IS THE ASSEMBLED VALUE OF
;; THE PARAMETER "NNN". (SEE 6. BELOW.) USE ONLY THE
;; STATISTICALLY BEST "EEE" VALUE FOR EACH "NNN" VALUE.

; PUSHJ S,VRANB
;
; 1.	USES STANDARD BASIC "PUSHJ" CALLING SEQUENCE.
; 3.	RETURNS IN AC N A 36-BIT PSEUDO-RANDOM VECTOR.
;		VRANX	; AC STORAGE, OWN INDEX.
;		VRANR	; OWN INDEX RESET VALUE.
;		VRANW	; WARMUP CONSTANT.
;		VRANT	; VECTOR-TABLE.
;		VRANN	; NEGATIVE TABLE LENGTH.
; 6.	VRAN HAS THREE ASSEMBLY PARAMETERS:
	RADIX 10
	NNN=7	; VECTOR-TABLE SIZE.
	EEE=3	; VECTOR-TABLE OFFSET.
	RADIX 8
	W=013702175435	; VECTOR-TABLE GENERATOR.
;	WHICH ARE USED TO ESTABLISH AN INITIAL TABLE OF
;	"NNN" BASIS VECTORS <V[J] : 0 .LE. J .LT. NNN>, AND TO
;	GENERATE SUCCESSIVE VECTORS ACCORDING TO THE RULE:
;	V[NNN+J] = (V[0+J] + V[EEE+J]) MODULO (2^36) : 0 .LE. J.
;	(SEE RANPAK.TXT FOR ADMISSABLE VALUES FOR <NNN,EEE,W>,
;	AND A DISCUSSION OF THE ALGORITHM.)

	VRANN=-NNN	; NEGATIVE TABLE LENGTH (FOR WRAN).
>

VRANB:	MOVE	T1,VRANX		; SET UP OWN INDEX.
	MOVE	N,VRANT+NNN(T1)	; ADDEND V[E+J] IF J .LT. N-E
	TRNN	T1,(1B0)		; [J.LT.N-E]=[RH(T1).LT.0]?
	MOVE	N,VRANT+0(T1)	; ADDEND V[E+J] IF J .GE. N-E.
	ADDB	N,VRANT+NNN-EEE(T1)	; AUGEND V[0+J] AND RESULT V[N+J].
	AOBJN	T1,VRAN1		; SETP J; J.GT.N? NO,OVER.
	MOVE	T1,VRANR		; YES, RESET J.
VRAN1:	MOVEM	T1,VRANX		; SAVE OWN INDEX
	POPJ	P,		;EXIT

VRANR:	XWD	-<NNN+1>,-<NNN-EEE>	; OWN INDEX RESET VALUE

VRANW:	EXP	W		;WARMUP CONSTANT (FOR WRAN).

	LIT

IFN PURESW,<
	LOC	140
>
EX1:	FSC	N,0
FRSTLN:	BLOCK	1	;141
LASTLN:	BLOCK	1	;142
LOWEST:	BLOCK	1	;143
PREAD:	BLOCK	2	;144
PINPUT:	BLOCK	2	;146
DATLIN:	BLOCK	2	;150
DATAFF:	BLOCK	1	;152
HPOS:	BLOCK	1	;153
REGPNT:	BLOCK	1	;154
TMPLOW:	BLOCK	1	;155
TMPPNT:	BLOCK	1	;156
PSHPNT:	BLOCK	1	;157
SEQPNT:	BLOCK	1	;160
TOPSTG:	BLOCK	1	;161
SVRBOT:	BLOCK	1	;162
SVRTOP:	BLOCK	1	;163
FMTPNT:	BLOCK	1	;164
IFFLAG:	BLOCK	1	;165

VARFRE:	BLOCK	1	;166
FCNLNK:	BLOCK	1	;167
ELETOP:	BLOCK	1	;170
FUNAME:	BLOCK	1	;171
LETSW:	BLOCK	1	;172
MTIME:	BLOCK	1	;173
	BLOCK	1	;174
FUNSTA:	BLOCK	1	;175
FUNLOW:	BLOCK	1	;176
LOWSTA:	BLOCK	1	;177
SB1M1:	BLOCK	1	;200
SB2M1:	BLOCK	1	;201
TEMP1:	BLOCK	1	;202
TEMP2:	BLOCK	1	;203
TEMP3:	BLOCK	1	;204
TYI:	BLOCK	3	;205
TYO:	BLOCK	3	;210
TTYBUF: BLOCK	3	;213

LINB0:	BLOCK	20	;216

DRMBUF:	BLOCK	2	;236
VECT1:	BLOCK	100	;240
VECT2:	BLOCK	100	;340
	BLOCK	1	;440
STRFCN:	BLOCK	1	;441
TABVAL:	BLOCK	1	;442
RUNFLA:	BLOCK	1	;443
OLDFLA:	BLOCK	1	;444
RENFLA:	EXP -1		;445
CURDEV: BLOCK	1	;446
CURNAM: BLOCK	1	;447
CUREXT: BLOCK	1	;450
DETER:	BLOCK	1	;451
NUMRES:	BLOCK	1	;452
VRANX:	BLOCK	1	;453
FILDIR:	BLOCK	1	;454
	SIXBIT /BAS/	;455
	EXP	0,0	;456
			;457
EX:	FSC N,0		;SCALE THE RESULTS
BADMSG:	ASCII /MISSING LINE NUMBER FOLLOWING LINE /
BADGNN:	EXP  60,0
CRLFMS:	ASCIZ /
/
UUOH:	0		;473
	JRST UUOHAN

	NNN=7
	W=13702175435
	INTERNAL VRANT

DEFINE	.WRAN(NN,WW) <	; ASSEMBLES "WRAN(0)" BASIS.
	DEFINE	.WRAN1 <
	REPEAT 6, <
	%Q=<%A>B<35+25>
	%Q=<%A ! %Q> & <-1-<%A & %Q>>
	%A=<%A>B<35-6> ! <%Q & 77> >
	EXP	%A >
	%A=WW
	REPEAT NN, <
	.WRAN1 >>

VRANT:	.WRAN(NNN,W)
SPEC:	EXP 1
NEWOL1:	SIXBIT /DSK/
	EXP TYI
WEAVI:	OCT 1
WEAV:	SIXBIT /DSK/
	EXP  TYI
SAVI:	OCT 1
SAVEX:	SIXBIT /DSK/
	XWD TYO,
DEFINE ROLLS <
X TXT
X LIN

X COD
X CON
X LIT
X ARA
X SVR
X GSB
X SCA
X VSP
X PTM
X TMP

X STM
X VAR
X SEX
X ARG
X REF
X FCN
X FCL
X FAD
X CAD
X LAD
X SAD
X FOR
X NXT
>
	PSHROL=200000	;ADDRESS ASSOCIATED WITH THIS
			;PHANTOM ROLL ARE ABSOLUTE, INDEXED BY (P)

DEFINE TBLS <
X CMD
X STA
X DEC
X REL
X IFN
>
ZZ.=0
DEFINE X(A)
<A'ROL=ZZ.
ZZ.=ZZ.+1
>
	TBLS
ROLLS
ROLTOP=ZZ.-1

FLOOR:
DEFINE X(A)
<EXP A'FLO>
TBLS

DEFINE X(A)
<Z>

	ROLLS
CEIL:
DEFINE X(A)
<EXP A'CEI>
TBLS

DEFINE X(A)
<Z>

	ROLLS

COMBOT=VARROL		;BOTTOM COMPILE ROLL AFTER CODROL
COMTOP=NXTROL		;TOP COMPILE ROLL.
ONCESW:	EXP	-1	;ONCE-ONLY SWITCH FOR START
			;AFTERWARDS, THE CONSTANT ZERO.

PAKFLA:	BLOCK	1	;612	;-1 IF TEXT IS NOT PACKED
VPAKFL:	BLOCK	1	;613	;-1 IF VARIABLE SPACE PACKED.
INPFLA:	BLOCK	1	;614	;NON-ZERO DURING INPUT,ZERO DURING READ
IFIFG:	BLOCK	1	;615
PIVOT: ES2: C3:	BLOCK	1	;616
SX:	BLOCK	1	;617
PLIST:	XWD -100,.
	BLOCK 100

EXTERN JOBSA,JOBREL,JOBFF,JOBREN,JOBOPC,JOBAPR,JOBTPC

MINFLG=400000   ;MINUS FLAG IN LEFT HALF OF EXPR PNTR
ROLMSK=377777   ;ROLL NUMBER MASK IN SAME

SUBTTL	LITERALS
	DEFINE	IMP(A)
<	CE'A=CEIL+A'ROL
	FL'A=FLOOR+A'ROL
	INTERN	CE'A,FL'A	>
	IMP	SVR
	IMP	LIT
	IMP	SCA
	IMP	ARA
	IMP	STM
	IMP	PTM
	IMP	LAD
	IMP	GSB
	IMP	FOR
	IMP	FCL
	IMP	CAD
	IMP	ARG
	IMP	REF
	IMP	COD
	IMP	SEX
	IMP	SAD
	IMP	NXT
	IMP	LIN
	IMP	CON
	IMP	VSP
	IMP	TXT
	IMP	TMP

	END	BASIC