.TITLE	AS3C
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; AS
; ASSORTED I/O ROUTINES
;
; VERSION X01
;
; DAVID G. CONROY	24-MAY-78
;
 
	.GLOBL	ERRORS
	.GLOBL	GETLIN
	.GLOBL	GETPCH
	.GLOBL	GETOKN
	.GLOBL	GETNB
	.GLOBL	GETC
	.GLOBL	UNGET
	.GLOBL	LOOKUP
	.GLOBL	INSERT
	.GLOBL	GLOBS
	.GLOBL	GETPS
	.GLOBL	FBOK
	.GLOBL	LINBUF
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
	.MCALL	GET$S
 
;
; EQUIVALENCES
;
 
BLANK	=	40		;ASCII BLANK
TAB	=	11		;ASCII TAB
 
;
; LOCAL DATA
; DIAGNOSTICS
;
 
ECT:	.WORD	1000.		;LINE NUMBER CONVERSION TABLE
	.WORD	100.		;
	.WORD	10.		;
	.WORD	1.		;
ECTE:	.BLKW	0		;END OF TABLE

LINPTR:	.BLKW	1		;WORKING LINE BUFFER POINTER
LINLST:	.BLKW	1		;UNGET LINE BUFFER POINTER
LINBUF:	.BLKB	81.		;80 BYTES + THE NUL
IDBUF:	.BLKB	8.		;IDENTIFIER BUFFER
EBUF:	.BLKB	7.		;CODE + BLANK + 4 DIGITS + NULL
 
STOVER:	.ASCIZ	"Symbol table overflow!"
PSTOVR:	.ASCIZ	"Psects table overflow!"
COLON:	.ASCIZ	":"
 
	.EVEN
 
;+
; ** ERRORS - PUT OUT ERRORS ONTO TI:
;
; THIS ROUTINE IS CALLED (FROM ASEMBL) AFTER EVERY SOURCE LINE
; IS PROCESSED BY PASS 3. IT SEARCHES THE ERROR FLAGS AND  ANY
; ERRORS FOUND ARE REPORTED.
;
; USES:
;	ALL
;-
 
ERRORS:	MOV	#ERRTAB,R3	;POINT AT FIRST ERROR

10$:	CMP	R3,#ERREND	;GOT THEM ALL
	BHIS	60$		;YES
	TSTB	(R3)+		;IS THE ERROR FLAG SET
	BEQ	50$		;NO

	TST	ARGV+2		;IS THERE ONLY 1 FILE
	BEQ	15$		;YES, FORGET THE NAME
	MOV	@ARGVPT,R4	;PUT OUT NAME IF NEEEDED
	BEQ	15$		;
	CLR	@ARGVPT		;
	MOV	#COLON,R5	;
	CALL	FMSG		;

15$:	MOV	#EBUF,R5	;POINT AT ERROR BUFFER
	MOVB	(R3),(R5)+	;CODE
	MOVB	#' ,(R5)+	;BLANK

	MOV	LNO,R0		;CONVERT LINE NUMBER
	MOV	#ECT,R1		;
20$:	MOV	#'0,R2		;START WITH "0"
30$:	CMP	R0,(R1)		;COMPUTE A DIGIT
	BLO	40$		;VIA
	SUB	(R1),R0		;VERY LONG DIVISION
	INC	R2		;
	BR	30$		;
40$:	MOVB	R2,(R5)+	;STORE CHARACTER
	TST	(R1)+		;NEXT TABLE ENTRY
	CMP	R1,#ECTE	;DONE
	BLO	20$		;NO

	CLRB	(R5)		;NULL ON THE END
	MOV	#EBUF,R5	;PUT IT OUT
	CALL	MSG		;

	CLRB	DFLAG		;CANCEL A -D

50$:	INC	R3		;NEXT ENTRY
	BR	10$		;

60$:	RETURN			;
 
;+
; ** GETLIN - GET A SOURCE LINE
;
; READ A SOURCE RECORD.
; UPDATE THE POINTERS USED TO SCAN THE LINE.
;
; USES:
;	R0
;-
 
GETLIN:	GET$S	#SFILE,#LINBUF,#80. ;READ SOURCE RECORD
	BCS	10$		;ERROR (ASSUME EOF)
	MOV	F.NRBD(R0),R0	;MARK END OF LINE WITH A NUL
	CLRB	LINBUF(R0)	;
	MOV	#LINBUF,LINPTR	;BACK UP LINE POINTER
	INC	LNO		;ADD 1 LINE UP
10$:	RETURN			;DONE
 
;+
; ** GETPCH - PEEK AT NEXT NON BLANK CHARACTER
; ** GETNB  - GET NEXT NON BLANK CHARACTER
; ** GETC   - GET NEXT CHARACTER
;
; OUTPUTS:
;	C BIT SET IF THE LINE RUNS OUT 
;	R0=CHARACTER (IF C BIT CLEAR)
;-
 
	.ENABL	LSB
 
GETPCH:	CALL	GETNB		;GET NEXT NONBLANK CHARACTER
	BCS	30$		;ISN'T ONE
	DEC	LINPTR		;PUT THE CHARACTER BACK
	BR	10$		;RETURN
 
GETNB:	CALL	GETC		;GET CHARACTER
	BCS	30$		;LINE RAN OUT
	CMPB	R0,#BLANK	;SKIP WHITE SPACE
	BEQ	GETNB		;
	CMPB	R0,#TAB		;
	BEQ	GETNB		;
	BR	10$		;RETURN
 
GETC:	MOVB	@LINPTR,R0	;GET SOURCE CHARACTER
	BEQ	20$		;END OF LINE
	INC	LINPTR		;BUMP POINTER
10$:	CLC			;COMMON RETURN, C BIT CLEAR
	BR	30$		;
20$:	SEC			;COMMON RETURN, C BIT SET
30$:	RETURN			;
 
	.DSABL	LSB
 
;+
; ** FBOK - CHECK OUT FB LABEL NUMBER
;
; INPUTS:
;	R1=THE NUMBER
;-
 
FBOK:	CMP	R1,#10.		;MUST BE 0 <= R1 <= 9
	BLO	10$		;
	CLR	R1		;FORCE IN RANGE FOR LOOKUP
	INCB	QERROR		;Q ERROR FOR FUNNY LABEL
10$:	RETURN			;
 
;+
; ** GETOKN - GET INPUT TOKEN
;
; GET THE NEXT BASIC SYMBOL FROM THE INPUT. THE VALUE OF THE
; SCANNING POINTER IS SAVED IN LINLST FOR THE BENEFIT OF THE
; UNGET ROUTINE; UNGET ONLY WORKS ONCE.
;
; OUTPUTS:
;	R0=TOKEN
;	R1=VALUE OF CONSTANTS
;-
 
GETOKN:	MOV	R2,-(SP)	;SAVE REGISTERS
	MOV	LINPTR,LINLST	;FOR UNGET
	CALL	GETNB		;GET CHARACTER, SKIPPING SPECES
	BCS	41$		;LINE RAN OUT
 
	CMPB	R0,#'0		;TEST FOR DIGITS
	BLO	42$		;
	CMPB	R0,#'9		;
	BHI	42$		;
	MOV	R0,R1		;BEGIN DECIMAL NUMBER
	MOV	R0,R2		;BEGIN OCTAL NUMBER
10$:	SUB	#'0,R1		;ASCII TO BINARY
	SUB	#'0,R2		;
	CALL	GETC		;GET A CHARACTER
	BCS	30$		;LINE RAN OUT, ITS OCTAL
	CMPB	R0,#'0		;BREAK IF NON DIGIT
	BLO	20$		;
	CMPB	R0,#'9		;
	BHI	20$		;
	ASL	R1		;MULTIPLY BY 10
	MOV	R1,-(SP)	;
	ASL	R1		;
	ASL	R1		;
	ADD	(SP)+,R1	;
	ADD	R0,R1		;ADD IN THE DIGIT
	ASL	R2		;NEXT OCTAL DIGIT
	ASL	R2		;
	ASL	R2		;
	ADD	R0,R2		;
	BR	10$		;GO FOR MORE
20$:	CALL	130$		;MAP UP DELIMITER
	CMPB	R0,#'F		;TEMP LABELS
	BEQ	400$		;YES
	CMPB	R0,#'B		;
	BEQ	400$		;YES
	CMPB	R0,#'.		;DECIMAL NUMBER
	BEQ	40$		;YES, NUMBER IS IN R1
	DEC	LINPTR		;PUT THE CHARACTER BACK
30$:	MOV	R2,R1		;AND CALL THE NUMBER OCTAL
40$:	MOV	#CON,R0		;TOKEN TYPE
	BR	115$		;RETURN
 
41$:	BR	120$		;LINE RAN OUT 'MAKE IT REACH' BR
 
400$:	CALL	FBOK		;INSURE IN RANGE
	ASL	R1		;THEN
	CMPB	R0,#'F		;GET POINTER FROM APPROPRIATE TABLE
	BNE	402$		;
	MOV	FBF(R1),R1	;
	BNE	406$		;
	BR	404$		;
402$:	MOV	FBB(R1),R1	;
	BNE	406$		;
404$:	INCB	UERROR		;U ERROR IF NO LABEL
	MOV	#CON,R0		;UNDEFINED TEMP LABEL IS A CONST 0
	BR	115$		;
406$:	MOV	#TLAB,R0	;TOKEN TYPE
	BR	115$		;
	
42$:	CMPB	R0,#'<		;LEFT AND RIGHT SHIFTS
	BEQ	44$		;
	CMPB	R0,#'>		;
	BNE	50$		;
44$:	MOV	R0,R2		;SAVE THE CHARACTER
	CALL	GETC		;GET THE NEXT ONE
	BCS	48$		;NO NEXT ONE
	CMPB	R0,R2		;TEST FOR '>>' AND '<<'
	BNE	46$		;NO
	MOV	#SL,R0		;GET CORRECT TOKEN
	CMP	R2,#'<		;
	BEQ	115$		;
	MOV	#SR,R0		;
	BR	115$		;
46$:	DEC	LINPTR		;ORDINARY CHARACTER
48$:	MOV	R2,R0		;
	BR	115$		;
 
50$:	CALL	130$		;MAP CHARACTER TO UPPER CASE
	CMPB	R0,#'.		;CHECK IF LEGAL TO BEGIN AN ID
	BEQ	60$		;
	CMPB	R0,#'_		;
	BEQ	60$		;
	CMPB	R0,#'A
	BLO	115$
	CMPB	R0,#'Z
	BHI	115$
60$:	MOV	#IDBUF,R1	;GET POINTER TO ID BUFFER
70$:	CMP	R1,#IDBUF+8.	;WILL THE CHARACTER FIT
	BHIS	80$		;NO, IGNORE IT
	CMPB	R0,#'_		;IS THE CHARACTER AN '_'
	BNE	75$		;NO
	MOVB	#'$,R0		;BECAUSE OF RAD50
75$:	MOVB	R0,(R1)+	;YES, SAVE IT
80$:	CALL	GETC		;GET NEXT CHARACTER
	BCS	100$
	CALL	130$		;MAKE IT UPPER CASE
	CMPB	R0,#'.		;LOOP BACK IF LEGAL
	BEQ	70$
	CMPB	R0,#'_
	BEQ	70$
	CMPB	R0,#'0
	BLO	90$
	CMPB	R0,#'9
	BLOS	70$
	CMPB	R0,#'A
	BLO	90$
	CMPB	R0,#'Z
	BLOS	70$
90$:	DEC	LINPTR		;PUT THE CHARACTER BACK
100$:	CMP	R1,#IDBUF+8.	;PAD THE NAME
	BHIS	110$
	CLRB	(R1)+
	BR	100$
110$:	MOV	#ID,R0		;RETURN ID
115$:	CLC			;GOOD RETURN
120$:	MOV	(SP)+,R2	;ELSE RETURN THE CHARACTER
	RETURN
 
130$:	CMPB	R0,#141		;MAP R0 TO UPPER CASE
	BLO	140$
	CMPB	R0,#172
	BHI	140$
	SUB	#BLANK,R0
140$:	RETURN
 
;+
; ** UNGET - PUT 1 TOKEN BACK
;
; THIS ROUTINE 'UNGETS' THE LAST TOKEN OBTAINED BY CALLING GETOKN.
; CAVEAT: IT ONLY WORKS ONCE; YOU CANNOT PUSH BACK SEVERAL TOKENS
; INTO THE INPUT.
;-
 
UNGET:	MOV	LINLST,LINPTR	;BACK UP THE SOURCE POINTER
	RETURN
 
;+
; ** LOOKUP - LOOKUP SYMBOL
;
; INPUTS:
;	R5=POINTER TO SYMBOL TABLE
;		(R5)=POINTER TO JUST PAST THE LAST ENTRY
;	       2(R5)=START OF THE FIRST SYMBOL
;    IDBUF=THE NAME TO LOOK UP
;
; OUTPUTS:
;	R5=POINTER TO SYMBOL IF FOUND
;-
 
LOOKUP:	MOV	R4,-(SP)	;SAVE REGISTERS
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	(R5)+,R4	;GET POINTER TO TABLE END
 
10$:	CMP	R5,R4		;IS THERE MORE
	BHIS	40$		;NO
	MOV	R5,R3		;POINT AT NAME IN THE NODE
	ADD	#S.N,R3
	MOV	#IDBUF,R2	;AND AT THE ID BUFFER
 
20$:	CMPB	(R2)+,(R3)+	;SEE IF THEY MATCH
	BNE	30$		;NO
	CMP	R2,#IDBUF+8.	;PERHAPS
	BLO	20$		;NOT YET
	CLC			;FOUND IT
	BR	50$
 
30$:	ADD	#S.SIZE,R5	;MOVE TO NEXT ENTRY
	BR	10$
 
40$:	SEC			;NOT THERE
50$:	MOV	(SP)+,R2	;RETURN
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	RETURN
 
;+
; ** INSERT - ADD A SYMBOL TO THE USER TABLE
;
; PUT SYMBOL IN IDBUF INTO THE USER SYMBOL TABLE. CHECK FOR THE
; TABLE OVERFLOWING, BUT NOT FOR DUPLICATE ENTRIES.
;
; OUTPUTS:
;	R5=POINTER TO THE NEW ENTRY
;-
 
INSERT:	MOV	R4,-(SP)	;SAVE REGISTERS
	MOV	UST,R5		;GET POINTER TO THE END OF THE TABLE
	CMP	R5,#USTMAX	;CHECK FOR NO ROOM
	BHIS	20$
 
	CLR	(R5)+		;S.V = 0
	MOV	#ST.UND,(R5)+	;S.T = UNDEFINED
	CLR	(R5)+		;S.F = 0
	MOV	#IDBUF,R4	;COPY IN THE NAME
10$:	MOVB	(R4)+,(R5)+
	CMP	R4,#IDBUF+8.
	BLO	10$
 
	MOV	R5,UST		;SET NEW TOP OF TABLE
	SUB	#S.SIZE,R5	;POINT AT THE NEW ENTRY
	MOV	(SP)+,R4	;RETURN
	RETURN
 
20$:	TST	ARGV+2		;1 FILE
	BEQ	30$		;YES, NO NAME
	MOV	@ARGVPT,R4	;SYMBOL TABLE OVERFLOW
	BEQ	30$
	MOV	#COLON,R5
	CALL	FMSG
30$:	MOV	#STOVER,R5
	CALL	MSG
	MOV	SPSAVE,SP
	RETURN			;THIS IS A RETURN FROM ASEMBL
 
;+
; ** GLOBS - MAKE UNDEFINED SYMBOLS GLOBAL
;
; USES:
;	R4, R5
;-
 
GLOBS:	MOV	UST,R4		;END POINTER
	MOV	#UST+2,R5	;START POINTER
10$:	CMP	R5,R4		;BREAK IF AT THE END
	BHIS	30$
	CMP	S.T(R5),#ST.UND	;IS IT UNDEFINED
	BNE	20$		;NO
	BIS	#SF.GBL,S.F(R5)	;YES, MAKE IT GLOBAL
20$:	ADD	#S.SIZE,R5
	BR	10$
30$:	RETURN
 
;+
; ** GETPS - GET PSECT TABLE POINTER
;
; INPUTS:
;    IDBUF=NAME OF THE PSECT
;
; OUTPUTS:
;	R5=POINTER TO PSECT TABLE ENTRY
;-
 
GETPS:	MOV	R4,-(SP)	;LOOK IT UP
	MOV	#PSECT,R5
	CALL	LOOKUP
	BCC	20$		;FOUND IT
	MOV	PSECT,R5	;ADD NEW ENTRY TO TABLE
	CMP	R5,#PSECTM	;SEE IF FULL
	BHIS	30$
	CLR	(R5)+		;P.L
	MOV	#PF.REL,(R5)+	;P.F
	CLR	(R5)+		;P.FUZZ
	MOV	#IDBUF,R4	;P.N
10$:	MOVB	(R4)+,(R5)+
	CMP	R4,#IDBUF+8.
	BLO	10$
	MOV	R5,PSECT	;FIX END OF TABLE POINTER
	SUB	#P.SIZE,R5
20$:	MOV	(SP)+,R4
	RETURN
 
30$:	TST	ARGV+2		;1 FILE
	BEQ	40$		;YES, NO NAME
	MOV	@ARGVPT,R4	;PSECT TABLE OVERFLOW
	BEQ	40$
	MOV	#COLON,R5
	CALL	FMSG
40$:	MOV	#PSTOVR,R5
	CALL	MSG
	MOV	SPSAVE,SP
	RETURN			;FROM ASEMBL
 
	.END