;*********
;        *
; 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
;

	;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	ARYLG,ARYL00	;COMPUTE ARRAY LENGTH
	TRPSUB	ATOF,ATOF00	;ASCII TO FLOATING
	TRPSUB	ATOI,ATOI00	;ASCII TO INTEGER
	TRPSUB	CLOSEF,CLOS00	;CLOSE ANY OPEN FILES
	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	GETADR,GTDR00	;GET ADDRESS OF A VARIABLE
	TRPSUB	GETNUM,GET00	;GET COMMAND PARAMETER
	TRPSUB	GETSAD,GTSD00	;GET ADDRESS OF STRING
	TRPSUB	GETVAR,GETV00	;GET TRUNCATED VARIABLE
	TRPSUB	ITOA,ITOA00	;CONVERT INTEGER TO ASCII
	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	PSHNAM,PSH00	;PUSH NAMED VARIABLE ONTO LIST
	TRPSUB	PSHSTR,PSHS00	;PUSH STRING DESCRIPTOR ONTO LIST
	TRPSUB	PUSH,PUSH00	;PUSH ONE WORD INTO USER LIST
	TRPSUB	SCRNCH,SCR00	;DELETE N BYTES FROM USER SPACE
	TRPSUB	SKIP,SKIP00	;SKIP OVER SPACES IN INPUT TEXT
	TRPSUB	SQUISH,SQU00	;DELETE TEXT TO TERMINATOR AND PACK
	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	SUBSCR,SUBS00	;COMPUTE A SUBSCRIPT EXPRESSION
	TRPSUB	TSTCH,TST00	;TEST CHAR (IN R2) ALPHA VS NUMERIC
	TRPSUB	TSTOK,TSTU00	;CHECK, IS THERE ENOUGH USER SPACE
	TRPSUB	TWOCHR,TWO00	;PACK TWO CHARACTERS IN R4
	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
;
; GLOBALS--RETURNS TO MAIN
;
	.GLOBL	INIT00,	INIT02,	INIT03,	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.CON
	.GLOBL	S.EOL	PARLST	P.ERCD	P.LINE	P.FCS
	.GLOBL	STCOUN
;
; GLOBALS--ENTRY POINTS
;
	.GLOBL	STOP00,	RUN00,	GOSB00,	GOTO00,	RES00
	.GLOBL	RET00,	DIM00,	DEF00,	EVAL00,	GTP00
	.GLOBL	GTDR00,	LET00,	IF00,	PR00,	INP00
	.GLOBL	READ00,	FOR00,	NEXT00,	REM00,	STOP02
	.GLOBL	RUN01,	EVLS00,	SET00,	GTSD00	STRCMP
	.GLOBL	ATTACH	DETACH	GOTO02	GOTO03	GOTO04
	.GLOBL	INP01	ONGT00
;
; GLOBALS--STRING FUNCTION ENTRY POINTS
;
	.GLOBL	SBS00	SEG00	RJS00	LJS00	FCHR00
	.GLOBL	TRM00	LTR00	DAT00	TIM00	CHR00
	.GLOBL	OCT00	OCS00	LEFT00	RIGHT0	DDAT00
	.GLOBL	PIECE0	SPACE0	STRG00
;
; GLOBALS--NUMERIC FUNCTION ENTRY POINTS
	.GLOBL	INX00	NRC00	LEN00	VAL00	ASC00
	.GLOBL	OCB00	COR00	ERR00	ERL00	FCS00
;
; 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

;
; RSX MACRO CALLS
	.MCALL	GTIM$S	QIOW$	DIR$
;
; LOCAL MACROS
;
	.MACRO	JSTERR		;ERROR IN LEFT OR RIGHT JUSTIFY FCN
	STRERR			;USE OLD CODE FOR NOW
	.ENDM
;
; PSECT DEFINITIONS
;
	.PSECT	BASIC2,RW,I,GBL,REL,CON,LOW	;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
; .ID -5
; ^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
;+3
; .SKIP
; .X ^^STOP\\
; .X ^^END\\
; .INDENT -5
; ^^STOP\\
; .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:	MOV	ENDSTK,SP	;RESTORE THE STACK
	MOV	LINENO,LASTEX	;SAVE LAST EXECUTED LINE NO.
	CLR	LINENO
	JMP	INIT00		; ASK WHAT NEXT
STOP01:	.ASCIZ	/STOP AT LINE /
	.EVEN
	.SBTTL	RUN00 - START PROGRAM EXECUTION
;+2
; .SKIP
; .X ^^RUN\\
; .INDENT -5
; ^^RUN\\
; .BREAK
; ^MAY BE USED IN IMMEDIATE MODE TO START PROGRAM EXECUTION OR BY
; SPECIFYING A FILE IN QUOTES TO RUN ANOTHER ^^BASIC\\ PROGRAM
; STORED ON DISK.
; ^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.
; ^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.EOL	;A LINE FEED?
	BEQ	4$		;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\\
; .INDENT -5
; ^^
; GOSUB N
; .INDENT -5
; 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
;
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
	STCFI	AC0,R0		;CONVERT TO INTEGER
	CFCC
	BGT	GOTO03		;IF POS, NON-ZERO, OK
	LNNERR
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
	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
	CRLF			;END THE LINE
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
TRCMSG:	.ASCIZ	/ BRANCH TO LINE /
	.EVEN
	.SBTTL	ON <EXP> GOTO
	.SBTTL	ON <EXP> GOSUB
;+3
; .SKIP
; .X ^^ON _<EXP> GOTO _<LINE _# LIST>\\
; .X ^^ON _<EXP> GOSUB _<LINE _# LIST>\\
; .ID -5
; ^^
; ON _<EXP> GOTO _<LINE _# LIST>
; .ID -5
; ON _<EXP> 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.EOL	;IS IT END OF LINE?
	BEQ	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
;+3
; .SKIP
; .X ^^RESTORE\\
; .X ^FILE RESTORE
; .INDENT -5
; ^^
; 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\\
; .INDENT -5
; ^^
; 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	R0,LINENO	;MAKE THIS CURRENT LINE NUMBER
	MOV	R5,LINEHD	;AND SET CURRENT LINE HEADER
	MOV	(SP)+,R3	;GET BACK LAST ADDRESS
	MOV	(R3),R2		;GET COUNT OF STATEMENTS
	MOV	R2,STCOUN	;RECORD STATEMENT COUNT
2$:	INC	R1		;PUSH PAST TERMINATOR (IN CASE 2ND TIME)
	JUNKIT			;FIND END OF STATEMENT
	SOB	R2,2$		;R2 TIMES
	ADD	#4,STGOSB	;UPDATE PTR AREA PTR
	JMP	INIT02		;AND CONTINUE IN CODE
3$:	ADD	#4,STGOSB	;DELETE GOSUB ITEM FROM PTR AREA
	JMP	STOP02
RET03:	RETERR

	.SBTTL	DIM00 - DIM STATEMENT
;+3
; .SKIP
; .X ^^DIM\\
; .X ^STRING VARIABLES
; .INDENT -5
; ^^
; DIM
; \\
; .BREAK
; ^DECLARES SIZE OF ARRAYS AND STRINGS.
; ^ALSO SPECIFIES STRINGS AS EITHER FIXED OR VARIABLE LENGTH.
; ^ARRAYS MAY HAVE ONE OR TWO SUBSCRIPTS.
; ^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.
; ^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.
;
	.PSECT	BASIC2		;BACK TO RO CODE
DIM00:	GETADR			;GET A TRUNCATED VARIABLE
DIM01:	BVS	DIM99		;ERROR IF NG.
	BNE	DIM97		;PREVIOUSLY DECLARED VARIABLE FOUND
	MOV	R4,-(SP)
	SKIP			;GET NEXT CHARACTER
	CLR	SLEN		;ZERO STRING LENGTH
	CMPB	R2,#'$		;IS THIS A STRING VARIABLE
	BNE	DIM06		;BR IF NOT
	BIS	#130000,@SP	;SET STRING TYPE
	MOV	#417,SLEN	;SET DEFAULT FIXED 15 CHARS
	SKIP
	CMPB	R2,#'[		;STRING LENGTH SPECIFIED
	BNE	DIM07		;SKIP IF NOT
	ATOI
	DIMCHK
	BNE	DIM99		;BR IF INVALID STRING LENGTH
	SKIP
	CMPB	R2,#']		;MUST HAVE TERMINATOR
	BNE	DIM99		;ERROR IF NOT
	MOVB	R0,SLEN		;SAVE LENGTH
	BEQ	DIM99		;ERROR IF ZERO LENGTH
	SKIP
DIM07:	CMPB	R2,#'V		;VARIABLE LENGTH STRING
	BNE	DIM06		;BR IF NOT
	NEGB	SLEN+1		;ELSE SET FLAG
	SKIP
DIM06:	CMP	R2,#'(		;IS IT A LEFT PAREN
	BNE	DIM10		;CHECK IF STRING LEN SPEC
	ATOI			;YES, GET FIRST DIMENSION
	DIMCHK			;CHECK FOR DIMENSION WITHIN BOUNDS
	BNE	DIM99		;NOT IN BOUNDS
	MOV	R0,-(SP)	;PUT AWAY FIRST DIMENSION
	SWAB	@SP		;IN UPPER HALF WORD
	SKIP			;GET LAST CHARACTER SCANNED
	CMPB	R2,#',		;IS IT A COMMA?
	BNE	DIM03		;NO
	ATOI			;GET SECOND DIMENSION
	DIMCHK			;IS IT IN RANGE?
	BNE	DIM99		;NO
	BIS	R0,@SP		;YES, PACK IT IN
	SKIP			;GET A CHARACTER
DIM03:	CMP	R2,#')		;NO IS IT A RIGHT PAREN?
	BEQ	DIM04		;YES, GET NEXT CHARACTER
DIM99:	DIMERR			;BAD DIMENSION
DIM04:	MOV	(SP)+,R2	;GET PACKED DIMENSIONS
	MOV	(SP)+,R0	;AND HEADER
	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
	MOV	R0,-(SP)	;SAVE THE HEADER AGAIN
	MOV	R2,R1		;SEPARATE THE DIMENSIONS
	SWAB	R1
	MOV	SLEN,R0		;GET THE STRING LENGTH
	BNE	1$		;IF NON-ZERO, WE HAVE STRING
	MOV	R2,R0		;PUT ONE DIMENSION IN R0
	ARYLG			;CALCULATE THE TOTAL ARRAY LENGTH IN R0
	BR	2$
1$:	STRLEN			;GET TOTAL STRING LENGTH
2$:	MOV	R0,R1		;LEN IN R1
	ADD	#6,R0		;TOTAL DATA ITEM LENGTH IN R0
	TSTOK
	BLO	DIM98		;IF NOT ENOUGH ROOM, OVERFLOW
	MOV	(SP)+,(R5)+	;PUT IN HEADER
	MOV	R2,(R5)+	;AND PACKED DIMENSIONS
	MOV	SLEN,R2		;STRING LENGTH
	BEQ	3$		;IF ZERO, NO STRING
	MOV	R2,(R5)+	;PUT IN STRING LENGTH
3$:	ASR	R1		;GET TOTAL LEN IN WORDS
4$:	CLR	(R5)+		;CLEAR OUT THE ARRAY
	SOB	R1,4$
	MOV	R5,ENUDAT	;MAKE DATA PERMANENT
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	SKIP			;GET A CHARACTER
	CMP	R2,#',		;COMMA?
	BEQ	DIM00		;YES LOOK FOR NEXT ITEM
	DEC	R1		;BACK UP OVER TERMINATOR
DIM05:	JMP	INIT02		;NOW GOAWAY
DIM98:	DMVERR			;OVERFLOW
DIM97:	DMDERR			;PREVIOUSLY USED OR DECLARED
DIM10:	TST	SLEN		;WAS A STRING LENGTH FOUND
	BEQ	DIM99		;NO DIMENSIONS MUST BE PRESENT
	CLR	-(SP)		;ELSE DEFAULT TO NO DIMENSIONS
	DEC	R1		;BACK UP TEXT POINTER
	BR	DIM04		;AND PROCESS
	.SBTTL	DEF00 - DEFINE FUNCTION STATEMENT
;+3
; .SKIP
; .X ^^DEF\\
; .X ^FUNCTION - USER
; .X ^USER DEFINED FUNCTIONS
; .INDENT -5
; ^^
; 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.
; ^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	#130000,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
	JMP	INIT02		;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. 
;	UPON ENTRY, R1 POINTS TO THE START OF
;	AN OPERAND.  UPON EXIT, R2,R3,AND R4 CONTAIN THE VALUE OF THE
;	OPERAND IF LEGAL.  IF NOT LEGAL, A FATAL ERROR CALL IS MADE.  ON
;	LEGAL OR ILLEGAL EXITS, R1 WILL ALWAYS POINT ONE CHARACTER AFTER
;	THE SCAN WAS ENDED.  NOTE:  THIS ROUTINE MUST BE RE-ENTRANT,
;	SINCE IT MAY, BY WAY OF CALLS TO "EVAL", RE-ENTER
;	ITSELF BEFORE COMPLETION.  REGISTERS USED - ALL.
;
GTP06:	ILFERR
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	GTP21		;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	GTP07		;IF SO, GO DO IT
	BNE	GTP06		;IF NOT, ERROR
3$:	TSTCH
	BVS	GTP15		;JUMP IF BAD OPERAND
	BNE	GTP09		;JUMP IF NOT NUMERIC
GTP18:	MOV	(SP)+,R1	;RESTORE CHARACTER POINTER
	ATOF			;CONVERT THE NUMBER, IGNORING ERROR FLAGS
	BVS	GTP06
GTP31:	RTS	PC
GTP01:	LDF	(R0)+,AC0	;GET THE NUMBER
	RTS	PC		;AND RETURN
GTP15:	CMP	R2,#'.		;DOES THE NUMBER START WITH "."?
	BEQ	GTP18		;YES
	BR	GTP09		;NO
GTP07:	GETVAR			;GET FOLLOWING VARIABLE NAME
	BVS	GTP09		;TRY SOMETHING ELSE IF NONE
	MOV	STUDAT,R3	;GET ADDRESS OF USER STORAGE
	BEQ	GTP12		;ERROR IF NO USER LIST
	CLR	R0		;SET ZERO MASK FOR THE SEARCH
	BIS	#060000,R4	;SET CLASS 3
	SRLST			;SEARCH THE LIST FOR THE ITEM
	BEQ	GTP09		;JUMP IF FAILURE, NOW TRY A VARIABLE
	JSR	PC,FNSET	;GO SET UP PARAMS
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R0,R1		;PUT DEF ADDRESS IN R1
	EVAL
	BVC	GTP20		;NO ')' ALLOWED
GTP21:	PARERR			;ERROR IF NOT
GTP20:	MOV	(SP)+,R1	;RESTORE R1
	JSR	PC,FNCLR	;CLEAN UP MESS WE'VE MADE
	TST	(SP)+		;CLEAR BACKUP TEXT POINTER
	RTS	PC
GTP09:	MOV	(SP)+,R1	;VARIABLE, BACK UP POINTER TO TRY AGAIN
	GETADR			;GET ADDRESS OF VARIABLE
	BVS	GTP12		;NON-EXISTENT
	BEQ	GTP12		; VARIABLE HERE
	JMP	GTP01		;GO AWAY AGAIN
GTP12:	NXVERR			;NON-EXISTENT VARIABLE ERROR - ZERO ASSUMED
	CLRF	AC0		;SET VARIABLE TO ZERO
	RTS	PC
GTP13:	ADD	#10,SP		;GET RID OF ANY JUNK ON THE STACK
	BR	GTP09

	.SBTTL	INX - INDEX (POSITION) STRING FUNCTION
	.SBTTL	POS - POSITION (INDEX) STRING FUNCTION
;+4
; .SKIP
; .X ^^INX\\
; .X ^^POS\\
; .X ^INDEX STRING FUNCTION
; .X ^POSITION STRING FUNCTION
; .INDENT -5
; ^^
; INX
; .INDENT -5
; POS
; \\
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^POS(STRING1,STRING2 [,P1] [,P2])\\
; .FILL
; ^THIS FUNCTION COMPUTES THE POSITION OF ^^STRING2\\ IN ^^STRING1\\ STARTING
; AT OPTIONAL POSITION ^P1 (^P1 ASSUMED TO BE 1 IF NOT SPECIFIED).
; ^A SECOND OPTIONAL PARAMETER ^P2 SPECIFIES THE FINAL CHARACTER POSITION.
; ^IF IT IS NOT SPECIFIED, IT IS ASSUMED TO BE THE END OF THE FIRST STRING.
; ^^INX\\ AND ^^POS\\ ARE IDENTICAL.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 A=POS("ABC","B")
;	20 X=POS(A1$,A2$,5,7)
; \\
; .FILL
;-
INX00:	MOV	ENUDAT,-(SP)	;SAVE CURRENT END OF LIST POINTER
	JSR	PC,STRCOM	;GET FIRST STRING ARGUMENT
				;LEN AND ADD ON STACK
	SKIP			;NEXT CHAR
	CMPB	R2,#',		;IS IT A COMMA?
	BNE	FUN99		;IF NOT, ERROR
	JSR	PC,STRCOM	;GET NEXT STRING ARG
	CLRF	AC0		;CLEAR ACCUM IN CASE NO ARG
	SKIP			;NEXT CHAR
	CMPB	R2,#',		;MORE PARAMS?
	BEQ	1$		;IF SO, BRANCH
	CMPB	R2,#')		;IF NOT, BETTER BE CLOSE PAREN
	BNE	FUN99		;ELSE ERROR
	BR	4$		;BRANCH AROUND REST OF THIS CODE
1$:	EVAL			;GET START POSITION
	BVS	4$		;IF ')', NO MORE PARAMS
	SKIP
	CMPB	R2,#',		;NEXT CHAR COMMA?
	BNE	FUN99		;IF NOT, ERROR
	STCFI	AC0,-(SP)	;SAVE FIRST POSITION
	EVAL			;GET FINAL POSITION IN AC0
	BVC	FUN99		;IF NO ')', ERROR
	STCFI	AC0,R5		;STORE FINAL POS. IN R5
	SUB	6(SP),R5	;SUBTRACT LEN OF FIRST STRING
	BGE	5$		;IF POS OR ZERO, DON'T DO ANYTHING
	ADD	R5,6(SP)	;DECREMENT STRING LEN
5$:	LDCIF	(SP)+,AC0	;GET FIRST POS IN AC0
4$:	MOV	(SP)+,R4	;RESTORE STRING2
	MOV	(SP)+,R3	;DESCRIPTORS
	STCFI	AC0,R5		;START POS IN R5
	DEC	R5		;MAKE OFFSET
	BGE	3$		;ASSUME 1ST OR MORE
	CLR	R5
3$:	MOV	(SP)+,R0	;RETRIEVE LEN AND
	MOV	(SP)+,R2	;ADDRESS OF 1ST STRING
	MOV	R1,4(SP)	;SAVE TEXT POINTER
	MOV	R5,-(SP)	;SAVE STARTING OFFSET
	ADD	R5,R2		;ADJUST ADDRESS
	SUB	R5,R0		;AND LEN
	BLE	INX03		;IF OFFSET BEYOND LEN, RETURN 0
	TST	R4		;IF 2ND STRING NULL, POINT TO
	BEQ	INX06		;FIRST ALLOWED POSTION IN 1ST STRING
INX02:	CMP	R0,R4		;ROOM IN SOURCE TO CHECK
	BLT	INX03		;RETURN ZERO IF NOT
	INC	@SP		;KEEP RESULT COUNTER
	MOV	R4,-(SP)	;SAVE LENGTH
	MOV	R2,R1		;SET WORK REGS
	MOV	R3,R5
INX01:	CMPB	(R1)+,(R5)+	;THESE TWO MATCH
	BNE	INX04		;GO SLIDE MASK IF NOT
	DEC	@SP		;MORE TO MASK
	BNE	INX01		;BR IF NO HIT YET
	TST	(SP)+		;CLEAN - WE HAVE FOUND STRING
INX05:	LDCIF	(SP)+,AC0	;GET NUMBER AS FLOAT
	MOV	(SP)+,ENUDAT	;RESTORE OLD END OF USER STORAGE
	RTS	PC		;AND RETURN
INX03:	CLR	@SP		;SET RESULT ZERO
	BR	INX05		;AND RETURN IT
INX04:	CMPB	(SP)+,(R2)+	;CLEAN STACK - SLIDE MASK
	SOB	R0,INX02	;LOOP IF MORE CHARS IN SOUR
	BR	INX03		;ELSE ZERO RESULT HIM
INX06:	INC	(SP)		;GET BACK TO CHAR POSITION
	BR	INX05		;AND RETURN
FUN99:	STXERR			;SYNTAX ERROR IN FUNCTION
;
; STRCOM
; SUBROUTINE TO EVALUATE A SINGLE STRING ARGUMENT.
; ON ENTRY:
;	R1 POINTS TO START OF STRING ARG
;
; ON EXIT:
;	R1 POINTS TO DELIMITING CHAR
;	(SP) HAS STRING LEN
;	2(SP) HAS STRING ADD
;	ENUDAT POINTS PAST END OF STRING
;	R5 SAME AS ENUDAT
;
; OTHER REGISTERS USED:
;	POTENTIALLY ALL
;
STRCOM:
	EVALS			;EVALUATE THE STRING
	BVS	1$		;ON ERROR, GO TRAP
	MOV	R3,R5		;NOW
	ADD	R4,R5		;ROUND UP END
	INC	R5		;OF USER STORAGE
	BIC	#1,R5		;
	MOV	R5,ENUDAT	;AND UPDATE PTR
	MOV	(SP)+,R0	;POP RTN ADD
	MOV	R3,-(SP)	;STORE ADD
	MOV	R4,-(SP)	;AND LEN
	JMP	(R0)		;DO EFFECTIVE RETURN
1$:	STXERR			;REPORT ERROR

	.SBTTL	LEN00 - LENGTH OF STRING FUNCTION
;+4
; .SKIP
; .X ^^LEN\\
; .X ^LENGTH OF STRING FUNCTION
; .INDENT -5
; ^^
; LEN
; \\
; .BREAK
; ^THIS FUNCTION COMPUTES THE LENGTH OF A SINGLE STRING EXPRESSION
; ARGUMENT.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	30 X=LEN(A$)
; \\
; .FILL
;-
LEN00:	EVALS			;COLLECT STRING
	BVS	FUN99		;BR IF ERROR
	SKIP
	CMP	R2,#')		;END OF FUNCTION
	BNE	FUN99		;ERROR IF NOT
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	LDCIF	R4,AC0		;CONVERT TO FLOAT
	RTS	PC		;AND RETURN
	.SBTTL	VAL00 - VALUE STRING FUNCTION
;+4
; .SKIP
; .X ^^VAL\\
; .X ^VALUE OF STRING FUNCTION
; .X ^NUMERIC VALUE OF STRING
; .INDENT -5
; ^^
; VAL
; \\
; .BREAK
; ^THIS FUNCTION TAKES AN ^^ASCII\\ STRING CONTAINING A LEGAL 
; NUMERIC EXPRESSION AND RETURNS A FLOATING POINT VALUE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 A=VAL(A$)
; \\
; .FILL
;-
;+4
; .SKIP
; .X ^^OCT\\
; .X ^OCTAL VALUE OF STRING
; .INDENT -5
; ^^
; OCT
; \\
; .BREAK
; ^THIS FUNCTION TAKES AN ^^ASCII\\ STRING CONTAINING A LEGAL
; OCTAL INTEGER REPRESENTATION AND RETURNS A FLOATING POINT VALUE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 A=OCT("1777")
; \\
; .FILL
;-
VAL00:	CLR	-(SP)		;SET DECIMAL FLAG
	BR	VAL01
OCB00:	MOV	#1,-(SP)	;SET OCTAL FLAG
VAL01:	EVALS			;GET ONE STRING WITH ADDRESS IN R3, LEN IN R4
	MOV	ENUDAT,R5	;R5 POINTS TO START OF STRING SCRATCH ITEM
	MOV	(SP)+,R0	;GET FLAG IN R0
	SKIP			;GET NEXT NON-BLANK CHAR AFTER ARGUMENT
	CMP	R2,#')		;SHOULD BE RIGHT PAREN.
	BNE	FUN99		;IF NOT, ERROR
	MOV	R1,2(SP)	;SAVE THE TEXT POINTER
	MOV	R3,R1		;SET STRING ADDRESS IN R1
	TST	R4		;CHECK STRING LENGTH
	BEQ	5$		;IF NULL, RETURN ZERO
7$:	CMPB	#40,(R3)+	;TRIM OFF LEADING BLANKS
	BNE	6$		;IF NON-BLANK, OK
	SOB	R4,7$		;KEEP GOING TILL AT END
	BR	5$		;EFFECTIVELY NULL STRING
6$:	DEC	R3		;READJUST R3
	ADD	R4,R3		;LET R3 POINT TO END
	MOVB	#',,(R3)+	;PUT DELIMITER AT END
	INCB	(R5)		;INCREMENT SCRATCH COUNT
	MOV	R3,-(SP)	;SAVE R3 ON STACK FOR REFERENCE
	TST	R0		;OCTAL OR DECIMAL?
	BNE	3$		;IF OCTAL, BRANCH
	MOV	R5,-(SP)	;SAVE R5
	MOV	R3,R5		;PUT R5 AT EVEN
	INC	R5		;END OF STRING
	BIC	#1,R5
	MOV	R5,ENUDAT	;SAVE END OF USER LIST
	ATOF
	BVS	8$		;ON ERROR, BRANCH
	MOV	(SP)+,ENUDAT	;GET OLD ENUDAT
	BR	4$		;GO TO COMMON FINISHING CODE
3$:	MOV	R1,R0		;SET STRING POINTER IN R0
	JSR	PC,$COTB	;DO OCTAL CONVERSION
	LDCIF	R1,AC0		;PUT RESULT IN AC0
	MOV	R0,R1		;UPDATE STRING POINTER
	DEC	R1		;BACK UP 1
4$:	SKIP			;MAKE R1 POINT AFTER NEXT NON-BLANK CHAR.
	CMP	R1,(SP)+	;ARE WE AT END OF STRING?
	BNE	1$		;IF NOT, ERROR
	BR	2$		;DO SUCCESSFUL RETURN
8$:	MOV	(SP)+,ENUDAT	;RESTORE END OF USER AREA
	TST	(SP)+		;CLEAN STACK
1$:	VALERR
5$:	CLRF	AC0		;SET ZERO FOR NULL STRING
2$:	RTS	PC
	.SBTTL	ASC00 - NUMERIC VALUE OF ASCII CODE
;+4
; .SKIP
; .X ^^ASC\\
; .X ^ASCII VALUE OF CHARACTER
; .INDENT -5
; ^^
; ASC
; \\
; .BREAK
; ^THIS FUNCTION RETURNS THE NUMERIC VALUE OF THE FIRST ^^ASCII\\ CHARACTER
; IN THE STRING ARGUMENT.
; ^FOR A NULL STRING, 0 IS RETURNED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 I=ASC("A")
; \\
; .FILL
;-
ASC00:	EVALS			;GET THE STRING
	BVS	FUN99		;BR ON ERROR
	SKIP			;GET NEXT CHAR
	CMP	R2,#')		;IS IT CLOSE PAREN
	BNE	FUN99		;IF NOT, ERROR
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	CLRF	AC0		;SET ZERO
	TST	R4		;IN CASE NULL STRING
	BEQ	1$
	MOVB	(R3),R4		;PUT CHAR IN R4
	LDCIF	R4,AC0		;CONVERT IT
1$:	RTS	PC		;AND RETURN
	.SBTTL	NRC00 - NUMBER OF RECORDS IN A FILE
;+4
; .SKIP
; .X ^^NRC\\
; .X ^RECORD COUNT FUNCTION
; .X ^NUMBER OF RECORDS FUNCTION
; .INDENT -5
; ^^
; NRC
; \\
; .BREAK
; ^THIS FUNCTION CALCULATES THE NUMBER OF RECORDS IN THE
; FILE NUMBER WHICH IS SPECIFIED IN THE ARGUMENT.
; ^THE FILE MUST BE A FIXED LENGTH RECORD TYPE.
; ^A -1 RETURNED INDICATES A NON-EXISTENT ^^FDB\\.
; ^A -2 RETURNED INDICATES VARIABLE LENGTH RECORDS.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 A=NRC(4)
; \\
; .FILL
;-
F.ONE:	.FLT2	1.
F.512:	.FLT2	512.
NRC00:	EVAL			;GET FILE NUMBER IN AC0
	BVS	1$		;NEED CLOSE PAREN
	STXERR			;ELSE ERROR
1$:	STCFI	AC0,R4		;FILE NUM IN R4
	DEC	R4
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	CMP	#255.,R4	;IS IT LEGAL
	BHIS	2$		;IF SO, BRANCH
	FNMERR
2$:	MOV	#017400,R0	;MASK OFF IRRELEVANT BITS
	CLRF	AC0		;CLEAR FOR LATER (IN CASE ERROR)
	JSR	PC,SRCHFL	;GO FIND FDB
	BEQ	3$		;IF SEARCH FAILED, ERROR
	ADD	#26,R3		;MAKE R3 POINT TO FDB
	BITB	#R.FIX,F.RTYP(R3) ;FIXED LEN RECORDS?
	BEQ	4$		;IF NOT, ERROR
	SETL			;GET LONG INTEGER
	LDCLF	F.EFBK(R3),AC0	;FOR # OF BLOCKS IN AC0
	SUBF	F.ONE,AC0	;DECREMENT
	SETI			;BACK TO SHORT INTEGERS
	LDCIF	F.RSIZ(R3),AC1	;GET RECORD SIZE
	DIVF	AC1,AC0
	MULF	F.512,AC0
	LDCIF	F.FFBY(R3),AC3
	DIVF	AC1,AC3
	ADDF	AC3,AC0
	BR	5$
4$:	SUBF	F.ONE,AC0	;SET UP ERROR CODES
3$:	SUBF	F.ONE,AC0
5$:	RTS	PC
;+4
; .SL
; .X <ERR
; .X <ERL
; .X <FCS
; .X ^ERROR CODE FUNCTIONS
; .ID -5
; <ERR
; .ID -5
; <ERL
; .ID-5
; <FCS
; .BR
; ^THESE FUNCTIONS RETURN RESPECTIVELY: THE NUMBER OF THE LAST ERROR,
; THE LINE NUMBER OF THE LAST ERROR, AND THE <FCS ERROR CODE (NEGATIVE)
; FOR THE LAST <FILES-11 RELATED ERROR.
; ^AN ARGUMENT FOR THE FUNCTION MUST BE INCLUDED ATLHOUGH IT WILL
; USUALLY BE ZERO.
; ^IF A NON-ZERO ARGUMENT IS INCLUDED, IT WILL BE ADDED TO THE
; RETURNED VALUE.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	100 A=ERR(0)
; 	110 B=FCS(0)
; 	120 CON ERL(1)
; \\
; .F
;-
ERR00:	MOV	#PARLST+P.ERCD,-(SP)	;PUT ADDRESS OF
	BR	ERR01			;REQUIRED PARAM
ERL00:	MOV	#PARLST+P.LINE,-(SP)	;ON STACK
	BR	ERR01
FCS00:	MOV	#PARLST+P.FCS,-(SP)
ERR01:	EVAL			;EVALUATE ARGUMENT
	BVS	1$		;WE NEED CLOSE PAREN
	STXERR			;ELSE ERROR
1$:	STCFI	AC0,R0		;STORE RESULT IN R0
	ADD	@(SP)+,R0	;ADD IN REQ'D PARAM
	LDCIF	R0,AC0		;STORE AWAY RESULT
	MOV	R1,2(SP)	;STORE AWAY TEXT POINTER
	RTS	PC
;+4
; .SL
; .X <COR
; .X ^FREE CORE FUNCTION
; .ID -5
; <COR
; .BR
; ^THIS FUNCTION RETURNS THE FREE CORE (IN BYTES) MINUS THE VALUE
; OF THE ARGUMENT.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	100 A=COR(255)
; \\
; .F
;-
COR00:	EVAL			;ARG VALUE -> AC0
	BVS	1$		;NO CLOSE PAREN IS ERROR
	STXERR
1$:	SETL			;AND FPP ALSO
	MOV	STUFDB,-(SP)	;END OF CORE VALUE -> STACK
	CLR	-(SP)		;SET UP STACK FOR DOUBLE PRECISION
	LDCLF	(SP),AC1	;AND NOW -> AC1
	MOV	ENUDAT,2(SP)	;NOW PUT IN END OF ACTUAL USER DATA
	LDCLF	(SP),AC2	;AND -> AC2
	SUBF	AC2,AC1		;ACTUAL FREE CORE -> AC1
	CMP	(SP)+,(SP)+	;CLEAN UP STACK
	SUBF	AC0,AC1		;NOW ADJUSTED VALUE -> AC1
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	LDF	AC1,AC0		;PUT ANSWER BACK -> AC0
	SETI			;BACK TO STANDARD MODE
	RTS	PC

	.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:
;	STRE [+ STRE]...
;	IT APPEARS THAT AT END OF SUCCESSFUL PASS THRU THIS
;	ROUTINE, R3 CONTAINS STRING ADDRESS (IN TEMP STORAGE 
;	AREA AT END OF USER STACK) AND R4 CONTAINS LENGTH.
;
;	FOR BAD STRING EXPRESSIONS, "V" BIT IS SET.
;
EVLS00:	MOV	#257.,R0	;CHECK FOR STRING ROOM
	TSTOK
	BLO	EVLS18		;IF NOT ENOUGH ROOM, BRANCH
	MOV	R5,-(SP)	;SAVE CURRENT END OF STACK
	MOV	#160000,(R5)+	;SET UP SCRATCH ITEM IN USER AREA
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R0,-(SP)	;SAVE MAX STRING LENGTH
EVLS03: MOV	R5,-(SP)	;SAVE R5 STRING POINTER
	INC	R5		;AND ROUND IT UP
	BIC	#1,R5
	MOV	R5,ENUDAT	;SAVE IN ENUDAT
	JSR	PC,GSTR00	;GET A STRING OPERAND
	BVS	EVLS04		;BR BAD ERROR
	BLE	EVLS02		;BR IF NULL STRING (OR LESS)
	TST	2(SP)		;MORE ROOM IN DEST
	BEQ	EVLS02		;SKIP IF NOT
	MOV	(SP)+,R5	;RESTORE
1$:	MOVB	(R3)+,(R5)+	;PUT TO WORK SPACE
	INC	@4(SP)		;INC RETURNED LENGTH
	DEC	@SP		;MORE ROOM IN WORK SPACE
	BEQ	2$		;SKIP IF NOT
	SOB	R4,1$		;LOOP ON STRING SIZE
2$:	MOV	R5,-(SP)	;SAVE CAUSE RESTORE
EVLS02:	MOV	(SP)+,R5	;RESTORE
	SKIP			;GET NEXT TEXT CHAR
	CMP	R2,#'+		;MORE STRING OPERANDS COMMING
	BEQ	EVLS03		;GO GET THEM IF SO
	DEC	R1		;POINT TO ENDING CHAR
	CMP	(SP)+,(SP)+	;POP MAX LEN AND OLD R1
	MOV	(SP),R3		;R3 POINTS TO STRING HEADER
	MOV	(R3)+,R4	;HEADER -> R4, STR ADD -> R3
	BIC	#160000,R4	;CLEAR OUT TYPE FOR TRUE LEN
	MOV	(SP)+,ENUDAT	;RESTORE END OF LIST POINTER
	CCC
	RTS	PC		;AND RETURN
EVLS04:	CMP	(SP)+,(SP)+	;CLEAN STACK
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	MOV	(SP)+,ENUDAT	;RESTORE END OF LIST POINTER
	CLR	R4		;INDICATE ZERO LENGTH STRING
	SEV			;SET INVALID EXPRESSION
	RTS	PC		;AND RETURN
EVLS18:	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
	CLR	-(SP)		;SET LENGTH WORK SPACE
	GETSAD			;GET STRING VAR
	BVS	GSTR08		;NON-EXIST VAR
	BEQ	GSTR08		;DITTO
	DEC	R1		;ADJUST
	MOVB	-1(R0),@SP	;SAVE LENGTH
	TST	@R3		;THIS VARIABLE LENGTH STRING
	BMI	GSTR07		;SKIP STUFF IF SO
	TSTB	@SP		;IS LENGTH ZERO
	BEQ	GSTR07		;PASS NULL IF SO
	MOVB	@R3,@SP		;ELSE USE MAX LEN FOR FIXED LEN STRING
GSTR07:	MOV	R0,R3		;PASS DATA ADDRESS
	MOV	(SP)+,R4	;PASS LENGTH
	RTS	PC		;BACK TO CALLER
GSTR08:	TST	(SP)+		;POP GARBAGE OFF STACK
GSTR09:	SEV
	RTS	PC		;AND RETURN
GSTR10:	CMP	R2,#'"		;THIS A STRING CONSTANT
	BNE	GSTR09		;ERR IF NOT
	MOV	R1,R0		;SAVE STRING START ADDRESS
	CLR	-(SP)		;SLOT FOR LENGTH
GSTR11:	CMPB	(R1)+,#'"	;END OF STRING
	BEQ	GSTR07		;RETURN IF SO
	CMPB	-(R1),#S.EOL	;END OF LINE
	BEQ	GSTR07		;RETURN IF SO TOO
	INC	R1		;SKIP OVER CHAR
	INC	@SP		;ADD TO LENGTH
	BR	GSTR11		;LOOP TILL END FOUND
;
; 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	CHR$ - ASCII CODE OF NUMERIC VALUE
;+4
; .SKIP
; .X ^^CHR$\\
; .X ^CHARACTER FROM ^ASCII VALUE FUNCTION
; .INDENT -5
; ^^
; CHR$
; \\
; .BREAK
; ^ROUTINE TO RETURN A ONE CHARACTER STRING CORRESPONDING TO A NUMERIC
; ^^ASCII\\ VALUE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 LET A$=CHR$(65)
; \\
; .FILL
;-
CHR00:	EVAL			;GET NUMBER
	BVC	SBS99		;MUST HAVE CLOSE PAREN
	STCFI	AC0,R4		;PUT INTEGER RESULT IN R4
	MOV	ENUDAT,R3	;START STRING SCRATCH ELEMENT
	MOV	#160001,(R3)+	;PUT IN SCRATCH HEADER
	MOVB	R4,(R3)		;PUT VALUE AWAY
	MOV	#1,R4		;LEN IS 1
	RTS	PC

	.SBTTL	SBS00 - SUBSTRING FUNCTION
	.SBTTL	SEG00 - SUBSTRING FUNCTION
;+4
; .SKIP
; .X ^^SEG$\\
; .X ^^SBS$\\
; .X ^^RIGHT\\
; .X ^^LEFT\\
; .X <MID
; .X ^SUBSTRING FUNCTIONS
; .INDENT -5
; ^^
; SEG$
; .INDENT -5
; SBS$
; .ID-5
; RIGHT
; .ID-5
; LEFT
; .ID-5
; MID
; \\
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^SEG$(STRING,A[,B])
;	SBS$(STRING,A[,B])
;	MID(STRING,A,[B])
;	RIGHT(STRING,A)
;	LEFT(STRING,A)\\
; .FILL
; ^WHERE '^^STRING\\' IS A LEGAL STRING EXPRESSION AND ^A IS THE FIRST
; CHARACTER IN THE STRING TO BE SELECTED. ^IN ^^SEG$\\, ^B IS THE LAST
; CHARACTER TO BE INCLUDED IN THE OUTPUT STRING; IN ^^SBS$\\, IT IS THE
; NUMBER OF CHARACTERS TO INCLUDE. ^IF NOT SPECIFIED IN EITHER CASE
; ALL CHARACTERS TO THE END OF THE STRING ARE INCLUDED.
; ^A NULL STRING IS RETURNED WHEN THE FIRST CHARACTER POSITION IS
; NOT WITHIN THE SOURCE STRING.
; ^WHEN THE ENDING POSITION OR LENGTH PLACES ONE BEYOND THE END OF
; THE SOURCE STRING, ALL CHARACTERS TO THE END ARE INCLUDED WITH NO
; BLANK FILL.
; ^IF THE FIRST POSITION IS AFTER THE FINAL, A NULL STRING IS RETURNED.
; ^IF ^A IS LESS THAN 1 A NULL STRING IS RETURNED.
; ^IF ^B PLACES THE FINAL CHARACTER POSITION PAST THE END OF THE STRING,
; IT IS AS THOUGH THE ENDING POSITION WAS SPECIFIED.
; .SKIP
; <RIGHT AND <LEFT ARE PROVIDED FOR COMPATIBILITY WITH OTHER VERSIONS
; OF <BASIC (IN PARTICULAR <RSTS <BASIC-PLUS).
; ^NOTE THAT THE NAMES ARE NOT FOLLOWED BY '$' EVEN THOUGH THE RESULTS
; ARE STRING VALUES.
; ^THE FUNCTIONS RETURN THE RIGHTMOST ^A OR LEFTMOST ^A CHARACTERS
; OF THE STRING RESPECTIVELY.
; THE FUNCTION <MID IS A SYNONYM FOR <SBS$.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 A$=SEG$(B$,1,5)
;	30 X$=SBS$(Y$,6)
; \\
; .FILL
;-
; ON EXIT R3 CONTAINS THE ADDRESS AND R4 CONTAINS THE LENGTH
; OF THE RESULTING STRING.
;
SEG00:	MOV	#2,-(SP)	;SET SEGMENT FLAG
	BR	SBS06
LEFT00:	MOV	#4,-(SP)	;SET LEFT FLAG
	BR	SBS06
RIGHT0:	MOV	#6,-(SP)	;SET RIGHT FLAG
	BR	SBS06
SBS00:	CLR	-(SP)		;INDICATE SUBSTRING
SBS06:
	MOV	ENUDAT,-(SP)	;SAVE OLD END OF USER DATA
	JSR	PC,STRCOM	;GO RETRIEVE STRING ARGUMENT ON STACK
	SKIP			;NEXT CHAR
	CMP	R2,#',		;SEPARATOR?
	BNE	SBS99		;ERROR IF NONE
	CLR	-(SP)		;SET 2/3 ARG FLAG
	EVAL			;GET STRING START
	BVS	SBS01		;BR IF ")" FOUND
	INC	@SP		;SET FOR 3 ARGS
SBS01:	STCFI	AC0,R0		;GET INTEGER VALUE
	DEC	R0		;ADJUST IT
	MOV	10(SP),R2	;GET FUNCTION FLAG -> R2
	JMP	@2$(R2)		;USE IT AS OFFSET INTO JUMP TABLE
2$:	.WORD	1$	;SBS$ (OR MID)
	.WORD	4$	;SEG$
	.WORD	5$	;LEFT
	.WORD	6$	;RIGHT
4$:	MOV	R0,10(SP)	;SAVE THE STARTING NUM -1
1$:	CMP	R0,2(SP)	;CHECK AGAINST SOURCE LEN
	BLO	SBS04		;BR IF WITHIN STRING
	CLR	2(SP)		;FORCE NULL STRING
	BR	SBS02		;CONTINUE
5$:
	INC	R0		;BACK TO COUNT (NOT OFFSET)
	CMP	R0,2(SP)	;CHECK REQ'D LEN
	BHIS	51$		;IF TOO MUCH, GIVE WHAT WE HAVE
	MOV	R0,2(SP)	;IF LESS, MODIFY
51$:	TST	(SP)		;MUST BE 2 ARGS ONLY
	BNE	SBS99		;IF NOT, ERROR
	BR	SBS02
6$:
	INC	R0		;BACK TO COUNT (NOT OFFSET)
	CMP	R0,2(SP)	;CHECK OUT NEEDED LEN
	BHIS	51$		;IF TOO MUCH, GIVE WHAT HAVE
	MOV	2(SP),R2	;CALCULATE
	ADD	4(SP),R2	;ADD OF END -> R2
	SUB	R0,R2		;R2 HAS NEW ADDRESS
	MOV	R2,4(SP)	;STORE IT
	MOV	R0,2(SP)	;AND NEW LEN
	BR	51$		;AND FINISH
SBS04:	ADD	R0,4(SP)	;ADJUST DATA ADDRESS
	SUB	R0,2(SP)	;AND LENGTH
SBS02:	MOV	(SP)+,R0	;ANOTHER ARG EXIST
	BEQ	SBS05		;BR IF 2 ARG CALL
	SKIP			;MUST HAVE "," SEPERATOR
	CMPB	R2,#',
	BNE	SBS99		;ERROR IF NOT
	EVAL			;GET 3RD ARG
	BVC	SBS99		;MUST HAVE PAREN
	STCFI	AC0,R0		;GET INTEGER
	SUB	6(SP),R0	;SUBTRACT INITIAL POS-1 IF SEG$
	BGT	SBS05		;BR IF POSSIBLY VALID
	CLR	@SP		;FORCE NULL
SBS05:	MOV	(SP)+,R4	;GET LENGTH
	MOV	(SP)+,R3	;GET DATA ADDRESS
	MOV	(SP)+,ENUDAT	;RESTORE LIST POINTER
	TST	(SP)+		;POP SEG$-SBS$ FLAG
	TST	R0		;ANY LENGTH
	BEQ	SBS03		;SKIP IF NOT
	CMP	R0,R4		;CHECK IF WHOLE STRING NEEDED
	BHI	SBS03		;BR IF SO
	MOV	R0,R4		;ELSE SET FOR PARTIAL STRING
SBS03:	RTS	PC		;RETURN STRING
SBS99:	SBSERR			;FATAL ERROR

	.SBTTL	PIEC0 - SUBSTRING BY DELIMITER STRING FUNCTION
;+4
; .SKIP
; .X ^^PIECE$\\
; .X ^PIECE OF STRING BY DELIMITER
; .ID -5
; ^^
; PIECE$
; \\
; .BREAK
; .NF
; ^FORMAT:
; 	^^PIECE$(STRING1,STRING2,N1 [,N2])\\
; .F
; <PIECE$ INSPECTS A SPECIFIED STRING (<STRING1) AND TAKES
; FROM IT THAT SUBSTRING WHICH LIES BETWEEN TWO SPECIFIED
; OCCURRENCES OF A PARTICULAR DIVIDING STRING (<STRING2).
; ^THE RESULTING SUBSTRING BEGINS IMMEDIATELY AFTER THE <N1
; MINUS ONE OCCURRENCE OF THE DIVIDING STRING AND ENDS
; IMMEDIATELY BEFORE THE ^N2ND OCCURRENCE (OR ^N1ST IF ^N2
; IS UNSPECIFIED).
; .BREAK
; ^EXAMPLE:
; .NF
; ^^
; 	110 M$=PIECE$("12/1/77","/",1) :! EXTRACT MONTH FROM STRING
; 	120 A$=PIECE$("12/1/77","/",1,2) :! EXTRACT MONTH AND DAY
; \\
; .F
;-
PIECE0:
	MOV	ENUDAT,-(SP)	;SAVE OLD END OF USER DATA
	CLR	-(SP)		;SAVE SLOT FOR R1
	JSR	PC,STRCOM	;GET SOURCE STRING
	SKIP
	CMPB	R2,#',		;NEXT CHAR COMMA?
	BNE	13$		;IF NOT, ERROR
	JSR	PC,STRCOM	;GET DELIMITING STRING
	CLRF	AC0		;CLEAR ACCUM FOR N1
	SKIP			;CHECK ON COMMA
	CMPB	R2,#',		;
	BEQ	1$		;IF THERE, GO EVAL PARAM
	CMPB	R2,#')		;ELSE MUST BE ')'
	BNE	13$		;IF NOT, SYNTAX ERROR
	ADDF	#1,AC0		;DEFAULT N1 TO 1
	BR	2$
1$:	EVAL			;GET N1 -> AC0
	BVC	3$		;IF NO ')', BRANCH
2$:	STCFI	AC0,-(SP)	;STORE N1
	CLRF	AC0		;SET ZERO FOR N2
	BR	4$
3$:	STCFI	AC0,-(SP)	;N1 ON STACK
	SKIP			;MUST HAVE
	CMPB	R2,#',		;COMMA DELIM
	BNE	13$		;IF NOT, ERROR
	EVAL			;GET N2 -> AC0
	BVC	13$		;IF NO ')', ERROR
; AT THIS POINT STACK AS FOLLOWS:
;	  (SP) N1
;	 2(SP) LEN OF STRING2
;	 4(SP) ADD OF STRING2
;	 6(SP) LEN OF STRING1
;	10(SP) ADD OF STRING1
;	12(SP) SLOT FOR R1
;	14(SP) OLD ENUDAT
;	16(SP) SUBROUTINE ROUTINE ADDRESS
; IN ADDITION AC0 HAS N2
4$:	MOV	R1,12(SP)	;FREE UP R1
	DEC	(SP)		;N1-1 ON STACK
	LDCIF	(SP)+,AC1	;NOW -> AC1
	LDCIF	(SP)+,AC2	;LEN OF STRING2 -> AC2
	LDCIF	(SP)+,AC3	;ADD OF STRING2 -> AC3
	MOV	(SP)+,R0	;LEN OF STRING1 -> R0
	MOV	(SP)+,R1	;ADD OF STRING1 -> R1
	SUBF	AC1,AC0		;N2-N1+1 -> AC0
	CFCC
	BGT	41$		;IF POS, BRANCH
	LDCIF	#1,AC0		;MAKE IT 1 BY DEFAULT
41$:	TSTF	AC1		;CHECK ITERATION COUNT
	CFCC
	BGT	5$		;IF POS, GO FIND MATCH
	CLR	-(SP)		;IF DOWN TO ZERO, RECORD POSITION
	BR	7$		;ON STACK AND SKIP SOME CODE
5$:	JSR	PC,STCM		;OTHERWISE FIND MATCH
	BNE	12$		;IF NO MATCH, RETURN NULL STRING
	SUBF	#1,AC1		;DECREMENT LOOP COUNTER
	CFCC
	BLE	6$		;IF ZERO, THIS IS START
	INC	R1		;PUSH STRING DESCRIPTORS PAST
	DEC	R0		;CURRENT CHAR
	BR	5$		;AND GO AROUND AGAIN
13$:	STXERR
6$:	STCFI	AC2,-(SP)	;LEN OF DELIM STRING + START OF
7$:	ADD	R1,(SP)		;ITS OCCURRENCE = START OF RESULT
8$:	INC	R1		;PUSH SOURCE STRING
	DEC	R0		;UP ONE CHAR
	JSR	PC,STCM		;GO LOOK FOR NEXT MATCH
	BNE	10$		;IF NONE, RETURN REST OF SOURCE
	SUBF	#1,AC0		;DECREMENT LOOP COUNTER
	CFCC
	BNE	8$		;IF NOT ZERO, LOOP
9$:	MOV	R1,R4		;R4 HAS ADD OF 1ST CHAR PAST END
				;OF DELIMITED STRING (RESULT)
	MOV	(SP)+,R3	;R3 HAS START ADDRESS
	SUB	R3,R4		;NOW R4 HAS LEN OF DELIMITED STRING
	BR	11$		;GO TO FINISH UP CODE
10$:	ADD	R0,R1		;R1 PTS TO END OF SOURCE STRING
	BR	9$
11$:	MOV	(SP)+,R1	;RESTORE TEXT PTR
	MOV	(SP)+,ENUDAT	;AND OLD END OF USER DATA
	RTS	PC
12$:	CLR	R4		;SET NULL STRING
	BR	11$
;
; SUBROUTINE TO SLIDE STRING2 ALONG STRING1
; LOOKING FOR A MATCH
; ON ENTRY:
; 	AC2 LEN OF STRING2
;	AC3 ADD OF STRING2
;	R0  LEN OF STRING1
;	R1  ADD OF STRING1
;
; ON EXIT:
;	R0 HAS REMAINING LEN OF STRING1
;	R1 HAS ADDRESS OF MATCH START
;	'Z' SET IF MATCH, CLEAR IF NOT
; OTHER REGISTERS USED: ALL
;
STCM:
	MOV	R0,R5		;COPY LEN OF STRING1 TO R5
	ADD	R1,R0		;NOW R0 PTS PAST END OF STRING1
	SUB	R4,R5		;R5 NOW HAS # OF
	INC	R5		;ITERATIONS FOR COMPARE
	BEQ	2$		;IF ZERO TRIES, UNSUCCESSFUL
	DEC	R1		;BACK UP FOR INC WHICH FOLLOWS
1$:	INC	R1		;MOVE UP SOURCE ADDRESS
	MOV	R1,R2		;COPY IT TO R2
	STCFI	AC2,R4		;GET LEN OF COMPARE -> R4
	STCFI	AC3,R3		;AND ADDRESS OF DELIMITING STRING -> R3
	JSR	PC,STRCMP	;DO ACTUAL COMPARE
	BEQ	3$		;ON SUCCESS, BRANCH
	SOB	R5,1$		;KEEP GOING TILL SUCCESS OR FINISH
2$:	CLZ			;INDICATE FAILURE
	SUB	R1,R0		;MAKE SURE R0 IS PROPER LEN
	RTS	PC
3$:	SUB	R1,R0		;CALCULATE REMAINING LEN -> R0
	SEZ			;INDICATE SUCCESS
	RTS	PC
	.SBTTL	FCHR00 - NUMERIC TO CHARACTER STRING
;+4
; .SKIP
; .X ^^STR$\\
; .X ^NUMERIC TO CHARACTER STRING
; .INDENT -5
; ^^
; STR$
; \\
; .BREAK
; ^NUMERIC TO CHARACTER STRING CONVERSION. (^NO LEADING OR TRAILING BLANKS.)
; ^THE ^ASCII STRING REPRESENTS THE VALUE OF THE ARGUMENT.
; .NOFILL
; ^FORMAT:
;	^^STR$(X)\\
; .FILL
; ^WHERE '^X' IS ANY LEGAL NUMERIC EXPRESSION.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	30 A$=STR$(EXP(X)+1.4)
; \\
; .FILL
;-
FCHR00:	EVAL			;GET NUMBER
	BVC	SBS99		;MUST HAVE PAREN
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	JSR	PC,FTOA00	;CONVERT TO STRING
	MOV	ENUDAT,R5
	MOV	R5,R3		;GET RESULT ADDRESS
	MOV	#160000,(R3)+	;FIRST PUT IN HEADER
	CLR	R4		;LENGTH COUNTER
	MOV	SP,R0		;RESULT FROM FTOA IS ON STACK
FCHR01:	MOVB	(R0)+,(R3)+	;PASS BYTE
	BEQ	FCHR02		;BR IF DONE
	INC	R4		;ADJUST LENGTH
	INCB	(R5)		;AND SCRATCH HEADER
	BR	FCHR01		;LOOP
FCHR02:	ADD	#24,SP		;CLEAN STACK
	DEC	R3		;GO BACK TO TRIM TRAILING BLANKS
1$:	DEC	R4		;DEC STRING LENGTH
	CMPB	#40,-(R3)	;SPACE?
	BEQ	1$		;IF SO KEEP GOING BACK
	INC	R4		;ADJUST FOR LAST NON-BLANK CHAR
	MOV	R5,R3		;SET STRING ADDRESS
	ADD	#2,R3		;IN R3
2$:	CMPB	(R3)+,#40	;BLANK?
	BNE	3$		;IF NOT, BRANCH
	SOB	R4,2$		;IF SO, GO DO IT AGAIN
3$:	DEC	R3		;RE-ADJUST R3
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	RTS	PC		;AND RETURN
;
	.SBTTL	TRM00 - TRAILING BLANK TRIM FUNCTION
	.SBTTL	LTR00 - LEADING BLANK TRIM FUNCTION
;+4
; .SKIP
; .X ^^TRM$\\
; .X ^^LTR$\\
; .X ^BLANK TRIM FUNCTIONS
; .INDENT -5
; ^^
; LTR$
; .INDENT -5
; TRM$
; \\
; .BREAK
; ^LEADING AND TRAILING BLANK TRIM FUNCTIONS.
; ^THE RESULTING STRING IS THE ARGUMENT STRING WITHOUT LEADING BLANKS
; FOR ^^LTR$\\ OR WITHOUT TRAILING BLANKS FOR ^^TRM$\\.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	30 A$=LTR$(A$)
;	40 B$=TRM$(C$)
; \\
; .FILL
;-
LTR00:	MOV	#1,-(SP)	;SET FLAG FOR LEADING TRIM
	BR	TRM01
TRM00:	CLR	-(SP)		;SET FLAG FOR TRAILING TRIM
TRM01:	EVALS			;EVALUATE THE STRING
3$:	SKIP			;GET NEXT CHARACTER
	CMPB	#'),R2		;IS IT ')'
	BEQ	1$
	CMPB	#S.CON,R2	;OR ':'
	BEQ	2$
	CMPB	#S.EOL,R2	;OR LF
	BNE	3$		;IF NONE, TRY AGAIN
2$:	DEC	R1		;RE-ADJUST TEXT POINTER
1$:	TST	(SP)+		;POP FLAG
	BNE	11$		;IF NON-ZERO, LEADING TRIM
	MOV	R3,-(SP)	;SAVE STRING POINTER
	ADD	R4,R3		;END OF STRING IN R3
4$:	CMPB	-(R3),#40	;BLANK?
	BNE	5$		;IF NOT, BRANCH
	SOB	R4,4$		;KEEP TRYING
5$:	MOV	(SP)+,R3	;GET BACK STRING POINTER
	RTS	PC
11$:	CMPB	(R3)+,#40	;IS CHAR A BLANK?
	BNE	14$		;IF NOT, BREAK OUT OF LOOP
	SOB	R4,11$		;KEEP GOING TILL NON-BLANK OR ZERO COUNT
14$:	DEC	R3		;BACK UP TO FIRST NON-BLANK CHAR
	RTS	PC
	.SBTTL	OCT$ - NUMERIC TO UNSIGNED OCTAL
	.SBTTL	OCS$ - NUMERIC TO SIGNED OCTAL
;+4
; .SKIP
; .X ^^OCT$\\
; .X ^^OCS$\\
; .X ^OCTAL TO STRING FUNCTIONS
; .INDENT -5
; ^^
; OCT$
; .INDENT -5
; OCS$
; \\
; .BREAK
; ^A SINGLE NUMERIC ARGUMENT IS CONVERTED TO ^^ASCII\\ REPRESENTATION
; OF AN OCTAL INTEGER.
; ^THE NUMERIC EXPRESSION IS EVALUATED AND TRUNCATED TO AN INTEGER
; PRIOR TO CONVERSION.
; ^^OCT$\\ PRODUCES AN UNSIGNED STRING, WHILE ^^OCS$\\ PRODUCES A
; SIGNED STRING.
; ^MAGNITUDES ARE LIMITED TO THOSE REPRESENTABLE IN ONE ^^PDP-11\\ WORD.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	40 PRINT OCS$(-53)
;	50 PRINT OCT$(I*16)
; \\
; .FILL
;-
OCS00:	MOV	#1,-(SP)	;SET SIGNED FLAG
	BR	OCT01
OCT00:	CLR	-(SP)		;INDICATE UNSIGNED
OCT01:	EVAL			;GET THE NUMBER IN AC0
	BVS	3$		;MUST HAVE ")"
	STXERR			;IF NOT, ERROR
3$:	MOV	(SP)+,R4	;FLAG IN R4
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	ENUDAT,R0	;SET UP STRING SCRATCH ITEM
	MOV	#160000,(R0)+	;HEADER
	MOV	R0,R3		;START OF STRING IN R3
	STCFI	AC0,R1		;PUT NUMBER IN R1
	CLR	R2		;NO LEADING ZEROES
	TST	R4		;SIGNED?
	BNE	1$		;BRANCH IF SO
	JSR	PC,$CBOMG
	BR	2$
1$:	JSR	PC,$CBOSG
2$:	MOV	R0,R4		;END OF STRING IN R4
	SUB	R3,R4		;NOW LEN IN R4
	MOVB	R4,@ENUDAT	;STORE IN HEADER
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	RTS	PC

	.SBTTL	DAT00 - DATE FUNCTION
	.SBTTL	TIM00 - TIME FUNCTION
;+4
; .SKIP
; .X ^^DAT$\\
; .X ^DATE FUNCTION
; .INDENT -5
; ^^
; DAT$
; \\
; .BREAK
; ^AN 8 CHARACTER STRING IS RETURNED CONTAINING THE DATE
; IN THE FORM ^^MO/DA/YR\\.
; ^A SINGLE DUMMY ARGUMENT IS REQUIRED FOR INTERNAL FUNCTION
; COMPATIBILITY ONLY.
; ^IT HAS NO EFFECT ON THE RESULT.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	50 A$=DAT$(0)
; \\
; .FILL
;-
;+4
; .SKIP
; .X ^^DDAT$\\
; .X <DEC STANDARD DATE FUNCTION
; .ID -5
; ^^
; DDAT$
; \\
; .BREAK
; ^THIS FUNCTION RETURNS A STRING CONTAINING THE <DEC
; STANDARD DATE IN THE FORM: DD-MMM-YY.
; ^THE STRING MAY BE EITHER 8 OR 9 CHARS DEPENDING ON THE
; NUMBER OF DIGITS IN THE DAY.
; .BREAK
; ^EXAMPLE:
; .NF
; ^^
; 	40 A$=DDAT$(0)
; \\
; .F
;-
;+4
; .SKIP
; .X ^^TIM$\\
; .X ^TIME FUNCTION
; .INDENT -5
; ^^
; TIM$
; \\
; .BREAK
; ^RETURNS TIME IN AN 8 CHARACTER STRING IN THE FORM ^^HR:MN:SC\\.
; ^A SINGLE DUMMY ARGUMENT IS REQUIRED FOR INTERNAL FUNCTION
; COMPATIBILITY ONLY.
; ^IT HAS NO EFFECT ON THE RESULT.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	30 A$=TIM$(0)
; \\
; .FILL
;-
;
; DATE AND TIME FUNCTIONS.
; EACH RETURNS AN 8 CHAR STRING ADDRESS IN R3 AND LENGTH IN R4 (8.)
; DATE IS IN FORM: MO/DA/YR.
; TIME IS IN FORM: HR:MI:SC
;
; USE: A$=DAT$(0) OR A$=TIM$(0).
; WHERE 0 IS A DUMMY ARGUMENT.
;
; DEFINE ERROR TEMPORARILY AS SAME AS SUBSTRING FUNCTION
TBTIM:	.ASCIZ	/:/
	.WORD	TIMBUF+G.TIHR
	.WORD	TIMBUF+G.TIMI
	.WORD	TIMBUF+G.TISC
TBDAT:	.ASCIZ	'/'
	.WORD	TIMBUF+G.TIMO
	.WORD	TIMBUF+G.TIDA
	.WORD	TIMBUF+G.TIYR
TBDDAT:	.ASCIZ	'-'
	.WORD	TIMBUF+G.TIDA
	.WORD	TIMBUF+G.TIMO
	.WORD	TIMBUF+G.TIYR
MONTH:	.ASCII	/JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
DDAT00:	MOV	#TBDDAT,-(SP)
	BR	DATIM
TIM00:	MOV	#TBTIM,-(SP)
	BR	DATIM
DAT00:	MOV	#TBDAT,-(SP)
DATIM:	EVAL			;EVALUATE DUMMY ARG
	BVS	3$		;MUST BE ')' OR ERROR
	SBSERR			;TEMPORARILY USE SUBSTRING ERROR
3$:	MOV	(SP)+,R3	;TABLE ADDRESS IN R3
	MOV	(R3)+,R4	;DELIMITING CHAR IN R4
	MOV	R1,-(SP)	;SAVE R1 ON STACK
	MOV	ENUDAT,R0	;R0 CONTAINS ADDRESS OF RESULTING STRING
	MOV	#160012,(R0)+	;PUT IN HEADER FOR SCRATCH STRING
	GTIM$S	#TIMBUF		;GET CURRENT TIME PARAMETERS
	MOV	@(R3)+,R1
	CMP	R4,#'-		;IS IT DEC DATE?
	BEQ	4$		;IF SO, BRANCH
	JSR	PC,2$
	MOVB	R4,(R0)+
	MOV	@(R3)+,R1
	JSR	PC,2$
5$:	MOVB	R4,(R0)+
	MOV	@(R3)+,R1
	JSR	PC,2$
	MOV	ENUDAT,R3
	TST	(R3)+		;PUSH R3 TO START OF STRING
	SUB	R3,R0		;GET LEN IN R0
	MOV	R0,R4		;NOW IN R4 WHERE IT SHOULD BE
	MOVB	R4,-2(R3)	;AND IN SCRATCH HEADER
	MOV	(SP)+,R1
	RTS	PC
2$:	CMP	#10.,R1		;IS NUMBER GE 10.?
	BLE	1$		;IF SO, OK
	MOVB	#'0,(R0)+	;IF NOT, INSERT LEADING ZERO
1$:	CLR	R2		;NO LEADING ZEROES
	JSR	PC,$CBDMG	;USE LIBRARY CONVERSION ROUTINE
	RTS	PC
4$:
	JSR	PC,1$		;CONVERT DAY WITHOUT LEADING 0
	MOVB	R4,(R0)+	;PUT IN DELIMITER
	MOV	@(R3)+,R2	;MONTH -> R2
	DEC	R2		;DECREMENT FOR OFFSET
	MOV	R2,R1		;AND COPY FOR MPY BY 3
	ASL	R2		;BY DOING SHIFT
	ADD	R1,R2		;AND ADD
	MOV	#MONTH,R1	;OFFSET INTO MONTH
	ADD	R2,R1		;TABLE
	MOVB	(R1)+,(R0)+	;PUT IN 3 CHAR
	MOVB	(R1)+,(R0)+	;MONTH
	MOVB	(R1)+,(R0)+	;
	BR	5$		;AND GO FINISH IN PREVIOUS CODE

	.SBTTL	RJS00 - RIGHT JUSTIFY STRING FUNCTION
;+4
; .SKIP
; .X ^^RJS$\\
; .X ^^LJS$\\
; .X ^RIGHT JUSTIFY FUNCTION
; .INDENT -5
; ^^
; RJS$
; .ID -5
; LJS$
; \\
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^RJS$(B$,I)\\
; 	^^LJS$(B$,I)\\
; .FILL
; ^WHERE ^I IS THE LENGTH OF THE RETURNED STRING WITH ^B$ RIGHT
; OR LEFT
; JUSTIFIED IN IT AND WITH LEADING OR TRAILING BLANK FILL 
; IF NECESSARY.
; ^IF ^B$ IS LONGER THAN ^I CHARACTERS, THEN THE RIGHTMOST
; OR LEFTMOST ^I
; CHARACTERS WILL BE RETURNED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	40 A$=RJS$(B$,9)
; 	70 A$=LJS$(B$,5)
; \\
; .FILL
;-
; ON RETURN:	R3 CONTAINS ADDRESS
;		R4 CONTAINS LENGTH
;
LJS00:	MOV	#1,-(SP)	;SET FLAG FOR LEFT JUSTIFY
	BR	RJS01
RJS00:	CLR	-(SP)		;CLEAR FLAG
RJS01:	EVALS			;GET STRING IN WORK AREA
	BVC	1$		;CHECK FOR ERROR
2$:	STXERR
1$:	SKIP
	CMPB	R2,#',		;NEXT CHAR MUST BE ','
	BNE	2$		;ELSE ERROR
	MOV	R4,-(SP)	;SAVE LEN
	MOV	R3,-(SP)	;AND ADDRESS
	MOV	ENUDAT,-(SP)	;SAVE ENUDAT
	ADD	R4,R3		;ACCOUNT FOR STRING
	MOV	R3,R5
	INC	R5		;MAKE SURE EVEN
	BIC	#1,R5
	MOV	R5,ENUDAT	;SET NEW END OF USER LIST
	EVAL			;GET REQ'D LEN
	BVC	2$		;MUST HAVE ')'
	MOV	(SP)+,ENUDAT	;RESTORE OLD ENUDAT
	MOV	(SP)+,R3	;RESTORE ADDRESS
	STCFI	AC0,R0		;REQUESTED LEN IN R0
	BNE	21$		;IF NON-ZERO, BRANCH
	CMP	(SP)+,(SP)+	;IF REQ LEN 0, CLEAN STACK
	CLR	R4		;RETURN 0 LEN
	RTS	PC
21$:	CMP	R0,#255.	;CHECK SIZE
	BHI	2$		;IF TOO BIG OR SMALL, ERROR
3$:	MOV	(SP)+,R4	;ACTUAL LEN -> R4
	BNE	5$		;IF NON - ZERO, BRANCH
31$:	MOV	R3,R5		;DUPLICATE ADDRESS OF STRING IN R5
	MOV	R0,R4		;AND REQ'D LEN IN R4
	MOVB	#40,R2		;SPACE IN R2
4$:	MOVB	R2,(R5)+	;FILL IN SPACES
	SOB	R0,4$
	TST	(SP)+		;POP RIGHT-LEFT FLAG
	BR	62$		;AND FINISH
5$:	TST	(SP)+		;RIGHT OR LEFT JUSTIFY
	BNE	10$		;IF LEFT JUSTIFY, BRANCH
; RIGHT JUSTIFY CODE
	MOV	R3,R2		;DUPLICATE STRING ADDRESS IN R2
	ADD	R4,R2		;MAKE R2 POINT PAST END OF ACTUAL STRING
51$:	CMPB	#40,-(R2)	;BLANK TRIM THE STRING FROM THE END
	BNE	52$
	SOB	R4,51$
53$:	TST	-(SP)		;FAKE FLAG ON STACK
	BR	31$		;AND FINISH
52$:	MOV	R4,R5		;DUPLICATE TRIMMED LEN IN R5
	BEQ	31$		;IF ZERO, BRANCH AND RETURN BLANK STRING
	MOV	R3,R2		;DUPLICATE ADDRESS IN R2
	SUB	R0,R5		;ACTUAL MINUS REQUESTED LENGTH IN R5
	BLT	7$		;IF ACTUAL LESS THAN REQUESTED, BRANCH
	ADD	R5,R2		;MAKE R2 POINT TO START OF REMAINING STRING
	MOV	R3,R5		;DUPLICATE STRING ADDRESS IN R5
6$:	MOVB	(R2)+,(R5)+	;SHIFT STRING LEFT SO WE GET
	SOB	R0,6$		;RIGHTMOST R0 CHARACTERS
61$:	STCFI	AC0,R4		;STORE REQ'D LEN -> R4
62$:	MOVB	R4,@ENUDAT	;AND IN SCRATCH HEADER
	RTS	PC
7$:	ADD	R0,R3		;LET R3 POINT TO REQ'D END
	ADD	R4,R2		;AND R2 POINT TO ACTUAL END
	NEG	R5		;MAKE R5 POS
8$:	MOVB	-(R2),-(R3)	;MOVE STRING TO THE
	SOB	R4,8$		;RIGHT
9$:	MOVB	#40,-(R3)	;AND FILL IN FIRST PART WITH
	SOB	R5,9$		;BLANKS
	BR	61$		;AND FINISH
; LEFT JUSTIFY CODE
10$:	MOV	R3,R2		;REPEAT STRING START ADD. -> R2
11$:	CMPB	(R2)+,#40	;TRIM OFF BEGINNING BLANKS
	BNE	12$		;BRANCH ON FIRST NON-BLANK CHAR
	SOB	R4,11$
	BR	53$		;IF WE FINISHED, RETURN BLANK STRING
12$:	DEC	R2		;MAKE R2 POINT TO FIRST NON-BLANK CHAR
	MOV	R3,R5		;DUPLICATE ADD IN R5
	MOV	R4,-(SP)	;SAVE TRIMMED LEN
13$:	MOVB	(R2)+,(R5)+	;NOW MOVE IT DOWN
	SOB	R4,13$
	SUB	(SP)+,R0	;SEE HOW WE MUCH WE NEED TO FILL
	BLE	15$		;IF ALREADY ENOUGH, BRANCH
14$:	MOVB	#40,(R5)+	;FILL IN THE BLANKS
	SOB	R0,14$
15$:	BR	61$

	.SBTTL SPACE$ AND STRING$ FUNCTIONS
;+4
; .SKIP
; .X <SPACE$
; .X <STRING$
; .ID -5
; ^^
; SPACE$
; .ID-5
; STRING$
; \\
; .BREAK
; .NF
; ^FORMAT
; 	^^SPACE$(I)\\
; 	^^STRING$(C$,I)\\
; .F
; ^WHERE ^I IS THE LENGTH OF THE STRING TO BE CREATED.
; ^IN THE CASE OF <SPACE$, A STRING OF BLANKS IS CREATED.
; ^FOR <STRING$, A STRING OF CHARACTERS MATCHING THE FIRST
; CHARACTER OF ^C$ IS CREATED.
; .BREAK
; ^EXAMPLES:
; .NF
; ^^
; 	120 A$=SPACE$(40)
; 	130 B$=STRING$("-",40)
; \\
; .F
;-
SPACE0:	MOVB	#40,R0		;SET UP SPACE CHAR
	BR	STRG01		;REST IS SAME AS STRING$
STRG00:	EVALS			;GET CHARACTER STRING
	MOVB	(R3),R0		;AND USE FIRST CHAR
	SKIP			;SKIP PAST COMMA SEPARATOR
STRG01:	MOV	R0,-(SP)	;SAVE CHARACTER ON STACK
	EVAL			;# OF CHARS -> AC0
	BVS	1$		;SHOULD HAVE CLOSE PAREN
	STXERR			;ELSE SYNTAX ERROR
1$:	STCFI	AC0,R0		;GET CHAR COUNT
	TSTOK			;CHECK FOR ROOM (ENUDAT -> R5)
	BLO	4$		;IF NO ROOM, REPORT ERROR
	MOV	#160000,(R5)+	;PUT IN SCRATCH HEADER
	MOVB	R0,-2(R5)	;AND SET CHAR COUNT
	MOV	(SP)+,R2	;GET CHAR TO USE
	MOV	R0,R4		;COPY CHAR COUNT -> R4
	BEQ	3$		;IF ZERO, DONE
	MOV	R5,R3		;COPY START ADDRESS -> R3
2$:	MOVB	R2,(R5)+	;FILL IN THE CHARS
	SOB	R0,2$
3$:	RTS	PC		;AND RETURN
4$:	OVFERR
	.SBTTL	GTDR00 - GET ADDRESS OF VARIABLE OR ARRAY ELEMENT
;
; GETADR - GTDR00, GET ADDRESS OF VARIABLE/ARRAY ELEMENT - DATA
;	ADDRESS RETURNED IN R0.  REGISTERS USED - R0,R1,R2,R3,R4.
;
GTDR00:	GETVAR			;GET A VARIABLE NAME
	BVS	GTDR03		;EXIT IF IN ERROR
	DEC	R1		;BACK UP CHARACTER POINTER
	CLR	R0		;SET ZERO SEARCH MASK
	MOV	STUDAT,R3	;GET ADDRESS OF USER STORAGE
	BEQ	GTDR02		;JUMP IF NOT FOUND
	MOV	R4,-(SP)	;SAVE SEARCH OBJECT
	CMPB	R2,#'$		;IS THIS A STRING
	BNE	GTDR05		;SKIP IF NOT
	BIS	#130000,R4	;MAKE STRING SEARCH OBJECT
GTDR05:	SRLST			;FIND THE ITEM
	BEQ	GTDR06		;JUMP IF NOT THERE
	CMP	@SP,#DIM01	;SKIP THE REST IF
	BEQ	GTDR04		;   CALLED FROM DIM
	TST	(R3)+		;POINT TO SUBSCRIPTS
	CMPB	@R1,#'(		;IS THERE A SUBSCRIPT EXPRESSION?
	BNE	GTDR01		;NO
	INC	R1		;SKIP OVER OPEN PAREN
	SUBSCR			;COMPUTE THE SUBSCRIPT
GTDR06:	MOV	(SP)+,R4
GTDR02:	TST	R0		;SET FLAGS
GTDR03:	RTS	PC		;RETURN WHEN DONE
GTDR01:	TST	(R3)+		;POINT TO DATA ADDRESS
GTDR04:	MOV	R3,R0		;PUT RESULT IN R0
	BR	GTDR06		;AND RETURN
	.SBTTL	GTSD00 - GET STRING VARIABLE ADDRESS
;
; GETSAD, GTSD00 - GET STRING VAR ADDRESS
;	ON ENTRY:
;		R1 POINTS TO TEXT
;	ON RETURN:
;		R0 POINTS TO DATA ADDRESS
;		R3 POINTS TO LEN INFO
;		'V' SET IF NO VARIABLE
;		R1 UPDATED
;
GTSD00:	GETVAR			;GET NAME
	BVS	GTSD01		;BR INVALID NAME
	CMPB	R2,#'$		;THIS REALLY A STRING
	BNE	GTSD01		;ERROR IF NOT
	SKIP			;NEXT TEXT CHAR
	BIS	#130000,R4	;SET STRING TYPE
	CLR	R0		;SET ZERO MASK
	MOV	STUDAT,R3	;GET TEXT ADDRESS
	BEQ	GTSD02		;BR IF NOT SETUP YET
	SRLST			;FIND VAR
	BEQ	GTSD02		;BR NOT DEFINED YET
	TST	(R3)+		;POINT TO DIM INFO
	MOV	R3,R0		;CALC DATA ADDRESS START
	CMP	(R0)+,(R0)+
	INC	R0
	CMP	R2,#'(		;SUBSCRIPT
	BNE	GTSD03		;EXIT IF NOT
	SUBSCR			;CALC DATA ADDRESS
	SKIP			;NEXT TEXT CHAR
GTSD03:	TST	(R3)+		;POINT TO STRING LEN INFO
GTSD02:	TST	R0		;SET CON-CODES
	RTS	PC		;AND RETURN
GTSD01:	SEV			;SET ERROR
	RTS	PC		;AND RETURN
	.SBTTL	LET00 - LET STATEMENT
;+3
; .SKIP
; .X ^^LET\\
; .X ^ARITHMETIC ASSIGNMENT
; .INDENT -5
; ^^
; 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:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	GETSAD			;TRY FOR STRING ASSIGNMENT
	BVC	SET06		;BR IF IT IS STRING
	MOV	(SP)+,R1	;ELSE RESTORE TEXT POINTER
	GETADR			;GET VARIABLE ADDRESS
	BVS	LET99		;JUMP IF BAD VARIABLE
	BNE	LET01
	MOV	R4,R0		;GET NAME
	PSHNAM			;PUSH VARIABLE ON THE LIST
LET01:	MOV	R0,-(SP)	;SAVE DATA ADDRESS
	SKIP
	CMP	R2,#'=		;IS THE "LET" OK?
	BNE	LET99		;NO
	EVAL			;YES, EVALUATE EXPRESSION
	BVS	LET98		;ERROR IF MISMATCHED PARENS
	STF	AC0,@(SP)+	;PUT RESULT AWAY
	JMP	INIT02		;GO BACK FOR NEXT LINE
LET99:	LETERR			;ILLEGAL LET STATEMENT
LET98:	PARERR			;MISMATCHED PARENS
SET00:	MOV	R1,-(SP)	;DUMMY SAVE TEXT POINTER
	GETSAD			;GET RESULT STRING
	BVS	LET99		;ERROR
SET06:	BNE	SET02		;BR IF DEFINED
	MOV	R4,R0		;ELSE DEFINE IT
	PSHSTR
SET02:	MOV	@R3,-(SP)	;SAVE LENGTH INFO
	MOV	R0,-(SP)	;SAVE DATA ADDRESS
	CMP	R2,#'=		;VALID ASSIGNMENT
	BNE	LET99		;BR IF ERROR
	EVALS			;GO GET SOURCE
	BVS	LET99		;BR IF ERROR
	MOV	(SP)+,R2	;GET DEST DATA ADDRESS
	MOVB	@SP,R0		;AND MAX LENGTH
	BIC	#177400,R0	;CLEAN IT UP
	TST	(SP)		;FIXED LENGTH?
	BPL	SET01		;IF SO, USE FULL LENGTH
	CMP	R0,R4		;WILL IT FIT
	BLT	SET01		;BR IF SO
	MOVB	R4,@SP		;SET SMALLER LEN
SET01:	MOVB	@SP,-1(R2)	;SET LENGTH
	TST	R4		;CHECK SOURCE LENGTH
	BEQ	SET04		;SKIP IF NULL STRING
SET03:	MOVB	(R3)+,(R2)+	;PASS STRING
	DEC	R0		;MORE ROOM IN DEST
	BEQ	SET05		;SKIP IF NOT
	SOB	R4,SET03	;LOOP ON SOURCE LENGTH
SET04:	MOVB	#40,(R2)+	;PAD WITH BLANKS
	SOB	R0,SET04	;LOOP ON DEST SIZE
SET05:	CMP	(SP)+,(SP)+	;CLEAN STACK
	JMP	INIT02		;NEXT STATEMENT

	.SBTTL	EVALC0 - EVALUATE LOGICAL CONDITION
;+1
; .SKIP
; .X ^LOGICAL ^EXPRESSIONS
; .ID -5
; ^LOGICAL ^EXPRESSIONS
; .BR
; ^LOGICAL EXPRESSIONS ARE OF THE FORM:
; .BR
; 	^^_<EXPRESSION>_<REL-OP>_<EXPRESSION>[_<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.
; ^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.
; ^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.
; ^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
; .INDENT -5
; ^^
; IF
; \\
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^IF _<LOGICAL EXPRESSION> THEN _<STMT>
;	IF _<LOGICAL EXPRESSION> THEN _<LINE _#>
;	IF _<LOGICAL EXPRESSION> GOTO _<LINE _#>\\
; .FILL
; ^IF THE LOGICAL EXPRESSION IS TRUE (SEE ^LOGICAL ^EXPRESSIONS), THEN
; ALL STATEMENTS FOLLOWING <THEN ON THE LINE ARE EXECUTED FOR THE FIRST
; OF THE ABOVE FORMATS, OTHERWISE EXECUTION CONTINUES ON THE NEXT LINE.
; ^FOR THE OTHER TWO FORMS OF THE <IF, A BRANCH IS TAKEN TO THE SPECIFIED
; LINE NUMBER IF THE LOGICAL EXPRESSION IS TRUE, OTHERWISE EXECUTION
; CONTINUES ON THE FOLLOWING LINE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	10 IF A > B THEN STOP
;	20 IF A$ _<> B$ GOTO 110
;	30 IF A >= 12.5 THEN 160
; \\
; .FILL
;-
; REGISTERS USED - ALL.
;
IF00:	JSR	PC,EVALC0	;EVALUATE CONDITION
	BNE	IF15		;IF TRUE, BRANCH
REM00:	SRCHLF			;SKIP OVER REST OF LINE
	DEC	R1		;AND BACK UP THE POINTER
	JMP	INIT02		;AND GO AWAY (HANDLE REMARK HERE TOO)
;+3
; .SL
; .X ^^REM\\
; .X !
; .SL
; .ID -5
; ^^
; REM
; .BR
; .ID -5
; !
; \\
; .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.
; ^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
	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
;+3
; .SKIP
; .X ^^PRINT\\
; .X ^BINARY OUTPUT
; .X ^RANDOM ACCESS ^I/^O
; .INDENT -5
; ^^
; 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.
; ^IT IS CONVERTED TO ^^"PRINT"\\ IF USED IN PROGRAM MODE.
; .SL
; ^EXAMPLE:
; .NOFILL
; ^^
;	50 PRINT A,3.5,"HELLO";A$
;	60 PRINT _#3,EXP(.5);X^Y;
; \\
; .FILL
;-
;+4
; .SKIP
; .X ^^TAB\\
; .X ^PRINT TAB FUNCTION
; .INDENT -5
; ^^
; 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
	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?
	CMPB	R2,#S.CON
	BEQ	PR13		;IS IT A COLON?
	CMPB	R2,#S.EOL
	BEQ	PR13		;IS IT A <LF>?
	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
	CRLF			;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
	CRLF
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
	CMP	R2,#TOTPT	;TERMINAL OUTPUT?
	BNE	5$		;IF NOT, SKIP
	DEC	R0		;ACCOUNT FOR CARRIAGE CONTROL BYTE
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

	.SBTTL	INP00 - INPUT STATEMENT PROCESSOR
;+3
; .TP 6
; .SKIP
; .X ^^INPUT\\
; .X ^BINARY INPUT
; .X ^RANDOM ACCESS ^I/^O
; .INDENT -5
; ^^
; 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).
; .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
;-
;+3
; .SKIP
; .X ^^INPUT LINE\\
; .INDENT -5
; ^^
; 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
	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$:	CLR	-(SP)		;SET UP A LAND MARK
	JSR	PC,COM00	;GET VARIABLE
	BVC	INP02		;IT IS OK
3$:	INPERR			;ISSUE FATAL ERROR
INP02:	CLR	-(SP)		;SET THE LIMITS OF ADDRESSES
	CLR	-(SP)
	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
INP10:	CMP	#TINPT,INPT	;IS THIS TERMINAL INPUT??
	BNE	INP07		;SKIP PROMPT IF NOT
	MOV	#'?,R2		;TELL HIM TO GET WITH IT
	PRINTC
INP07:	PACK			;GET A LINE
	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
	CMP	(SP)+,(SP)+	;REMOVE FIRST 0
	TST	@SP		;REMOVE A WORD AND CHECK FOR THE END
	BNE	.-4		;LOOP FOR MORE
	TST	(SP)+		;CLEAN IT
	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.EOL,@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
LINEST:	.ASCII	/LINE/
;
; STRCMP - STRING COMPARISON ROUTINE
; ON CALL:
;	R3 CONTAINS ADDRESS OF FIRST STRING
;	R2 CONTAINS ADDRESS OF SECOND STRING
;	R4 CONTAINS LEN FOR COMPARISON
; IF BLSKFL IS NON-ZERO, BLANKS WILL BE SKIPPED IN FIRST STRING
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
;
; FILL00 - COMMON DATA ELEMENT FILL ROUTINE
;          FOR READ+INPUT
;	ON ENTRY R1 MUST POINT TO DATA ADDRESS
;
FILL00:	MOV	SP,R4		;USE R4 FOR A WHILE
	CMP	(R4)+,(R4)+	;POINTS TO THE LAST ZERO NOW
	TST	(R4)+
1$:	TST	(R4)+		;POINTS TO THE LAST ADDRESS
	TST	(R4)+		;GO FIND THE FIRST 0
	BNE	1$		;LOOP TILL FOUND
	TST	-(R4)		;R4 POINTS TO THE FIRST 0
	TST	LINEFL		;CHECK FOR LINE OR BINARY INPUT
	BNE	BNFILL		;IF EITHER, DO BINARY FILL
FILL01:	TST	-(R4)		;SKIP STRING/NUM INDICATOR
	MOV	-(R4),R0	;PICK UP A VARIABLE ADDRESS
	BEQ	FILL06		;NOT ENOUGH VARIABLES
	MOV	R4,-(SP)	;SAVE THE LIST POINTER
	MOV	2(R4),R3	;GET STRING/NUM INDICATOR
	BNE	FILL07		;BR IF STRING
	ATOF
	BVS	FILL99		;I WISH HE COULD TYPE
	STF	AC0,@R0		;PUT AWAY THE VALUE
FILL10:	MOV	(SP)+,R4	;RESTORE LIST POINTER
	CMPB	@R1,#',		;CHECK THE SEPARATOR
	BEQ	FILL02		;IT'S A COMMA
	CMPB	@R1,#40		;IT'S A SPACE
	BNE	1$
	SKIP			;GET NEXT NON-BLANK CHAR
	TSTCH			;IS IT NUMERIC
	BEQ	2$		;IF SO, PROCESS NEW DATA ITEM
	CMPB	R2,#'+		;IS IT PLUS
	BEQ	2$
	CMPB	R2,#'-		;OR MINUS
	BEQ	2$
	CMPB	R2,#'.		;IS IT LEADING DECIMAL?
	BEQ	2$
	CMPB	R2,#',		;SPACES FOLLOWED BY COMMA
	BEQ	FILL01
	DEC	R1		;FAILED, BACK UP ONE
	BR	1$		;GO LOOK FOR TERMINATOR
2$:	DEC	R1		;BACK UP OVER GOOD CHAR
	BR	FILL01		;AND PROCESS NEXT DATA
1$:	CMPB	@R1,#S.CON
	BEQ	FILL03		;IT'S A COLON
	CMPB	@R1,#S.EOL
	BEQ	FILL03		;IT'S A <LF>
FILL05:	SEV			;SET OVERFLOW
FILL04:	RTS	PC		;RETURN
FILL02:	INC	R1		;SKIP THE SEPARATOR
	BR	FILL01		;TAKE ANOTHER CONVERSION
FILL03:	TST	-(R4)		;SKIP INDICATOR
	MOV	-(R4),R0	;SEE IF THE NEXT ONE IS VALID
	BEQ	FILL04		;EXIT IF OK
	SEN			;TELL HIM NOT ENOUGH DATA
	RTS	PC		;RETURN
FILL06:	CCC			;MAKE MORE DATA THAN VAR.
	RTS	PC		;AND EXIT
FILL99:	TST	(SP)+		;REMOVE LIST POINTER
	BR	FILL05		;AND EXIT
FILL07:	BMI	FILL11		;BR IF VAR LEN STRING
	BIC	#177400,R3	;ISOLATE LENGTH
	MOVB	R3,-1(R0)	;SET IT
FILL08:	CMPB	@R1,#S.EOL	;END OF LINE
	BEQ	FILL09		;GO PADD IF SO
	MOVB	(R1)+,(R0)+	;PASS BYTE
	SOB	R3,FILL08	;LOOP ON STRING SIZE
	BR	FILL12		;SKIP TO FIELD END
FILL09:	MOVB	#40,(R0)+	;PADD IT
	SOB	R3,FILL09	;LOOP ON REMAINING SIZE
	BR	FILL10		;DONE
FILL11:	BIC	#177400,R3	;ISOLATE LENGTH
	MOV	R0,R4		;ZAP STRING LENGTH FIELD
	CLRB	-(R4)
FILL12:	CMPB	@R1,#S.EOL	;END OF LINE
	BEQ	FILL10		;DONE IF SO
	CMPB	@R1,#',		;ITEM TERMINATOR
	BEQ	FILL10		;DONE IF SO
	TST	R3		;MORE ROOM
	BNE	FILL13		;PASS BYTE IF ROOM
	INC	R1		;POINT TO NEXT
	BR	FILL12		;SKIP THEM
FILL13:	MOVB	(R1)+,(R0)+	;PASS IT
	INCB	@R4		;ADD TO LENGTH
	DEC	R3		;SUB FROM MAX LENGTH
	BR	FILL12		;LOOP
BNFILL:	MOV	LINELN,R2	;LENGTH OF INPUT LINE -> R2
	ADD	R1,R2		;R2 POINTS TO END OF DATA BUFFER
2$:	TST	-(R4)		;SKIP STRING/NUM INDICATOR
	MOV	-(R4),R0	;VAR ADD -> R0
	BEQ	10$		;IF ZERO, DONE
	MOV	2(R4),R3	;STRING/NUM INDICATOR -> R3
	BNE	3$		;BRANCH IF STRING
	MOV	#4,R5
1$:	MOVB	(R1)+,(R0)+	;PUT FLOATING VALUE
	SOB	R5,1$		;AWAY (4 BYTES)
	CMP	R1,R2		;AT END?
	BHI	11$		;IF PAST, ERROR
	BEQ	10$		;IF JUST THERE, DONE
	BR	2$
3$:	BMI	7$		;IF VAR LEN, BRANCH
	BIC	#177400,R3	;STRING LEN -> R3
	MOVB	R3,-1(R0)	;SET ACTUAL LEN SAME AS MAX
	BEQ	4$		;IF ZERO, DONE
5$:	CMP	R1,R2		;PAST END OF INPUT DATA?
	BHIS	6$		;IF SO, GO BLANK FILL
	MOVB	(R1)+,(R0)+	;MOVE IN THE STRING DATA
	SOB	R3,5$		;TILL DONE
	BR	4$		;IF WE FINISHED, OK!
6$:	MOVB	#40,(R0)+	;FILL REM OF STRING
	SOB	R3,6$		;WITH BLANKS
4$:	CMP	R1,R2		;AT END?
	BHIS	9$		;GO FINISH IF SO
	BR	2$
7$:	MOV	R0,R5		;R5 POINTS TO ACTUAL
	CLRB	-(R5)		;COUNT FIELD (STARTS WITH 0)
	BIC	#177400,R3	;MAX LEN IN R3
8$:	CMP	R1,R2		;AT END?
	BHIS	2$		;IF SO, GO FINISH
	MOVB	(R1)+,(R0)+	;PUT IN THE BYTE
	INCB	(R5)		;AND ADJUST THE COUNT
	SOB	R3,8$
	BR	4$		;GO MAKE REGULAR ITEM FINISH
9$:	TST	-(R4)
	MOV	-(R4),R0
	BEQ	10$		;IF END OF LIST, RETURN SUCCESSFULLY
11$:	SEN			;INDICATE NOT ENOUGH DATA
10$:	RTS	PC
	.SBTTL	COM00 - COMMON EXPRESSION HANDLER FOR READ AND INPUT
;
; COMMON EXPRESSION HANDLER FOR READ AND INPUT
; ON ENTRY: R1 IS TEXT POINTER
; OTHER REGISTERS USED: R0,R2,R3,R4
;
COM00:	MOV	(SP)+,R2	;SAVE RETURN ADDRESS
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	CLR	-(SP)		;SLOT FOR DATA ADDRESS
	MOV	R2,-(SP)	;SAVE RETURN ADDRESS
	GETSAD			;TRY FOR STRING VARIABLE
	BVS	COM06		;TRY FOR NUM IF NOT STRING
	BNE	COM05		;BR IF DEFINED
	MOV	R4,R0		;STRING NAME
	PSHSTR			;GO DEFINE IT
COM05:	MOV	@R3,4(SP)	;SAVE MAX LENGTH FIELD
	MOV	R0,2(SP)	;SAVE DATA ADDRESS
	BR	COM04		;GO COMMON CODE
COM06:	BIT	#1,LINEFL	;ARE WE DOING LINE?
	BNE	COM99		;IF SO, NO NUMERIC ALLOWED
	MOV	4(SP),R1	;RESTORE TEXT  POINTER
	GETADR			;GET NAME
	BVS	COM99		;BAD NAME
	BNE	COM01		;OK IF FOUND
	MOV	R4,R0		;SET UP THE NAME
	PSHNAM			;PUSH VARIABLE ON LIST
COM01:	CLR	4(SP)		;SET NUMBER FLAG
	MOV	R0,2(SP)	;SAVE THE VARIABLE ADDRESS
	MOV	#4,R0		;SEE IF FOUR
	TSTOK			; BYTES ARE AVAILABLE
	BLO	COM03		;     OVERFLOW IF NOT AVAILABLE
	SKIP
COM04:	CMPB	R2,#',		;CHECK FOR A GOOD SEPARATOR
	BNE	1$		;IF NOT COMMA, LOOK FOR OTHERS
	BR	COM00		;GET NEXT ITEM
1$:	CMPB	R2,#S.CON	;SO IS A COLON
	BEQ	COM02
	CMPB	R2,#S.EOL	;SO IS A <LF>
	BEQ	COM02
COM99:	SEV			;SET BADNESS
COM02:	RTS	PC
COM03:	OVFERR			;OVERFLOW

	.SBTTL	READ00 - READ STATEMENT PROCESSOR
;+3
; .SKIP
; .X ^^READ\\
; .X ^^DATA\\
; .INDENT -5
; ^^
; READ
; .INDENT -5
; 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:	MOV	#1,-(SP)	;A BACK STOP FOR THE LANDMARK
	CLR	-(SP)		;A LANDMARK
	CLR	LINEFL		;JUST IN CASE INPUT LINE WAS ^Z'ED
	JSR	PC,COM00
	BVC	READ02
READ99:	REAERR
READ02:	CLR	-(SP)
	CLR	-(SP)
	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	READ05		;AND LOOK FOR A DATA STATEMENT
1$:	ADD	USR,R1		;MAKE OFFSET INTO REAL ADDRESS
READ03:	CMPB	@R1,#S.EOL	;NEXT
	BEQ	READ05		;DATA STATEMENT
	JSR	PC,FILL00	;GO GET DATA
	BVS	READ07		;OH NO AN ERROR
	BLT	READ04		;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
	CMP	(SP)+,(SP)+	;POP THE TOP 0
	TST	@SP		;POP TO THE LANDMARK
	BNE	.-4		;LOOP FOR MAORE
	TST	(SP)+		;THEN GO TO THE BACK STOP
	BEQ	.-2		;LOOP FOR MORE IF ANY
	DEC	R1
	JMP	INIT02		;BACK TO THE BOSS
READ04:	CMP	(R4)+,(R4)+	;R4 POINTS TO THE LAST GOOD VARIABLE
	CLR	(R4)+		;CLEAR IT AND ANY OTHERS TO THE
	CLR	(R4)+
	TST	@R4		;LAND MARK WE LAID DOWN BEFORE
	BNE	.-6		;LOOP TIL WE FIND THAT 0
READ05:	MOV	STUDAT,R3	;FIND THE UPPER LIMIT
READ06:	CMPB	#S.DATA,(R1)+	;IS WE AT A DATA STATEMENT??
	BEQ	READ03		;IF SO GO FINISH WHAT WE STARTED
	CMP	R1,R3		;SEE IF IT'S ALL OVER
	BLO	READ06		;BRANCH IF MORE TEXT
	RE1ERR			;FATAL ERROR
READ07:	RE2ERR			;FATAL ERROR

	.SBTTL	FOR00 - FOR STATEMENT
;+3
; .SKIP
; .X ^^FOR\\
; .INDENT -5
; ^^
; 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).
; ^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.
; .BREAK
; ^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:	GETVAR			;GET THE CONTROL VARIABLE
	CMP	R2,#'=		;IS IT A SIMPLE VARIABLE?
	BNE	FOR99		;NO
	CLR	R0		;ZERO MASK
	MOV	STUDAT,R3	;GET ADDRESS OF LIST
	SRLST			;FIND THE VARIABLE
	BNE	FOR01		;FOUND IT
	MOV	R4,-(SP)	;SAVE NAME
	MOV	R4,R0		;PUT THE VARIABLE
	PSHNAM			;AWAY
	MOV	(SP)+,R4	;RESTORE NAME
	BR	FOR02		;DATA ADDRESS IN R0
FOR01:	MOV	R3,R0
	CMP	(R0)+,(R0)+	;GET DATA ADDRESS IN R0
FOR02:	MOV	R0,-(SP)	;SAVE DATA ADDRESS
	MOV	R4,-(SP)	;AND VARIABLE NAME
	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.EOL	;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\\
; .INDENT -5
; ^^
; 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	R0,LINENO	;SET CURRENT LINE NUMBER
	MOV	R5,LINEHD	;AND LINE HEADER
	MOV	(SP)+,R2	;STATEMENT COUNT -> R2
	MOV	R2,STCOUN	;SET STMT COUNT IN "FOR" STMT
1$:	INC	R1		;PUSH PAST TERMINATOR (IN CASE 2ND TIME AROUND)
	JUNKIT			;SKIP TO NEXT STATEMENT
	SOB	R2,1$		;R2 TIMES
	BR	FOR12		;CONTINUE LOOP
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
;