;*********
;        *
; 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
;
; 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	IMPUR2,RW,I,CON,REL	;PSECT FOR RW CODE
ATTDET:	QIOW$	IO.ATA,2,1,,STATUS,,<CTCENT>	;DPB FOR ATTACH AND DETACH
STATUS:	.BLKW	2
	.PSECT	BASIC2,RO,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 PRINTING AFTER A ^^RUN\\ COMMAND INCLUDING NON-FATAL
; ERRORS.
; ^PRINTING RESUMES WITH A ^^STOP\\ OR _^^B 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.
; ^TO PRESERVE DATA AND USER FILES, USE ^^"CHAIN"\\ COMMAND.
; ^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.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
; 	RUN
; 	RUN "PROGRAM"
; 	10 RUN "PROG1"
; \\
; .FILL
;-
;	REGISTERS USED - R5
;
RUN00:	MOV	#1,RUNF		;TURN ON RUN FLAG
	CLRUSR			;CLEAR ANY REMAINING USER AREA
	CLR	LINENO		;CLEAR LINE NUMBER POINTER
	SKIP			;GET NEXT CHARACTER
	CMP	R2,#S.EOL	;A LINE FEED?
	BEQ	RUN01		;RESTART THIS PROGRAM
	DEC	R1		;RESET TEXT POINTER
	JMP	OLD01		;RUN OLD PROGRAM
RUN01:	MOV	LINENO,R0	;DO WE HAVE NON-ZERO LINE NUMBER
	BEQ	1$		;IF NOT, RESET TEXT POINTER
	FINDLN			;IF SO, FIND PLACE IN TEXT
	BR	2$
1$:	MOV	USR,R1		;PUT START OF USER AREA
	INC	R1		; PLUS ONE IN R1
	MOV	#13507,M.I	;RESET RANDOM NUMBER GENERATOR
2$:	JSR	PC,ATTACH	;ATTACH TERMINAL
	JMP	INIT03		;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	STCOUN,R0	;GET STATEMENT POSITION IN LINE
	BIS	#20000,R0	;SET HEADER TYPE
	MOV	R0,(R5)+	;AND STORE IT
	MOV	LINENO,(R5)+	;AND LINE NUMBER
	MOV	R5,ENUDAT	;MAKE IT PERMANENT
	.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	LINENO,R2	;CURRENT LINE NO. IN R2
	BEQ	2$		;IF ZERO, DO COMPLETE SEARCH
	CMP	R0,R2		;IS NEEDED LINE NO. FARTHER DOWN
	BLOS	2$		;IF NOT, START FROM BEGINNING
	JSR	PC,FIND01	;IF SO, START FROM HERE
	BR	3$
2$:	FINDLN
3$:	BNE	GOTO01		;LINE DOESN'T EXIST
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
	JMP	INIT13
GOTO01:	TST	(SP)		;EXACT MATCH NEEDED?
	BNE	GOTO02		;IF NOT, JUST GET FOLLOWING LINE
	GOERR			;ILLEGAL GOTO OR GOSUB
	.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:	CLR	-(SP)		;SET UP TEMPORARY POINTER
	MOV	#020000,R4	;LOOK FOR CLASS 1
	MOV	STUDAT,R3	;GET ADDRESS OF LIST
	BEQ	RET03		;ERROR IF NO LIST
	MOV	#017777,R0	;SET SEARCH MASK
RET01:	SRLST			;FIND A CLASS 1 ITEM
	BEQ	RET02		;JUMP IF DONE LOOKING
	MOV	R3,@SP		;SAVE LOCATION
	CMP	(R3)+,(R3)+	;SKIP OVER CURRENT ONE
	BR	RET01		;LOOK AGAIN UNTIL LAST IS FOUND
RET02:	MOV	(SP),R3		;GET LAST FOUND ADDRESS
	BEQ	RET03		;IF NONE, ERROR
	MOV	2(R3),R0	;LINE NUMBER -> R0
	BEQ	3$		;IF ZERO, BRANCH
	MOV	R0,LINENO	;SAVE LINE NUMBER
	FINDLN			;POSITION TO IT
	BNE	RET03		;IF NOT FOUND, BIG TROUBLE
	MOV	(SP)+,R3	;GET BACK LAST ADDRESS
	MOV	(R3),R2		;GET COUNT OF STATEMENTS
	BIC	#20000,R2	;CLEAR HEADER
	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
	MOV	#4,R4		;BYTE COUNT FOR DELETEION
	SCRNCH
	JMP	INIT02		;AND CONTINUE IN CODE
3$:	MOV	#4,R4		;PREPARE TO DELETE STACK ITEM
	SCRNCH
	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	IMPUR2
SLEN:	.WORD	0		;STRING LENGTH STORAGE LOCATION
	.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:	TWOCHR			;LOOK FOR "FN"
	CMP	R4,#"NF		;IS IT AN "FN"?
	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
	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
	TSTCH
	BVS	GTP15		;JUMP IF BAD OPERAND
	BNE	GTP02		;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	GTP19		;NO
GTP02:	MOV	#177700,-(SP)
	BIC	@SP,R2		;MASK OFF EXTRA BITS
	MOV	R2,R3
	MUL	#36.,R3		;MULTIPLY BY 36. THE FAST WAY
	SKIP			;GET SECOND CHAR HERE
	TSTCH
	BVS	GTP11		;GO TRY FOR A VARIABLE
	BEQ	GTP11		;IF NOT A FUNCTION
	BIC	@SP,R2		;MAKE 8 BITS INTO 6
	ADD	R2,R3		;ADD IT IN MODULO 36
	CMP	R3,#<36.*6+16>	;DO WE HAVE 'FN'
	BEQ	GTP07		;IF SO, BRANCH
	MUL	#36.,R3		;DO TIMES 36. THE FAST WAY AGAIN
	SKIP			;GET THIRD CHARACTER
	TSTCH			;CHECK WHAT IT IS
	BVS	GTP11		;TRY FOR A
	BEQ	GTP11		;VARIABLE IF NOT A FUNCTION
	BIC	(SP)+,R2
	ADD	R2,R3		;THIS IS THE FUNCTION NAME MOD 36
	MOV	#GTP16,R0	;START OF LIST
GTP04:	CMP	(R0)+,R3	;IS THIS A GOOD FUNCTION NAME?
	BEQ	GTP05		;YES
	CMP	R0,#GTP17	;SEARCH FAILURE?
	BLO	GTP04		;NO
	MOV	#GTP27,R0	;CHECK STRING FUNCTION TABLE
GTP28:	CMP	(R0)+,R3	;MATCH
	BEQ	GTP30		;GO IF SO
	CMP	R0,#GTP29	;OR END OF TABLE
	BLO	GTP28		;LOOP IF NOT
	BR	GTP09		;YES, GO TRY A VARIABLE
GTP30:	SKIP			;NEXT TEXT CHAR
	CMPB	R2,#'(		;VALID FUNCTION
	BNE	GTP09		;TRY FOR VAR IF NOT
	TST	(SP)+		;CLEAN IT UP
	MOV	ENUDAT,-(SP)	;SAVE LIST POINTER
	CLR	-(SP)		;SLOT FOR TEXT POINTER SAVE
	JSR	PC,@GTP29-GTP27-2(R0) ;GOTO FUNCTION
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	MOV	(SP)+,ENUDAT	;RESTORE LIST POINTER
	BR	GTP31		;GO POP VALUE AND RETURN
GTP05:	SKIP
	CMP	R2,#'(		;IS THIS FUNCTION LEGAL?
	BNE	GTP09		;NO, GO TRY FOR AVARIABLE
	MOV	GTP17-GTP16-2(R0),-(SP)	;SAVE ADDRESS OF FUNCTION
	EVAL
	BVC	GTP21		;THERE MUST BE A PAREN FOUND
GTP23:	MOV	(SP)+,R2	;RESTORE JUMP ADDRESS
	JSR	PC,@R2		;GO DO THE FUNCTION
	TST	(SP)+		;REMOVE BACKUP TEXT POINTER
	RTS	PC
GTP11:	TST	(SP)+		;POP MASK FROM STACK
GTP19:	BR	GTP09
GTP07:	TST	(SP)+		;CLEAN MASK OFF STACK
	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
;
GTP16:	.WORD	60602	;SIN
	.WORD	10537	;COS
	.WORD	03756	;ATN
	.WORD	16300	;EXP
	.WORD	37343	;LOG
	.WORD	02553	;ABS
	.WORD	61246	;SQR
	.WORD	27634	;INT
	.WORD	56434	;RND
	.WORD	60472	;SGN
GTP17:	SINE00
	COS00
	ATN00
	EXPF00
	LOG00
	ABS00
	SQRT00
	INT00
	RND00
	SGN00
GTP27:	.WORD	12192.		;INX - INDEX STRING FUNCTION
	.WORD	21295.		;POS - INDEX STRING FUNCTION
	.WORD	18795.		;NRC - NUMBER OF RECORDS FUNCTION
	.WORD	15746.		;LEN - LENGTH STRING FUNCTION
	.WORD	28560.		;VAL - VALUE OF STRING
	.WORD	1983.		;ASC - ASCII VALUE OF CHARACTER
	.WORD	19568.		;OCT - OCTAL VALUE OF STRING
	.WORD	7146.		;ERR - VALUE OF LAST ERROR
	.WORD	7140.		;ERL - LINE # OF LAST ERROR
	.WORD	7903.		;FCS - LAST FCS ERROR CODE
GTP29:	INX00			;INX - INDEX STRING FUNCTION
	INX00			;POS - INDEX STRING FUNCTION
	NRC00			;NRC - NUMBER OF RECORDS FUNCTION
	LEN00			;LEN - LENGTH STRING FUNCTION
	VAL00			;VAL - STRING TO NUMERIC
	ASC00			;ASC - ASCII VALUE OF CHARACTER
	OCB00			;OCT - OCTAL VALUE OF STRING
	ERR00			;ERR - VALUE OF LAST ERROR
	ERL00			;ERL - LINE # OF LAST ERROR
	FCS00			;FCS - LAST FCS ERROR CODE

	.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
	EVALS			;GET FIRST STRING
	BVS	FUN99		;BR IF ERROR
	MOV	R3,R5		;START AT START OF STRING
	ADD	R4,R5		;ADJUST LIST POINTER
	INC	R5
	BIC	#1,R5
	MOV	R5,ENUDAT	;SAVE NEW END OF USER STORAGE
	MOV	R3,-(SP)	;SAVE DATA ADDRESS
	MOV	R4,-(SP)	;SAVE LENGTH
	SKIP			;NEXT CHAR
	CMP	R2,#',		;SEPERATOR?
	BNE	FUN99		;ERR IF NOT
	EVALS			;GET SECOND STRING
	BVS	FUN99		;BR IF ERROR
	CLRF	AC0		;INIT AC0
	SKIP			;NEXT CHAR
	CMP	R2,#',		;ANOTHER PARAM?
	BNE	1$		;IF NOT, GO CHECK FOR ')'
	MOV	R3,R5		;PUSH R5 PAST END OF THIS STRING
	ADD	R4,R5
	INC	R5		;ROUND IT UP TO
	BIC	#1,R5		;NEXT WORD
	MOV	R5,ENUDAT	;NEW END OF USER STORAGE
	MOV	R3,-(SP)	;SAVE STRING2
	MOV	R4,-(SP)	;DESCRIPTORS
	EVAL			;GET RESULT IN AC0
	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
	BR	2$		;SKIP NEXT TEST
1$:	CMP	R2,#')		;IF NOT ')'
	BNE	FUN99		;THEN ERROR
2$:	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

	.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
	BIS	#140000,R4	;SET TYPE
	CLRF	AC0		;CLEAR FOR LATER (IN CASE ERROR)
	MOV	STUDAT,R3	;START OF USER AREA IN R3
	SRLST
	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)
; \\
; .FL
;-
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

	.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
	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
	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:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	SKIP			;GET NEXT TEXT CHAR
	TSTCH			;WHAT IS IT
	BVS	GSTR10		;NOT ALPHANUM MAYBE "
	BEQ	GSTR09		;NUMBER=ERROR
	MOV	#177700,-(SP)	;SAVE A MASK
	BIC	@SP,R2		;MAKE CHAR TO SIXBITS
	MOV	R2,R3		;SAVE IT
	MUL	#36.,R3		;TIMES 36 THE FAST WAY
	SKIP			;NEXT TEXT CHAR
	TSTCH			;AND WHAT IS THIS ONE
	BVS	GSTR05		;NOT ALPHANUM
	BEQ	GSTR05		;NUMERIC - TRY FOR VAR
	BIC	@SP,R2		;ADD TO OTHER CHAR
	ADD	R2,R3
	CMP	R3,#230.	;ARE LETTERS "FN"
	BEQ	GSTR01		;IF SO, DO USER STRING FUNCTION
	MUL	#36.,R3		;TIMES 36. THE FAST WAY
	SKIP			;YET ANOTHER TEXT CHAR
	TSTCH			;GET TYPE
	BVS	GSTR05		;NOT ALPHA - TRY VAR
	BEQ	GSTR05		;NUMERIC - TRY VAR
	BIC	(SP)+,R2	;MAKE SIX-BIT
	ADD	R2,R3		;ADD HIM IN
	SKIP
	CMPB	R2,#'$		;'$' NEEDED FOR STRING FUNCTION
	BNE	GSTR06		;IF NO '$', TRY FOR NUMBER
	MOV	#GSTR12,R0	;FUNCTION STRING
GSTR03:	CMP	(R0)+,R3	;THIS IT
	BEQ	GSTR04		;GO IF SO
	TST	@R0		;END OF LIST
	BNE	GSTR03		;CHECK MORE IF SO
	BR	GSTR06		;ELSE TRY FOR VAR
GSTR05:	TST	(SP)+		;CLEAN STACK
GSTR06:	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	CLR	-(SP)		;SET LENGTH WORK SPACE
	GETSAD			;GET STRING VAR
	BVS	GSTR09		;NON-EXIST VAR
	BEQ	GSTR09		;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
GSTR09:	TST	(SP)+		;CLEAN STACK
	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
GSTR04:	SKIP			;NEXT TEXT CHAR
	CMP	R2,#'(		;VALID FUNCTION
	BNE	GSTR06		;TRY VAR IF NOT
	JSR	PC,@GSTR13-GSTR12-2(R0) ;ELSE GOTO IT
	TST	(SP)+		;CLEAN STACK
	TST	R4		;SET CONCODES
	RTS	PC		;AND RETURN
;
; ADDED CODE TO HANDLE USER STRING FUNCTIONS
;
GSTR01:	GETVAR			;NAME OF STRING FCN IN R4
	BVS	GSTR05		;IF UNSUCCESSFUL, BACK UP & TRY AGAIN
	CMPB	R2,#'$		;IS IT STRING FCN NAME?
	BNE	GSTR05
	SKIP
	CMPB	R2,#'(		;MUST HAVE ARG LIST
	BNE	GSTR05		;ELSE TRY FOR VARIABLE
	MOV	STUDAT,R3
	CLR	R0		;NO MASK
	BIS	#100000,R4	;SET STRING FCN TYPE
	SRLST
	BEQ	GSTR05		;IF NOT FOUND, TRY SOMETHING ELSE
	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
	CMP	(SP)+,(SP)+	;ADJUST STACK
	MOV	R2,R3		;RESTORE ADDRESS
	TST	R4		;SET CON CODES
	RTS	PC
;STRING EXPRESSION FUNCTION TABLE
GSTR12:	.WORD	24715.		;SBS$ - SUBSTRING
	.WORD	24811.		;SEG$ - SUBSTRING
	.WORD	23707.		;RJS$ - RIGHT JUSTIFY
	.WORD	15931.		;LJS$ - LEFT JUSTIFY
	.WORD	25362.		;STR$ - NUMERIC TO CHAR STRING
	.WORD	26581.		;TRM$ - TRAILING BLANK TRIM FUNCTION
	.WORD	16290.		;LTR$ - LEADING BLANK TRIM FUNCTION
	.WORD	5240.		;DAT$ - DATE FUNCTION
	.WORD	26257.		;TIM$ - TIME FUNCTION
	.WORD	4194.		;CHR$ - ASCII CHAR
	.WORD	19568.		;OCT$ - UNSIGNED OCTAL
	.WORD	19567.		;OCS$ - SIGNED OCTAL
	.WORD	0		;TERMINATOR
GSTR13:	.WORD	SBS00		;SBS$ - SUBSTRING
	.WORD	SEG00		;SEG$ - SUBSTRING
	.WORD	RJS00		;RJS$ - RIGHT JUSTIFY
	.WORD	LJS00		;LJS$ - LEFT JUSTIFY
	.WORD	FCHR00		;STR$ - NUMERIC TO CHAR STRING
	.WORD	TRM00		;TRM$ - TRAILING BLANK TRIM FUNCTION
	.WORD	LTR00		;LTR$ - LEADING BLANK TRIM FUNCTION
	.WORD	DAT00		;DAT$ - DATE FUNCTION
	.WORD	TIM00		;TIM$ - TIME FUNCTION
	.WORD	CHR00		;CHR$ - ASCII CHAR
	.WORD	OCT00		;OCT$ - UNSIGNED OCTAL
	.WORD	OCS00		;OCS$ -  SIGNED OCTAL
	.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 ^SUBSTRING FUNCTIONS
; .INDENT -5
; ^^
; SEG$
; .INDENT -5
; SBS$
; \\
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^SEG$(STRING,A[,B])
;	SBS$(STRING,A[,B])\\
; .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.
; .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	#1,-(SP)	;SET SEGMENT FLAG
	BR	SBS06
SBS00:	CLR	-(SP)		;INDICATE SUBSTRING
SBS06:	EVALS			;GET OBJECT STRING
	BVS	SBS99		;BR IF ERROR
	MOV	ENUDAT,-(SP)	;SAVE LIST POINTER
	MOV	R3,R5		;ACCOUNT FOR STRING IN USER AREA
	ADD	R4,R5
	INC	R5
	BIC	#1,R5
	MOV	R5,ENUDAT	;SET NEW END OF USER LIST
	MOV	R3,-(SP)	;SAVE DATA ADDRESS
	MOV	R4,-(SP)	;SAVE LENGTH
	SKIP			;NEXT CHAR
	CMP	R2,#',		;SEPERATOR?
	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
	TST	10(SP)		;DOING SEG$ FCN?
	BEQ	1$		;IF NOT, BRANCH
	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
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	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
	BVC	SBS99		;MUST HAVE ")"
	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 ^^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
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
	GTIM$S	#TIMBUF		;GET CURRENT TIME PARAMETERS
	MOV	@(R3)+,R1
	JSR	PC,2$
	MOVB	R4,(R0)+
	MOV	@(R3)+,R1
	JSR	PC,2$
	MOVB	R4,(R0)+
	MOV	@(R3)+,R1
	JSR	PC,2$
	MOV	#8.,R4
	MOV	ENUDAT,R3
	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

	.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$:	JSTERR
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	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
	.SBTTL	SET00 - SET STATEMENT (STRING ASSIGNMENT)
;+3
; .SKIP
; .X ^^SET\\
; .X ^STRING ASSIGNMENT
; .INDENT -5
; ^^
; SET
; \\
; .BREAK
; ^THIS IS THE STRING ASSIGNMENT STATEMENT.
; ^IT IS FUNCTIONALLY THE SAME AS ^^LET\\ AND CONSEQUENTLY IS
; SELDOM USED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	20 SET X1$="XYZ"
;	30 A3$=B$+"9.5"
; \\
; .FILL
;-
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	IF00 - IF STATEMENT
;+3
; .SKIP
; .X ^^IF\\
; .X ^STRING COMPARISON
; .INDENT -5
; ^^
; IF
; \\
; .BREAK
; .NOFILL
; ^FORMAT:
;	^^IF _<EXPRESSION>_<REL-OP>_<EXPRESSION> THEN _<STMT>
;	IF _<EXPRESSION>_<REL-OP>_<EXPRESSION> THEN _<LINE _#>
;	IF _<EXPRESSION>_<REL-OP>_<EXPRESSION> GOTO _<LINE _#>\\
; .FILL
; ^ANY OF THE FOLLOWING
; RELATIONAL OPERATORS ARE ALLOWED: =, _<>, _<, >, _<=, >=.
; ^STRINGS ARE COMPARED ON THE BASIS OF THEIR ^^ASCII\\ CODES.
; ^IF TWO STRINGS ARE OF UNEQUAL LENGTH, YET MATCH AT ALL COMMON
; CHARACTER POSITIONS, THE SHORTER STRING IS LESS THAN THE LONGER
; STRING.
; .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.
;
S.LT	=1	;DEFINE BITS FOR RELATIONAL OPERATORS
S.EQ	=2
S.GT	=4
IF00:	EVALS			;IF STRING OK
	BVC	1$		;GO DO STRING COMPARE
	EVAL
	BVS	LET98		;ERROR - MISMATCHED PAREN
	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
	BVS	LET98		;IF CLOSE PAREN, ERROR
	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$:	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:	TWOCHR			;GET TWO CHARACTERS
	CMP	R4,#"HT		;IS THIS A "THEN"?
	BNE	IF09		;NO
	TWOCHR
	CMP	R4,#"NE		;MAKE SURE SPELLING IS OK
	BNE	IF99		;BAD IF STATEMENT
	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:	CMP	R4,#"OG		;IS THIS A "GO"?
	BNE	IF99		;NO, ERROR
	TWOCHR
	CMP	R4,#"OT		;ERROR
	BEQ	IF10		; IF NOT A "GOTO"
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 ON 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 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$
; \\
; .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:	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
	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$:	TST	BLSKFL		;SKIP BLANKS?
	BEQ	1$		;IF NOT, AVOID SKIP ROUTINE
2$:	CMPB	(R3)+,#40	;NEXT CHAR BLANK?
	BEQ	2$		;IF SO, LOOK FOR NON-BLANK
	DEC	R3		;GET BACK TO NON-BLANK CHAR
1$:	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	READ03		;START NOW IF WE ARE SOME WHERE
	MOV	USR,R1		;START FROM THE BEGINING
	BR	READ05		;AND LOOK FOR A DATA STATEMENT
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
	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 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	R4,-(SP)	;SAVE CONTROL VARIABLE ADDRESS
	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)	;PUT IT AWAY
	CLR	R0		;ZERO MASK
	MOV	STUDAT,R3
	BIS	#040000,R4	;LOOK FOR THE "FOR" ITEM
	MOV	R4,-(SP)
	SRLST
	BEQ	FOR03		;NONE THERE
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	#16,R4		;DELETE 14 BYTES FROM THE LIST
	SCRNCH
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
FOR03:	MOV	#16,R0		;CHECK FOR ROOM
	TSTOK
	BHIS	1$		;IF OK, BRANCH
	OVFERR
1$:	EVAL			;GET THE STARTING FORMULA
	MOV	2(SP),R0	;DESTINATION
	STF	AC0,(R0)+	;PUT AWAY THE VALUE
	TWOCHR			;GET TWO BYTES
	CMP	R4,#"OT		;IS IT A "TO"?
	BNE	FOR99		;NO
	EVAL			;YES
	STF	AC0,-(SP)	;PUT ENDING VALUE AWAY
	CMPB	@R1,#'S		;IS THIS A "STEP"?
	BNE	FOR05		;NO
	TWOCHR			;YES
	CMP	R4,#"TS		;LOOK FOR "ST"
	BNE	FOR99		;NOT FOUND
	TWOCHR
	CMP	R4,#"PE		;AND "EP"
	BNE	FOR99		;NOT FOUND
	EVAL			;EVALUATE THE STEP VALUE
FOR04:	MOV	ENUDAT,R5	;MAKE SURE R5 IS SET
	LDF	(SP)+,AC1	;GET ENDING VALUE
	MOV	(SP)+,(R5)+	;PUT HEADER AWAY
	STF	AC1,(R5)+	;AND ENDING VALUE
	STF	AC0,(R5)+	;PUT THE STEP VALUE AWAY
	MOV	LINENO,(R5)+	;AND LINE NUMBER
	MOV	STCOUN,(R5)+	;AND STATEMENT NUMBER
	MOV	R5,ENUDAT	;AND MAKE THE ITEM PERMANENT
	BR	FOR06
FOR05:	LDCIF	#1,AC0		;GET A STEP OF ONE AS DEFAULT
	BR	FOR04
FOR06:	MOV	@SP,R0		;CONTROL VARIABLE ADDRESS
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R5,R1
	SUB	#14,R1		;ADDRESS OF END VALUE
FOR14:	LDF	@R0,AC0		;GET CONTROL VARIABLE VALUE
	CMPF	@R1,AC0		;CHECK END VS CONTROL
	CFCC			;GET COMPARE RESULTS
	BEQ	FOR13		;GO DO LOOP IF VARIABLE = END VALUE
	BLT	FOR08		;END LESS THAN CONTROL
	TSTF	4(R1)		;CHECK SIGN OF STEP
	CFCC			;SET CONCODES FROM TSTF
	BLT	FOR09		;NO, LOOP IS ALL WASHED UP
	BR	FOR13
FOR13:	MOV	(SP)+,R1	;STEP IS OK, GO DO LOOP
	CMP	(SP)+,(SP)+	;REMOVE START VALUE AND HEADER
FOR12:	JMP	INIT02		;GO DO NEXT STATEMENT
FOR99:	FORERR
FOR08:	TSTF	4(R1)		;IS STEP < 0
	CFCC			;SET CONCODES
	BLT	FOR13		;YES, ALL IS OK
FOR09:	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	TST	(SP)+		;POP CONTROL VARIABLE ADDRESS
	MOV	STUDAT,R3	;STEP IS WRONG OR LOOP IS DONE
FOR10:	CMPB	(R1)+,#S.NEXT	;LOOK FOR A NEXT
	BEQ	FOR11
	CMP	R1,R3		;DONE?
	BLO	FOR10		;NO
	NXTERR			;YES, NO MATCHING NEXT
FOR11:	GETVAR
	CMP	R4,@SP		;IS VARIABLE CORRECT?
	BNE	FOR10		; LOOP UNTIL FOUND OR FAILURE
	TST	(SP)+		;WE-UNS IS HERE BOSS
FOR15:	DEC	R1
	BR	FOR12		;AND IS DONE

	.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.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	70 NEXT I
; \\
; .FILL
;-
;	REGISTERS USED - ALL.
;
NEXT00:	CLR	R0		;ZERO MASK
	GETVAR			;GET THE CONTROL VARIABLE
	MOV	R4,-(SP)	;SAVE CONTROL VARIABLE NAME
	MOV	STUDAT,R3
	SRLST			;FIND THE VARIABLE
	BEQ	NEXT99		;NEXT WITHOUT FOR
	MOV	R3,-(SP)	;SAVE ADDRESS OF VARIABLE
	BIS	#040000,R4
	MOV	STUDAT,R3	;FIND
	SRLST			;THE CORRESPONDING "FOR" ELEMENT
	BEQ	NEXT99		;NOT FOUND
	TST	(R3)+		;ADDRESS OF END VALUE
	MOV	@SP,R0		;ADDRESS
	CMP	(R0)+,(R0)+	; OF CONTROL VARIABLE
	LDF	4(R3),AC0	;GET STEP VALUE
	ADDF	@R0,AC0		;ADD CONTROL VARIABLE
	TSTF	4(R3)		;CHECK SIGN OF STEP
	CFCC			;SET CONCODES
	BPL	NEXT02		;POSITIVE, DO NORMAL COMPARE
	CMPF	@R3,AC0		;DO THE COMPARE
	CFCC			;AND SET CONCODES
	BGT	NEXT01		; BACKWARDS
	BR	NEXT03
NEXT02:	CMPF	@R3,AC0		;EQUAL?
	CFCC			;SET CONCODES TO CHECK
	BLT	NEXT01		;YES, ALL DONE
NEXT03:	STF	AC0,@R0		;SAVE CONTROL VARIABLE
	MOV	R3,-(SP)	;END VALUE ADD. ON STACK
	MOV	10(R3),R0	;LINE # -> R0
	MOV	12(R3),-(SP)	;STATEMENT COUNT ON STACK
	MOV	R0,LINENO	;SET FOR LINE NUMBER IN CASE STOPPED
	FINDLN			;FIND WHERE IT BELONGS
	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
	MOV	R1,R4		;TEXT POINTER TO TEMPORARY
	MOV	(SP)+,R1	;GET END VALUE ADDRESS
	MOV	@SP,R0		;CONTROL VARIABLE ADDRESS
	MOV	R4,-(SP)	;TEXT POINTER
	CMP	(R0)+,(R0)+
	BR	FOR14		;GO BACK TO CHECK THINGS OUT
NEXT99:	NXMERR			;NEXT WITHOUT FOR
NEXT01:	CMP	(SP)+,(SP)+	;DISCARD TWO MORE WORDS
	BR	FOR15
	.END
;