;*********
;	 *
; BASIC4 *
;	 *
;*********
;
	.TITLE	BASIC4
;
; OBJECT MODULE FOR USER SUBROUTINE CALL PROCESSING
;
; ORIGINAL ENTRY DATE: 22-DEC-76
; AUTHOR: LARRY SIMPSON
;         DEPARTMENT OF MEDICAL PHYSICS
;         MICHAEL REESE MEDICAL CENTER
;
	.SBTTL	MACRO DEFINITIONS AND GLOBAL DECLARATIONS
;
	.PSECT	BASIC4,RW,I,GBL,REL,CON
	.MACRO	TRPSUB	A,B
	.MACRO	A
	JSR	PC,B
	.GLOBL	B
	.ENDM
	.ENDM
;
	TRPSUB	EVAL	EVAL00
	TRPSUB	EVALS	EVLS00
	TRPSUB	GETADR	GTDR00
	TRPSUB	GETSAD	GTSD00
	TRPSUB	SKIP	SKIP00
	TRPSUB	TSTOK	TSTU00
	TRPSUB	CRLF	CRLF00
	TRPSUB	ATOI	ATOI00
	TRPSUB	PRINTC	PRNT00
	TRPSUB	PRINTL	PRN00
	TRPSUB	SRLST	SRL00
;
; GLOBAL SYMBOLS DEFINED HERE
	.GLOBL	GETARG	CALL00	NSTORE	SSTORE	OPLB00
	.GLOBL	PARCHK
;
; GLOBAL REFERENCES TO OTHER MODULES
	.GLOBL	STUDAT	ENUDAT	INIT02	$CAT5	$CBDSG
	.GLOBL	OP.LUN	OP.MXL	CSINT0	FILFN1	INIT02
	.GLOBL	S.EOL	CSDSPT	PARLST	P.FCS
;
; GLOBAL ERROR CODES - DEFINED IN BASIC0
	.GLOBL	ARGERR	CALERR	STOERR	OVFERR	OPLBER
	.GLOBL	OPLFER	TM1ERR	TM2ERR
;
; MACRO CALLS:
	.MCALL	NMBLK$	FDRC$R	FDOP$R	GET$	FDOF$L
;
; DEFINE FDB OFFSETS LOCALLY
FDOF$L
;
; FLOATING POINT REGISTER DEFINITIONS
AC0=%0
AC1=%1
AC2=%2
AC3=%3
AC4=%4
AC5=%5

	.SBTTL	GETARG - ARGUMENT PROCESSING FOR "CALLED" SUBROUTINES
;
; GETARG ROUTINE
; TO RETRIEVE ADDRESSES OR VALUES FROM AN ARGUMENT LIST
; IN A BASIC "CALL" STATEMENT.
; ON ENTRY:	R5 POINTS TO A USER TABLE FOR RESULT TO BE PLACED IN
;		R1 POINTS TO CURRENT POS IN ARG LIST (MUST BE "," OR "(" )
;		R0 POINTS TO LIST OF BYTE ARG TYPES (TERM. BY 0 OR > 4)
; ON RETURN:	R5 POINTS TO THE FIRST WORD PAST THE RETURNED DATA
;		R1 POINTS TO NEXT CHAR FOLLOWING LAST ARG JUST RETURNED
;		R0 POINTS TO FIRST BYTE AFTER TERMINATING BYTE
; ARG TYPES IN R0 LIST:
;		1 = INPUT NUMERIC EXPRESSION	(2 WORDS)
;		2 = OUTPUT NUMERIC TARGET	(3 WORDS) ADDRESS, VALUE
;		3 = INPUT STRING EXPRESSION	(2 WORDS) LEN, ADDRESS
;		4 = OUTPUT STRING TARGET	(3 WORDS) LENMAX, LEN, ADD
;		0 OR > 4 = LIST TERMINATOR
; ALL OTHER REGISTERS WILL BE USED AND DESTROYED
;
GETARG:	MOVB	(R0)+,R4	;ARG TYPE IN R4
	BEQ	ENDARG		;IF ZERO, END OF LIST
	CMP	R4,#4		;SEE IF OTHER TERMINATOR
	BHI	ENDARG		;IF SO, ALSO END
	ASL	R4		;MAKE INTO WORD OFFSET
	JMP	@JMPTBL-2(R4)	;SELECT APPROPRIATE ROUTINE
JMPTBL:	.WORD	INPNUM
	.WORD	OUTNUM
	.WORD	INPSTR
	.WORD	OUTSTR
ENDARG:	RTS	PC
;
; ROUTINE TO CHECK INITIAL DELIMITER AND SAVE REGISTERS
DLMCHK:	SKIP			;GET NEXT CHAR
	CMPB	R2,#',		;COMMA IS OK
	BEQ	1$
	CMPB	R2,#'(		;SO IS OPEN PAREN
	BEQ	1$
	ARGERR			;ANYTHING ELSE IS ERROR
1$:	MOV	(SP)+,R2	;RETURN ADDRESS -> R2
	MOV	R0,-(SP)	;SAVE R0 AND R5
	MOV	R5,-(SP)	;IN CASE USED IN CALLED ROUTINES
	JMP	(R2)		;DO EFFECTIVE RETURN
;
; ROUTINE FOR INPUT NUMERIC
INPNUM:	JSR	PC,DLMCHK	;CHECK DELIMITER AND SAVE REGISTERS
	EVAL			;GET ARG VALUE IN AC0
	BVC	1$		;IF OK, BRANCH
	DEC	R1		;BACK UP OVER CLOSE PAREN
1$:	MOV	(SP)+,R5	;GET BACK ADDRESS TO STORE RESULT
	STF	AC0,(R5)+	;AND STORE IT
	BR	FINUP		;GO AROUND AGAIN
;
; ROUTINE FOR OUTPUT NUMERIC
OUTNUM:	JSR	PC,DLMCHK	;DO INITIAL SET UP
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	GETSAD			;TRY FOR STRING, JUST IN CASE
	BVS	1$		;THIS SHOULD NOT BE A STRING
	ARGERR			;IF SO, ERROR
1$:	MOV	(SP)+,R1	;RESTORE TEXT POSITION
	GETADR			;NOW GET REAL NUMERIC ARG ADDRESS
	MOV	(SP)+,R5	;RESTORE LOCATION TO STORE RESULT
	MOV	R0,(R5)+	;PUT IN ADDRESS
	BNE	2$		;IF NON-ZERO, OK
	ARGERR			;IF ZERO, ERROR
2$:	MOV	(R0)+,(R5)+	;NOW MOVE IN VALUE
	MOV	(R0)+,(R5)+
FINUP:	MOV	(SP)+,R0	;RESTORE R0 LIST POINTER
	BR	GETARG		;AND LOOK FOR NEXT ARGUMENT
;
; ROUTINE FOR INPUT STRING
INPSTR:	JSR	PC,DLMCHK	;INITIAL SET UP
	EVALS			;GET THE STRING
	BVC	1$		;IF OK, BRANCH
	ARGERR
1$:	MOV	R3,R5		;SAFE GUARD THE RESULT
	ADD	R4,R5		;IN USER STORAGE
	INC	R5
	BIC	#1,R5
	MOV	R5,ENUDAT
	MOV	(SP)+,R5	;GET BACK LIST POINTER FOR RESULT
	MOV	R4,(R5)+	;PUT IN LENGTH
	MOV	R3,(R5)+	;AND ADDRESS
	BR	FINUP
;
; ROUTINE FOR OUTPUT STRING
OUTSTR:	JSR	PC,DLMCHK	;INITIAL SET UP
	GETSAD			;GET THE ADDRESS OF THE STRING
	BVC	1$		;BRANCH IF OK
	ARGERR			;ELSE ARG ERROR
1$:	DEC	R1		;BACK UP TEXT POINTER (IT WAS TOO FAR)
	MOV	(SP)+,R5	;RESTORE LIST POINTER FOR RESULT
	MOV	(R3),(R5)+	;PUT IN MAX LEN AND TYPE INFO
	MOVB	-1(R0),(R5)+	;PUT IN ACTUAL LENGTH
	CLRB	(R5)+		;CLEAR HIGH BYTE
	MOV	R0,(R5)+	;STRING ADDRESS IN
	BR	FINUP
;
; SUBROUTINE GTRGPI
; TO ENABLE POSITION INDEPENDENT ARGUMENT RETRIEVAL FOR USER LOADED
; ROUTINES. THE ARGUMENT TYPE LIST FOLLOWS THE CODE IN A JSR R4,GTPRI
; INSTRUCTION. THE ARGUMENT LIST ITSELF IS CONSTRUCTED ON THE STACK
; AND POINTED TO BY SP ON RETURN.
;
; ON ENTRY:
;	R4 POINTS TO ARG TYPE LIST (VIA JSR R4,@#GTRGPI)
;	OLD R4 ON STACK (WILL BE POPPED)
; ON RETURN:
;	SP POINTS TO ARG LIST (ON STACK - TO BE REMOVED BY CALLING ROUTINE)
; OTHER REGISTERS: POTENTIALLY ALL
;
	.GLOBL	GTRGPI
GTRGPI:
	TST	(SP)+		;POP OLD R4
	MOV	R4,R0		;ESTABLISH ARG TYPE LIST PTR
1$:	MOVB	(R4)+,R3	;GET TYPE
	BEQ	3$		;IF ZERO, END OF LIST
	CMP	R3,#4		;CHECK LIMIT
	BHI	3$		;IF TOO HIGH, ALSO END OF LIST
	SUB	#4,SP		;ADD TWO WORDS TO STACK
	BIT	#1,R3		;CHECK FOR ODD TYPE
	BNE	2$		;IF SO, INPUT (2 WORDS ONLY)
	TST	-(SP)		;ELSE OUTPUT (3 WORDS)
2$:	BR	1$		;GO BACK FOR MORE
3$:	INC	R4		;ROUND R4 UP TO
	BIC	#1,R4		;RETURN ADDRESS
	MOV	SP,R5		;SAVE ARG LIST POINTER
	MOV	R4,-(SP)	;AND SAVE RETURN ADDRESS
	JSR	PC,GETARG	;GO TO NORMAL ROUTINE
	RTS	PC		;AND RETURN TO ADDRESS SAVED ON STACK

	.SBTTL	NSTORE - NUMERIC STORAGE ROUTINE
;
; NSTORE ROUTINE
; TO STORE AWAY A VALUE FROM AC0 INTO A LOCATION
; STORED IN A TABLE SUCH AS THAT FILLED IN BY GETARG.
; ON CALL:	R5 CONTAINS POINTER TO ADDRESS
;		AC0 CONTAINS VALUE TO BE STORED
; ON RETURN:	NOTHING CHANGED
; REGISTERS USED: R0
NSTORE:	BIT	#1,(R5)		;CHECK ADDRESS
	BEQ	1$		;IF EVEN ADDRESS, OK
	STOERR
1$:	JSR	PC,LIMCHK	;CHECK THAT ADDRESS IS IN USER DATA AREA
	STF	AC0,@(R5)	;PUT ADDRESS AWAY
	RTS	PC
LIMCHK:	CMP	(R5),STUDAT	;CHECK AGAINST START OF USER DATA
	BHI	2$		;IF HIGHER, BRANCH
	STOERR
2$:	CMP	(R5),ENUDAT	;CHECK AGAINST END
	BLO	3$		;IF LESS, OK
	STOERR
3$:	RTS	PC

	.SBTTL	SSTORE - STRING STORAGE ROUTINE
;
; SSTORE ROUTINE
; TO TAKE A STRING DESCRIBED BY LEN IN R4 AND ADDRESS IN R3
; AND STORE IT INTO A STRING VARIABLE WHOSE TABLE ENTRY IS
; POINTED TO BY R5.
;
; ON CALL:	R3 = ADDRESS OF STRING TO BE STORED
;		R4 = LENGTH OF STRING TO BE STORED
;		R5 = POINTER TO OUTPUT STRING TABLE ENTRY
;
; ON RETURN:	R3 POINTS PAST END OF STRING
;		R4 = 0
;		R5 POINTS TO NEXT TABLE ENTRY
;
; OTHER REGISTERS USED:	R0,R2 (ALL BUT R1)
;
SSTORE:	CMPB	(R5),R4		;CHECK MAX LEN AGAINST STRING TO BE STORED
	BHIS	1$		;IF GREATER OR EQUAL, OK
	MOVB	(R5),R4		;OTHERWISE PUT IN MAX LEN
	BIC	#177400,R4	;CLEAR OUT HIGH BYTE
1$:	ADD	#4,R5		;POINT TO ADDRESS
	JSR	PC,LIMCHK	;CHECK ON LIMITS
	MOV	(R5),R0		;ADDRESS TO STORE -> R0
	MOV	R4,-2(R5)	;SAVE ACTUAL LENGTH
	TST	R4		;CHECK FOR ZERO LENGTH
	BEQ	5$		;IF ZERO, SKIP TRANSFER
4$:	MOVB	(R3)+,(R0)+	;MOVE IN THE STRING
	SOB	R4,4$
5$:	TSTB	-3(R5)		;CHECK ON STRING TYPE
	BMI	7$		;IF NEG, VARIABLE LENGTH
	MOV	-2(R5),R2	;ACTUAL LENGTH -> R2
	MOVB	-4(R5),R4	;MAX LEN IN R4
	BIC	#177400,R4	;CLEAR HIGH BYTE
	SUB	R2,R4		;R4 HAS DEFICIT TO BLANK FILL
	BEQ	7$		;IF NO DEFICIT, SKIP FILL
	ADD	R4,-2(R5)	;ADJUST ACTUAL LENGTH
6$:	MOVB	#40,(R0)+	;PUT IN BLANK
	SOB	R4,6$
7$:	MOV	(R5)+,R0	;ADDRESS OF STRING -> R0
	DEC	R0		;BACK IT UP
	MOVB	-4(R5),(R0)	;STORE ACTUAL LENGTH
	RTS	PC

	.SBTTL	ARGUMENT COUNT ROUTINE
;
; COUNT ARGUMENTS ROUTINE
; ON ENTRY:	R1 POINTS TO LEADING OPEN PAREN "("
; ON EXIT:	R1 UNCHANGED
;		R0 CONTAINS COUNT OF ARGUMENTS UP TO ")" IN THE LIST
;		   QUOTED STRINGS AND SUBSCRIPTS ARE ACCOUNTED FOR
; OTHER REGISTERS USED: R2
; NOTE:		A LINE FEED WILL TERMINATE THE SCAN IRRESPECTIVE OF
;		ENCLOSING QUOTES AS LONG AS IT IS USED AS THE INTERNAL
;		LINE DELIMITER (S.EOL)
ARGCNT:	MOV	R1,-(SP)	;SAVE SO WE CAN RESTORE LATER
	INC	R1		;BUMP PAST OPEN PAREN
	CLR	R0		;INITIALIZE COMMA COUNT
	CLR	-(SP)		;PAREN COUNTING WORD
	CLR	-(SP)		;CLEAR FLAG INDICATING QUOTED STRING
3$:	MOVB	(R1)+,R2	;CHAR -> R2
	CMPB	R2,#S.EOL	;END OF LINE?
	BNE	1$
	ARGERR
1$:	TST	(SP)		;ARE WE IN STRING?
	BNE	4$		;IF SO, BRANCH
	TST	2(SP)		;INSIDE PARENTHESES?
	BGT	7$		;IF SO, BRANCH
	CMPB	R2,#',		;IS CHAR A COMMA
	BNE	2$		;IF NOT, BRANCH
	INC	R0		;ELSE INCREMENT COUNT
	BR	3$		;AND KEEP LOOKING
2$:	CMPB	R2,#')		;END OF LIST?
	BNE	5$		;IF NOT, TRY FOR QUOTE
	CMP	(SP)+,(SP)+	;POP FLAGS
	MOV	(SP)+,R1	;RESTORE R1
	INC	R0		;COUNT ARGS INSTEAD OF COMMAS
	RTS	PC
5$:	CMPB	R2,#'"		;IS IT START OF QUOTED STRING
	BNE	6$		;IF NOT, TRY NEXT CHAR
	INC	(SP)		;SET FLAG ON STACK
	BR	3$		;AND GET NEXT CHAR
6$:	JSR	PC,OPNPRN	;CHECK FOR OPEN PAREN
	BNE	3$		;IF NOT, TRY SOMETHING NEW
	INC	2(SP)		;SET FLAG
	BR	3$		;AND TRY NEXT CHAR
7$:	JSR	PC,OPNPRN	;ANOTHER OPEN PAREN?
	BNE	8$		;IF NOT, TRY CLOSE PAREN
	INC	2(SP)		;ADD TO NESTED COUNT
	BR	3$
8$:	CMPB	R2,#')		;CLOSE PAREN?
	BNE	3$		;IF NOT, TRY ANOTHER CHAR
	DEC	2(SP)		;IF SO, DECREMENT NESTING COUNT
	BR	3$
4$:	CMPB	R2,#'"		;CLOSING QUOTE?
	BNE	3$		;IF NOT, TRY AGAIN
	CLR	(SP)		;IF SO, CLEAR FLAG
	BR	3$		;AND KEEP TRYING
OPNPRN:	CMPB	R2,#'(		;IS IT REGULAR OPEN PAREN?
	BEQ	1$		;IF SO, GO SET EQUALITY
	CMPB	R2,#S.SFST	;SEE IF IN RANGE OF FCNS WITH ( INCL
	BLO	2$		;IF NOT, GO SET INEQUALITY
	CMPB	R2,#S.NFBO	;CHECK AGAINST END OF FCNS
	BHI	2$		;IF PAST, SET INEQUALITY
1$:	SEZ			;SET EQUALITY (WE HAVE OPEN PAREN)
	RTS	PC
2$:	CLZ			;SET INEQUALITY (NO OPEN PAREN)
	RTS	PC

	.SBTTL	CALL STATEMENT
;+3
; .SL
; .X <CALL
; .X ^SUBOUTINE CALL
; .X ^USER SUBROUTINE CALL
; .ID -5
; ^^
; CALL "NAME"(ARG1,ARG2,...)
; \\
; .BR
; ^THE <CALL STATEMENT IS USED BY THE <BASIC USER TO CALL SPECIALLY
; WRITTEN <MACRO SUBROUTINES WHICH WILL PERFORM SPECIAL FUNCTIONS.
; ^THE ROUTINE WHICH IS CALLED MUST BE ENCLOSED IN QUOTES AS ABOVE,
; OR RESIDE IN A STRING EXPRESSION WHICH IS ENCLOSED IN PARENTHESES.
; ^THE ENCLOSING PARENTHESES ARE NECESSARY TO KEEP THE ARGUMENT LIST
; WHICH FOLLOWS FROM APPEARING AS A SUBSCRIPT TO A STRING VARIABLE.
; ^THE ARGUMENTS CAN BE STRING OR NUMERIC VARIABLES OR EXPRESSIONS.
; ^IN THE CASE THAT A VALUE IS TO BE RETURNED, THE ARGUMENT MUST
; BE A SIMPLE VARIABLE (MAY BE SUBSCRIPTED).
; ^FOR VALUES WHICH ARE PASSED, EITHER EXPRESSIONS OR VARIABLES MAY
; BE USED.
; ^THE VARIABLES AND EXPRESSIONS USED IN THE ARGUMENT LIST MUST
; MATCH THE TYPE (STRING OR NUMERIC) EXPECTED BY THE SUBROUTINE.
; ^THE <NAME MAY BE UP TO 6 CHARACTERS IN LENGTH.
; ^USER ROUTINES MUST PRESERVE THE TEXT POINTER (^R1) AND ON EXIT,
; IF AN ARGUMENT LIST IS PRESENT, MUST POSITION IT JUST PAST THE
; CLOSE PARENTHESIS.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	100 CALL "ABC"(A$,B)
; 	120 CALL (B$)(A-X,Y$+Z$)
; \\
; .F
;-
CALL00:	EVALS			;GET THE NAME OF THE ROUTINE
	BVC	1$
	CALERR
1$:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R3,R0		;ADDRESS IN R0
	ADD	R3,R4		;R4 POINTS PAST END OF STRING
	MOVB	#',,(R4)+	;PUT IN COMMA FOR TERMINATION
	MOV	#1,R1		;'.' IS LEGAL RAD50
	JSR	PC,$CAT5	;DO CONVERSION
	MOV	R1,-(SP)	;SAVE FIRST 3 CHAR ON STACK
	BCC	2$		;IF NOT TERMINATED, BRANCH
	CLR	-(SP)		;OTHERWISE, BLANK OUT 2ND 3 CHARS
	BR	3$
2$:	JSR	PC,$CAT5	;GET 2ND RAD50 WORD
	MOV	R1,-(SP)	;AND PUT IT ON STACK
3$:	MOV	STUEPT,R0	;START OF RAD50 LIST -> R0
6$:	CMP	(R0)+,2(SP)	;FIRST PART MATCH?
	BEQ	4$		;IF SO, CHECK MORE
	TST	(R0)+		;IF NOT, BUMP POINTER
	BR	5$		;AND CONTINUE WITH NO MATCH CODE
4$:	CMP	(R0)+,(SP)	;2ND HALF MATCH?
	BEQ	8$		;IF SO, BRANCH
5$:	TST	(R0)+		;BUMP UP JUMP TABLE POINTER
	CMP	R0,STUROU	;AT END OF RAD50 TABLE?
	BLO	6$		;IF NOT, KEEP TRYING
	CALERR			;IF SO, ERROR
8$:	CMP	(SP)+,(SP)+	;CLEAR THE STACK OF JUNK
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	MOV	ENUDAT,-(SP)	;SAVE END OF USER DATA AREA
	JSR	PC,@(R0)	;GO TO THE ROUTINE
	MOV	(SP)+,ENUDAT	;RESTORE END OF USER DATA
	JMP	INIT02		;CONTINUE WITH NEXT BASIC STATEMENT
;
; ROUTINE TO CHECK FOR CLOSE PAREN AND POSITION R1 PAST IT.
PARCHK:	SKIP
	CMPB	R2,#')
	BEQ	1$
	CALERR
1$:	RTS	PC

	.IF NDF AC0		;THIS CONDITIONAL ELIMINATES FOLLOWING CODE
;
; TEST ROUTINE TO REVERSE A STRING
	CALTBL	REVSTR
	.PSECT	BASIC4
RVSTB1:	.BYTE	3,4,0
	.EVEN
	.PSECT	IMPUR4,RW,REL,CON,GBL,D
RVSTB2:	.BLKW	5
	.PSECT	BASIC4
REVSTR:	MOV	#RVSTB1,R0	;ARG TYPE TABLE ADD -> R0
	MOV	#RVSTB2,R5	;ARG TABLE ADDRESS -> R5
	JSR	PC,GETARG	;FILL IN TABLE
	MOV	RVSTB2,R0	;GET CHAR COUNT -> R0
	BEQ	3$		;IF ZERO, CAN SKIP A LOT OF THIS
	TSTOK			;CHECK ON SPACE (ENUDAT -> R5)
	BHI	1$		;IF OK, BRANCH
	OVFERR
1$:	MOV	R0,R4		;LEN -> R4
	BIS	#160000,R0	;SET SCRATCH ITEM HEADER
	MOV	R0,(R5)+	;SCRATCH HEADER -> USER AREA
	MOV	R5,R2		;SAVE ADDRESS OF RESULT IN R2
	MOV	RVSTB2+2,R3	;ADDRESS -> R3
	MOV	R4,R0		;LEN -> R0
	ADD	R4,R3		;POINT PAST END OF SOURCE STRING
2$:	MOVB	-(R3),(R5)+	;NOW REVERSE THE STRING
	SOB	R0,2$
	MOV	R2,R3		;SET UP ADDRESS OF RESULT
3$:	MOV	#RVSTB2+4,R5	;POINT TO OUTPUT ENTRY
	JSR	PC,SSTORE	;STORE RESULT
	JSR	PC,PARCHK	;FINISH UP ARG LIST
	RTS	PC
	.ENDC

;+5
; .SKIP
; .ID-5
; <INSTRG
; .X <INSTRG
; .BR
; ^SUBROUTINE TO INSERT A STRING INTO ANOTHER STRING.
; .NF
; ^^BASIC CALL:
; 	120 CALL "INSTRG"(S$,E$,P [,L])
; WHERE:
; 	S$ = STRING VARIABLE INTO WHICH INSERTION IS MADE
; 	E$ = STRING EXPRESSION TO BE INSERTED
; 	P  = POSITION TO START INSERTION
; 	L  = OPTIONAL MAX LENGTH OF INSERTION
; \\
; .F
; ^IF ^L IS NOT SPECIFIED, THE LENGTH OF ^E$ IS USED BY DEFAULT FOR
; THE LENGTH OF THE INSERTION.
; ^IF ^L IS SPECIFIED, JUSTIFICATION OF ^E$ IN A FIELD OF THAT SIZE
; IS PERFORMED.
; ^A POSITIVE VALUE IS LEFT JUSTIFY, NEGATIVE MEANS RIGHT JUSTIFY.
; ^THIS ROUTINE IS AT LEAST THREE TIMES AS FAST AS THE "CUT AND PASTE"
; METHOD USING THE <SBS$ FUNCTION.
; ^IF THE "CUT AND PASTE" IS FORMATTED AS A USER DEFINED FUNCTION,
; THE SPEED INCREASE IS A FACTOR OF SEVEN.
; ^THEREFORE IT IS ALMOST ALWAYS PREFERABLE TO THE <SBS$ METHOD.
;-
	.GLOBL	INSTRG
INTYP:	.BYTE	4,3,1,0		;ARG TYPE LIST
;
INSTRG:	MOV	#INTYP,R0	;ARG TYPE LIST ADD -> R0
	SUB	#16,SP		;MAKE ROOM ON STACK
	MOV	SP,R5		;COPY POINTER -> R5
	JSR	PC,GETARG	;GET ARGUMENTS
	SKIP			;CHECK FOR OPTIONAL ARG
	CMPB	R2,#',		;IS THERE A COMMA
	BNE	1$		;IF NOT, NO ARG
	EVAL			;IF SO, EVALUATE IT DIRECTLY
	BVS	6$		;CLOSE PAREN EXPECTED
	ARGERR			;ELSE ERROR
6$:	STCFI	AC0,R4		;INTEGER LEN -> R4
	BGE	7$		;IF POS OR ZERO, BRANCH
	NEG	R4		;IF NOT, MAKE POS
7$:	BR	2$		;AND SKIP SOME OTHER STUFF
1$:	MOV	6(SP),R4	;SET LEN FROM STRING EXPRESSION
	LDCIF	R4,AC0		;AND STORE IT IN AC0 FOR POSTERITY
	JSR	PC,PARCHK+4	;CHECK FOR TRAILING PAREN IN R2
2$:	LDF	12(SP),AC1	;CONVERT FLOATING
	STCFI	AC1,R0		;POSITION -> R0
	DEC	R0		;BACK UP SO IT'S OFFSET
	BLT	5$		;IF NEGATIVE, BRANCH (DO NOTHING)
	MOV	4(SP),R5	;ADDRESS OF STRING -> R5
	MOV	R4,R3		;COPY LEN
	ADD	R0,R3		;CALCUALTE END POSITION
	BIC	#177400,(SP)	;CLEAR UPPER BYTE IN MAX LEN
	SUB	(SP),R3		;SUBTRACT TOTAL LENGTH
	BLE	3$		;IF ZERO OR LESS, OK
	SUB	R3,R4		;BACK OFF ON LEN TO XFER
	LDCIF	R3,AC1		;GET SUBTRACTION AMOUNT -> AC1
	TSTF	AC0		;CHECK SIGN OF AC0
	CFCC
	BMI	21$		;IF NEGATIVE, BRANCH
	SUBF	AC1,AC0		;IF POS, DO SUBTRACTION
	BR	3$
21$:	ADD	AC1,AC0		;IF NEGATIVE, ADD
3$:	CMP	(SP),2(SP)	;COMPARE MAXLEN TO ACTUAL LENGTH
	BEQ	8$		;IF SAME, BRANCH
	MOV	R4,R3		;GET XFER LEN -> R3
	ADD	R0,R3		;ADD ON OFFSET
	CMP	R3,2(SP)	;CHECK THIS LEN AGAINST ACTUAL
	BLE	8$		;IF LESS OR SAME, BRANCH
	MOVB	R3,-1(R5)	;ELSE UPDATE ACTUAL LEN BYTE IN STRING
8$:	TSTF	AC0		;CHECK ON RIGHT OR LEFT JUSTIFY
	CFCC
	BMI	83$		;IF RIGHT, BRANCH
; LEFT JUSTIFY CODE
	CLRF	AC1		;ZERO NUMBER OF LEADING BLANKS
	SUB	6(SP),R4	;GET AMOUNT SPEC'D OVER WHAT WE HAVE
	BGT	81$		;IF POS, BRANCH
	LDF	AC0,AC2		;IF NOT, USE FIRST "L" CHARACTERS
	CLRF	AC3		;AND NO TRAILING BLANKS
	BR	82$		;AND BRANCH
81$:	LDCIF	6(SP),AC2	;ACTUAL LEN TO BE USED
	LDCIF	R4,AC3		;PLUS DIFFERENCE IN TRAILING BLANKS
82$:	BR	88$		;END OF LEFT JUSTIFY CODE
; RIGHT JUSTIFY CODE
83$:	SUB	6(SP),R4	;GET # OF CHARS NEEDED TO FILL
	BGE	84$		;IF POS OR ZERO, BRANCH
	SUB	R4,10(SP)	;BUMP UP STRING POINTER
	ADD	R4,6(SP)	;AND DECREMENT LENGTH
	CLRF	AC1		;SET NO LEADING BLANKS
	BR	85$
84$:	LDCIF	R4,AC1		;SET NUMBER OF LEADING BLANKS
85$:	LDCIF	6(SP),AC2	;SET LEN OF CHAR XFER
	CLRF	AC3		;NO TRAILING BLANKS
88$:	ADD	R0,R5		;GET START POSITION IN SOURCE
	MOV	10(SP),R3	;AND IN EXPRESSION
	STCFI	AC1,R4		;NUMBER OF LEADING BLANKS
	BLE	42$		;IF ZERO OR LESS, BRANCH
41$:	MOVB	#40,(R5)+	;MOVE IN LEADING BLANKS
	SOB	R4,41$
42$:	STCFI	AC2,R4		;NUMBER OF ACTUAL CHARS
	BLE	44$		;IF ZERO OR LESS, BRANCH
43$:	MOVB	(R3)+,(R5)+	;MOVE IN ACTUAL CHARS
	SOB	R4,43$
44$:	STCFI	AC3,R4		;NUMBER OF TRAILING BLANKS
	BLE	5$		;IF ZERO OR LESS, BRANCH
45$:	MOVB	#40,(R5)+	;MOVE IN TRAILING BLANKS
	SOB	R4,45$
5$:	ADD	#16,SP		;CLEAN STACK
	RTS	PC		;AND RETRURN

	.SBTTL	OPEN LIBRARY COMMAND PROCESSOR
;+3
; .SL
; .X ^^OPEN LIBRARY\\
; .X ^LIBRARY OPEN
; .ID -5
; ^^
; OPEN LIBRARY
; \\
; .NF
; ^FORMAT:
; 	50 ^^OPEN LIBRARY _#N,_<STRING FILESPEC>\\
; .F
; ^THIS COMMAND FUNCTIONS SIMILARLY TO THE STANDARD <OPEN COMMAND
; EXCEPT THAT A <MACRO LIBRARY FILE IS OPENED FOR QUESTION TEXT
; OUTPUT AND OTHER QUESTION PROCESSING SUBROUTINES INVOKED BY THE
; <CALL STATEMENT.
; ^A <LUN MUST BE USED THAT IS NOT ALREADY IN USE AND IS ONE OF THE
; ALLOWABLE NUMBERS AS FOR THE STANDARD <OPEN.
; ^NO SWITCHES ARE ALLOWED AS ALL FILE OPTIONS ARE DETERMINED
; INTERNALLY FOR HANDLING THE LIBRARY FORMAT.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	100 OPEN LIBRARY _#5,"QUESLS.MLB"
; 	200 OPEN LIBRARY _#3,A$
; \\
; .F
;-
S.QLBF=S.FDB+80.+<11.*2>+2	;DEFINE SIZE OF USER DATA ITEM SIZE
;
LIBNAM:	NMBLK$	QESLIB,MLB,,SY,0	;DEFINE DEFAULT FILE NAME BLOCK
;
OPLB00:	SKIP			;GET NEXT CHAR AFTER VERB
	CMPB	#'#,R2		;IS IT POUND SIGN
	BEQ	1$		;IF SO, OK
2$:	OPLBER			;OTHERWISE ERROR
1$:	EVAL			;GET FILE NUMBER
	BVS	2$		;REPORT ERROR
	STCFI	AC0,R4		;STORE NUMBER IN R4
	MOVB	R4,OP.LUN	;STORE FOR FUTURE REFERENCE
	CMP	R4,#2		;CHECK LUN IN RANGE
	BLE	2$
	CMP	R4,#OP.MXL
	BGT	2$
	CLR	R0		;NO OTHER BITS REQUIRED FOR SEARCH
	JSR	PC,FILFN1	;SEE IF WE CAN FIND ANOTHER FILE WITH NUMBER
	BNE	2$		;IF SO, ERROR
	SKIP			;NEXT CHAR
	CMPB	#',,R2		;SHOULD BE COMMA
	BNE	2$		;IF NOT, ERROR
	EVALS			;GET FILE NAME
	BVS	2$		;ON ERROR, BRANCH
	CLR	R2		;NO SWITCH TABLE
	JSR	PC,CSINT0	;INTERPRET COMMAND STRING
	MOV	#S.QLBF,R0	;SET SIZE FOR USER LIBRARY FILE AREA
	TSTOK			;CHECK (AND ENUDAT -> R5)
	BHIS	3$		;IF OK, BRANCH
	OVFERR
3$:	MOV	STGOSB,R2	;SET UP TO MOVE BLOCK
	MOV	STUFDB,R3	;OF DATA DOWN
	JSR	PC,SLDN		;TO ACCOMMODATE NEW FDB
	SUB	R0,R2		;R2 POINTS TO START OF NEW FDB
	MOV	R2,R3		;ALSO R3
	SUB	R0,STGOSB	;UPDATE PTRS
	SUB	R0,STFONX
	SUB	R0,STUFDB
	ASR	R0		;R0 NOW WORD COUNT FOR ZERO LOOP
4$:	CLR	(R2)+		;CLEAR OUT AREA
	SOB	R0,4$
	MOV	R3,R0		;MAKE R0 POINT TO
	ADD	#11.*2,R0	;FDB START
	FDRC$R	,#FD.PLC	;SET LOCATE MODE
	FDOP$R	,OP.LUN,#CSDSPT,#LIBNAM,#FO.RD!FA.SHR
	JSR	PC,.OPEN
	BCC	5$
	MOV	#S.QLBF,R0	;SIZE OF LIBRARY FDB
	MOV	STGOSB,R2	;SET UP TO MOVE IT ALL
	MOV	STUFDB,R3	;BACK UP
	JSR	PC,SLUP		;
	ADD	R0,STGOSB	;ADJUST PTRS BACK
	ADD	R0,STFONX
	ADD	R0,STUFDB
6$:	OPLFER			;DECLARE ERROR
5$:	GET$			;GET FIRST RECORD (BLOCK)
	BCS	6$		;ON ERROR, BRANCH
	MOV	F.NRBD+2(R0),R2	;ADDRESS -> R2
	MOVB	32(R2),2(R3)	;STORE MNT SIZE
	MOV	#80.,4(R3)	;PUT IN MAX BYTE COUNT
	MOV	34(R2),6(R3)	;STARTING BLOCK FOR MNT
	MOV	36(R2),10(R3)	;NO. OF ENTRIES
	MOV	R0,12(R3)	;CLACULATE BUFFER
	ADD	#S.FDB,12(R3)	;ADDRESS
	MOV	R0,16(R3)	;FDB ADDRESS
	MOVB	OP.LUN,R4	;CALCULATE AND
	DEC	R4		;DECREMENT FOR INTERNAL STORAGE
	BIS	#10000,R4	;SET HEADER FOR
	MOV	R4,(R3)		;LIBRARY FILE
	JMP	INIT02		;GO ON WITH NEXT STATEMENT
;
; INITIAL SET UP ROUTINE
; ON ENTRY:	R0 CONTAINS ARG TYPE LIST
;		R1 POINTS TO "(" OF ARG LIST IN CALL
; ON EXIT:	R0 POINTS TERM. BYTE OF ARG TYPE LIST
;		R5 POINTS PAST LAST FILLED IN VALUE OF ARG VALUE LIST
;		R1 POINTS PAST END OF ARG LIST AND IS SAVED ON STACK
;		QLUN CONTAINS START OF FCB
;		QLUN+2 CONTAINS START OF FDB
;
SETUP:	MOV	#MPARLS,R5	;ARGUMENT RETURN LIST -> R5
	JSR	PC,GETARG	;GET THE ARGUMENTS
	JSR	PC,PARCHK	;CHECK FOR FINAL CLOSE PAREN
	MOV	(SP),-(SP)	;MOVE RETURN ADDRESS DOWN ON STACK
	MOV	R1,2(SP)	;SAVE TEXT POINTER
	LDF	QLUN,AC0	;LUN IN AC0
	STCFI	AC0,R4		;INTEGER -> R4
	DEC	R4		;DECREMENT FOR INTERNAL STORAGE
	BIS	#10000,R4	;SET TYPE
	MOV	#7400,R0	;SET MASK TO IGNORE
	JSR	PC,SRCHFL	;GO FIND IT
	BNE	1$		;IF FOUND, BRANCH
	LDCIF	#-1,AC0		;SET ERROR CODE
	JMP	ERRFIN		;AND GO FINISH ERROR PROCESSING
1$:	MOV	R3,QLUN		;SAVE START OF FILE CONTROL BLOCK
	MOV	R3,12(R3)	;RE-CALCULATE BUFFER ADDRESS
	ADD	#26+S.FDB,12(R3) ;SO WE DON'T CLOBBER CORE
11$:	ADD	#26,R3		;MAKE R3 POINT TO FDB START
	MOV	R3,QLUN+2	;AND STORE IT AWAY
	RTS	PC
;
; RAD50 CONVERSION ROUTINE
; ON ENTRY:	R0 POINTS TO START OF STRING TO BE CONVERTED
; 		R4 CONTAINS LENGTH OF STRING
; ON EXIT:	2 RAD50 WORDS ON STACK (1ST 2(SP), 2ND (SP))
;		R0 POINTS TO TERMINATING CHARACTER
; ALL REGISTERS USED
;
R50CVT:	MOV	(SP)+,R5	;POP RTN ADDRESS TO R5
	MOV	R0,R3		;NOW MAKE R3
	ADD	R4,R3		;POINT PAST END AND
	MOVB	#',,(R3)	;PUT IN TERM. CHAR
	JSR	PC,$CAT5	;GET FIRST RAD50 WORD -> R1
	MOV	R1,-(SP)	;SAVE IT ON STACK
	BCC	1$		;IF SCAN NOT TERMINATED, BRANCH
	CLR	-(SP)		;ELSE PUT DEFAULT 2ND WORD ON STACK
	BR	2$
1$:	JSR	PC,$CAT5	;CONVERT 2ND WORD
	MOV	R1,-(SP)	;AND SAVE IT
2$:	JMP	(R5)		;DO EFFECTIVE RETURN
;
; FIND AND POSITION ROUTINE
; ON ENTRY:	STACK CONTAINS 2 RAD50 WORDS FOR QUESTION NAME
; 		QNAM CONTAINS LEN OF NAME
; ON EXIT:	QUESTION TYPE (MAX ANS #) -> 14(FCB)
;		BLOCK # (.MACRO LINE) -> 20(FCB)
;		BYTE OFFSET (.MACRO LINE) -> 22(FCB)
;
FILPOS:	MOV	QLUN,R3		;START OF FCB -> R3
	MOV	QLUN+2,R0	;FDB START -> R0
	MOVB	#R.FIX,F.RTYP(R0)	;SET FOR FIXED LEN
	MOVB	#FD.PLC!FD.RAN,F.RACC(R0) ;RAN ACC, LOCATE MODE
	MOV	6(R3),F.RCNM+2(R0) ;MNT STARTING BLOCK
	CLR	F.RCNM(R0)	;CLEAR OUT HIGH WORD
	MOV	10(R3),R5	;NO. OF MNT ENTRIES -> R5
	MOV	(SP)+,R4	;RETURN ADDRESS -> R4
	MOV	(SP)+,R2	;SECOND RAD50 PART OF QUES NAME
	MOV	(SP)+,R1	;AND FIRST HALF
	MOV	R4,-(SP)	;SAVE RETURN ADDRESS BACK ON STACK
7$:	GET$			;READ IN MNT BLOCK
	BCC	19$		;IF OK, BRANCH
	JMP	FCSERS		;GO RECORD FCS CODE AND RETURN STATUS
19$:	MOV	F.NRBD+2(R0),R3	;STARTING ADDRESS OF BLOCK -> R3
	MOV	R3,R4		;END ADDRESS -> R4
	ADD	F.NRBD(R0),R4
5$:	CMP	R1,(R3)+	;COMPARE FIRST PART OF NAME
	BEQ	3$		;IF MATCH, TRY SECOND
	TST	(R3)+		;OTHERWISE POP PAST SECOND PART
	BR	4$		;AND TRY AGAIN
3$:	CMP	R2,(R3)+	;SECOND PART MATCH?
	BEQ	8$		;IF SO, BRANCH
4$:	DEC	R5		;ARE WE THROUGH LIST
	BLE	6$		;IF SO, RETURN ERROR STATUS
	ADD	#4,R3		;JUMP OVER BLOCK AND OFFSET
	CMP	R3,R4		;AT END OF BLOCK YET?
	BLO	5$		;IF NOT, DO SMALLER LOOP
	BR	7$		;ELSE READ IN NEW BLOCK AND CONTINUE
6$:	LDCIF	#-3,AC0		;LOAD ERROR RETURN CODE
	JMP	ERRFIN		;FINISH ERROR PROCESSING
8$:	MOV	(R3)+,R2	;BLOCK -> R2
	CLR	R1		;BLOCK HIGH CLEAR
	MOV	(R3)+,R3	;BYTE OFFSET -> R3
	MOVB	#R.VAR,F.RTYP(R0) ;SET FOR VAR LEN
	BICB	#FD.RAN!FD.PLC,F.RACC(R0) ;SEQUENTIAL AND MOVE MODE
	JSR	PC,.POINT	;POINT TO RECORD
	MOV	QLUN,R5		;START OF FCB -> R5
	GET$	,12(R5),4(R5)	;GET HEADER RECORD
	BCS	9$
	JSR	PC,.MARK	;MARK FILE POSITION
	MOV	R2,20(R5)	;SAVE BLOCK AND
	MOV	R3,22(R5)	;BYTE OFFSET
	GET$			;NOW GET FIRST REAL RECORD
	MOV	F.NRBD+2(R0),R1	;ADDRESS OF BUFFER -> R1
	BCC	11$		;IF ALL OK, BRANCH
9$:	JMP	FCSERS		;GO RECORD FCS CODE AND RETURN STATUS
11$:	MOV	R1,R3		;GET ADDRESS OF BYTE PAST END
	ADD	F.NRBD(R0),R3	;OF LINE READ IN
	CLRB	(R3)		;AND SET STOPPER FOR ATOI ROUTINE
	SKIP			;POINT PAST FIRST NON-SPACE (OR TAB) CHAR
	ADD	#5,R1		;POINT PAST '.MACRO'
	SKIP			;NEXT NON-BLANK CHAR
	CMPB	R2,#',		;IS IT COMMA?
	BNE	12$		;IF NOT, BRANCH
	SKIP			;GET NEXT NON-BLANK AFTER COMMA
12$:	DEC	R1		;BACK UP POINTER
	ADD	QNAM,R1		;ADD LEN OF QUES NAME TO TEXT POINTER
	SKIP			;GET NEXT NON BLANK OR TAB
	CMPB	R2,#',		;IS IT COMMA (ALSO DELIMITER)
	BNE	13$		;IF NOT, BRANCH
	SKIP			;NEXT NON BLANK OR TAB
13$:	DEC	R1		;BACK UP POINTER TO START OF NUMBER
	ATOI			;GET NUMBER WHICH FOLLOWS -> R0
	MOV	R0,14(R5)	;SAVE QUES TYPE (INCL MAX RESPONSE)
	LDCIF	R0,AC0		;STORE AWAY MAX RESPONSE
	MOV	#QSTAT,R5	;
	JSR	PC,NSTORE
	RTS	PC
FCSERS:	LDCIF	#-2,AC0		;PUT IN ERROR CODE
	MOVB	F.ERR(R0),R5	;SIGN EXTEND IN R5
	MOV	R5,PARLST+P.FCS	;AND STORE FOR FUTURE REFERENCE
	JMP	ERRFIN
;
; DISPLAY ROUTINE
; ON ENTRY:	FILE POSITION ASSUMED TO BE STORED AS IN FILPOS ROUTINE
; ON EXIT:	SCREEN HAS QUESTION PUT UP
; TYPE:		0) TEXT DISPLAY (NO NUMBERS BUT OPTIONAL STRING CAN BE USED)
;		1) SINGLE ANSWER QUESTION (NO CR-LF)
;		2+) MULTIPLE CHOICE (TYPE IS MAX # OF RESPONSES)
;
DISPLA:	JSR	PC,FILPNT	;POINT TO START OF QUESTION (.MACRO LINE)
	GET$	,12(R5),4(R5)	;GET 1ST LINE (.MACRO)
	BCS	FCSERS
	MOV	14(R5),R4	;RESPONSE COUNT -> R4
	DEC	R4		;DECREMENT FOR BRANCHING
	BLT	11$		;IF INFO (MULTI-LINE), BRANCH
	BEQ	21$		;IF SINGLE TEXT, BRANCH
	GET$			;GET QUESTION TEXT
	BCS	FCSERS		;ON ERROR, BRANCH
	MOV	12(R5),R1	;ADDRESS -> R1
	MOV	F.NRBD(R0),R3	;LEN -> R3
	BEQ	2$		;IF ZERO, CAN SKIP A LOT
1$:	MOVB	(R1)+,R2	;CHARACTER -> R2
	PRINTC			;PRINT IT
	SOB	R3,1$
2$:	CRLF
	CLR	R4		;INIT ANSWER NUMBER
8$:	JSR	PC,5$		;PUT OUT LEADING CHARS
	MOV	12(R5),R0	;BUFFER ADDRESS -> R0
	MOVB	#40,(R0)+	;PUT IN SPACE
	INC	R4		;INCREMENT ANSWER NUMBER
	MOV	R4,R1		;PUT IN R1 FOR CONVERSION
	CLR	R2		;NO LEADING ZEROES
	JSR	PC,$CBDSG	;CONVERT TO ASCII -> R0
	MOVB	#'),(R0)+	;DELIMIT FOR GOOD FORM
	MOVB	#40,(R0)+	;AND PUT IN A SPACE
	CLRB	(R0)		;PUT IN DELIMITER
	MOV	12(R5),R0	;GET START ADDRESS
	PRINTL			;AND PRINT THE LINE (NO CR-LF YET)
	GET$	QLUN+2		;GET IN ACTUAL TEXT
	BCS	FCSERS
	MOV	F.NRBD(R0),R3	;LENGTH -> R3
	MOV	F.NRBD+2(R0),R1	;ADD -> R1
6$:	MOVB	(R1)+,R2	;NEXT CHAR -> R2
	CMPB	R2,#'\		;IS IT BACK SLASH (END OF TEXT PROPER)
	BEQ	7$		;IF SO, BRANCH
	PRINTC			;ELSE PRINT IT
	SOB	R3,6$		;DO WHOLE LINE
7$:	CRLF			;END THE LINE
	CMP	R4,14(R5)	;UP TO MAX RESPONSE?
	BLT	8$		;IF NOT, DO ANOTHER LINE
	RTS	PC		;DONE WITH DISPLAY
;
; SUBROUTINE FOR INSERTING LEADING CHARACTERS
5$:	LDF	COUNT,AC1	;GET CHARS PER LINE
	STCFI	AC1,R3		;AND PUT IN R3
	BLE	4$		;IF ZERO OR NEG, RETURN
	MOV	STRIN+2,R1	;STRING ADDRESS -> R1
3$:	TST	STRIN		;ANYTHING LEFT IN SOURCE STRING?
	BLE	4$		;IF NOT, DONE
	MOVB	(R1)+,R2	;PUT CHAR -> R2
	PRINTC			;AND PRINT IT
	DEC	STRIN		;DECREMENT REMAINING COUNT
	SOB	R3,3$
	MOV	R1,STRIN+2	;PUT IN MODIFIED ADDRESS FOR NEXT TIME
4$:	RTS	PC
;
; MULTI-LINE TEXT OUTPUT
11$:	GET$			;GET TEXT LINE
	BCS	FCSERS
	MOV	12(R5),R1	;BUFFER ADDRESS -> R1
	MOV	#ASCENM,R4	;ADDRESS OF '.ENDM' STRING
	SKIP			;GET FIRST NON-BLANK OR TAB
	DEC	R1		;BACK UP TO FIRST NON-BLANK CHAR
	MOV	#5,R2		;LENGTH -> R2
14$:	CMPB	(R1)+,(R4)+	;MATCH
	BNE	12$		;IF NOT, DO OUTPUT
	SOB	R2,14$		;KEEP GOING
	RTS	PC		;IF FINISH, RETURN
12$:	JSR	PC,5$		;PUT OUT LEADING CHARACTERS
	MOV	F.NRBD(R0),R3	;LEN OF LINE -> R3
	MOV	F.NRBD+2(R0),R1	;ADDRESS -> R1
13$:	MOVB	(R1)+,R2	;CHARACTER -> R2
	PRINTC
	SOB	R3,13$		;PRINT WHOLE LINE
	CRLF			;END OF LINE
	BR	11$		;KEEP GOING TILL DONE
;
; ROUTINE FOR SINGLE LINE TEXT ENTRY QUESTION DISPLAY
21$:	JSR	PC,5$		;PUT OUT LEADING STRING
	GET$			;GET QUESTION TEXT
	MOV	F.NRBD(R0),R3	;LEN -> R3
	MOV	F.NRBD+2(R0),R1	;ADD -> R1
22$:	MOVB	(R1)+,R2	;CHAR -> R2
	PRINTC
	SOB	R3,22$
	RTS	PC
MDRTN:	MOV	(SP)+,R1	;RESTORE TEXT POINTER
1$:	RTS	PC
ERRFIN:	TST	(SP)+		;POP OFF SUBROUTINE RETURN ADDRESS
ERRFN1:	MOV	#QSTAT,R5	;ADDRESS POINTER -> R5
	JSR	PC,NSTORE	;STORE THE BAD STATUS
	BR	MDRTN
;
; QLINK ROUTINE TO LINK TO QUESTION LINKED BY ANSWER # GIVEN IN CALL
; ON ENTRY:	QLUN HAS FCB ADD.
;		QLUN+2 HAS FDB ADD.
;		PREVIOUS QUESTION TYPE 2 (OR GREATER)
; ON EXIT:	R1 POINTS TO ADDRESS OF LINKED NAME
;		R4 HAS LEN OF LINKED NAME
; NOTE:		POINTERS ONLY GOOD UNTIL NEXT GET$
;
QLINK:	MOV	QLUN,R5		;FCB POINTER -> R5
	LDF	QNAM,AC0	;GET NUMBER OF RESPONSE TO LAST QUESTION
	STCFI	AC0,R4		;INTEGERIZE -> R4
	BLE	4$		;ZERO OR NEG IS ERROR
	CMP	R4,14(R5)	;COMPARE TO MAX RESPONSE ALLOWED
	BLE	1$		;IF IN RANGE, BRANCH
4$:	LDCIF	#-3,AC0		;ERROR: NO SUCH QUESTION
	JMP	ERRFIN
1$:	MOV	QLUN+2,R0	;FDB ADDRESS -> R0
	CLR	R1		;CLEAR HIGH PART OF BLOCK NUMBER
	MOV	20(R5),R2	;SET UP LOW PART OF BLOCK NO.
	MOV	22(R5),R3	;AND BYTE OFFSET
	JSR	PC,.POINT	;POINT TO FIRST RESPONSE TEXT RECORD
	MOV	12(R5),R1	;BUFFER ADDRESS -> R1
	GET$	,R1,4(R5)	;.MACRO LINE
	GET$			;QUESTION LINE
2$:	GET$			;GET NEXT ANSWER
	SOB	R4,2$		;GET AS MANY RECORDS AS ANSWER
	MOV	R1,R4		;CALCULATE END OF BUFFER
	ADD	F.NRBD(R0),R4
	MOV	R4,R2		;DUPLICATE END ADDRESS IN R2
	SUB	R1,R2		;GET BACK LEN -> R2
	BEQ	4$		;IF ZERO, ERROR
3$:	CMPB	(R1)+,#'\	;FOUND START OF LINK?
	BEQ	5$		;IF SO, BRANCH
	SOB	R2,3$		;GO THROUGH WHOLE LINE LOOKING
	BR	4$		;IF NO LINK, ERROR (NO LINK QUESTION)
5$:	SKIP			;GET NEXT NON-BLANK OR TAB
	DEC	R1		;BACK UP TO IT
	SUB	R1,R4		;LEN -> R4
	MOV	R4,QNAM		;LENGTH STORED FOR FUTURE REFERENCE
	RTS	PC
;
; FILE POINT ROUTINE
; ON ENTRY:	FILE POSITION STORED AS IN FILPOS ROUTINE
;		QLUN CONTAINS FCB POINTER
;		QLUN+2 CONTAINS FDB POINTER
; ON EXIT:	R5 CONTAINS FCB POINTER
;		R0 CONTAINS FDB POINTER
;		FILE IS POSITIONED FOR READ OF .MACRO LINE
; OTHER REGISTERS USED: R1,R2,R3
FILPNT:	MOV	QLUN,R5		;FCB PTR -> R5
	MOV	QLUN+2,R0	;FDB PTR -> R0
	CLR	R1		;CLEAR HIGH BLOCK NUM.
	MOV	20(R5),R2	;SET UP LOW BLOCK NUM.
	MOV	22(R5),R3	;SET UP BYTE OFFSET FOR .MACRO LINE
	JSR	PC,.POINT	;POINT TO IT
	RTS	PC
;
; STORE STATUS ROUTINE
; USED TO RETURN FILE TYPE (COUNT FOR MUL CHC) ON PREVIOUSLY POSITIONED FILE
; ON ENTRY:	FILE SET UP AS IN FILPOS ROUTINE
;		QLUN CONTAINS FCB POINTER
; ON EXIT:	14(FCB) STORED IN QSTAT VARIABLE (2ND IN LIST)
; REGISTERS USED: R5,AC0
STATST:	MOV	QLUN,R5		;FCB ADD -> R5
	LDCIF	14(R5),AC0	;TYPE (COUNT) -> AC0
	MOV	#QSTAT,R5	;ADD. FOR STORE PTR
	JSR	PC,NSTORE	;STORE IT
	RTS	PC

;+5
; .SL
; .ID-5
; ^QUESTION ^DISPLAY
; .X ^QUESTION ^DISPLAY
; .BR
; ^A SERIES OF ROUTINES CAN BE USED FOR DISPLAYING QUESTIONS AT A
; TERMINAL FOR INTERACTIVE DATA ENTRY APPLICATIONS.
; ^THE TEXT OF THE QUESTIONS THEMSELVES RESIDES IN A FILE MADE BY THE
; <RSX LIBRARIAN (<LBR) AND FORMATTED AS A <MACRO LIBRARY (<.MLB
; EXTENSION).
; ^THERE ARE THREE TYPES OF QUESTIONS THAT CAN BE DISPLAYED:
; .NF
; 	0) ^MULTI-LINE TEXT DISPLAY
; 	1) ^SINGLE LINE QUESTION (TEXT INPUT)
; 	2) ^MULTIPLE CHOICE DISPLAY
; .F
; .SL
; ^THE QUESTIONS ARE FORMATTED AS MACROS WITH THE NAME OF THE QUESTION
; BEING THE NAME OF THE MACRO.
; ^THERE IS A SINGLE ARGUMENT TO THE MACRO, A NUMBER WHICH IS THE
; TYPE AS SPECIFIED ABOVE EXCEPT IN THE CASE OF TYPE 2, IT IS THE
; TOTAL NUMBER OF CHOICES FOR THAT MULTIPLE CHOICE QUESTION (CAN
; NEVER BE LESS THAN 2).
; .SL
; ^THE QUESTION NAMES ARE USED FOR LINKING OF MULTIPLE CHOICE QUESTIONS
; AND FOR QUESTION REPLACEMENT BY THE LIBRARIAN.
; ^QUESTION NAMES MAY BE UP TO 6 CHARACTERS IN LENGTH.
; ^THE CHARACTERS MUST BE LEGAL <RAD50 CHARACTERS I.E. ALPHANUMERIC,
; PERIOD AND DOLLAR SIGN.
; ^AFTER DISPLAY, THE INPUT OF A RESPONSE IS LEFT TO THE USER PROGRAM.
; .SL
; ^^MULTI-LINE TEXT\\
; .SL
; ^THE MULTI-LINE TEXT QUESTION (NEED NOT BE AN ACTUAL QUESTION) IS
; REPRODUCED EXACTLY AS ENTERED WITH THE CARRIAGE (CURSOR) POSITIONED
; TO THE START OF THE NEXT LINE.
; ^THE TEXT DISPLAY IS TERMINATED WHEN THE <.ENDM DIRECTIVE IS ENCOUNTERED
; AS THE FIRST ENTRY ON A LINE OTHER THAN SPACE OR TAB.
; ^TYPE CODE IS 0.
; .NF
; ^EXAMPLE:
; ^^
; 	.MACRO  MULTXT  0
;	THIS IS AN EXAMPLE OF A
; 	MULTIPLE LINE TEXT QUESTION.
; 	IT MAY BE USED AS A QUESTION OR JUST
; 	TO PRINT OUT SOME INFORMATION FOR THE
; 	PROGRAM USER. ANY NUMBER OF LINES
; 	MAY BE USED.
; 	.ENDM
; \\
; .F
; .SL
; ^^SINGLE LINE QUESTION\\
; .SL
; ^THIS TYPE OF QUESTION IS USUALLY USED TO SOLICIT TEXT INFORMATION
; FROM THE USER (NAME, AGE ETC.).
; ^ONLY ONE LINE IS PRINTED AND THE CARRIAGE (CURSOR) IS POSITIONED
; AT THE END OF THE LINE.
; ^ANY FURTHER LINES OF TEXT ENTERED FOR THIS QUESTION TYPE WILL NOT
; BE DISPLAYED.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	.MACRO  SINGLE  1
; 	TYPE YOUR NAME: LAST, FIRST 
; 	.ENDM
; \\
; .F
; .SL
; ^^MULTIPLE CHOICE QUESTION\\
; .SL
; ^THIS TYPE OF QUESTION IS USED TO SOLICIT A NUMBER RESPONSE WHICH
; IS SELECTED FROM A FINITE SET OF CHOICES DISPLAYED TO THE USER.
; ^A SUCCEEDING QUESTION MAY BE SELECTED DEPENDING ON THE RESPONSE
; TO THE DISPLAYED QUESTION.
; ^THUS MULTIPLE CHOICE BRANCHING STRUCTURES MAY BE SET UP.
; ^THE CHARACTER USED TO SEPARATE THE RESPONSE TEXT FROM ITS
; ASSOCIATED BRANCHING QUESTION NAME IS THE BACKSLASH.
; ^THE NUMBER OF CHOICES IS THE NUMBER FOLLOWING THE QUESTION NAME
; IN THE <.MACRO LINE.
; .BR
; ^EXAMPLE:
; .NF
; ^^
; 	.MACRO  MULCHC  3
; 	SELECT YOUR STATE OF MIND
; 	GOOD_\MULCH1
; 	FAIR_\MULCH2
; 	TGIF_\MULCH3
; 	.ENDM
; \\
; .F
; .SL
; ^^COMMON INFORMATION FOR ALL QUESTION PROCESSING CALLS\\
; .SL
; ^SBROUTINES ARE PROVIDED IN THREE DIFFERENT FORMS TO PERFORM A
; NUMBER OF DIFFERENT FUNCTIONS.
; ^THE FUNCTIONS ARE AS FOLLOWS:
; .NF
; 	1) ^DISPLAY QUESTION
; 	2) ^POSITION TO QUESTION
; 	3) ^RETURN QUESTION TEXT
; 	4) ^RETURN ANSWER TEXT
; 	5) ^RETURN QUESTION NAME
; .SL
; ^THE THREE FORMS OF THE SUBROUTINES ARE AS FOLLOWS:
; 	1) '^M' FORM: PERFORM FUNCTION BY NAME
; 	2) '^C' FORM: PERFORM FUNCTION ON QUESTION LINKED TO PREV. QUEST.
; 	3) '^R' FORM: PERFORM FUNCTION ON LAST QUESTION ACCESSED
; .SL
; .F
; ^IN GENERAL THE '^M' FORM AND '^C' FORM OF THE SUBROUTINES RESET THE
; LAST QUESTION ACCESSED.
; ^THE '^R' FORM, SINCE IT ACTS ON THE LAST QUESTION ACCESSED, DOES NOT
; CHANGE IT.
; ^THE ONE EXCEPTION IS THE '^C' FORM OF THE RETURN QUESTION NAME FUNCTION
; (<CQNAM).
; ^IT DOES NOT CHANGE THE LAST QUESTION ACCESSED.
; ^THE '^M' FORM OF THE SUBROUTINES USES A NAME SPECIFIED AS AN INPUT STRING
; ARGUMENT (3RD PARAMETER) TO POSITION TO THE SPECIFIED QUESTION AND THEN
; PERFORM THE REQUIRED ACTION.
; ^THE '^C' FORM USES THE LAST QUESTION ACCESSED (POSITIONED TO) IN ORDER
; TO POSITION TO ANOTHER QUESTION.
; ^TO DO THIS, THE LAST QUESTION MUST HAVE BEEN A MULTIPLE CHOICE QUESTION
; AND A LINK MUST BE PROVIDED FOR THE ANSWER NUMBER SPECIFIED AS THE
; THIRD PARAMETER IN THE SUBROUTINE CALL.
; ^THE '^R' FORM USES THE PREVIOUSLY ACCESSED QUESTION (WHETHER BY '^M'
; OR '^C') TO PERFORM ITS ACTION.
; ^THE THIRD PARAMETER IS A DUMMY NUMERIC PARAMETER.
; .SL
; ^^GENERAL PARAMETERS\\
; .SL
; ^FOLLOWING IS A DESCRIPTION OF THE SYMBOLIC PARAMETER NAMES USED IN
; DESCRIBING THE VARIOUS SUBROUTINE CALLS.
; ^THEY ARE, OF COURSE, REPLACED IN THE ACTUAL CALLS BY LEGAL <BASIC
; EXPRESSIONS IN THE CASE OF INPUT VALUES AND BY LEGAL VARIABLE NAMES
; IN THE CASE OF OUTPUT VALUES.
; .NF
; 	<LUN:    ^INPUT VALUE CONTAINING <LUN USED IN <OPEN <LIBRARY COMMAND
; 	<STATUS: ^OUTPUT VALUE RETURNING STATUS OF ACTION REQUESTED
; 	        +2 OR GREATER = MAX RESPONSE _# FOR MULTIPLE CHOICE QUES.
; 	        +1 = QUESTION WAS A TEXT INPUT TYPE (SINGLE LINE)
; 	         0 = QUESTION WAS MULTI-LINE INFO DISPLAY
; 	        -1 = <LUN NOT FOUND (<OPEN <LIBRARY NOT DONE ON THIS <LUN)
; 	        -2 = <FCS ERROR DURING READ
; 	        -3 = ^QUESTION NOT FOUND (FOR A VARIETY OF REASONS)
; 	<NAME$:  ^INPUT STRING CONTAINING QUESTION NAME ('^M' TYPE)
; 	<ANS:    ^INPUT NUMERIC VALUE WITH ANSWER TO PREV. QUES. ('C' TYPE)
; 	<DUMMY:  ^DUMMY NUMERIC INPUT ('^R' TYPE)
; .F
; ^NOTE: ^THE VALUE OF -3 RETURNED FOR <STATUS CAN INDICATE A VARIETY OF
; CONDITIONS.
; ^FOR '^M' TYPE CALLS, IT MEANS THE SPECIIED QUESTION NAME IS NOT PRESENT
; IN THE LIBRARY FILE.
; ^FOR '^C' TYPE CALLS, IT WILL BE RETURNED IF THE PREVIOUS QUESTION WAS
; NOT A MULTIPLE CHOICE TYPE, IF NO LINKED QUESTION WAS RECORDED FOR THE
; SPECIFIED ANSWER, OR IF THE LINKED QUESTION SPECIFIED WAS NOT PRESENT
; IN THE LIBRARY.
; .SL
; ^^DISPLAY QUESTION SUBROUINES\\
; ^^
; .ID-5
; MDIS
; .ID -5
; CDIS
; .ID -5
; RDIS
; \\
; .BR
; .X <MDIS
; .X <CDIS
; .X <RDIS
; .NF
; ^FORMATS:
; ^^
; 	CALL "MDIS"(LUN,STATUS,NAME$[,STRING$,COUNT])
; 	CALL "CDIS"(LUN,STATUS,ANS[,STRING$,COUNT])
; 	CALL "RDIS"(LUN,STATUS,DUMMY[,STRING$,COUNT])
; \\
; .F
; ^THE NAMED QUESTION, LINKED QUESTION OR PREVIOUS QUESTION WILL BE
; DISPLAYED RESPECTIVELY BY THE ABOVE THREE SUBROUTINE CALLS ACCORDING
; TO THE FOLLOWING RULES.
; ^IF THE OPTIONAL PARAMETERS ARE NOT SPECIFIED:
; .SL
; ^^MULTI-LINE INFO DISPLAY\\:
; ^TEXT IS DISPLAYED AS TYPED.
; ^CARRIAGE (CURSOR) IS POSITIONED TO THE START OF THE NEXT LINE.
; ^ALL LINES UP TO THE LINE WITH A LEADING <.ENDM DIRECTIVE WILL
; BE DISPLAYED.
; .SL
; ^^SINGLE LINE TEXT INPUT\\:
; ^THE LINE OF TEXT IS DISPLAYED WITH THE CARRIAGE (CURSOR) TO THE
; IMMEDIATE RIGHT OF THE TEXT JUST DISPLAYED.
; ^ANY SPACES REQUIRED AFTER THE TEXT MUST BE EITHER INCLUDED IN THE
; QUESTION TEXT OR ADDED FROM THE PROGRAM VIA A <PRINT STATEMENT.
; .SL
; ^^MULTIPLE CHOICE QUESTION\\:
; ^FOR THIS TYPE QUESTION THE FIRST LINE IS DISPLAYED AS TYPED.
; ^SUBSEQUENT LINES ARE DISPLAYED WITH A LEADING SPACE AND A NUMBER
; WHICH STARTS AT ONE AND INCREASES BY ONE FOR EACH SUCCEEDING LINE.
; ^THE NUMBER IS THEN FOLLOWED BY A RIGHT PARENTHESIS ')' AND ANOTHER
; SPACE AND THEN THE TEXT FOR THAT LINE.
; ^AFTER ALL LINES HAVE BEEN DISPLAYED, THE CARRIAGE (CURSOR) IS THEN
; POSITIONED TO THE START OF THE NEXT LINE.
; ^NOTE THAT THE TOTAL NUMBER OF LINES DISPLAYED IS THE NUMBER GIVEN AS
; THE ARGUMENT ON THE <.MACRO LINE PLUS ONE AND IS INDEPENDENT OF WHERE
; THE <.ENDM LINE OCCURS.
; ^THIS MAY LEAD TO NOT DISPLAYING ALL OF THE TYPED IN QUESTION TEXT OR
; THE OUTPUT OF GARBAGE IF THE QUESTION HAS NOT BEEN TYPED IN PROPERLY.
; .SL
; ^IF THE OPTIONAL PARAMETERS ARE SPECIFIED (BOTH MUST BE PRESENT), THE
; FOLLOWING HOLDS:
; .SL
; ^^MULTI-LINE INFO DISPLAY\\:
; ^IF ^N IS THE NUMBER SPECIFIED IN <COUNT, THEN THE TEXT IS DISPLAYED
; PRECEDED BY ^N CHARACTERS OF <STRING$ FOR EACH LINE UNTIL THE
; CHARACTERS IN <STRING$ ARE EXHAUSTED OR THE DISPLAY IS COMPLETE
; (NORMALLY THESE SHOULD HAPPEN TOGETHER).
; .SL
; ^^ SINGLE LINE TEXT INPUT\\:
; ^THE LINE OF TEXT IS DISPLAYED AS BEFORE BUT WITH ^N CHRACTERS OF
; <STRING$ PRECEDING IT.
; .SL
; ^^MULTIPLE CHOICE QUESTIONS\\:
; ^IN THIS CASE THE FIRST LINE IS DISPLAYED AS ABOVE, BUT THE
; SUBSEQUENT LINES (ANSWERS) ARE EACH PRECEDED BY ^N CHARACTERS FROM
; <STRING$.
; .SL 2
; ^^POSITION TO QUESTION SUBROUTINES\\
; .ID-5
; <MPOS
; .ID-5
; <CPOS
; .ID-5
; <RPOS
; .X <MPOS
; .X <CPOS
; .X <RPOS
; .BR
; .NF
; ^FORMATS:
; ^^
; 	CALL "MPOS"(LUN,STATUS,NAME$)
; 	CALL "CPOS"(LUN,STATUS,ANS)
; 	CALL "RPOS"(LUN,STATUS,DUMMY)
; \\
; .F
; ^IN THE FIRST TWO CASES, A NEW QUESTION IS POSITIONED TO (ACCESSED)
; AND A STATUS (COUNT) VALUE RETURNED.
; ^IN THE LAST CASE, THE POSITIONING REMAINS UNCHANGED, BUT THE STATUS
; (COUNT) IS RETURNED.
; .SL
; ^^RETURN QUESTION TEXT SUBROUTINES\\
; .ID-5
; <MQTXT
; .ID-5
; <CQTXT
; .ID-5
; <RQTXT
; .X <MQTXT
; .X <CQTXT
; .X <RQTXT
; .BR
; .NF
; ^FORMATS:
; ^^
; 	CALL "MQTXT"(LUN,STATUS,NAME$,STRING$)
; 	CALL "CQTXT"(LUN,STATUS,ANS,STRING$)
; 	CALL "RQTXT"(LUN,STATUS,DUMMY,STRING$)
; \\
; .F
; ^THE QUESTION TEXT OF THE NAMED, LINKED OR CURRENT QUESTION IS
; RETURNED IN THE VARIABLE <STRING$ (MUST BE A SINGLE VARIABLE NAME).
; ^IN THE CASE OF A MULTI-LINE INFO DISPLAY (TYPE 0), THE FIRST
; LINE IS RETURNED.
; .SL
; ^^RETURN ANSWER TEXT SUBROUTINES\\
; .ID -5
; <MATXT
; .ID -5
; <CATXT
; .ID-5
; <RATXT
; .X <MATXT
; .X <CATXT
; .X <RATXT
; .BR
; .NF
; ^FORMATS:
; ^^
; 	CALL "MATXT"(LUN,STATUS,NAME$,STRING$,ANS1)
; 	CALL "CATXT"(LUN,STATUS,ANS,STRING$,ANS1)
; 	CALL "RATXT"(LUN,STATUS,DUMMY,STRING$,ANS1)
; \\
; .F
; ^THE TEXT CORRESPONDING TO <ANS1 IS RETURNED IN <STRING$ FOR
; THE NAMED, LINKED OR CURRENT QUESTION.
; ^IN THE CASE OF A MULTI-LINE INFO DISPLAY, THE FIRST ANSWER
; CORRESPONDS TO THE SECOND LINE OF TEXT AND SO ON.
; ^NOTE THAT THERE IS NO WAY TO DISCERN IN ADVANCE HOW MANY LINES
; THERE ARE IN THIS CASE.
; ^THUS THE USER PROGRAM SHOULD TEST FOR THE PRESENCE OF '.<ENDM'
; IN THE RETURNED LINE.
; ^NO INTERNAL RESTRAINTS ARE PLACED ON THE VALUE OF <ANS1 AND
; SO PARTS OF FOLLOWING QUESTIONS MAY BE RETURNED IF CARE IS
; NOT EXERCISED.
; .SL
; ^^RETURN QUESTION NAME SUBROUTINES\\
; .ID-5
; <CQNAM
; .ID -5
; <RQNAM
; .X <CQNAM
; .X <RQNAM
; .BR
; .NF
; ^FORMATS:
; ^^
; 	CALL "CQNAM"(LUN,STATUS,ANS,STRING$)
; 	CALL "RQNAM"(LUN,STATUS,DUMMY,STRING$)
; \\
; .F
; ^IN THE FIRST CASE, THE NAME OF THE QUESTION LINKED BY <ANS IS
; RETURNED IN <STRING$.
; ^NOTE THAT THE LINKED QUESTION IS NOT POSITIONED TO, THUS
; ENABLING A USER PROGRAM TO RECORD MULTIPLE LINKED NAMES
; WITHOUT HAVING TO REPOSITION TO THE ORIGINAL QUESTION.
; ^IN THE SECOND CASE THE CURRENT QUESTION NAME WILL BE RETURNED
; IN <STRING$.
;-
;
; CALL FOR QUESTION DISPLAY
; CALL "MDIS"(LUN,STATUS,NAME$[,STRIN$,COUNT])
; STATUS RETURNS:
;	-1 LUN NOT FOUND
;	-2 FCS ERROR IN READ
;	-3 QUES NOT FOUND
;	-4 WRONG QUES TYPE
;
; DECLARE ALL OF THE ROUTINES DEFINED BELOW
;
	.GLOBL	MDIS	CDIS	RDIS	MPOS	CPOS
	.GLOBL	RPOS	MQTXT	CQTXT	RQTXT	MATXT
	.GLOBL	CATXT	RATXT	CQNAM	RQNAM
;
	.PSECT	BASIC4
ASCMAC:	.ASCII	/.MACRO/
ASCENM:	.ASCII	/.ENDM/
MDARG:	.BYTE	1,2,3,0
MDARG1:	.BYTE	1,2,3,3,1,0
	.EVEN
;
; CHAINED (LINKED) QUESTION CALL
; CALL "CDIS"(LUN,STATUS,ANS[,STRIN$,COUNT])
; PUTS UP QUESTION LINKED TO BY ANSWER TO PREVIOUS QUESTION (ANS).
	.PSECT	BASIC4
CDARG:	.BYTE	1,2,1,0
CDARG1:	.BYTE	1,2,1,3,1,0
	.EVEN
MDIS:	MOV	#MDIS02,-(SP)	;FAKE A SUBROUTINE JUMP
MDIS01:	JSR	PC,ARGCNT	;COUNT THE ARGUMENTS
	CMP	R0,#5		;FIVE?
	BLT	1$		;GO ONE PLACE IF LESS
	BEQ	2$		;ANOTHER IF SAME
3$:	ARGERR			;MORE IS ERROR
1$:	CMP	R0,#3		;MUST BE 3
	BNE	3$		;IF NOT, ERROR
	MOV	#MDARG,R0	;SHORT ARG TYPE LIST -> R0
	CLRF	COUNT		;CLEAR COUNT OF OPTIONAL INPUT STRING
	BR	4$
2$:	MOV	#MDARG1,R0	;LONG LIST -> R0
4$:	RTS	PC
MDIS02:	JSR	PC,SETUP	;DO INITIAL SETUP
	MOV	QNAM+2,R0	;ADDRESS OF QUESTION NAME -> R0
	MOV	QNAM,R4		;LEN -> R4
MDIS03:	JSR	PC,R50CVT	;COME BACK WITH RAD50 WORDS ON STACK
	JSR	PC,FILPOS	;GO GET FILE IN POSITION
MDIS04:	JSR	PC,DISPLA	;DO DISPLAY
	JMP	MDRTN		;AND RETURN WITH RESTORED R1
CDIS:	JSR	PC,MDIS01	;DO INITIAL CHECKING
	ADD	#CDARG-MDARG,R0	;ADJUST THE ARGUMENT LIST
	JSR	PC,SETUP	;SET UP THE FILE
	JSR	PC,QLINK	;GET POINTERS FOR LINKED QUES NAME STRING
	MOV	R1,R0		;ADDRESS -> R0
	JMP	MDIS03		;FINISH UP AS FOR MDIS
;
; RE-DISPLAY PREVIOUS QUESTION
; CALL "RDIS"(LUN,STATUS,DUMMY[,STRIN$,COUNT])
	.PSECT	BASIC4
RDIS:	JSR	PC,MDIS01	;DO INITIAL CHECKING
	ADD	#CDARG-MDARG,R0	;USE CHAIN TYPE ARG TYPE LIST
	JSR	PC,SETUP
	JSR	PC,STATST	;STORE STATUS (TYPE OR COUNT)
	BR	MDIS04
	.PSECT	BASIC4
MPOS:	MOV	#MDARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;DO INITIAL FILE SET UP
	MOV	QNAM+2,R0	;ADD. OF QUES NAME -> R0
	MOV	QNAM,R4		;LEN OF NAME -> R4
MPOS01:	JSR	PC,R50CVT	;GET RAD50 NAME ON STACK
	JSR	PC,FILPOS	;POSITION FILE TO QUESTION
	JMP	MDRTN		;AND RETURN
CPOS:	MOV	#CDARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;DO INITIAL FILE SET UP
	JSR	PC,QLINK	;DO QUESTION LINK (R1 HAS ADDRESS, R4 LEN)
	MOV	R1,R0		;ADDRESS -> R0
	BR	MPOS01		;FINISH UP AS ABOVE
RPOS:	MOV	#CDARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;DO INITIAL FILE SET UP
	JSR	PC,STATST	;STORE QUESTION STATUS (TYPE OR COUNT)
	JMP	MDRTN
	.PSECT	BASIC4
MQARG:	.BYTE	1,2,3,4,0
CQARG:	.BYTE	1,2,1,4,0
MQTXT:	MOV	#MQARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;INITIAL FILE SET UP
	MOV	QNAM+2,R0	;ADD. OF QUES. NAME -> R0
	MOV	QNAM,R4		;LEN -> R4
MQTXT1:	JSR	PC,R50CVT	;GET RAD50 NAME ON STACK
	JSR	PC,FILPOS	;POSITION TO QUESTION
MQTXT2:	JSR	PC,FILPNT	;POINT TO QUESTION
	GET$	,12(R5),4(R5)	;GET .MACRO LINE
	BCC	MQTXT5
MQTXT3:	LDCIF	#-2,AC0		;LOAD ERROR CODE
	JMP	ERRFN1		;AND FINISH UP
MQTXT5:	GET$			;GET QUESTION LINE
MQTXT4:	MOV	F.NRBD(R0),R4	;LEN OF LINE -> R4
	MOV	F.NRBD+2(R0),R3	;ADD OF LINE -> R3
	MOV	#STROUT,R5	;ADDRESS TO STORE -> R5
	JSR	PC,SSTORE	;GO STORE STRING
	JMP	MDRTN
CQTXT:	MOV	#CQARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;INITIAL FILE SETUP
	JSR	PC,QLINK	;GET LINKED QUESTION NAME
	MOV	R1,R0		;ADD. OF NAME -> R0
	BR	MQTXT1		;FINISH UP AS IN PREVIOUS CODE
RQTXT:	MOV	#CQARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;INITIAL FILE SET UP
	JSR	PC,STATST	;STORE STATUS OF PREVIOUS QUESTION
	BR	MQTXT2		;AND FINISH AS BEFORE
	.PSECT	BASIC4
MAARG:	.BYTE	1,2,3,4,1,0
CAARG:	.BYTE	1,2,1,4,1,0
	.EVEN
MATXT:	MOV	#MAARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;DO INITIAL FILE SET UP
	MOV	QNAM+2,R0	;ADD OF NAME -> R0
	MOV	QNAM,R4		;LEN OF NAME -> R4
MATXT1:	JSR	PC,R50CVT	;CONVERT NAME TO RAD50 ON STACK
	JSR	PC,FILPOS	;POSITION TO NAME ON STACK
MATXT2:	JSR	PC,FILPNT	;POINT TO .MACRO LINE
	GET$	,12(R5),4(R5)	;GET .MACRO LINE
	BCS	MQTXT3		;ON ERROR, BRANCH
	GET$			;QUESTION LINE
	BCS	MQTXT3
	LDF	ANS1,AC0	;ANSWER NUMBER -> AC0
	STCFI	AC0,R4		;INTEGERIZE -> R4
1$:	GET$			;GET NEXT LINE
	BCS	MQTXT3
	SOB	R4,1$		;GET ANSWER LINE WE WANTED
	BR	MQTXT4		;AND FINISH AS QUESTION CODE
CATXT:	MOV	#CAARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;INITIAL FILE SET UP
	JSR	PC,QLINK	;LINKED QUESTION ADD -> R1, LEN -> R4
	MOV	R1,R0		;ADDRESS -> R0
	BR	MATXT1		;USE ABOVE CODE TO FINISH
RATXT:	MOV	#CAARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;INITIAL FILE SET UP
	JSR	PC,STATST	;STORE STATUS (TYPE OR COUNT)
	BR	MATXT2		;AND FINISH WITH ABOVE CODE
	.PSECT	BASIC4
CQNAM:	MOV	#CQARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;INITIAL FILE SET UP
	JSR	PC,QLINK	;ADD OF LINKED QUES. -> R1, LEN -> R4
	MOV	R1,R3		;ADD -> R3
	MOV	#STROUT,R5	;ADDRESS OF STORE POINTER -> R5
	JSR	PC,SSTORE	;STORE NAME STRING
	JSR	PC,STATST	;STORE STATUS OF PREVIOUS QUESTION
	JMP	MDRTN
RQNAM:	MOV	#CQARG,R0	;ARG TYPE LIST -> R0
	JSR	PC,SETUP	;INITIAL FILE SET UP
	JSR	PC,STATST	;STORE STATUS (TYPE OR COUNT)
	JSR	PC,FILPNT	;POINT TO .MACRO LINE OF QUESTION
	GET$	,12(R5),4(R5)	;GET THE RECORD
	MOV	12(R5),R1	;ADDRESS OF LINE -> R1
	MOV	R1,R3		;DUPLICATE ADDRESS -> R3
	ADD	F.NRBD(R0),R3	;POINT PAST END OF LINE
	MOVB	"',,(R3)	;PUT IN DELIMITING COMMA
	SKIP			;GET FIRST NON-BLANK OR TAB
	ADD	#5,R1		;PUSH PAST '.MACRO'
1$:	SKIP			;NEXT NON-BLANK CHAR
	CMPB	R2,#',		;IS IT COMMA?
	BEQ	1$		;IF SO, THEN WANT SOMETHING ELSE
	MOV	R1,R3		;MAKE R3 POINT TO
	DEC	R3		;START OF NAME
2$:	MOVB	(R1)+,R2	;NEXT CHAR -> R2
	CMPB	R2,#40		;SPACE?
	BEQ	3$		;IF SO, END
	CMPB	R2,#11		;TAB?
	BEQ	3$		;ALSO END
	CMPB	R2,#',		;COMMA IS ALSO TERMINATOR
	BNE	2$		;IF NOT, NOT END
3$:	MOV	R1,R4		;END ADDRESS -> R4
	DEC	R4		;BACK UP TO TERMINATOR
	SUB	R3,R4		;LEN -> R4
	MOV	#STROUT,R5	;ADD OF PTR FOR STORAGE -> R5
	JSR	PC,SSTORE	;STORE NAME STRING
	JMP	MDRTN
	.END