⟦35df334fb⟧

TextFile

;INPUT ROUTINES
;
	NAME INPT
	ENTRY READ,READLN,INPUT,ERRTYP,L110,L112
	EXT EOF,EOLN,ERROR,PERROR,LOOK,FLTIN,TIN,TXTIN
	EXT TXTYP,BYTIN,STRERR,STRMSG,CO
	INCLUDE DEFLT.SRC
;
	IF	COMPILER	;Compiler never calls RBLOCK
RBLOCK:
	ELSE
	EXT	RBLOCK
	ENDIF
;
;READLN INPUTS DATA FROM THE FILE INTO THE LISTED 
;PARAMETERS.  THEN ADVANCES THE POINTER IN THE FILE TO
;THE BEGINNING OF THE NEXT LINE IN THE FILE AND SETS THE
;END OF LINE FLAG. IF THE END OF FILE IS REACHED BEFORE
;THE END OF THE PARAMETER LIST A FATAL ERROR IS DETECTED
;AND EXECUTION IS TERMINATED.

L112:
READ:	CALL	READIT		;READ WHAT'S IN THE LIST
	RET			;AND RETURN

L110:
READLN:	CMP	C		;ARE THERE ANY PARAMETERS?
	JRNZ	REDLN2		;YES PROCESS THE READLN
	CMP	B
	JRZ	SKCR		;NO PARAMETERS
REDLN2:	INR	A		;INDICATE THAT THIS IS A READLN
	CALL	READIT
;IF WE'RE AT THE END OF A LINE THEN DON'T SCAN AT ALL
;OTHERWISE, SEARCH FOR THE NEXT CARRIAGE RETURN, LINE FEED
SKCR:	CALL	EOLN		;CHECK FOR EOL
	JRC	ONEMOR		;ONE MORE CALL TO INPUT
	CALL	INPUT		;NO....SKIP ANOTHER CHARACTER
	JR	SKCR
ONEMOR:	MOV	A,H		;CHECK FOR A CONSOLE FILE
	ORA	A		;IF SO THEN SKIP THE EXTRA READ
	RZ
	CALL	EOF
	CNC	INPUT		;SKIP THE SPACE
	XRA	A		;CLEAR ACC
	RET

;INPUT IS CALLED WITH THE PASCAL FILE BUFFER ADDRESS IN HL
;IT RETURNS THE NEXT READ BYTE IN REGISTER A.
;INPUT CAN CHANGE ONLY THE A REGISTER AND C REGISTER
INPUT:	MOV	A,H
	ORA	A
	JRNZ	NCONS

;ZERO ADDRESS IN HL MEANS INPUT IS FROM THE CONSOLE WITH NO LOOK AHEAD.
	CALL	TIN
	JM	LSTCR
	MVI	L,0
	RET
;CARRIAGE RETURN ENCOUNTERED CHECK FOR END OF INPUT ITEM
LSTCR:	CPI	'C'&3FH	;CHECK FOR CTRL-C
	JZ	ERROR
	DCR	L	;CHECK FOR FIRST BYTE OF ITEM
	CZ	TXTIN	;GET MORE IF THIS IS THE FIRST CALL
	CALL	TIN	;GET FIRST CHARACTER AND RETURN TO CALLER
	CPI	'C'&3FH	;CHECK FOR CTRL-C
	JZ	ERROR
	CPI	LF
	RNZ
	MVI	A,CR
	RET		;DON'T RETURN A LINE FEED, USE A CR INSTEAD

;NON-ZERO ADDRESS IN HL MEANS DISK FILE INPUT
NCONS:	PUSH	B
	PUSH	D
	XRA	A
	BIT	1,M	;CHECK FOR READ BEYOND END OF FILE
	JNZ	RBEOF
	MOV	D,H
	MOV	E,L
	BIT 	0,M	;TEST EOLN BIT
	JRZ	NCONS1	;NOT EOLN. GET NEXT CHAR.
;RETURN A SPACE FOR A READ WHEN EOLN IS TRUE
	INX	H
	INX	H
	INX	H	;FCB
	CALL	BYTIN
	JRC	GEOF	;EOF?
	CPI	EOFMRK	;TEST FOR END OF FILE MARK
	JRZ	GEOF
	CALL	BYTIN
	JRC	GEOF	;EOF?
	CPI	EOFMRK
	JRZ	GEOF
	DCX	H
	DCX	H
	DCX	H
	CPI	CR	;CHECK FOR ANOTHER EOLN
	JRZ	LOTS
	RES	0,M	;RESET EOLN BIT
LOTS:	INX	H
	MOV	M,A	;NEW CHAR IN READ AHEAD BYTE
	DCX	H
	MVI	A,' '	;RETURN A SPACE
	CMP	A	;SET FLAGS
	POP	D
	POP	B
	RET		;DONE

NCONS1:	INX	H
	INX	H
	INX	H
	CALL	BYTIN	;GET NEXT CHARACTER
	JRC	GEOF
	CPI	EOFMRK	; Test for end of file mark.
	JRZ	GEOF
	MOV	B,A
	DCX	H	;POINT TO FLAG BYTE
	DCX	H
	DCX	H
	RES	0,M	;RESET EOLN
	CPI	CR
	JRNZ	FIN	;NEXT CHARACTER A CR
	BSET	0,M	;SET EOLN TRUE
FIN:	RES	1,M	;RESET EOF FLAG
	INX	H
	MOV	C,M	;READ LOOK AHEAD
	MOV	M,B
	DCX	H
	MOV	A,C
NTXIT:	POP	D
	POP	B
	CPI	' '	;SET FLAGS LIKE TIN
	RET

;END OF FILE
GEOF:	DCX	H
	DCX	H
	MOV	C,M	;READ LOOK AHEAD
	MOV	M,A
	MOV	A,C
	DCX	H
	BSET	0,M	;SET EOLN
	BSET	1,M	;SET EOF
	JR	NTXIT


;READ BEYOND END OF FILE, FATAL ERROR
RBEOF:	LXI	H,EOFMES
	JMP	PERROR
EOFMES:	IF 	NOT COMPILER
	DB	'Read beyond EO','F'+80H
	ELSE	
	DB	'premature EO','F'+80H
	ENDIF

;PROCESS THE PARAMETER LIST, THE ODD WORDS SPECIFY THE TYPE
;1-BOOLEAN, 2-INTEGER, 3-CHARACTER,4-SCALAR, 5-NON-TEXT,
;6-FLOATING POINT,7-STRING.
;THE EVEN WORDS ARE THE ADDRESS OF THE PARAMETER.
;FILE BUFFER ADDRESS ALREADY IN HL

RSSLOC	EQU	5	;SKIP RETURN ADDRESSES

READIT:	PUSH	X
	LXI	X,RSSLOC
	MOV	D,B	;NUMBER OF PARMS
	MOV	E,C
	DADX	SP	;EACH PARAMETER IS 4 BYTES LONG
	DADX	D	;SET X TO START OF PARAMETER LIST
	DADX	D	;SET X TO START OF PARAMETER
	DADX	D	;SET X TO START OF PARAMETER
	DADX	D	;SET X TO START OF PARAMETER
	PUSH	X	;NEW STACK POINTER

;IX POINTS TO NEXT BYTE ON PARAMETER LIST
;DE HOLDS THE NUMBER OF PARAMATERS IN THE PARAMETER LIST
	MOV	B,A	;SAVE READ/READLN INDICATOR
	XRA	A
	LXI	H,0	;ASSUME CONSOLE FILE UNTIL PROVEN OTHERWISE
	CMP	-2(X)	;IDENTIFY FILE TYPE
	JRNZ	BEGIN	;CONSOLE FILE...GO PROCESS PARAMETER LIST
	MOV	H,0(X)	;FILE BUFFER ADDRESS
	MOV	L,-1(X)
	CMP	B	;SEE IF THIS IS A READLN
	JRZ	NTRDLN	;NO, NOT A READLN
	BSET	5,M	;SET BIT TO SAY SO
NTRDLN:	DCX	D	;FILE INFO. TAKES 8 BYTES,OR TWO PARAMATERS
	DCX	D
	LXI	B,-8
	DADX	B	;FIRST PARAMETER
	PUSH	D	;SAVE PARAMETER COUNT ON STACK
	PUSH	H	;SAVE FBA
	MOV	A,4(X)	;RECORD NUMBER HIGH BYTE
	MOV	E,3(X)	;RECORD NUMBER LOW BYTE
	ORA	E	;DIRECT ACCESS?
	JRZ	SEQRD	;NO, SEQUENTIAL READ
RRPREP:	BSET	4,M	;RANDOMLY ACCESSED
	MOV	D,4(X)	;RECORD NUMBER HIGH BYTE
	MOV	H,2(X)	;RECORD SIZE HIGH BYTE
	MOV	L,1(X)	;RECORD SIZE LOW BYTE
	POP	B	;FILE BUFFER ADDRESS
	PUSH	B
	XRA	A	;ZERO IN A REG TO RBLOCK INDICATES READ 
	CALL	RBLOCK	;PERFORM DIRECT READ
RRCLN:	POP	H	;FBA
	POP	D	;PARAMETER  COUNT
	JR 	FILTST
SEQRD:	POP	H	;FBA
	PUSH	H
	BIT	3,M	;WAS PREVIOUS OPERATION A WRITE
	JRNZ	RRPREP	;YES, MUST FLUSH BUFFER
	POP	H
	POP	D	;PARAM. COUNT
FILTST:	XRA	A	;NO,SEQUENTIAL READ
	CMP	5(X)	;TEXT OR NON-TEXT
	JNZ	NTXT	;NON-TEXT FILE

;TEST FOR THE END OF LIST
BEGIN:	MOV	A,D
	ORA	E
	JRZ	THREW	;ZERO COUNT
;GET PARAMETER TYPE
NEWPAR:	XRA	A
	CMP	H
	JRNZ	NEWP1	;CHECK FOR CONSOLE FILE
	INR	L	;INDICATE FIRST CHARACTER
NEWP1:	MOV	B,-2(X)
	DCR	B
	CZ	BOOLE	;BOOLEAN
	DCR	B
	CZ	RINTEG	;INTEGER
	DCR	B
	CZ	CHARA	;CHARACTER
	DCR	B
	CZ	ENUM	;SYMBOLIC READ OF AN ENUMERATION TYPE
	DCR	B
	DCR	B

	IF	NOT COMPILER ;Compiler doesn't need this
	CZ	FLTIN	;GET A FLOATING POINT NUMBER
	ENDIF

	DCR	B
	CZ	STREAD	;STRING
	DCX	D	;COUNTER
	LXI	B,-4	;POINTER
	DADX	B
	JR	BEGIN

;REMOVE PARAMETER LIST FROM STACK, RESTORE X, AND RETURN
THREW:	XCHG
	POP	H	;POP NEW STACK POINTER
	MOV	M,D	;SAVE BUFFER ADDRESS
	DCX	H
	MOV	M,E
	POP	X	;RESTORE X
	POP	D	;SECOND RETURN ADDRESS
	POP	B	;FIRST RETURN ADDRESS
	SPHL		;NEW STACK POINTER
	POP	H	;FILE BUFFER ADDRESS
	PUSH	B	;FIRST RETURN ADDRESS
	PUSH	D	;SECOND RETURN ADDRESS
	RET		;RETURN

;CHARACTER READS THE NEXT CHARACTER IN FROM THE FILE
;AND MOVES IT TO THE APPROPRIATE LOCATION.
CHARA:	MOV	B,-3(X)	;GET LENGTH
	PUSH	H	;FILE BUFFER ADDRESS
	MOV	H,0(X)	;GET ADDRESS OF VARIABLE
	MOV	L,-1(X)
;INPUT THE CHARACTERS
	XTHL
	CALL 	EOF
	JC	RBEOF	;READING A NEW PARAM. WITH EOF TRUE. FATAL ERROR
	MOV	A,H	;CHECK FOR A CONSOLE FILE
	ORA	A
	JRZ	CHST	;ALWAYS CALL INPUT AT LEAST ONCE FOR THE CONSOLE
	CALL	EOLN
	JRNC	CHST
	BIT	5,M	;TEST FOR READLN CALL
	JRZ	DOSKIP	;NOT A READLN SO DON'T CHECK PARM COUNT
	DCX	D	;CHECK FOR LAST PARM
	MOV	A,E
	ORA	D
	INX	D	;RESTORE COUNT
	JRZ	FILLIN	;LAST PARM OF A READLN SO DON'T SKIP
DOSKIP:	CALL	INPUT
	JR	FILLIN
STRIN:	XTHL		;SWITCH VARIABLE ADDRESS WITH
	CALL	EOF	;RECOGNIZE END OF FILE AS A TERMINATER
	JRC	FILLIN
	CALL	EOLN
	JRC	FILLIN
CHST:	CALL	INPUT
	XTHL		;FILE BUFFER ADDRESS
	MOV	M,A	;STORE CHARACTER
	DCX	H
	DJNZ	STRIN
	POP	H	;FILE BUFFER ADDRESS
	RET

;FILLIN PADS STRING OUT TO REQUIRED LENGTH WITH BLANKS
FILLIN:	XTHL
FILLN1:	MVI	M,' '
	DCX	H
	DJNZ	FILLN1
	POP	H	;FILE BUFFER ADDRESS
	RET

	NLIST


;BOOLEAN READS THE CHARACTER STRING TRUE OR
;FALSE FROM THE INPUT FILE AND TRANSFORMS T TO 1
;AND F TO 0 AND STORES IT IN THE APPROPRIATE PLACE.
BOOLE:
	IF	NOT COMPILER	;DON'T USE WITH COMPILER
	CALL	INPUT
	CPI	'T'
	JRZ	TRUIN	;TRUE
	CPI	't'
	JRZ	TRUIN	;TRUE
	CPI	'F'	;FALSE
	JRZ	FALIN
	CPI	'f'
	JRZ	FALIN	;FALSE
	CPI	' '	;A BLANK
	JRZ	BOOLE
	JMP	ERRTYP	;TYPE ERROR

;TRUE, FIND THE E OR e OR ' ' OR CR OR LF OR SKIP AT MOST THE NEXT 
;THREE CHARACTERS.
TRUIN:	MVI	B,3
	CALL	SKIM
	MVI	B,1	;VARIABLE GETS ONE
	JMPR	STOBOO

;FALSE, FIND THE E,e,' ',OR SKIP AT MOST FOUR CHARACTERS.
FALIN:	MVI	B,4
	CALL	SKIM
	MVI	B,0	;VARIABLE GETS 0

;GET VARIABLE LOCATION
STOBOO:	PUSH	H	;SAVE BUFFER ADDRESS
	MOV	H,0(X)
	MOV	L,-1(X)
;STORE BOOLEAN VALUE
	MOV	M,B
	XRA	A	;CLEAR A
	MOV	B,A	;CLEAR B
	POP	H	;RESTORE  BUFFER ADDRESS
	RET

;SKIM SCANS THE NEXT N CHARACTERS (N IN B) OF THE INPUT 
;STREAM  AND STOPS AFTER THE FIRST E OR ' '.
SKIM:	CALL	INPUT	;GET THE NEXT CHARACTER
	CPI	'E'
	RZ		;E FOUND
	CPI	'e'
	RZ		;e FOUND
	CPI	' '
	RZ		;BLANK FOUND
	CPI	','	;COMMA FOUND
	RZ
	CALL	EOF	;RECOGNIZE END OF FILE AS A TERMINATER
	RC
	DJNZ	SKIM
	RET
	ENDIF


;ENUM READS AN IDENTIFIER FROM THE INPUT STREAM AND
;ATTEMPTS TO MAKE A SYMBOLIC MATCH AGAINST THE LIST OF
;POSSIBLE IDENTIFIERS FOR THIS ENUMERATION TYPE. IF  A
;MATCH IS MADE THEN THE TABLE POSITION OF THE MATCH IS
;THE ORDINAL NUMBER OF THE VARIABLE IN QUESTION.
ENUM:
	IF	NOT COMPILER
	DCX	D	;DECR PARAM COUNTER
	PUSH	D	;SAVE PARAM COUNTER
	PUSH	H	;SAVE FILE BUFFER ADDR
	PUSH	X	;SAVE VAR ADDR
ENUM1:	XRA	A
	MOV	C,A	
	MOV	B,A
	JR	CHK	
STR:	CALL	EOF
	JRC	ENDSTR
	CALL	EOLN
	JRC	ENDSTR
CHK:	XRA	A
	CMP	C	;FIRST CHAR ?
	JRZ	GETCHR	;YES
	CALL    LOOK	;NO,LOOK AT NEXT CHAR
	JMP	SEPCHK
GETCHR:	CALL	INPUT	;GET NEXT CHAR
SEPCHK:	CPI	' '	;CHECK FOR SEPARATORS
	JRZ	LEADCH
	CPI	CR	;CARR. RET.
	JRZ	LEADCH
	CPI	9	;TAB
	JRZ	LEADCH
	CPI	LF	;LINE FEED
	JRZ	LEADCH	
	CPI	12	;FORM FEED
	JRZ	LEADCH
	CPI	'#'	;CHECK FOR ALLOWED CHAR
	JRZ	OK
	CPI	'_'
	JRZ	OK
	CPI	'$'
	JRZ	OK
	CPI	'z'+1	;CHECK FOR LOWER CASE LETTER
	JRC	LOWCHK
UPCASE:	CPI	'Z'+1	;CHECK FOR UPPER CASE LETTER
	JRC	CAPCHK
DGIT:	CPI	'9'+1	;CHECK FOR DIGITS
	JRC	DGTCHK
	JMP	SCERR	;CHAR NOT ALLOWED
LOWCHK:	CPI	'a'	;CHECK FOR LOWER CASE LETTER
	JRC	UPCASE	;NOT LOWER CASE
	ANI	0DFH	;CONVERT TO UPPER CASE
	JR 	OK
CAPCHK:	CPI	'A'	;CHECK FOR UPPER CASE LETTER
	JRC	DGIT	;NOT UPPER CASE
	JR	OK
DGTCHK:	CPI	'0'	;CHECK FOR DIGIT
	JC	SCERR	;CHAR NOT ALLOWED
	MOV	D,A	;SAVE DIGIT
	XRA	A
	CMP	C	;FIRST CHAR?
	JNC	SCERR	;DIGIT CAN'T BE FIRST CHAR
	MOV	A,D
OK:	MOV	D,A
	MVI	A,8
	CMP	C	;IS VAR 8 CHARS LONG?
	JRZ	VARFUL	;YES.DON'T PUSH
	XRA	A
	CMP	C	;FIRST CHAR?
	JRZ	NOINPT	;YES.CHAR ALREADY INPUT
	CALL	INPUT
NOINPT:	PUSH	D	;SAVE CHAR
	INX	SP	;ONLY ADDING ONE BYTE
	INR	C	;COUNT CHARS IN STRING
	JR	STR
VARFUL:	CALL	INPUT
	JMP	STR
LEADCH:	XRA	A
	CMP	C	;ANY CHARS IN STRING YET?
	JZ	GETCHR	;NO. GET NEXT CHAR
ENDSTR:	MOV	H,-4(X)	;GET TABLE ADDR TOP
	MOV	L,-5(X)
	PUSH	H	;SAVE TABLE ADDR
	MOV	A,-7(X)	;GET SIZE OF TABLE
	LXI	X,1
	DADX	S	;X GETS TOP OF STK
	DADX	B
	MOV	B,A	;B GETS MAX SIZE OF TABLE
	XRA	A
	MOV	E,A
CPAR:	INR	E	;COUNT CURRENT CHAR
	MOV	A,0(X)
	CMP	M	;ARE CHARS THE SAME?
	JRZ	TSTLNG	;LETTERS EQUAL.CHECK LENGTH
	XRA	A	;LETTERS NOT EQUAL
	SUB	B	;CHK IF LAST TABLE ENTRY
	JRZ	NOMTCH	;LAST ENTRY.NO MATCH
NXTSTR	DCR	B	;DEC STRINGS LEFT IN TABLE
	XRA	A
	MOV	D,A
	DCR	E
	DADX	D	;BACK TO FIRST CHAR IN STK
	MVI	A,8
	SUB	E
	MOV	E,A
	DAD	D	;HL GETS FIRST CHAR OF NXT TABLE ENTRY
	XRA	A
	MOV	E,A	;CHAR COUNT SET TO ZERO
	JR	CPAR
TSTLNG	XRA	A
	MOV	A,E
	CMP	C	;TEST IF LAST CHAR OF STR
	JRZ	MAYMAT
	DCX	X	;NOT LAST CHAR
	INX	H	;GET NXT CHAR IN TABLE
	JR	CPAR
MAYMAT	XRA	A
	MVI	A,8
	CMP	E	;CHK IF 8TH CHAR
	JRZ	MATCH	;MATCH FOUND
	INX	H	;GET NXT CHAR IN TABLE
	XRA	A
	MVI	A,' '	
	CMP	M
	DCX	H	;A MATCH
	JRNZ	NXTSTR	;NO MATCH GET NXT STR
MATCH	XRA	A
	MOV	H,A	;GET VAR OFF STACK
	MOV	L,E
	POP	D	;GET TABLE ADDR
	DAD	S
	SPHL		;VAR OFF STACK
	POP	X	;GET VAR ADDR
	MOV	A,-7(X)	;GET MAX TABLE INDEX VALUE
	SUB	B	;SUB NUMBER OF TABLE ENTRIES NOT CHECKED
	MOV	H,0(X)	;HL GETS VAR ADDR
	MOV	L,-1(X)
	MOV	M,A	;STORE TABLE INDEX VALUE
	POP	H	;RESTORE FILE BUFFER ADDR
	POP	D	;RESTORE PARA COUNTER
	LXI	B,-4
	DADX	B	;DECR IX FOUR BYTES
	RET
SCERR:	LXI	H,0
	JR	NM1
NOMTCH:	LXI	H,2	;SKIP TABLE ADDRESS ON STACK
NM1:	DAD	SP
	XRA	A
	MOV	B,A
	DAD	B	;BC HAS # OF CHARS. PUT ON STACK
	SPHL		;SP -> LOW BYTE OF VARIABLE ADDR
	POP	X	;VAR. ADDR.
	POP	H	;FBA
	XRA	A
	CMP	H	;CONSOLE FILE?
	JNZ	ERRTYP	;NO, TERMINATE
	PUSH	H	;YES,FBA BACK ON STACK
	LXI	H,REPROM
	CALL 	TXTYP	;REPROMPT
NM2:	CALL	TIN	;CLEAR INPUT BUFFER
	CPI	CR
	JRNZ	NM2
	POP	H	;RESET HL AND FIX UP STACK
	PUSH	H
	PUSH	X
	JMP	ENUM1
	JMP	ERRTYP	;SCALAR ERROR	
	ENDIF

;
;STREAD READS A STRING OF CHARACTERS
;
STREAD:	XRA	A
	IF	NOT COMPILER	;Compiler doesn't need this
	MOV	C,A	;ZERO CHARACTER COUNTER
	PUSH	H	;FBA
	MOV	H,0(X)	;HL <- ADDRESS OF STRING
	MOV	L,-1(X)
	MOV	B,-3(X)	;MAX LENGTH
	DCX	H	;FIRST CHAR. SPACE
	XTHL
	CALL	EOF
	JC	RBEOF	;READING NEW PARAM. WITH EOF TRUE 
			;READ BEYOND EOF ERROR
	MOV 	A,H
	ORA	A	;CHECK FOR CONSOLE
	JRZ	STRNPT	;READ AT LEAST ONE CHAR FROM CONSOLE
	CALL	EOLN
	JRNC	STRNPT
STRG1:	XTHL
	INX	H	;LENGTH BYTE OF STRING
	XRA	A
	MOV	M,A	;ZERO LENGTH
	POP	H
	RET
STRG:	XTHL	
	CALL	EOF	;CHECK FOR EOF
	JRC	NDSTR	;END OF STRING
	CALL	EOLN	;CHECK FOR EOLN
	JRC	NDSTR
STRNPT:	CALL 	INPUT	;GET CHARACTER
	CPI	CR	;CARRIAGE RETURN?
	JRZ	NDSTR
	CPI	LF	;LINE FEED?
	JRZ	NDSTR
	CPI	EOFMRK
	JRZ	NDSTR	;END OF FILE?
	XTHL
	INR	C	;INCREMENT ACTUAL LENGTH
	EXAF
	MOV	A,B	;MAXIMUM LENGTH	
	CMP	C	;CHECK FOR STRING OVERFLOW
	JRC	STRER	;OVERFLOW
	EXAF	
	MOV	M,A	;STORE CHAR.
	DCX	H
	JR	STRG	;GET NEXT CHAR
STRER:	POP	H	;FBA
	XRA	A
	CMP	H	;CONSOLE FILE?
	JNZ	STRERR	;NO
	PUSH	H	;YES, TYPE ERROR MESSAGE AND TRY AGAIN
	LXI	H,STRMSG  ;'string too long'
	CALL	TXTYP	;PRINT MESSAGE
	MVI	C,20H
	CALL 	CO	;CARRIAGE RETURN
	LXI	H,REPROM  ;'error in input, try again'
	CALL	TXTYP	;PRINT MESSAGE
	POP	H
STRER1:	CALL	TIN	;FLUSH BUFFER
	CALL	EOLN	;UNTIL EOLN
	JRNC	STRER1
	CALL	TXTIN	;GET NEW INPUT FROM CONSOLE
	JMP	STREAD	;AND READ IT
NDSTR:	XTHL
	XRA	A
	MOV	B,A
	DAD	B 	;BEGINNING OF STRING
	INX	H
	MOV	M,C	;SAVE ACTUAL LENGTH
	POP	H	;FBA
	RET
	ENDIF
;
;RINTEG GETS THE INTEGER FROM THE INPUT FILE AND STORES IT
RINTEG:
	IF	NOT COMPILER	;DON'T USE WITH COMPILER
	MOV	B,-3(X)
	DCR	B
	JRNZ	INT2	;DOUBLE BYTE INTEGER
;

;INT1 CONVERTS A CHARACTER STRING TO A SINGLE BYTE
;BYTE INTEGER IN THE RANGE FROM 0 TO 255.  IT PRODUCES
;AN ERROR MESSAGE IF THE CHARACTER STRING REPRESENTS A
;NUMBER LARGER THAN THIS.

INT1:	CALL	CONV	;GET THE NUMBER IN BC
	CMP	B	;CHECK THE SIZE
	JRZ	SMPOS	;POSITIVE
	CMP	H
	JNZ	ERRTYP
	PUSH	H
	LXI	H,REPROM
	CALL	TXTYP
	POP	H
	JMPR	INT1

;MOVE LOW BYTE TO MEMORY
SMPOS:	PUSH	H
	MOV	H,0(X)	;GET ADDRESS
	MOV	L,-1(X)
	MOV	M,C	;MOVE NUMBER
	POP	H	;RESTORE THE BUFFER ADDRESS
	XRA	A	;0 A
	MOV	B,A	;0 B
	RET

;INT2 CONVERTS A CHARACTER STRING TO A DOUBLE
;BYTE INTEGER IN THE RANGE FROM 32,767 TO -32768.
;IT PRODUCES AN ERROR MESSAGE.

INT2:	CALL	CONV

;MOVE NUMBER TO MEMORY, CONV CATCHES THE 15 BIT OVERFLOWS.
	PUSH	H	;SAVE BUFFER ADDRESS
	MOV	H,0(X)	;GET PARAMETER ADDRESS
	MOV	L,-1(X)
	MOV	M,B	;HI BYTE
	DCX	H
	MOV	M,C	;LOW BYTE
	POP	H
	XRA	A
	MOV	B,A
	RET

;CONVERT READS IN THE DIGITS, AND CONVERTS THEM TO
;A 15 BIT NUMBER IN THE BC REGISTER PAIR.  CONVERT 
;DETECTS 15 BIT OVERFLOWS, TRUNCATES THE RESULT TO 
;15 BITS AND CAUSES AN ERROR MESSAGE TO BE PRINTED.

CONV:	PUSH	D		;SAVE D,H
	PUSH	H
	LXI	H,0		;INITIALIZE THE RESULT
	MOV	B,H		;SIGN INDICATOR, DEFAULT +IVE
	XTHL

BLNK1:	CALL	INPUT
	CPI	' '
	JRZ	BLNK1		;LEADING BLANK?
	CPI	'-'		;MINUS SIGN?
	JRNZ	NMINUS
	INR	B		;INDICATE NEGATIVE RESULT
	JR	GETDIG
NMINUS:	CPI	'+'		;POSITIVE SIGN
	JRNZ	CHKDIG		;NO, CHECK FOR A DIGIT

GETDIG:	CALL	INPUT		;GET NEXT CHARACTER

;CHECK FOR A VALID DIGIT
CHKDIG:	CPI	'9'+1
	JRNC	OVFMSG		;TOO LARGE
	SUI	'0'
	JRC	OVFMSG		;TOO SMALL

VALDIG:	XTHL			;GET PARTIAL RESULT
	CALL	TIMES10		;MULTIPLY BY 10 AND ADD THIS DIGIT
	XTHL			;SAVE PARTIAL RESULT ON STACK
	JV	OVFMSG		;ERROR ON 15 BIT OVERFLOW
	call	look		;look ahead one character
CHKCHR:	CPI	'9'+1
	JRNC	NOTDIG
	SUI	'0'
	JRNC	GETDIG		;PROCESS NEXT DIGIT


;NOT DIGIT INDICATES THAT THE END OF THE STRING HAS BEEN 
;REACHED.

NOTDIG:	XRA	A
	CMP	B		;IS RESULT SUPPOSED TO BE NEGATIVE
	POP	B
	POP	D		;RESTORE ARGUMENT COUNT
	RZ			;RETURN IF RESULT IS +IVE
	MOV	A,B
	CMA
	MOV	B,A
	MOV	A,C
	CMA
	MOV	C,A
	INX	B
	XRA	A
	RET			;SIGN IS FIXED, ALL DONE!!

OVFMSG:	XRA	A		;CHECK FOR CONSOLE FILE
	CMP	H
	JRNZ	ERRTYP		;NO, FATAL ERROR
	POP	B
	POP	D
	LXI	H,REPROM	;YES, GET NEW INPUT
	CALL	TXTYP
OVF1	CALL	TIN		;CLEAR INPUT BUFFER
	CPI	CR
	JRNZ	OVF1
	LXI	H,1		;CONSOLE FILE
	JR	CONV		;GET NEXT NUMBER

; MULTIPLY A NUMBER BY TEN AND ADD IN THE DIGIT
; STORED IN THE ACCUMULATOR
TIMES10	MOV	D,H
	MOV	E,L		;COPY HL -> DE
	ORA	A		;CLEAR CARRY
	DADC	H		;X2
	RV			;RETURN IF 15 BIT OVERFLOW
	DADC	H		;X4
	RV
	DADC	D		;X5
	RV
	DADC	H		;X10
	RV
	MOV	E,A
	MVI	D,0
	DADC	D		;PLUS THE NEW DIGIT
	RET
	ENDIF

;NTXT INPUTS A DATA STREAM FROM A NON-TEXT DATA FILE
NTXT:
	PUSH	D	;PARAMETER COUNT
	PUSH	H	;FILE BUFFER ADDRESS
	MOV	H,0(X)	;GET ADDRESS
	MOV	L,-1(X)
	MOV	D,-2(X)	;GET BYTE COUNT
	MOV	E,-3(X)
TXLP:	XTHL
	CALL	EOF
	JC	RBEOF
	INX	H
	INX	H
	INX	H
	CALL	BYTIN	;GET NEXT DATA BYTE
	DCX	H
	DCX	H
	MOV	B,M
	MOV	M,A
	MOV	A,B
	DCX	H
	JRNC	NTCONT
	BSET	1,M	;SET EOF FLAG
NTCONT:	XTHL
	MOV	M,A	;STORE IT
	DCX	H	;MEMORY ADDRESS
	DCX	D	;BYTE COUNT
	MOV	A,D	;CHECK FOR END
	ORA	E
	JRNZ	TXLP
	LXI	B,-4	;MOVE THE LIST POINTER
	DADX	B
	POP	H	;FILE BUFFER ADDRESS
	POP	D	;CHECK FOR END OF PARAMETER LIST
	DCX	D
	MOV	A,D
	ORA	E
	JRNZ	NTXT
	JMP	THREW


;ERROR TYPE OF INPUT DOESN'T MATCH VARIABLE
;FATAL ERROR
ERRTYP:	LXI	H,TYPMES
	JMP	PERROR
TYPMES:
	IF	NOT COMPILER	;Compiler doesn't need this
	DB	'Type error on inpu','t'+80H
REPROM:	DB	'Error in input, try again',CR,LF+80H
	ENDIF
«eof»
DataMuseum.dk

Jet Computer Jet80

⟦35df334fb⟧ TextFile

Derivation

TextFile
