;*********
;        *
; BASIC2 *
;        *
;*********
	.TITLE	BASIC2
;
; OBJECT MODULE FOR PART 2 0F MAIN BASIC INTERPRETER  8JUNE 72
;
; DOS VERSION FROM WHICH THE RSX VERSION EVOLVED WAS ORIGIANLLY A DECUS
; LIBRARY PROGRAM MODIFIED BY FRANK KORZENIEWSKI OF RPSLMC.
;
; MODIFIED FOR USE UNDER RSX-11D
; BY:	LARRY SIMPSON
;	MICHAEL REESE MEDICAL CENTER
;	JULY-OCTOBER 1975
;
; MODIFIED TO CLOSE ALL USER FILES ON 6-APR-76
;
; MODIFIED TO TURN ECHO ON AND TURN PASS-ALL-INPUT OFF                          ;DSS1
; AFTER ANY FATAL ERROR OR STOP  (AT STOP02)  18-JAN-79                         ;DSS1
;                                                                               ;DSS1
; MODIFIED NOT TO CRASH ON MIXED STRING AND NUMERIC VARIABLES IN EXPRESSIONS    ;DSS1
;                                                                               ;DSS1
; (CONDITIONAL ON  DEFVAR ) ADDED CODE IN GETHDR TO DEFINE UNDEFINED VARIABLES  ;DSS1
; (THIS MEANS THAT ALL REFERENCES TO ORDINARY UNDEFINED VARIABLES DEFINE THEM)  ;DSS1
; WHEN A VARIABLE'S VALUE IS REQUIRED, AND THE VARIABLE DOES NOT EXIST,         ;DSS1
; IT'S NAME AND TYPE ARE ENTERED AND IT IS GIVEN A DEFAULT VALUE (SEE THE       ;DSS1
; SUBROUTINE  NEWVAR )                                                          ;DSS1
; THIS ALLOWS, FOR INSTANCE, THE FOLLOWING PROGRAM:                             ;DSS1
;	10 FOR A=1 TO 5                                                         ;DSS1
;	20 PRINT B                                                              ;DSS1
;	30 B=A*5                                                                ;DSS1
;	40 NEXT A                                                               ;DSS1
;THE FIRST TIME  B  IS PRINTED, IT HAS A VALUE OF ZERO                          ;DSS1
; ** THE VARIABLE  DEFVAR  IS DEFINED IN A PREFIX FILE **                       ;DSS1
; DANIEL STEINBERG 13-FEB-79                                                    ;DSS1

	;CODE TO CONVERT TRAP SUBROUTINE CALLS TO NORMAL JSR'S
	;FOR OPERATION UNDER RSX.
	;
	;DEFINE A GENERAL MACRO TO GENERATE A SECOND MACRO WHICH
	;CONVERTS A TRAP NAME OF XXXXXX TO A
	;	JSR	PC,XXXXXX
	;
	.MACRO TRPSUB	A,B
	.MACRO	A
	JSR	PC,B
	.ENDM
	.ENDM
;
;	NOW ALL THE ONE-TIME TRAPS THAT BASIC USES
;
	TRPSUB	ATOF,ATOF00	;ASCII TO FLOATING
	TRPSUB	ATOI,ATOI00	;ASCII TO INTEGER
	TRPSUB	CLRUSR,CLRU00	;CLOSE TEMP USER SPACE (IF ANY)
	TRPSUB	CRLF,CRLF00	;DO [CR,LF]
	TRPSUB	DIMCHK,DIMC00	;CHECK LEGALITY OF DIMENSIONS
	TRPSUB	EVAL,EVAL00	;EVALUATE ARITHMETIC EXPRESSION
	TRPSUB	EVALS,EVLS00	;EVALUATE STRING EXPRESSION
	TRPSUB	FINDLN,FIND00	;FIND LINE NUMBER (IN R0)
	TRPSUB	GETVAR,GETV00	;GET TRUNCATED VARIABLE
	TRPSUB	JUNKIT,JUNK00	;SKIP OVER TRASH TO END OF LINE
	TRPSUB	PACK,PCK00	;PACK LINE INTO WORKING STORAGE
	TRPSUB	PRINTC,PRNT00	;PRINT CHARACTER
	TRPSUB	PRINTL,PRN00	;PRINT LINE, R0=FBA,R1=LBA
	TRPSUB	PRNTLN,PRLN00	;PRINT LINE NUMBER
	TRPSUB	PUSH,PUSH00	;PUSH ONE WORD INTO USER LIST
	TRPSUB	SKIP,SKIP00	;SKIP OVER SPACES IN INPUT TEXT
	TRPSUB	SRCHLF,SRCH00	;SEARCH FOR LINE FEED USING R1 AS POINTER
	TRPSUB	SRLST,SRL00	;SEARCH FOR ITEM IN USER STORAGE
	TRPSUB	STRLEN,STRL00	;COMPUTE STRING LENGTH
	TRPSUB	TSTCH,TST00	;TEST CHAR (IN R2) ALPHA VS NUMERIC
	TRPSUB	TSTOK,TSTU00	;CHECK, IS THERE ENOUGH USER SPACE
	TRPSUB	FNMBR,FNMB00	;GET FILE NUMBER AND SET UP FILE

	.SBTTL	GLOBALS AND DEFINITIONS
;
; GLOBALS--ERROR CALLS
;
	.GLOBL	GOERR,	RETERR,	DIMERR,	DMVERR,	DMDERR
	.GLOBL	DEFERR,	PARERR,	OVFERR,	ILFERR,	NXVERR
	.GLOBL	LETERR,	OPRERR,	IFERR,	PRNERR,	INPERR
	.GLOBL	IN1ERR,	IN2ERR,	IN3ERR,	REAERR,	RE1ERR
	.GLOBL	RE2ERR,	FORERR,	NXTERR,	NXMERR,	SBSERR
	.GLOBL	STXERR	FNMERR	LNNERR	VTMERR                                  ;DSS1
;                                                                               ;**-1
; GLOBALS--RETURNS TO MAIN
;
	.GLOBL	INIT00	INIT02	INIT10	INIT13
	.GLOBL	OLD01	CLSEAL	FIND01
;
; GLOBALS--REFERENCES TO FPP
;
	.GLOBL	PWRF00
	.GLOBL	SINE00,	COS00,	ATN00,	EXPF00,	LOG00
	.GLOBL	ABS00,	SQRT00,	INT00,	RND00,	SGN00
	.GLOBL	FTOA00,	M.I
;
; GLOBALS--SYSTEM VARIABLES
;
	.GLOBL	DATI	LINENO	RUNF	USR	LASTEX
	.GLOBL	STUDAT	ENUDAT	S.DATA	S.NEXT	S.EOS1
	.GLOBL	PARLST	P.ERCD	P.LINE	P.FCS
	.GLOBL	STCOUN	S.EOL1	S.EOL2	S.EOS1
;
; GLOBALS--ENTRY POINTS
;
	.GLOBL	STOP00,	RUN00,	GOSB00,	GOTO00,	RES00
	.GLOBL	RET00,	DIM00,	DEF00,	EVAL00,	GTP00
	.GLOBL	LET00,	IF00,	PR00,	INP00	EOSCHK
	.GLOBL	READ00,	FOR00,	NEXT00,	REM00,	STOP02
	.GLOBL	RUN01	EVLS00	STRCMP	INP01	ONGT00
	.GLOBL	ATTACH	DETACH	GOTO02	GOTO03	GOTO04
	.GLOBL	GETHDR	GTOFFS	GETNUM	STONUM	GETSTR
	.GLOBL	STOSTR	NEWVAR	STRADD	WRITBK
;
; PART 2 OF MAIN INTERPRETER
;
;
; REGISTER ASSIGNMENTS
;
R0	=	%0		;TEMPORARY AND PARAMETER TRANSFER
R1	=	%1		;TEMPORARY AND PARAMETER TRANSFER
R2	=	%2		;SCRATCH
R3	=	%3		;SCRATCH
R4	=	%4		;SCRATCH
R5	=	%5		;USER LIST POINTER
SP	=	%6		;BASIC STACK POINTER
PC	=	%7		;PROGRAM COUNTER
;
AC0	=	%0		;F.P. REGISTER 0
AC1	=	%1		;F.P. REGISTER 1
AC2	=	%2		;F.P. REGISTER 2
AC3	=	%3		;F.P. REGISTER 3
AC4	=	%4		;F.P. REGISTER 4
AC5	=	%5		;F.P. REGISTER 5

;
; RSX MACRO CALLS
	.MCALL	DIR$	WAIT$	READ$	WRITE$
;
; LOCAL MACROS
;
;
; PSECT DEFINITIONS
;
	.PSECT	BASIC2,RW,I,GBL,REL,CON		;PSECT FOR RO CODE
;
; ATTACH AND DETACH PROCESSING CODE
;
ATTACH:	MOV	#IO.ATA,ATTDET+Q.IOFN
	BR	COMATD
DETACH:	MOV	#IO.DET,ATTDET+Q.IOFN
COMATD:	DIR$	#ATTDET
	RTS	PC
;+1
; .TP 6
; .SL
; .HEADERLEVEL 1 ^CONTROL ^O
; .BR
; .X ^CONTROL ^O
; .X _^^O
; ^CONTROL-^O (_^^O) WILL STOP ALL OUTPUT FROM A ^^LIST\\ COMMAND
; AND RESUME PRINTING WITH ^^READY\\.
; ^IT ALSO STOPS ALL PRINTING FOLLOWING A ^^RUN\\ COMMAND INCLUDING
; NON-FATAL ERRORS.
; ^PRINTING RESUMES WITH A ^^STOP\\ OR _^^C OR A FATAL ERROR (ONE
; WHICH STOPS PROGRAM EXECUTION).
;-

	.SBTTL	STOP00 - STOP AND END STATEMENTS
;+2
; .SKIP
; .X ^^STOP\\
; .X ^^END\\
; .HEADERLEVEL 1 ^^STOP . . END\\
; .BREAK
; ^^STOP\\ AND ^^END\\ STATEMENTS.
; ^STOP USER PROGRAM EXECUTION AND TELL USER WHERE PROGRAM HAS STOPPED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
; 	{10 STOP}
; 	{20 END}
; \\
; .FILL
;-
;	REGISTERS USED - R0,R1,R2,R3,R4
;
STOP00:	JSR	PC,DETACH	;NULLIFY ^O
	MOV	#TINPT,INPT	;RE-ASSERT TERMINAL I/O
	MOV	#TOTPT,OTPT	;IN CASE DOING FILE I/O
	CRLF
	MOV	#STOP01,R0	;TELL USER
	PRINTL			;  THAT ALL HAS STOPPED
	PRNTLN			;   AT SOME FUNNY PLACE
	CRLF			;AND THEN
STOP02:	CLR	WTMAG		;SET ZERO TIMEOUT                               ;DSS1
	CLRB	RPASFL		;CLEAR PASS-ALL-INPUT BYTE (SO USER CAN TYPE)   ;DSS1
	MOVB	#1,ECHOFL	;AND SET ECHO ON                                ;DSS1
	MOV	ENDSTK,SP	;RESTORE THE STACK                              ;DSS1
	MOV	LINENO,LASTEX	;SAVE LAST EXECUTED LINE NO.                    ;**-1
	CLR	LINENO
	JMP	INIT00		; ASK WHAT NEXT
STOP01:	.ASCIZ	/STOP AT LINE /
	.EVEN
	.SBTTL	RUN00 - START PROGRAM EXECUTION
;+2
; .SKIP
; .X ^^RUN\\
; .HEADERLEVEL 1 ^^RUN\\
; .BREAK
; ^MAY BE USED IN IMMEDIATE MODE TO START THE PROGRAM IN MEMORY OR BY
; SPECIFYING A FILE IN QUOTES TO RUN ANOTHER ^^BASIC\\ PROGRAM
; STORED ON DISK.
; .FG 1
; ^IN PROGRAM MODE, IT MAY BE USED WITH A FILE SPECIFIER TO CHAIN
; TO ANOTHER PROGRAM.
; ^THE ASSUMED FILE EXTENSION IS ^^.BAS\\.
; ^NOTE THAT NO DATA IS SAVED ACROSS A ^^"RUN"\\ TYPE CHAIN.
; ^USER LOADED SUBROUTINES ARE ALSO UNLOADED.
; ^TO PRESERVE DATA AND USER FILES, USE ^^"CHAIN"\\ COMMAND.
; ^IF BASIC FAILS TO FIND THE REQUIRED FILE, IT WILL ALSO LOOK UNDER
; THE "DEFAULT <UIC", (USUALLY [1,1],) IF THIS OPTION IS ENABLED. ^THIS
; ALLOWS FREQUENTLY USED PROGRAMS TO BE AVAILABLE TO ANY USER WITHOUT
; HAVING MULTIPLE COPIES AVAILABLE.
; .FG 1
; ^A PREVIOUS RESTRICTION AGAINST USING A VARIABLE IN THE
; STRING EXPRESSION FOLLOWING THE <RUN COMMAND HAS BEEN REMOVED.
; ^THE OPTIONAL SWITCH /^R^T MAY BE USED AS WITH ^^OLD\\ TO TRIM
; ^^REM\\ AND ! STATEMENTS WHEN THE FILE FORM OF THE COMMAND IS USED.
; ^THE SWITCHES /<LI AND /<CO MAY BE USED AS IN THE <CHAIN STATEMENT.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
; 	{RUN}
; 	{RUN "PROGRAM"}
; 	{10 RUN "PROG1"}
; \\
; .FILL
;-
;	REGISTERS USED - R5
;
RUN00:	MOV	#1,RUNF		;TURN ON RUN FLAG
	MOV	#13507,M.I	;RESET RANDOM NUMBER GENERATOR
	CLR	LINENO		;CLEAR LINE NUMBER POINTER
	SKIP			;GET NEXT CHARACTER
	CMP	R2,#S.EOS1	;END OF STATEMENT?
	BHIS	4$		;IF SO, RESTART THIS PROGRAM
	DEC	R1		;RESET TEXT POINTER
	EVALS			;GET STRING BEFORE WE WIPE ANYTHING
	MOV	#INPBUF,R0	;WE CAN STORE STRING IN
	MOV	R0,R1		;TERMINAL INPUT BUFFER
	MOVB	#'",(R0)+	;STICK IN LEADING QUOTE
	TST	R4		;CHECK R4 FOR ZERO
	BEQ	2$		;IF ZERO, BRANCH
	CMP	R4,#TRMSIZ	;SEE IF TOO BIG
	BLOS	1$		;IF OK, BRANCH
	MOV	#TRMSIZ,R4	;ELSE TRIM IT TO BE SAFE
1$:	MOVB	(R3)+,(R0)+	;STORE STRING
	SOB	R4,1$		;WITH R1 POINTING TO IT
2$:	MOVB	#'",(R0)+	;AND DELIMIT WITH TRAILING QUOTE
	CLRUSR			;NOW WE CAN WIPE VARIABLES
	JSR	PC,UNLD01	;UNLOAD USER ROUTINES
	JMP	OLD01		;RUN OLD PROGRAM
4$:	CLRUSR			;WIPE VARIABLES BEFORE RUNNING PROGRAM
	JSR	PC,UNLD01	;AND UNLOAD USER ROUTINES
RUN01:	MOV	LINENO,R0	;DO WE HAVE NON-ZERO LINE NUMBER
	FINDLN			;FIND PLACE IN TEXT
	SUB	#4,R5		;GET NEXT LINE HEADER -> R5
2$:	MOV	#13507,M.I	;RESET RANDOM NUMBER GENERATOR
	JSR	PC,ATTACH	;ATTACH TERMINAL
	JMP	INIT13		;GO BACK AND LOOK FOR LINE TO DO
	.SBTTL	GOSB00 - GOSUB STATEMENT
;+3
; .SKIP
; .X ^^GOSUB\\
; .X ^^GOTO\\
; .HEADERLEVEL 1 <GOSUB N . . <GOTO N
; .BREAK
; ^TRANSFERS PROGRAM CONTROL TO STATEMENT ^N, WHERE ^N CAN BE A
; POSITIVE INTEGER CONSTANT OR AN EXPRESSION WHICH WILL BE TRUNCATED
; TO AN INTEGER.
; ^NOTE THAT AN EXPRESSION WILL NOT PRODUCE CORRECT RESULTS IN THE
; EVENT OF A RESEQUENCE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 GOTO 50}
;	{20 GOSUB A(I)}
; \\
; .FILL
;-
; GOSB00 - GOSUB STATEMENT, PUSH CLASS 1 ITEM ON STACK THEN DO A GOTO
;	REGISTERS USED - R0,R1,R2,R3,R4
;
TWO16:	.FLT2	65536.		;2^16
TWO15:	.FLT2	32768.		;2^15
GOSB00:	MOV	#4,R0		;CHECK FOR 4 BYTES SPACE
	TSTOK			;AND INITIALIZE R5 WITH STUDAT
	BHIS	1$		;IF OK, BRANCH
	OVFERR
1$:	MOV	STGOSB,R5	;GET START OF GOSUB/RETURN PTRS -> R5
	MOV	LINENO,-(R5)	;PUT IN PRESENT LINE NUMBER
	MOV	STCOUN,-(R5)	;AND STATEMENT COUNT
	MOV	R5,STGOSB	;AND SET UP NEW START OF PTRS
	.SBTTL	GOTO00 - GOTO STATEMENT
;
; GOTO00 - GOTO STATEMENT - RESET LINENO TO NEW EXECUTION POINT
;	REGISTERS USED - R0,R1,R2,R3,R4
;
GOTO00:	CLR	-(SP)		;INDICATE EXACT MATCH WANTED
GOTO04:	EVAL			;ARGUMENT FROM R1 LIST TO NUMBER IN AC0
	TSTF	AC0		;CHECK FOR NEGATIVE
	CFCC
	BLE	1$		;IF NEG, ERROR
	CMPF	TWO16,AC0	;CHECK OUR RANGE
	CFCC
	BGT	2$		;IF IN RANGE, BRANCH
1$:	LNNERR			;ELSE ERROR
2$:	CMPF	TWO15,AC0	;ARE WE IN UNSIGNED REGION
	CFCC
	BGT	3$		;IF NOT (1-32767), BRANCH
	SUBF	TWO16,AC0	;IF SO, MAKE NEGATIVE FOR CONVERSION
3$:	STCFI	AC0,R0		;CONVERT TO INTEGER
GOTO03:	MOV	STUDAT,R1	;SET UP LOW # LINE PTR
	MOV	BOLNHD,R2	;AND HIGH # LINE PTR
	TST	LINENO		;CHECK WHERE WE CAME FROM
	BEQ	2$		;IF ZERO (IMMEDIATE), BRANCH
	CMP	R0,LINENO	;CHECK REQUESTED AGAINST CURRENT
	BHI	1$		;IF FARTHER ON, BRANCH
	MOV	LINEHD,R2	;IF SAME OR BEFORE, SET NEW HIGH FOR RANGE
	BR	2$
1$:	MOV	LINEHD,R1	;SET NEW LOW FOR SEARCH RANGE
2$:	JSR	PC,FIND01	;AND DO MODIFIED FIND
	BNE	GOTO01		;IF NOT EXACT, BRANCH
GOTO02:	TST	RUNF		;RUN FLAG SET?
	BNE	1$		;IF SO, SKIP
	INC	RUNF		;IF NOT, SET IT
	JSR	PC,ATTACH	;AND MAKE SURE ATTACHED
1$:	TST	(SP)+		;POP OFF FLAG
	TSTB	TRCFLG		;TRACE WANTED?
	BEQ	2$		;IF NOT, BRANCH
	CLR	STCOUN		;IF SO, CLEAR THE STATEMENT COUNT
	JSR	PC,TRCLIN	;AND GO PRINT TRACE MESSAGE
2$:
	JMP	INIT13
GOTO01:	TST	(SP)		;EXACT MATCH REQUIRED?
	BEQ	1$		;IF SO, ERROR
	SUB	#4,R5		;ELSE POINT TO FOLLOWING LINE HEADER
	BR	GOTO02		;AND FINISH PROCESSING
1$:	GOERR
TRCLIN:
	PRNTLN			;PRINT THE LINE NUMBER WE'RE AT
	MOV	#TRCMSG,R0	;ADDRESS OF MESSAGE FOR TRACE
	PRINTL			;PRINT IT
	MOV	(R5),R1		;LINE # TO BRANCH TO -> R1
	JSR	PC,PRLN01	;PRINT IT
	MOV	#TRCMS2,R0	;NEXT PART OF MESSAGE
	PRINTL
	MOV	STCOUN,R1	;STATEMENT COUNT -> R1
	INC	R1		;MAKE R1 STATEMENT WE'RE GOING TO
	JSR	PC,PRLN01	;PRINT IT OUT
	CRLF			;END THE LINE
	RTS	PC
TRCMSG:	.ASCIZ	/ BRANCH TO LINE /
TRCMS2:	.ASCIZ	/ STMT /
	.EVEN
	.SBTTL	ON <EXP> GOTO
	.SBTTL	ON <EXP> GOSUB
;+3
; .SKIP
; .X ^^ON _<EXP> GOTO _<LINE _# LIST>\\
; .X ^^ON _<EXP> GOSUB _<LINE _# LIST>\\
; .HEADERLEVEL 1 ^^ON _<EXP> GOTO _<GOSUB> _<LINE _# LIST>\\
; .BR
; ^THIS STATEMENT TRANSFERS CONTROL TO THE ^NTH LINE NUMBER IN THE LIST.
; ^THE EXPRESSION IS EVALUATED AS A NORMAL <BASIC EXPRESSION (FLOATING
; POINT) AND THEN TRUNCATED TO GET AN INTEGER VALUE.
; ^IF THIS VALUE DOES NOT CORRESPOND TO A LINE NUMBER IN THE LIST, A
; <GOTO ERROR HAPPENS.
; ^THE TRANSFER IS HANDLED JUST AS IN THE STANDARD <GOTO AND <GOSUB
; STATEMENTS.
; .BR
; ^EXAMPLE:
; .NF
; ^^
;	{100 ON I GOTO 1000,1200,1400}
; 	{210 ON X-A(C1) GOSUB 2000,2100,3000}
; \\
; .F
;-
ONGT00:	EVAL			;EVALUATE INDEX
	BVC	2$		;IF ALL OK, BRANCH
1$:	GOERR			;OTHERWISE ERROR
2$:	STCFI	AC0,R0		;INDEX -> R0 (INTEGER)
	BLE	1$		;ZERO OR NEG => ERROR
	SKIP			;GET NEXT BYTE
	CMPB	R2,#S.GOTO	;CHECK FOR PROPER
	BEQ	3$		;CODES - GOTO
	CMPB	R2,#S.GOSB	;OR GOSUB
	BEQ	3$		;ELSE NOT A
	UNRERR			;RECOGNIZED STATEMENT
3$:	MOV	R2,-(SP)	;SAVE A BYTE CODE
	DEC	R0		;DECREMENT FOR COMMA COUNT
	BEQ	6$		;IF ZERO, BRANCH
4$:	SKIP			;GET NEXT CHAR
	CMPB	R2,#',		;IS IT A COMMA?
	BEQ	5$		;IF SO, GO THROUGH LOOP COUNT
	CMPB	R2,#S.EOS1	;IS IT END OF STATEMENT?
	BHIS	1$		;IF SO, ERROR
	BR	4$		;IF NOT, KEEP LOOKING FOR COMMA
5$:	SOB	R0,4$		;KEEP COUNTING COMMAS
6$:	CMP	(SP)+,#S.GOTO	;WAS THE CODE A GOTO?
	BEQ	7$		;IF SO, BRANCH
	JMP	GOSB00		;IF NOT, MUST HAVE BEEN A GOSUB
7$:	JMP	GOTO00

	.SBTTL	RES00 - RESTORE STATEMENT
;+6
; .SKIP
; .X ^^RESTORE\\
; .X ^FILE RESTORE
; .HEADERLEVEL 1 <RESTORE
; .BREAK
; ^RESETS DATA POINTER TO START OF DATA STATEMENTS.
; ^FOR FILES, THE ^^RESTORE\\ STATEMENT MAY BE FOLLOWED BY A _#
; SIGN AND AN ARITHMETIC EXPRESSION GIVING THE FILE NUMBER.
; ^A SEQUENTIAL FILE OPEN FOR READ ONLY WILL BE RESET TO THE
; START.
; ^TO READ A SEQUENTIAL FILE CURRENTLY BEING WRITTEN, IT IS NECESSARY
; TO CLOSE AND THEN RE-OPEN FOR READ.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 RESTORE}
; \\
; .FILL
;-
; RES00 - RESTORE STATEMENT - CLEAR THE DATA POINTER
;	REGISTERS USED - NONE
;
RES00:	SKIP			;GET NEXT CHAR
	CMP	R2,#'#		;FILE NUM FOLLOWING?
	BNE	1$		;IF NOT, DO DATA RESTORE
	MOV	#400,R0		;SET FOR INPUT OK
	JSR	PC,FILFND	;FIND THE FILE CONTROL BLOCK
	BNE	3$		;IF FOUND, BRANCH
	FNMERR			;ELSE ERROR
3$:	BIT	#3000,(R3)	;CHECK FOR RANDOM OR OUTPUT BITS
	BNE	4$		;IF EITHER, IGNORE STATEMENT
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R3,R0		;GET FDB ADDRESS
	ADD	#26,R0		;IN R0
	CLR	R1		;SET UP FIRST
	MOV	#1,R2		;BLOCK AND ZEROTH
	CLR	R3		;BYTE FOR .POINT
	JSR	PC,.POINT	;RESET FILE TO START
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
4$:	JMP	INIT02		;GO BACK TO INTERPRETER
1$:	CLR	DATI		;DO DATA RESTORE
	DEC	R1		;BACK UP TEXT POINTER
	BR	4$
	.SBTTL	RET00 - RETURN STATEMENT
;+3
; .SKIP
; .X ^^RETURN\\
; .HEADERLEVEL 1 <RETURN
; .BREAK
; ^RETURNS TO STATEMENT FOLLOWING ^^GOSUB\\ WHICH GOT YOU HERE.
; ^OTHER STATEMENTS MAY FOLLOW A GOSUB ON A LINE.
; ^IF THE LINE CONTAINING A <GOSUB IS INTERACTIVELY MODIFIED WHILE
; THE SUBROUTINE IS IN THE MIDDLE OF EXECUTING, THE <GOSUB MUST
; OCCUPY THE SAME RELATIVE STATEMENT POSITION IN THE LINE BEFORE
; AND AFTER THE MODIFICATION: I.E. IT MUST BE THE FIRST OR THIRD
; ETC. STATEMENT IN THE LINE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 RETURN}
; \\
; .FILL
;-
; RET00 - RETURN STATEMENT - FIND LAST GOSUB ITEM IN LIST,
;	GET ITS LINE NUMBER, PLACE IN LINENO, AND DELETE THE ITEM.
;	REGISTERS USED - R0,R1,R2,R3,R4,R5
;
RET00:	MOV	STGOSB,R3	;START OF GOSUB/RETURN PTRS -> R3
	CMP	R3,STFONX	;ANYTHING THERE?
	BHIS	RET03		;IF NOT, REPORT ERROR
	MOV	R3,-(SP)	;SAVE THIS ADDRESS FOR LATER
RET02:	MOV	2(R3),R0	;LINE NUMBER -> R0
	BEQ	3$		;IF ZERO, BRANCH
	FINDLN			;POSITION TO IT
	BNE	RET03		;IF NOT FOUND, BIG TROUBLE
	MOV	(SP)+,R3	;GET BACK LAST ADDRESS
	MOV	(R3),R2		;GET COUNT OF STATEMENTS
	JSR	PC,STFIND	;FIND PLACE IN LINE (PRINT MESSAGE IF TRACE)
	ADD	#4,STGOSB	;UPDATE PTR AREA PTR
	JMP	INIT03		;AND CONTINUE IN CODE
3$:	ADD	#4,STGOSB	;DELETE GOSUB ITEM FROM PTR AREA
	JMP	STOP02
RET03:	RETERR
;
; STATEMENT FIND ROUTINE TO POSITION OURSELVES TO PROPER STATEMENT
; IN A LINE (USED FOR RETURN AND NEXT STATEMENTS)
; ON ENTRY:
;	R0 HAS LINE NUMBER
;	R5 HAS LINE HEADER
;	R1 POSITIONED TO START OF LINE
;	R2 HAS COUNT OF STATEMENTS TO SKIP
;
; ON EXIT:
;	R0 -> LINENO
;	R5 -> LINEHD
;	R1 AT START OF R2+1 STATEMENT
;	R2 UNDEFINED
;
STFIND:
	MOV	R0,-(SP)	;SAVE LINE NUMBER
	MOV	R2,STCOUN	;UPDATE STATEMENT COUNT NOW
2$:	INC	R1		;PUSH PAST POSSIBLE STATEMENT TERMINATOR
;
; FOLLOWING CODE IS TO MAKE SURE AN ELSE JUST AFTER A STATEMENT TERMINATOR
; (MEANING A COMMENT IN PREVIOUS LINE) DOES NOT GET COUNTED TOO MANY TIMES
;
	MOV	R2,-(SP)	;SAVE R2
	SKIP			;POSITION R1 TO JUST PAST 1ST SIG. BYTE
	DEC	R1		;AND BACK IT UP TO SIG. BYTE
	MOV	(SP)+,R2	;GET BACK R2
	CMPB	(R1),#S.ELSE	;IS IT ELSE
	BNE	3$		;IF NOT, DO REGULAR PROCESS
	INC	R1		;IF SO, PUSH PAST IT
;
3$:	JUNKIT			;GET TO END OF STATEMENT
	SOB	R2,2$		;DO IT R2 TIMES
	TSTB	TRCFLG		;TRACE WANTED?
	BEQ	1$		;IF NOT, BRANCH
	MOV	R1,-(SP)	;SAVE TEXT PTR WE'VE WORKED SO HARD TO SET
	JSR	PC,TRCLIN	;GO PRINT MESSAGE
	MOV	(SP)+,R1	;RESTORE OUR TEXT PTR
1$:	MOV	(SP)+,LINENO	;NOW SET LINE NUMBER
	MOVB	(R1)+,R2	;TERMINATOR -> R2
	MOV	R5,LINEHD	;AND LINE HEADER
	RTS	PC

	.SBTTL	DIM00 - DIM STATEMENT
;+3
; .SKIP
; .X ^^DIM\\
; .X ^STRING VARIABLES
; .HEADERLEVEL 1 <DIM
; .BREAK
; ^DECLARES SIZE OF ARRAYS AND STRINGS.
; ^ALSO SPECIFIES STRINGS AS EITHER FIXED OR VARIABLE LENGTH.
; ^ARRAYS MAY HAVE ONE OR TWO SUBSCRIPTS.
; .FG 1
; ^STRING LENGTHS ARE INDICATED IN SQUARE BRACKETS [#] WHICH ARE
; FOLLOWED BY A '^V' IF THE STRING IS TO HAVE VARIABLE LENGTH.
; ^IN THE CASE OF A VARIABLE LENGTH STRING, THE LENGTH IS THE
; MAXIMUM LENGTH WHICH THE STRING MAY ASSUME.
; ^A STRING UNDECLARED IN A <DIM STATEMENT IS ASSUMED TO BE
; VARIBLE LENGTH WITH A MAX OF 15 CHARACTERS.
; ^FOR STRINGS DECLARED IN A <DIM STATEMENT, THE DEFAULTS ARE
; 15 CHARACTER LENGTH (OR MAX LENGTH) AND FIXED TYPE.
; .FG 1
; ^ARRAYS HAVE A ZEROTH ELEMENT WHICH IS THE SAME AS THE UNSUBSCRIPTED
; VARIABLE NAME: I.E. ^B(0) OR ^B(0,0) IS THE SAME AS ^B.
; ^UNLIKE OTHER VERSIONS OF ^^BASIC\\, ARRAYS DO NOT HAVE ANY
; ASSUMED DIMENSIONS; THEY MUST BE DECLARED IF THEY ARE TO BE USED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 DIM A(5,5),B$[10]}
;	{20 DIM C$[20]V(10,10),D$(5)}
; \\
; .FILL
;-
; DIM STATEMENT - GENERATE DIMENSIONED TABLE ENTRY
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
DIM00:	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#'#		;IS THIS A VIRTUAL ARRAY DIMENSION?
	BEQ	DIM01		;IF SO, BRANCH TO THAT ROUTINE
	DEC	R1		;ELSE BACK UP TEXT PTR
DIM02:	JSR	PC,GETHD5	;VARIABLE NAME -> R4 ETC.                       ;DSS1
	BVS	DIM99		;IF ERROR, REPORT IT                            ;**-1
	BNE	DIM97		;OR IF USED ALREADY, DIFFERENT ERROR
	MOV	R4,-(SP)	;SAVE 2 CHAR NAME (SIX BITS EACH)
	MOV	R0,-(SP)	;SAVE TYPE OFFSET
	CMP	R0,#10		;IS IT STRING?
	BEQ	2$		;IF SO, BRANCH
	JSR	PC,SUBONE	;AND GO GET SUBSCRIPTS
	BVS	DIM99		;IF ERROR, REPORT IT
	MOV	(SP)+,R2	;TYPE OFFSET -> R2
	MOV	R0,-(SP)	;SAVE DIM INFO
	INC	R3		;ADD ONE TO EACH
	INC	R4		;DIMENSION
	MUL	R4,R3		;PRODUCT -> R3
	BIT	#160000,R3	;TOO BIG?
	BNE	DIM98		;IF SO, DECLARE OVERFLOW
	MOV	R3,R0		;COPY # OF VARIABLES -> R0
	ASH	8$(R2),R0	;SHIFT BY APPROPRIATE AMOUNT
	INC	R0		;ROUND UP, IN CASE
	BIC	#1,R0		;AN ODD # OF BYTE VARIABLES
	MOV	R0,-(SP)	;SAVE ON STACK
	ADD	#4,R0		;ADD HEADER + DIM INFO
	TSTOK			;CHECK FOR ROOM (ENUDAT -> R5)
	BLO	DIM98		;IF NOT ENOUGH ROOM, DECLARE OVERFLOW
	ADD	R5,R0		;R0 POINTS TO NEW END OF DATA
	MOV	R0,ENUDAT	;SET NEW END OF DATA
	MOV	(SP)+,R3	;RESTORE # OF FLOATING TOTAL BYTES
	ASR	R3		;NOW # OF WORDS
	MOV	(SP)+,R2	;POP DIM INFO
	MOV	(SP)+,(R5)+	;HEADER -> DATA AREA
	MOV	R2,(R5)+	;DIM INFO -> DATA AREA
1$:	CLR	(R5)+		;CLEAR THE AREA
	SOB	R3,1$		;R3 TIMES
	BR	7$		;AND GO TO FINAL FINISH
8$:	.WORD	2	;REAL*4
	.WORD	1	;INTEGER
	.WORD	0	;BYTE
	.WORD	3	;REAL*8
;
; STRING SECTION
;
2$:
	JSR	PC,STRGLN	;GO GET SIZE OF INDIVIDUAL ELEMENT
	BVS	DIM99		;IF ERROR, BRANCH
	MOV	R0,(SP)		;SAVE LEN WITH SIGN (OVER TYPE CODE)
	BPL	3$		;NOW GET
	NEG	R0		;ABSOLUTE VALUE
3$:	DIMCHK			;AND CHECK ITS RANGE
	BNE	DIM99		;BRANCH IF ERROR
	MOV	R0,-(SP)	;SAVE ABS VALUE
	JSR	PC,SUBONE	;R3,R4 WITH INDIVIDUAL DIMS, R0 PACKED
	BVS	DIM99		;REPORT ERROR
	MOV	R1,-(SP)	;SAVE TEXT PTR
	MOV	R0,R1		;COPY PACKED SUBSCRIPTS -> R1
	MOV	2(SP),R0	;ABS LEN OF INDIVIDUAL STRING -> R0
	MOV	R1,2(SP)	;PACKED SUBSCRIPTS ON STACK
	STRLEN			;GET TOTAL STRING LEN -> R0
	ADD	#6,R0		;ADD 3 HEADER WORDS
	TSTOK			;CHECK FOR ROOM
	BLO	DIM98		;IF NOT ENOUGH, REPORT ERROR
	MOV	(SP)+,R1	;TEXT PTR
	MOV	(SP)+,R3	;PACKED DIMS
	MOV	(SP)+,R2	;LEN WITH SIGN
	MOV	(SP)+,(R5)+	;HEADER -> DATA AREA
	MOV	R3,(R5)+	;PACKED DIMENSIONS
	TST	R2		;FIXED OR VARIABLE?
	BPL	4$		;IF FIXED, BRANCH
	NEG	R2		;IF VARIABLE, MAKE ABS VALUE
	BIS	#177400,R2	;WITH HIGH BYTE -1
4$:	MOV	R2,(R5)		;PUT LEN AND TYPE AWAY
	BIS	#400,(R5)+	;MAKE SURE NON-ZERO HIGH BYTE
	SUB	#6,R0		;GET LEN INDEP. OF 3 HEADER WORDS
	ASR	R0		;CONVERT LEN TO WORDS
5$:	CLR	(R5)+		;AND CLEAR IT ALL
	SOB	R0,5$		;OUT (NULLS)
	MOV	R5,ENUDAT	;RECORD NEW END OF DATA
7$:	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#',		;SOMETHING TO FOLLOW?
	BEQ	DIM00		;IF SO, DO IT AGAIN
	DEC	R1		;IF NOT, BACK UP TEXT PTR
	JMP	INIT02
DIM97:	DMDERR			;PREVIOUSLY USED NAME
DIM98:	DMVERR			;OVERFLOW
DIM99:	DIMERR			;BAD DIMENSION
;+3
; .S
; .X ^^DIM#_#\\
; .X ^VIRTUAL ARRAYS
; .HEADERLEVEL 1 ^^DIM#_#N,_<EXP>\\
; .BREAK
; ^THIS STATEMENT DECLARES CERTAIN VARIABLES AS "VIRTUAL ARRAYS" AND DEFINES
; THEIR ALLOCATION ON THE FILE WHOSE <LUN IS THE VALUE OF "EXP".
; ^A VIRTUAL ARRAY HAS ITS VALUES STORED ON A FILE AND MAINTAINS ONLY
; A SMALL PART OF THE ARRAY IN MEMORY AT ANY ONE TIME (CURRENTLY 512 BYTES -
; 1 DISK BLOCK).
; ^THE <DIM#_# STATEMENT ONLY DEFINES THE MAPPING OF THE ARRAY ONTO THE FILE.
; ^THE FILE ITSELF MUST BE OPENED VIA AN <OPEN STATEMENT USING THE </BL SWITCH.
; ^CONSEQUENTLY, SEVERAL <DIM#_# STATEMENTS MAY DEFINE SEVERAL MAPPINGS
; OF DIFFERENT VARIABLES ONTO THE SAME FILE WITH AN EFFECT SIMILAR TO A
; <FORTRAN <EQUIVALENCE STATEMENT.
; .FG 1
; ^THE RULES FOR MAPPING FOLLOW <RSTS <BASIC-PLUS.
; ^ESSENTIALLY, NO ARRAY ELEMENT MAY CROSS BLOCK BOUNDARIES.
; ^THIS IMPLIES THAT VARIABLE SIZES MUST BE POWERS OF TWO.
; ^NUMERIC VARIABLES AUTOMATICALLY FULFILL THIS CONDITION.
; ^STRINGS ARE ALLOCATED THEIR SPECIFIED SIZE WHETHER FIXED OR VARIABLE.
; ^VARIABLE LENGTH STRINGS ARE NULL PADDED ON DISK, AND WHEN USED IN A
; PROGRAM CONTEXT ARE AUTOMATICALLY TRIMMED TO THEIR SIZE WITHOUT
; THE NULL PADDING.
; ^FIXED LENGTH VIRTUAL STRINGS, AS WITH STANDARD FIXED LENGTH STRINGS,
; ARE BLANK PADDED.
; ^IF THE ALLOCATION OF A VARIABLE IN A <DIM#_# LIST WOULD CAUSE IT TO
; CROSS BLOCK BOUNDARIES BECAUSE OF PREVIOUS ALLOCATIONS IN THE LIST,
; IT IS STARTED AT THE NEXT DISK BOUNDARY.
; ^SUBSCRIPTS MAY RANGE UP TO 32767 AND STRING ELEMENTS UP TO 512
; CHARACTERS (IN POWERS OF 2).
; .BREAK
; ^EXAMPLE:
; .NF
; ^^
;	{20 DIM _#3,A(20,100),A$[256]V(5000)}
;	{30 DIM _#3,B(20000),B$[128]V(10000)}
;	{40 DIM _#7,X(100),Y(100),Z(200)}
; \\
; .F
;-
DIM01:
	EVAL			;FILE # -> AC0
	STCFI	AC0,R0		;INTEGER -> R0
	BLE	DIM99		;NEG OR ZERO IS ERROR
	CMP	R0,#OP.MXL	;CHECK AGAINST MAX LUN
	BHI	DIM99		;ALLOWED, IF TOO BIG, ERROR
	MOV	R0,-(SP)	;SAVE IT FOR FUTURE USE
	CLR	-(SP)		;SET ACCUMULATED OFFSET
	CLR	-(SP)		;32 BIT ZERO
	SKIP			;NEXT CHAR SHOULD BE
	CMPB	R2,#',		;COMMA
	BNE	DIM99		;ELSE ERROR
1$:	JSR	PC,GETHD5	;VARIABLE NAME -> R4                            ;DSS1
	BVS	DIM99		;IF SYNTAX ERROR, BRANCH                        ;**-1
	BNE	DIM97		;IF ALREADY USED, BRANCH
	BIS	#10000,R4	;SET VIRTUAL FLAG
	MOV	R4,-(SP)	;AND SAVE NAME AND FLAG
	MOV	R0,-(SP)	;SAVE JUMP PTR
	SUB	#10,R0		;DO WE HAVE STRING?
	BGE	3$		;IF SO, BRANCH
	JSR	PC,SUBSUB	;GET SUBSCRIPTS
	BVS	DIM99		;REPORT ANY ERROR
	MOV	(SP)+,R0	;JUMP OFFSET -> R0
	MOV	7$(R0),R2	;ELEMENT LENGTH -> R2
	MOV	R2,-(SP)	;AND ON STACK
	BR	2$		;GO TO COMMON FINISHING CODE
7$:	.WORD	4		;SINGLE PRECISION FLOATING
	.WORD	2		;INTEGER (16 BIT)
	.WORD	1		;BYTE
	.WORD	10		;DOUBLE PRECISION
;
; STRING SECTION
;
3$:
	JSR	PC,STRGLN	;GET LENGTH OF INDIVIDUAL STRING ELEMENT
	MOV	R0,(SP)		;SAVE SIGNED LENGTH (OVER JUMP PTR)
	BPL	4$		;NOW GET
	NEG	R0		;ABS VALUE
4$:	MOV	R0,-(SP)	;SAVE ABS VALUE ON STACK
	MOV	#12,R2		;UP TO 12(8) BITS
	CLR	R3		;THIS IS THE BIT COUNTER
5$:	ASR	R0		;SHIFT BITS OUT
	BCC	6$
	INC	R3		;AND COUNT THEM
6$:	SOB	R2,5$		;WE SHOULD HAVE
	DEC	R3		;ONLY 1 BIT IF
	BNE	DIM99		;LENGTH IS POWER OF 2 (0 NOT ALLOWED)
	TST	R0		;NOTHING SHOULD BE LEFT IN R0 EITHER
	BNE	DIM99		;ELSE BIGGER THAN A BLOCK
	JSR	PC,SUBSUB	;GET ARRAY SUBSCRIPTS
	MOV	(SP)+,R2	;ABS LEN -> R2
	BR	2$		;AND FINISH UP
;
; COMMON CODE FOR VIRTUAL DIMENSION STATEMENT
;
; ON ENTRY (VIA JUMP OR BRANCH)
;	R2 HAS POSITIVE SIZE OF INDIVIDUAL ELEMENT (MUST BE A POWER OF 2)
;	R3 HAS THE FIRST SUBSCRIPT
;	R4 HAS THE 2ND SUBSCRIPT
;	(SP) WITH ITEM LENGTH INCL SIGN IF NEEDED FOR STRINGS
;	2(SP) HAS HEADER WORD
;	4(SP) AND 6(SP) HAVE ACCUMULATED LONG INTEGER OFFSET VALUE
;	10(SP) HAS LUN FOR VIRTUAL ARRAY
;
; EXIT TO REPEATED PART OF CODE (1$)
;	(SP) AND 2(SP) WITH FLOATING ACCUMULATED OFFSET
;	4(SP) WITH LUN
; OR TO STATEMENT INTERPRETER WITH STACK CLEAN
;
2$:
	MOV	R3,-(SP)	;SAVE DIMENSIONS
	MOV	R4,-(SP)	;
	INC	R3		;ACCOUNT FOR ZEROTH ELEMENT
	INC	R4		;
	LDCIF	R3,AC0		;NOW LOAD UP FP ACCUMULATORS
	LDCIF	R4,AC1		;WITH DIMENSIONS (ADJUSTED FOR 0TH ELEMENTS)
	MULF	AC1,AC0		;GET PRODUCT -> AC0
	LDCIF	R2,AC1		;ELEMENT SIZE -> AC1
	MULF	AC1,AC0		;TOTAL # OF BYTES -> AC0
	MOV	#16,R0		;SIZE OF VIRTUAL DATA ITEM
	TSTOK			;ENOUGH ROOM?
	BLO	DIM98		;IF NOT, BRANCH
	ADD	R0,ENUDAT	;UPDATE END OF USER DATA
	MOV	(SP)+,R4	;RESTORE DIMENSIONS
	MOV	(SP)+,R3	;
	MOV	(SP)+,R0	;SIGNED ELEMENT LENGTH -> R0
	MOV	(SP)+,(R5)+	;STORE HEADER WITH NAME
	MOV	R3,(R5)+	;SAVE 1ST SUBSCRIPT
	MOV	R4,(R5)+	;AND 2ND
	MOV	4(SP),(R5)+	;LUN -> DATA BLOCK
	MOV	R0,(R5)+	;SIGNED ELEMENT LENGTH
;
; FOLLOWING CODE ROUNDS UP ACCUMULATED OFFSET IN
; ACCORD WITH RSTS BASIC+ RULES FOR VIRTUAL ARRAY ALLOCATION
;
	MOV	R2,R4		;ELEMENT LENGTH -> R4
	MOV	2(SP),R2	;LOWER 16 BITS -> R2
	MOV	#1000,R3
	BIC	#177000,R2	;GET # BYTES OVER EVEN BLOCK
	SUB	R2,R3		;# REMAINING BYTES IN BLOCK -> R3
	CLR	R2		;GET SET FOR DIVIDE
	DIV	R4,R2		;DIVIDE BY ELEMENT SIZE
	TST	R3		;CHECK REMAINDER
	BEQ	8$		;IF ZERO, NO ROUND UP
	BIC	#777,2(SP)	;CLEAR BYTE OFFSET
	ADD	#1000,2(SP)	;GET TO START OF NEXT BLOCK
	ADC	(SP)		;AND MAKE SURE OF DOUBLE PRECISION ADD
8$:	SETL			;SET LONG INTEGER MODE
	LDCLF	(SP)+,AC2	;RESULT -> AC2
	STCFL	AC2,(R5)+	;STORE IT AWAY IN DATA BLOCK
	ADDF	AC0,AC2		;NEW OFFSET -> AC2
	STCFL	AC2,-(SP)	;STORE IT
	SETI			;RESET 16 BIT INTEGER MODE
;
	SKIP			;DO WE HAVE
	CMPB	R2,#',		;MORE ITEMS?
	BEQ	1$		;IF SO, LOOP AROUND
	DEC	R1		;ELSE BACK UP TEXT PTR
	ADD	#6,SP		;CLEAN STACK
	JMP	INIT02		;AND GO BACK TO STATEMENT INTERPRETER
;
; SUBROUTINE STRGLN FOR USE WITH DIM STATEMENT
; ON ENTRY:
;	R1 POINTS JUST PAST '$'
; ON EXIT:
;	R1 POINTS JUST PAST LEN INFO [IF THERE]
;	R0 HAS LEN (+ FOR FIXED, - FOR VAR)
;	'V' SET IF SYNTAX ERROR
; OTHER REGISTERS USED: R2
;
STRGLN:	SKIP			;NEXT CHAR -> R2
	MOV	#17,R0		;SET DEFAULT LENGTH OF 15 DECIMAL
	CMPB	R2,#'[		;DO WE HAVE LENGTH?
	BNE	1$		;IF NOT, BRANCH
	ATOI			;IF SO, GET IT -> R0
	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#']		;IS IT CLOSE BRACKET?
	BNE	3$		;IF NOT, BRANCH TO ERROR RETURN
	SKIP			;NEXT CHAR -> R2
1$:	CMPB	R2,#'V		;VARIABLE LEN STRING?
	BEQ	2$		;IF SO, BRANCH
	DEC	R1		;IF NOT, BACK UP PTR
	RTS	PC		;AND RETURN
2$:	NEG	R0		;INDICATE VARIABLE LENGTH
	RTS	PC		;RETURN
3$:	SEV			;SET ERROR
	RTS	PC		;RETURN
;
; SUBROUTINE SUBSUB TO RETURN SUBSCRIPT VALUES FOR DIM
; ON ENTRY:
;	R1 POINTS TO START OF INFO [OPEN PAREN]
; ON EXIT:
;	R1 POINTS PAST END OF SUBSCRIPT INFO [PAST CLOSE PAREN]
;	R3 HAS FIRST SUBSCRIPT VALUE
;	R4 HAS 2ND SUBSCRIPT VALUE (0 IF NONE SPEC'D)
;	'V' SET IF SYNTAX ERROR
; OTHER REGISTERS USED: R2,R0
;
SUBSUB:
	SKIP			;FIRST CHAR -> R2
	CMPB	R2,#'(		;START OF SUBSCRIPT?
	BNE	3$		;IF NOT, BRANCH AND RETURN ZEROES
	ATOI			;CONVERT 1ST NUMBER
	MOV	R0,-(SP)	;SAVE NUMBER
	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#',		;ANOTHER SUBSCRIPT?
	BNE	1$		;IF NOT, BRANCH
	ATOI			;IF SO, CONVERT IT
	SKIP			;GET FOLLOWING CHAR -> R2
	MOV	R0,R4		;2ND VALUE -> R4
2$:	MOV	(SP)+,R3	;1ST VALUE -> R3
	CMPB	R2,#')		;FINAL CLOSE PAREN?
	BNE	4$		;IF NOT, SET ERROR
	RTS	PC		;ELSE RETURN NICELY
1$:	CLR	R4		;SET ZERO 2ND SUBSCRIPT
	BR	2$		;AND FINISH UP
3$:	DEC	R1		;BACK UP TEXT PTR
	CLR	R3		;SET ZERO
	CLR	R4		;SUBSCRIPTS
	RTS	PC		;AND RETURN
4$:	SEV			;SET ERROR BIT
	RTS	PC		;AND RETURN
;
; SUBROUTINE SUBONE
; TO GET SUBSCRIPTS VIA SUBSUB AND CHECK
; THEM FOR IMMEDIATE (NON-VIRTUAL) USE.
; ON ENTRY:
;	R1 = TEXT PTR
; ON EXIT:
;	R1 POINTS PAST CLOSE PAREN
;	R3 HAS 1ST SUBSCRIPT
;	R4 HAS 2ND SUBSCRIPT
;	R0 HAS PACKED SUBSCRIPTS
;	'V' SET IF ERROR
; OTHER REGISTERS USED: R2
;
SUBONE:	JSR	PC,SUBSUB	;GET SUBSCRIPTS
	BVS	1$		;ON ERROR BRANCH
	MOV	R4,R0		;CHECK 2ND SUBSCRIPT
	DIMCHK
	BNE	1$		;IF TOO BIG, ERROR
	MOV	R3,R0		;NOW CHECK FIRST SUBSCRIPT
	DIMCHK
	BNE	1$		;IF TOO BIG, DECLARE ERROR
	SWAB	R0		;SET COMBINED SUBSCRIPTS
	BISB	R4,R0		;IN R0
	RTS	PC
1$:	SEV			;INDICATE ERROR
	RTS	PC

	.SBTTL	DEF00 - DEFINE FUNCTION STATEMENT
;+3
; .SKIP
; .X ^^DEF\\
; .X ^FUNCTION - USER
; .X ^USER DEFINED FUNCTIONS
; .HEADERLEVEL 1 <DEF
; .BREAK
; ^ONE LINE FUNCTION DEFINITION.
; ^THE FUNCTION NAME IS FORMED WITH THE LETTERS ^F^N FOLLOWED BY ANY
; LEGAL VARIABLE NAME.
; E.G.: ^^FNA, FNX1, FNM$\\ ETC.
; ^DUMMY ARGUMENTS MAY BE ANY NUMERIC OR STRING VARIABLE WITH ANY
; NUMBER OF ARGUMENTS SUBJECT TO FITTING ON ONE LINE.
; ^THE DEFINITION ITSELF MAY BE ANY LEGAL NUMERIC OR STRING EXPRESSION
; INCLUDING SYSTEM AND OTHER USER FUNCTIONS.
; .FG 1
; ^FUNCTION NAMES RETURNING STRING VALUES MUST END IN '$', THOSE
; RETURNING NUMERIC VALUES MUST NOT.
; ^FUNCTIONS ARE RECURSIVE, I.E. THEY MAY USE THEMSELVES AS ARGUMENTS
; IN THE FUNCTION CALL.
; .SKIP
; ^FUNCTION DEFINITIONS CREATE AN INTERNAL POINTER TO THE ^^ASCII\\
; TEXT TO THE RIGHT OF THE EQUAL SIGN.
; ^FOR THIS REASON THEY SHOULD BE PLACED NEAR THE BEGINNING OF THE
; PROGRAM TO AVOID BEING MOVED DURING DEBUGGING RUNS BY INSERTIONS,
; DELETIONS OR CHANGES TO LINES PRECEDING THE FUNCTION DEFINITION.
; .SKIP
; ^FUNCTION DEFINITIONS ARE DELETED BY THE ^^CHAIN\\ STATEMENT.
; .SKIP
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 DEF FNA1(A)=A^2}
;	{40 DEF FNC$(X$)=X$+"ABC"}
;	{50 DEF FNZ3$(X$,I)=SEG$(X$,I,LEN(X$))}
; \\
; .FILL
;-
; DEFINE STATEMENTS ARE DONE HERE - ONE TABLE ENTRY IS MADE, CONFLICTS
;	ARE NOT CHECKED.  REGISTERS USED - R1,R2,R4.
;
DEF00:	SKIP			;GET NEXT CHAR
	CMPB	R2,#S.FN	;IS IT 'FN' TOKEN
	BNE	DEF99		;NO, BAD STATEMENT
	GETVAR			;LOOK FOR A VARIABLE NAME
	BVS	DEF99		;IF NONE, ERROR
	CMPB	R2,#'$		;IS IT STRING FCN?
	BNE	2$		;IF NOT, BRANCH
	BIS	#100000,R4	;SET STRING FCN TYPE
	SKIP
	BR	1$
2$:	BIS	#060000,R4	;SET NUM FCN TYPE
1$:	CLR	R0		;IS FCN DEFINED ALREADY
	MOV	STUDAT,R3
	SRLST
	BNE	DEF99		;SUCCESS IS FAILURE
	MOV	ENUDAT,R5
	MOV	R4,R0		;PUSH HEADER ON STACK
	PUSH
	CMP	R2,#'(		;IS THE REQUIRED LEFT PAREN PRESENT?
	BNE	DEF99		;NO
	MOV	R5,R3		;SAVE ADDRESS FOR NUM OF PARAMS
	CLR	R0
	PUSH
	PUSH			;SPACE FOR PAST = ADDRESS
	CMPB	R2,#'(		;DO WE HAVE PARAMS
	BNE	DEF99		;IF NOT, ERROR
5$:	GETVAR			;GET DUMMY NAME
	BVS	DEF99		;IF BAD, ERROR
	CMPB	R2,#'$		;IS IT STRING?
	BNE	3$		;IF YES,
	BIS	#120000,R4	;SET STRING TYPE
	SKIP
3$:	MOV	R4,R0		;PUT IT IN USER AREA
	PUSH
	INC	(R3)		;COUNT IT
	CMPB	R2,#')		;ARE WE AT END OF PARAMS
	BEQ	4$		;IF SO, BRANCH OUT OF LOOP
	CMPB	R2,#',		;COMMA SEPARATOR?
	BEQ	5$		;IF SO, GET NEXT PARAM
	BR	DEF99		;ELSE ERROR
4$:	SKIP
	CMPB	R2,#'=		;IS NEXT CHAR '='
	BNE	DEF99		;ERROR IF NOT
	MOV	R1,2(R3)	;PUT ADDRESS IN ITS PLACE
	SUB	USR,2(R3)	;MAKE IT INTO OFFSET FROM START OF PROGRAM
	MOV	R5,ENUDAT	;MAKE FCN ITEM PERMANENT
	JUNKIT			;SKIP REST OF DEFINITION
	MOVB	(R1)+,R2	;TERMINATOR -> R2 (EVEN S.EOL1)
	JMP	INIT03		;AND PROCEED
DEF99:	DEFERR			;HORRIBLE ERROR!!!

	.SBTTL	EVAL00 - EVALUATE AN ARITHMETIC EXPRESSION
;
; EVAL - EVAL00, EVALUATE AN ARITHMETIC EXPRESSION.  UPON ENTRY, R1
;	POINTS TO THE CURRENT TEXT POSITION.  ON EXIT AC0 CONTAINS
;	THE NUMERIC VALUE OF THE EXPRESSION.  REGISTERS USED - ALL.
;	V-BIT WILL BE SET IF EXPRESSION TERMINATED BY ')', CLEAR OTHERWISE.
;	ON V SET, R1 POINTS PAST CLOSE PAREN
;	ON V CLEAR, R1 POINTS TO TERMINATING CHAR
;
EVAL00:	CLR	R0
	TSTOK			;CHECK FOR BACKUP ROOM
	BLO	EVAL18		;ON ERROR, BRANCH
	PUSH			;CLEAR THE PAREN COUNT
	MOV	#-1,-(SP)	;PUSH NULL (-1) ON STACK
EVAL02:	SKIP			;GET A NON-BLANK CHARACTER
	CMP	R2,#'+		;IS THIS A UNARY PLUS?
	BEQ	EVAL03		;YES, IGNORE IT
	CMP	R2,#'-		;IS IT A UNARY MINUS?
	BNE	EVAL01		;NO
	MOV	R2,R0		;YES, SET OPERAND2=0
	CLRF	AC0		;AND PUT THE OPERATOR IN R0
	BR	EVAL05
EVAL03:	SKIP			;GET ACHARACTER
EVAL01:	CMP	R2,#'(		;IS OPERAND AN OPEN PAREN?
	BNE	EVAL04		;NO, GET A REAL OPERAND
	CLR	-(SP)		;PUSH A NULL ON THE STACK
	INC	-2(R5)		;INCREMENT THE PAREN COUNT
	BR	EVAL02		;GO BACK AND DO IT AGAIN
EVAL05:	STF	AC0,-(SP)	;PUSH OPERAND ON THE STACK
	MOV	R0,-(SP)	;   OPERATOR ON STACK
	BR	EVAL03		;AND GO BACK AROUND
EVAL04:	DEC	R1		;MOVE CHARACTER POINTER BACK ONE
	MOV	-(R5),-(SP)	;SAVE PAREN COUNT
	JSR	PC,GTP00	;GET AN OPERAND
	MOV	ENUDAT,R5	;RESTORE R5
	MOV	(SP)+,(R5)+	;RESTORE THE PAREN COUNT
EVAL12:	MOV	R2,-(SP)	;SAVE R2
	SKIP			;GET A CHARACTER
	MOV	#EVAL07+7,R0	;GET ADDRESS OF LIST
GTPR01:	CMPB	-(R0),R2	;IS IT A LEGAL OPERATOR?
	BEQ	GTPR02		;JUMP IF LEGAL
	CMP	R0,#EVAL07+1	;HAS SEARCH FAILED?
	BHI	GTPR01		;NO
	CLR	R0		;YES - SET ZERO AND BACK UP POINTER
	DEC	R1		; TO POINT AT FAILURE
GTPR03:	MOV	(SP)+,R2	;RESTORE R2
	BR	EVAL19		;AND CONTINUE
GTPR02:	MOV	R2,R0		;PUT A CHARACTER IN R0
	BR	GTPR03
EVAL19:	TST	@SP		;IS STACK NULL?
	BLE	EVAL17
EVAL06:	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
	MOV	#EVAL07+7,R1	;GET THE TABLE ADDRESS
EVAL08:	CMPB	-(R1),R0		;FIND OPERATOR2
	BNE	EVAL08		;IT MUST BE FOUND
	ASR	R1		;GET RID OF THE BYTE POINTER
	MOV	R1,(R5)+	;PUT RESULT ON USER LIST FOR A WHILE
	MOV	#EVAL07+7,R1	;GET TABLE ADDRESS AGAIN
EVAL09:	CMPB	-(R1),2(SP)	;FIND OPERATOR1
	BNE	EVAL09		;IT MUST BE THERE
	ASR	R1		;CLEAR LOW ORDER BIT
	MOV	R1,(R5)+	;SAVE IT FOR NOW
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	CMP	-(R5),-(R5)	;COMPARE OPERATOR1 WITH OPERATOR2
	BLT	EVAL05		;GO BACK IF PRECEDENCE IS WRONG
	MOV	R0,(R5)+	;SAVE OPERATOR2 FOR NOW
	MOV	#EVAL07+7,R0
EVAL10:	CMPB	-(R0),@SP	;FIND APPROPRIATE OPERATOR IN LIST
	BNE	EVAL10		;IT MUST BE FOUND
	SUB	#EVAL07+2,R0	;GET DISPLACEMENT
	ASL	R0
	ASL	R0
	ADD	#EVAL11,R0	;WE NOW HAVE THE ROUTINE ADDRESS
	MOV	R0,(R5)+	;SAVE IT
	TST	(SP)+		;DISCARD OLD OPERATOR1
	LDF	AC0,AC1		;PUT SOURCE IN AC1
	LDF	(SP)+,AC0	;AND DEST IN AC0
	MOV	-(R5),R2	;ROUTINE ADDRESS
	JSR	PC,(R2)		;GO COMPUTE VALUE
	MOV	-(R5),R0	;RESTORE OPERATOR2
	TST	@SP		;IS STACK NULL?
	BGT	EVAL06		;NO, TAKE CARE OF REST OF STACK
EVAL17:	CMP	R0,#')		;IS OPERATOR2 A CLOSED PAREN?
	BEQ	EVAL14		;YES
	TST	R0		;NO, IS IT NULL?
	BGT	EVAL05		;NOT NULL - GO BACK
	TST	-(R5)		;IS THE PAREN COUNT ZERO?
	BNE	EVAL13		;NO
	TST	(SP)+		;POP NULL
	CCC
	RTS	PC		;RETURN WITH RESULT IN R2,R3,R4.
EVAL13:	PARERR			;PAREN COUNT BAD
EVAL14:	TST	-(R5)		;IS PAREN COUNT ZERO?
	BNE	EVAL15		;NO
EVAL16:	TST	(SP)+		;POP NULL
	SEV			;YES, ERROR - BUT DON'T TELL USER YET
	RTS	PC
EVAL15:	TST	@SP		;JUMP
	BLT	EVAL16		;IF NULL = -1
	TST	(SP)+		;POP NULL
	DEC	(R5)+		;DECREMENT PAREN COUNT
	BR	EVAL12		;AND DO IT AGAIN
EVAL18:	OVFERR
EVAL07:	.BYTE	0,')		;DO NOT
	.BYTE	'+,'-		; CHANGE
	.BYTE	'*,'/		;  THE ORDER
	.BYTE	'^		;   OF THIS TABLE
	.EVEN
; END OF TABLE REFERENCED AT: EVAL06+2, EVAL08+8, EVAL10-2
; ARGUMENTS ARE FIRST IN AC0, SECOND IN AC1
EVAL11:	ADDF	AC1,AC0		;DO AN ADD
	RTS	PC
	SUBF	AC1,AC0		;DO A SUBTRACT
	RTS	PC
	MULF	AC1,AC0		;DO A MULTIPLY
	RTS	PC
	DIVF	AC1,AC0		;DO A DIVIDE
	RTS	PC
	JMP	PWRF00		;POWER IS EXTERNAL TO HERE

	.SBTTL	GTP00 - GET AN OPERAND
;
; GETOP - GTP00, GET AN OPERAND.
; ON ENTRY:
;	R1 POINTS TO START OF OPERAND
;
; ON EXIT:
;	R1 POINTS TO NEXT CHAR AFTER SCAN ENDED
;	AC0 HAS VALUE OF OPERAND
;
; OTHER REGISTERS USED: POTENTIALLY ALL
;
; NOTE: THIS ROUTINE MUST BE RE-ENTRANT SINCE IT MAY RE-ENTER ITSELF
;	VIA CALLS TO "EVAL".
;
GTP00:	MOV	R1,-(SP)	;SAVE TEXT BACKUP POINTER
	SKIP			;GET FIRST CHARACTER
	BIC	#177400,R2	;CLEAR SIGN EXTEND
	CMPB	R2,#S.SAST	;IN FCN RANGE?
	BLO	3$		;IF BELOW, TRY FOR SOMETHING ELSE
	CMPB	R2,#S.SAEN	;PAST END OF SINGLE ARG FCNS?
	BHI	1$		;IF SO, TRY FOR OTHER FUNCTION TYPE
	SUB	#140,R2		;CALCULATE TABLE
	ASL	R2		;OFFSET
	MOV	R2,-(SP)	;AND SAVE IT
	EVAL			;ARG VALUE -> AC0
	BVC	21$		;IF NO CLOSE PAREN, ERROR
	MOV	(SP)+,R2	;RESTORE TABLE OFFSET
	TST	(SP)+		;REMOVE BACKUP TEXT POINTER
	JSR	PC,@INIT12(R2)	;GO TO THE ROUTINE
	RTS	PC
1$:	CMPB	R2,#S.NFBO	;PAST END NUMERIC FCNS?
	BHI	2$		;IF SO, ERROR
	SUB	#140,R2		;CALCULATE TABLE
	ASL	R2		;OFFSET
	MOV	ENUDAT,(SP)	;COVER TEXT PTR WITH EOD PTR
	CLR	-(SP)		;SLOT FOR TEXT PTR
	JSR	PC,@INIT12(R2)	;GO TO ROUTINE
	MOV	(SP)+,R1	;GET PROPER END OF TEXT PTR
	MOV	(SP)+,ENUDAT	;AND END OF USER DATA
	RTS	PC
2$:	CMPB	R2,#S.FN	;USER FCN?
	BEQ	7$		;IF SO, GO DO IT
	BNE	6$		;IF NOT, ERROR
3$:	TSTCH
	BVS	15$		;JUMP IF BAD OPERAND
	BNE	9$		;JUMP IF NOT NUMERIC
18$:	MOV	(SP)+,R1	;RESTORE CHARACTER POINTER
	ATOF			;CONVERT THE NUMBER, IGNORING ERROR FLAGS
	BVS	6$
	RTS	PC
15$:	CMP	R2,#'.		;DOES THE NUMBER START WITH "."?
	BEQ	18$		;YES
	BR	6$		;NO
7$:	GETVAR			;GET FOLLOWING VARIABLE NAME
	BVS	6$		;ERROR IF NO VARIABLE NAME AFTER "FN"
	MOV	STUDAT,R3	;GET ADDRESS OF USER STORAGE
	CLR	R0		;SET ZERO MASK FOR THE SEARCH
	BIS	#060000,R4	;SET CLASS 3
	SRLST			;SEARCH THE LIST FOR THE ITEM
	BEQ	6$		;GO REPORT ERROR IF NOT DEFINED
	JSR	PC,FNSET	;GO SET UP PARAMS
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R0,R1		;PUT DEF ADDRESS IN R1
	EVAL
	BVC	20$		;NO ')' ALLOWED
21$:	PARERR			;ERROR IF NOT
6$:	ILFERR
20$:	SKIP			;NEXT CHAR IN FCN DEF -> R2
	CMPB	R2,#S.EOS1	;AT END OF STATEMENT?
	BLO	6$		;IF NOT, ERROR
	MOV	(SP)+,R1	;RESTORE R1
	JSR	PC,FNCLR	;CLEAN UP MESS WE'VE MADE
	TST	(SP)+		;CLEAR BACKUP TEXT POINTER
	RTS	PC
9$:	MOV	(SP)+,R1	;IT'S A VARIABLE, RESTORE POINTER
	JSR	PC,GETHDR	;GET HEADER ADDRESS OF VARIABLE
                                                                                ;DSS1
	.IF	NDF,DEFVAR	;IF NO AUTOMATIC VARIABLE DEFINITION            ;DSS1
	BEQ	12$		;VARIABLE NOT DEFINED....ERROR                  ;DSS1
	.ENDC                                                                   ;DSS1
                                                                                ;DSS1
	JMP	@11$(R0)		;GO TO APPROPRIATE ROUTINE              ;**-1
11$:	.WORD	13$	;REAL*4
	.WORD	13$	;INTEGER
	.WORD	13$	;BYTE
	.WORD	12$	;REAL*8
	.WORD	VTMR	;STRING (ERROR 52)                                      ;DSS1
12$:	NXVERR			;NON-EXISTENT VARIABLE
	CLRF	AC0		;ZERO RESULT PASSED BACK
	RTS	PC
13$:	JSR	PC,GTOFFS	;GET THE OFFSET
	JSR	PC,GETNUM	;AND THE NUMBER
	RTS	PC
	.SBTTL	LEN00 - LENGTH OF STRING FUNCTION
	.SBTTL	FNSET - PARAM SETUP FOR USER FCN
;
; FNSET - SET UP PARAMS FOR FUNCTION CALL
; RETURN ADDRESS IS PULLED FROM STACK AND STACK IS USED
; TO STORE INFO ON ALREADY DEFINED DUMMY PARAMS. ENTRIES
; FOR DUMMY PARAMS ARE PUT INTO USER AREA AND NAMES FOR
; PREVIOUSLY DEFINED DUMMY PARAMS ARE ZEROED.
; ON CALL:
;	R3 POINTS TO FCN ENTRY
;	R1 POINTS TO FIRST ACTUAL ARG IN LIST
; ON EXIT:
;	R1 POINTS PAST CLOSING ')'
;	R0 POINTS PAST = SIGN FOR FCN DEF
;
FNSET:	MOV	(SP)+,R2	;POP RETURN ADDRESS
	MOV	ENUDAT,-(SP)	;SAVE ENUDAT
	CLR	-(SP)		;SET BOUNDARY FOR ARG INFO
	MOV	R2,-(SP)	;PUT BACK RETURN ADDRESS
	TST	(R3)+		;PUSH PAST HEADER
	MOV	(R3)+,R0	;COUNT IN R0
	MOV	(R3)+,R2	;ADDRESS OF PAST = SIGN IN R2
6$:	MOV	(R3)+,R4	;NEXT DUMMY ARG IN R4
	LDCIF	R2,AC1		;SAVE A FEW REGISTERS FOR A WHILE
	LDCIF	R3,AC2
	LDCIF	R0,AC3
	MOV	STUDAT,R3
	CLR	R0
	SRLST			;IS DUMMY DEFINED?
	BEQ	1$		;IF NOT FOUND, THINGS ARE EASY
	MOV	(SP)+,R2	;RETURN ADDRESS IN R2
	MOV	(R3),-(SP)	;SAVE HEADER
	MOV	R3,-(SP)	;AND ITS ADDRESS
	MOV	R2,-(SP)	;PUT BACK RETURN ADDRESS
1$:	STCFI	AC1,-(SP)	;SAVE REGISTERS 	(R2)
	STCFI	AC2,-(SP)	;FOR REENTRANCE		(R3)
	STCFI	AC3,-(SP)	;			(R0)
	MOV	R4,-(SP)	;SAVE PARAM NAME
	BIT	#020000,R4	;STRING PARAM?
	BNE	2$		;IF SO, BRANCH
	EVAL			;EVALUATE ACTUAL PARAM
	BVC	10$		;BACK UP IF CLOSE PAREN
	DEC	R1
10$:	SKIP
	MOV	#10,R0		;CHECK FOR ROOM
	TSTOK
	BLO	14$		;IF NO ROOM, BRANCH
	MOV	(SP)+,(R5)+	;PUT AWAY NAME
	CLR	(R5)+		;ZERO DIMENSIONS
	STF	AC0,(R5)+	;STORE VALUE
	MOV	R5,ENUDAT	;MAKE IT SEMI-PERMANENT
	BR	4$
2$:	MOV	#10,R0		;MAKE ROOM FOR STRING HEADER INFO
	TSTOK
	BHIS	9$
14$:	OVFERR
9$:	MOV	#160006,(R5)	;SAFEGUARD THESE FOUR WORDS
	ADD	R0,R5
	MOV	ENUDAT,-(SP)	;SAVE OLD END OF USER LIST
	MOV	R5,ENUDAT	;CREATE NEW END
	EVALS			;GET STRING, ADD -> R3, LEN -> R4
	BVS	7$		;REPORT ERROR
	MOV	(SP)+,R5	;RESTORE OLD R5
	MOV	(SP)+,(R5)+	;PUSH NAME
	CLR	(R5)+		;ZERO DIMENSIONS
	MOV	R4,(R5)+	;AND LEN ALONG WITH FIXED TYPE
	MOVB	R4,(R5)+	;ACTUAL LEN
	BEQ	13$
3$:	MOVB	(R3)+,(R5)+	;AND STRING ITSELF
	SOB	R4,3$
13$:	INC	R5		;ROUND R5 UP TO EVEN
	BIC	#1,R5		;BOUNDARY
	MOV	R5,ENUDAT
	SKIP			;GET NEXT CHAR IN R2 (NOT DONE BY EVALS)
4$:	MOV	(SP)+,R0	;RESTORE COUNT OF ARGS
	MOV	(SP)+,R3	;AND ARG ADDRESS
	CMPB	#'),R2		;AT END OF ACTUAL PARAMS?
	BEQ	8$		;IF SO, BRANCH
	CMPB	#',,R2		;IS IT COMMA
	BEQ	5$		;IT BETTER BE
7$:	ILFERR
5$:	MOV	(SP)+,R2	;ADD OF PAST = SIGN IN R2
	DEC	R0		;DEC AND DO IT AGAIN
	BEQ	7$		;SHOULD NEVER GET TO ZERO
	JMP	6$
8$:	DEC	R0		;IF COUNT WAS 1, OK
	BNE	7$		;ANYTHING ELSE = BAD NEWS
	MOV	(SP)+,R0	;ADD OF PAST = SIGN IN R0
	ADD	USR,R0		;MAKE INTO REAL ADDRESS
	MOV	SP,R2		;GET ADDRESS OF LIST OF
	TST	(R2)+		;BLANKED PARAMS
11$:	MOV	(R2)+,R3	;ADDRESS OF PARAM
	BEQ	12$		;ZERO MEANS END OF LIST
	BIC	#7777,(R3)	;CLEAR OUT NAME
	TST	(R2)+		;SKIP OVER OLD NAME
	BR	11$		;DO ALL OF THEM
12$:	RTS	PC		;RETURN WITH SAVED INFO ON STACK
;
; SUBROUTINE TO RESET DATA ITEMS AFTER
; FUNCTION EVALUATION.
; REGISTERS USED: R2,R0
;
FNCLR:	MOV	(SP)+,R0	;SAVE RETURN ADD
1$:	MOV	(SP)+,R3	;ADD OF DATA ITEM
	BEQ	2$		;BR IF AT END
	MOV	(SP)+,(R3)	;RESTORE OLD NAME
	BR	1$
2$:	MOV	(SP)+,ENUDAT	;GET US BACK TO WHERE WE WERE
	MOV	R0,-(SP)	;PUT BACK RETURN ADD
	RTS	PC

	.SBTTL	EVLS00 - EVALUATE A STRING EXPRESSION
;
; EVALS, EVLS00 - EVALUATE A STRING EXPRESSION OF THE FORM:
;	STRE1 + [STRE2 + ...]
;	WHERE:
;		STRE1 AND STRE2 ARE STRING ELEMENTS
;	A STRING ELEMENT MAY BE:
;		A STRING CONSTANT (IN DOUBLE QUOTES)
;		A STRING VARIABLE (ENDING IN '$')
;		A STRING FUNCTION (SYSTEM OR USER DEFINED)
; ON ENTRY:
;	R1 POINTS TO START OF PROGRAM TEXT WITH STRING EXPRESSION
;
; ON EXIT:
;	R1 POINTS TO FIRST CHAR PAST END OF EXPRESSION
;	R3 HAS ADDRESS (IN FREE SPACE)
;	R4 HAS LEN
;	'V' SET FOR BAD STRING EXPRESSION AND R1 AS ON ENTRY
;
EVLS00:
	MOV	#2,R0		;CHECK FOR HEADER ROOM ONLY
	TSTOK			;(ENUDAT -> R5)
	BLO	18$		;IF NOT ENOUGH ROOM, BRANCH
	MOV	R5,-(SP)	;SAVE HEADER ADDRESS (AND ORIGINAL ENUDAT)
	MOV	#160000,(R5)+	;SET UP HEADER WITH NO LENGTH
	MOV	R1,-(SP)	;SAVE TEXT PTR
3$:
	MOV	R5,-(SP)	;SAVE CURRENT POSITION OF R5 (END OF
				;ACCUMULATED STRING)
	INC	R5		;ROUND IT UP
	BIC	#1,R5
	MOV	R5,ENUDAT	;AND PROTECT WHAT WE ALREADY HAVE
	JSR	PC,GSTR00	;GET STRING ELEMENT (WHICH MAY IN
				;TURN EVALUATE A STRING)
	BVS	4$		;IF ERROR, BRANCH
	BLE	2$		;IF ZERO OR LESS, BRANCH
	MOV	R4,R0		;LEN OF OPERAND -> R0
	MOV	R3,-(SP)	;SAVE ADDRESS
	TSTOK			;CHECK FOR ROOM
	BLO	18$		;IF NOT ENOUGH, BRANCH
	MOV	(SP)+,R3	;RESTORE STRING ELEMENT ADDRESS
	MOV	(SP)+,R5	;AND CURRENT END OF STRING
	MOV	@2(SP),R2	;HEADER -> R2
	BIC	#160000,R2	;CLEAR DATA TYPE
	ADD	R0,R2		;ADD IN NEW LEN
	BIT	#160000,R2	;IS IT TOO BIG?
	BNE	18$		;IF SO, BRANCH
	BIS	#160000,R2	;SET HEADER TYPE
	MOV	R2,@2(SP)	;AND STORE IT AWAY
1$:	MOVB	(R3)+,(R5)+	;MOVE IN NEW ELEMENT
	SOB	R0,1$
	MOV	R5,-(SP)	;JUST TO KEEP STACK STRAIGHT
2$:	MOV	(SP)+,R5	;RESTORE R5 (END OF ACCUM STRING)
	SKIP			;NEXT TEXT CHAR
	CMPB	R2,#'+		;MORE ELEMENTS?
	BEQ	3$		;IF SO, GO ADD THEM
	DEC	R1		;ELSE BACK UP
	TST	(SP)+		;POP OLD R1
	MOV	(SP)+,R3	;ADDRESS OF HEADER -> R3
	MOV	R3,ENUDAT	;ALSO RESTORE ORIGINAL END OF DATA
	MOV	(R3)+,R4	;HEADER -> R4, R3 AT STRING START
	BIC	#160000,R4	;CLEAR HEADER TYPE, LEAVING LENGTH
	CCC			;SET SUCCESS
	RTS	PC
4$:	TST	(SP)+		;POP END OF ACCUM STRING
	MOV	(SP)+,R1	;RESTORE R1 AS WE ENTERED
	MOV	(SP)+,ENUDAT	;AND END OF USER DATA
	CLR	R4		;ZERO LEN
	SEV			;NO EXPRESSION
	RTS	PC
18$:	OVFERR

	.SBTTL	GSTR00 - GET A STRING OPERAND
;
; GSTR, GSTR00 - GET A STRING OPERAND
;
;	AT END OF SUCCESSFUL COMPLETION OF THIS ROUTINE,
;	R3 CONTAINS AN INDIVIDUAL STRING ADDRESS AND R4
;	CONTAINS ITS LENGTH
;
GSTR00:	SKIP			;GET NEXT TEXT CHAR
	BIC	#177400,R2	;CLEAR OUT SIGN EXTEND
	CMPB	R2,#S.SFST	;ARE WE IN RANGE OF STRING FUNCTION TOKENS?
	BLO	1$		;IF NOT, TRY SOMETHING ELSE
	CMPB	R2,#S.SFEN	;OVER THE TOP?
	BHI	2$		;IF SO, GO LOOK FOR USER FUNCTION
	SUB	#140,R2		;MAKE R2 INTO JUMP TABLE OFFSET
	ASL	R2
	JSR	PC,@INIT12(R2)	;GO TO FUNCTION
	TST	R4		;SET LENGTH CONDITION CODES
	RTS	PC		;AND GO BACK WHER WE CAME FROM
2$:	CMPB	R2,#S.FN	;USER FUNCTION DEFINITION?
	BEQ	GSTR01		;IF SO, GO TO THAT CODE
	BR	GSTR09		;IF NOT, ERROR
1$:	TSTCH			;WHAT IS IT
	BVS	GSTR10		;NOT ALPHANUM MAYBE "
	BEQ	GSTR09		;NUMBER=ERROR
GSTR06:	DEC	R1		;RESTORE TEXT POINTER
	JSR	PC,GETHDR	;GET HEADER ADDRESS
	BVS	GSTR09		;ERROR IN VAR                                   ;DSS1
                                                                                ;DSS1
	.IF	NDF,DEFVAR	;IF NO AUTOMATIC VARIABLE DEFINITION            ;DSS1
	BEQ	GSTR09		;NO VARIABLE                                    ;DSS1
	.ENDC                                                                   ;DSS1
                                                                                ;DSS1
	CMP	#10,R0		;IS THIS A STRING?                              ;**-2
	BNE	GSTR09		;IF NOT, REPORT ERROR
	JSR	PC,GTOFFS	;GET THE OFFSET
	MOV	R3,R0		;HEADER ADDRESS -> R0
	JSR	PC,GETSTR	;AND THE STRING ITSELF
GSTR02:	TST	R4		;SET CONDITION CODES ON LENGTH
	RTS	PC		;BACK TO CALLER
GSTR09:	SEV
	RTS	PC		;AND RETURN
GSTR10:	CMP	R2,#'"		;THIS A STRING CONSTANT
	BNE	GSTR09		;ERR IF NOT
	MOV	R1,R3		;SAVE STRING START ADDRESS
	CLR	R4		;REGISTER FOR LENGTH
GSTR11:	CMPB	(R1)+,#'"	;END OF STRING
	BEQ	GSTR02		;RETURN IF SO
	CMPB	-(R1),#S.EOL1	;END OF LINE?
	BHIS	1$		;RETURN IF SO TOO
	INC	R1		;SKIP OVER CHAR
	INC	R4		;ADD TO LENGTH
	BR	GSTR11		;LOOP TILL END FOUND
1$:	UNMERR			;UNMATCHED QUOTES ERROR
                                                                               ;DSS1
VTMR:	VTMERR			;VARIABLE TYPE MISMATCH                         ;DSS1
;
; ADDED CODE TO HANDLE USER STRING FUNCTIONS
;
GSTR01:	GETVAR			;NAME OF STRING FCN IN R4
	BVS	GSTR09		;IF UNSUCCESSFUL, ERROR
	CMPB	R2,#'$		;IS IT STRING FCN NAME?
	BNE	GSTR09		;IF NOT, ERROR
	SKIP
	CMPB	R2,#'(		;MUST HAVE ARG LIST
	BNE	GSTR09		;ELSE ERROR
	MOV	STUDAT,R3
	CLR	R0		;NO MASK
	BIS	#100000,R4	;SET STRING FCN TYPE
	SRLST
	BEQ	GSTR09		;IF NOT FOUND, ERROR
	JSR	PC,FNSET	;SET UP PARAMS
	MOV	R1,-(SP)	;SAVE R1
	MOV	R0,R1		;TEMP R1 FOR FCN EVAL
	EVALS
	BVC	1$		;IF OK, SKIP
	ILFERR			;OTHERWISE ERROR!
1$:	SKIP
	CMPB	R2,#')		;NO EXTRA PARENS ALLOWED
	BNE	2$
	PARERR
2$:	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	MOV	R3,R2		;SAVE STRING ADDRESS
	JSR	PC,FNCLR	;CLEAN UP MESS
	MOV	R2,R3		;RESTORE ADDRESS
	TST	R4		;SET CON CODES
	RTS	PC
	.SBTTL	GETHDR - GET ADDRESS OF DATA ELEMENT HEADER
                                                                               ;DSS1
	.IF	DF,DEFVAR	;IF AUTOMATIC VARIABLE DEFINITION               ;DSS1
                                                                                ;DSS1
;
; ON ENTRY:
;	R1 IS TEXT PTR WHICH SHOULD POINT TO VAR NAME START
;
; ON EXIT:
;	R1 POINTS TO CHAR FOLLOWING VAR NAME
;	R3 HAS HEADER ADDRESS
;	R0 HAS RETURN CODE (FOR USE AS JUMP INDEX)
;		0 = SINGLE PRECISION FLOATING
;		2 = INTEGER
;		4 = BYTE
;		6 = DOUBLE PRECISION
;		10= STRING VARIABLE
;	R4 HAS HEADER TYPE AND VAR NAME
;	'V' SET IF NO VAR IN TEXT (SYNTAX ERROR)                                ;DSS1
;		IN THIS CASE R4, R3 AND R0 ARE NOT DEFINED                      ;DSS1
;                                                                               ;DSS1
; *** 'Z' NO LONGER SET IF VARIABLE UNDEFINED...INSTEAD, THE VARIABLE           ;DSS1
;        IS CREATED (BY NEWVAR) ****                                            ;DSS1
;                                                                               ;DSS1
GETHDR:	JSR	PC,GETHD5	;DO OLD GETHDR STUFF                            ;DSS1
	BVS	6$		;ERROR                                          ;DSS1
	BNE	5$		;OK                                             ;DSS1
	MOV	R5,-(SP)	;(SAVE R5)                                      ;DSS1
	JSR	PC,NEWVAR	;DEFINE THE VARIABLE                            ;DSS1
	MOV	(SP)+,R5	;(RESTORE R5)                                   ;DSS1
5$:	CLZ			;CLEAR Z, JUST IN CASE                          ;DSS1
6$:	RTS	PC                                                              ;DSS1
                                                                                ;DSS1
                                                                                ;DSS1
; GETHD5 IS EXACTLY LIKE GETHDR, EXCEPT THAT, ON RETURN,                        ;DSS1
; THE Z-BIT IS SET IF THE VARIABLE IS UNDEFINED                                 ;DSS1
;***TEST 'V' FIRST, THEN 'Z' ....... VARIABLES ARE NOT AUTOMATICALLY CREATED    ;DSS1
GETHD5:                                                                         ;DSS1
                                                                                ;DSS1
	.IFF			;IF NO AUTOMATIC VARIABLE DEFINITION            ;DSS1
; GETHDR AND GETHD5 ARE IDENTICAL, IF UNDEFINED VARIABLES ARE ERRORS, RATHER    ;DSS1
; THAN ZEROES                                                                   ;DSS1
GETHDR:                                                                         ;DSS1
GETHD5:                                                                         ;DSS1
	.ENDC		;IF DF,DEFVAR                                           ;DSS1
                                                                                ;DSS1
	CLR	R0		;CLEAR R0 FOR SEARCH MASK                       ;DSS1
	MOV	R0,-(SP)	;AND SET ERROR RETURN CODE                      ;**-8
	GETVAR			;2 CHAR VAR NAME -> R4 (3RD CHAR -> R2)
	BVS	11$		;ON ERROR, BRANCH
	CMPB	R2,#'$		;DO WE HAVE STRING TYPE?
	BEQ	1$		;IF SO, BRANCH
	CMP	R2,#'%		;INTEGER TYPE?
	BEQ	2$		;IF SO, BRANCH TO INTEGER CODE
	CMPB	R2,#'&		;BYTE TYPE SPEC'D?
	BEQ	3$		;IF SO, BRANCH
;
; OTHER VARIABLE TYPE DETERMINATIONS TO BE DONE HERE
;
	DEC	R1		;BACK UP TEXT PTR IF ORDINARY FLOATING VAR
				;STACK LEFT AT 0 FOR FLOATING VAR.
	BR	10$		;BRANCH TO COMMON FINISH
1$:	BIS	#120000,R4	;SET STRING TYPE IN HEADER
	MOV	#10,(SP)	;SET STRING RETURN CODE
	BR	10$		;BRANCH TO COMMON FINISH
2$:	BIS	#20000,R4	;SET INTEGER HEADER
	MOV	#2,(SP)		;SET INTEGER TYPE ON STACK
	BR	10$
3$:	BIS	#40000,R4	;SET BYTE HEADER
	MOV	#4,(SP)		;AND TYPE ON STACK
	BR	10$
;
; CODE FOR OTHER VARIABLE TYPES TO BE INSERTED HERE
;
10$:	MOV	STUDAT,R3	;SET UP FOR SEARCH
	SRLST			;SEE IF IT'S THERE
	BEQ	12$		;IF NOT THERE, BRANCH
11$:	MOV	(SP)+,R0	;SET RETURN CODE
	CLZ			;INDICATE VAR FOUND
	RTS	PC
12$:	MOV	(SP)+,R0	;POP RETURN TYPE CODE                           ;DSS1
	SEZ			;VARIABLE NOT DEFINED                           ;DSS1
	RTS	PC                                                              ;**-2
	.SBTTL	GTOFFS - GET OFFSET OF ACTUAL DATA
;
; ON ENTRY:
;	R3 POINTS TO DATA ITEM HEADER
;	R1 POINTS TO TEXT FOLLOWING VAR NAME (OPEN PAREN IF THERE)
;
; ON EXIT:
;	R3 AS ABOVE
;	R1 POINTS PAST CLOSE PAREN (IF SUBSCRIPT USED)
;	AC0 HAS:
;		1) FOR STANDARD VAR, OFFSET FROM STUDAT
;			(R0 HAS ABSOLUTE ADDRESS IN THIS CASE)
;		2) FOR VIRTUAL ARRAY, OFFSET FROM FILE START (IN BYTES)
;
; OTHER REGISTERS USED: R2, R0, R4, AC1, AC2
;
GTOFFS:
	BIT	#10000,(R3)	;VIRTUAL ARRAY?
	BNE	3$		;IF SO, BRANCH
	MOV	R3,-(SP)	;SAVE R3
	MOV	(R3)+,R0	;HEADER -> R0
	ASH	#-14,R0		;SHIFT BITS DOWN
	BIC	#177761,R0	;CLEAR ALL BUT ITEM TYPE
	MOV	R0,-(SP)	;AND SAVE TYPE ON STACK
	SKIP
	CMPB	R2,#'(		;SUBSCRIPT?
	BNE	1$		;IF NOT, SIMPLE VARIABLE
	CMP	R0,#12		;DO WE HAVE STRING?
	BNE	6$		;IF NOT, BRANCH
	CLR	R0		;GET SET TO GET STRING LENGTH
	BISB	2(R3),R0	;WITHOUT SIGN EXTEND
	INC	R0		;AND ADD LENGTH BYTE
	MOV	R0,-(SP)	;SAVE IT ON STACK
	BR	7$
6$:	MOV	5$(R0),-(SP)	;LEN OF NUMERIC ELEMENT ON STACK
7$:	MOV	R3,-(SP)	;SAVE CURRENT POSITION OF R3
	EVAL			;GET 1ST SUBSCRIPT
	BVS	8$		;IF CLOSE PAREN, BRANCH
	STCFI	AC0,-(SP)	;STORE FIRST SUBSCRIPT
	SKIP			;GET NEXT TEXT CHAR
	CMPB	R2,#',		;MUST BE COMMA
	BNE	98$		;ELSE ERROR
	EVAL			;GET 2ND SUBSCRIPT
	BVC	98$		;MUST END WITH CLOSE PAREN
	STCFI	AC0,R0		;2ND SUBSCRIPT -> R0
	BR	9$
8$:	STCFI	AC0,-(SP)	;1ST (AND ONLY) SUBSCRIPT ON STACK
	CLR	R0		;2ND IS IMPLIED 0
9$:	MOV	2(SP),R3	;RESTORE R3
	CLR	R2		;MAKE SURE R2 CLEAR SO WE CAN GET
	BISB	(R3)+,R2	;2ND SUBSCRIPT LIMIT -> R2
	CMP	R0,R2		;COMPARE ACTUAL TO MAX
	BHI	99$		;IF TOO BIG, ERROR
	CLR	R2		;GET SET TO GET UNSIGNED
	BISB	(R3)+,R2	;1ST SUBSCRIPT LIMIT -> R2
	CMP	(SP),R2		;COMPARE 1ST SUBSCRIPT TO MAX
	BHI	99$		;IF TOO BIG, ERROR
	MOV	R3,2(SP)	;RE-SAVE R3
	CLR	R2		;GET Y.MAX -> R2
	BISB	-2(R3),R2	;IN UNSIGNED WAY
	MOV	R2,R3		;NOW DO WORK IN R3
	INC	R3		;ADD ONE FOR ZEROTH ELEMENT
	MUL	(SP)+,R3	;X*(Y.MAX+1) -> R3
	ADD	R0,R3		;Y+X*(Y.MAX+1) -> R3
	MOV	(SP)+,R2	;R2 NOW HAS PTR TO START OF DATA ELEMENTS
	MUL	(SP)+,R3	;MULTIPLY BY ELEMENT LENGTH
	ADD	R2,R3		;ADD IN OFFSET
10$:	CMP	(SP)+,#12	;DO WE HAVE STRING?
	BNE	2$		;IF NOT, BRANCH
	ADD	#3,R3		;ELSE ADD EXTRA WORD PLUS LEADING LEN BYTE
2$:	MOV	R3,R4		;COPY -> R4
	MOV	R3,R0		;AND -> R0
	MOV	(SP)+,R3	;HEADER ADDRESS
	SUB	STUDAT,R4	;OFFSET -> R4
	LDCIF	R4,AC0		;NOW -> AC0
	RTS	PC
1$:	DEC	R1		;BACK UP TEXT PTR
	TST	(R3)+		;PUSH TO 3RD WORD
	BR	10$		;AND GO FINISH
98$:	SBSERR			;BADLY FORMED SUBSCRIPT
99$:	SUBERR			;SUBSCRIPT OUT OF RANGE
5$:	.WORD	4	;REAL*4 (NORMAL TYPE)
	.WORD	2	;INTEGER*2
	.WORD	1	;BYTE
	.WORD	10	;REAL*8
;
; VIRTUAL SECTION
;
3$:	JSR	PC,VSUBSC	;GET ELEMENT NUMBER (LINEAR) -> AC0
	LDCIF	10(R3),AC1	;ELEMENT SIZE -> AC1
	ABSF	AC1		;MAKE SURE POSITIVE
	MULF	AC1,AC0		;GET TOTAL BYTE OFFSET IN ARRAY
	SETL			;LONG INTEGER MODE
	LDCLF	12(R3),AC2	;START OFFSET FOR ARRAY -> AC2
	ADDF	AC2,AC0		;ADD IT IN FOR FILE OFFSET
	SETI			;BACK TO 16 BIT INTEGERS
	RTS	PC		;AND RETURN
;
; VIRTUAL SUBSCRIPT CALCULATION
;
VSUBSC:
	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#'(		;CHECK FOR SUBSCRIPT
	BNE	3$		;IF NONE, (0,0) ELEMENT ASSUMED
	MOV	R3,-(SP)	;SAVE DATA ITEM PTR
	EVAL			;FIRST SUBSCRIPT -> AC0
	BVS	1$		;IF CLOSE PAREN, SHORT CALC.
	STF	AC0,-(SP)	;STORE IT ON STACK
	SKIP			;CHECK NEXT CHAR.
	CMPB	R2,#',		;FOR COMMA
	BNE	4$		;IF NO COMMA, BADLY FORMED SUBSCRIPT
	EVAL			;GET 2ND SUBSCRIPT
	BVC	4$		;IF NO CLOSE PAREN, BADLY FORMED SUBSCRIPT
	LDF	(SP)+,AC1	;1ST SUBSCRIPT -> AC1
2$:	MOV	(SP)+,R3	;RESTORE PTR TO VIRTUAL DATA ITEM
	STCFI	AC0,R0		;INTEGERIZE 2ND SUBSCRIPT
	CMP	R0,4(R3)	;CHECK ITS RANGE
	BHI	5$		;IF TOO HIGH, RANGE ERROR
	LDCIF	R0,AC0		;RE-LOAD 2ND SUBSCRIPT INTEGERIZED
	STCFI	AC1,R0		;GET 1ST SUBSCRIPT
	CMP	R0,2(R3)	;CHECK ITS RANGE
	BHI	5$		;IF TOO HIGH, RANGE ERROR
	LDCIF	R0,AC1		;1ST SUBSCRIPT -> AC1 (INTEGERIZED)
	LDCIF	4(R3),AC2	;SIZE OF 2ND DIMENSION
	ADDF	#1,AC2		;PLUS ONE -> AC2
	MULF	AC2,AC1		;TIMES FIRST SUBSCRIPT
	ADDF	AC1,AC0		;ADDED TO 2ND FOR RESULT
	RTS	PC		;AND RETURN
1$:	LDF	AC0,AC1		;MAKE SURE 1ST SUBSCRIPT -> AC1
	CLRF	AC0		;2ND SUBSCRIPT = IMPLIED 0
	BR	2$		;GO FINISH IN REGULAR WAY
3$:	DEC	R1		;BACK UP TEXT PTR
	CLRF	AC0		;ZEROTH ELEMENT WANTED
	RTS	PC		;AND RETURN
4$:	SBSERR			;BADLY FORMED SUBSCRIPT
5$:	SUBERR			;SUBSCRIPT OUT OF RANGE
;
; SUBROUTINE VIRACC
; TO GET NEEDED DISK BLOCK IN MEMORY GIVEN AN
; OFFSET INTO THE FILE. THIS ROUTINE ALSO TAKES
; CARE OF WRITING OUT AN EXITSING BLOCK IF NECESSARY.
; ON ENTRY:
;	R3 IS PTR TO VIRTUAL DATA HEADER
;	AC0 HAS OFFSET (IN BYTES) FROM FILE START
;	R5 HAS WRITE FLAG (1 TO INDICATE WRITE TO BE PERFORMED
;		AFTER ACCESS)
;
; ON EXIT:
;	R3 AS ABOVE
;	AC0 AS ABOVE
;	R0 HAS ADDRESS OF BLOCK BUFFER
;	R2 HAS OFFSET INTO BLOCK (IN BYTES)
;
; OTHER REGISTERS USED: AC1, AC2
;
VIRACC:
	MOV	R4,-(SP)	;SAVE A COUPLE
	MOV	R5,-(SP)	;OF REGISTERS
	MOV	6(R3),R4	;LUN -> R4
	DEC	R4		;BACK IT OFF BY ONE
	BIS	#10000,R4	;SET BLOCK MODE
	MOV	#7400,R0	;MASK TO IGNORE
	MOV	R3,-(SP)	;SAVE DATA PTR
	JSR	PC,SRCHFL	;LOOK FOR IT
	BEQ	4$		;IF NOT THERE, BRANCH
	SETL			;SET 32 BIT INTEGER MODE
	STCFL	AC0,-(SP)	;CONVERT OFFSET TO INTEGER
	MOV	(SP)+,R4	;AND PUT IN REGISTERS
	MOV	(SP)+,R5	;FOR FURTHER WORK
	ASHC	#-11,R4		;MAKE IT JUST BLOCK NUMBER
	ADD	#1,R5		;OFFSET BLOCK (SINCE START AT 1)
	ADC	R4		;MAKE SURE OF 32 BITS
	MOV	R5,-(SP)	;STORE 32 BIT BLOCK
	MOV	R4,-(SP)	;NUMBER ON STACK
	LDCLF	(SP)+,AC1	;REQUIRED BLOCK -> AC1
	LDCLF	6(R3),AC2	;CURRENT  BLOCK -> AC2
	CMPF	AC1,AC2		;IS REQUIRED SAME AS CURRENT?
	CFCC
	BEQ	2$		;IF SO, BRANCH (NO NEED TO READ)
	JSR	PC,WRITBK	;GO WRITE THE BLOCK OUT
	BCS	3$		;ON ERROR, BRANCH
	LDCLF	F.EFBK(R0),AC2	;CURRENT EOF BLOCK # -> AC2
	CMPF	AC1,AC2		;COMPARE REQUIRED VS EOF
	CFCC
	BLT	5$		;IF REQ'D < CURRENT EOF, OK FOR READ
	TST	2(SP)		;CHECK ON WRITE FLAG
	BNE	2$		;IF WRITE, SKIP READ
				;ELSE CONTINUE SO WE GET EOF ERROR ON READ
5$:	STCFL	AC1,F.BKVB(R0)	;REQUIRED BLOCK NUMBER -> FDB
	CLR	-(SP)		;IO STATUS BLOCK
	CLR	-(SP)		;ON STACK
	MOV	SP,F.BKST(R0)	;WITH ADDRESS IN FDB
	READ$			;DO BLOCK READ
	BCC	6$		;IF OK, BRANCH TO WAIT
	MOVB	F.ERR(R0),(SP)	;IF NOT, GET ERROR CODE WHERE EXPECTING IT
	BR	1$		;AND BRANCH AROUND WAIT
6$:	WAIT$	R0		;WAIT FOR IT TO FINISH
1$:	MOV	(SP)+,R2	;IO STATUS RETURN -> R2
	TST	(SP)+		;POP XFER COUNT
	MOVB	R2,F.ERR(R0)	;STATUS -> FDB
	BMI	3$		;ON ERROR, BRANCH
2$:	STCFL	AC0,-(SP)	;OFFSET -> STACK
	TST	(SP)+		;POP HIGH ORDER PART
	MOV	(SP)+,R2	;LOW PART -> R2
	BIC	#177000,R2	;CLEAR OUT ALL BUT BLOCK OFFSET
	STCFL	AC1,6(R3)	;STORE CURRENT BLOCK #
	MOV	R3,R0		;BASIC FDB PTR -> R0
	MOV	(SP)+,R3	;RESTORE DATA PTR
	MOV	(SP)+,R5	;RESTORE SOME
	BIS	R5,14(R0)	;SET WRITE FLAG IF IN R5
	ADD	#S.FDB+26,R0	;MAKE R0 POINT TO BLOCK BUFFER
	MOV	(SP)+,R4	;REGISTERS
	SETI			;BACK TO 16 BIT INTEGERS
	RTS	PC		;AND RETURN
;
; ERROR ROUTINES
;
3$:	MOVB	R2,R2		;EXTEND SIGN
	MOV	R2,PARLST+P.FCS	;STORE FCS ERROR CODE
	SETI			;RESTORE INTEGER MODE
	VFIERR			;ERROR IN VIRTUAL FILE ACCESS
4$:	SETI
	VOPERR			;VIRTUAL FILE NOT OPEN
;
; SUBROUTINE WRITBK
; TO WRITE OUT BLOCK BUFFER ON BLOCK ACCESS FILE IF NEEDED
; AND SET UP FDB FOR BLOCK OPERATIONS
;
; ON ENTRY:
;	R3 POINTS TO BASIC FILE CONTROL BLOCK HEADER
;
; ON EXIT:
;	R0 POINTS TO FDB PROPER
;	F.BKDS AND F.BKDS+2 SET UP
;	F.BKVB(R0) SET UP WITH BLOCK NUMBER OF WRITTEN BLOCK IF WRITE DONE
;	14(R3) ZEROED (NO UNRECORDED WRITES TO THIS BLOCK)
;	F.ERR(R0) SET WITH IO STATUS CODE IF WRITE DONE
;	'C' SET IF ERROR IN WRITE, CLEAR OTHERWISE
;
; OTHER REGISTERS USED:R2
;
WRITBK:
	MOV	R3,R0		;MAKE R0 POINT TO FCS FDB
	ADD	#26,R0		;
	MOV	R0,F.BKDS+2(R0)	;STORE PROPER
	ADD	#S.FDB,F.BKDS+2(R0) ;BLOCK ADDRESS
	MOV	#1000,F.BKDS(R0) ;AND SIZE
	TST	14(R3)		;CHECK # WRITES TO THIS BLOCK
	BEQ	2$		;IF NONE, BRANCH (NO NEED TO WRITE)
	MOV	6(R3),F.BKVB(R0);SET UP BLOCK NUMBER
	MOV	10(R3),F.BKVB+2(R0) ;FOR WRITE
	CLR	-(SP)		;MAKE A STATUS BLOCK
	CLR	-(SP)		;ON THE STACK
	MOV	SP,F.BKST(R0)	;AND ADDRESS IN FDB
	WRITE$			;DO THE BLOCK WRITE
	BCC	4$		;IF OK, BRANCH TO WAIT
	MOVB	F.ERR(R0),(SP)	;PUT ERROR CODE WHERE EXPECTING IT
	BR	3$		;AND BRANCH AROUND WAIT
4$:	WAIT$	R0		;AND WAIT FOR IT TO FINISH
3$:	MOV	(SP)+,R2	;IO STATUS RETURN -> R2
	TST	(SP)+		;POP XFER COUNT
	SEC			;SET 'C' FOR ERROR RETURN
	MOVB	R2,F.ERR(R0)	;STORE STATUS IN FDB
	BMI	1$		;IF NEGATIVE, BRANCH
2$:	CLC			;ELSE SET SUCCESS RETURN
1$:	RTS	PC
	.SBTTL	GETNUM - TO RETURN NUMBER -> AC0, GIVEN INFO FROM GTOFFS
;
; ON ENTRY:
;	R3 IS PTR TO DATA ITEM HEADER
;	AC0 HAS OFFSET
;		1) FOR STANDARD VAR, OFFSET FROM STUDAT
;		2) FOR VIRTUAL ARRAY, OFFSET FROM FILE START
;
; ON EXIT:
;	R3 AS ABOVE
;	AC0 HAS NUMERIC VALUE
;
; OTHER REGISTERS USED: R0, R2
;
GETNUM:
	MOV	R5,-(SP)	;SAVE CURRENT R5
	CLR	R5		;NO WRITE FLAG (READ ONLY)
	JSR	PC,NUMSUB	;GO TO COMMON READ/WRITE SUBROUTINE
	JMP	@1$(R0)		;AND JUMP TO PROPER CODE
1$:	.WORD	2$		;FLOATING
	.WORD	3$		;INTEGER
	.WORD	4$		;BYTE
	.WORD	9$		;DOUBLE PRECISION
2$:	LDF	(R2),AC0	;LOAD IN FLOATING VALUE
	BR	8$
3$:	MOV	(R2),R0		;INTEGER VALUE -> R0
5$:	LDCIF	R0,AC0		;CONVERT IT TO FLOATING
8$:	MOV	(SP)+,R5	;RESTORE R5
	RTS	PC		;AND RETURN
4$:	MOVB	(R2),R0		;CONVERT BYTE TO INTEGER
	BR	5$		;AND FINISH LIKE INTEGER
;
; TEMPOROARILY FOR LOGICAL TIE-UP OF CODE FOR DOUBLE PRECISION
; EVENTUALLY THE USE OF DOUBLE PRECISION (REAL*8) HAS TO BE RE-THOUGHT
;
9$:	LDCDF	(R2),AC0
	BR	8$
;
; COMMON CODE FOR READ AND WRITE OF NUMERIC DATA
;
; ON ENTRY:
;	R3 IS PTR TO DATA ITEM HEADER
;	AC0 HAS OFFSET
;		1) FOR STANDARD VAR, OFFSET FROM STUDAT
;		2) FOR VIRTUAL ARRAY, OFFSET FROM FILE START
;	R5 HAS READ/WRITE FLAG (0=READ, 1=WRITE)
;
; ON EXIT:
;	R3,AC0,R5 AS ABOVE
;	R2 HAS ADDRESS OF DATA
;	R0 HAS TYPE INDICATOR
;		0 = FLOATING (REAL*4)
;		2 = INTEGER*2
;		4 = BYTE (LOGICAL*1)
;		6 = DOUBLE (REAL*8)
;
NUMSUB:
	MOV	(R3),R0		;ARE WE IN RANGE FOR NUMERIC DATA
	ASH	#-14,R0		;MAKE TYPE INFO INTO
	BIC	#177761,R0	;A JUMP TABLE OFFSET
	CMP	R0,#6		;ARE WE IN RANGE OF NUMBER TYPES
	BHI	8$		;IF NOT, BRANCH TO ERROR
	BIT	#10000,(R3)	;VIRTUAL?
	BNE	6$		;IF SO, BRANCH
	STCFI	AC0,R2		;OFFSET -> R2
	ADD	STUDAT,R2	;MAKE IT INTO ABSOLUTE ADDRESS
7$:	RTS	PC
;
; VIRTUAL SECTION
;
6$:	MOV	R0,-(SP)	;SAVE JUMP PTR
	JSR	PC,VIRACC	;GO ACCESS APPROPRIATE BLOCK
				;(RETURN WITH BLOCK ADDRESS -> R0)
				;(OFFSET -> R2)
	BVS	8$		;IF NO FILE, 'V' SET
	ADD	R0,R2		;MAKE R2 POINT TO VALUE
	MOV	(SP)+,R0	;RESTORE JUMP PTR
	BR	7$		;AND GO FINISH LIKE REGULAR VARIABLE
8$:	NXVERR
	.SBTTL	STONUM - STORE A NUMBER FROM AC0 INTO VARIABLE
;
; ON ENTRY:
;	R3 POINTS TO DATA ITEM HEADER
;	AC0 HAS VALUE
;	AC1 HAS OFFSET
;		1) FOR STANDARD VAR, OFFSET FROM STUDAT
;		2) FOR VIRTUAL ARRAY, OFFSET FROM FILE START
;
; ON EXIT:
;	R3 AS ABOVE
;	AC0 AS ABOVE
;	AC1 AS ABOVE
;
; OTHER REGISTERS USED: R0, R2
;
STONUM:
	MOV	R5,-(SP)	;SAVE R5
	MOV	#1,R5		;SET WRITE FLAG
	STF	AC0,-(SP)	;SAVE VALUE
	STF	AC1,AC0		;AND PUT OFFSET WHERE EXPECTED
	JSR	PC,NUMSUB	;DO COMMON CODE
	LDF	(SP)+,AC0	;GET VALUE OFF STACK
	JMP	@1$(R0)		;GO TO PROPER ROUTINE
1$:	.WORD	2$		;REAL*4
	.WORD	3$		;INTEGER*2
	.WORD	4$		;LOGICAL*1 (BYTE)
	.WORD	9$		;REAL*8
2$:	STF	AC0,(R2)
	BR	8$
3$:	STCFI	AC0,(R2)	;CONVERT TO 1-WORD INTEGER
	BR	8$
4$:	STCFI	AC0,R0		;CONVERT 1ST TO INTEGER
	MOVB	R0,(R2)		;THEN TO BYTE
8$:	MOV	(SP)+,R5	;RESTORE R5
	RTS	PC
;
; TEMPORARY DOUBLE PRECISION STORE
;
9$:	STCFD	AC0,(R2)
	BR	8$
	.SBTTL	GETSTR - TO RETURN STRING ELEMENT DESCRIPTOR IN R3,R4
;
; ON ENTRY:
;	R0 IS PTR TO DATA ITEM HEADER
;	AC0 HAS OFFSET
;		1) FOR STANDARD VAR, OFFSET FROM STUDAT
;		2) FOR VIRTUAL ARRAY, OFFSET FROM FILE START
;
; ON EXIT:
;	R0, AC0 AS ABOVE
;	R3 HAS STRING ADDRESS
;	R4 HAS STRING LENGTH
;	'V' SET IF ERROR, CLEAR OTHERWISE
;
; OTHER REGISTERS USED:
;
GETSTR:
	MOV	R5,-(SP)	;SAVE CURRENT R5
	CLR	R5		;SET READ ONLY
	JSR	PC,STRADD	;GO TO COMMON CODE
	BIT	#10000,(R0)	;VIRTUAL?
	BNE	8$		;IF SO, BRANCH
	TST	4(R0)		;FIXED OR VAR?
	BMI	1$		;IF VAR, BRANCH
	MOVB	4(R0),R4	;FIXED LEN -> R4
	BR	2$
1$:	MOVB	-1(R3),R4	;ACTUAL LENGTH -> R4
2$:	BIC	#177400,R4	;CLEAR ANY SIGN EXTEND
	BR	5$		;AND THAT'S IT
;
; VIRTUAL STRING RETRIEVE
;
8$:	MOV	10(R0),R4	;SIZE -> R4
	BPL	5$		;IF POSITIVE, WE'RE DONE
	NEG	R4		;MAKE ABSOLUTE VALUE
	MOV	R4,R2		;GET END OF STRING
	ADD	R3,R2		;IN R2
4$:	TSTB	-(R2)		;CHECK FOR FIRST
	BNE	5$		;NON-NULL (BRANCH)
	SOB	R4,4$		;ELSE KEEP LOOKING
5$:	MOV	(SP)+,R5	;RESTORE ORIGINAL R5
	RTS	PC
;
; COMMON CODE FOR STRING READ AND WRITE
;
; ON ENTRY:
;	R0 IS PTR TO DATA ITEM HEADER
;	AC0 HAS OFFSET
;		1) FOR STANDARD VAR, OFFSET FROM STUDAT
;		2) FOR VIRTUAL ARRAY, OFFSET FROM FILE START
;	R5 HAS READ/WRITE FLAG (0=READ, 1=WRITE)
;
; ON EXIT:
;	R0,AC0,R5 AS ABOVE
;	R3 HAS ADDRESS OF STRING
;
; OTHER REGISTERS USED: R0,R2
;
STRADD:
	MOV	(R0),-(SP)	;HEADER ON STACK
	BIC	#17777,(SP)	;CLEAR ALL BUT TYPE
	CMP	#120000,(SP)+	;IS IT STRING
	BNE	6$		;IF NOT, ERROR
	BIT	#10000,(R0)	;VIRTUAL STRING?
	BNE	3$		;IF SO, BRANCH
	STCFI	AC0,R3		;OFFSET -> R3
	ADD	STUDAT,R3	;MAKE IT ABSOLUTE
7$:	RTS	PC
3$:	MOV	R0,R3		;GET HEADER WHERE WE NEED IT
	MOV	R0,-(SP)	;AND SAVE SINCE R0 GETS USED
	JSR	PC,VIRACC	;GO ACCESS THE ITEM
	MOV	R0,R3		;BLOCK ADDRESS -> R3
	ADD	R2,R3		;NOW ABS ADDRESS
	MOV	(SP)+,R0	;HEADER ADDRESS BACK -> R0
	BR	7$
6$:	NXVERR			;THIS ERROR SHOULDN'T HAPPEN
	.SBTTL	STOSTR - STORE STRING IN MEMORY (REAL OR VIRTUAL)
;
; ON ENTRY:
;	R0 IS PTR TO DATA ITEM HEADER
;	AC0 HAS OFFSET
;		1) FOR STANDARD VAR, OFFSET FROM STUDAT
;		2) FOR VIRTUAL ARRAY, OFFSET FROM FILE START
;	R3 HAS STRING ADDRESS
;	R4 HAS STRING LENGTH
;
; ON EXIT:
;	R0, AC0 AS ABOVE
;	R3 HAS ADDRESS PAST END OF USED PORTION OF SOURCE STRING
;	R4 = 0
;
STOSTR:
	MOV	R5,-(SP)	;SAVE A REGISTER
	MOV	R3,-(SP)	;SAVE STRING DESCRIPTORS
	MOV	R4,-(SP)
	MOV	#1,R5		;SET WRITE FLAG
	JSR	PC,STRADD	;GO DO COMMON CODE
	MOV	R3,R2		;DESTINATION ADDRESS -> R2
	MOV	(SP)+,R4	;POP LENGTH
	MOV	(SP)+,R3	;AND ADDRESS OF DESTINATION
	BIT	#10000,(R0)	;VIRTUAL DESTINATION?
	BNE	4$		;IF SO, BRANCH
	MOVB	4(R0),R5	;MAX LEN -> R5
	BIC	#177400,R5	;CLEAR OUT ANY SIGN EXTEND
	SUB	R4,R5		;R5 HAS DIFFERENCE BETWEEN MAX AND ACTUAL
	BGE	1$		;IF POS OR ZERO, OK (BRANCH)
	ADD	R5,R4		;IF NEGATIVE, REDUCE ACTUAL TO MAX
	CLR	R5		;AND SET ZERO DIFFERENCE (FOR FILL)
1$:	MOV	R0,-(SP)	;SAVE DATA ITEM HEADER
	TST	4(R0)		;CHECK FIXED OR VARIABLE
	BMI	2$		;IF VARIABLE, BRANCH
	MOVB	#40,R0		;IF FIXED USE SPACE AS FILL CHAR
	BR	3$
2$:	MOVB	R4,-1(R2)	;STORE ACTUAL LENGTH IN ITS FIELD
	CLR	R0		;USE NULL AS FILL
3$:	JSR	PC,FILSTR	;GO FILL THE STRING
	MOV	(SP)+,R0	;RESTORE DATA ITEM PTR
	MOV	(SP)+,R5	;AND REGISTER WE USED
	RTS	PC
;
; VIRTUAL STRING SECTION
;
4$:	MOV	R0,-(SP)	;SAVE DATA ITEM PTR
	MOV	10(R0),R5	;GET STRING LENGTH -> R5
	BPL	5$		;IF POSITIVE THEN FIXED (BRANCH)
	CLR	R0		;IF NEGATIVE, THEN VARIABLE => NULL FILL
	NEG	R5		;MAKE LENGTH POSITIVE
	BR	6$
5$:	MOV	#40,R0		;USE SPACE FILL FOR FIXED LENGTH
6$:	SUB	R4,R5		;LENGTH DIFFERENCE -> R5
	BGE	3$		;IF POSITIVE, WE'RE SET NOW
	ADD	R5,R4		;IF NEG, MAKE LEN = MAX LEN
	CLR	R5		;AND NO FILL
	BR	3$		;AND GO FINISH FILL OPERATION
;
; FILSTR
; TO FILL IN A STRING VARIABLE
;
; ON ENTRY:
;	R3 HAS ADDRESS OF SOURCE
;	R4 HAS LEN OF SOURCE
;	R2 HAS ADDRESS OF VARIABLE
;	R5 HAS FILL COUNT
;	R0 HAS FILL CHAR
;
; ON EXIT:
;	R4 = 0
;	R5 = 0
;	R3 HAS ADDRESS PAST END OF USED SOURCE
;	R2 HAS ADDRESS PAST END OF FILLED VARIABLE
;	R0 HAS FILL CHAR
;
FILSTR:	TST	R4		;DO WE HAVE AN ACTUAL STRING?
	BEQ	2$		;IF NOT, BRANCH
1$:	MOVB	(R3)+,(R2)+	;MOVE IN THE ACTUAL STRING
	SOB	R4,1$		;
2$:	TST	R5		;DO WE HAVE ANY FILL TO DO?
	BEQ	4$		;IF NOT, BRANCH
3$:	MOVB	R0,(R2)+	;MOVE IN THE FILL CHARACTERS
	SOB	R5,3$
4$:	RTS	PC
	.SBTTL	NEWVAR - TO CREATE A SIMPLE VARIABLE OF R0 TYPE
;
; ON ENTRY:
;	R0 HAS TYPE INDICATOR
;		0 = REAL*4
;		2 = INTEGER
;		4 = BYTE
;		6 = REAL*8
;		10= STRING
;	R4 HAS VARIABLE HEADER
;		LOWER 12 BITS HAVE VAR. NAME
;		TOP 3 BITS ARE DATA TYPE
;
; ON EXIT:
;	R0 AND R4 AS ABOVE
;	R3 POINTS TO DATA ITEM HEADER
;	ENUDAT UPDATED
;
; OTHER REGISTERS USED: R5
;
NEWVAR:
	MOV	R4,-(SP)	;SAVE HEADER
	ASR	R0		;DIVIDE INDEX BY TWO
	MOV	R0,-(SP)	;AND SAVE IT
	MOVB	10$(R0),R0	;GET ITEM SIZE -> R0
	TSTOK			;CHECK FOR ROOM
	BLO	12$		;IF NOT ENOUGH, ERROR
	MOV	(SP)+,R0	;RESTORE JUMP POINTER
	MOV	(SP),R4		;AND HEADER
	MOV	R5,R3		;COPY DATA ITEM START -> R3
	MOV	R4,(R5)+	;PUT IN HEADER
	CLR	(R5)+		;SET ZERO DIMENSIONS
	CMP	R0,#4		;STRING?
	BNE	1$		;IF NOT, BRANCH
	MOV	#177417,(R5)+	;IF SO, SET VAR LENGTH 15 BYTE STRING
1$:	MOVB	11$(R0),R4	;GET WORD COUNT TO CLEAR -> R4
2$:	CLR	(R5)+		;AND
	SOB	R4,2$		;CLEAR SPACE
	MOV	R5,ENUDAT	;SAVE NEW END OF DATA
	MOV	(SP)+,R4	;RESTORE DATA HEADER
	ASL	R0		;AND TYPE INDEX
	RTS	PC
12$:	OVFERR
10$:	.BYTE	10,6,6,14,26	;REAL*4,INTEGER,BYTE,REAL*8,STRING
11$:	.BYTE	2,1,1,4,10	;   "			"
	.EVEN

	.SBTTL	LET00 - LET STATEMENT
;+3
; .SKIP
; .X ^^LET\\
; .X ^ARITHMETIC ASSIGNMENT
; .HEADERLEVEL 1 <LET
; .BREAK
; ^THIS IS THE NUMERIC ASSIGNMENT STATEMENT.
; ^IT IS ALSO ALLOWABLE FOR STRING ASSIGNMENT.
; ^THE WORD ITSELF IS OPTIONAL IN THIS VERSION OF ^^BASIC\\.
; ^A SINGLE VARIABLE NAME TO THE LEFT OF THE '=' IS GIVEN
; THE VALUE OF THE NUMERIC OR STRING EXPRESSION TO THE RIGHT
; OF THE EQUAL SIGN.
; ^VARIABLE AND EXPRESSION TYPES MUST MATCH.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{20 LET A=EXP(10.34)}
;	{30 A$="ABC"+B$}
; \\
; .FILL
;-
;  REGISTERS USED - ALL.
;
LET00:
	JSR	PC,GETHDR	;GET VARIABLE HEADER
	BVS	97$		;IF NO VARIABLE IN TEXT, ERROR
                                                                               ;DSS1
	.IF	NDF,DEFVAR	;IF NO AUTOMATIC VARIABLE DEFINITION            ;DSS1
	BNE	4$		;NO VARIABLE                                    ;DSS1
	JSR	PC,NEWVAR	;NOT DEFINED....DEFINE IT                       ;DSS1
	.ENDC                                                                   ;DSS1
                                                                                ;DSS1
4$:	MOV	R0,-(SP)	;SAVE JUMP PTR                                  ;**-2
	JSR	PC,GTOFFS	;GET OFFSET (REAL OR VIRTUAL)
	MOV	(SP)+,R0	;RESTORE JUMP PTR
	MOV	R3,-(SP)	;SAVE DATA HEADER ADDRESS
	STF	AC0,-(SP)	;AND DATA OFFSET
	SKIP			;GET NEXT CHAR
	CMPB	R2,#'=		;MUST BE '='
	BNE	97$		;ELSE ERROR
	CMP	R0,#10		;STRING?
	BEQ	10$		;IF SO, BRANCH TO STRING SECTION
2$:	EVAL			;GET SOURCE VALUE -> AC0
	BVS	98$		;IF ERROR, REPORT IT
	LDF	(SP)+,AC1	;OFFSET -> AC1
	MOV	(SP)+,R3	;RESTORE DATA ITEM HEADER
	JSR	PC,STONUM	;STORE NUMBER
	BR	12$		;AND BACK TO MAIN INTERPRETER
;
; STRING SECTION OF LET
;
10$:	EVALS			;EVALUATE SOURCE STRING (R3,R4)
	BVS	99$		;ON ERROR, BRANCH
	LDF	(SP)+,AC0	;RESTORE OFFSET
	MOV	(SP)+,R0	;AND DATA HEADER ADDRESS
	JSR	PC,STOSTR	;STORE RESULT
12$:	JMP	INIT02		;AND BACK TO INTERPRETER
97$:	UNRERR			;UNRECOGNIZED STATEMENT
98$:	PARERR
99$:	LETERR

	.SBTTL	EVALC0 - EVALUATE LOGICAL CONDITION
;+1
; .SKIP
; .X ^LOGICAL ^EXPRESSIONS
; .HEADERLEVEL 1 ^LOGICAL ^EXPRESSIONS
; .BR
; ^LOGICAL EXPRESSIONS ARE OF THE FORM:
; .BR
; 	^^_<EXP>_<REL-OP>_<EXP>[_<LOGICAL-OP>_<EXP>_<REL-OP>...]
; \\
; .BR
; ^WHERE EXPRESSIONS ARE EITHER ARITHMETIC OR STRING AND RELATIONAL OPERATORS
; CAN BE FORMED BY ANY COMBINATION OF _<, > AND =.
; ^THE TWO EXPRESSIONS WHICH ARE RELATED BY THE RELATIONAL OPERATOR MUST BE
; OF THE SAME TYPE: I.E. STRING OR ARITHMETIC.
; ^THE RESULT OF EVALUATING THE RELATIONSHIP (TERMED HERE A LOGICAL
; SUBEXPRESSION) IS EITHER TRUE OR FALSE.
; .FG 1
; ^STRINGS ARE COMPARED CHARACTER BY CHARACTER ON THE BASIS OF THEIR <ASCII
; CODES. ^WHEN TWO STRINGS OF UNEQUAL LENGTH MATCH AT ALL COMMON CHARACTER
; POSITIONS, THE SHORTER ONE IS CONSIDERED LESS THAN THE LONGER ONE.
; .FG 1
; ^LOGICAL SUBEXPRESSIONS CAN IN TURN BE RELATED BY THE LOGICAL (^BOOLEAN)
; OPERATORS: <AND, <OR, <XOR AND <NOT.
; ^THE ORDER OF EVALUATION IS FROM LEFT TO RIGHT, BUT LOGICAL SUBEXPRESSIONS
; MAY BE NESTED WITH PARENTHESES TO ANY DEPTH DESIRED.
; .FG 1
; ^ONE RESTRICTION EXISTS WITH RESPECT TO PARENTHESES: NO LEADING ARITHMETIC
; EXPRESSION IN A LOGICAL SUBEXPRESSION SHOULD BEGIN WITH AN OPEN PARENTHESIS,
; OTHERWISE THE INTERPRETER WILL ATTEMPT TO EVALUATE IT AS A NESTED
; SUBEXPRESSION. ^THIS CAN EASILY BE GOTTEN AROUND BY REARRANGING THE
; ARITHMETIC EXPRESSION OR ADDING IT TO 0.
; .BR
; ^EXAMPLES:
; ^^
; .NF
; 	{A _< B OR B = .5}
; 	{NOT (X1 _< 1 AND A >= 5)}
; \\
; .F
;-
;
; THIS CODE EVALUATES A COMPOUND CONDITION, ALLOWING FOUR LOGICAL
; OPERATORS: NOT, AND, XOR, OR.
;
; ON ENTRY:
;	R1 POINTS TO START OF CONDITION TEXT
; ON EXIT:
;	R1 POINTS TO NEXT CHAR OF TEXT
;	R0 HAS CONDITION -1 = TRUE, 0 = FALSE
;	'N' SET IF TRUE
;	'Z' SET IF FALSE
;
EVALC0:	CLR	-(SP)		;SET STOPPER ON STACK
1$:	SKIP			;FIRST CHAR -> R2
	BIC	#177400,R2	;CLEAR ANY SIGN EXTEND
	CMPB	R2,#'(		;OPEN PAREN?
	BEQ	12$		;IF SO, BRANCH
	CMPB	R2,#S.NOT	;IS IT A LEADING 'NOT'
	BNE	2$		;IF NOT, BRANCH
	MOV	R2,-(SP)	;IF SO, SAVE IT
	BR	1$		;AND GO BACK FOR MORE
2$:	DEC	R1		;BACK UP TEXT POINTER
	JSR	PC,SNGLCN	;GO EVALUATE SINGLE CONDITION
8$:	MOV	(SP)+,R3	;SEE WHAT'S ON STACK
	BEQ	11$		;IF ZERO, BRANCH
	SUB	#S.NOT,R3	;ANYTHING ELSE IS AN OPERATOR
	ASL	R3		;MAKE IT INTO A TABLE OFFSET
	JMP	@3$(R3)		;AND GO TO APPROPRIATE ROUTINE
3$:	.WORD	4$		;NOT
	.WORD	5$		;AND
	.WORD	6$		;XOR
	.WORD	7$		;OR
4$:	COM	R0		;COMPLEMENT THE EXISTING CONDITION
	BR	8$		;AND SEE IF ANYTHING MORE ON STACK
5$:	MOV	(SP)+,R2	;PRIOR CONDITION -> R2
	COM	R2		;HAVE TO FUSS TO GET
	BIC	R2,R0		;LOGICAL AND
	BR	9$		;NOW SEE WHAT'S NEXT
6$:	MOV	(SP)+,R2	;GET PRIOR CONDITION -> R2
	XOR	R2,R0		;WE HAVE INSTRUCTION FOR EXCLUSIVE OR
	BR	9$
7$:	BIS	(SP)+,R0	;THIS IS THE INSTRUCTION FOR INCL. OR
9$:	SKIP			;GET NEXT CHAR -> R2
	BIC	#177400,R2	;CLEAR ANY SIGN EXTEND
	CMPB	R2,#S.AND	;SEE IF WE HAVE BINARY
	BLO	10$		;LOGICAL OPERATOR
	CMPB	R2,#S.OR
	BHI	10$		;IF NOT, AT END OF CONDITION
	MOV	R0,-(SP)	;IF SO, PUT CURRENT CONDITION
	MOV	R2,-(SP)	;AND OPERATOR ON STACK
	BR	1$		;AND EVALUATE NEXT CONDITION
10$:	DEC	R1		;BACK UP TEXT POINTER
	TST	(SP)+		;POP STOPPER FROM STACK
	TST	R0		;SET CONDITION CODES
	RTS	PC		;AND RETURN
11$:	CLR	-(SP)		;RESET STOPPER
	BR	9$		;AND GO LOOK FOR BINARY OPERATOR
12$:	JSR	PC,EVALC0	;CALL THIS ROUTINE RECURSIVELY
	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#')		;IS IT CLOSE PAREN?
	BEQ	8$		;IF SO, BRANCH
	PARERR
S.LT	=1	;DEFINE BITS FOR RELATIONAL OPERATORS
S.EQ	=2
S.GT	=4
SNGLCN:	EVALS			;IF STRING OK
	BVC	1$		;GO DO STRING COMPARE
	EVAL
	BVC	10$		;IF NO PAREN, BRANCH
	PARERR			;CLOSE PAREN HERE IS ERROR
10$:	STF	AC0,-(SP)	;SAVE THE VALUE
	CLR	-(SP)		;SPACE TO SET TRUE CONDITIONS
	JSR	PC,OPSET	;SET THE TRUE CONDITIONS
	EVAL			;GET SECOND ARG -> AC0
	BVC	12$		;IF NO CLOSE PAREN, BRANCH
	DEC	R1		;IF ONE, BACK UP OVER IT
12$:	MOV	(SP)+,R0	;CONDITIONS IN R0
	CMPF	(SP)+,AC0	;DO ACTUAL COMPARE
	CFCC			;COPY THE CONDITION CODES
	BR	6$		;GO FINISH
1$:	MOV	R4,-(SP)	;SAVE LEN AND
	MOV	R3,-(SP)	;ADDRESS OF FIRST STRING
	MOV	ENUDAT,-(SP)	;SAVE OLD STORAGE END
	CLR	-(SP)		;SAVE SLOT FOR TRUE CONDITIONS
	MOV	R3,R5		;SET NEW END OF
	ADD	R4,R5		;USER STORAGE PAST
	INC	R5		;FIRST STRING
	BIC	#1,R5
	MOV	R5,ENUDAT
	JSR	PC,OPSET	;SET TRUE REL OPERATORS
	EVALS			;GET SECOND STRING
	BVS	IF99		;ON ERROR, BRANCH
	MOV	(SP)+,R0	;GET TRUE CODES IN R0
	MOV	(SP)+,ENUDAT	;RESTORE OLD END OF USER STORAGE
	MOV	(SP)+,R2	;1ST STRING ADDRESS -> R2
	MOV	(SP)+,R5	;ITS LEN -> R5
	CLR	-(SP)		;PUT LENGTH RELATIONAL FLAG ON STACK
	CMP	R5,R4		;COMPARE 1ST LEN TO SECOND
	BEQ	2$		;IF SAME, DON'T DO ANYTHING YET
	BLT	3$		;IF LESS, GO SET NEG & NEW COMPARE COUNT
	INC	(SP)		;IF GT, SET POS
	BR	2$		;AND KEEP PRESENT COMPARE COUNT (R4)
3$:	DEC	(SP)
	MOV	R5,R4		;MIN LENGTH IN R4
2$:	MOV	(SP)+,R5	;LEN RELATION IN R5
	TST	R4		;CHECK LENGTH
	BLE	5$		;IF NEG OR ZERO, GO BY LEN ONLY
4$:	CMPB	(R2)+,(R3)+	;CHECK EACH CHAR.
	BNE	6$		;IF DON'T MATCH, END OF COMPARE
	SOB	R4,4$		;KEEP COMPARING
5$:	TST	R5		;IF FINISHED CHECK, GO ON LEN
6$:	BLT	7$		;GO TO APPROPRIATE TEST FOR TRUE
	BEQ	8$		;CONDITIONS
	BIT	#S.GT,R0	;IS > TRUE
	BR	9$
7$:	BIT	#S.LT,R0	;IS < TRUE
	BR	9$
8$:	BIT	#S.EQ,R0	;IS = TRUE
9$:	BEQ	11$		;IF FALSE, BRANCH
	MOV	#-1,R0		;SET TRUE CONDITION
	RTS	PC
11$:	CLR	R0		;SET FALSE CONDITION
	RTS	PC

	.SBTTL	IF00 - IF STATEMENT
;+3
; .SKIP
; .X ^^IF\\
; .X ^STRING COMPARISON
; .HEADERLEVEL 1 <IF
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^IF _<LOGICAL EXPRESSION> THEN _<STMT>[ELSE _<LINE _#>][ELSE _<STMT>]
;	IF _<LOGICAL EXPRESSION> THEN _<LINE _#> "   "
;	IF _<LOGICAL EXPRESSION> GOTO _<LINE _#>\\ "  "
; .FILL
; ^IF THE LOGICAL EXPRESSION IS TRUE (SEE ^LOGICAL ^EXPRESSIONS), THEN
; THE LINE NUMBER FOLLOWING THE <THEN OR <GOTO IS BRANCHED TO OR ALL STATEMENTS
; FOLLOWING <THEN UP TO THE END OF THE LINE OR AN <ELSE ARE EXECUTED.
; .FG 1
; ^IF THE CONDITION IS FALSE, A MATCHING <ELSE IS SEARCHED FOR.
; ^IF FOUND, THE LINE NUMBER FOLLOWING THE <ELSE IS BRANCHED TO OR ALL
; STATEMENTS FOLLOWING THE <ELSE TO THE END OF THE LINE OR THE NEXT
; <ELSE ARE EXECUTED. ^IF NO MATCHING <ELSE IS FOUND, EXECUTION CONTINUES
; ON THE FOLLOWING LINE.
; .S
; <IF\S AND <ELSE\S ARE PAIRED LIKE MATCHING PARENTHESES FROM THE INSIDE
; OUT. ^THAT IS, AN <ELSE IS MATCHED WITH THE <IF MOST IMMEDIATELY
; PRECEDING IT IN THE LINE WHICH DOES NOT ALREADY HAVE A MATCHING <ELSE.
; ^THIS IMPLEMENTATION OF <IF-<THEN-<ELSE IS INTENDED TO MATCH
; <BASIC-<PLUS.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 IF A > B THEN STOP}
;	{20 IF A$ _<> B$ GOTO 110 ELSE 500}
;	{30 IF A >= 12.5 THEN 160 ELSE PRINT "A _< 12.5" : GOTO 300}
; \\
; .FILL
;-
; REGISTERS USED - ALL.
;
IF00:	JSR	PC,EVALC0	;EVALUATE CONDITION
	BNE	IF15		;IF TRUE, BRANCH
	MOV	#1,R0		;ACCOUNT FOR CURRENT IF
1$:	MOVB	(R1)+,R2	;GET NEXT CHAR
	CMPB	R2,#S.IF	;IS IT IF?
	BLO	1$		;IF LESS, NOT INTERESTING AT ALL
	BNE	2$		;IF NOT SAME, BRANCH
	INC	R0		;IF SO, COUNT IT
	BR	1$		;AND KEEP LOOKING FOR ELSE
2$:	CMPB	R2,#S.EOS1	;END OF ANY STATEMENT?
	BLO	3$		;IF NOT, BRANCH
	CMPB	R2,#S.EOL2	;END OF LOGICAL LINE?
	BEQ	4$		;IF SO, BRANCH
	INC	STCOUN		;KEEP TRACK OF STATEMENTS FOR GOSUB ETC.
	BR	1$
4$:	DEC	R1		;ELSE BACK UP
	JMP	INIT02		;AND GIVE UP
3$:	CMPB	R2,#S.ELSE	;DO WE HAVE AN ELSE?
	BNE	1$		;IF NOT, KEEP LOOKING
	INC	STCOUN		;ESLE'S COUNT AS NEW STATEMENT!
	DEC	R0		;ALSO, COUNT DOWN THE IF'S
	BNE	1$		;IF NOT ZERO, KEEP LOOKING
	BR	IF01		;IF THIS IS IT, GO TO IT
REM00:
	MOV	LINEHD,R5	;CURRENT LINE HEADER -> R5
	MOV	R1,-(SP)	;SAVE CURRENT TEXT PTR
	MOV	2(R5),R1	;START OF LINE OFFSET -> R1
	ADD	USR,R1		;ADD IN OFFSET OF PROGRAM TEXT
	CLR	R0		;CLEAR FLAG
	SKIP			;GET FIRST SIGNIFICANT THING IN CURRENT LINE
	MOV	R1,R3		;SAVE POSITION IN R3
	MOV	(SP)+,R1	;AND GET BACK OUR REAL POSITION
	CMP	R3,R1		;DO THE TWO MATCH?
	BNE	2$		;IF NOT, BRANCH (WE ARE NOT AT START OF LINE)
	INC	R0		;IF MATCH, SET FLAG THAT THIS IS FIRST THING
2$:	CMPB	(R1)+,#S.EOL1	;LOOK FOR END OF PHYSICAL LINE
	BLO	2$
	BNE	1$		;IF NOT END OF PHYSICAL LINE, BRANCH
	MOVB	#S.EOS1,R2	;FAKE END OF STATEMENT
	TST	R0		;WERE WE AT START OF LINE
	BEQ	3$		;IF NOT, BRANCH
	DEC	STCOUN		;IF SO, BACK US OFF TO ZERO NOW
				;SO RETURN AND NEXT WORK PROPERLY
3$:	JMP	INIT03		;AND JUMP INTO MIDDLE OF INTERPRETER
1$:	DEC	R1		;BACK UP
	JMP	INIT02		;AND DO THINGS REGULAR
;+3
; .SL
; .X ^^REM\\
; .X !
; .SL
; .HEADERLEVEL 1 <REM . . !
; .BR
; ^THE ^^REM\\ARK STATEMENT IS USED TO INSERT COMMENTS INTO THE TEXT
; OF THE ^^BASIC\\ PROGRAM.
; ^IT HAS TWO FORMS: ^^REM\\ AND !.
; ^ALL TEXT FOLLOWING THE ^^REM\\ OR ! WILL BE IGNORED BY THE
; ^^BASIC\\ INTERPRETER UP TO THE END OF A PHYSICAL LINE.
; ^NO OTHER STATEMENTS MAY FOLLOW ON THE SAME LINE AS THEY ARE TREATED
; AS PART OF THE COMMENT.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	{10 REM PROGRAM TO ADD ALL NUMBERS FROM 1 TO 10}
; 	{20 ! AND DEMONSTRATE USE OF REM AND !}
; \\
; .FILL
;-
IF15:	SKIP			;NEXT CHAR
	CMPB	R2,#S.THEN	;IS IT THEN
	BNE	IF09		;IF NOT, TRY FOR GOTO
IF01:	SKIP			;SKIP OVER BLANKS
	DEC	R1		;POINT AT CHARACTER
	TSTCH			;CHECK NUMERIC
	BVS	IF08		;MUST BE A CODE .GT. 140
	BNE	IF08		;ASSUME LET STATEMENT IF ALPHA
IF10:	JMP	GOTO00		;MAKE IT A GO TO
IF08:	JMP	INIT10		;GO BACK TO FIGURE OUT THE REST
IF09:	CMPB	R2,#S.GOTO	;IS IT GOTO
	BEQ	IF10		;IF SO, GO DO IT
IF99:	IFERR			;ILLEGAL IF
OPSET:	SKIP			;GET CHAR
	CMPB	R2,#'<		;IS IT ONE OF
	BEQ	1$
	CMPB	R2,#'=		;THE LEGAL
	BEQ	2$
	CMPB	R2,#'>		;RELATIONAL OPERATORS
	BEQ	3$
	DEC	R1		;IF NOT, BACK UP POINTER
	TST	2(SP)		;CHECK FOR AT LEAST ONE OPERATOR
	BNE	4$		;IF SO, RETURN
	OPRERR			;ELSE ERROR
4$:	RTS	PC
1$:	BIS	#S.LT,2(SP)	;SET APPROPRIATE
	BR	OPSET
2$:	BIS	#S.EQ,2(SP)	;OPERATOR FLAG BIT
	BR	OPSET
3$:	BIS	#S.GT,2(SP)	;ON THE STACK
	BR	OPSET

	.SBTTL	PR00 - PRINT STATEMENT
;+6
; .SKIP
; .X ^^PRINT\\
; .X ^BINARY OUTPUT
; .X ^RANDOM ACCESS ^I/^O
; .HEADERLEVEL 1 <PRINT
; .BREAK
; ^PRINT STATEMENT.
; .NOFILL
; ^FORMAT:
;	^^PRINT [_#N,]V1,V2,V3\\ ETC.
; OR
;	^^PRINT _#N@R,V1,V2,V3\\ ETC.
; .FILL
; ^WHERE ^N IS AN OPTIONAL FILE NUMBER AND ^V1, ^V2, ^V3, ETC.
; ARE ANY LEGAL NUMERIC OR STRING EXPRESSION.
; ^IN THE SECOND FORM ^R IS A RANDOM ACCESS RECORD NUMBER EXPRESSION.
; ^IT MAY HAVE ANY VALUE UP TO THE MAXIMUM ALLOWED IN A DOUBLE
; PRECISION SIGNED INTEGER.
; ^FLOATING POINT VALUES ARE TRUNCATED BEFORE USE.
; ^THE FILE ^N MUST HAVE BEEN OPENED FOR RANDOM ACCESS VIA THE
; ^^/RN\\ SWITCH IN THE ^^OPEN\\ STATEMENT.
; .SL
; ^WHEN EXPRESSIONS ARE SEPARATED BY COMMAS, RESULTS ARE PRINTED
; IN FIELDS OF 14 CHARACTERS EACH.
; ^WHEN EXPRESSIONS ARE SEPARATED BY SEMICOLONS, RESULTS ARE PRINTED
; NEXT TO EACH OTHER WITHOUT ANY SPACES ADDED.
; ^A TRAILING SEMICOLON WILL SUPPRESS ^^_<CR>_<LF>\\.
; ^WHEN PRINTING WITH COMMA SEPARATION, AS MANY FIELDS ARE ALLOWED AS
; CAN FIT ON THE PRINTING DEVICE.
; ^NOTE THAT NUMERIC VALUES, WHEN CONVERTED IN A ^^PRINT\\ STATEMENT
; NORMALLY HAVE A SPACE AT EACH END.
; ^TO AVOID THIS, USE THE ^^STR$\\ FUNCTION.
; .SKIP
; ^ON BINARY FILES, THE FOLLOWING CONDITIONS HOLD: ^^TAB\\ IS IGNORED,
; NO "FIELD" JUSTIFICATION IS PERFORMED AND ALL DATA LIST ITEMS MUST FIT
; INTO THE EXISTING BUFFER.
; ^FLOATING VALUES ARE STORED AS FOUR CONSECUTIVE BYTES WHICH ARE NOT
; WORD ALIGNED.
; ^STRINGS AND NUMERIC VALUES ARE PACKED TOGETHER AND MAY BE COMBINED IN
; ANY ORDER.
; ^IT IS UP TO THE USER TO KEEP TRACK OF THE INTERNAL STORAGE ARRANGEMENT
; FOR FUTURE USE WITH ^^INPUT\\ OR OTHER NON-^^BASIC\\ PROGRAMS.
; .SL
; ^A SYNONYM FOR ^^PRINT\\ IS "?" PRIMARILY FOR CONVENIENCE IN IMMEDIATE
; MODE USE.
; .SL
; ^EXAMPLE:
; .NOFILL
; ^^
;	{50 PRINT A,3.5,"HELLO";A$}
;	{60 PRINT _#3,EXP(.5);X^Y;}
; \\
; .FILL
;-
;+5
; .SKIP
; .X ^^TAB\\
; .X ^PRINT TAB FUNCTION
; .HEADERLEVEL 1 <TAB
; .BREAK
; ^THE ^^TAB\\ FUNCTION IS USED ONLY IN THE PRINT STATEMENT TO SPACE
; TO A GIVEN COLUMN (THE VALUE OF THE NUMERIC ARGUMENT).
; ^THE COLUMN SPECIFIED IS THE ONE IN WHICH SUBSEQUENT PRINTING WILL
; BEGIN.
; ^COLUMNS ARE NUMBERED STARTING WITH 1.
; ^IF THE SPECIFIED COLUMN IS GREATER THAN THE WIDTH OF THE DEVICE BEING
; PRINTED ON, THE TAB IS CALCULATED MODULO THE DEVICE WIDTH.
; ^IF THE SPECIFIED COLUMN IS LESS THAN THE CURRENT PRINT POSITION, THE
; FUNCTION IS IGNORED.
; ^^TAB\\ IS IGNORED ON BINARY OUTPUT FILES.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 PRINT A;TAB(20);A$}
; \\
; .FILL
;-
;		REGISTERS USED 0,1,2,3,4-OR ALL FOR SHORT
;
ASCTAB:	.ASCII	/TAB(/		;STRING FOR COMPARISON
	.EVEN
PR00:	MOV	#1000,R0	;SET FOR OUTPUT OK WANTED
	FNMBR			;SETUP FILE IF SPECIFIED
	MOV	OTPT,R3		;FCB POINTER -> R3
	MOV	14(R3),R3	;FDB POINTER -> R3
	CMP	R3,#OUTQIO	;IS THIS TERMINAL OUTPUT?
	BEQ	2$		;IF SO, IT'S ASCII NO MATTER WHAT!
	BITB	#FD.CR!FD.FTN,F.RATT(R3) ;IF CARR CNTL
	BNE	2$		;BRANCH (NOT BINARY FILE)
	BIS	#2,LINEFL	;SET BINARY BIT
2$:	CLR	-(SP)		;A SWITCH TO FORCE A DELIMITER
PR01:	MOV	#34,R0		;MAKE SURE THIS MAY BYTES ARE AVAILABLE
	TSTOK			;AND FIND OUT FOR SURE
	BLO	PR02		;JUMP IF NOT AVAILABLE
	SKIP			;GET THE NEXT CHARACTER
	CMPB	R2,#',		;CHECK FOR A VALID DELIMITER
	BEQ	PR04		;IS IT A COMMA?
	CMPB	R2,#';
	BEQ	PR09		;IS IT A SEMI-COLON?
	JSR	PC,EOSCHK	;IS THIS END OF STATEMENT?
	BEQ	PR13		;IF SO, GO TO FINAL CODE
	TST	(SP)		;IT'S NOT A DELIMITER
	BLT	PR11		;IF NEGATIVE THEN WE WANTED ONE!
	DEC	R1		;BACK UP TO THE START OF THE EXPRESSION
	MOV	R1,R3		;SET UP FOR TAB CHECK
	MOV	#ASCTAB,R2
	MOV	#4,R4
	JSR	PC,STRCMP
	BEQ	PR03		;IF TAB, PROCESS IT
	EVALS			;TRY FOR STRING EXPRESSION
	BVC	PR15		;BR IF VALID STRING EXPRESSION
	EVAL			;GO FIND THE VALUE
	BVS	PR11		;OVERFLOW IS AN ERROR
	TST	LINEFL		;BINARY?
	BEQ	1$		;IF NOT, BRANCH
	MOV	OTPT,R3		;FCB POINTER -> R3
	MOV	2(R3),R2	;MAX BYTE COUNT -> R2
	SUB	6(R3),R2	;#BYTES LEFT -> R2
	CMP	R2,#4		;ENOUGH?
	BGE	2$		;IF YES, BRANCH
	PRNERR			;(REPLACE WITH MORE SPECIFIC ERROR IN FUTURE)
2$:	STF	AC0,-(SP)	;GET 4 BYTE VALUE ON STACK
	MOV	SP,R0		;R0 IS POINTER TO VALUE
	MOV	#4,R2
	ADD	R2,6(R3)	;ADJUST ACTUAL BYTE COUNT
	ADD	R2,SP		;RESET THE STACK
	MOV	(R3),R4		;CURRENT BUFFER PTR -> R4
3$:	MOVB	(R0)+,(R4)+	;PUT VALUE AWAY
	SOB	R2,3$
	MOV	R4,(R3)		;SAVE BUFFER POINTER
	BR	PR17
1$:	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
	JSR	PC,FTOA00
	MOV	SP,R0		;THE OUTPUT AREA WAS LEFT ON THE STACK
	PRINTL
	ADD	#24,SP		;REMOVE THE OUTPUT AREA
PR10:	MOV	(SP)+,R1	;RESTORE THE TEXT POINTER
PR17:	MOV	#-1,(SP)	;FORCE A DELIMITER
PR12:	BR	PR01
PR04:	TST	LINEFL		;BINARY?
	BNE	PR09		;IF SO, SKIP JUSTIFICATION
	MOV	OTPT,R2		;CONTROL BLOCK POINTER IN R2
	MOV	6(R2),R0	;ACTUAL BYTE COUNT IN R0
	MOV	2(R2),R2	;MAX BYTE COUNT IN R2
	SUB	#14,R2		;SUBTRACT LENGTH OF ONE ZONE
	CMP	R0,R2		;ENOUGH ROOM TO JUSTIFY?
	BLT	1$		;IF SO GO DO IT
	JSR	PC,PR18		;PUT OUT THE LINE
	BR	PR05		;ACT AS THOUGH WE HAD A TERMINATOR
1$:	CMP	OTPT,#TOTPT	;IS THIS THE TERMINAL?
	BNE	PR05		;IF NOT DON'T ACCOUNT FOR CARR CONT.
	DEC	R0		;ACCOUNT FOR FORTRAN CARR. CONTROL
PR05:	NEG	R0		;CALCULATE THE MOD 14 COUNT
PR06:	BGT	PR07		;ADD 14 UNTIL A POSITIVE RESULT
	ADD	#14.,R0		;ADD AND GO AGAIN
	BR	PR06
PR07:	MOVB	#040,R2		;OUTPUT SPACES
PR08:	PRINTC
	DEC	R0		;DECREMENT THE MOD 14 COUNTER
	BGT	PR08		;LOOP IF MORE TO DO
PR09:	MOV	#1,(SP)		;SET DELIMITER FOUND SWITCH
	BR	PR01

PR11:	PRNERR			;ISSUE FATAL ERROR
PR13:	TST	(SP)+		;CHECK FOR TRAILING DELIMITER
	BGT	PR14		;NEGATIVE OR ZERO MEANS CRLF
	JSR	PC,PR18
PR14:	DEC	R1		;BACK UP TO THE TERMINATOR
	CLR	LINEFL		;CLEAN UP FLAGS
	JMP	INIT02		;BACK TO THE INTERPRETER
PR02:	OVFERR			;STORAGE OVERFLOW IN PRINT
PR15:	TST	R4		;CHECK STRING LENGTH
	BEQ	PR17		;IGNORE IF NULL
	TST	LINEFL		;BINARY OUTPUT?
	BEQ	PR16		;IF NOT, SKIP TEST
	MOV	OTPT,R0		;FCB ADD -> R0
	MOV	2(R0),R2	;MAX BYTE COUNT -> R2
	SUB	6(R0),R2	;BYTES LEFT -> R2
	CMP	R4,R2		;ENOUGH ROOM?
	BGT	PR11		;IF NOT, ERROR
PR16:	MOVB	(R3)+,R2	;GET CHAR IN R2
	PRINTC			;PRINT IT
	SOB	R4,PR16		;KEEP GOING TILL DONE
	CLR	(SP)		;SET NO DELIMITER
	BR	PR12		;AND CONTINUE
PR03:	MOV	R3,R1		;UPDATE TEXT POINTER
	EVAL			;GET TAB NUMBER
	BVC	PR11		;MUST END WITH ')'
	TST	LINEFL		;IF BINARY, SKIP
	BNE	PR17		;REST OF TAB NONSENSE
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	OTPT,R2		;CONTROL BLOCK POINTER -> R2
	MOV	6(R2),R0	;ACTUAL COUNT IN R0
5$:	MOV	2(R2),R2	;MAX COUNT IN R2
	STCFI	AC0,R4		;TAB COUNT IN R4
	DEC	R4		;WANT TO END JUST BEFORE DESIRED COL
2$:	CMP	R4,R2		;GET COLUMN IN RANGE
	BLT	1$		;BY SUBTRACTING MODULO
	SUB	R2,R4		;OUTPUT WIDTH
	BR	2$
1$:	CMP	R4,R0		;RELATIVE TO OUTPUT POINTER
	BLE	3$		;WHERE ARE WE?
	SUB	R0,R4		;GET SPACE COUNT IN R4
	MOVB	#40,R2		;CHAR TO OUTPUT IN R2 (SPACE)
4$:	PRINTC
	SOB	R4,4$
3$:	BR	PR10		;GO FINISH UP
PR18:	TSTB	WPASFL		;WRITE PASS ALL SET?
	BEQ	1$		;IF NOT, BRANCH
	MOV	#IO.WVB!TF.WAL,OUTQIO+Q.IOFN ;SET WRITE PASS ALL FCN CODE
	CLRB	OUTQIO+Q.IOPL+4	;SET NO CARR CONTROL
1$:	CRLF
	RTS	PC

	.SBTTL	INP00 - INPUT STATEMENT PROCESSOR
;+6
; .TP 6
; .SKIP
; .X ^^INPUT\\
; .X ^BINARY INPUT
; .X ^RANDOM ACCESS ^I/^O
; .HEADERLEVEL 1 <INPUT
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^INPUT [_#N,] V1,V2,V3\\ ETC.
; OR
;	^^INPUT _#N@R,V1,V2,V3\\ ETC.
; .FILL
; ^WHERE ^N IS AN OPTIONAL FILE NUMBER AND ^V1, ^V2, ^V3 ETC. ARE
; LEGAL STRING OR NUMERIC VARIABLE NAMES.
; ^THE SECOND FORM FOLLOWS THE RULES FOR RANDOM ACCESS DESCRIBED
; FOR THE ^^PRINT\\ STATEMENT.
; ^NUMERIC DATA MUST BE SEPARATED BY COMMAS OR SPACES, SUCCESSIVE
; STRING VARIABLES MUST BE SEPARATED BY A COMMA AFTER THE REQUIRED NUMBER
; OF CHARACTERS HAVE BEEN TYPED IN.
; ^A CHARACTER LEGALITY CHECK IS PERFORMED TO ENSURE THAT ALL CHARACTERS
; ARE BETWEEN OCTAL ^^ASCII\\ CODES 40 AND 137 INCLUSIVE AND 11 (TAB).
; ^IF A "<SET <UPPER <ON" COMMAND HAS BEEN ISSUED, LOWER CASE ASCII WILL
; BE CONVERTED TO UPPER CASE.
; .SKIP
; ^FOR INPUT FROM THE TERMINAL (NO FILE NUMBER), A PROMPT STRING
; (ONLY STRING DEFINED IN QUOTES ALLOWED) MAY BE SPECIFIED BEFORE
; THE VARIABLE LIST.
; ^THIS IS EQUIVALENT TO A <PRINT FOLLOWED BY AN <INPUT.
; ^SEE THIRD EXAMPLE BELOW.
; .SKIP
; ^FOR BINARY FILES THE FOLLOWING CONDITIONS HOLD: FOUR BYTES ARE USED
; FOR EACH NUMERIC (FLOATING) VARIABLE, STRINGS USE AS MANY BYTES AS
; THEY HAVE BEEN DIMENSIONED FOR.
; ^MORE DATA THAN VARIABLES IS NOT CONSIDERED AN ERROR.
; ^INSUFFICIENT DATA IS AN ERROR WITH THE FOLLOWING EXCEPTION:
; A VARIABLE LENGTH STRING WILL HAVE ITS LENGTH SHORTENED TO THE
; AVAILABLE DATA IF DATA RUNS OUT, AND A FIXED LENGTH STRING
; WILL BE BLANK FILLED.
; ^IF DATA RUNS OUT WHILE FILLING A NUMERIC VARIABLE, THE RESULTS
; ARE UNPREDICTABLE AND IN ANY CASE TERMINATE THE PROGRAM WITH AN ERROR.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 INPUT _#3,A1,B1$}
;	{50 INPUT _#4@R+5,X1,X2,A1$}
;	{80 INPUT "WHAT IS YOUR NAME",N$ : ! READ NAME INTO N$}
; \\
; .FILL
;-
;+6
; .SKIP
; .X ^^INPUT LINE\\
; .HEADERLEVEL 1 <INPUT <LINE
; .BREAK
; ^THIS IS THE SAME AS THE INPUT STATEMENT EXCEPT THAT ONLY STRING
; VARIABLES ARE PERMITTED IN THE INPUT LIST AND NO CHARACTER CHECKING IS
; PERFORMED.
; ^THUS NO DELIMITERS ARE RECOGNIZED AND STRING VARIABLES ARE FILLED
; SEQUENTIALLY TO THEIR DIMENSIONED LENGTH WHETHER FIXED OR VARIABLE.
; ^RANDOM ACCESS IS THE SAME AS FOR ^^INPUT\\.
; ^FOR BINARY FILES ^^INPUT#LINE\\ IS THE SAME AS ^^INPUT\\.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{30 INPUT LINE _#3,A1$}
; \\
; .FILL
;-
INP01:	MOV	#1,LINEFL	;SET TO INDICATE "INPUT LINE"
	BR	INP08
INP00:	CLR	LINEFL		;DEFAULT TO NORMAL INPUT
INP08:	SKIP			;CHECK NEXT CHAR
	DEC	R1		;AND BACK UP
	CMPB	R2,#'"		;IS IT START OF A PROMPT STRING
	BNE	1$		;IF NOT, DO REGULAR PROCESS
	EVALS			;EVALUATE THE WHOLE STRING
	BVS	3$		;IF ERROR, GO REPORT
	MOV	#TOTPT,OTPT	;SPECIFY TERMINAL OUTPUT
	TST	R4		;CHECK LEN
	BLE	4$		;IF NONE, SKIP
5$:	MOVB	(R3)+,R2	;PRINT OUT THE CHARACTERS
	PRINTC			;(ALL OF THEM)
	SOB	R4,5$
4$:	SKIP			;SKIP TERMINATOR
	MOV	#TINPT,INPT	;SET FOR TERMINAL INPUT
	CMPB	R2,#',		;CHECK FOR VALID TERMINATOR
	BEQ	6$		;IF COMMA, OK
	CMPB	R2,#';		;SEMICOLON ALSO ALLOWED
	BEQ	6$		;IF IT IS, ALSO BRANCH
	DEC	R1		;ASSUME USER JUST LEFT OUT SEPERATOR
6$:	SKIP			;GET NEXT CHARACTER FROM TERM	FRB FIX BUG
	CMPB	R2,#'A		;SEE IF VALID CHARACTER		WITH INPUT 
	BLT	3$		;IF NOT, AN ERROR
	CMPB	R2,#'Z
	BGT	3$
	DEC	R1		;BACK UP POINTER AGAIN
	BR	2$
1$:	MOV	#400,R0		;SET FOR INPUT OK WANTED
	FNMBR			;SET UP FILE IF SPECIFIED
	MOV	INPT,R3		;FCB ADD -> R3
	BIT	#4000,-2(R3)	;IS BINARY CONTROL BIT SET
	BEQ	2$		;IF NOT, SKIP FLAG SET
	BIS	#2,LINEFL	;SET BINARY BIT
2$:
	JSR	PC,COM00	;GET VARIABLE
	BVC	INP02		;IT IS OK
3$:	MOV	R0,-(SP)	;FRB SAVE A REG
	MOV	OTPT,R0		;PUT CNTRL BLOCK ADDRESS IN R0
	CRLF			;FORCE OUT PROMPT IF STILL HUNG
	MOV	(SP)+,R0	;RESTORE A REG
	INPERR			;ISSUE FATAL ERROR
INP02:
	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
INP10:	CMP	#TINPT,INPT	;IS THIS TERMINAL INPUT??
	BNE	INP07		;SKIP PROMPT IF NOT
	TSTB	PRMTFL		;PROMPT MODE SET?
	BEQ	INP07		;IF NOT, BRANCH
	MOV	#'?,R2		;TELL HIM TO GET WITH IT
	PRINTC
INP07:	BIS	#LOWNOC,LOWFLG	;SHOW NO CONVERSION OF LOWER CASE ALPHA
	PACK			;GET A LINE
	BIC	#LOWNOC,LOWFLG	;RESET FLAG
	JSR	PC,FILL00	;TRY TO SATISFY THE REQUEST
	BVS	INP06		;OVERFLOW IS BAD DATA
	BGT	INP04		;TOO MUCH INPUT TYPED
	BLT	INP05		;NOT ENOUGH INPUT TYPED
	MOV	(SP)+,R1	;RECOVER THE TEST ADDRESS
	MOV	(SP)+,R5	;INPUT LIST POINTER -> R5
	MOV	R5,SP		;THIS IS WHERE STACK USED TO BE
	ADD	#2,SP		;(ALMOST)
	DEC	R1		;BACK UP CHARACTER POINTER
	CLR	LINEFL		;BACK TO NORMAL INPUT
	TST	RUNF		;CHECK FOR IMMEDIATE MODE
	BNE	INP03		;OMIT THIS LITTLE BIT IF RUNNING
	MOVB	#S.EOL2,(R1)
INP03:	JMP	INIT02

INP04:	IN1ERR			;HE TYPED TOO MUCH
	BR	INP10		;TRY AGAIN
INP05:	IN2ERR			;HE DIDN'T TYPE ENOUGH
	BR	INP10		;TRY AGAIN
INP06:	IN3ERR			;HE IS A LOUSY TYPIST
	BR	INP10		;TRY AGAIN
;
; STRCMP - STRING COMPARISON ROUTINE
; ON CALL:
;	R3 CONTAINS ADDRESS OF FIRST STRING
;	R2 CONTAINS ADDRESS OF SECOND STRING
;	R4 CONTAINS LEN FOR COMPARISON
STRCMP:	TST	R4		;IS LEN ZERO?
	BEQ	3$		;IF SO, DONE
4$:	CMPB	(R3)+,(R2)+	;CHARACTERS EQUAL?
	BNE	3$		;IF NOT, RETURN AS FAILED
	SOB	R4,4$		;KEEP GOING TILL DONE
3$:	RTS	PC

	.SBTTL	FILL00 - COMMON DATA ELEMENT FILL ROUTINE
;
; ON ENTRY:
;	R1 POINTS TO START OF DATA
;	LINELN HAS LENGTH OF DATA FOR BINARY OR INPUT LINE
;	STACK AS ON EXIT FROM COM00 PLUS TEXT PTR AND SUBROUTINE LINK
;
; ON EXIT:
;	R1 POINTS PAST END OF DATA USED (TO EOL CHAR IF ASCII)
;	LINELN = REMAINING CHAR COUNT (USUALLY 0) ON BINARY
;	'V' SET ON BAD DATA		(ASCII ONLY)
;	BGT TRUE IF TOO MUCH DATA	(ASCII ONLY)
;	BLT TRUE IF NOT ENOUGH DATA	(ASCII AND BINARY NUMERIC)
;
; NOTE: CONDITION CODES ONLY RELEVANT FOR ASCII DATA AND BINARY NUMERIC
;
; OTHER REGISTERS USED: R0 THROUGH R5, AC0 AND AC1
;
FILL00:
	MOV	4(SP),R5	;START OF LIST ADDRESS -> R5
FILL01:
3$:
	JSR	PC,FILL1	;DO INDIVIDUAL ITEM
	BVS	99$		;ON ERROR BRANCH
	BLT	99$		;ALSO BRANCH IF NOT ENOUGH DATA
	SUB	#10,R5		;POINT TO NEXT ITEM
	TST	(R5)		;ANOTHER ITEM?
	BEQ	4$		;IF NOT, BRANCH
	TST	LINEFL		;DOING BINARY OR INPUT LINE?
	BNE	2$		;IF SO, BRANCH
	CMPB	(R1),#',	;DO WE HAVE NEEDED COMMA?
	BEQ	1$		;IF SO, BRANCH
	CMPB	(R1),#S.EOL2	;AT END?
	BNE	3$		;IF NOT, GO AROUND AGAIN
5$:	CCC			;ELSE SET LESS THAN CONDITION
	SEN
	BR	99$		;AND EXIT
1$:	INC	R1		;PUSH PAST TERMINATOR
	BR	3$		;AND GO AROUND AGAIN
2$:	TST	LINELN		;ANYTHING LEFT?
	BNE	3$		;IF SO, GO AROUND AGAIN
	BR	5$		;ELSE GO SET LESS THAN (NOT ENOUGH DATA)
;
; COME HERE IF NO MORE ITEMS TO FILL
;
4$:	TST	LINEFL		;DOING BINARY OR INPUT LINE?
	BNE	98$		;IF SO, BRANCH (EXCESS IS OK)
	CMPB	(R1),#S.EOL2	;AT END OF LINE?
	BEQ	98$		;IF SO, BRANCH TO SUCCESSFUL EXIT
	CCC			;SETS GREATER THAN CONDITION (TOO MUCH DATA)
99$:	RTS	PC		;RETURN WITH ERROR CONDITION SET
98$:	CLR	R0		;SET 'Z' (SUCCESS)
	RTS	PC
;
; INDIVIDUAL ITEM FILL PROCESSOR
;
; ON ENTRY:
;	R5 POINTS TO 4 WORD ITEM DESCRIPTOR ON STACK
;	R1 HAS START OF TEXT WITH INPUT INFO
;
; ON EXIT:
;	R5 AS ABOVE
;	R1 POINTS PAST END OF THIS ITEM'S TEXT
;
; OTHER REGISTERS USED:
;
FILL1:
	CMP	-2(R5),#10	;DO WE HAVE STRING?
	BEQ	20$		;IF SO, BRANCH
	TST	LINEFL		;STRAIGHT FILL OR CONVERSION?
	BNE	1$		;IF STRAIGHT (BINARY), BRANCH
	ATOF			;ELSE CONVERT NUMBER
	BVS	99$		;ON ERROR, BRANCH
	SKIP			;SKIP OVER ANY TERMINATING BLANKS
	DEC	R1		;AND POINT TO FIRST NON-BLANK
	BR	8$		;GO TO STORE CODE
1$:	BIT	#1,LINEFL	;DOING INPUT LINE?
	BNE	98$		;IF SO, ERROR
	MOV	-2(R5),R0	;DATA TYPE -> R0
	ASR	R0		;DIVIDE BY TWO
	MOVB	10$(R0),R2	;# OF STACK BYTES NEEDED -> R2
	SUB	R2,SP		;GET US THE ROOM ON THE STACK
	MOVB	11$(R0),R2	;GET # BYTES FOR XFER -> R2
	SUB	R2,LINELN	;ADJUST LINE LENGTH
	BLT	9$		;IF NOT ENOUGH INPUT, BRANCH
	MOV	SP,R3		;ADDRESS FOR XFER -> R3
2$:	MOVB	(R1)+,(R3)+	;TRANSFER IN
	SOB	R2,2$		;BINARY INFO
	ASL	R0		;BACK TO ORIGINAL VALUE
	JMP	@3$(R0)		;AND GO TO PROPER CODE
3$:	.WORD	4$	;REAL*4
	.WORD	5$	;INTEGER
	.WORD	6$	;BYTE
	.WORD	7$	;REAL*8
4$:	LDF	(SP)+,AC0	;REAL VALUE -> AC0
	BR	8$		;GO TO FINISH
5$:	LDCIF	(SP)+,AC0	;INTEGER -> AC0
	BR	8$		;GO TO FINISH
6$:	MOVB	(SP),R2		;INTEGER VALUE FROM BYTE
	TST	(SP)+		;CLEAN STACK
	LDCIF	R2,AC0		;AND INTEGER -> AC0
	BR	8$		;GO TO FINISH
7$:	LDCDF	(SP)+,AC0	;CONVERT DOUBLE TO FLOATING
8$:	MOV	(R5),R3		;DATA ITEM HEADER -> R3
	LDF	-6(R5),AC1	;OFFSET -> AC1
	JSR	PC,STONUM	;STORE NUMBER
	RTS	PC		;AND RETURN
9$:	ADD	R2,SP		;CLEAN STACK
	RTS	PC		;AND RETURN WITHOUT CHANGING VALUE
10$:	.BYTE	4,2,2,10	;# BYTES NEEDED FOR STACK
11$:	.BYTE	4,2,1,10	;# BYTES NEEDED FOR XFER
;
; STRING SECTION
;
20$:
	MOV	(R5),R0		;DATA ITEM HEADER -> R0
	BIT	#10000,(R0)	;VIRTUAL?
	BNE	22$		;IF SO, BRANCH
	MOVB	4(R0),R4	;LENGTH -> R4
	BIC	#177400,R4	;CLEAR ANY SIGN EXTEND
	TST	4(R0)		;IS THIS VARIABLE LENGTH
	BGE	21$		;IF NOT, BRANCH
	NEG	R4		;IF SO, MAKE IT NEGATIVE FOR FURTHER PROCESSING
21$:	BR	23$		;BRANCH AROUND VIRTUAL CODE
22$:	MOV	10(R0),R4	;GET VIRTUAL ITEM LENGTH -> R4
23$:	MOV	R1,R3		;SET START OF STRING -> R3
	TST	LINEFL		;INPUT LINE OR BINARY?
	BNE	30$		;IF SO, BRANCH
				;ELSE REGULAR ASCII INPUT
	TST	R4		;FIXED OR VAR?
	BPL	26$		;IF FIXED, BRANCH
;
; ASCII INPUT, VARIABLE LENGTH
;
	CLR	R4		;START WITH ZERO LENGTH STRING
24$:	MOVB	(R1)+,R2	;NEXT CHAR -> R2
	CMPB	R2,#',		;IS IT COMMA?
	BEQ	25$		;IF SO, BRANCH
	CMPB	R2,#S.EOL2	;END OF LINE?
	BHIS	25$		;IF SO, ALSO BRANCH
	INC	R4		;ELSE IT'S A GOOD CHARACTER
	BR	24$		;SO ADD 1 AND KEEP COUNTING
;
; ASCII INPUT, FIXED STRING LENGTH
;
26$:	MOV	R4,-(SP)	;SAVE LENGTH
27$:	MOVB	(R1)+,R2	;NEXT CHAR -> R2
	CMPB	R2,#',		;LOOK FOR COMMA
	BEQ	29$		;IF SO, END OF STRING
	CMPB	R2,#S.EOL2	;OR COULD BE END OF LINE
	BHIS	29$		;IF FOUND, BRANCH
	SOB	R4,27$		;KEEP LOOKING FOR WHOLE STRING LENGTH
28$:	MOVB	(R1)+,R2	;AND LOOK FOR TERMINATOR OF STRING
	CMPB	R2,#',		;EITHER COMMA
	BEQ	29$
	CMPB	R2,#S.EOL2	;OR END OF LINE
	BEQ	29$		;WHEN FOUND, GO TO COMMON FINISH
	BR	28$		;KEEP GOING TILL IT'S FOUND
29$:	SUB	R4,(SP)		;REDUCE LENGTH STORED ON STACK
	MOV	(SP)+,R4	;AND POP ADJUSTED LENGTH -> R4
25$:	DEC	R1		;BACK UP TEXT PTR TO TERMINATOR
	BR	32$		;AND BRANCH TO STORAGE SECTION
;
;BINARY (OR INPUT LINE) FIXED AND VARIABLE
;
30$:	TST	R4		;MAKE SURE
	BPL	33$		;LENGTH IS POSITIVE
	NEG	R4
33$:	CMP	R4,LINELN	;DO WE HAVE ENOUGH BYTES
	BLE	31$		;IF SO, BRANCH
	MOV	LINELN,R4	;ELSE USE JUST WHAT'S LEFT
31$:	SUB	R4,LINELN	;ADJUST REMAINING LENGTH
32$:	MOV	(R5),R0		;SET UP R0 (DATA ITEM ADDRESS)
	LDF	-6(R5),AC0	;AND OFFSET
	JSR	PC,STOSTR	;STORE IT
	CCC			;MAKE SURE EVERYTHING LOOKS OK
99$:	RTS	PC		;AND RETURN
98$:	INPERR

	.SBTTL	COM00 - COMMON EXPRESSION HANDLER FOR READ AND INPUT
;
; ON ENTRY:
;	R1 IS TEXT PTR
;
; ON EXIT:
;	R1 POINTS PAST END OF STATEMENT
;	'V' SET IF ERROR IN VARIABLE LIST
; STACK ON EXIT:
;	DATA PTR	(1 WORD)
;	DATA TYPE	(1 WORD)
;	OFFSET		(2 WORDS)
;	DATA PTR
;	DATA TYPE
;	OFFSET
;	  .
;	  .
;	  .
;	NULL
; SP -> PTR TO START OF LIST
;
; OTHER REGISTERS USED: POTENTIALLY ALL (INCL FLOATING PT.)
;
COM00:
	LDCIF	SP,AC2		;MARK WHERE START OF LIST WILL BE
	LDCIF	(SP)+,AC3	;SAVE RETURN ADDRESS
	STF	AC3,AC5		;AND MOVE BOTH ITEMS
	STF	AC2,AC4		;OUT OF THE WAY
	CLR	R2		;IN CASE OF ERROR
3$:	JSR	PC,GETHDR	;GET HEADER AND TYPE
	BVS	5$		;ON ERROR, BRANCH
                                                                               ;DSS1
	.IF	NDF,DEFVAR	;IF NO AUTOMATIC VARIABLE DEFINITION            ;DSS1
	BNE	1$		;VARIABLE EXISTS                                ;DSS1
	JSR	PC,NEWVAR	;NOT DEFINED....DEFINE IT                       ;DSS1
	.ENDC                                                                   ;DSS1
                                                                                ;DSS1
1$:	BIT	#1,LINEFL	;INPUT LINE IN PROGRESS?                        ;**-2
	BEQ	2$		;IF NOT, BRANCH
	CMP	R0,#10		;IF SO, DO WE HAVE STRING?
	BNE	5$		;IF NOT, ERROR
2$:	CLR	-(SP)		;SPACE FOR HEADER ADDRESS
	MOV	R0,-(SP)	;SAVE DATA TYPE
	JSR	PC,GTOFFS	;GET OFFSET FOR VARIABLE
	MOV	R3,2(SP)	;STORE HEADER ADDRESS
	STF	AC0,-(SP)	;AND OFFSET
	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#',		;COMMA?
	BEQ	3$		;IF SO, GO AROUND AGAIN
5$:	CLR	-(SP)		;SET LIST END MARKER
	LDF	AC4,AC2		;LET'S GET BACK START OF LIST
	LDF	AC5,AC3		;AND RETURN ADDRESS
	STCFI	AC2,-(SP)	;CONVERT START TO INTEGER
	STCFI	AC3,-(SP)	;AND ALSO RETURN ADDRESS ON STACK
	JSR	PC,EOSCHK	;END OF STATEMENT?
	BEQ	4$		;IF SO, BRANCH
	SEV			;ELSE SET ERROR CODE
4$:	RTS	PC		;AND RETURN

;
; ROUTINE EOSCHK
; TO CHECK FOR LEGIT END OF STATEMENT
;
; ON ENTRY:
;	R2 HAS CHAR TO BE CHECKED
;
; ON EXIT:
;	'Z' SET IF END
;	'Z' CLEAR IF NOT END CHAR
;
; OTHER REGISTERS USED: NONE
;
EOSCHK:
	CMPB	R2,#S.EOS1	;END OF STATEMENT PROPER?
	BHIS	1$		;IF SO, SUCCESS (BRANCH)
	CMPB	R2,#S.ELSE	;AN ELSE TOKEN?
	BEQ	1$		;IF SO, ALSO END
	CMPB	R2,#S.EXC	;COMMENT?
	BEQ	1$		;IF SO, ALSO END
	CCC
	RTS	PC		;RETURN WITH NO COND. CODES SET
1$:	CCC
	SEZ			;INDICATE SUCCESS (END OF STATEMENT)
	RTS	PC		;AND RETURN
	.SBTTL	READ00 - READ STATEMENT PROCESSOR
;+3
; .SKIP
; .X ^^READ\\
; .X ^^DATA\\
; .HEADERLEVEL 1 <READ . . <DATA
; .BREAK
; ^THE ^^READ\\ STATEMENT INPUTS DATA FROM THE ^^DATA\\ STATEMENT.
; ^THE RULES FOR ^^INPUT\\ APPLY TO ^^READ\\, BUT ^^DATA\\ LISTS ARE
; USED AS NEEDED WHEREAS ^^INPUT\\ INPUTS AN ENTIRE LINE FROM A FILE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{10 DATA 10.5,-76,1E7,FRANK}
;	{50 READ A,B,C,D$}
; \\
; .FILL
;-
READ00:
	CLR	LINEFL		;JUST IN CASE INPUT LINE WAS ^Z'ED
	JSR	PC,COM00
	BVC	2$
	REAERR
2$:
	MOV	(SP),R5		;SET UP LIST POINTER
	MOV	R1,-(SP)
	MOV	DATI,R1		;PICK UP THE CURRENT POINTER
	BNE	1$		;START NOW IF WE ARE SOME WHERE
	MOV	USR,R1		;START FROM THE BEGINING
	BR	5$		;AND LOOK FOR A DATA STATEMENT
1$:	ADD	USR,R1		;MAKE OFFSET INTO REAL ADDRESS
3$:	CMPB	(R1),#S.EOL2	;NEXT
	BEQ	5$		;DATA STATEMENT
	CMPB	(R1),#',	;AT A COMMA?
	BNE	4$		;IF NOT, BRANCH
	INC	R1		;IF SO, PUSH PAST IT
4$:	JSR	PC,FILL01	;GO GET DATA
	BVS	7$		;OH NO AN ERROR
	BLT	5$		;BRANCH ON NOT ENOUGH DATA
	SUB	USR,R1		;MAKE ADDRESS INTO OFFSET
	MOV	R1,DATI		;SAVE THE POINTER FOR NEXT TIME
	MOV	(SP)+,R1	;GET BACK THE TEXT POINTER
	MOV	(SP)+,R5	;DATA ITEM LIST PTR -> R5
	MOV	R5,SP		;WHICH IS START OF OLD STACK
	ADD	#2,SP		;IF YOU ADD 2
	DEC	R1
	JMP	INIT02		;BACK TO THE BOSS
5$:	MOV	ENDTXT,R3	;FIND THE UPPER LIMIT
6$:	CMPB	#S.EXC,(R1)	;ARE WE ENTERING COMMENT FIELD ?
	BNE	61$		;NO
	BIS	#2,DATASK	;YES SET FLAG
	BR	65$		;AND CAN SKIP FURTHER CHECKS
61$:	CMPB	#S.REM,(R1)	;OR REMARK FIELD ?
	BNE	62$		;NO
	BIS	#2,DATASK	;YES, SET FLAG
	BR	65$		;AND SKIP FURTHER CHECKS
62$:	CMPB	#'",(R1)	;OR ENTERING/LEAVING QUOTE FIELD ?
	BNE	64$		;BR IF NOT
	BIT	#1,DATASK	;ARE WE ALREADY IN QUOTE FIELD
	BEQ	63$		;NO
	BIC	#1,DATASK	;YES, SHOW EXITING QUOTE FIELD
	BR	65$		;AND SKIP FURTHER TESTS
63$:	BIS	#1,DATASK	;SHOW ENTERING QUOTE FIELD
	BR	65$		;AND SKIP FURTHER TESTS
64$:	CMPB	#S.EOL1,(R1)	;FINALLY, END OF LINE ?
	BNE	65$		;BR IF NOT
	CLR	DATASK		;YES, CLEAR SKIP DATA FLAGS
65$:	CMPB	#S.EOL2,(R1)	;OR END OF PHYSICAL LINE ?
	BNE	651$		;BR IF NOT
	CLR	DATASK		;YES, CLEAR SKIP DATA FLAGS
651$:	TST	DATASK		;SHOULD WE NOT TRY FOR DATA STATEMENT ?
	BEQ	66$		;NO, DO CHECK
	INC	R1		;YES, JUST SKIP THE CHARACTER
	BR	67$		;AND TRY AGAIN
66$:	CMPB	#S.DATA,(R1)+	;IS WE AT A DATA STATEMENT??
67$:	BEQ	3$		;IF SO GO FINISH WHAT WE STARTED
	CMP	R1,R3		;SEE IF IT'S ALL OVER
	BLO	6$		;BRANCH IF MORE TEXT
	RE1ERR			;FATAL ERROR
7$:	RE2ERR			;FATAL ERROR

	.SBTTL	FOR00 - FOR STATEMENT
;+3
; .SKIP
; .X ^^FOR\\
; .HEADERLEVEL 1 <FOR
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^FOR _<VARIABLE> = _<EXP1> TO _<EXP2> [STEP _<EXP3>]\\
; .FILL
; ^THIS STATEMENT SETS UP AND CONTROLS EXECUTION OF A ^^FOR-NEXT\\ LOOP.
; ^ANY NUMERIC EXPRESSIONS MAY BE USED.
; ^THE VARIABLE MUST BE, HOWEVER, A SIMPLE FLOATING VARIABLE
; (NO SUBSCRIPT).
; .FG 1
; ^THE STATEMENTS FOLLOWING THE ^^FOR\\ STATEMENT UNTIL THE ASSOCIATED
; ^^NEXT\\ STATEMENT COMPRISE THE LOOP.
; ^THE LOOP BEGINS WITH THE VARIABLE SET EQUAL TO ^^EXP1\\ AND
; CONTINUES BY INCREMENTING THE VARIABLE BY ^^EXP3\\ (DEFAULTED TO ONE)
; UNTIL IT REACHES OR PASSES THE VALUE OF ^^EXP2\\ (THEREFORE THE LOOP
; MAY NOT BE EXECUTED AT ALL).
; ^FINAL VALUE OF THE VARIABLE IS ITS VALUE THE LAST TIME THROUGH THE
; LOOP.
; .NOTE
; ^CHANGING THE VALUE OF THE VARIABLE WITHIN THE LOOP WILL
; AFFECT THE NUMBER OF TIMES THE LOOP IS EXECUTED.
; .ENDNOTE
; ^EXAMPLE:
; .NOFILL
; ^^
;	{40 FOR I=1 TO 5.5 STEP .5}
;	{100 FOR J1=-.1 TO -1.5 STEP -.1}
; \\
; .FILL
;-
;  REGISTERS USED - ALL.
;
FOR00:	JSR	PC,GETHDR	;GET CONTROL VARIABLE HEADER
	BVS	FOR99		;ON ERROR, BRANCH
                                                                               ;DSS1
	.IF	NDF,DEFVAR	;IF NO AUTOMATIC VARIABLE DEFINITION            ;DSS1
	BNE	1$		;VARIABLE EXISTS                                ;DSS1
	JSR	PC,NEWVAR	;NOT DEFINED....DEFINE IT                       ;DSS1
	.ENDC                                                                   ;DSS1
                                                                                ;DSS1
1$:	SKIP			;GET NEXT CHAR                                  ;**-2
	CMPB	R2,#'=		;IS IT EQUAL SIGN (SIMPLE VARIABLE ONLY)
	BNE	FOR99		;IF NOT, ERROR
	BIT	#10000,(R3)	;IS IT VIRTUAL?
	BNE	FOR99		;ALSO ILLEGAL IF SO
	CLR	-(SP)		;SET UP A SLOT ON STACK
	MOV	R4,-(SP)	;AND SAVE VARIABLE HEADER
	DEC	R1		;BACK OFF TO EQUAL SIGN SO THE NEXT
				;SUBROUTINE DOESN'T GET CONFUSED
	JSR	PC,GTOFFS	;AND GET OFFSET (R0 HAS ADDRESS)
	SKIP			;NOW POINT TO NEXT NON-BLANK AFTER '='
FOR02:	MOV	R0,2(SP)	;SAVE DATA ADDRESS
	MOV	(SP),R4		;RESTORE VARIABLE HEADER
	JSR	PC,SCHFOR	;SEE IF WE HAVE A CONTROL BLOCK
	BEQ	FOR03		;IF NOT, BRANCH
	JSR	PC,DELFOR	;IF SO, GO DELETE IT
FOR03:	MOV	#20,R0		;CHECK FOR ROOM
	TSTOK
	BHIS	1$		;IF OK, BRANCH
	OVFERR
1$:	MOV	STGOSB,R2	;START OF BLOCK TO MOVE -> R2
	MOV	STFONX,R3	;END OF BLOCK -> R3
	JSR	PC,SLDN		;SLIDE IT DOWN BY R0 BYTES
	SUB	R0,STGOSB	;ADJUST POINTERS
	SUB	R0,STFONX
	MOV	STFONX,R3	;R3 HAS START OF NEW CONTROL BLOCK
	MOV	(SP)+,(R3)	;GET SIXBIT NAME FROM STACK TO CTRL BLOCK
	MOV	(SP)+,R0	;STORAGE ADDRESS FOR CTRL VARIABLE -> R0
	MOV	R0,6(R3)	;STORE IT AWAY
	SUB	STUDAT,6(R3)	;AS OFFSET
	MOV	LINENO,2(R3)	;SET UP LINE NUMBER
	MOV	STCOUN,4(R3)	;AND STATEMENT COUNT
	MOV	R3,-(SP)	;SAVE CTRL BLOCK ADDRESS
	MOV	R0,-(SP)	;AND CTRL VARIABLE ADDRESS
	EVAL			;GET THE STARTING FORMULA
	MOV	(SP)+,R0	;DESTINATION
	STF	AC0,(R0)+	;PUT AWAY THE VALUE
	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#S.TO	;IS IT 'TO' TOKEN
	BNE	FOR99		;NO
	EVAL			;YES
	STF	AC0,-(SP)	;PUT ENDING VALUE AWAY
	SKIP			;GET NEXT CHAR
	CMPB	R2,#S.STEP	;IS IT STEP?
	BEQ	2$		;IF SO, BRANCH
	DEC	R1		;ELSE BACK UP
	LDCIF	#1,AC0		;SET DEFAULT STEP
	BR	FOR04		;AND SKIP EVALUATION OF STEP
2$:	EVAL			;EVALUATE THE STEP VALUE
FOR04:	LDF	(SP)+,AC1	;GET ENDING VALUE
	MOV	(SP)+,R3	;RESTORE START OF CTRL BLOCK -> R3
	STF	AC1,14(R3)	;STORE ENDING VALUE
	STF	AC0,10(R3)	;PUT THE STEP VALUE AWAY
FOR06:	JSR	PC,CHKFOR	;GO CHECK IF AT END OF LOOP ALREADY
	BGE	FOR12		;IF NOT, GO EXECUTE
	MOV	(R3),-(SP)	;SAVE SIXBIT VARIABLE NAME FOR FUTURE
	JSR	PC,DELFOR	;DELETE FOR CONTROL BLOCK
	BR	FOR09		;AND GO LOOK FOR END OF LOOP
FOR12:	JMP	INIT02		;GO DO NEXT STATEMENT
FOR99:	FORERR
FOR09:	MOV	BOLNHD,R3	;SET UP TO LOOK IMMEDIATELY FOR END OF
	MOV	LINEHD,R5	;LOOP (FOR LOOP IS OVER BEFORE IT STARTS)
FOR10:	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#S.NEXT	;IS IT A "NEXT"?
	BEQ	FOR11		;IF SO, GO LOOK AT IT
	JUNKIT			;IF NOT, SKIP REST OF STATEMENT
	CMPB	(R1)+,#S.EOL2	;END OF LINE?
	BNE	2$		;IF NOT (JUST END OF STATEMENT), BRANCH
	SUB	#4,R5		;GET NEXT LINE HEADER -> R5
	CMP	R5,R3		;PAST END?
	BHIS	1$		;IF NOT, CONTINUE
	NXTERR			;IF SO, ERROR (FOR WITHOUT NEXT)
1$:	MOV	2(R5),R1	;START OF NEXT LINE -> R1
	ADD	USR,R1		;ADD IN OFFSET
	MOV	#1,STCOUN	;INIT STATEMENT COUNT
	BR	FOR10		;AND KEEP LOOKING
2$:	INC	STCOUN		;PUSH ON IN LINE
	BR	FOR10		;AND KEEP LOOKING
FOR11:	GETVAR
	CMP	R4,@SP		;IS VARIABLE CORRECT?
	BNE	FOR16		; LOOP UNTIL FOUND OR FAILURE
	TST	(SP)+		;WE-UNS IS HERE BOSS
FOR15:	DEC	R1
	MOV	R5,LINEHD	;UPDATE CURRENT LINE HEADER
	MOV	(R5),LINENO	;AND LINE #
	BR	FOR12		;AND IS DONE
FOR16:	CMPB	R2,#',		;LOOK FOR FORM: NEXT I,J
	BEQ	FOR11		;IF SO, TRY AGAIN
	BR	FOR10		;ELSE CONTINUE REGULAR SEARCH

	.SBTTL	NEXT00 - NEXT STATEMENT TO TERMINATE FOR LOOP
;+3
; .SKIP
; .X ^^NEXT\\
; .HEADERLEVEL 1 <NEXT
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^NEXT _<VARIABLE>\\
; .FILL
; ^THIS STATEMENT TERMINATES THE LOOP BEGUN BY THE
; IMMEDIATELY PRECEDING ^^FOR\\ STATEMENT
; WITH THE SAME VARIABLE NAME.
; ^A CONCATENATED FORM OF TWO <NEXT STATEMENTS IS SHOWN IN THE SECOND
; EXAMPLE. ^NOTE, HOWEVER THAT IT IS NOT POSSIBLE TO BRANCH TO THE
; SECOND (IMPLIED) <NEXT (<NEXT#^J) WITHOUT ENCOUNTERING <NEXT#^I.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	{70 NEXT I}
;	{100 NEXT I,J}
; \\
; .FILL
;-
;	REGISTERS USED - ALL.
;
NEXT00:	GETVAR			;GET THE CONTROL VARIABLE
	JSR	PC,SCHFOR	;LOOK FOR RIGHT FOR/NEXT CTRL BLOCK
	BEQ	NEXT99		;NOT FOUND
	JSR	PC,CHKFOR	;CHECK IF LOOP DONE
	BLE	NEXT01		;IF SO, BRANCH
NEXT03:	LDF	(R0),AC0	;GET CONTROL VARIABLE
	ADDF	10(R3),AC0	;ADD IN STEP
	LDF	14(R3),AC1	;TERMINAL VALUE -> AC1
	SUBF	AC0,AC1		;TERM-NEW -> AC1
	DIVF	10(R3),AC1	;(TERM-NEW)/STEP -> AC1
	CFCC			;COPY CONDITION CODES
	BMI	NEXT01		;IF PAST TERMINAL VALUE, BRANCH
	STF	AC0,(R0)	;PUT BACK NEW VALUE
	MOV	2(R3),R0	;LINE # -> R0
	MOV	4(R3),-(SP)	;STATEMENT COUNT ON STACK
	FINDLN			;FIND WHERE IT BELONGS
	MOV	(SP)+,R2	;STATEMENT COUNT -> R2
	JSR	PC,STFIND	;FIND PLACE IN LINE (PRINT TRACE MESSAGE)
	JMP	INIT03		;AND CONTINUE IN INTERPRETER
NEXT99:	NXMERR			;NEXT WITHOUT FOR
NEXT01:	MOV	R2,-(SP)	;SAVE NEXT CHAR
	JSR	PC,DELFOR	;DELETE CTRL BLOCK
	CMPB	(SP)+,#',	;IS NEXT CHAR A COMMA?
	BEQ	NEXT00		;IF SO, START CHECK OVER
	DEC	R1		;BACK UP TEXT PTR
	JMP	INIT02		;AND CONTINUE PROCESSING
;
; ROUTINE TO SEARCH FOR A GIVEN FOR/NEXT CTRL BLOCK
; ON ENTRY:
;	R4 HAS SIXBIT NAME
;
; ON EXIT:
;	R4 UNCHANGED
;	'Z' SET IF NOT FOUND, R3 = 0
;	'Z' CLEAR IF FOUND, R3 = ADDRESS OF CTRL BLOCK
;
; OTHER REGISTERS USED: NONE
;
SCHFOR:	MOV	STFONX,R3	;START OF FOR/NEXT CTRL BLOCK AREA -> R3
1$:	CMP	R3,STUFDB	;AT END YET?
	BHIS	3$		;IF SO, BRANCH
	CMP	R4,(R3)		;IS THIS THE RIGHT ONE?
	BNE	2$		;IF NOT, BRANCH
	CLZ			;IF SO, INDICATE SUCCESS
	RTS	PC		;AND RETURN
2$:	ADD	#20,R3		;ADD SIZE OF CTRL BLOCK
	BR	1$		;SO WE POINT TO NEXT ONE AND LOOK AGAIN
3$:	CLR	R3		;INDICATE FAILURE
	RTS	PC		;AND RETURN
;
; ROUTINE TO DELETE A FOR/NEXT CTRL BLOCK
; ON ENTRY:
;	R3 POINTS TO CTRL BLOCK TO BE DELETED
; ON EXIT:
;	R3 UNDETERMINED
; OTHER REGISTERS USED: R0,R2
;
DELFOR:	MOV	STGOSB,R2	;START OF BLOCK TO BE MOVED -> R2
	MOV	#20,R0		;AMOUNT TO MOVE UP
	JSR	PC,SLUP		;GO SLIDE IT UP
	ADD	R0,STGOSB	;ADJUST PTRS
	ADD	R0,STFONX
	RTS	PC
;
; ROUTINE TO CHECK ON FINISHED/NOT FINISHED CONDITION
; OF FOR/NEXT LOOP.
; ON ENTRY:
;	R3 POINTS TO FOR/NEXT CTRL BLOCK
; ON EXIT:
;	R3 UNCHANGED
;	'Z' SET IF CTRL VARIABLE AT END VALUE, CLEAR OTHERWISE
;	'N' SET IF CTRL VARIABLE PAST END VALUE, CLEAR OTHERWISE
;	R0 HAS ACTUAL STORAGE ADDRESS OF CONTROL VARIABLE
; REGISTERS USED:
;	AC0
;
CHKFOR:	LDF	14(R3),AC0	;TERM VALUE -> AC0
	MOV	6(R3),R0	;OFFSET OF CTRL VARIABLE -> R0
	ADD	STUDAT,R0	;MAKE IT ACTUAL ADDRESS
	SUBF	(R0),AC0	;TERM VALUE - CURRENT VALUE -> AC0
	DIVF	10(R3),AC0	;(TERM-CURRENT)/STEP -> AC0
	CFCC			;COPY CONDITION CODES
	RTS	PC		;AND RETURN
	.END
;