;*********
;        *
; BASIC3 *
;        *
;*********
	.TITLE	BASIC3
;
; OBJECT MODULE FOR PART 1 OF MAIN BASIC INTERPRETER  6 JUNE 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
;
; COMMENT OUT THE FOLLOWING LINE FOR RSX11M OPERATION
RSX11D=1	;DEFINE FOR RSX11D VARIABLE RECEIVE DATA
;
; MODIFIED FOR IMPLIED LET AND ^Z ON INPUT 6-APR-76
;
; FEATURES CURRENTLY SUPPORTED:
;	1. PROGRAM (FILES-11) SAVE VIA SAVE COMMAND
;	2. PROGRAM (FILES-11) RECALL VIA OLD COMMAND
;	3. PROGRAM (FILES-11) EXECUTE VIA RUN COMMAND (ALLOWS CHAINING)
;	4. IMMEDIATE MODE MCR  PRINT VIA ?
;	5. MULTI-USER WITH PURE AREA
;	6. ^B BREAK FEATURE
;	7. FILES-11 SEQUENTIAL DATA FILES VIA OPEN STATEMENT
;	8. IMPLIED LET (BUT NOT IN IF STATEMENT)
;	9. FILES-11 RANDOM ACCESS FILES VIA OPEN AND INPUT OR PRINT
;	10. GENERALIZED ONE LINE USER DEFINED FUNCTIONS
;		A) ANY # OF ARGS
;		B) RECURSIVE -> ONE FCN DEFINED IN TERMS OF ANOTHER
;		C) STRING AND NUMERIC ARGS
;		D) LETTERS FN & VARIABLE NAME (NUMERIC OR STRING)
;		E) NUMERIC OR STRING VALUE RETURNED
;	11. PRESERVATION OF USER DATA UNLESS EXPLICIT CLEAR
;	12. IMPLIED LET IN IF STATEMENT
;	13. PROGRAM CHAIN STATEMENT (30-SEP-76)
;	14. PROGRAM OVERLAY STATEMENT (1-OCT-76)
;	15. ON ERROR GOTO (15-DEC-76)
;	16. BINARY I/O
;	17. GOSUB - RETURN IN MIDDLE OF MULTI-STATEMENT LINE
;	18. FOR - NEXT LOOPS NESTED ON ONE LINE
;	19. DEFAULT PROGRAM FILE NAME, EXTENSION AND DEVICE CHANGED
;		BY OLD, CHAIN, RUN, OVERLAY (31-MAR-77)
;	20. WAIT STATEMENT ADDED (TIME OUT ON INPUT)
;	21. CTRL-C AST FOR PROGRAM STOP 11-MAY-77
;	22. PRIORITY STATEMENT
;	23. ONE BYTE TOKEN REPLACEMENT FOR FCNS + OTHER KEY WORDS - 24-JUN-77
;	24. SAVE + RECALL OF COMPILED PROGRAM - 29-JUN-77
;	25. IF END STATEMENT - 22-JUL-77
;	26. LOADABLE ASSEMBLY ROUTINES OCT-77
;	27. LINE HEADERS WITH BINARY SEARCH MAR-78
;	28. TRACE FEATURE MAR-78

	.SBTTL	MACRO DEFINITIONS
	;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	FNMBR,FNMB00	;GET FILE NUMBER AND SET UP FILE

	.SBTTL	GLOBALS, REGISTERS AND MACRO CALLS
;
; GLOBALS--ERROR CALLS
;
	.GLOBL	LINERR	ILCERR	OVFERR	SBSERR	SUBERR
	.GLOBL	UNRERR	UNMERR	LNNERR	CSIERR	OPNERR
	.GLOBL	CLSERR	FNMERR	EOFERR	CLOSER	OPENER
	.GLOBL	TM1ERR	TM2ERR	SLPERR	WATERR	TMOERR
	.GLOBL	PRIERR	PRFERR	LODERR
;
; GLOBALS--REFERENCES TO OTHER MODULES
;
	.GLOBL	LET00	READ00	REM00	RUN00	RES00
	.GLOBL	RET00	DIM00	PR00	GOSB00	GOTO00
	.GLOBL	IF00	FOR00	NEXT00	INP00	STOP00
	.GLOBL	DEF00	RND01	RUN01	SET00
	.GLOBL	PARLST	P.FCS	STRCMP	ATTACH	DETACH
	.GLOBL	GOTO02	GOTO03	GOTO04	ERRBRN	INP01
	.GLOBL	FPEXTR	FPERMS	CALL00	OPLB00	ONGT00
;
; GLOBALS--INTERNAL, DEFINED HERE 
;
	.GLOBL	PRNT00	CRLF00	PRLN00	PRN00	TST00
	.GLOBL	SKIP00	FIND00	SQU00	PCK00	SRCH00
	.GLOBL	TSTU00	GET00	JUNK00	PUSH00	SRL00
	.GLOBL	CLRU00	SCR00	ARYL00	DIMC00	GETV00
	.GLOBL	SUBS00	CLSEAL	FILFND	FIND01
	.GLOBL	PSH00	CLOS00	OLD01	STRL00	FPEXFL
	.GLOBL	PSHS00	FNMB00	BLSKFL	LINELN	LINEFL
	.GLOBL	CSDSPT	CSINT0	FILFN1	OP.LUN	COMFNB
	.GLOBL	WTMAG	WTUNIT	CTCENT	INIT01	OLD02
	.GLOBL	PCK03	VECTAB	UNLD01	SRCHFL	SLUP
	.GLOBL	SLUP01	SLDN	SLDN01	PRLN01	LOAD00
;
	.GLOBL	INIT00,	INIT02,	INIT03,	INIT10,	INIT13
	.GLOBL	INIT12
;
	.GLOBL	ENDSTK	RNDM	DATI	STUDAT	ENUDAT
	.GLOBL	LINENO	RUNF	USR	ENDUSR	ENDTXT
	.GLOBL	TINPT	TOTPT	INPT	OTPT	LASTEX
	.GLOBL	STCOUN
	.GLOBL	S.DATA	S.NEXT	S.EOL	S.CON
;
; 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
	.PSECT	VERBAD,RW,I,GBL,REL,CON	;ROUTINE ADDRESSES FOR VERBS IN HERE
	.PSECT	BASIC3,RW,I,GBL,REL,CON,LOW	;START OF MAIN BODY
;RSX MACRO CALLS
	.MCALL	GET$	PUT$	OPEN$R	OPEN$W
	.MCALL	CLOSE$	OPEN$	CSI$	DELET$
	.MCALL	CSI$1	CSI$2	NMBLK$	FDAT$R
	.MCALL	DIR$	EXIT$S	CMKT$S
	.MCALL	ASTX$S	CSI$SW	CSI$SV
	.MCALL	CSI$ND	FDAT$R	FDRC$R
	.MCALL	MRKT$S	WTSE$S
	.MCALL	CLEF$S	QIO$S	WTLO$S	RDAF$S
	.MCALL	ALTP$S	QIOW$S
;

	.SBTTL	PCK00 - GET A LINE FROM INPUT DATASET
;
; PACK - PCK00  GET A LINE FROM INPUT DATASET
; USE OLD DEVICE IF INITIALISED, OTHERWISE TERMINAL
;
PCK00:	MOV	INPT,R2		;GET FILE CONTROL BLOCK POINTER
	MOV	R0,-(SP)	;SAVE R0
	CMP	#TINPT,R2	;IS THIS TERMINAL INPUT
	BNE	PCK06		;BR IF NOT
	CMP	TCOUNT,#1	;ANYTHING IN BUFFER BESIDES CARR CNTRL?
	BLE	3$		;BR IF NOT
	MOVB	#'$,OUTBUF	;PUT IN CARRIAGE CONTROL
	MOV	#TOTPT,R0	;POINT TO TERM OUT BLOCK
	JSR	PC,PRNT01	;FORCE OUT STUFF
3$:	CLEF$S	#1		;MAKE SURE MARK TIME FLAG CLEAR
	SUB	#4,SP		;SET SPACE FOR IO STATUS BLOCK
	MOV	SP,R1		;AND RECORD ITS POSITION
	QIO$S	#IO.RVB,#2,#2,,R1,,<#INPBUF,#TRMSIZE>
	BCC	4$		;IF OK, BRANCH
	JMP	PCK14		;ELSE REPORT ERROR
4$:	TST	WTMAG		;TIME OUT SPEC'D?
	BEQ	2$		;IF NOT, SKIP MARK TIME
	MRKT$S	#1,WTMAG,WTUNIT	;SET MARK TIME
2$:	WTLO$S	0,#3		;WAIT FOR SOMETHING TO HAPPEN
	SUB	#10,SP		;ALLOCATE SPACE FOR 4 WD BLOCK
	MOV	SP,R0		;PTR TO BLOCK -> R0
	RDAF$S	R0		;GET THE 4 FLAG WORDS
	MOV	(R0),R0		;GET FIRST FLAG WD -> R0
	ADD	#10,SP		;CLEAN UP STACK
	BIT	#1,R0		;CHECK FOR FLAG 1 (MARK TIME)
	BEQ	1$		;IF FLAG CLEAR, READ FINISHED - BRANCH
	QIOW$S	#IO.KIL,#2,#2,,R1	;KILL READ REQUEST
	JSR	PC,ATTACH	;AND NOW RE-ATTACH TERMINAL
	ADD	#4,SP		;RESTORE STACK
	TMOERR			;ERROR TRAP (TIMEOUT)
1$:	CMKT$S	#1		;CANCEL MARK TIME
	MOV	(SP)+,R1	;IO STATUS -> R1
	ADD	#14,R2		;UPDATE R2 AND
	MOV	(R2),R0		;R0 FOR FURTHER PROCESSING
	MOV	(SP)+,F.NRBD(R0) ;PUT AWAY THE COUNT
	TSTB	R1		;ERROR?
	BMI	PCK13		;IF SO, PROCESS ERROR
	BR	PCK02		;ELSE PROCESS LINE SUCCESSFULLY
PCK06:	ADD	#14,R2		;
	MOV	(R2),R0		;R0 CONTAINS FDB ADDRESS
	GET$	,-4(R2),-12(R2)	;GET RECORD WITH EXPLICIT RECORD BUFFER
	BCC	PCK02
	MOVB	F.ERR(R0),R1	;ERROR CODE IN R1
PCK13:	MOV	(SP)+,R0	;RESTORE R0
	CMPB	R1,#IE.EOF	;IS IT END OF FILE?
	BEQ	1$		;IF SO, BRANCH
	CMPB	R1,#IE.PRI	;MIGHT BE READ PAST END OF RAN ACC
	BNE	PCK01		;FILE, IF NOT PRIVILEGE ERROR, BRANCH
	BIT	#2000,-16(R2)	;MAKE SURE RAN ACC FILE
	BEQ	PCK01		;IF NOT, REGULAR ERROR
1$:	CLR	LINEFL		;IN CASE BINARY OR INPUT LINE
	CMP	#LNKOLD,R2	;IS THIS EOF ON OLD D.S.
	BEQ	PCK09		;BR IF SO
	MOV	2(R2),R0	;MAYBE SAVE EOF LINE NUMBER
	BNE	PCK07		;IF THERE, GO PROCESS
	CMP	#LNKTIN,R2	;IS IT TERMINAL
	BEQ	PCK12		;IF YES CHECK FURTHER
				;ELSE DO ERROR WHICH CLOSES ALL FILES
PCK08:	EOFERR			;EOF ERROR
;EOF IN RUN MODE WITH USER EXIT
PCK07:	MOV	ENDSTK,SP	;RESET STACK
	FINDLN			;GO LOOK FOR IT
	BNE	PCK08		;ERROR IF NOT FOUND
	JMP	INIT13		;ELSE GO PROCESS
PCK12:	TST	RUNF		;ARE WE RUNNING?
	BEQ	PCK11		;IF NOT, EXIT
	JMP	STOP00		;ELSE, JUST STOP
PCK11:	CLRUSR			;DO CLEAR SO FILES GET CLOSED
	CLOSE$	#TRMFDB		;CLOSE THE TERMINAL IN CASE SPOOLED (BATCH)
	EXIT$S			;WE GOTTA GET OUTA THIS PLACE..
;EOF ON OLD INPUT FILE
PCK09:	CLOSEF			;CLOSE OLD
	MOV	ENDSTK,SP	;RESET STACK
	TST	RUNF		;ARE WE IN RUN MODE
	BEQ	PCK10		;BR IF OLD COMMAND
	JMP	RUN01		;ELSE RUN IT
PCK10:	JMP	INIT00		;GET ANOTHER COMMAND
PCK01:	CMPB	R1,#IE.DNR	;IS THIS A HUNG-UP TTY
	BEQ	PCK11		;IF SO, CLOSE DOWN SHOP
	MOV	R1,PARLST+P.FCS	;RECORD FCS ERROR CODE
PCK14:	LINERR			;ELSE GIVE ERROR MESSAGE
PCK02:	MOV	-4(R2),R1	;ADDRESS OF DATA IN R1
	MOV	F.NRBD(R0),R0	;RECORD SIZE IN R0
	MOV	R0,LINELN	;RECORD LINE LEN IN CASE "INPUT LINE"
	ADD	R1,R0		;CHAR AFTER RECORD IN R0
	TST	LINEFL		;DOING LINE?
	BEQ	PCK03		;IF NOT, CHECK LEGALITY OF CHARS
	MOV	R0,R1		;ELSE POINT R1 TO END OF LINE
	BR	PCK05		;AND DO END OF LINE PROCESSING
PCK03:	CMP	R0,R1		;END OF STRING?
	BLE	PCK05		;IF SO BRANCH
	CMPB	#140,@R1	;CHECK NOT TOO BIG
	BLE	PCK04		;ERROR
	CMPB	#40,(R1)+	;CHECK NOT TOO SMALL
	BLE	PCK03		;DO NEXT
	CMPB	#11,-1(R1)	;WAS IT TAB?
	BEQ	PCK03		;IF SO, IT'S OK
	CMPB	#15,-(R1)	;CR ?
	BEQ	PCK05		;YES
	CMPB	#S.EOL,@R1	;OR END OF LINE
	BEQ	PCK05		;YES
PCK04:	ILCERR
PCK05:	MOVB	#S.EOL,@R1	;SET LINE TERMINATOR
	MOV	-4(R2),R1	;SET DATA ADDRESS
	MOV	(SP)+,R0	;RESTORE R0
	RTS	PC		;AND RETURN

	.PSECT	BASIC3
USDFNB:	NMBLK$	BASDAT,DAT,0,SY,0
SCDFNB:	NMBLK$	SCR,BAS,0,SY,0		;DFNB FOR SCRATCH FDB

	.SBTTL	PRNT00 - OUTPUT CHARACTER OR LINE
;
; PRINTC - PRNT00  OUTPUTS CHARACTER IN R2
; ON SAVE DEVICE IF INITED, OTHERWISE ON TERMINAL
;
; FOLLOWING CODE OUTPUTS A SINGLE CHARACTER INTO FILE BUFFER
	.PSECT	BASIC3
PRNT00:	MOV	R0,-(SP)	;SAVE FOR A BIT
	MOV	OTPT,R0		;GET FILE CONTROL BLOCK POINTER
	MOVB	R2,@(R0)+	;DUMP OUT CHARACTER
	INC	-(R0)		;POINT TO NEXT SLOT
	INC	6(R0)		;ADD TO ACTUAL BYTE COUNT
	CMP	2(R0),6(R0)	;AT MAX BC YET
	BGT	2$		;IF NOT, BRANCH
	CMP	OTPT,#TOTPT	;IS THIS TERMINAL?
	BNE	1$		;IF NOT, SKIP CARR CNTRL
	MOVB	#' ,OUTBUF	;NORMAL CARR CNTRL (SPACE)
1$:	BR	PRNT02		;GO PRINT OUT LINE
2$:	MOV	(SP)+,R0	;RESTORE
	RTS	PC		;AND RETURN
PRNT01:	MOV	R0,-(SP)	;SAVE REG
	MOV	OTPT,R0		;MAKE SURE CNTRL BLOCK PTR IN R0
PRNT02:	CMP	#TOTPT,R0	;TERMINAL OUTPUT??
	BEQ	PRNT04		;BR IF IT IS
	MOV	10(R0),(R0)+	;RESET CHAR POINTER
PRNT03:	MOV	R1,-(SP)	;SAVE R1 FOR AWHILE
	ADD	#12,R0		;GET FDB POINTER ADDR IN R0
	MOV	R0,R1		;AND ALSO IN R1
	MOV	(R0),R0		;ADDRESS OF FDB IN R0
	PUT$	,-4(R1),-6(R1)	;SPECIFY RECORD TO WRITE
	CLR	-6(R1)		;CLEAR ACTUAL BYTE COUNT
	SUB	#14,R1		;R1 AT BEGINNING OF CONTROL BLOCK
	CMP	R1,#TOTPT	;SEE IF TERMINAL WAS DONE
	BNE	PRNT06		;IF NOT BRANCH AROUND
	INC	6(R1)		;IF SO, ACCOUNT FOR CARRIAGE CONTROL
PRNT06:	MOV	(SP)+,R1	;RESTORE R1
	MOV	(SP)+,R0	;AND R0
	RTS	PC		;AND RETURN
PRNT04:	MOV	10(R0),(R0)	;RESET CHAR POINTER
	INC	(R0)+		;AND PUSH PAST CARRAIGE CONTROL
	BR	PRNT03		;CONTINUE

	.SBTTL	CLOS00 - CLOSE OPEN DATA SET (NON USER DATA)
;
; CLOSEF - CLOS00  CLOSES ANY OPEN DATA SETS
;
CLOS00:	MOV	#TINPT,INPT	;RESET INPUT POINTER
CLOS01:	TSTB	COMFDB+F.FACC	;IS ANY FILE OPEN
	BEQ	CLOS02		;SKIP IF NOT
	TST	SCOUNT		;ANYTHING LEFT IN SAVE BUFFER
	BEQ	CLOS03		;SKIP IF NOT
	MOV	R0,-(SP)	;SAVE REG
	MOV	#SOTPT,R0	;POINT TO SAVE CONTROL BLOCK
	JSR	PC,PRNT01	;FORCE IT OUT
	MOV	(SP)+,R0	;RESTORE
CLOS03:	CLR	REMTRM		;CLEAR REMARK TRIM FLAG
	CLR	LINEFL		;IN CASE GETTING COMPILED FILE
	MOV	R0,-(SP)	;SAVE R0 SO NOT CLOBBERED BY CLOSE
	CLOSE$	#COMFDB
	BIC	FD.PLC,F.RACC(R0) ;MAKE SURE BACK TO MOVE MODE FOR NEXT USE
	MOV	(SP)+,R0	;RESTORE R0
	MOV	#TOTPT,OTPT	;RESET OUTPUT POINTER
CLOS02:	RTS	PC
	.SBTTL	CLEAR0 - CLEAR USER DATA AREA
;+2
; .SKIP
; .X ^^CLEAR\\
; .X ^FILE CLOSE
; .INDENT -5
; ^^
; CLEAR
; \\
; .BREAK
; ^THIS COMMAND CLEARS THE USER DATA AREA.
; ^IT CLOSES ALL USER FILES BEFORE DOING THE CLEAR OPERATION.
;-
CLEAR0:	CLRUSR			;CLEAR IT OUT
	JMP	INIT02		;AND BACK TO INTERPRETER

	.SBTTL	CSINT0 - SET UP FOR COMMAND STRING INTERPRETER
;
; CSINT0 - COMMAND STRING INTERPRETER ROUTINE
; JSR PC,CSINT0
; WITH THE FOLLOWING REGISTERS ASSIGNED AS FOLLOWS:
;	R0: ZERO IF NO STRING TO INTERPRET
;	R2: ADDRESS OF SWITCH TABLE
;	R3: ADDRESS OF STRING
;	R4: LENGTH OF STRING
;
	.PSECT	BASIC3		;FOLLOWING CODE IS RO
CSINT0:	CMP	R4,#CSBUFS	;IS STRING TOO BIG TO FIT
	BHI	CSINT4		;IF SO, REPORT ERROR
	MOV	R0,-(SP)	;SAVE OLD R0
	BEQ	3$		;IF ZERO, NO STRING
	MOV	R1,-(SP)	;SAVE OLD R1
	MOV	#CSIBLK,R0	;SET UP FOR
	MOV	#C.SIZE,R1	;CLEAR OF CSIBLK
	ASR	R1		;GET WORD COUNT IN R1
1$:	CLR	(R0)+		;CLEAR OUT CSIBLK
	SOB	R1,1$		;KEEP GOING TILL DONE
	MOV	#CSBUFF,R1	;ADDRESS OF BUFFER IN R1
	MOV	R4,CSBUFL	;SAVE STRING LENGTH
	BEQ	CSINT4		;LEN ZERO IS ERROR
4$:	MOVB	(R3)+,(R1)+	;MOVE STRING IN
	SOB	R4,4$		;UNTIL DONE
	CSI$1	#CSIBLK,#CSBUFF,CSBUFL	;PERFORM SYNTAX CHECK
	BCS	CSINT4		;REPORT ERROR
	CSI$2	#CSIBLK,OUTPUT,R2 ;OTHERWISE INTERPRET LINE
	BCS	CSINT4		;REPORT ERROR
	MOV	(SP)+,R1	;RESTORE OLD R1
3$:	MOV	(SP)+,R0	;AND R0
	RTS	PC		;AND RETURN
CSINT4:	CSIERR

	.SBTTL	TST00 - TEST ALPHABETIC VS NUMERIC CHARACTER
;
; TSTCH - TST00, TEST ALPHABETIC VS NUMERIC IN R2
;	REGISTERS USED - R2
;	'V' SET IF NEITHER ALPHA OR NUMERIC
;	'Z' SET IF NUMERIC
;
TST00:	CMP	R2,#'0		;CHECK NUMERIC
	BLT	TST03		;NON-NUMERIC
	CMP	R2,#'9		;CHECK ALPHA
	BGT	TST01		;NON-NUMERIC
	SEZ			;SET ZERO CODE IF NUMERIC
	RTS	PC
TST01:	CMP	R2,#'A		;ALPHABETIC?
	BLT	TST03		;NO
	CMP	R2,#'Z		;ALPHABETIC?
	BGT	TST03		;NO
	CCC			;SET NON-ZERO CODE IF ALPHABETIC
	RTS	PC
TST03:	CCC
	SEV			;SET
	RTS	PC		;OVERFLOW IF NEITHER
	.SBTTL	CRLF00 - ROUTINE TO FORCE OUT LINE
;
;
;ROUTINE TO FORCE  OUT LINE IN RESPONSE TO CR LF REQUEST
;	REGISTER USED - R2.
;
CRLF00:	CMP	#TOTPT,OTPT	;SEE IF FOR TERMINAL
	BNE	CRLF01		;IF NOT BRANCH
	MOVB	#' ,OUTBUF
CRLF01:	JSR	PC,PRNT01
	RTS	PC
	.SBTTL	PRN00 - PRINT A LINE OF ASCII
;
; PRINTL - PRN00 - PRINT A LINE OF ASCII
;	R0 HAS STARTING ADDRESS, LINE IS TERMINATED BY A ZERO BYTE
;	REGISTERS USED - R0,R2.
PRN00:	MOVB	(R0)+,R2	;GET A CHARACTER
	BEQ	PRN01		;EXIT IF DONE
	PRINTC			;PRINT IT
	BR	PRN00		;LOOP
PRN01:	RTS	PC
	.SBTTL	SKIP00 - GET NEXT NON-BLANK CHARACTER IN BUFFER
;
; SKIP - SKIP00, SKIP OVER BLANKS IN WORKING STORAGE, R1 POINTS
;  TO LINE POSITION, CHARACTER FOUND GOES TO R2
;	REGISTERS USED - R1,R2.
;
SKIP00:	MOVB	(R1)+,R2	;GET A CHARACTER
	CMPB	#' ,R2		;IS IT BLANK?
	BEQ	SKIP00		;YES, GET ANOTHER
	CMPB	#11,R2		;IS IT TAB?
	BEQ	SKIP00		;LIKEWISE GET NEXT CHAR.
	RTS	PC
	.SBTTL	JUNK00 - SKIP OVER REMAINDER OF LINE
;
; JUNKIT - JUNK00, SKIP OVER REMAINDER OF LINE
;	UNTIL _<LF> OR ":" IS FOUND.
;  R1 POINTS TO TERMINATOR ON EXIT.
;	REGISTERS USED - R1.
;
JUNK00:	CMPB	(R1),#'"	;START OF STRING?
	BNE	1$		;IF NOT, DO OTHER CHECKS
	JSR	PC,SKPQT	;IF SO, SKIP QUOTES
	BR	JUNK00		;AND CHECK AGAIN
1$:	CMPB	@R1,#S.CON	;IS CHARACTER A ":"?
	BEQ	JUNK01		;JUMP IF YES
	CMPB	(R1)+,#S.EOL	;IS IT A LINE TERMINATOR?
	BNE	JUNK00		;NO, LOOK AGAIN
	DEC	R1		;YES, BACK UP POINTER ONE PLACE
JUNK01:	RTS	PC
	.SBTTL	CLRU00 - CHECK FOR AND DELETE USER SPACE
;
; CLRUSR - CLRU00, CHECK FOR EXISTENCE OF USER SPACE, AND DELETE
;  IT IF PRESENT.  REGISTERS USED - R5.
;
CLRU00:	JSR	PC,CLSEAL	;CLOSE ALL USER DATA FILES
	JSR	PC,DETACH	;IN CASE TERMINAL ATTACHED
	CLR	DATI		;CLEAR THE DATA POINTER
	MOV	STUDAT,ENUDAT	;ZAP ALL OF USER DATA
	RTS	PC

	.SBTTL	PSH00 - PUSH DUMMY VARIABLE ONTO USER LIST
;
; PSHNAM, PSH00 - PUSH A DUMMY VARIABLE ON THE USER LIST
; ON RETURN, R0 POINTS TO DATA ADDRESS
;
PSH00:	MOV	R0,-(SP)	;SAVE THE NAME
	MOV	#10,R0		;CHECK FOR ROOM
	TSTOK
	BLO	PUSH02		;IF NOT ENOUGH, BRANCH
	MOV	(SP)+,(R5)+	;PUT IN NAME
	CLR	(R5)+		;AND ZERO DIMENSIONS
	MOV	R5,R0		;SAVE ADDRESS OF DATA
	CLR	(R5)+		;PUT IN ZERO
	CLR	(R5)+
	MOV	R5,ENUDAT	;MAKE ITEM PERMANENT
	RTS	PC
	.SBTTL	PSHS00 - PUSH A STRING DESCRIPTOR ONTO USER LIST
;
; PSHSTR, PSHS00 - PUSH A STRING DISCRIPTOR ON THE USER LIST
; ON ENTRY:
;	R0 CONTAINS NAME PACKED INTO LOWER 12 BITS + 13000.
; ON RETURN:
;	R3 CONTAINS POINTER TO 3RD WORD OF STRING ITEM.
;	R0 CONTAINS POINTER TO STRING ITSELF.
;
PSHS00:	MOV	R0,-(SP)	;SAVE NAME AND STACK CODE
	MOV	#26,R0		;CHECK FOR ROOM
	TSTOK
	BHIS	2$		;IF OK, BRANCH
	OVFERR
2$:	MOV	(SP)+,(R5)+	;PUT NAME INTO USER STORAGE
	CLR	(R5)+		;PUSH A ZERO DIMENSION WORD
	MOV	R5,R3		;SET R3 TO STRING INFO
	MOV	#177417,R0	;SET VARIABLE(15) STRING
	MOV	R0,(R5)+
	MOV	R5,-(SP)	;SAVE DATA ADDRESS
	INC	@SP
	MOV	#10,R0		;SAVE STRING SPACE
1$:	CLR	(R5)+
	SOB	R0,1$
	MOV	R5,ENUDAT
	MOV	(SP)+,R0	;DATA ADDRESS
	RTS	PC		;RETURN
	.SBTTL	PUSH00 - PUSH ONE WORD IN R0 ONTO USER LIST
;
; PUSH - PUSH00, PUSH ONE WORD IN R0 ON USER STORAGE LIST
;	IF ENDTXT=0 ON ENTRY, SAVE R5 IN ENDTXT FIRST
;	IF R5 IS ODD, MOVE TO NEXT EVEN BOUNDARY
;	R5 IS UPDATED WHEN ITEM IS PLACED ON THE LIST
;	REGISTERS USED - R0,R5.
;
PUSH00:	CMP	R5,STGOSB	;CHECK FOR ROOM
	BHIS	PUSH02		;OVERFLOW
PUSH01:	MOV	R0,(R5)+	;PUT ONE WORD ON THE LIST
	RTS	PC
PUSH02:	OVFERR

	.SBTTL	SRL00 - SEARCH USER STORAGE (FOR ITEM OF CLASS TYPE IN R4)
;
; SRLST - SRL00, SEARCH USER STORAGE FOR THE FIRST ITEM HAVING THE
;	CLASS AS SPECIFIED IN R4.  THE ADDRESS OF THE FOUND ITEM IS
;	RETURNED IN R3.  UPON ENTRY, R3 MUST POINT TO THE START ADDRESS
;	OF THE LIST.  REGISTERS USED - R0,R2,R3,R4.
;	AND R0 IS A MASK OF BITS TO IGNORE IN THE HEADER.
;
SRL01:	MOV	@R3,R0		;GET ITEM ON TOP OF LIST
	BIC	@SP,R0		;CLEAR OUT THE JUNK
	CMP	R0,R4		;ARE THE CLASSES THE SAME?
	BEQ	SRL05		;EXIT IF YES
	ASH	#-14,R0		;MOVE DOWN THE BITS WE'RE INTERESTED IN
	BIC	#177761,R0	;AND CLEAR OUT EVERYTHING ELSE
	JMP	@SRLTBL(R0)	;GO TO APPROPRIATE UPDATE ROUTINE
SRLTBL:	.WORD	SRL04		;TYPE 0 - NUMERIC VARIABLE
	.WORD	SRL03		;TYPE 1 - GOSUB/RETURN POINTER
	.WORD	SRL07		;TYPE 2 - FOR LOOP CONTROL TABLE
	.WORD	SRL02		;TYPE 3 - NUMERIC FUNCTION
	.WORD	SRL02		;TYPE 4 - STRING FUNCTION
	.WORD	SRL09		;TYPE 5 - STRING VARIABLE
	.WORD	SRL10		;TYPE 6 - FILE CONTROL BLOCK
	.WORD	SRL11		;TYPE 7 - SCRATCH STACK ITEM
SRL07:	TM2ERR
SRL00:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	BIC	#160000,R0	;ONLY ALLOW SINGLE TYPE
	MOV	R0,-(SP)	;SAVE MASK
SRL08:	CMP	R3,ENUDAT	;OUT OF SPACE?
	BLO	SRL01		;NO
	BHI	SRL12		;IF HIGH, BAD USER AREA
	CLR	R3		;YES, QUIT - SET NOT FOUND
SRL05:	MOV	(SP)+,R0	;RESTORE MASK
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	TST	R3		;SET STATUS BITS ON RESULT OF SEARCH
	RTS	PC
SRL02:	MOV	2(R3),R0	;CLASS 3 & 4 HERE, NO OF ARGS IN R0
	ASL	R0		;MPY BY 2
	ADD	#6,R0		;ADD ON HEADER LEN
	ADD	R0,R3		;ADJUST R3
	BR	SRL08
SRL04:	MOVB	2(R3),R0	;FIRST DIM -> R0
	BEQ	2$		;IF ZERO, BRANCH
	MOVB	3(R3),R1	;SECOND DIM -> R1
	BEQ	3$		;IF ZERO, BRANCH (DO FAST CALC)
	ARYLG			;ELSE DO LONG CALC
	BR	4$		;AND GO FINISH
2$:	MOVB	3(R3),R0	;SECOND DIM -> R0
3$:	BIC	#177400,R0	;MAKE SURE POS.
	INC	R0		;ADD 1
	ASL	R0		;MPY BY FOUR
	ASL	R0		;BYTES/VAR.
4$:	ADD	R0,R3		;ADJUST DATA PTR
	ADD	#4,R3
	BR	SRL08
SRL03=SRL07
SRL09:	TST	(R3)+		;GET PAST HEADER
	MOV	(R3)+,R1	;PACKED DIM -> R1
	BEQ	2$		;IF ZERO, DO EASY CODE
	MOV	(R3)+,R0	;MAX STRING LEN -> R0
	STRLEN			;CALC TOTAL LEN LONG WAY
1$:	ADD	R0,R3		;ADJUST DATA PTR
	BR	SRL08		;AND GO BACK TO MAIN LOOP
2$:	MOV	(R3)+,R0	;MAX STRING LEN -> R0
	BIC	#177400,R0	;MAKE SURE POS.
	ADD	#2,R0		;ADD 1 FOR COUNT, 1 FOR ROUNDUP
	BIC	#1,R0		;CLEAR ODD BYTE
	BR	1$		;FINISH
SRL10:	TM2ERR			;SHOULDN'T HAVE THIS TYPE
SRL11:	MOV	(R3),R0		;HEADER BACK IN R0
	ADD	#3,R0		;ROUND UP LENGTH
	BIC	#160001,R0	;MAKE EVEN AND CLEAR TYPE
	ADD	R0,R3		;GET TO NEXT ITEM
	BR	SRL08
SRL12:	MOV	R3,PARLST+P.FCS	;STORE ADDRESS IN FCS ERROR LOCATION
	TM1ERR			;DECLARE TEMPORARY ERROR

	.SBTTL	STRL00 - COMPUTE STRING SPACE SIZE
;
; STRLEN - STRL00, COMPUTE STRING SPACE SIZE. PACKED DIMENSIONS
;	IN R1,STRING MAX LENGTH IN R0
;	REGISTERS USED - R0,R1,R3
;
STRL00:	MOV	R3,-(SP)	;SAVE
	MOV	R1,R3
	SWAB	R1
	BIC	#177400,R1
	BIC	#177400,R3
	INC	R1		;ADD ONE TO BOTH
	INC	R3
	CLC			;CAUSE FUNNY MULTIPLY
	MUL	R1,R3		;GET ONE WORD PRODUCT
	BCS	STRL01		;BR TOO LARGE
	BIC	#177400,R0
	INC	R0		;ACCOUNT FOR LEN FIELD
	MUL	R0,R3		;TIMES STRING SIZE
	BCS	STRL01		;BR TOO LARGE
	MOV	R3,R0		;PASS RESULT BACK
	INC	R0		;ROUND UP
	BIC	#1,R0
	MOV	(SP)+,R3	;RESTORE
	CCC
	RTS	PC
STRL01:	MOV	(SP)+,R3	;RESTORE
	SEV
	RTS	PC
	.SBTTL	ARYL00 - COMPUTE ARRAY LENGTH
;
; ARYLG - ARYL00, COMPUTE ARRAY LENGTH - FIRST DIM IN R0, SECOND IN
;	R1, RESULT RETURNED IN R0.  REGISTERS USED - R0,R1,R2,R3.
;
ARYL00:	BIC	#177400,R0	;CLEAR BOTH
	BIC	#177400,R1	;SIGN EXTENSIONS IF ANY
	INC	R0		;ADD ONE
	INC	R1		; TO EACH AND
	CLC			;STRANGE MULTIPLY
	MUL	R0,R1		;GET PRODUCT IN R1
	BCS	ARYL01		;JUMP IF TOO BIG
	MOV	R1,R0		;SET IN CORRECT REG
	CMP	R0,#22000	;IS ARRAY LONGER THAN IS POSSIBLE?
	BHIS	ARYL01
	ASL	R0		;MULTIPLY RESULT BY 4
	ASL	R0
	CCC
	RTS	PC		;RETURN
ARYL01:	SEV
	RTS	PC		;SET ERROR IF IMPOSSIBLE ARRAY

	.SBTTL	SCR00 - DELETE BYTES FROM R3 TO R4 FROM USER STORAGE
;
; SCRNCH - SCR00, DELETE THE NUMBER OF BYTES FROM THE USER STORAGE
;	SPECIFIED BY R4.  R3 POINTS TO STARTING POINT FOR THE
;	DELETION.  REGISTERS USED - R2,R3,R4
;
SCR00:	MOV	R3,R2		;GET A COPY OF THE POINTER
	ADD	R4,R2		;R2 HAS START OF REMAINING DATA
	MOV	ENUDAT,R4	;END OF REMAINING DATA IN R4
	SUB	R2,R4		;LEN OF REMAINING DATA IN R4
	ASR	R4		;# WDS OF REMAINING DATA
	BEQ	2$		;IF ZERO, SKIP THE MOVE
1$:	MOV	(R2)+,(R3)+	;MOVE OLD DATA DOWN
	SOB	R4,1$
2$:	MOV	R3,ENUDAT	;ESTABLISH NEW END OF DATA
	RTS	PC
	.SBTTL	SQU00 - DELETE ONE LINE OF TEXT
;
; SQUISH - SQU00, DELETE LINE WHOSE HEADER IS POINTED TO BY R5
; ON ENTRY:
;	R5 HAS POINTER TO LINE HEADER
; ON EXIT:
;	R5 = OLD R5 + 4 (POINTS TO PRECEDING LINE HEADER)
;	R1 POINTS TO INSERTION POINT FOR NEW LINE (WHERE OLD LINE WAS)
;	OLD LINE HEADER AND LINE TEXT ARE DELETED
;	ENDTXT AND BOLNHD UPDATED
;
SQU00:	MOV	2(R5),R1	;GET TEXT OFFSET
	ADD	USR,R1		;ADD BASE FOR ABS ADD
	MOV	R1,R2		;GET TWO COPIES
	SRCHLF			;START OF NEXT LINE -> R1
	MOV	R1,-(SP)
	SUB	R2,(SP)
	MOV	ENDTXT,R3	;CALC # OF CHARS
	SUB	R1,R3		;TO MOVE -> R3
	BEQ	2$		;IF ALREADY THERE, SKIP CODE
1$:	MOVB	(R1)+,(R2)+	;SLIDE REST OF CODE DOWN
	SOB	R3,1$
2$:	MOV	BOLNHD,R2	;BOTTOM OF LINE HEADER AREA -> R2
	MOV	R5,R3		;CURRENT POSITION IN HEADERS -> R3
	MOV	R0,-(SP)	;SAVE R0
	MOV	#4,R0		;4 BYTES TO MOVE UP
	JSR	PC,SLUP		;SLIDE IT ALL UP
	ADD	R0,R5		;ADJUST POSITION OF R5
	ADD	R0,BOLNHD	;AND BOTTOM OF HEADER AREA
	MOV	(SP)+,R0	;RESTORE OLD R0
	MOV	(SP)+,R2	;# OF BYTES WE MOVED TEXT DOWN BY -> R2
	MOV	#4,R3
	MOV	R5,-(SP)	;SAVE HEADER INSERTION POINT
3$:	SUB	R3,R5		;NOW GO THROUGH ALL HEADERS PAST
	CMP	R5,BOLNHD	;ONE WE DELETED AND ADJUST THEIR
	BLO	4$		;OFFSETS TO ACCOUNT FOR MISSING TEXT
	SUB	R2,2(R5)
	BR	3$
4$:	SUB	R2,ENDTXT	;ALSO ADJUST END OF TEXT POINTER
	MOV	(SP)+,R5	;RESTORE HEADER INSERTION POINT
	CMP	R5,BOLNHD	;IS IT AT END OF PROGRAM?
	BNE	5$		;IF NOT, BRANCH
	MOV	ENDTXT,R1	;IF SO, ENDTXT IS INSERTION POINT
	BR	6$
5$:	MOV	-2(R5),R1	;GET INSERTION OFFSET (START OF NEXT LINE)
	ADD	USR,R1		;AND MAKE IT ABSOLUTE
6$:	RTS	PC
	.SBTTL	SRCH00 - SEARCH FOR EOL
;
; SRCHLF - SRCH00, SEARCH FOR EOL, POINTER IN R1, WHEN DONE R1
;  POINTS ONE BYTE AFTER THE EOL.  REGISTERS USED - R1.
;
SRCH00:	CMPB	(R1)+,#S.EOL	;IS THIS CHAR A LINE TERMINATOR?
	BNE	SRCH00		;NO
	RTS	PC

	.SBTTL	FIND00 - SEARCH TEXT FOR LINE NUMBER (SPECIFIED IN R0)
;
; FINDLN - FIND00
; SUBROUTINE TO FIND A GIVEN LINE IN THE PROGRAM TEXT
; BY SEARCHING THROUGH LINE NUMBER HEADERS
; ON ENTRY:
;	R0 HAS REQUIRED LINE NUMBER
; ON EXIT:
;	R1 HAS ABSOLUTE START OF LINE IF MATCH
;	R1 HAS INSERTION POINT IN TEXT IF NO MATCH
;	R5 POINTS TO HEADER IF MATCH
;	R5 POINTS TO HEADER INSERTION POINT IF NO MATCH
;	'Z' SET IF MATCH
;	'Z' CLEAR IF NO MATCH
;	R0 UNCHANGED
; OTHER REGISTERS USED: R2
;
FIND00:	MOV	STUDAT,R1	;R1 PTS ABOVE LOWEST LINE # HEADER
	MOV	BOLNHD,R2	;R2 PTS TO HIGHEST LINE # HEADER
FIND01:	CMP	R1,R2		;ANY TEXT?
	BEQ	8$		;IF NOT, BRANCH
1$:	CMP	R0,-4(R1)	;SEE IF IN RANGE
	BLO	4$		;IF TOO LOW, R1 IS INSERTION POINT, BRANCH
	BEQ	7$		;IF MATCH, BRANCH
	CMP	R0,(R2)		;CHECK OTHER END OF RANGE
	BHI	8$		;IF TOO HIGH, R2 IS INSERTION PT, BRANCH
	BEQ	11$		;IF MATCH AT THIS END, BRANCH
	MOV	R1,R5		;OTHERWISE LET'S SPLIT
	SUB	R2,R5		;DIFFERENCE: DIVIDE BY 8,
	ASH	#-3,R5		;CLEAR REMAINDER
	CLC			;(C-BIT) AND
	ASH	#2,R5		;MPY BY 4
	ADD	R2,R5		;ADD BACK OFFSET
	CMP	R0,(R5)		;AND SEE WHERE WE ARE
	BEQ	3$		;IF A HIT, BRANCH
	BHI	2$		;IF IN UPPER HALF, BRANCH
	MOV	R5,R2		;IN LOWER HALF, SO RESET
	BR	1$		;RANGE AND TRY AGAIN
2$:	MOV	R5,R1		;IN UPPER HALF, SO RESET
	BR	1$		;RANGE AND TRY AGAIN
3$:	MOV	2(R5),R1	;SET POINT IN TEXT
	ADD	USR,R1		;WITH OFFSET IN
	SEZ			;SUCCESS INDICATOR
	RTS	PC		;AND RETURN
4$:	MOV	R1,R5		;SET HEADER INSERTION POINT
	BR	5$
7$:	MOV	R1,R5		;SET FOR MATCH ON
	SUB	#4,R5		;FOLLOWING LINE
	BR	3$		;AND FINISH MATCH CODE
8$:	MOV	R2,R5		;SET HEADER INSERTION AT HIGH END OF LINE NOS.
	CMP	R5,BOLNHD	;AT BOTTOM OF HEADERS (PAST END OF PROG)?
	BEQ	10$		;IF SO, BRANCH
5$:	MOV	-2(R5),R1	;START OF NEXT LINE IS TEXT INSERTION POINT
	ADD	USR,R1		;ADD IN START OF TEXT SECTION
9$:	CLZ			;SET NO MATCH
	RTS	PC		;AND RETURN
10$:	MOV	ENDTXT,R1	;END OF TEXT IS INSERTION POINT
	BR	9$		;GO FINISH
11$:	MOV	R2,R5		;MATCH AT HIGH LINE # END OF RANGE
	BR	3$		;GO FINISH
	.SBTTL	GETV00 - GET VARIABLE AND PACK INTO R4
;
; GETVAR - GETV00, GET A VARIABLE AND PACK IT IN TRUNCATED ASCII INTO
;	R4.  ON RETURN R4 HAS VARIABLE, R2 HAS NEXT CHARACTER.
;	REGISTERS USED - R1,R2,R4.
;
GETV00:	SKIP			;GET A CHARACTER
	TSTCH			;ALPHABETIC?
	BEQ	GETV99		;NO
	BVS	GETV99		;NO
	BIC	#177700,R2	;TRUNCATE IT
	MOV	R2,R4		;AND
	SWAB	R4		;PACK IT IN
	ASR	R4		;THE
	ASR	R4		;HEADER WORD
	SKIP			;GET NEXT CHARACTER
	TSTCH			;NUMERIC?
	BNE	GETV01		;NO
	BIS	R2,R4		;YES, ZOT IT INTO THE HEADER
	SKIP			;GET ANOTHER CHARACTER
GETV01:	CCC
	RTS	PC		;RETURN OK
GETV99:	SEV			;SET OVERFLOW FOR BAD VARIABLE
	RTS	PC

	.SBTTL	DIMC00 - CHECK RANGE OF DIMENSION (IN R0) 
;
; DIMCHK - DIMC00, MAKE SURE DIMENSION IN R0 IS IN BOUNDS 0 TO 255
;	REGISTERS USED - R0.
;
DIMC00:	CMP	R0,#377		;IN 0 -> 255. RANGE?
	BHI	1$		;IF NOT, BRANCH
	SEZ			;SET EQUAL CODE IF IN BOUNDS
	RTS	PC
1$:	CCC			;SET ILLEGAL DIMENSION
	RTS	PC

	.SBTTL	SAVE00 - LIST PROGRAM ON "SAVE" DATASET
;+2
; .SKIP
; .X ^^SAVE\\
; .X ^PROGRAM SAVE
; .INDENT -5
; ^^
; SAVE _<STRING FILESPEC[/CO]> [N1][-N2][,N3...]
; \\
; .BREAK
; ^PRIMARILY AN IMMEDIATE MODE COMMAND.
; ^IT MAKES A COPY OF THE PRESENT PROGRAM ON THE FILE NAMED IN
; THE STRING FILESPEC (STRING VARIABLE OR STRING IN QUOTES).
; ^THE OPTIONAL SWITCH WILL PRODUCE A PSUEDO-COMPILED VERSION
; WHICH CAN BE READ BACK WITH THE SAME SWITCH WITHOUT
; RE-INTERPRETING THE CODE THUS SAVING A CONSIDERABLE AMOUNT
; OF TIME FOR LONG PROGRAMS.
; ^THE DEFAULT EXTENSION WILL BE <BAC IF THE SWITCH IS INCLUDED.
; ^OPTIONAL LINE NUMBERS OR LINE NUMBER RANGES CAN BE INCLUDED.
; ^THE DEFAULT FILE SPECIFIER IS: ^^SY:PROGRAM.BAS\\
; OR THE NAME, EXTENSION AND DEVICE IN THE LAST <OLD, <RUN,
; <CHAIN OR <OVERLAY COMMAND.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	SAVE "PROGRAM"
;	SAVE "LP:"
;	SAVE "DK2:PROG.BAS"
;	SAVE
; \\
; .FILL
;-
SAVE00:	SKIP			;GET NEXT CHARACTER
	DEC	R1		;RESET TEXT POINTER
; THE FOLLOWING CODE ZEROES THE CSI BLOCK IN CASE NO STRING
	MOV	#CSIBLK,R3
	MOV	#C.SIZE,R4
	ASR	R4
1$:	CLR	(R3)+
	SOB	R4,1$
;
	CMP	R2,#S.EOL	;A LINE FEED?
	BEQ	SAVE02		;SKIP CSI
SAVE01:	JSR	PC,FNAME	;CHECK FOR STRING EXPRESSION
	MOV	#SAVSWT,R2	;GET SWITCH TABLE
	JSR	PC,CSINT0	;GET FILE SPECS IN CSDSPT
	JSR	PC,SETEXT	;GO SET PROPER EXTENSION
SAVE02:	MOV	LNKSAV,R0	;ADDRESS OF SAVE FDB IN R0
	FDAT$R	,#R.VAR,#FD.CR
	FDRC$R	,,SCOUNT+2,SOTPT+2
	OPEN$W			;GO OPEN FOR WRITE
	BCC	SAVE03		;CHECK FOR ERROR
	JMP	SAVFER		;GO TO ERROR ROUTINE
SAVE03:	MOV	#SOTPT,OTPT	;INDICATE SAVE IN PROGRESS
	JMP	LIST00
	.SBTTL	OLD00 - RESTART ON OLD FILE
;+2
; .SKIP
; .X ^^OLD\\
; .X ^PROGRAM RETRIEVE
; .INDENT -5
; ^^
; OLD _<STRING FILESPEC[/RT][/CO]>
; \\
; .BREAK
; ^THE ^^OLD\\ COMMAND READS IN A PREVIOUSLY SAVED OR EDITED PROGRAM
; FROM THE FILE NAMED IN THE STRING FILESPEC (AS IN ^^SAVE\\).
; ^THE OPTIONAL SWITCH, WHEN SPECIFIED, CAUSES TRUNCATION OF
; ^^REM\\ AND ! STATEMENTS.
; ^THE DEFAULT FILE SPECIFIER IS: ^^SY:PROGRAM.BAS\\
; ^THE <CO SWITCH INDICATES THAT A COMPILED BASIC FILE IS TO BE
; USED (DEFAULT EXTENSION <BAC).
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	OLD "PROG1"
;	OLD "DK3:PROGRAM.BAS"
; \\
; .FILL
;-
OLD00:	CLR	RUNF		;TURN OFF RUN FLAG
	SKIP			;GET NEXT CHARACTER
	DEC	R1		;RESET TEXT POINTER
	CMP	R2,#S.EOL	;A LINE FEED?
	BNE	OLD01		;HANDLE TEXT STRING
OLD04:	CSIERR			;MUST HAVE FILE NAME
OLD01:	JSR	PC,FNAME	;CHECK FOR STRING EXPRESSION
	BEQ	OLD04		;IF NO STRING, ERROR
	MOV	#OLDSWT,R2	;SWITCH TABLE ADDRESS IN R2
	JSR	PC,CSINT0	;GET FILE SPECS IN CSDSPT
OLD05:	JSR	PC,CLRTXT	;CLEAR OUT PROGRAM TEXT
OLD02:	MOV	LNKOLD,R0	;ADDRESS OF OLD FDB IN R0
	JSR	PC,SETEXT	;GO SET PROPER EXTENSION
	FDRC$R	,,OINPT+10,OINPT+2
	OPEN$R			;GO OPEN FOR READ
	BCC	OLD03		;CHECK FOR ERROR
	JMP	OLDFER		;GO TO ERROR ROUTINE
OLD03:	MOV	#OINPT,INPT	;INDICATE OLD IN PROGRESS
; FOLLOWING CODE ADDED TO CHANGE DEFAULT FILE NAME INFO.
	ADD	#F.FNB+N.FNAM,R0 ;MAKE R0 POINT TO START OF NAME IN FNB
	MOV	#COMFNB+N.FNAM,R2 ;DFNB NAME ADDRESS -> R2
	MOV	#4,R3		;SET TO XFER NAME AND EXTENSION
1$:	MOV	(R0)+,(R2)+	;MOVE IN NAME
	SOB	R3,1$		;AND EXTENSION
	ADD	#14,R0		;POINT TO
	ADD	#14,R2		;DEVICE NAME
	MOV	(R0)+,(R2)+	;TRANSFER IT IN
	MOV	(R0)+,(R2)+	;AND UNIT #
;
	JMP	INIT04		;BACK TO INTERPRETER
CLRTXT:	MOV	USR,R5		;DELETE ALL
	INC	R5		;LEAVE ORIGINAL LF
	MOV	R5,ENDTXT	;SAVE 
	CLR	LINENO		;CLEAR LINE NUMBER
	MOV	STUDAT,BOLNHD	;DELETE LINE HEADERS
	RTS	PC		;RETURN
SETEXT:	MOV	#6273,COMFNB+N.FTYP ;SET "BAS" EXTENSION
	BIT	#2,REMTRM	;DO WE HAVE /CO SWITCH?
	BEQ	1$		;IF NOT, ALL OK AND BRANCH
	MOV	#6253,COMFNB+N.FTYP ;SET "BAC" EXTENSION
	MOV	#1,LINEFL	;ENABLE READING OF STRANGE CHARS
1$:	RTS	PC		;AND RETURN
	.SBTTL	CHAIN0 - START EXECUTING NEW FILE WITH OLD DATA
;+3
; .SKIP
; .X ^^CHAIN\\
; .X ^PROGRAM CHAIN
; .INDENT -5
; ^^
; CHAIN _<STRING FILESPEC[/LI:VAL][/RT][/CO]>
; \\
; .BREAK
; ^THE ^^CHAIN\\ COMMAND READS IN ANOTHER ^^BASIC\\ PROGRAM WHILE
; PRESERVING VARIABLES AND OPEN FILES' ^^FCB\\'S.
; ^^GOSUB/RETURN\\ POINTERS, ^^FOR\\ LOOP CONTROL TABLES, USER ^^DEF\\INED
; FUNCTIONS AND SCRATCH ITEMS ARE ALL DELETED FROM THE USER DATA AREA.
; ^THUS USER FUNCTIONS MUST BE REDEFINED IN ANY NEW PROGRAM MODULE.
; ^THE DEFAULT FILE SPECIFIER AND SWITCHES ARE THE SAME AS FOR THE 
; ^^OVERLAY\\ COMMAND WITH THE ADDITION OF THE /<LI SWITCH WHICH CAN SPECIFY
; AN OPTIONAL LINE NUMBER TO CONTINUE EXECUTION.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
; 	20 CHAIN "PROG2"
; \\
; .FILL
;-
;
CHAIN0:	MOV	#1,RUNF		;SET THE RUN FLAG
	CLR	DATI		;CLEAR THE DATA POINTER
	MOV	STUFDB,R0	;GET RID OF
	MOV	R0,STGOSB	;GOSUB/RETURN AREA
	MOV	R0,STFONX	;AND FOR/NEXT AREA
	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
	MOV	STUDAT,R3	;GET START OF USER DATA AREA
CHAIN1:	CMP	R3,ENUDAT	;ARE WE AT END
	BHIS	CHAIN2		;IF SO, GO GET NEW FILE
	MOV	(R3),R0		;ITEM HEADER IN R0
	BIC	#17777,R0	;CLEAR ALL BUT TYPE
	SWAB	R0		;MOVE DOWN 8 BITS (NO SIGN EXTEND)
	ASH	#-4,R0		;AND THE REST OF THE WAY
	JMP	@CHNTBL(R0)	;GO TO RIGHT ROUTINE
CHAIN2:	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	JSR	PC,CLRTXT	;CLEAR OUT EXISTING PROGRAM TEXT
	BR	OVL00		;AND READ IN FILE WITH OPT LINE # TO START
CHNTBL:	.WORD	CHN00	;NUMERIC VARIABLES
	.WORD	CHN02	;GOSUB/RETURN POINTER
	.WORD	CHN04	;FOR LOOP CONTROL TABLE
	.WORD	CHN06	;NUMERIC FUNCTION
	.WORD	CHN10	;STRING FUNCTION
	.WORD	CHN12	;STRING VARIABLE
	.WORD	CHN14	;FILE CONTROL BLOCK
	.WORD	CHN16	;SCTATCH ITEM
CHN00:	MOVB	2(R3),R0	;DIMENSIONS IN R0
	MOVB	3(R3),R1	;AND R1
	ARYLG			;CALCULATE LENGTH -> R0
	ADD	R0,R3		;ADD TO PTR
	ADD	#4,R3		;PLUS FIRST 2 WORDS
	BR	CHAIN1		;AND LOOK AT NEXT ITEM
CHN02:	TM2ERR
CHN03:	MOV	R3,R5		;SAVE CURRENT POSITION
	SCRNCH			;MOVE REST DOWN
	MOV	R5,R3		;GET BACK POSITION
	BR	CHAIN1		;AND SEE WHAT'S HERE NOW
CHN04:	TM2ERR
CHN06:	MOV	2(R3),R4	;GET NUM OF USER FCN VARIABLES
	ASL	R4		;MAKE IT IN BYTES
	ADD	#6,R4		;ADD 1ST 3 WORDS
	BR	CHN03		;AND DELETE
CHN10	=CHN06			;NUMERIC AND STRING ARE SAME
CHN12:	TST	(R3)+		;BUMP PAST STRING VAR. HEADER
	MOV	(R3)+,R1	;PACKED DIMENSIONS -> R1
	MOV	(R3)+,R0	;SIZE AND TYPE -> R0
	STRLEN			;CALC LEN -> R0
	ADD	R0,R3		;ADD IT ON
	BR	CHAIN1		;AND LOOK AT NEXT ITEM
CHN14:	TM2ERR			;SHOULDN'T HAVE THIS DATA TYPE
CHN16:	MOV	(R3),R4		;SCRATCH HEADER -> R4
	ADD	#3,R4		;ADD HEADER AND ROUND UP
	BIC	#160001,R4	;ALSO CLEARING HEADER TYPE
	BR	CHN03		;AND DELETE ITEM
	.SBTTL	OVERLAY - ADD PROGRAM LINES FROM FILE AND OPTIONALLY EXECUTE
;+3
; .SKIP
; .X ^^OVERLAY\\
; .X ^PROGRAM OVERLAY
; .INDENT -5
; ^^
; OVERLAY _<STRING FILESPEC [/LI:VAL][/RT][/CO]>
; \\
; .BREAK
; ^THE ^^OVERLAY\\ COMMAND READS IN ADDITIONAL PROGRAM TEXT FROM THE SPECIFIED
; FILE AND ADDS THEM TO THE EXISTING PROGRAM JUST AS THOUGH THEY WERE TYPED
; FROM THE KEYBOARD: I.E. NEW STATEMENTS WITH THE SAME LINE NUMBER AS AN
; EXISTING STATEMENT REPLACE THE EXISTING STATEMENT.
; ^THE SAME PRECAUTIONS REGARDING FUNCTION DEFINITIONS AND ^^DATA\\ STATEMENTS
; DURING DEBUGGING SHOULD ALSO BE OBSERVED WHEN USING THE ^^OVERLAY\\
; STATEMENT IN PROGRAM MODE.
; ^THE OPTIONAL SWITCH (/^L^I) IS SIGNIFICANT IN PROGRAM MODE ONLY AND CAN BE
; USED TO SPECIFY THE LINE AT WHICH EXECUTION SHOULD RESUME.
; ^THE /<RT AND /<CO SWITCHES ARE THE SAME AS FOR THE ^^OLD\\ COMMAND.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
; 	OVERLAY "PATCH1"
; 	100 OVERLAY "PATCH2.BAS/LI:500"
; \\
; .FILL
;-
;
	.PSECT	BASIC3
OLDSWT:
OVLSWT:	CSI$SW	LI,,,,,LINSWT
	CSI$SW	RT,1,REMTRM
SAVSWT:	CSI$SW	CO,2,REMTRM
	CSI$ND
LINSWT:	CSI$SV	DECIMAL,NEWLIN,2
	CSI$ND
OVL00:	CLR	NEWLIN		;CLEAR OPTIONAL NUMBER
	JSR	PC,FNAME	;GET FILENAME STRING DESCRIPTORS
	BNE	1$		;IF OK, BRANCH
	CSIERR
1$:	MOV	#OVLSWT,R2	;SPECIFY SWITCH TABLE
	JSR	PC,CSINT0	;INTERPRET FILE NAME STRING
	TST	NEWLIN		;LINE SPEC'D?
	BLE	3$		;IF NOT, BRANCH
	MOV	NEWLIN,LINENO	;IF SO, PUT IT AWAY
	DEC	LINENO		;AND BACK IT UP ONE
	BR	3$
3$:	JMP	OLD02		;GO FINISH FILE READ

	.SBTTL	TSTU00 - CHECK FOR USER STORAGE OVERFLOW
;
; TSTOK - TSTU00, CHECK FOR POSSIBLE USER STORAGE OVERFLOW
;  R0 HAS NUMBER OF BYTES TO ENTER.  REGISTERS USED - R0,R3,R4,R5.
;
TSTU00:	MOV	ENUDAT,R5
	MOV	R5,R4		;GET END OF USER STORAGE
	ADD	R0,R4		;COMPUTE EXTENSION
	MOV	STUFDB,R3	;GET END OF BUFFER
	SUB	#70,R3		;SUBTRACT EXPANSION FUDGE
	CMP	R3,R4		;IF SP-FUDGE .GE. R5+R0 ALL IS OK
	RTS	PC
	.SBTTL	SCRA00 - DELETE A FILE
;+2
; .SKIP
; .X ^^SCRATCH\\
; .X ^PROGRAM DELETE
; .INDENT -5
; ^^
; SCRATCH _<STRING FILESPEC>
; \\
; .BREAK
; ^THE ^^SCRATCH\\ COMMAND MUST HAVE A FILE SPECIFIER WITH AN
; EXPLICIT VERSION NUMBER IN ORDER TO DELETE A FILE.
; ^THE DEFAULT FILE SPECIFIER IS: ^^SY:PROGRAM.BAS\\
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	SCRATCH "DATA.DAT;3"
;	50 SCRATCH "DK1:DAT3.TMP"
; \\
; .FILL
;-
SCRA00:	SKIP			;GET NEXT CHAR
	DEC	R1		;RESET TEXT POINTER
	CMP	R2,#S.EOL	;A LINE FEED?
	BNE	SCRA01
	CSIERR			;MUST HAVE TEXT STRING
SCRA01:	JSR	PC,FNAME	;CHECK FOR STRING EXPRESSION
	MOV	R0,-(SP)	;SAVE R0 FROM EVIL
	JSR	PC,CSINT0	;GET FILE SPECS
	DELET$	#COMFDB,SCRFER	;DELETE FILE SPECIFIED IN FDB
	MOV	(SP)+,R0	;RESTORE R0 BACK INTO EVIL
	TST	R0		;WAS A STRING EXPRESSION USED
	BEQ	SCRA02		;SKIP IF NOT
	MOV	R0,R1		;ELSE RESET TEXT POINTER
SCRA02:	JMP	INIT02		;GO TO COMMAND INTERP
	.SBTTL	FNAME - CHECK STRING EXPRESSION FOR FILE SPEC
;
; FNAME - CHECK FOR STRING EXPRESSION IN FILE SPEC
; ON ENTRY R1 CONTAINS TEXT POINTER
; ON EXIT FOLLOWING REGISTER ASSIGNMENTS:
;	R0: ZERO IF NO STRING TO INTERPRET, OTHERWISE = OLD R1
;	R1: TEXT POINTER
;	R2: ZERO TO INDICATE NO SWITCH TABLE FOR CSI
;	R3: ADDRESS OF STRING IN STRING WORK AREA (FROM EVALS)
;	R4: LENGTH OF STRING IN STRING WORK AREA (FROM EVALS)
;
FNAME:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	EVALS			;TRY FOR STRING EXPRESSION
	BVC	FNAM02		;BR IF OK STRING
FNAM03:	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	CLR	R0		;SET NO STRING FLAG
	RTS	PC		;AND RETURN
FNAM02:	TST	R4		;IS IT A NULL STRING
	BEQ	FNAM03		;IGNORE IF SO
	TST	(SP)+		;DELETE TEXT POINTER
	CLR	R2		;SET NO SWITCH TABLE
	CLR	REMTRM		;RESET ALL OF THE SWITCHES
	MOV	R1,R0		;INDICATE STRING EXISTS
	RTS	PC		;AND RETURN

	.SBTTL	OPEN COMMAND PROCESSOR
;+3
; .SKIP
; .X ^^OPEN\\
; .X ^FILE OPEN
; .X ^RANDOM ACCESS ^I/^O
; .INDENT -5
; ^^
; OPEN
; .NOFILL
; NEW OPEN COMMAND PROCESSOR.
; FORM:
;	OPEN _#EXP,STRING (WHERE STRING CONTAINS FILESPEC/SWITCHES)
; ALLOWED SWITCHES:
;	/FX	FOR FIXED LENGTH RECORDS (VARIABLE ASSUMED)
;	/RN	FOR RANDOM ACCESS (SEQUENTIAL ASSUMED)
;	/LN:LEN TO SPECIFY BUFFER LENGTH IN BYTES (80 ASSUMED)
;	/EN:LNO	TO SPECIFY LINE NO. FOR CNTRL XFER ON EOF
;	/BN	TO SPECIFY BINARY FILE (ASCII ASSUMED)
; THE FOLLOWING SWITCHES SPECIFY FILE ACCESS
; THEY ARE MUTUALLY EXCLUSIVE EXCEPT FOR /SH (SHARED ACCESS)
;	/RO	FOR READ ONLY ACCESS (DEFAULT)
;	/WR	FOR WRITE ACCESS (CREATING NEW FILE)
;	/UP	FOR UPDATE (READ,WRITE,APPEND)
;	/MO	FOR MODIFICATION (READ,WRITE)
;	/AP	FOR APPEND ONLY
;	/SH	TO SET SHARED ACCESS BIT IN FDB
; \\
; .SL
; ^EXAMPLES:
; ^^
; 	50 OPEN _#4, "LS:/WR"
;	60 OPEN _#3,N$
; .FILL
; \\
;-
; READ/WRITE BUFFER VARIABLES
;
;
; READ ONLY SWITCH AND SWITCH VALUE TABLES
;
	.PSECT	BASIC3
OPENSW:	CSI$SW	FX,R.FIX,OP.RTP
	CSI$SW	RN,FD.RAN,OP.RAC
	CSI$SW	LN,,,,,LENVAL
	CSI$SW	EN,,,,,EOFVAL
	CSI$SW	BN,1400,OP.RTP,CLEAR
	CSI$SW	RO,<400*FO.RD>,OP.LUN
	CSI$SW	WR,<400*FO.WRT>,OP.LUN
	CSI$SW	UP,<400*FO.UPD>,OP.LUN
	CSI$SW	MO,<400*FO.MFY>,OP.LUN
	CSI$SW	AP,<400*FO.APD>,OP.LUN
	CSI$SW	SH,<400*FA.SHR>,OP.LUN
	CSI$ND
LENVAL:	CSI$SV	DECIMAL,OP.LEN,2
	CSI$ND
EOFVAL:	CSI$SV	DECIMAL,OP.EOF,2
	CSI$ND
;
;SET DEFAULTS FOR FILE OPEN
;
OPEN00:	MOV	#S.FDB,R0	;SIZE OF FDB IN R0
	ASR	R0		;NOW IN WORDS
1$:	CLR	-(SP)		;CLEAR SPACE ON STACK
	SOB	R0,1$		;FOR FDB
	MOV	SP,FDBSAV
	MOV	SP,R0
	FDAT$R	R0,#R.VAR,#FD.CR,#80.,#-5 ;ESTABLISH DEFAULTS
	MOV	#80.,OP.LEN
	MOV	#OP.LUN,R4
	CLR	(R4)+
	CLR	(R4)+
	CLR	(R4)+
	MOV	#<FD.CR*400+R.VAR>,(R4)+	;SET DEFAULT TYPE  & CARR CNTL
	FDOP$R	R0,OP.LUN,#CSDSPT,#USDFNB,FO.RD
; END OF FDB INIT CODE
	SKIP
	CMPB	#'#,R2		;FILE NUMBER TO FOLLOW??
	BNE	OPEN01		;ERROR IF NOT
	EVAL			;GET FILE NUMBER
	BVS	OPEN01		;PAREN IS ERROR
	STCFI	AC0,R4		;MAKE FILE NUMBER INTEGER
	MOVB	R4,OP.LUN	;FILE # = LUN
	MOV	FDBSAV,R0	;R0 POINTS TO START OF STACK FDB
	CMP	R4,#2		;#1 & 2 RESERVED
	BLE	OPEN01
	CMP	R4,#OP.MXL	;SEE IF GREATER THAN MAX ALLOWED
	BGT	OPEN01
	CLR	R0
	JSR	PC,FILFN1	;FINISH GETTING FILE
	BNE	OPEN01		;ERROR IF RE-OPEN ATTEMPTED
	SKIP
	CMPB	#',,R2		;SEPARATOR??
	BNE	OPEN01		;ERR IF NOT
	EVALS			;GET FILE SPEC.
	BVC	OPEN07		;BR IF OK
OPEN01:	OPNERR
OPEN07:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	#OPENSW,R2	;SWITCH TABLE ADDRESS IN R2
	JSR	PC,CSINT0	;DECODE STRING
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	MOV	FDBSAV,R3	;R3 POINTS TO START OF STACK FDB
	MOV	OP.LUN,F.LUN(R3) ;PUT IN LUN AND FILE ACCESS BITS
	MOV	OP.RTP,F.RTYP(R3)
	MOV	OP.RAC,F.RACC(R3)
	BITB	#FD.RAN,F.RACC(R3) ;IS RANDOM BIT SET?
	BEQ	2$		;IF NOT SKIP NEXT INSTRUCTION
	BISB	#R.FIX,F.RTYP(R3) ;IF SO FORCE FIXED RECORDS
2$:	BITB	#R.FIX,F.RTYP(R3) ;SEE IF FIXED RECORD SPECIFIED
	BEQ	1$		;DON'T DO ANYTHING IF NOT
	BIC	#R.VAR,F.RTYP(R3) ;IF SO CLEAR VARIABLE BIT
; CHECK EOF LINE NUMBER
1$:	TST	OP.EOF		;MUST BE + INTEGER
	BLT	OPEN01		;IF NOT, ERROR
; CHECK BUFFER LENGTH AND CONTROL BLOCK FOR ROOM
	INC	OP.LEN		;ROUND UP TO EVEN
	ASR	OP.LEN		;WORD BUFFER
	ASL	OP.LEN		;LENGTH
	MOV	OP.LEN,R0	;PUT IT IN R0
	MOV	R0,F.RSIZ(R3)	;AND IN FDB
	ADD	#S.FDB+30,R0	;ADD IN CONTROL BLOCK LEN AND WORD FUDGE
	TSTOK			;ENOUGH ROOM?
	BHIS	OPEN11		;PROCEED IF OK
	OVFERR			;REPORT STORAGE OVERFLOW
OPEN11:
	MOV	STGOSB,R2	;START OF BLOCK TO MOVE
	MOV	STUFDB,R3	;END OF BLOCK TO MOVE
	JSR	PC,SLDN		;SLIDE IT ALL DOWN R0 BYTES
	SUB	R0,STGOSB	;AND ADJUST PTRS
	SUB	R0,STFONX
	SUB	R0,STUFDB
	MOV	STUFDB,R5	;GET START OF CURRENT BLOCK -> R5
	MOV	R5,-(SP)	;SAVE R5
	ASR	R0		;WORD COUNT IN R0
2$:	CLR	(R5)+		;CLEAR THE DATA AREA
	SOB	R0,2$		;AND BRANCH TILL DONE
	MOV	(SP)+,R5	;RESTORE OLD R5
	MOV	R5,R4		;SAVE A COPY OF FDB START
;R0 ASSUMED CLEAR FROM SOB LOOP
	MOV	FDBSAV,R3	;R3 POINTS TO START OF STACK FDB
	BITB	#FA.WRT,F.FACC(R3) ;WAS WRITE SPECIFIED
	BEQ	OPEN03		;IF NOT GO SET READ
	BIS	#1000,R0	;SET WRITE IN CONTROL WORD
	BITB	#FD.RAN,F.RACC(R3) ;IF RANDOM BIT IS SET
	BNE	OPEN03		;SET READ BIT TOO
	BITB	#FA.CRE!FA.APD,F.FACC(R3) ;SHOULD FILE BE WRITE ONLY?
	BNE	OPEN02		;IF SO, SKIP READ SET
OPEN03:	BIS	#400,R0		;SET READ BIT
OPEN02:	BITB	#FD.RAN,F.RACC(R3) ;RANDOM SPECIFIED?
	BEQ	OPEN05		;IF NOT, SKIP BIT SET
	BIS	#2000,R0	;SET RANDOM BIT
OPEN05:	BITB	#FD.CR,F.RATT(R3) ;ASCII SET?
	BNE	OPEN06		;BRANCH IF SO
	BIS	#4000,R0	;SET BINARY BIT
OPEN06:	BISB	F.LUN(R3),R0	;SET FILE NUMBER IN CONTROL WORD
	DEC	R0		;STORE FILE NUMBER AS ONE LESS
	MOV	R0,(R5)+	;OUTPUT IT
	MOV	R5,@R5		;BUILD CHAR POINTER
	ADD	#S.FDB+24,(R5)+	;BUFFER AFTER FDB
	MOV	OP.LEN,(R5)+	;GET MAX BYTE COUNT (REC LEN)
	CLR	(R5)+		;THIS LOCATION UNUSED AT PRESENT
OPEN14:	CLR	(R5)+		;ACTUAL BC
	MOV	-10(R5),(R5)+	;SET DATA ADDRESS
	CMP	(R5)+,(R5)+	;SKIP TWO PLACES (LB ERR, FDB PTR)
	MOV	OP.EOF,(R5)+	;END OF FILE ROUTINE
	CLR	(R5)+		;ZERO RECORD NUMBER
	CLR	(R5)+		;RAN VAR ADD (NOT IMPLEMENTED)
	MOV	R5,R0		;START OF FDB NOW IN R0
	MOV	#S.FDB,R2	;# BYTES TO XFER IN R2
	ASR	R2		;# WORDS TO XFER IN R2
3$:	MOV	(R3)+,(R5)+	;HEAD 'EM UP
	SOB	R2,3$		;AND MOV 'EM OUT
	ADD	#S.FDB,SP	;GET RID OF STACK FDB
	MOV	-16(R0),F.URBD+2(R0) ;ADD OF REC BUFFER IN FDB
	MOV	-24(R0),F.URBD(R0) ;LIKEWISE ITS LENGTH
	JSR	PC,.OPEN	;NOW OPEN FILE
	MOVB	F.ERR(R0),R0	;ERROR CODE WITH SIGN EXTEND IN R0
	MOV	R0,PARLST+P.FCS	;PUT IN MO PARAMETER LIST
	BCC	OPEN08		;IF OPEN OK GO ADD BUFFER LEN
	MOV	R4,R3		;GET SET TO DELETE UNUSED FDB
	MOV	4(R4),R0	;CALCULATE SIZE
	ADD	#S.FDB+30,R0	;-> R0
	MOV	STGOSB,R2	;SET START OF BLOCK TO MOVE
	JSR	PC,SLUP
	ADD	R0,STUFDB	;ADJUST ALL PTRS
	ADD	R0,STGOSB
	ADD	R0,STFONX
	OPENER			;REPORT FCS ERROR
OPEN08:	MOV	R4,STUFDB	;SAVE NEW FDB START
	JMP	INIT02		;GO TO NEXT STATEMENT

	.SBTTL	CLOS00 - USER FILE CLOSE ROUTINE
;+3
; .SKIP
; .X ^^CLOSE\\
; .X ^FILE CLOSE
; .INDENT -5
; ^^
; CLOSE N1[,N2...]
; \\
; .BREAK
; ^THIS COMMAND CLOSES A USER DATA FILE WHOSE NUMBER IS ^N1, ^N2 ETC.
; ^NOTE THAT NO _# SIGN PRECEDES THE NUMBER.
; ^IF USED WITH NO FILE NUMBER, ALL USER FILES ARE CLOSED.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	60 CLOSE 4
;	70 CLOSE I1
;	95 CLOSE
; \\
; .FILL
;-
CLSE00:	SKIP
	CMP	#S.CON,R2	;ALL WANTED??
	BEQ	CLSE02		;BR IF YES
	CMP	#S.EOL,R2	;ALL WANTED
	BEQ	CLSE02		;NO ARGS MEANS ALL FILES
	DEC	R1		;REDO LAST CHAR
CLSE01:	EVAL			;GET A FILE NUMBER
	BVS	CLSE04		;PAREN IS ERROR
	STCFI	AC0,R4		;GET FILE NUM
	DEC	R4		;ADJUST
	CMP	#255.,R4	;VALID??
	BLO	CLSE04		;NOPE
	MOV	#17400,R0	;SET MASK
	JSR	PC,CLSEIT	;GOTO CLOSE ROUTINE
	SKIP
	CMP	#',,R2		;MORE FILES??
	BEQ	CLSE01		;GO DO IF SO
	BR	CLSE06		;EXIT
;
; ACTUAL CLOSE ROUTINE
;
CLSEIT:	JSR	PC,SRCHFL	;SEARCH FOR FILE WHOSE NUMBER IS IN R4
	BEQ	CLSE03		;BR NOT THERE (IGNORE REQUEST)
CLSEFL:	BIT	#1000,@R3	;THIS OUTPUT
	BEQ	CLSE05		;SKIP BUFF CHECK IF NOT
	BIT	#2000,@R3	;OR IF CONTIG
	BNE	CLSE05		;SKIP CHECK
	TST	10(R3)		;ANYTHING LEFT IN BUFFER??
	BEQ	CLSE05		;OK IF NOT
	MOV	R3,R0		;SET REG
	TST	(R0)+		;ADJUST
	JSR	PC,PRNT01	;ELSE FORCE IT OUT
CLSE05:	MOV	R3,R0		;GET FDB ADDRESS
	ADD	#26,R0		;IN R0
	CLOSE$			;AND CLOSE
	MOVB	F.ERR(R0),R0	;ERROR CODE WITH SIGN EXTEND IN R0
	MOV	R0,PARLST+P.FCS	;STORE IN MO PARAMETER LIST
	BCC	1$		;IF NO ERROR, DON'T REPORT
	CLOSER			;REPORT FCS ERROR
1$:	MOV	4(R3),R0	;CALCULATE SIZE OF
	ADD	#S.FDB+30,R0	;BLOCK -> R0
	MOV	STGOSB,R2	;START OF DATA TO BE MOVED -> R2
	JSR	PC,SLUP		;SLIDE IT UP
	ADD	R0,STUFDB	;ADJUST PTRS
	ADD	R0,STGOSB
	ADD	R0,STFONX
CLSE03:	RTS	PC		;AND RETURN
;
; CLOSE ALL FILES ROUTINE
;
CLSE02:	JSR	PC,CLSEAL	;CALL CLOSER
CLSE06:	DEC	R1		;ADJUST TEXT POINTER
	JMP	INIT02		;NEXT STATEMENT
CLSEAL:	CLR	R4		;SEARCH FOR A FILE
	MOV	#17777,R0	;MASK
	JSR	PC,CLSEIT	;DO A CLOSE
	BNE	CLSEAL		;IF OK TRY FOR ANOTHER
	RTS	PC		;ELSE RETURN
CLSE04:	CLSERR		;ERROR
;
; ROUTINE SRCHFL - TO SEARCH FOR FILE WHOSE HEADER
; MATCHES R4 AND MASK TO IGNORE IN R0
; PTR TO FCB -> R3 IF FOUND, 0 OTHERWISE
;
SRCHFL:	MOV	STUFDB,R3	;START OF FDB AREA -> R3
1$:	CMP	R3,ENDUSR	;AT END OF BASIC TASK AREA?
	BHIS	2$		;IF SO, GO REPORT FAILURE
	MOV	(R3),R2		;HEADER -> R2
	BIC	R0,R2		;CLEAR OUT MASK
	CMP	R2,R4		;MATCH?
	BEQ	3$		;IF SO, GO RETURN SUCCESSFULLY
	ADD	4(R3),R3	;OFFSET TO NEXT FDB
	ADD	#S.FDB+30,R3	;
	BR	1$
2$:	CLR	R3		;INDICATE FAILURE
3$:	TST	R3		;TEST FOR SUCCESS OR FAILURE
	RTS	PC		;AND RETURN

	.SBTTL	FNMB00 - FILE NUMBER PROCESSOR
;
; FNMBR/FNMB00 - PROCESS FILE NUMBER, SETUP FILE BLOCK POINTERS
;
FNMB00:	SKIP
	CMP	#'#,R2		;FILE NUMBER THERE??
	BEQ	FNMB01		;BR IF YES
	DEC	R1		;BACKUP POINTER
	RTS	PC		;AND RETURN
FILFND:	MOV	R0,-(SP)	;SAVE IO TYPE
	EVAL			;GET NUMBER
	BVS	FNMB04		;PAREN IS ERROR
	MOV	(SP)+,R0	;RESTORE IO TYPE
	STCFI	AC0,R4		;GET NUMBER
FILFN1:	DEC	R4		;IN RANGE 0-255
	CMP	#255.,R4	;VALID??
	BLO	FNMB04		;NOPE
	BIS	R0,R4		;SET SEARCH MASK
	MOV	#17400,-(SP)	;CALCULATE MASK TO IGNORE
	BIC	R0,(SP)
	MOV	(SP)+,R0	;AND PUT IT IN R0
	JSR	PC,SRCHFL
	RTS	PC
FNMB01:	JSR	PC,FILFND
	BEQ	FNMB04		;ERROR BR
	BIT	#400,(R3)+	;INPUT??
	BEQ	FNMB02		;NOPE
	MOV	R3,INPT		;SET INPUT POINTER
FNMB02:	BIT	#1000,-2(R3)	;OUTPUT??
	BEQ	FNMB05		;NOPE
	MOV	R3,OTPT		;SET OUTPUT POINTER
FNMB05:	MOV	R3,14(R3)	;SET UP PROPER FDB POINTER
	ADD	#24,14(R3)	;IN I/O CONTROL BLOCK (WHICH MAY HAVE MOVED)
	MOV	R3,10(R3)	;UPDATE DATA BUFFER ADDRESS PTR
	ADD	#24+S.FDB,10(R3)
	MOV	10(R3),(R3)	;AND NEXT BYTE AVAIL PTR
	ADD	6(R3),(R3)
	SKIP			;BUMP R1 PAST COMMA
	CMPB	R2,#',		;MAKE SURE IT IS COMMA
	BEQ	FNMB06		;AND CHECK THAT ACCESS IS SEQ.
	CMPB	R2,#''		;IS CHAR A SINGLE QUOTE
	BEQ	FNMB07		;IF SO, PROCESS
	DEC	R1		;OTHERWISE BACK UP TEXT POINTER
	BR	FNMB06		;AND MAKE SURE SEQUENTIAL
FNMB03:	RTS	PC		;AND RETURN
FNMB04:	FNMERR			;FILE NUMBER ERROR
FNMB06:	BIT	#2000,-2(R3)	;IS RANDOM BIT SET
	BNE	FNMB08		;IF SO, AN ERROR
	BR	FNMB03		;RETURN
FNMB07:	BIT	#2000,-2(R3)	;CHECK RANDOM BIT
	BEQ	FNMB08		;IF NOT SET, ACCESSM MODE ERROR
	MOV	R3,-(SP)	;SAVE FCB POINTER
	EVAL			;EVALUATE THE RECORD NUMBER
	BVS	FNMB04		;IF ERROR, DO ERROR EXIT
	MOV	(SP)+,R3	;RESTORE FILE CONTROL BLOCK POINTER
	MOV	14(R3),R3	;FDB ADDRESS IN R3
	SETL
	STCFL	AC0,F.RCNM(R3)	;STORE LONG RECORD NUMBER IN FDB
	SETI
	BLE	FNMB04		;NEG OR ZERO RECORD NUMBER IS ERROR
	SKIP			;GET NEXT NON-BLANK CHAR
	CMPB	R2,#',		;CHECK FOR COMMA
	BNE	FNMB04		;IF NOT REPORT ERROR
	BR	FNMB03		;RETURN SUCCESSFULLY
FNMB08:	FACERR			;FILE ACCESS MODE ERROR (RAN/SEQ)

	.SBTTL	SUBS00 - SUBSCRIPT COMPUTATION ROUTINE
;
; SUBSCR - SUBS00, COMPUTE A SUBSCRIPT EXPRESSION - UPON ENTRY, R1
;	POINTS TO THE ASCII CHARACTER STRING STARTING WITH THE
;	LEFT PAREN, R3 POINTS TO THE ADDRESS OF TWO STANDARD FORMAT
;	SUBSCRIPTS.  UPON EXIT, R0 POINTS TO THE DESIRED LOCATION
;	R3 IS UNCHANGED, AND R1 POINTS TO A NON-BLANK CHARACTER
;	FOLLOWING THE CLOSED PAREN.
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
SUBS00:	MOV	R3,-(SP)
	EVAL			;EVALUATE THE FIRST SUBSCRIPT
	BVS	SUBS01		;SKIP IF PAREN FOUND
	CMPB	@R1,#',		;OTHERWISE MAKE SURE
	BNE	SUBS98		;COMMA IS THERE
	JSR	PC,SUBS03
	SKIP			;YES
	MOV	R0,-(SP)	;SAVE VERIFIED SUBSCRIPT
	EVAL			;GET THE SECOND SUBSCRIPT
	BVC	SUBS98		;JUMP IF NO CLOSED PAREN
	STCFI	AC0,R0		;AND FIX IT
	BMI	SUBS99
	MOV	(SP)+,R3	;GET THE
SUBS02:	MOV	@(SP),R4	;SECOND
	BIC	#177400,R4	;SUBSCRIPT LIMIT
	CMP	R0,R4		;OUT OF RANGE?
	BGT	SUBS99		;YES
	INC	R4
	MUL	R4,R3		;GET X*(Y.MAX+1)
	ADD	R3,R0		;COMPUTE ACTUAL POSITION OF VARIABLE
	MOV	#4,R3		;LENGTH OF NUMBER
	MOV	@SP,R2		;GET DIM INFO POINTER
	BIT	#10000,-(R2)	;IS THIS A STRING
	BEQ	SUBS04		;BR IF NOT
	MOVB	4(R2),R3	;GET STRING ELEMENT MAX LENGTH
	BIC	#177400,R3	;CLEAN IT UP
	INC	R3		;ACCOUNT FOR LENGTH BYTE
	ADD	#3,R2		;ADJUST
SUBS04:	MUL	R0,R3		;LINEAR SUBSCRIPT*ELEMENT LEN
	ADD	#4,R2		;CALC BASE ADDRESS
	ADD	R2,R3		;GET ELEMENT ADDRESS
	MOV	R3,R0		;IN CORRECT REGISTER
	MOV	(SP)+,R3	;RESTORE R3
	RTS	PC
SUBS01:	JSR	PC,SUBS03
	MOV	R0,R3		;SAVE FIRST SUBSCRIPT
	CLR	R0		;SET SECOND SUBSCRIPT TO ZERO
	BR	SUBS02		;GO BACK TO MAIN LINE
SUBS98:	SBSERR			;BADLY FORMED SUBSCRIPT
SUBS99:	SUBERR			;SUBSCRIPT OUT OF RANGE
SUBS03:	STCFI	AC0,R0		;FIX IT
	BMI	SUBS99
	MOV	@2(SP),R4	;GET BOTH SUBSCRIPT LIMITS
	SWAB	R4		;I WANT THE FIRST ONE ONLY
	BIC	#177400,R4	; ONLY
	CMP	R0,R4		; OUT OF RANGE?
	BGT	SUBS99		;YES
	RTS	PC
;

	.SBTTL	PRLN00 - PRINT LINE NUMBER
;
; PRNTLN - PRLN00 - PRINT LINE NUMBER
;	REGISTERS USED - R0,R1,R2.
;
PRLN00:	MOV	LINENO,R1	;CURRENT LINE NUMBER -> R1
PRLN01:	SUB	#10,SP		;DESTINATION
	MOV	SP,R0		;  IS ON THE STACK
	ITOA			;CONVERT TO ASCII
	MOV	SP,R0		;PRINT THE RESULTING
	PRINTL			;PRINT NUMBER
	ADD	#10,SP		;RESTORE THE STACK
	RTS	PC

	.SBTTL	GET00 - GET LINE LIMITS FOR COMMAND (LIST OR DELETE)
;
; GET00 - GET LINE LIMITS FOR COMMAND (LIST OR DELETE)
; ON ENTRY:
;	R1 POINTS TO START OF PARAMETERS
; ON EXIT:
;	R1 POINTS PAST END OF THIS SET OF PARAMS
;	R3 HAS ADDRESS OF LOWEST LINE # HEADER IN RANGE
;	R4 HAS ADDRESS OF HIGHEST INCLUDED LINE # HEADER
;	'Z' SET IF NO LINES INCLUDED IN RANGE
; OTHER REGISTERS USED: R0,R2,R5 (ALL)
;
GET00:	SKIP			;GET 1ST CHAR
	CMPB	R2,#'*		;ASKING FOR LAST LINE?
	BNE	1$		;IF NOT, BRANCH
	MOV	BOLNHD,R3	;POINT TO LAST LINE
	BR	8$
1$:	DEC	R1		;BACK UP ONE CHAR
	ATOI			;GET NUMBER -> R0
	MOV	R1,-(SP)	;SAVE TEXT PTR
	FINDLN			;FIND THE LINE
	BEQ	2$		;IF EXACT MATCH, BRANCH
	SUB	#4,R5		;ELSE POINT TO 1ST INCLUDED HEADER
2$:	MOV	R5,R3		;COPY POINTER -> R3
	MOV	(SP)+,R1	;RESTORE TEXT PTR
8$:	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#'-		;DO WE WANT RANGE?
	BEQ	4$		;IF SO, BRANCH
	DEC	R1		;BACK UP TEXT PTR
	TST	R0		;CHECK FOR LINE # 0
	BNE	3$		;IF NOT, BRANCH
	MOV	BOLNHD,R4	;IF SO, IT WAS A PLAIN LIST, SO INCLUDE ALL
	BR	6$		;GO TO FINAL CHECK
3$:	CMP	R0,(R3)		;EXACT MATCH?
	BNE	7$		;IF NOT, BRANCH TO NO TEXT FINISH
	MOV	R3,R4		;COPY START -> END
	BR	6$		;GO TO FINAL CHECK
4$:	SKIP
	CMPB	R2,#'*		;LAST LINE ASKED?
	BNE	5$		;IF NOT, BRANCH
	MOV	BOLNHD,R4	;PUT LAST LINE HEADER -> R4
	BR	6$		;GO TO FINAL CHECK
5$:	DEC	R1		;BACK UP ONE CHAR
	ATOI			;GET SECOND LINE # -> R0
	MOV	R1,-(SP)	;SAVE OUR TEXT PTR
	FINDLN			;FIND THE HEADER -> R5
	MOV	R5,R4		;COPY -> R4 (NO MATTER IF EXACT MATCH)
	MOV	(SP)+,R1	;RESTORE TEXT PTR
6$:	CMP	R3,R4		;SEE IF ACTUAL RANGE EXISTS
	BLO	7$		;IF NOT, BRANCH
	CLZ			;MAKE SURE NO 'Z' (SUCCESS)
	RTS	PC		;AND RETURN
7$:	SEZ			;SET NO TEXT (FAILURE)
	RTS	PC

	.SBTTL	LIST00 - LIST THE SOURCE TEXT
;+2
; .SKIP
; .X ^^LIST\\
; .X ^PROGRAM LIST
; .INDENT -5
; ^^
; LIST [N1][-N2][,N3...]
; \\
; .BREAK
; ^THIS IS PRIMARILY AN IMMEDIATE MODE COMMAND.
; ^WITH NO ARGUMENTS, THE WHOLE PROGRAM IS LISTED AT THE USER'S
; TERMINAL.
; ^SINGLE ARGUMENTS SEPARATED BY COMMAS WILL LIST ONLY THE
; LINE NUMBERS REQUESTED.
; ^TWO ARGUMENTS SEPARATED BY A DASH (MINUS) WILL LIST AN INCLUSIVE
; LINE NUMBER RANGE.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	LIST
;	LIST 20
;	LIST 50,100
;	LIST 50-80,135,710-750
; \\
; .FILL
;-
;	REGISTERS USED - R1,R2,R3,R4,R5
;
LIST00:
	JSR	PC,ATTACH	;ATTACH TERMINAL (FOR ^O)
1$:	JSR	PC,GET00	;GET LINE HEADER RANGE
	BEQ	31$		;IF NONE, BRANCH
	MOV	R1,-(SP)	;SAVE TEXT PTR
	MOV	R4,-(SP)	;SAVE FINAL HEADER ADDRESS
	MOV	R3,R5		;INITIAL HEADER ADD -> R5
2$:	CMP	R5,(SP)		;PAST END OF RANGE YET?
	BLO	3$		;IF SO, BRANCH
	JSR	PC,4$		;GO DO THIS LINE
	SUB	#4,R5		;POINT TO NEXT HEADER
	BR	2$		;AND GO AROUND AGAIN
3$:	TST	(SP)+		;POP FINAL HEADER ADDRESS
	MOV	(SP)+,R1	;RESTORE TEXT PTR
31$:	SKIP			;NEXT CHAR OF PARAMS
	CMPB	R2,#',		;COMMA SEPARATING SETS OF NUMBERS?
	BEQ	1$		;IF SO, DO IT AGAIN
	DEC	R1		;ELSE BACK UP TEXT PTR
	CLOSEF			;CLOSE FILE IF OPEN
	JSR	PC,DETACH	;DETACH TERMINAL (NULLIFY ^O)
	JMP	INIT02		;AND GO GET NEXT STATEMENT
;
; SUBROUTINE TO PRINT OUT LINE WHOSE HEADER
; IS POINTED TO BY R5
;
4$:	MOV	(R5),R1		;GET LINE NUMBER -> R1
	JSR	PC,PRLN01	;PRINT IT
	MOV	2(R5),R1	;SET UP TEXT PTR
	ADD	USR,R1		;ADD IN BASE ADDRESS
5$:	MOVB	(R1)+,R2	;NEXT CHAR -> R2
	CMPB	R2,#S.EOL	;END OF LINE?
	BEQ	15$		;IF SO, BRANCH
	BIT	#2,REMTRM	;COMPILED PROG.?
	BNE	14$		;IF SO, CAN SKIP SOME CODE
	BIC	#177400,R2	;CLEAR SIGN EXTEND
	CMPB	R2,#140		;A TOKEN?
	BLO	14$		;IF NOT, BRANCH
	CLR	-(SP)		;SET NO FLAG FOR SURROUNDING BLANKS
	CMPB	R2,#S.VBEN	;ARE WE IN VERBS PROPER?
	BLOS	6$		;IF SO, BRANCH TO SET FLAG
	CMPB	R2,#S.THEN	;MIGHT BE IN OTHER TOKENS WITH BLANKS
	BLO	7$		;IF NOT, BRANCH (DON'T SET FLAG)
6$:	INC	(SP)		;SET SURROUNDING BLANKS FLAG
7$:	MOV	#INIT11,R0	;START OF PROTOTYPES -> R0
	SUB	#140,R2		;MAKE R2 INTO LOOP COUNTER
	BEQ	9$		;IF ZERO, SKIP LOOP TO FIND PROTOTYPE TEXT
8$:	TSTB	(R0)+		;SKIP THROUGH A PROTOTYPE
	BNE	8$		;
	SOB	R2,8$		;R2 TIMES
9$:	TST	(SP)		;SURROUNDING BLANKS?
	BEQ	10$		;IF NOT, BRANCH
	MOVB	#40,R2		;IF SO, PRINT LEADING
	BR	11$		;BLANK
10$:	MOVB	(R0)+,R2	;GET NEXT PROTOTYPE CHAR
	BEQ	12$		;IF AT END, BRANCH
11$:	PRINTC			;PRINT THE CHARACTER
	BR	10$		;AND LOOK FOR ANOTHER
12$:	TST	(SP)+		;POP SURROUNDING BLANK FLAG
	BEQ	13$		;IF NONE, DON'T PRINT CHAR
	MOVB	#40,R2		;IF ONE, PRINT IT
14$:	PRINTC
13$:	BR	5$		;AND GO BACK FOR MORE PROGRAM TEXT
15$:	CRLF			;DO END OF LINE
	RTS	PC		;AND RETURN

	.SBTTL	DEL00 - DELETE TEXT IN USER PROGRAM
;+2
; .SKIP
; .X ^^DELETE\\
; .X ^PROGRAM LINE DELETE
; .INDENT -5
; ^^
; DELETE N1[-N2][,N3...]
; \\
; .BREAK
; ^THIS ALSO IS PRIMARILY AN IMMEDIATE MODE COMMAND.
; ^IT WILL DELETE INDIVIDUAL LINES WITH SINGLE PARAMETERS OR INCLUSIVE
; RANGES WITH NUMBERS SEPARATED BY A DASH (MINUS).
; ^IF NO NUMBERS ARE SPECIFIED, THE WHOLE PROGRAM TEXT IS DELETED (BUT NOT
; PROGRAM DATA - THIS MUST BE DONE WITH THE ^^CLEAR\\ COMMAND).
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
;	DELETE 30
;	DELETE 50-70
;	DELETE 10-40,60-80
; \\
; .FILL
;-
;	REGISTERS USED - R0,R1,R2,R3,R4,R5.
;
DEL00:
1$:	GETNUM			;GET PARAMS FOR DELETE
	BEQ	6$		;IF NOTHING TO DELETE, BRANCH
	CMP	R4,BOLNHD	;DELETE THROUGH LAST LINE?
	BHI	2$		;IF NOT, MORE COMPLICATED PROCEDURE
	MOV	2(R3),R2	;CALCULATE NEW END OF TEXT
	ADD	USR,R2		;ADD IN OFFSET
	MOV	R2,ENDTXT	;AND STORE IT AWAY
	ADD	#4,R3		;POINT TO PRECEDING HEADER
	MOV	R3,BOLNHD	;AND MAKE IT THE LAST ONE
	BR	6$		;AND GO LOOK FOR MORE
2$:	MOV	ENDTXT,R0	;END OF TEXT -> R0
	MOV	R1,-(SP)	;SAVE A REGISTER
	MOV	2(R3),R1	;MAKE R1 POINT TO
	ADD	USR,R1		;START OF DEST FOR BLOCK MOVE
	MOV	-2(R4),R2	;CALCULATE # OF BYTES TO
	ADD	USR,R2		;MOVE IN R0 AND
	SUB	R2,R0		;START OF BLOCK ADD -> R2
	BEQ	4$		;IF ZERO, BRANCH
3$:	MOVB	(R2)+,(R1)+	;DO THE MOVE
	SOB	R0,3$
4$:	SUB	R1,R2		;R2 HAS DISTANCE WE MOVED
	MOV	R1,ENDTXT	;RECORD NEW END OF TEXT
	MOV	(SP)+,R1	;RESTORE R1
	MOV	R2,-(SP)	;SAVE DISTANCE OF TEXT MOVE
	MOV	R3,-(SP)	;SAVE R3 (TOP OF HEADER) AREA TO BE DELETED
	MOV	BOLNHD,R2	;BOTTOM OF BLOCK OF HEADERS TO BE MOVED
	MOV	R3,R0		;R0 TEMPORARILY HAS NEW
	ADD	#4,R0		;TOP ADDRESS TO MOVE TO
	MOV	R4,R3		;GET OLD TOP ADDRESS -> R3
	MOV	R0,R4		;NEW TOP -> R4
	JSR	PC,SLUP01	;SLIDE UP THE REMAINING HEADERS
	MOV	R4,BOLNHD	;SET NEW BOTTOM OF HEADERS
	MOV	(SP)+,R5	;POINTS TO START OF HEADERS TO BE ADJUSTED
	MOV	(SP)+,R0	;COUNT OF DISTANCE MOVED
	MOV	2(R5),R2	;SEE IF TEXT POINTER FOR
	ADD	USR,R2		;DELETE INSTRUCTION WAS IN
	CMP	R1,R2		;MOVED CODE
	BLO	5$		;IF NOT, BRANCH
	SUB	R0,R1		;IF SO, ADJUST IT
5$:	CMP	R5,BOLNHD	;FINISHED WITH ADJUSTING?
	BLO	6$		;IF SO, BRANCH
	SUB	R0,2(R5)	;ADJUST TEXT PTR FOR EACH LINE
	SUB	#4,R5		;THAT WAS MOVED
	BR	5$		;AND KEEP GOING
6$:	SKIP			;GET NEXT CHAR IN DELETE COMMAND
	CMPB	R2,#',		;IS IT A COMMA (MORE)?
	BEQ	1$		;IF SO, DO IT
	DEC	R1		;ELSE BACK IT UP
	JMP	INIT02		;AND GO ON WITH PROGRAM

	.SBTTL	INIT00, INIT02 - STATEMENT INTERPRETER
;
; PDP-11 BASIC - COMMAND/STATEMENT INTERPRETER
;	REGISTERS USED - R0,R1,R2,R3,R4,R5
;
INIT02:	TST	FPEXFL		;ANY FLOATING POINT ERRORS?
	BEQ	1$		;IF NOT, SKIP SUBROUTINE
	JSR	PC,FPERMS	;IF SO, PROCESS THEM
1$:	SKIP			;GET THE NEXT CHARACTER
	CMPB	#S.CON,R2	;IS THIS A CONTINUATION?
	BEQ	INIT09		;JUMP IF YES
	CMPB	#S.EOL,R2	;IS IT A LINE FEED
	BEQ	INIT03		;JUMP IF YES
	ILCERR			;ILLEGAL CHARACTER TERMINATING STMT.
INIT03:	TSTB	QFLG		;CHECK FOR 1 LINE MCR PRINT
	BEQ	INIT07		;IF SO
	JMP	PCK11		;EXIT
INIT26:	JMP	STOP00
INIT07:	TST	BRFLAG		;SEE IF BREAK SET
	BNE	INIT26		;IF SET, STOP
	TST	RUNF		;IS RUN MODE SET
	BEQ	INIT19		;JUMP IF NOT
	MOV	LINEHD,R5	;GET CURRENT LINE HEADER
	SUB	#4,R5		;AND POINT TO NEXT LINE HEADER
INIT13:	CMP	R5,BOLNHD	;AT END OF PROGRAM?
	BLO	INIT26		;IF SO, BRANCH
	MOV	R5,LINEHD	;ESTABLISH NEW CURRENT LINE HEADER
	MOV	(R5),LINENO	;AND NEW CURRENT LINE NUMBER
	MOV	2(R5),R1	;AND TEXT POINTER
	ADD	USR,R1		;ADD IN OFFSET
	CLR	STCOUN		;SET STATEMENT COUNT TO ZERO
INIT09:	JMP	INIT20
INIT19:	MOV	#TINPT,INPT	;RESET INPUT AND OUTPUT
	MOV	#TOTPT,OTPT	;IN CASE IMMEDIATE I/O WITH FILE
INIT00:	CLR	RUNF		;CLEAR RUN FLAG TO START
	CLR	BRFLAG		;CLEAR THE BREAK FLAG
	MOV	#RDY00,R0	;TELL USER THAT
	PRINTL			;ALL IS READY

INIT04:	PACK			;GET A COMMAND
INIT01:	MOV	R1,WORK		;SAVE INITIAL TEXT POINTER
	SKIP			;GET THE FIRST CHARACTER
	CMP	R2,#S.EOL	;IGNORE IF ONLY A TERMINATOR
	BEQ	INIT04
	MOV	WORK,R1		;GET TEXT POINTER
	ATOI			;GET INTERNAL LINE NUMBER
	MOV	R1,R3		;TEST ADDRESS ALSO IN R3
	CMPB	@R1,#S.EOL	;CALL IT A DELETE IF NO
	BNE	INIT08
	FINDLN			;FIND THE LINE NUMBER
	BNE	INIT04		;NO SUCH LINE
	SQUISH			;FOUND,DELETE IT
	BR	INIT04
INIT08:	BIT	#2,REMTRM	;COMPILED FILE?
	BEQ	INIT05		;IF NOT, DO REGULAR INTERPRETATION
	SRCHLF			;IF SO, GET TO END OF LINE
	DEC	R1		;BACK UP TEXT POINTER
	JMP	INIT06		;AND SKIP THE INTERPRETATION
;
; THIS SECTION TAKES THE BUFFER POINTED TO BY R1 AND R3 AND COMPACTS IT.
; IN EFFECT, R1 IS A LEFT BUFFER POINTER AND R3 IS A RIGHT BUFFER POINTER.
;
INIT05:	MOV	#INIT11,R0	;START OF VERB AND TOKEN PROTOTYPES -> R0
12$:	CMPB	(R3),#40	;IS CURRENT CHAR A SPACE?
	BNE	13$		;IF NOT, BRANCH
14$:	MOVB	(R3)+,(R1)+	;IF SO, MOVE IT INTO LEFT BUFFER
	BR	12$		;AND KEEP LOOKING FOR NON-SPACE
13$:	CMPB	(R3),#'"	;IS THIS START OF QUOTED STRING?
	BEQ	7$		;IF SO, GO PROCESS STRING
	CMPB	(R3),#S.EOL	;END OF LINE?
	BEQ	INIT06		;IF SO, GO TO NEXT SECTION OF CODE
;
; NEXT SECTION OF CODE DOES CHECK FOR ALPHA CHAR. IF NOT, WE CAN SAVE
; SOME PROCESSING SINCE ALL PROTOTYPES START WITH AN ALPHA, ! OR ?
;
	MOVB	(R3),R4		;CHAR -> R4
	CMPB	R4,#'?
	BLO	15$
	CMPB	R4,#'Z
	BLOS	16$
15$:	CMPB	R4,#'!		;THIS IS THE OTHER POSSIBILITY
	BNE	14$		;IF NOT, NOT START OF PROTOTYPE
	MOVB	#S.EXC,R2	;SAVE OURSELVES SOME TIME THIS WAY
	INC	R3		;ADJUST RIGHT BUFFER
	CLR	-(SP)		;DUMMY TO KEEP STACK STRAIGHT
	BR	20$		;AND GO FINISH LINE WITH NO FANCY STUFF
;
16$:	CLR	R2		;INITIALIZE TOKEN COUNTER
11$:	MOV	R3,-(SP)	;SAVE RIGHT BUFFER POINTER
1$:	CMPB	(R3)+,#40	;IS NEXT CHAR A SPACE?
	BEQ	1$		;IF SO, SKIP IT
	CMPB	-(R3),#S.EOL	;IS IT END OF LINE?
	BEQ	4$		;IF SO, NO TOKEN MATCH (BRANCH)
2$:	CMPB	(R0),#40	;IS PROTOTYPE CHAR A SPACE?
	BNE	3$		;IF NOT, BRANCH
	INC	R0		;IF SO, BUMP IT AND PROCEED
	BR	2$
3$:	CMPB	(R0)+,(R3)+	;DO PROTOTYPE & TEXT MATCH?
	BNE	4$		;IF NOT, GO TRY FOR NEXT PROTOTYPE
	TSTB	(R0)		;END OF PROTOTYPE?
	BNE	1$		;KEEP TRYING
	ADD	#140,R2		;FORM TOKEN
20$:	CMPB	R2,#S.VBEN	;IS THIS A VERB PROPER?
	BLOS	21$		;IF SO, BRANCH
	CMPB	R2,#S.THEN	;ARE WE IN TOKENS NEEDING SPACES?
	BLO	19$		;IF NOT, BRANCH
21$:	CMPB	-1(R1),#40	;IS PRECEDING CHAR A SPACE?
	BNE	18$		;IF NOT, BRANCH
	DEC	R1		;IF SO, CAN ELIMINATE SPACE
18$:	CMPB	(R3),#40	;IS FOLLOWING CHAR A SPACE?
	BNE	19$		;IF NOT, BRANCH
	INC	R3		;IF SO, CAN ELIMINATE IT TOO!
19$:	MOVB	R2,(R1)+	;PUT IT INTO LEFT JUSTIFIED BUFFER
	TST	(SP)+		;CLEAN STACK
	CMPB	R2,#S.DATA	;DATA STATEMENT?
	BEQ	17$		;IF SO, NO FURTHER TOKEN SEARCH
	CMPB	R2,#S.EXC	;EXCLAMATION TYPE REMARK?
	BEQ	17$
	CMPB	R2,#S.REM	;STD REM?
	BEQ	17$
	BR	INIT05		;AND CONTINUE ON IN LINE
4$:	MOV	(SP)+,R3	;RESTORE RIGHT BUFFER PTR
5$:	TSTB	(R0)+		;SKIP TO END OF PROTOTYPE
	BNE	5$
	CMP	R0,#PROTEN	;END OF TOKEN PROTOTYPES?
	BHIS	6$		;IF SO, BRANCH
	INC	R2		;ELSE INCREMENT TOKEN COUNTER
	BR	11$		;AND GO TRY AGAIN
6$:	MOVB	(R3)+,(R1)+	;PUT IN CURRENT CHAR (RT -> LT)
	BR	INIT05		;AND START OVER
7$:	MOVB	(R3)+,(R1)+	;PUT IN OPEN QUOTE
9$:	MOVB	(R3)+,R4	;GET NEXT CHAR
	CMPB	R4,#S.EOL	;END OF LINE?
	BNE	8$		;IF NOT, BRANCH
	UNMERR			;IF SO, UNMATCHED QUOTES ERROR
8$:	CMPB	R4,#'"		;END OF QUOTE?
	BEQ	10$		;IF SO, BRANCH
	MOVB	R4,(R1)+	;IF NOT, PUT IN CHAR
	BR	9$		;AND KEEP GOING
10$:	MOVB	R4,(R1)+	;PUT IN CLOSE QUOTE
	BR	INIT05
17$:	MOVB	(R3)+,R4	;THIS SECTION MOVES REST OF
	CMPB	R4,#S.EOL	;RIGHT BUFFER INTO LEFT BUFFER
	BEQ	INIT06		;LOOKING FOR <LF>
	MOVB	R4,(R1)+	;BUT WITH NO TOKEN SEARCH
	BR	17$
INIT06:	MOVB	#S.EOL,(R1)+	;MAKE END OF LINE
	MOV	R1,R3		;END OF LINE -> R3
	MOV	WORK,R1		;START OF LINE -> R1
	ATOI			;GET LINE # -> R0
	SUB	R1,R3		;CALCULATE LEN WITHOUT LINE NUMBER
	MOV	R1,WORK		;AND REMEMBER START WITHOUT LINE #
4$:	SKIP			;GET FIRST NON-ZERO CHAR -> R2
	CMPB	R2,#140		;SEE THAT FIRST THING IS A VERB
	BLO	1$		;IF NOT, GO CHECK FOR IMPLIED LET
	CMPB	R2,#S.VBEN	;CHECK AGAINST VERB END
	BLOS	3$		;IF IN RANGE, OK (BRANCH)
2$:	UNRERR			;ANYTHING HIGHER IS ERROR
1$:	DEC	R1		;BACK UP TEXT POINTER
	GETVAR			;TRY TO GET A VARIABLE NAME
	BVS	2$		;FAILURE MEANS THIS IS NOT A 'LET'
5$:	CMPB	R2,#S.CON	;LOOK FOR END OF STATEMENT
	BEQ	2$		;IF FOUND, ERROR
	CMPB	R2,#S.EOL	;CHECK FOR END OF LINE
	BEQ	2$		;IF FOUND, ALSO ERROR
	CMPB	R2,#'=		;LOOK FOR EQUAL
	BEQ	3$		;IF FOUND, AT LEAST CHANCE FOR 'LET'
	SKIP			;TRY AGAIN
	BR	5$
3$:	CMPB	R2,#S.EXC	;EXCLAMATION PT. REMARK?
	BEQ	9$		;IF SO, BRANCH
	CMPB	R2,#S.REM	;REGULAR REMARK?
	BNE	6$		;IF NOT, BRANCH
9$:	BIT	#1,REMTRM	;TRIMMING REMARKS?
	BNE	7$		;IF SO, BRANCH
	BR	10$		;DON'T DO ANY MORE INTERPRETATION
6$:	JUNKIT			;GET TO END OF STATEMENT
	CMPB	(R1)+,#S.EOL	;IS THIS END OF LINE?
	BNE	4$		;IF NOT, ANOTHER STATEMENT TO CHECK
10$:	MOV	WORK,R1		;START OF LINE -> R1
8$:	TST	R0		;ANY NON-ZERO LINE NUMBER?
	BNE	ASSM00		;IF SO, PUT IT INTO PROGRAM
	CLOSEF			;ELSE IMMEDIATE SO CLOSE OFF OLD FILE
	JMP	INIT10		;AND DO COMMAND
7$:	MOVB	#S.EOL,(R1)+	;PUT IN END OF LINE TO TRIM REMARK SHORT
	MOV	R1,R3		;NOW RE-CALCULATE REMARK
	MOV	WORK,R1		;RE-ESTABLISH START
	SUB	R1,R3		;R3 NOW HAS LENGTH (SHORTENED)
	BR	8$		;AND BRANCH BACK TO REGULAR CODE
INIT20:	INC	STCOUN		;INCREMENT STATEMENT POSITION COUNT
INIT10:	MOV	ENDTXT,R3	;CURRENT END OF TEXT -> R3
	INC	R3		;ROUND IT UP TO
	BIC	#1,R3		;NEXT WORD BOUNDARY
	CMP	R3,BOLNHD	;DOES IT MATCH BOTTOM OF LINE HEADERS?
	BEQ	2$		;IF SO, SKIP THE MOVE
	MOV	BOLNHD,R2	;START OF BLOCK TO MOVE -> R2
	MOV	R2,R0		;CALCULATE DISTANCE TO
	SUB	R3,R0		;MOVE IN R0
	MOV	ENUDAT,R3	;END OF BLOCK TO MOVE -> R3
	JSR	PC,SLDN		;SLIDE IT ALL DOWN
	SUB	R0,BOLNHD	;AND ADJUST THE POINTERS
	SUB	R0,STUDAT	;INVOLVED
	SUB	R0,ENUDAT
	TST	LINEHD		;NON-ZERO LINEHD (PROGRAM MODE)?
	BEQ	2$		;IF NOT, DON'T DO ANYTHING
	SUB	R0,LINEHD	;IF SO, ADJUST IT TOO!
2$:
	MOV	ENUDAT,ENUSAV	;SAVE END OF USER DATA IN CASE ERROR
	SKIP			;GET VERB
	BIC	#177400,R2	;CLEAR SIGN EXTEND
	SUB	#140,R2		;GET ADDRESS DISPLACEMENT
	BGE	1$		;IF REGULAR CODE, PROCEED
	DEC	R1		;ELSE IMPLIED LET
	JMP	LET00
1$:	ASL	R2
	MOV	#TINPT,INPT	;SET FILE CONTROL BLOCK POINTERS
	MOV	#TOTPT,OTPT
	JMP	@INIT12(R2)	;GO DO IT
STOP03:	JMP	STOP00
SKPQT:	CMPB	(R1),#'"	;START OF STRING CONSTANT?
	BEQ	1$		;IF SO, BRANCH
	RTS	PC		;ELSE RETURN
1$:	INC	R1		;PUSH POINTER TO NEXT CHAR
	CMPB	(R1),#'"	;END OF QUOTE?
	BEQ	2$		;IF SO, RETURN
	CMPB	(R1),#S.EOL	;END OF LINE?
	BNE	1$		;IF NOT, BRANCH
	UNMERR			;IF SO, UNMATCHED QUOTES
2$:	INC	R1
	RTS	PC
	.SBTTL	ASSM00 - ASSEMBLE LINE OF USER CODE
;
; ASSEMBLE LINE OF CODE INTO WORKING STORAGE - TRANSFER TO USER AREA
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
UPUSRD:	CMP	ENUDAT,STGOSB	;AT TOP ALREADY?
	BHIS	3$		;IF SO, WE'RE DONE
	MOV	R3,-(SP)	;SAVE R3
	MOV	STGOSB,R4	;NEW TOP -> R4
	MOV	BOLNHD,R2	;OLD START -> R2
	MOV	ENUDAT,R3	;OLD TOP -> R3
	MOV	R4,R0		;CALC DISTANCE TO MOVE
	SUB	R3,R0		;IN R0
	JSR	PC,SLUP01	;SLIDE IT UP
	MOV	(SP)+,R3	;RESTORE R3
4$:	ADD	R0,ENUDAT	;SAVE NEW END OF USER DATA
	MOV	ENUDAT,ENUSAV	;AND ERROR RECOVERY END OF USER DATA
	ADD	R0,STUDAT	;AND START
	ADD	R0,BOLNHD	;AND BOTTOM OF LINE HEADERS
3$:	RTS	PC
ASSM00:
	MOV	R3,-(SP)	;SAVE LEN OF LINE
	MOV	R0,-(SP)	;AND LINE NUMBER
	JSR	PC,UPUSRD	;MOVE UP LINE NUMBERS
	MOV	BOLNHD,R0	;NOW CHECK FOR
	SUB	ENDTXT,R0	;ROOM
	SUB	#4,R0		;FOR NEW
	CMP	R0,2(SP)	;LINE
	BHIS	2$		;IF OK, BRANCH
	OVFERR			;ELSE ERROR (OVERFLOW)
2$:	MOV	(SP),R0		;LINE # -> R0
	FINDLN			;GET LINE
	BNE	1$		;IF NOT ALREADY THERE, BRANCH
	SQUISH			;IF IT'S THERE, DELETE IT (REGISTERS NOW SET)
1$:	MOV	R5,R3		;COPY HEADER INSERTION POINT
	MOV	BOLNHD,R2	;BOTTOM OF HEADER AREA -> R2
	MOV	#4,R0		;SLIDE THAT RANGE DOWN
	JSR	PC,SLDN		;BY FOUR BYTES (ONE HEADER'S WORTH)
	SUB	R0,BOLNHD	;AND ADJUST POINTER TO AREA
	SUB	R0,R5		;AND MAKE R5 POINT TO HOLE WE CREATED
	MOV	(SP)+,(R5)	;PUT IN LINE NUMBER
	MOV	R1,2(R5)	;AND ADDRESS OF LINE TEXT
	SUB	USR,2(R5)	;MAKE IT AN OFFSET INTO TEXT AREA
	MOV	(SP),R3		;GET LENGTH OF LINE (MINUS LINE NUMBER)
	CMP	R1,ENDTXT	;IS INSERTION POINT AT THE END
	BEQ	6$		;IF SO, WE CAN SKIP SOME CODE
3$:	SUB	#4,R5		;POINT TO NEXT HEADER
	CMP	R5,BOLNHD	;PAST END YET?
	BLO	4$		;IF SO, BRANCH
	ADD	R3,2(R5)	;IF NOT, ADJUST ALL THE HIGHER LINE PTRS
	BR	3$
4$:	MOV	ENDTXT,R4	;SET UP TO MOVE TEXT UP
	MOV	R4,R2
	ADD	R3,R2		;GET NEW END -> R2
	MOV	R4,R0		;CALCULATE # BYTES TO MOVE
	SUB	R1,R0		;IN R0
	BEQ	6$
5$:	MOVB	-(R4),-(R2)	;MOVE IT ALL UP
	SOB	R0,5$
6$:	MOV	(SP)+,R3	;GET LENGTH OF NEW TEXT AGAIN
	ADD	R3,ENDTXT	;UPDATE END OF TEXT
	MOV	WORK,R2		;ADDRESS OF TEXT -> R2
7$:	MOVB	(R2)+,(R1)+	;MOVE IT ALL
	SOB	R3,7$		;IN
	JMP	INIT04		;AND GO GET NEXT LINE
	.SBTTL	DATASET ERROR ROUTINES
;
; DATASET ERROR ROUTINES
;
OLDFER:
SCRFER:
SAVFER:	CLR	REMTRM			;CLEAR SOME FLAGS
	MOV	#COMFDB,R0		;ADDRESS OF FDB -> R0
	MOVB	F.ERR(R0),R0		;FCS ERROR CODE -> R0
	MOV	R0,PARLST+P.FCS		;STORE IN MO LIST
	PRFERR				;AND GO TO NORMAL ERROR HANDLING

	.SBTTL	STATEMENT LIST
;
; DEFINITIONS OF LINE AND STATEMENT TERMINATORS
S.EOL	=12	;LINE FEED FOR NOW
S.CON	=72	;COLON FOR NOW
;
; DEFINE MACRO VERB AND ADDRESS DEFINITIONS
	.MACRO	VERBDF	NAME,ROUTIN,VDEF
	.ASCIZ	/NAME/		;NAME WITH TRAILING NULL
	.IF	NB,VDEF
	VDEF=S.MAX
	.GLOBL	VDEF
	.ENDC
	.PSECT	VERBAD		;GET INTO PROPER PSECT
	.WORD	ROUTIN		;DEFINE ADDRESS
	.PSECT	BASIC3		;BACK TO BASIC3 PSECT
	S.MAX=S.MAX+1		;UPDATE VERB COUNTER
	.ENDM
;
; DEFINE MACRO FOR TOKEN DEFINITION (NO ASSOCIATED ROUTINE)
; THIS MACRO MUST BE USED ONLY AFTER ALL TOKENS WITH ASSOCIATED ADDRRESSES
; IN PSECT 'VERBAD' HAVE BEEN DEFINED.
;
	.MACRO	TOKDEF	NAME,TDEF
	.ASCIZ	/NAME/
	.IF	NB,TDEF
	TDEF=S.MAX
	.GLOBL	TDEF
	.ENDC
S.MAX=S.MAX+1
	.ENDM
;
; DEFINE ADDRESS OF START OF VERB PSECT
	.PSECT	VERBAD
INIT12:
	.PSECT	BASIC3
S.BAS=140
S.MAX=S.BAS
;
; NOW DEFINE THE VERBS AND THEIR ROUTINE ADDRESSES
INIT11:	VERBDF	LET		LET00
	VERBDF	<IF END>	IFEND0
	VERBDF	IF		IF00	S.IF
	VERBDF	GOTO		GOTO00	S.GOTO
	VERBDF	FOR		FOR00
	VERBDF	NEXT		NEXT00	S.NEXT
	VERBDF	GOSUB		GOSB00	S.GOSB
	VERBDF	RETURN		RET00
	VERBDF	!		REM00	S.EXC
	VERBDF	REM		REM00	S.REM
	VERBDF	PRINT		PR00	S.PRIN
	VERBDF	?		PR00
	VERBDF	<INPUT LINE>	INP01
	VERBDF	INPUT		INP00
	VERBDF	READ		READ00
	VERBDF	<MAT INPUT>	REM00
	VERBDF	<MAT READ>	REM00
	VERBDF	<MAT LET>	REM00
	VERBDF	TRACE		TRACE0
	VERBDF	<ON ERROR GOTO>	ONG00
	VERBDF	ON		ONGT00	S.ON
	VERBDF	CALL		CALL00
	VERBDF	DIM		DIM00
	VERBDF	DATA		REM00	S.DATA
	VERBDF	DEF		DEF00
	VERBDF	RESTORE		RES00
	VERBDF	<OPEN LIBRARY>	OPLB00
	VERBDF	OPEN		OPEN00
	VERBDF	CLOSE		CLSE00
	VERBDF	LOAD		LOAD00
	VERBDF	UNLOAD		UNLD00
	VERBDF	CON		CON00
	VERBDF	PRIORITY	PRI00
	VERBDF	RANDOMIZE	RND01
	VERBDF	STOP		STOP00
	VERBDF	END		STOP00
	VERBDF	STEP		STEP00	S.STEP
	VERBDF	RUN		RUN00
	VERBDF	CLEAR		CLEAR0
	VERBDF	DELETE		DEL00
	VERBDF	LIST		LIST00
	VERBDF	SAVE		SAVE00
	VERBDF	CHAIN		CHAIN0
	VERBDF	OVERLAY		OVL00
	VERBDF	OLD		OLD00
	VERBDF	SCRATCH		SCRA00
	VERBDF	EXIT		PCK11
	VERBDF	SLEEP		SLEEP0
	VERBDF	WAIT		WAIT0	S.VBEN
VERBEN:
FNADD:
	VERBDF	SBS$(		SBS00	S.SFST
	VERBDF	SEG$(		SEG00
	VERBDF	RJS$(		RJS00
	VERBDF	LJS$(		LJS00
	VERBDF	STR$(		FCHR00
	VERBDF	TRM$(		TRM00
	VERBDF	LTR$(		LTR00
	VERBDF	DAT$(		DAT00
	VERBDF	TIM$(		TIM00
	VERBDF	CHR$(		CHR00
	VERBDF	MID(		SBS00
	VERBDF	LEFT(		LEFT00
	VERBDF	RIGHT(		RIGHT0
	VERBDF	DDAT$(		DDAT00
	VERBDF	PIECE$(		PIECE0
	VERBDF	SPACE$(		SPACE0
	VERBDF	STRING$(	STRG00
	VERBDF	STREP$(		DUM00
	VERBDF	OCT$(		OCT00
	VERBDF	OCS$(		OCS00	S.SFEN
	VERBDF	SIN(		SINE00	S.SAST
	VERBDF	COS(		COS00
	VERBDF	ATN(		ATN00
	VERBDF	EXP(		EXPF00
	VERBDF	LOG(		LOG00
	VERBDF	ABS(		ABS00
	VERBDF	SQR(		SQRT00
	VERBDF	INT(		INT00
	VERBDF	RND(		RND00
	VERBDF	SGN(		SGN00	S.SAEN
	VERBDF	INX(		INX00	S.NFST
	VERBDF	POS(		INX00
	VERBDF	NRC(		NRC00
	VERBDF	LEN(		LEN00
	VERBDF	VAL(		VAL00
	VERBDF	ASC(		ASC00
	VERBDF	OCT(		OCB00
	VERBDF	COR(		COR00
	VERBDF	TIME(		DUM00
	VERBDF	ERR(		ERR00
	VERBDF	ERL(		ERL00
	VERBDF	FCS(		FCS00	S.NFBO
;
	TOKDEF	FN			S.FN
	TOKDEF	THEN			S.THEN
	TOKDEF	TO			S.TO
	TOKDEF	NOT			S.NOT
	TOKDEF	AND			S.AND
	TOKDEF	XOR			S.XOR
	TOKDEF	OR			S.OR
	TOKDEF	IMP			S.IMP
	TOKDEF	EQV			S.EQV
	TOKDEF	OFF			S.OFF
	TOKDEF	ELSE			S.ELSE
PROTEN:
	.EVEN
	.PSECT	BASIC3
DUM00:	TM2ERR			;DEFINE ERROR FOR NON-IMPLEMENTED ROUTINES

	.SBTTL	EXIT STATEMENT (DOCUMENTATION)
;+3
; .SL
; .X <EXIT
; .ID-5
; <EXIT
; .BR
; ^THIS STATEMENT STOPS PROGRAM EXECUTION AND EXITS FROM <BASIC
; TO THE <MCR.
; ^ALL FILES ARE CLOSED BEFORE EXIT.
; ^IT IS EQUIVALENT TO A <STOP FOLLOWED BY A _^^Z FROM THE KEYBOARD.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	1000 EXIT
; \\
; .F
;-
	.SBTTL	BASIC BREAK AST ENTRY ROUTINE
;+1
; .SL
; .ID -5
; ^CONTROL ^C
; .BR
; .X _^^C
; .X ^CONTROL ^C
; ^THE BREAK KEY FOR ^^BASIC\\ IS THE ^CONTROL-^C (_^^C).
; ^A _^^C TYPED AT THE KEYBOARD WHEN RUNNING WILL CAUSE THE PROGRAM
; TO STOP AT THE NEXT SEQUENTIAL LINE (NOT AT A LINE ENTERED VIA
; <GOTO, <GOSUB, <IF ETC.).
; ^WHEN IN IMMEDIATE MODE, _^^C WILL BRING UP <MCR IF THE TERMINAL HAS
; NOT BEEN SET HOSTILE.
;-
;
; AST ENTRY FOR ^C BREAK ROUTINE
; DATA IS SENT TO "...BAS" BY A TASK "BASTER" INVOKED BY ^B TO TT16
;
	.PSECT BASIC3
CTCENT:
	.IF	NDF RSX11D	;CONDITIONAL CODE FOR RSX-11M
				;^C COMES ON STACK JUST LIKE
				;ANY OTHER UNSOLICITED CHAR.
	CMP	(SP)+,#3	;WAS CHAR ^C?
	BNE	1$		;IF NOT, IGNORE IT
	.ENDC
	INC	BRFLAG
1$:	ASTX$S			;AST SERVICE EXIT

	.SBTTL	ON ERROR GOTO
;+3
; .SL
; .X ^^ON ERROR GOTO\\
; .ID -5
; ^^
; ON ERROR GOTO
; \\
; .BR
; ^THIS STATEMENT SETS THE LINE NUMBER FOR A TRANSFER ON ANY TYPE
; OF ERROR.
; ^IT DOES NOT CAUSE ANY BRANCHING WHEN IT ITSELF IS EXECUTED,
; RATHER IT CHANGES THE PROCESSING OF ERRORS IN THE <BASIC INTERPRETER.
; ^IF THIS STATEMENT HAS BEEN PREVIOUSLY EXECUTED WITH A NON-ZERO
; LINE NUMBER SPECIFIED, NO ERROR MESSAGE WILL BE PRINTED AND A
; BRANCH TO THE SPECIFIED STATEMENT WILL BE MADE.
; ^NORMAL ERROR PROCESSING WILL BE RESTORED AFTER THE BRANCH IS MADE
; OR BY EXECUTING THE STATEMENT WITH A ZERO LINE NUMBER.
; ^THUS AT LEAST ON ^^ON ERROR GOTO\\ MUST FOLLOW THE LAST ERROR
; ANS PRECEDE THE NEXT ONE FOR USER ERROR HANDLING TO OCCUR.
; ^PRECISE INFORMATION AS TO THE CAUSE OF THE ERROR CAN BE HAD
; FROM THE FUNCTIONS <ERR, <ERL, <FCS DETAILED ELSEWHERE.
; .BR
; ^EXAMPLES:
; .NF
; ^^
; 	100 ON ERROR GOTO 1500
; 	510 ON ERROR GOTO 0	! THIS RESTORES NORMAL ERROR HANDLING
; \\
; .F
;-
ONG00:	EVAL			;GET THE LINE NUMBER
	BVS	1$		;CLOSE PAREN IS ERROR
	STCFI	AC0,ERRBRN	;PUT AWAY LINE NUMBER
	JMP	INIT02		;AND CONTINUE EXECUTING
1$:	STXERR

	.SBTTL	IF END - RESET END-OF-FILE ERROR ROUTINE ADDRESS
;+3
; .SL
; .X ^^IF END\\
; .ID -5
; ^^
; IF END [_#N] THEN _<LINE _#>
; \\
; .BR
; ^THIS STATEMENT IS USED TO RESET THE END OF FILE BRANCH ON A GIVEN
; FILE OR WITHOUT THE "_#^N", IT SETS THE TERMINAL END OF FILE BRANCH.
; ^THE SPECIFIED FILE MUST HAVE BEEN OPENED WITH THE POSSIBILITY OF
; BEING READ FROM.
; .BR
; ^EXAMPLES:
; .NF
; ^^
; 	100 IF END THEN 1500   :! SET TERMINAL END OF FILE LINE NO.
; 	120 IF END _#3 THEN 2100:! SET END OF FILE LINE NO. ON LUN 3
; \\
; .F
;-
IFEND0:	SKIP			;NEXT CHAR -> R2
	CMPB	R2,#'#		;FILE SPEC'D?
	BNE	1$		;IF NOT, BRANCH
	MOV	#400,R0		;LOOK FOR FILE WITH READ POSSIBLE
	JSR	PC,FILFND	;FIND IT WITH PTR -> R3
	BNE	4$		;IF THERE, BRANCH
	FNMERR			;ELSE ERROR
4$:	SKIP			;NEXT CHAR -> R2
	TST	(R3)+		;AND MAKE FCB PTR CONSISTENT WITH TERMINAL
	BR	2$		;AND BRANCH
1$:	MOV	INPT,R3		;TERMINAL FCB ADD -> R3
2$:	CMPB	R2,#S.THEN	;DO WE HAVE "THEN"
	BEQ	3$		;YES, BRANCH
	CMPB	R2,#S.GOTO	;OR MAYBE "GOTO"
	BEQ	3$		;OK TOO
5$:	IFERR			;ELSE ERROR
3$:	MOV	R3,-(SP)	;SAVE FCB PTR
	EVAL			;EVALUATE LINE #
	BVS	5$		;CLOSE PAREN AT END IS ERROR
	MOV	(SP)+,R3	;RESTORE FCB PTR
	STCFI	AC0,16(R3)	;SAVE LINE #
	JMP	INIT02		;AND GO TO NEXT STATEMENT
	.SBTTL	SINGLE LINE STEP INSTRUCTION
;+2
; .SL
; .X ^^STEP\\
; .X ^SINGLE LINE EXECUTE
; .ID -5
; ^^
; STEP [LINE _#]
; \\
; .BR
; ^THIS STATEMENT ALLOWS ONE TO STEP THROUGH A PROGRAM ONE LINE AT
; A TIME.
; ^THE OPTIONAL LINE NUMBER MAY BE USED TO START AT A DIFFERENT LINE.
; ^IF NO LINE NUMBER IS SPECIFIED, EXECUTION RESUMES AT THE LINE
; FOLLOWING THE LAST STOP.
; ^NOTE THAT IF A BRANCH IS TAKEN THE LINE BEING EXECUTED,
; THE PROGRAM WILL NOT STOP UNTIL THE NEXT LINE AFTER THE BRANCH.
; ^THE STOP USES THE SAME INTERNAL FACILITIES AS THE
; _^^B BREAK FEATURE.
; .BR
; ^EXAMPLE:
; .NF
; ^^
;	STEP
; 	STEP 510
; \\
; .F
;-

	.SBTTL	PROGRAM CONTINUE
;+2
; .SL
; .X ^^CON\\
; .X ^PROGRAM CONTINUE
; .ID-5
; ^^
; CON [LINE _#]
; \\
; .BR
; ^THIS COMMAND ALLOWS ONE TO RESUME EXECUTION OF A PROGRAM
; AFTER STOPPING IT FOR INTERACTIVE DE-BUGGING.
; ^WHEN USED WITH THE OPTIONAL LINE NUMBER, IT FUNCTIONS
; JUST LIKE ^^GOTO\\
; WITH THE EXCEPTION THAT THE NEXT AVAILABLE LINE AFTER THE ONE SPECIFIED
; IS USED IF THERE IS NO EXACT MATCH.
; ^IF NO LINE NUMBER IS SPECIFIED, EXECUTION IS RESUMED AT THE LINE FOLLOWING
; THE LAST STOP.
; .BR
; ^EXAMPLE:
; ^^
; .NF
;	CON
; \\
; .F
;-
STEP00:	INC	BRFLAG		;SET UP FOR STOP AFTER LINE EXECUTED
CON00:	SKIP			;GET NEXT CHAR
	CMP	R2,#S.EOL	;END OF LINE?
	BNE	1$		;IF NOT, BRANCH
	MOV	LASTEX,R0	;GET LAST EXECUTED LINE IN R0
	INC	R0		;WE WANT NEXT ONE
	MOV	#1,-(SP)	;FLAG FOR INEXACT MATCH
	JMP	GOTO03		;FINISH AS A GOTO
1$:	DEC	R1		;BACK UP TEXT POINTER
	MOV	#1,-(SP)	;FLAG TO TAKE NEXT AVAILABLE LINE
	JMP	GOTO04		;AND DO A REGULAR GOTO

	.SBTTL	SLEEP COMMAND
;+3
; .SL
; .X <SLEEP
; .ID -5
; ^^
; SLEEP _<EXPRESSION>_<UNIT>
; \\
; .BR
; ^THE <SLEEP COMMAND CAUSES THE EXECUTING PROGRAM TO PAUSE FOR
; THE SPECIFIED AMOUNT OF TIME.
; ANY VALID ARITHMETIC EXPRESSION MAY BE USED TO SPECIFY THE TIME
; MAGNITUDE.
; ^HOWEVER, A NEGATIVE RESULT WILL GIVE AN ERROR AND ZERO WILL
; BE TREATED AS A NO-OP.
; ^TRUNCATION OF THE FLOATING EXPRESSION VALUE WILL BE USED.
; ^THE UNIT OF TIME MAY BE SPECIFIED AS <TICKS, <SECONDS, <MINUTES,
; <HOURS OR ANY ABBREVIATION OF THOSE WORDS WITH THE SAME FIRST LETTER.
; ^NO UNITS SPECIFICATION WILL DEFAULT TO <SECONDS.
; .BR
; ^EXAMPLES:
; .NF
; ^^
; 	510 SLEEP 10 SECONDS
; 	105 SLEEP 2 M
; 	632 SLEEP 25
; \\
; .F
;-
SLPWTC:	EVAL			;EVALUATE THE NUMBER OF UNITS
	BVS	5$		;ON ERROR BRANCH
	CLR	R3		;MAGNITUDE ZERO IF ERROR
	SKIP			;FIRST CHAR OF UNITS SPEC IN R2
	CMPB	R2,#'T		;IS IT TICKS?
	BNE	1$		;TRY FOR SOMETHING ELSE
	MOV	#1,R0		;SET UNITS TYPE -> R0
	BR	7$
1$:	CMPB	R2,#'S		;SECONDS?
	BNE	2$
	MOV	#2,R0
	BR	7$
2$:	CMPB	R2,#'M		;MINUTES?
	BNE	3$
	MOV	#3,R0
	BR	7$
3$:	CMPB	R2,#'H		;HOURS?
	BNE	4$
	MOV	#4,R0
	BR	7$
4$:	CMPB	R2,#S.EOL	;END OF LINE?
	BEQ	6$		;IF SO, DEFAULT
	CMPB	R2,#S.CON	;END OF STATEMENT?
	BEQ	6$		;IF SO, ALSO DEFAULT
5$:	SEC			;INDICATE ERROR
	RTS	PC
6$:	DEC	R1		;BACK UP TO TERMINATOR
	MOV	#2,R0		;SET SECONDS TYPE
7$:	STCFI	AC0,R3		;INTEGERIZE MAGNITUDE
	CLC			;SUCCESS
	RTS	PC
SLEEP0:	JSR	PC,SLPWTC	;USE COMMON CODE IN SUBROUTINE
	BCC	1$		;IF OK, BRANCH
2$:	SLPERR
1$:	BMI	2$		;NEGATIVE MAGNITUDE IS ERROR
	BEQ	WTSLPC		;ZERO IS NO-OP
	MRKT$S	#1,R3,R0	;SET MARK TIME
	BCS	2$		;BRANCH ON ERROR
	WTSE$S	#1		;WAIT FOR A TIME
	BCS	2$
WTSLPC:	JUNKIT			;SKIP REST OF LINE
	JMP	INIT02

	.SBTTL	WAIT0 - WAIT COMMAND - SPECIFY TIMEOUT PARAMETERS
;+3
; .SL
; .X <WAIT
; .ID -5
; ^^
; WAIT _<EXPRESSION>_<UNIT>
; \\
; ^THE <WAIT COMMAND SETS PARAMETERS FOR THE TIMEOUT OF TERMINAL INPUT.
; ^THE FORMAT IS SIMILAR TO THE <SLEEP COMMAND.
; ^NOTE THAT NO EXPLICIT ACTION IS TAKEN ON EXECUTION OF THE <WAIT
; COMMAND.
; ^IT IS USED ONLY TO SET THE LENGTH OF TIME TO WAIT FOR TERMINAL INPUT
; BEFORE CAUSING A TIMEOUT ERROR TRAP.
; ^THE USER MAY CHECK FOR THIS CONDITION BY USE OF THE <ON <ERROR <GOTO
; COMMAND AND THEN CHECK THE ERROR CODE (44 CURRENTLY).
; ^APPROPRIATE ACTION MAY BE TAKEN AT THIS POINT (<EXIT FOR EXAMPLE).
; ^THE NO TIMEOUT CONDITION MAY BE RESTORED BY USING A MAGNITUDE OF 0.
; .BR
; ^EXAMPLES:
; .NF
; ^^
;	400 WAIT 40 S :! ALL TERMINAL INPUT TO TIME OUT AFTER 40 S
;	500 WATI 0    :! RESTORE TO NO TIMEOUT CONDITION
; \\
; .F
;-
WAIT0:	JSR	PC,SLPWTC	;USE COMMON CODE FOR SLEEP AND WAIT
	BCC	1$		;IF OK, BRANCH
2$:	WATERR
1$:	BMI	2$		;NEGATIVE MAGNITUDE IS ERROR
	MOV	R3,WTMAG	;STORE MAGNITUDE
	MOV	R0,WTUNIT	;STORE UNIT
	BR	WTSLPC		;NOW EXIT COMMAND

	.SBTTL	PRI00 - PRIORITY COMMAND
;+3
; .SL
; .X <PRIORITY
; .ID -5
; ^^
; PRIORITY _<EXPRESSION>
; \\
; .BR
; ^THE <PRIORITY COMMAND CAUSES THE INTERPRETER TO CHANGE ITS PRIORITY
; TO THAT SPECIFIED IN THE FOLLOWING EXPRESSION.
; ^PRIORITIES UP TO 100 ARE ALLOWED.
; .BR
; ^EXAMPLE
; .NF
; ^^
; 	500 PRIORITY 30
; \\
; .F
;-
PRI00:	EVAL			;GET VALUE OF PRIORITY
	BVS	1$		;ON ERROR, BRANCH
	STCFI	AC0,R0		;MAKE PRIORITY INTEGER IN R0
	CMP	R0,#100.	;CHECK AGAINST MAX ALLOWED
	BLE	2$		;IF OK, BRANCH
1$:	PRIERR
2$:	ALTP$S	,R0		;CHANGE THIS TASK TO PRI IN R0
	BR	WTSLPC		;AND FINISH

	.SBTTL	LOAD - USER ASSEMBLY SUBROUTINE LOAD
;+3
; .SL
; .X <LOAD
; .ID-5
; ^^
; LOAD _<STRING FILESPEC>
; \\
; .BR
; ^THIS COMMAND LOADS THE SPECIFIED FILE AS A USER CALLABLE SUBROUTINE.
; ^THE DEFAULT EXTENSION IS <BTK.
; ^THE SUBROUTINE MODULE MUST FOLLOW A CERTAIN PREDEFINED FORMAT DESCRIBED
; IN THE <BASIC INTERPRETER SOURCE.
; .BR
; ^EXAMPLE:
; .NF
; ^^
;	610 LOAD "REVERS"
; \\
; .F
;-
;
; FORMAT FOR BASIC LOADABLE SUBROUTINES:
; FIRST THREE WORDS:
;	.WORD	ID0001	;THESE THREE WORDS ARE FILLED IN BY GLOBAL SYMBOLS
;	.WORD	ID0002	;FROM A SYMBOL TABLE FOR BASIC, ENSURING CORRECT
;	.WORD	ID0003	;SYMBOL LINKAGES (OR ELSE ERROR MESSAGE).
; NEXT TWO WORDS ARE LENGTHS:
;	.WORD	??????	;LENGTH (IN BYTES) OF CODE PLUS ENTRY POINTS
;	.WORD	??????	;LENGTH (IN BYTES) OF ENTRY POINTS
;	.WORD	??????	;# OF ENTRY POINTS
; NEXT ENTRIES ARE THREE WORD BLOCKS DESCRIBING ENTRY POINTS
;	.RAD50	/NAME/	;TWO WORDS OF RAD50 ENTRY POINT NAME
;	.WORD	??????	;OFFSET FROM START OF CODE PROPER
; FINALLY, ONE WORD CONTAINING NUMBER OF WORDS OF CODE PROPER:
;	.WORD	??????	;LEN (IN WORDS) OF CODE PROPER
;
; NOTE: THESE MODULES MUST BE TASK BUILT WITH /-HD/-FP AND:
;	STACK=0
;	UNITS=0
;
; IN ADDITION POSITION INDEPENDENT CODING TECHNIQUES MUST BE USED IN
; WRITING THE CODE BECAUSE ITS POSITION IN THE INTERPRETER WILL VARY
; DEPENDING ON WHAT OTHER ROUTINES ARE LOADED.
;
LOAD00:
	JSR	PC,FNAME	;EVALUATE STRING
	BNE	1$		;IF ONE, BRANCH
	CSIERR			;ELSE ERROR
1$:	JSR	PC,CSINT0	;INTERPRET FILE NAME
	MOV	#7653,COMFNB+N.FTYP ;".BTK" EXTENSION DEFAULT
				;OPEN FILE IN LOCATE MODE
	OPEN$R	LNKOLD,,,#FD.PLC,,,OLDFER
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	CLR	R1		;SET UP REGISTERS
	MOV	#2,R2		;TO POINT TO
	CLR	R3		;ZEROTH BYTE
	JSR	PC,.POINT	;OF 2ND BLOCK (RECORD)
	GET$	,,,OLDFER	;AND READ IT IN
	MOV	#IDNTFY,R3	;ADDRESS OF IDENT INFO -> R3
	MOV	F.NRBD+2(R0),R4	;ADDRESS OF LOAD MODULE IDENT INFO -> R4
	MOV	#3,R2		;SET TO
2$:	CMP	(R3)+,(R4)+	;COMPARE 3 WDS
	BNE	3$		;IF NO MATCH, BRANCH
	SOB	R2,2$
	MOV	(R4)+,R0	;GET TOTAL LENGTH NEEDED
	MOV	R4,-(SP)	;SAVE INPUT PTR
	TSTOK			;CHECK FOR ROOM
	BHIS	4$		;IF OK, BRANCH
3$:	LODERR			;ELSE ERROR
4$:	MOV	USR,R2		;START OF AREA TO MOVE
	MOV	ENUDAT,R3	;END OF AREA TO MOVE
	JSR	PC,SLUP		;GO SLIDE IT UP
6$:	MOV	USR,R2		;OLD START OF PROGRAM -> R2
	MOV	#USR,R3		;START ADDRESS OF PARAMETERS TO
				;BE ADJUSTED
	ADD	R0,(R3)+	;NOW ADJUST	;USR
	ADD	R0,(R3)+	;THEM		;ENDTXT
	ADD	R0,(R3)+	;		;BOLNHD
	ADD	R0,(R3)+	;		;STUDAT
	ADD	R0,(R3)		;		;ENUDAT
	MOV	(R3),ENUSAV	;AND UPDATE SAVED END OF DATA
	TST	RUNF		;ARE WE RUNNING
	BEQ	61$		;IF NOT, BRANCH
	ADD	R0,2(SP)	;IF SO, UPDATE TEXT PTR
	ADD	R0,LINEHD	;AND LINE HEADER ADDRESS
61$:	MOV	(SP)+,R4	;RESTORE INPUT PTR
	MOV	(R4)+,R3	;LEN OF ENTRY PT. TABLE (BYTES) -> R3
	MOV	R2,R1		;COPY OLD END OF CURRENT ROUTINES
	ADD	R3,R1		;NEW END FOR CURRENT ROUTINES -> R1
	MOV	R1,-(SP)	;SAVE IT
	MOV	R2,R0		;CALCULATE
	SUB	STUROU,R0	;LEN TO MOVE (BYTES) -> R0
	MOV	STUROU,-(SP)	;SAVE PLACE TO INSERT EPT
	ADD	R3,STUROU	;ADJUST PTR
	MOV	(SP),R5		;END OF PREVIOUS ROUTINES -> R5
	TST	-(R5)		;LAST ROUTINE ADDRESS -> R5
62$:	CMP	(R5),#TRAP00	;IS IT A LOADED ROUTINE?
	BHIS	63$		;IF NOT (IN PURE CODE), BRANCH
	ADD	R3,(R5)		;IF SO, ADJUST ADDRESS
	SUB	#6,R5		;AND LOOK AT NEXT
	BR	62$		;ROUTINE
63$:	ASR	R0		;LEN NOW IN WORDS
	BEQ	8$		;IF ZERO, CAN SKIP SOME CODE
7$:	MOV	-(R2),-(R1)	;MOVE UP EXISTING ROUTINES
	SOB	R0,7$
8$:	MOV	(SP)+,R2	;PLACE TO INSERT ENTRY PTS -> R2
	MOV	(R4)+,R3	;# OF ENTRY PTS -> R3
	BEQ	10$		;IF ZERO, CAN BRANCH
	MOV	(SP),R0		;CALCULATE OFFSET TO
9$:	MOV	(R4)+,(R2)+	;MOVE IN TWO RAD50 WORDS
	MOV	(R4)+,(R2)+	;WITH ROUINE NAME
	MOV	(R4)+,(R2)	;AND NOW OFFSET INTO CODE
	ADD	R0,(R2)+	;PLUS OFFSET TO START OF CODE
	SOB	R3,9$
10$:	MOV	(SP)+,R2	;INSERTION PT FOR NEW ROUTINES -> R2
	MOV	(R4)+,R3	;# OF WDS OF CODE TO XFER -> R3
	BEQ	13$		;IF ZERO, BRANCH
	MOV	LNKOLD,R0	;RESTORE FDB PTR
	MOV	F.NRBD+2(R0),R1	;START OF BUFFER -> R1
	ADD	#1000,R1	;NOW END OF BUFFER -> R1
11$:	CMP	R4,R1		;ARE WE AT END OF BUFFER
	BLO	12$		;IF NOT, BRANCH
	GET$			;IF SO, GET ANOTHER RECORD
	MOV	F.NRBD+2(R0),R4	;AND RESET PTR
12$:	MOV	(R4)+,(R2)+	;MOVE IN
	SOB	R3,11$		;THE CODE
13$:	CLOSEF			;CLOSE THE INPUT FILE
	MOV	(SP)+,R1	;RESTORE TEXT PTR
	SKIP			;CHECK FOR
	CMPB	R2,#',		;COMMA
	BNE	14$		;IF NOT, END (BRANCH)
	JMP	LOAD00		;IF SO, GO AROUND AGAIN
14$:	DEC	R1		;OTHERWISE AT END (BACK UP TEXT PTR)
	BIC	#FD.PLC,F.RACC(R0) ;AND CLEAR LOCATE BIT IN FDB
	JMP	INIT02		;AND CONTINUE ON IN PROGRAM
;
	.SBTTL	UNLOAD - COMMAND TO UNLOAD ALL USER LOADED MACRO ROUTINES
;+3
; .SL
; .X <UNLOAD
; .ID -5
; ^^
; UNLOAD
; \\
; .BR
; ^THIS COMMAND UNLOADS ALL USER ASSEMBLY ROUTINES LOADED BY THE
; <LOAD COMMAND.
; .BR
; ^EXAMPLE
; .NF
; ^^
; 	500 UNLOAD
; \\
; .F
;-
UNLD00:	JSR	PC,UNLD01	;DO THE UNLOAD ROUTINE
	TST	RUNF		;ARE WE RUNNING?
	BEQ	1$		;IF NOT, BRANCH
	SUB	R0,R1		;IF SO, ADJUST R1
	SUB	R0,LINEHD	;AND LINE HEADER ADDRESS
1$:	JMP	INIT02		;AND GO TO NEXT STATEMENT
UNLD01:	MOV	UNLDSV,R4	;GET ADDRESS WE STARTED LOADING AT
	MOV	R4,STUROU	;RESTORE START OF USER ROUTINES
	MOV	USR,R2		;START OF AREA TO MOVE
	MOV	ENUDAT,R3	;END OF AREA TO MOVE
	MOV	R2,R0		;CALCULATE AMOUNT OF MOVE
	SUB	R4,R0		;IN R0
	JSR	PC,SLDN01	;DO THE MOVE
3$:	MOV	#USR,R2		;START OF SOME PARAMS
	MOV	#5,R3		;AND # OF THEM
2$:	SUB	R0,(R2)+	;ADJUST THEM
	SOB	R3,2$
	RTS	PC

;+3
; .SKIP
; .X <TRACE <ON AND <OFF
; .ID-5
; ^^
; TRACE ON
;.ID-5
; TRACE OFF
; \\
; .BR
; ^THIS STATEMENT TURNS THE TRACE FEATURE ON AND OFF.
; ^WHEN THE TRACE IS ON, ALL TRANSFERS OUT OF THE NORMAL FLOW
; OF NORMAL PROGRAM EXECUTION ARE PRINTED ON THE USER'S TERMINAL.
; ^THIS CAN BE USED IN EITHER IMMEDIATE MODE OR PROGRAM MODE
; (FOR SELECTIVE TRACING).
; .BR
; ^EXAMPLE:
; .NF
; ^^
;	TRACE ON
;	READY
;	RUN
; OR
;	100 TRACE ON
;	...
;	200 TRACE OFF
; \\
; .F
;-
TRACE0:	SKIP			;GET FIRST NON-BLANK CHAR AFTER TRACE
	CMPB	R2,#S.ON	;TURN IT ON?
	BNE	1$		;IF NOT, BRANCH (MAYBE OFF)
	BISB	#1,TRCFLG	;IF SO, DO IT
	BR	2$
1$:	CMPB	R2,#S.OFF	;TURN IT OFF?
	BNE	3$		;IF NOT, ERROR
	CLRB	TRCFLG		;IF SO, DO IT
2$:	JMP	INIT02
3$:	UNRERR

;
; SLIDE UP ROUTINE SLUP
; TO MOVE A BLOCK OF WORDS FROM LOW TO HIGH MEMORY
; ON ENTRY:
;	R2 HAS START ADDRESS OF BLOCK
;	R3 HAS END ADDRESS (FIRST WORD PAST BLOCK)
;	R0 HAS # OF BYTES TO MOVE UP (ASSUMED EVEN)
; ON EXIT:
;	R2 HAS OLD START ADDRESS
;	R3 HAS OLD START ADDRESS
;	R0 UNCHANGED
; NO OTHER REGISTERS USED
;
SLUP:	MOV	R4,-(SP)	;SAVE A REGISTER FOR TEMPORARY USE
	MOV	R3,R4		;COPY END ADDRESS
	ADD	R0,R4		;AND CALC NEW END
	JSR	PC,SLUP01	;GO TO ACTUAL MOVE ROUTINE
	MOV	(SP)+,R4	;RESTORE REGISTER
	RTS	PC
;
; SLIDE UP ROUTINE SLUP01
; TO MOVE A BLOCK OF WORDS FROM LOW TO HIGH MEMORY
; ON ENTRY:
;	R2 HAS START ADDRESS OF BLOCK
;	R3 HAS END ADDRESS (FIRST WORD PAST BLOCK)
;	R4 HAS NEW END (TOP) ADDRESS
; ON EXIT:
;	R2 HAS OLD START ADDRESS
;	R3 HAS OLD START ADDRESS
;	R4 HAS NEW START ADDRESS
;
SLUP01:	MOV	R2,-(SP)	;CALCULATE # OF BYTES
	MOV	R3,R2		;TO MOVE
	SUB	(SP)+,R2	;IN R2
	BEQ	2$		;IF ZERO, CAN SKIP CODE
	ASR	R2		;MAKE IT # OF WORDS
1$:	MOV	-(R3),-(R4)	;NOW MAKE THE MOVE
	SOB	R2,1$
2$:	MOV	R3,R2		;COPY BACK SO R2 UNCHANGED
	RTS	PC
;
; SLIDE DOWN ROUTINE SLDN
; ON ENTRY:
;	R2 HAS START ADDRESS OF BLOCK
;	R3 HAS END ADDRESS
;	R0 HAS # OF BYTES TO MOVE
; ON EXIT:
;	R2 HAS OLD END
;	R3 HAS OLD END
;	R0 UNCHANGED
; NO OTHER REGISTERS USED
;
SLDN:	MOV	R4,-(SP)	;SAVE A REGISTER
	MOV	R2,R4		;CALCULATE NEW START
	SUB	R0,R4		;IN R4
	JSR	PC,SLDN01	;GO TO ACTUAL MOVE ROUTINE
	MOV	(SP)+,R4	;RESTORE REGISTER
	RTS	PC
;
; SLIDE DOWN ROUTINE SLDN01
; ON ENTRY:
;	R2 HAS START ADDRESS OF BLOCK
;	R3 HAS END ADDRESS
;	R4 HAS NEW START
; ON EXIT:
;	R2 HAS OLD END
;	R3 HAS OLD END (UNCHANGED)
;	R4 HAS NEW END
;
SLDN01:	SUB	R2,R3		;CALC # OF BYTES TO MOVE -> R3
	BEQ	2$		;IF ZERO, BRANCH
	ASR	R3		;NOW MAKE IT WORDS
1$:	MOV	(R2)+,(R4)+	;MAKE THE MOVE
	SOB	R3,1$
2$:	MOV	R2,R3		;COPY OLD END
	RTS	PC
	.SBTTL	VARIOUS POINTERS AND VARIABLES
;
; SYSTEM VARIABLES DEFINED OR STORED HERE
; USR AND ENDUSR SET UP AT BEGINNING OF PROGRAM
;
	.PSECT	BASIC3
RDY00:	.ASCII	/READY/
RDY01:	.BYTE	15,12,0
	.EVEN
	.GLOBL	TRAP00
VECTAB:	.WORD 0
	.WORD 0
	.WORD 0		;T-BIT TRAP OR BPT
	.WORD 0
	.WORD 0
	.WORD 0
	.WORD TRAP00		;TRAP INSTRUCTION
	.WORD 0
	.END