;*********
;        *
; 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

	.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	TWOCHR,TWO00	;PACK TWO CHARACTERS IN R4
	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
;
; 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,	ENDBAS,	SET00
	.GLOBL	PARLST	P.FCS	STRCMP	ATTACH	DETACH
	.GLOBL	GOTO02	GOTO03	GOTO04	ERRBRN	INP01
	.GLOBL	FPEXTR	FPERMS	CALL00	OPLB00
;
; 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	TWO00	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
;
	.GLOBL	INIT00,	INIT02,	INIT03,	INIT10,	INIT13
;
	.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	IMPUR3,RW,CON,REL ;DEFINE ATTRIBUTES OF RW PSECT
	.PSECT	$$$$US,RW,CON,REL ;PSECT TO DEFINE END OF USER STORAGE
	.PSECT	VERBAD,RO,I,GBL,REL,CON	;ROUTINE ADDRESSES FOR VERBS IN HERE
	.PSECT	BASIC3,RO,I,GBL,REL,CON,LOW	;START OF MAIN BODY
;RSX MACRO CALLS
	.MCALL	GET$	PUT$	OPEN$R	OPEN$W
	.MCALL	FDBDF$	FDAT$A	FDRC$A	FDOP$A
	.MCALL	CLOSE$	FSRSZ$	OPEN$	CSI$
	.MCALL	CSI$1	CSI$2	NMBLK$	FDAT$R
	.MCALL	SVTK$S	DELET$	FINIT$	GMCR$
	.MCALL	DIR$	OPEN$U	EXIT$S	CMKT$S
	.MCALL	SRDA$S	ASTX$S	CSI$SW	CSI$SV
	.MCALL	CSI$ND	FDAT$R	FDRC$R	GTSK$S
	.MCALL	GLUN$S	SFPA$S	MRKT$S	WTSE$S
	.MCALL	CLEF$S	QIO$S	WTLO$S	RDEF$S
	.IF	DF	RSX11D
	.MCALL	VRCD$
	.IFF
	.MCALL	RCVD$
	.ENDC
;

	.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	PCK06		;BR IF NOT
	MOVB	#'$,OUTBUF	;PUT IN CARRIAGE CONTROL
	MOV	#TOTPT,R0	;POINT TO TERM OUT BLOCK
	JSR	PC,PRNT01	;FORCE OUT STUFF
	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>
	BCS	PCK14		;ON ERROR TRAP
	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
	RDEF$S	#1		;WAS IT MARK TIME?
	TST	@#0		;0 => NO (MUST HAVE BEEN READ FINISHED)
	BEQ	1$		;IF FLAG CLEAR, READ FINISHED - BRANCH
	QIO$S	#IO.KIL,#2,#2,,R1	;KILL READ REQUEST
	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
	TST	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?
	BNE	PCK01		;IF NOT - ERROR
	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
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

	.SBTTL	FILE CONTROL BLOCKS AND FDB'S
;
;TERMINAL INPUT FILE CONTROL BLOCK
;
TRMSIZ=132.	;DEFINE MAX TERMINAL SIZE
	.PSECT	IMPUR3
	.WORD	0		;FLAGS WORD IN CASE USED
TINPT:	.WORD	INPBUF		;OUTPUT POINTER
	.WORD	TRMSIZ		;MAX BC
	.BYTE	4,0		;STAT/MODE
	.WORD	0		;ACTUAL BC
	.WORD	INPBUF		;DATA ADDRESS
	.WORD	0		;LINK BLOCK ERR
LNKTIN:	.WORD	TRMFDB		;TERMINAL FDB POINTER
	.WORD	0		;EOF ADDRESS
INPBUF:	.BLKB	TRMSIZ		;BUFFER
;
; TERMINAL OUTPUT CONTROL BLOCK
;
TOTPT::	.WORD	OUTBUF+1	;CHAR POINTER
	.WORD	TRMSIZ		;MAX BC
	.BYTE	4,0		;STAT/MODE
TCOUNT:	.WORD	1		;ACTUAL BYTE COUNT (START PAST CARR CNTL)
	.WORD	OUTBUF		;DATA ADDRESS
	.WORD	0		;LINK BLOCK ERR
LNKTOT:	.WORD	TRMFDB		;LINK DDB POINTER
	.WORD	0		;EOF ADDRESS
OUTBUF:	.BLKB	TRMSIZ+2	;OUTPUT BUFFER
;
; SAVE OUTPUT CONTROL BLOCK
;
SOTPT:	.WORD	SAVBUF		;CHAR POINTER
	.WORD	80.		;MAX BC
	.BYTE	4,0		;STAT/MODE
SCOUNT:	.WORD	0		;ACTUAL BYTE COUNT
	.WORD	SAVBUF		;DATA ADDRESS
	.WORD	0		;LINK BLOCK ERR
LNKSAV:	.WORD	COMFDB		;LINK DDB POINTER
	.WORD	0		;EOF ADDRESS
SAVBUF:	.BLKB	80.		;SAVE OUTPUT BUFFER
;
; OLD INPUT CONTROL BLOCK
;
OINPT:	.WORD	0		;NOT USED FOR INPUT
	.WORD	80.		;MAX BC
	.BYTE	4,0		;STAT/MODE
	.WORD	0		;ACTUAL BC
	.WORD	INPBUF		;DATA ADDRESS
	.WORD	0		;LINK BLOCK ERR
LNKOLD:	.WORD	COMFDB		;LINK DDB POINTER
	.WORD	0		;EOF ADDRESS
;
; INPUT/OUTPUT CONTROL BLOCK POINTERS
;
INPT:	.WORD	TINPT
OTPT:	.WORD	TOTPT
ERRADD:	.WORD 0
;
;VARIOUS FDB'S
;
TRMFDB:	FDBDF$				;TERMINAL FDB
	FDAT$A	R.VAR,FD.FTN!FD.CR,80.
	FDRC$A	,OUTBUF,80.
	FDOP$A	2
;
COMFDB:	FDBDF$
	FDOP$A	1,CSDSPT,COMFNB
COMFNB:	NMBLK$	PROGRAM,BAS,0,SY,0
	.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:	MOV	R0,-(SP)	;SAVE R0 SO NOT CLOBBERED BY CLOSE
	CLOSE$	#COMFDB
	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	INIT04		;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	IMPUR3		;CSI BLOCK IS RW
	CSI$
CSIBLK:	.BLKB	C.SIZE		;DEFINE CSI PARAMETER BLOCK
CSDSPT=CSIBLK+C.DSDS		;DEFINE DATA SET POINTER ASSOCIATED WITH CSI
CSBUFS=40.			;DEFINE LENGTH OF BUFFER
CSBUFF:	.BLKB	CSBUFS		;ALLOCATE BUFFER
CSBUFL:	.WORD	0		;LOCATION FOR ACTUAL LENGTH
	.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	ENDTXT,R5	;R5 NOW AT END OF USER TEXT
	INC	R5		;ROUND IT UP
	BIC	#1,R5
	MOV	R5,STUDAT	;RE-ESTABLISH USER DATA AREA
	MOV	R5,ENUDAT	;WITH NOTHING IN IT
	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,ENDUSR	;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
	BIC	#17777,R0	;CLEAR EVERYTHING OUT
	SWAB	R0		;MOVE TYPE DOWN 8
	ASH	#-4,R0		;REST OF THE WAY (WITHOUT SIGN EXTEND)
	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:	ADD	#16,R3		;JUMP OVER 7 ITEMS FOR CLASS TWO
	BR	SRL08
SRL00:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	BIC	#160000,R0	;ONLY ALLOW SINGLE TYPE
	MOV	R0,-(SP)	;SAVE MASK
SRL08:	CMP	R3,ENDUSR	;HAS THE SEARCH OVERFLOWED?
	BHI	PUSH02		;YES, GO AWAY AND DIE NICELY
	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
SRL06:	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	;ITEM IS CLASS ZERO, WORK IS NEEDED
	MOVB	3(R3),R1	;GET BOTH OPERANDS
	ARYLG			;COMPUTE ARRAY LENGTH
	ADD	R0,R3		;SKIP OVER PROPER NUMBER OF ITEMS
SRL03:	ADD	#4,R3		;FOR CLASS ONE, SKIP ITEM
	BR	SRL08		;AND RETURN
SRL09:	TST	(R3)+		;ADJUST
	MOV	(R3)+,R1	;PACKED DIMENSIONS
	MOV	(R3)+,R0	;MAX STRING LENGTH
	STRLEN
	ADD	R0,R3		;SKIP OVER IT
	BR	SRL08		;CONTINUE
SRL10:	ADD	4(R3),R3	;KICK UP BY BUFFER SIZE
	ADD	#S.FDB+30,R3	;PLUS CONTROL BLOCK SIZE AND WORD FUDGE
	BR	SRL08		;AND LOOK AT NEXT ITEM
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 ONE LINE OF TEXT POINTED TO BY R1
;  R1 IS NOT DESTROYED, R2 AND R3 ARE USED FOR SCRATCH
; R5 IS UPDATED WHEN DONE.  REGISTERS USED - R1,R2,R3,R5.
;
SQU00:	MOV	ENDTXT,R5	;R5 POINTS TO END OF USER TEXT
	MOV	R1,R3		;GET TWO COPIES
	MOV	R1,R2		; OF THE POINTER
	SRCHLF			;FIND END OF LINE
SQU01:	CMP	R1,R5		;CHECK COMPLETION OF SQUEEZE
	BHIS	SQU02		;JUMP IF DONE
	MOVB	(R1)+,(R3)+	;MOVE A CHARACTER
	BR	SQU01		;MOVE THE WHOLE CHUNK
SQU02:	MOV	R3,R5		;UPDATE USER POINTER
	MOV	R5,ENDTXT	;SAVE FOR RESTART
	MOV	R2,R1		;RESTORE R1
	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, FIND THE LINE NUMBER IN THE TEXT WHICH CORRESPONDS
;  TO THE NUMBER SPECIFIED IN R0.  IF FOUND, SET ZERO CODE AND RETURN,
;  R1 POINTS TO BEGINNING OF LINE.  IF NOT FOUND, SET NON-ZERO, RETURN
;  WITH R1 POINTING TO THE LOGICAL INSERTION POINT FOR A NEW
;  LINE WITH THE SPECIFIED NUMBER.  
;  REGISTERS USED - R0,R1,R2,R3,R4,R5.
;
FIND00:	MOV	USR,R1		;START LOOKING AT BEGINNING OF TEXT
FIND01:	SRCHLF			;GO TO START OF LINE
1$:	CMP	R1,ENDTXT
2$:	BHIS	FIND05		;JUMP IF END OF TEXT
	MOV	R0,-(SP)	;SAVE LINE NUMBER
	MOV	R1,-(SP)	;SAVE LINE POINTER
	ATOI			;GET LINE NUMBER FROM TEXT
	MOV	(SP)+,R1	;RESTORE LINE POINTER
	MOV	R0,R2
	MOV	(SP)+,R0
	CMP	R0,R2		;DO LINE NUMBERS MATCH?
	BEQ	FIND03		;YES
	BGT	FIND01		;KEEP LOOKING
FIND02:	CCC			;SET NOT EQUAL
FIND03:	RTS	PC
FIND05:	CCC
	SEV			;SET OVERFLOW ON OVERFLOW
	RTS	PC
	.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:	TST	R0		;DIM .LT. 0?
	BLT	FIND02		;YES
	CMP	R0,#377		;GREATER THAN 255?
	BGT	FIND02		;YES
	SEZ			;SET EQUAL CODE IF IN BOUNDS
	RTS	PC
	.SBTTL	GET00 - GET PARAMETERS FOR COMMAND
;
; GETNUM - GET00, GET PARAMETERS FOR COMMAND
;  R1 POINTS TO START OF USER AREA, R3 RETURNS FIRST PARAMETER, R4
;  RETURNS SECOND.  REGISTERS USED - R0,R1,R2,R3,R4.
;
GET00:	CLR	R4		;INITIALIZE R4 (2ND PARAM)
	SKIP			;GET ONE CHARACTER
	TSTCH			;IS IT NUMERIC
	BNE	GET01		;NO, LOOK FOR DASH (MINUS)
	DEC	R1		;YES, REPOSITION CHARACTER POINTER
	ATOI			;CONVERT FIRST ARGUMENT
	MOV	R0,-(SP)	;SAVE IT
	SKIP			;GET THE SEPARATOR
GET04:	CMP	#'-,R2		;IS IT A REAL SEPARATOR?
	BNE	GET02		;NO
	SKIP
	CMP	#'*,R2		;IS SECOND PARAM '*'
	BNE	1$		;IF NOT, DO NUMBER CONVERSION
	MOV	#77777,R4	;PUT MAX + INTEGER IN R4 (2ND PARAM)
	BR	GET03		;AND LEAVE
1$:	DEC	R1
	ATOI			;CONVERT SECOND ARGUMENT
	MOV	R0,R4
GET03:	MOV	(SP)+,R3	;SET UP FIRST ARGUMENT
	RTS	PC
GET01:	CLR	-(SP)		;NO ARGUMENTS
	CMPB	R2,#'*		;HIGHEST LINE # ?
	BNE	1$		;IF NOT, SKIP
	SKIP			;IF IT WAS, GET NEXT CHAR
	MOV	#77777,R4	;SET UP MAX IN 2ND AND
	MOV	R4,(SP)		;FIRST PARAM
1$:	BR	GET04
GET02:	DEC	R1		;LEAVE POINTER IN POSITION IN CASE COMMA
	BR	GET03

	.SBTTL	SAVE00 - LIST PROGRAM ON "SAVE" DATASET
;+2
; .SKIP
; .X ^^SAVE\\
; .X ^PROGRAM SAVE
; .INDENT -5
; ^^
; SAVE _<STRING FILESPEC> [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).
; ^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
	JSR	PC,CSINT0	;GET FILE SPECS IN CSDSPT
SAVE02:	MOV	R0,-(SP)	;TEMP SAVE R0
	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
	MOV	(SP)+,R0	;RESTORE R0
	JMP	SAVFER		;GO TO ERROR ROUTINE
SAVE03:	MOV	#SOTPT,OTPT	;INDICATE SAVE IN PROGRESS
	MOV	(SP)+,R0	;RESTORE R0
	JMP	LIST00
	.SBTTL	OLD00 - RESTART ON OLD FILE
;+2
; .SKIP
; .X ^^OLD\\
; .X ^PROGRAM RETRIEVE
; .INDENT -5
; ^^
; OLD _<STRING FILESPEC[/RT]>
; \\
; .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\\
; .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
	CLR	LSTLIN		;INIT LAST LINE NUMBER
	MOV	#OLDSWT,R2	;SWITCH TABLE ADDRESS IN R2
	CLR	REMTRM		;CLEAR THE REMARK TRIM FLAG
	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
	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+6,R0	;MAKE R0 POINT TO START OF NAME IN FNB
	MOV	#COMFNB+6,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
	MOV	R5,LASTR1	;INITIALIZE POINTER FOR LAST R1
	INC	R5		;LEAVE ORIGINAL LF
	MOV	R5,ENDTXT	;SAVE 
	CLR	LINENO		;CLEAR LINE NUMBER
	RTS	PC		;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]>
; \\
; .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 SWITCH ARE THE SAME AS FOR THE 
; ^^OVERLAY\\ COMMAND.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
; 	20 CHAIN "PROG2"
; \\
; .FILL
;-
;
CHAIN0:	MOV	#1,RUNF		;SET THE RUN FLAG
	CLR	DATI		;CLEAR THE DATA POINTER
	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:	MOV	#4,R4		;GOSUB POINTER LENGTH -> R4
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:	MOV	#16,R4		;SIZE OF FOR ITEM
	BR	CHN03		;GO CRUNCH IT
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:	ADD	4(R3),R3	;ADD BUFFER LEN
	ADD	#S.FDB+30,R3	;PLUS FDB AND CONTROL BLOCK
	BR	CHAIN1		;AND LOOK AGAIN
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]>
; \\
; .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 /^R^T SWITCH IS THE SAME AS FOR THE ^^OLD\\ COMMAND.
; .BREAK
; ^EXAMPLE:
; .NOFILL
; ^^
; 	OVERLAY "PATCH1"
; 	100 OVERLAY "PATCH2.BAS/LI:500"
; \\
; .FILL
;-
;
	.PSECT	IMPUR3
NEWLIN:	.WORD	0
REMTRM:	.WORD	0		;REMARK TRIM FLAG
	.PSECT	BASIC3
OVLSWT:	CSI$SW	LI,,,,,LINSWT
OLDSWT:	CSI$SW	RT,1,REMTRM
	CSI$ND
LINSWT:	CSI$SV	DECIMAL,NEWLIN,2
	CSI$ND
OVL00:	CLR	NEWLIN		;CLEAR OPTIONAL NUMBER
	CLR	LSTLIN		;CLEAR LAST LINE INSERTED
	MOV	USR,LASTR1	;AND INIT INSERTION POINT
	JSR	PC,FNAME	;GET FILENAME STRING DESCRIPTORS
	BNE	1$		;IF OK, BRANCH
	CSIERR
1$:	MOV	#OVLSWT,R2	;SPECIFY SWITCH TABLE
	CLR	REMTRM		;CLEAR REMARK TRIM SWITCH
	JSR	PC,CSINT0	;INTERPRET FILE NAME STRING
	TST	NEWLIN		;LINE SPEC'D?
	BLE	2$		;IF NOT, BRANCH
	MOV	NEWLIN,LINENO	;IF SO, PUT IT AWAY
	BR	3$
2$:	INC	LINENO		;CONTINUE WITH OLD LINE NO. +1
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	ENDUSR,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
	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
;
	.PSECT	IMPUR3
	.GLOBL	OP.MXL		;GLOBAL DEFINED AT TKB TIME FOR MAX # OF LUNS
OP.LEN:	.WORD	0		;BUFFER FOR FILE LENGTH
OP.LUN:	.WORD	0		;BUFFER FOR LUN
OP.EOF:	.WORD	0		;BUFFER FOR EOF LINE NUMBER
OP.RAC:	.WORD	0		;RECORD ACCESS WORD
OP.RTP:	.WORD	0		;RECORD TYPE WORD
FDBSAV:	.WORD	0
;
; 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	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
;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
	BIS	#140000,R0	;SET DATA TYPE
	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	R2,-(SP)	;SAVE R2
	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
	MOV	(SP)+,R2	;RESTORE R2
	BCC	OPEN08		;IF OPEN OK GO ADD BUFFER LEN
	OPENER			;REPORT FCS ERROR
OPEN08:	ADD	OP.LEN,R5	;ADJUST R5
	ADD	#2,R5		;ADD IN WORD FUDGE
	MOV	R5,ENUDAT	;MAKE IT PERMANENT
	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:	BIS	#140000,R4	;SET FILE MASK
	MOV	STUDAT,R3	;GET STACK ADDRESS
	SRLST			;FIND FILE
	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	R0,-(SP)	;SAVE R0
	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
	MOV	(SP)+,R0	;RESTORE R0
	BCC	1$		;IF NO ERROR, DON'T REPORT
	CLOSER			;REPORT FCS ERROR
1$:	MOV	4(R3),R4	;MAX BC
	ADD	#S.FDB+30,R4	;CALC FILE BLOCK SIZE
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	SCRNCH			;DELETE IT
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	TST	@PC		;SET NON0 CONCODES (OK CLOSE)
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

	.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
	BIS	#140000,R4	;SET FILE TYPE
	MOV	STUDAT,R3	;GET STACK ADDRESS
	SRLST			;FIND FILE
	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)
	CMPB	(R1)+,#',	;BUMP R1 PAST COMMA IF PRESENT
	BEQ	FNMB06		;AND CHECK THAT ACCESS IS SEQ.
	CMPB	-(R1),#''	;IS CHAR A SINGLE QUOTE
	BEQ	FNMB07		;IF SO, PROCESS
	BR	FNMB06		;OTHERWISE MAKE SURE SEQUENTIAL
FNMB03:	RTS	PC		;AND RETURN
FNMB04:	FNMERR			;FILE NUMBER ERROR
FNMB06:	BIT	#2000,-2(R3)	;IS RANDOM BIT SET
	BNE	FNMB04		;IF SO, AN ERROR
	BR	FNMB03		;RETURN
FNMB07:	INC	R1		;BUMP PAST '
	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

	.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,R3,R4.
;
PRLN00:	SUB	#10,SP		;DESTINATION
	MOV	SP,R0		;  IS ON THE STACK
	MOV	LINENO,R1	;SOURCE
	ITOA			;CONVERT TO ASCII
	MOV	SP,R0		;PRINT THE RESULTING
	PRINTL			;PRINT NUMBER
	ADD	#10,SP		;RESTORE THE STACK
	RTS	PC
	.SBTTL	TWO00 - PACK NEXT TWO CHARACTERS IN R4
;
; TWOCHR - TWO00, PACK NEXT TWO CHARACTERS IN R4.
;	REGISTERS USED - R1,R2,R4.
;
TWO00:	SKIP			;GET FIRST CHARACTER
	MOV	R2,R4		;PUT IT IN
	SWAB	R4		; HIGH BYTE OF R4
	SKIP			;GET SECOND CHARACTER
	BIS	R2,R4		; AND PACK IT TOO.
	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:	MOV	ENDTXT,R5
	JSR	PC,ATTACH	;ATTACH THE TERMINAL
LIST14:	GETNUM			;GET THE PARAMETERS
	MOV	R1,-(SP)	;SAVE COMMAND TEXT POINTER
	MOV	R3,R0
	BNE	LIST03
LIST05:	MOV	USR,R3
	INC	R3		;SKIP PAST FIRST <LF>
	TST	R4		;IS SECOND PARAMETER ZERO ALSO?
	BNE	LIST07		;NO
LIST04:	MOV	R5,R4
	BR	LIST15		;CHECK IF NOTHING TO LIST
LIST01:	MOVB	(R3)+,R2	;GET CHARACTER
	BIC	#177400,R2	;CLEAR OUT SIGN EXTEND
	CMPB	R2,#140		;IS IT A PACKED VERB?
	BLO	LIST08		;JUMP IF NOT
	SUB	#140,R2		;GENERATE VERB NUMBER
	MOV	#INIT11,R0	;GET PROTOTYPE LIST
	MOV	R2,R1
LIST09:	DEC	R1		;DECREMENT VERB COUNT
	BLT	LIST11		;IF FOUND GO PRINT THE VERB
LIST10:	CMPB	(R0)+,#'$	;FIND PROTOTYPE END TO GET TO
	BNE	LIST10		; THE NEXT
	BR	LIST09		;  VERB IN THE LIST
LIST11:	MOVB	(R0)+,R2	;GET A CHARACTER
	CMPB	R2,#'$		;QUIT IF END OF PROTOTYPE
	BEQ	LIST01
	PRINTC			;OTHERWISE TYPE THE CHARACTER
	BR	LIST11
LIST08:	CMPB	R2,#S.EOL	;LINE TERMINATOR?
	BEQ	LIST02
	PRINTC
	BR	LIST01		;RE-LOOP
LIST02:	CRLF			;OUTPUT <CR,LF>
LIST15:	CMP	R3,R4
	BLO	LIST01
	MOV	(SP)+,R1	;GET COMMAND TEXT POINTER
	SKIP
	CMP	R2,#',		;MORE LINES SPECIFIED?
	BEQ	LIST14		;IF SO, TAKE CARE OF THEM
	CLOSEF			;IN CASE A SAVE
	JSR	PC,DETACH	;NULLIFY ^O
	DEC	R1		;BACK UP TO END OF STATEMENT
	JMP	INIT02		;GO BACK TO INTERPRETER
LIST03:	MOV	R4,-(SP)	;SAVE R4
	FINDLN			;FIND START LINE
	BEQ	1$		;IF FOUND EXACT LINE, BRANCH
	MOV	(SP)+,R4	;RESTORE SECOND PARAM
	BEQ	LIST02		;IF ZERO, NO PRINTOUT
	BR	2$		;OTHERWISE, CONTINUE
1$:	MOV	(SP)+,R4	;RESTORE R4
2$:	CMP	R1,R5		;NO SUCH LINE?
	BLOS	3$		;IF NOT AT END OF PROG, BRANCH
	MOV	USR,R0		;GET START OF USER STORAGE
	INC	R0		;PUSH PAST FIRST <LF>
	CMP	R1,R0		;AT START (NO CODE)?
	BLOS	LIST02		;IF SO, ALSO NO OUTPUT
	MOV	R2,R0		;IF SO, PUT LAST LINE # IN R0
	BR	LIST03		;AND GO SEARCH FOR IT
3$:	MOV	R1,R3		;START ADDRESS TO R3
LIST07:	CMP	R4,R0		;CHECK LAST ARGUMENT AGAINST FIRST
	BLE	LIST06		;JUMP IF .LE. FIRST ARGUMENT
	MOV	R4,R0
	MOV	R3,-(SP)	;
	FINDLN			;GET POSITION OF SECOND LINE
	BNE	LIST12
	MOV	(SP)+,R3
	CMP	R1,R5		;AT END OF TEXT?
	BHI	LIST04		;YES
LIST06:	SRCHLF			;NO, FIND END OF CURRENT LINE
LIST13:	MOV	R1,R4
	BR	LIST15
LIST12:	MOV	(SP)+,R3
	CMP	R1,R5
	BHI	LIST04
	BR	LIST13
;

	.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:	MOV	R1,-(SP)	;SAVE TEXT POINTER FROM HARM
	JSR	PC,UPUSRD	;MOVE UP USER DATA TO END OF RW CORE
	MOV	(SP)+,R1	;GET BACK OUR TEXT POINTER
	MOV	ENDTXT,R5	;AND PUT END OF TEXT IN R5
DEL04:	GETNUM			;GET THE PARAMETERS
	MOV	R1,-(SP)	;SAVE COMMAND TEXT POINTER
	MOV	USR,R1		;SET TO START OF USER AREA
	TST	R4		;IS SECOND PARAMETER PRESENT?
	BNE	DEL05		;YES
	MOV	R3,R4		;NO
	BEQ	DEL06		;IF BOTH ZERO, THEN DELETE ALL
DEL05:	MOV	R4,-(SP)	;R4=SECOND PARAMETER
	MOV	R3,-(SP)	;R3=FIRST PARAMETER
DEL01:	SRCHLF			;FIND THE NEXT LINE
DEL03:	CMP	R1,R5		;ALL DONE?
	BHIS	DEL02		;YES
	MOV	R1,-(SP)	;SAVE POINTER
	ATOI
	MOV	(SP)+,R1	;RESTORE IT
	CMP	R0,@SP		;COMPARE LINE NUMBERS
	BLT	DEL01
	CMP	R0,2(SP)	;COMPARE WITH END OF LIST
	BGT	DEL02
	SQUISH			;DELETE ONE LINE
	BR	DEL03
DEL02:	CMP	(SP)+,(SP)+	;POP TWO WORDS FROM STACK
	MOV	(SP)+,R1	;RESTORE COMMAND TEXT POINTER
	SKIP
	CMPB	R2,#',		;MORE LINES?
	BEQ	DEL04		;IF SO, TAKE CARE OF THEM
	DEC	R1		;BACK UP POINTER TO END OF STATEMENT
DEL07:	JMP	INIT02
DEL06:	JSR	PC,CLRTXT	;CLEAR ALL USER TEXT THE EASY WAY
	BR	DEL07

	.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	INIT20		;JUMP IF YES
	CMPB	#S.EOL,R2	;IS IT A LINE FEED
	BEQ	INIT03		;JUMP IF YES
	ILCERR			;ILLEGAL CHARACTER TERMINATING STMT.
INIT03:	TST	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
INIT13:	CMP	R1,ENDTXT	;IS THE TEXT POINTER TOO FAR ALONG?
	BHIS	INIT26		;STOP IF SO
	ATOI			;FIND REAL LINE NUMBER
	MOV	R0,LINENO
	CLR	STCOUN		;SET STATEMENT COUNT TO ZERO
	BR	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
	CMPB	@R1,#S.EOL	;CALL IT A DELETE IF NO
	BNE	INIT05
	FINDLN			;FIND THE LINE NUMBER
	BNE	INIT04		;NO SUCH LINE
	SQUISH			;FOUND,DELETE IT
	BR	INIT04
INIT05:	MOV	R1,R3		;SAVE THE TEXT POINTER
	SKIP			;CHECK FOR SHORTIE PRINT
	CMPB	R2,#'?
	BNE	INIT28		;SKIP IF NOT
	MOV	R3,-(SP)	;MUST SWAP REGS
	MOV	R1,R3
	MOV	(SP)+,R1
	MOV	#S.PRIN-140,R2	;SET CODE
	BR	INIT14		;GO PROCESS
INIT28:	MOV	R3,R1		;RESTORE TEXT POINTER
	MOV	#INIT11,R0	;GET ADDRESS OF PROTOTYPES
	CLR	R2		;CLEAR JUMP POINTER FLAG
INIT06:	CMPB	(R3)+,#' 	;IS CHARACTER A SPACE?
	BEQ	INIT06		;IGNORE SPACES
1$:	CMPB	-(R3),(R0)+	;DOES CHARACTER MATCH PROTOTYPE
	BEQ	2$		;IF SO, BRANCH
	CMPB	-1(R0),#40	;WAS LAST PROTOTYPE CHAR A SPACE?
	BNE	INIT08		;IF NOT, TRY NEXT PROTOTYPE
	INC	R3		;BACK UP AND
	BR	1$		;TRY AGAIN
2$:	INC	R3		;YES, GET NEXT CHARACTER
	CMPB	@R0,#'$		;IS NEXT CHARACTER THE TERMINATOR?
	BEQ	INIT14		;IF SO, EXIT SUCCESSFULLY
	BR	INIT06		;GO BACK
INIT08:	CMPB	(R0)+,#'$	;SKIP TO START OF NEXT
	BNE	INIT08		;  PROTOTYPE
	CMPB	@R0,#'$		;TWO IN A ROW?
	BEQ	INIT09		;YES, END OF LIST
	MOV	R1,R3		;RESET TEXT POINTER
	INC	R2		;INCREMENT JUMP POINTER
	BR	INIT06		;RE-LOOP
INIT20:	INC	STCOUN		;INCREMENT STATEMENT POSITION COUNT
INIT10:	MOV	STUDAT,R4	;GET START OF USER DATA IN R4
	MOV	R4,R3		;CALCULATE DIFFERENCE BETWEEN IT
	SUB	ENDTXT,R3	;AND END OF TEXT. IF ONE
	DEC	R3		;OR ZERO
	BLE	2$		;IT'S OK
	MOV	ENDTXT,R2	;ELSE WE MUST MOVE IT
	INC	R2		;ROUND UP END OF TEXT
	BIC	#1,R2
	MOV	R2,STUDAT	;AND MAKE THIS START OF DATA
	MOV	ENUDAT,R0	;CURRENT END OF USER DATA IN R0
	SUB	R4,R0		;CALCULATE LEN OF USER DATA
	ASR	R0		;MAKE IT WORDS
	BEQ	3$		;IF NONE, SKIP MOVE
4$:	MOV	(R4)+,(R2)+	;MOVE IT ALL DOWN
	SOB	R0,4$
3$:	MOV	R2,ENUDAT	;SAVE NEW END OF USER DATA
2$:
	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
INIT09:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	GETVAR			;TRY FOR VARIABLE
	BVC	INIT30		;GO TRY FOR "="
INIT31:	UNRERR			;WHAT IS THIS ANYWAY?
INIT30:	CMPB	R2,#'=		;IS NEXT CHAR "="
	BEQ	1$		;IF SO, OK
	CMPB	R2,#S.EOL	;AT END OF LINE?
	BEQ	INIT31		;IF SO, ERROR
	SKIP			;GET NEXT CHAR
	BR	INIT30		;AND TRY AGAIN
1$:	MOV	(SP)+,R4	;RESTORE TEXT POINTER TO R4
	BR	INIT18		;PROCEED CHECKING LINE
INIT14:	ADD	#140,R2		;GENERATE SPECIAL BYTE
	MOVB	R2,(R1)+	;STORE IT IN THE TEXT
	MOV	R1,R4		;REMEMBER PLACE IN LINE
INIT15:	MOVB	@R3,(R1)+	;PACK
	CMPB	(R3)+,#S.EOL	; LINE UP TIGHT
	BNE	INIT15
	TST	REMTRM		;ARE WE TRIMMING REMARK STATEMENTS?
	BEQ	1$		;IF NOT, SKIP FURTHER CHECK
	CMP	R2,#S.EXC	;IS VERB "!"
	BEQ	2$		;IF SO, GO PROCESS
	CMP	R2,#S.REM	;IS IT REGULAR REM
	BNE	1$		;IF NOT, SOME OTHER STATEMENT
2$:	MOVB	#S.EOL,(R4)	;TRIM THE LINE
	BR	INIT18		;AND GO FINISH PROCESSING
1$:	CMP	R2,#S.IF	;IS THIS LINE AN "IF"?
	BNE	INIT18		;NO, EXIT.
	MOV	R4,R1		;START SCAN FOR "THEN"
INIT16:	SKIP			;NEXT TEXT CHAR
	DEC	R1		;BACK IT UP
	JSR	PC,SKPQT	;SKIP OVER QUOTED STRINGS
	SKIP
	CMPB	R2,#'T		;IT STARTS WITH A "T"
	BNE	INIT17
	SKIP
	CMPB	R2,#'H		;FOLLOWED BY AN "H"
	BNE	INIT17
	SKIP
	CMPB	R2,#'E		;THEN AN "E"
	BNE	INIT17
	SKIP
	CMPB	R2,#'N		;FINALLY AN "N"
	BNE	INIT17		;GO BACK AND SCRUNCH IT TOO
INIT21:	SKIP			;MAKE LEADING BLANKS SAFE
	DEC	R1		;BEFORE MODIFYING STATEMENT
	MOV	R1,R4		;THIS KEEPS ME FROM AN INFINITE LOOP
	TSTCH			;IF THE "THEN" IS FOLLOWED BY A
	BEQ	INIT18		;  NUMBER IT IS LEGAL
	JMP	INIT05
INIT17:	CMPB	R2,#S.EOL	;END OF LINE?
	BEQ	INIT27		;NO
	CMPB	R2,#S.CON	;ALTERNATE END OF LINE?
	BNE	INIT16		;NO
INIT18:	MOV	R4,R1		;RESET THE POINTER

INIT23:	JSR	PC,SKPQT	;SKIP OVER QUOTED STRINGS
	CMPB	(R1)+,#S.CON	;NO, IS IT A STATEMENT SEPARATOR?
	BEQ	INIT21		;YES
	CMPB	-(R1),#S.EOL	;THEN IS IT A TERMINATOR?
	BEQ	INIT22		;YES
	INC	R1		;ADVANCE
	BR	INIT23		;CONTINUE
INIT25:	INC	R1		;NO
	RTS	PC
SKPQT:	CMPB	@R1,#'"		;START OF STRING CONSTANT
	BEQ	INIT24		;GO SKIP IF SO
	RTS	PC		;ELSE RETURN
INIT24:	INC	R1
	CMPB	@R1,#'"		;IS THIS THE SECOND "?
	BEQ	INIT25		;YES
	CMPB	@R1,#S.EOL	;NO, END OF LINE?
	BNE	INIT24		;NO
	UNMERR			;UNMATCHED QUOTES IN LINE
INIT22:	INC	R1
INIT27:	MOV	R1,R3		;SAVE END OF LINE POINTER
	MOV	WORK,R1		;YES, CONTINUE MAIN LOOP
	SKIP			;GET FIRST CHARACTER
	TSTCH			;IS IT NUMERIC?
	BEQ	ASSM00		;YES, GO ASSEMBLE LINE
	DEC	R1		;OTHERWISE DO IT IMMEDIATELY
	CLOSEF			;CLOSE OFF IF FROM OLD
	JMP	INIT10
	.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,ENDUSR	;AT TOP ALREADY?
	BHIS	3$		;IF SO, WE'RE DONE
	MOV	ENDUSR,R4	;END OF CORE IN R4
	MOV	ENUDAT,R2	;CURRENT END OF USER DATA IN R2
	MOV	R2,R1		;CALCULATE LENGTH OF USER DATA
	SUB	STUDAT,R1	;IN R1
	ASR	R1		;IN WORDS
	BEQ	4$		;IF ZERO, SKIP MOVE
5$:	MOV	-(R2),-(R4)	;MOVE THEM ALL UP
	SOB	R1,5$
4$:	MOV	ENDUSR,ENUDAT	;SAVE NEW END OF USER DATA
	MOV	R4,STUDAT	;AND START
3$:	RTS	PC
ASSM00:	JSR	PC,UPUSRD	;MOVE UP USER DATA TO TOP OF CORE
	MOV	WORK,R1		;GET STORAGE ADDRESS
	SUB	R1,R3		;GET LINE LENGTH
	MOV	R3,-(SP)	;SAVE IT
	ATOI			;ASCII TO INTEGER IN R0
	TST	R0		;IS LINE NUMBER ZERO?
	BEQ	ASSM02		;YES, DISALLOWED
	MOV	R0,-(SP)	;SAVE LINE NUMBER
	CMP	#OINPT,INPT	;IS THIS FROM OLD FILE?
	BNE	1$		;IF NOT, DO IT REGULAR
	CMP	LSTLIN,R0	;ARE WE IN ORDER
	BGE	1$		;IF NOT, DO IT REGULAR
	MOV	LASTR1,R1	;IF SO, WE CAN SHORTEN SEARCH
	DEC	R1		;MAKE SURE WE FIND AT LEAST 1 LF
	JSR	PC,FIND01
	BR	2$
1$:	FINDLN			;LOOK FOR LINE NUMBER IN TEXT
2$:	BNE	ASSM01		;DON'T DELETE LINE
	SQUISH			;DELETE TEXT LINE TO TERMINATOR
ASSM01:	MOV	(SP)+,LSTLIN	;SAVE LAST LINE NUMBER
	MOV	(SP)+,R3	;RESTORE LINE LENGTH
INS00:	MOV	ENDTXT,R5	;END OF TEXT IN R5
	MOV	STUDAT,R0	;START OF USER DATA IN R0
	SUB	R5,R0		;AVAILABLE ROOM IN R0
	CMP	R3,R0		;COMPARE WITH NEEDED ROOM
	BLT	INS01		;IF OK, BRANCH
	OVFERR			;OVERFLOW ERROR
INS04:	ADD	R3,R5		;UPDATE TEXT POINTER
	MOV	R5,ENDTXT	;SAVE FOR RESTART
	BR	INS05
INS01:	CMP	R1,R5		;IS POINTER AT END OF TEXT?
	BHIS	INS04		;JUMP IF YES
	MOV	R5,R2
	ADD	R3,R5		;MOVE STORAGE POINTER
	MOV	R5,ENDTXT	;SAVE FOR RESTART
	MOV	R5,R4
INS02:	MOVB	-(R2),-(R4)	;SHIFT THE TEXT AROUND
	CMP	R1,R2		;DONE?
	BLOS	INS02		;NO, DO IT AGAIN
INS05:	MOV	WORK,R2
INS03:	MOVB	@R2,(R1)+	;INSERT NEW TEXT
	CMPB	(R2)+,#S.EOL	;CHECK FOR LINE TERMINATOR
	BNE	INS03
	MOV	R1,LASTR1	;SAVE INSERTION POINT
	JMP	INIT04		;BACK FOR NEXT LINE
ASSM02:	LNNERR			;BAD LINE NUMBER
	.SBTTL	DATASET ERROR ROUTINES
;
; DATASET ERROR ROUTINES
;
OLDFER:
SCRFER:
SAVFER:	MOV	#COMFDB,-(SP)
;COMMON CODE
FILER:	MOV	#FILELN,R0	;PRINT ERROR MESSAGE
	PRINTL
	MOV	(SP)+,R0	;GET FDB POINTER FROM STACK
	MOV	LINENO,-(SP)	;SAVE LINE NUMBER
	MOVB	F.ERR(R0),R0	;PRINT ERR CODE USING PRNTLN
	MOV	R0,LINENO	;BUT EXTEND ERROR SIGN TO WORD
	PRNTLN
	MOV	(SP)+,LINENO	;RESTORE LINE NUMBER
	MOV	#FILEL2,R0	;PRINT 2 PART
	PRINTL
	PRNTLN			;AND LINE NUMBER
	CRLF			;NEXT LINE
	CLR	LINENO		;RESET
	JMP	INIT00		;RETURN TO COMMAND INTERP
FILELN:	.ASCIZ	/**FILE ERROR=/
FILEL2:	.ASCIZ	/ AT LINE /
	.EVEN

	.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
	.ASCII	/NAME/<44>	;NAME WITH TRAILING $
	.IIF	NB,VDEF,VDEF=S.MAX ;DEFINE OPTIONAL VERB SYMBOL
	.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 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		IF00	S.IF
	VERBDF	GOTO		GOTO00
	VERBDF	FOR		FOR00
	VERBDF	NEXT		NEXT00	S.NEXT
	VERBDF	GOSUB		GOSB00
	VERBDF	RETURN		RET00
	VERBDF	!		REM00	S.EXC
	VERBDF	REM		REM00	S.REM
	VERBDF	PRINT		PR00	S.PRIN
	VERBDF	<INPUT LINE>	INP01
	VERBDF	INPUT		INP00
	VERBDF	READ		READ00
	VERBDF	SET		SET00
	VERBDF	<ON ERROR GOTO>	ONG00
	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	CON		CON00
	VERBDF	RANDOMIZE	RND01
	VERBDF	STOP		STOP00
	VERBDF	END		STOP00
	VERBDF	STEP		STEP00
	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
	.ASCII	/$/
	.EVEN

	.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
; \\
; .FL
;-
	.SBTTL	BASIC BREAK AST ENTRY ROUTINE
;+1
; .SL
; .ID -5
; ^CONTROL ^B
; .BR
; .X _^^B
; .X ^CONTROL ^B
; ^THE BREAK KEY FOR ^^BASIC\\ IS THE ^CONTROL-^B (_^^B).
; ^THIS FUNCTION OPERATES THROUGH THE TELETYPE HANDLER WHICH
; CALLS THE ^^BASIC\\ TERMINATOR TASK (^^BASTER\\) WHICH IN TURN
; SENDS A DUMMY DATA BLOCK TO THE ^^BASIC\\ INTERPRETER ITSELF.
; ^THIS CAUSES A RECEIVE DATA ^^AST\\ TO BE EXECUTED WHICH SETS
; A FLAG WHICH CAUSES A STOP TO HAPPEN ON THE NEXT LINE.
;-
;
; AST ENTRY FOR ^B BREAK ROUTINE
; DATA IS SENT TO "...BAS" BY A TASK "BASTER" INVOKED BY ^B TO TT16
;
	.PSECT	IMPUR3
	.IF	DF	RSX11D
DUMBUF:	.BLKW	3	;DUMMY BUFFER FOR DATA
	.PSECT	BASIC3
RCVDPB:	VRCD$	BASTER,DUMBUF,1	;RECEIVE A 1 WORD DATA BUFFER
	.IFF
DUMBUF:	.BLKW	15.
	.PSECT	BASIC3
RCVDPB:	RCVD$	,DUMBUF
	.ENDC
BRKENT:	DIR$	#RCVDPB		;ACTUALLY DO IT
CTCENT:	INC	BRFLAG
	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
; \\
; .FL
;-
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	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
; \\
; .FL
;-

	.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
; \\
; .FL
;-
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
; \\
; .FL
;-
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
; \\
; .FL
;-
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	VARIOUS POINTERS AND VARIABLES
;
; SYSTEM VARIABLES DEFINED OR STORED HERE
; USR AND ENDUSR SET UP AT BEGINNING OF PROGRAM
;
	.PSECT	IMPUR3
WORK:	.WORD	0	;TEMP TEXT POINTER SAVE
USR:	.WORD	0	;FIRST WORD OF USER AREA
ENDUSR:	.WORD	0	;LAST  WORD OF USER AREA
LINENO:	.WORD	0	;TEMPORARY LINE NUMBER CELL
STCOUN:	.WORD	0	;STATEMENT POSITION COUNT IN LINE
RUNF:	.WORD	0	;RUN FLAG
BRFLAG:	.WORD	0	;BREAK (^B) FLAG
FPEXFL:	.WORD	0	;FLOATING POINT EXCEPTION FLAGS
ENDTXT:	.WORD	0	;END OF USER TEXT
DATI:	.WORD	0	;DATA STATEMENT POSITION POINTER
RNDM:	.WORD	1	;RANDOMIZE WORD
ENDSTK:	.WORD	0	;BOTTOM OF STACK
STUDAT:	.WORD	0	;START OF USER DATA AREA
ENUDAT:	.WORD	0	;END OF USER DATA AREA
QFLG:	.WORD 	0	;FLAG FOR MCR PRINT
BLSKFL:	.WORD	0	;FLAG FOR BLANK SKIP
LINEFL:	.WORD	0	;FLAG FOR INPUT LINE COMMAND
LINELN:	.WORD	0	;LENGTH OF LINE FOR INPUT LINE
LSTLIN:	.WORD	0	;LAST LINE NUMBER INSERTED
LASTR1:	.WORD	ENDBAS	;CORRESPONDING INSERTION POINT
LASTEX:	.WORD	0	;LAST LINE EXECUTED BEFORE STOP
;
WTUNIT:	.WORD	0	;UNITS FOR WAIT TIMEOUT
WTMAG:	.WORD	0	;CORRESPONDING MAGNITUDE
	.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
	.PSECT	$$$$US
ENDBAS:	.WORD	0		;START OF USER AREA
MSG001:	.ASCII	/RSX BASIC/
	.BYTE	15,12,0
	.EVEN

	.SBTTL	BEGIN - INIT CODE
;
; BASIC INITIALIZATION CODE
;	THIS CODE RESIDES IN THE USER'S AREA AND IS OVERLAYED
;	BY THE USER TEXT AND USER STACK.
;	ONLY ONCE EXECUTED CODE MAY BE HERE!!!!!!!!
;
BEGIN:	LDFPS	#3400		;SET FPP STATUS REG FOR INTERRUPTS
	DIR$	#MCRDPB		;GET MCR COMMAND LINE (JUST TO CLEAR)
	MOV	@#0,MCRCNT	;GET CHAR COUNT FROM DSW
	SVTK$S	#VECTAB,#8.	;SET UP SST VECTOR TABLE
	SRDA$S	#BRKENT		;SPECIFY AST FOR ^B BREAK
	SFPA$S	#FPEXTR		;SPECIFY FLOATING POINT EXCEPTION AST
	FINIT$
	GTSK$S	#TSKPAR		;GET TASK PARAMETERS
	BIC	#1,TSKPAR+32	;MAKE SURE END IS EVEN
	MOV	TSKPAR+32,ENDUSR ;AND PUT IN ITS PLACE
	MOV	ENDUSR,STUDAT	;SET UP USER DATA AREA START
	MOV	ENDUSR,ENUDAT	;AND END
	GLUN$S	#2,#TSKPAR	;GET TERMINAL LUN INFO
	MOV	TSKPAR+12,R1	;LEN OF LINE IN R1
	CMP	#TRMSIZ,R1	;CAN ONLY HANDLE MAX TERMINAL WIDTH
	BGE	1$
	MOV	#TRMSIZ,R1
1$:	MOV	R1,TOTPT+2	;PUT IT IN CONTROL BLOCK FOR OUTPUT
	MOV	R1,TINPT+2	;AND FOR INPUT
	OPEN$W	#TRMFDB,,,,,R1	;OPEN TERMINAL FOR INPUT AND OUTPUT
	MOV	#ENDBAS,USR	;SET BEGINNING OF USER AREA AT END OF CODE
	MOV	USR,R1		;SET UP TEXT POINTER
	MOV	R1,R5		;SET UP USER LIST POINTER
	MOVB	#S.EOL,(R5)+	;WITH LF IN FIRST TEXT BYTE
	MOV	R5,ENDTXT	;SAVE FOR RESTART
	MOV	SP,ENDSTK	;SAVE FOR ZAPPING
	CLR	LINENO		;CLEAR THE LINE NUMBER
	MOV	#MCRDPB+G.MCRB,R1 ;START OF BUFFER -> R1
	MOV	R1,R3		;DUPLICATE START IN R3
	MOV	MCRCNT,R0	;LEN IN R0
	ADD	R0,R3		;R3 POINTS PAST END
2$:	MOVB	(R1)+,R2	;NEXT CHAR IN R2
	CMPB	R2,#40		;LOOK FOR SPACE
	BEQ	3$		;BR IF FOUND
	CMPB	R2,#11		;ELSE IT MIGHT BE TAB
	BEQ	3$		;BR IF FOUND
	SOB	R0,2$		;KEEP LOOKING
	BR	BEGIN1		;NOTHING SPECIAL, SO DO MESSAGE
3$:	SKIP			;GET NEXT NON-BLANK CHAR -> R2
	DEC	R1		;BACK UP POINTER
	CMPB	R2,#'?		;IS IT ONE LINE MCR PRINT
	BEQ	4$		;IF SO, BRANCH
	CMPB	R2,#'@		;ARE WE COMING FROM BATCH?
	BNE	5$		;IF NOT, BRANCH
	INC	R1		;MAKE SURE CSI NOT SCREWED UP
	INC	RUNF		;WE MUST RUN IF BATCH
5$:	SUB	R1,R3		;GET LENGTH OF STRING -> R3
	MOV	R3,R4		;PUT IT IN PROPER REGISTER
	MOV	R1,R3		;ADDRESS IN R3
	MOV	#STRSWT,R2	;STARTING SWITCH TABLE IN R2
	JSR	PC,CSINT0	;INTERPRET COMMAND STRING
	JMP	OLD02		;GO FINISH AS OLD COMMAND
4$:	MOV	#1,QFLG		;SET MCR PRINT FLAG
	MOV	R3,R0		;END ADDRESS -> R0
	MOV	#MCRDPB+G.MCRB+80.,ENDTXT ;DON'T WIPE OUT MCR BUFFER
	MOV	ENDTXT,R5	;SAME GOES FOR R5
	MOV	#S.EOL,(R5)+	;COPY ABOVE PROCEDURE
	MOV	#MCRCNT+4,R2	;FAKE OUT R2 INTO THINKING IT'S
	MOV	R1,MCRCNT	;IN A DATA CONTROL BLOCK
	MOV	#INIT01,-(SP)	;ADDRESS FOR RETURN
	MOV	R0,-(SP)	;JUST TO KEEP STACK STRAIGHT
	JMP	PCK03		;GO CHECK STRING AND EXECUTE
BEGIN1:	MOV	#MSG001,R0	;INITIAL MESSAGE
	PRINTL
	JMP	INIT00
MCRCNT:	.WORD	0		;COUNTER FOR MCR COMMAND LINE BUFFER
MCRDPB:	GMCR$
TSKPAR:	.BLKW	20		;BUFFER FOR TASK PARAMETERS
STRSWT:	CSI$SW	RN,1,RUNF,,,STRSVT
	CSI$SW	RT,1,REMTRM
	CSI$ND
STRSVT:	CSI$SV	DECIMAL,LINENO,2
	CSI$ND

	FSRSZ$	7,512.*6+134.	;ALLOW 6 OPEN FILES AT ONCE (PLUS TERMINAL)
	.END	BEGIN