⟦db19badf3⟧

TextFile

;WRITE AND WRITELN ROUTINES
;
	NAME OUTPT
	ENTRY WRITEL,WRITE,L109,L111
	EXT CO,BYTOT,SCAN,ERRTMF,POPHDB,PUSHBD
	include deflt.src
;
	IF	COMPILER	;Compiler never calls RBLOCK
RBLOCK:
	ELSE
	EXT	RBLOCK
	ENDIF
;
;
;WRITELN WRITES THE PARAMETER LIST TO THE SPECIFIED
;OUTPUT FILE, SETS THE END OF FILE FLAG,
;AND APPENDS A CARRIAGE RETURN AND LINE FEED
;TO TERMINATE THE CURRENT LINE 

SYSLOC	EQU	5	;SYSTEM LOCATIONS
; THIS LABEL IS USED BY THE COMPILER

L109:
WRITEL:	PUSH	X	;SAVE X
	CALL	PNTR
	PUSH	X	;SAVE BEGINNING
;IDENTIFY THE FILE TYPE
	MOV	B,0(X) 
	CMP	B
	JRNZ	CONSOL
;NON-CONSOLE FILE
	CALL	BUFADR
;SET BUFFER FLAGS
	BSET	0,M	;SET EOLN
	INX	H
	INX	H
	INX	H	;HL POINTS TO OPSYS BUFFER
	JMPR	TEXT

;CONSOLE FILE
;ALL CONSOLE FILES MUST BE TEXT
CONSOL:	MOV	H,A
	MOV	L,A

;TEXT FILE
TEXT:	CALL	TXTFIL

;APPEND THE CARRIAGE RETURN AND LINE FEED
ADDCR:	MVI	C,CR
	CALL	PRINT
	MVI	C,LF
	CALL	PRINT
;CLEAN UP STACK AND RETURN
CLEAN:	POP	H	;BEGINNING OF LIST
	INX	H
	POP	X	;RESTORE OLD X
	POP	D	;RETURN ADDRESS
	SPHL		;REMOVE LIST FROM STACK
	XCHG		;RETURN ADDRESS
	PCHL

;WRITE WRITES THE PARAMETER LIST TO THE SPECIFIED
;OUTPUT FILE, SETS THE END OF FILE FLAG, RESETS THE
;END OF LINE FLAG, AND SETS THE WRITE INDICATER FLAG

L111:
WRITE:	PUSH	X	;SAVE X
	CALL	PNTR
	PUSH	X	;SAVE BEGINNING
;IDENTIFY FILE TYPE
	MOV	B,0(X)
	CMP	B
	JRNZ	CONSO2
;NON- CONSOLE FILE
	CALL	BUFADR
;SET BUFFER FLAGS
	RES	0,M	;RESET EOLN
	INX	H
	INX	H
	INX	H
;TEST FOR NON-TEXT FILE
	XRA	A
	CMP	B
	JNZ	NONTXT
	JMPR	TEXT2

;CONSOLE FILE
;ALL CONSOLE FILES MUST BE TEXT FILES
CONSO2:	MOV	H,A
	MOV	L,A

;TEXTFILE
TEXT2:	CALL	TXTFIL
;CLEAN UP STACK AND RETURN
	JR	CLEAN	;CLEAN UP AND RETURN

;PNTR SETS UP THE POINTERS FOR WRITING
PNTR:	LXI	X,SYSLOC
	DADX	S
	DADX	B	;X POINTS TO START OF LIST
	MOV	D,B
	MOV	E,C	;COUNT IN DE
	RET

;BUFADR PUTS THE BUFFER ADDRESS IN HL FOR NON-CONSOLE FILES
BUFADR:	LXI	B,-8
	XCHG
	DAD	B	;SKIP 8 BYTES OF FILE INFO.
	XCHG
	PUSH	D	;BYTE COUNT
	DADX	B
	MOV	B,7(X)	;FILE TYPE
	MOV	H,6(X)	;FILE BUFFER ADDRESS
	MOV	L,5(X)
	PUSH	B	;SAVE FILE TYPE
	PUSH	H
	BIT	2,M	;IS FILE DECLARED AS AN OUTPUT FILE?
	JRNZ	OUTSET	;YES
	PUSH	Y
	PUSH	H	;FBA	
	XRA	A
	MOV	H,A	
	MOV	L,A
	CALL 	SCAN	;SEARCH OUTPUT FILE LIST FOR BUFFER ADDRESS
	JNC	ERRTMF	;TOO MANY OUTPUT FILES OPEN
	POP	H
	MOV	A,H	;STOREE OUTPUT FBA
	STAX	B
	DCX	B	
	MOV	A,L
	STAX	B
	POP	Y	;BUFFER NOW IN LIST AS OUTPUT FILE
OUTSET:	MOV	A,2(X)	;CHECK FOR ZERO RECORD NUMBER
	MOV	E,1(X)
	ORA	E
	JRZ	SEQTST	;ZERO, SEQUENTIAL WRITE
RWPREP:	MOV	D,2(X)	;RECORD NUMBER IN DE
	MOV	H,4(X)	;RECORD SIZE
	MOV	L,3(X)
	POP	B	;FILE BUFFER ADDR.
	PUSH	B
	MVI	A,1	;INDICATE A WRITE OPERATION
	CALL	RBLOCK	;PERFORM RANDOM WRITE
	POP	H	;FBA
	BSET	4,M	;SET 'RANDOMLY ACCESSED' BIT
	JR	RCLN1
RCLN:	POP	H	;FBA
RCLN1:	POP	B	;FILE TYPE
	BSET	2,M	;SET 'WRITTEN TO' BIT - OUTPUT FILE
	POP	D	;BYTE COUNT
	RET
SEQTST:	POP	H
	PUSH	H
	BIT	4,M	;HAS RANDOM OPERATION OCCURRED
	JRZ	RCLN	;NO RANDOM OPS. ON THIS FILE.TREAT AS SEQ.
	JR	RWPREP	;TREAT AS RANDOM
;
;PROCESS PARAMETER LIST
;THE ODD WORDS IDENTIFY THE PARAMETER TYPE
;0-FILE,1-BOOLEAN,2-INTEGER,3-CHARACTER,4-SCALAR,5-NON-TEXT,
;6-FLOATING POINT,7-STRING
;THE EVEN WORDS ARE THE VALUE OF THE PARAMETER
;TEST FOR THE END OF LIST

TXTFIL:	MOV	A,D
	ORA	E
	RZ		;LIST EXHAUSTED:RETURN
NXTPAR:	XRA	A	;CLEAR A
	MOV	B,0(X)
	DCX	X	;POINTER
	DCX	D	;BYTE COUNT
	DCR	B
	CZ	BOOL	;BOOLEAN
	DCR	B
	CZ	INTEG	;INTEGER
	DCR	B
	CZ	CHAR	;CHARACTER
	DCR	B
	CZ	SCALAR	;SCALAR
	DCR	B
	DCR	B
	DCR	B
	CZ	STRING	;STRING
	JMPR	TXTFIL

;SCALARS ARE PRINTED BY CALCULATING THE ADDRESS AND PRINTING
;THE SYMBOLIC NAME OF THE SCALAR
SCALAR:	LXI	B,-4	;FIX...
	DADX	B	;....PARAMETER LIST POINTER
	XCHG
	DAD	B	;....BYTE COUNT
	PUSH	H	;SAVE BYTE COUNT
	PUSH	D	;SAVE FILE POINTER
	MOV	C,4(X)	;MINIMUM SYMBOL LENGTH
	MOV	L,3(X)	;GET SCALAR VALUE
	MOV	H,A	;IN THE HL PAIR
	DAD	H	;X2
	DAD	H	;X4
	DAD	H	;X8  SYMBOLS ARE 8 CHARS EACH
	MOV	D,2(X)	;GET HIGH BYTE OF BASE ADDRESS
	MOV	E,1(X)	;GET LOW BYTE
	DAD	D	;CALCULATE ADDR OF THIS SYMBOL
	PUSH	H	;SAVE ADDRESS
	MOV	B,A	;ZERO B REG.
SCLR1:	MOV	A,M	;FIND NUMBER OF CHARS. IN SCALAR
	CPI	' '	;END OF SCALAR?
	JRZ	SCLR2	;YES
	INR	B	;NO, INCREMENT CHAR. COUNTER
	INX	H	;BUMP SYMBOL POINTER
	BIT	3,B	;8 CHARS. YET?
	JRZ	SCLR1	;NO
;CALCULATE NUMBER OF SPACES TO PRINT FOR MINIMUM FIELD WIDTH
SCLR2:	POP	H	;VAR. ADDR.
	IF	COMPILER
	JR 	SCLR4	;COMPILER SCALARS ALL HAVE FIELD LENGTH OF 1
	ELSE
	MOV	A,C	;FIELD LENGTH
	SUB	B	;LESS NUMBER OF CHARS.
	JRZ	SCLR4	;NO SPACES TO PRINT
	JRC	SCLR4
	MOV	D,B	;SAVE NUMBER OF CHARS.
	MOV	B,A	;NUMBER OF SPACES
	XTHL		;HL <- FBA
	MVI	C,' '
SCLR3:	CALL	PRINT
	DJNZ	SCLR3	;PRINT LEADING SPACES
;PRINT CHARACTERS
	MOV	B,D	;NUMBER OF CHARS.
	XTHL		;SCALAR ADDR. IN HL
	ENDIF
SCLR4:	MOV	C,M	;CHAR INTO C
	XTHL		;SWITCH POINTERS
	CALL	PRINT	;PRINT IT
	XTHL		;SWITCH POINTERS
	INX	H	;NEXT CHAR
	DJNZ	SCLR4
	POP	H
	POP	D
	RET
;
;CHARACTER OUTPUTS A CHARACTER STRING TO THE FILE
CHAR:	MOV	B,-2(X)		;VARIABLE LENGTH
	MOV	A,0(X)		;MINIMUM FIELD LENGTH
	SUB	B		;FIGURE HOW MUCH PADDING
	DCX	X		;BUMP POINTER AND COUNTER
	DCX	X
	DCX	D
	DCX	D
	JRZ	CHAR2		;NO PADDING NEEDED
	JRC	CHAR2
	MOV	B,A		;PADDING COUNT
	MVI	C,' '
CHAR1:	CALL	PRINT		;PRINT SPACES
	DJNZ	CHAR1
	MOV	B,0(X)		;VARIABLE LENGTH, AGAIN
CHAR2:	DCX	X
	DCX	D
	MOV	C,0(X)		;GET NEXT CHARACTER
	CALL	PRINT
	DJNZ	CHAR2		;DO FOR ALL CHARACTERS IN THE STRING
	DCX	X
	DCX	D
	RET

;BOOLEAN PRINTS EITHER TRUE OR FALSE
;RIGHT JUSTIFIED IN A FIELD OF THE SIZE SPECIFIED IN THE BYTE
;OF THE PARAMETER LIST

BOOL:
	IF	NOT COMPILER	;DON'T USE WITH COMPILER
	DCX	X
	DCX	X
	DCX	D
	DCX	D
	PUSH	D	;SAVE BYTE COUNT
	CMP	1(X)	;GET VALUE
	MOV	A,2(X)	;GET FIELD SIZE
	LXI	B,4	;LENGTH OF 'TRUE'
	LXI	D,TRUE	;ACTUAL MESSAGE
	JRC	ISTRUE
	XCHG
	DAD	B	;NOT TRUE...
	XCHG
	INR	C	;POINT TO 'FALSE'
ISTRUE:	SUB	C	;COMPUTE PADDING
	JRZ	FIT1B	;NO PADDING NEEDED
	JRC	FIT1B
	MOV	B,A	;B <- NUMBER OF LEADING SPACES
	MOV	A,C	;SAVE NUMBER OF CHARS. IN A
	EXAF
	MVI	C,' '
BLANKS:	CALL	PRINT	;PRINT PADDING
	DJNZ	BLANKS
	EXAF
	MOV	C,A	;A <- NUMBER OF CHARS.
FIT1B:	MOV	B,C
FIT1A:	LDAX	D	;GET CHARACTER
	MOV	C,A
	CALL	PRINT	;PRINT IT
	INX	D	;BUMP POINTER
	DJNZ	FIT1A
	POP	D	;RESTORE BYTE COUNT
	RET

TRUE:	DB	'TRUE'
	DB	'FALSE'
	ENDIF
;
;STRING WRITES A CHAR STRING AND FILLS TO THE MINIMUM FIELD LENGTH IF 
;NECESSARY
;
STRING:
	IF	NOT COMPILER	;Compiler doesn't need this
	MOV	B,-3(X)	;ACTUAL LENGTH
	MOV	A,0(X)	;MIN FIELD LENGTH
	DCX	X	;BYTE POINTER
	DCX	X
	DCX	X
	DCX	D	;BYTE COUNTER
	DCX	D
	DCX	D
	MOV	C,1(X)	;LOW BYTE OF SIZE=MAXLENGTH+1
	DCR	C	;C <- MAX LENGTH
	PUSH	B	;SAVE MAX. LENGTH(C) AND ACTUAL LENGTH(B)
	SUB	B	;CALCULATE PADDING IF ANY
	JRZ	STPRNT	;NONE NEEDED
	JRC	STPRNT
	MOV	B,A	;PAD TO FILL OUT MIN. FIELD LENGTH
	MVI	C,' '
SFILL:	CALL	PRINT
	DJNZ	SFILL
STPRNT:	POP	B	;B <- ACT. LENGTH, C<- MAX LENGTH
	XRA	A
	CMP	B	;CHECK FOR ZERO LENGTH STRIN
	JRZ	STRZRO
	PUSH	B	;SAVE ACTUAL LENGTH AND MAXIMUM LENGTH
STRPT1:	DCX	D
	DCX	X
	MOV	C,0(X)	;GET NEXT CHAR.
	CALL	PRINT
	DJNZ	STRPT1	;DO FOR ALL CHARS IN STRING
	POP	B	;B <- ACT LENGTH, C<- MAX LENGTH
STRZRO:	MOV	A,C
	SUB	B
	JRZ	STSKP	;NO UNUSED BYTES
	MOV	B,A	;NUMBER OF UNUSED BYTES
STSKIP:	DCX	X	;SKIP UNUSED BYTES
	DCX	D
	DJNZ	STSKIP
STSKP:	DCX	X
	DCX	D
	RET
	ENDIF

;INTEGER OUTPUTS THE INTEGER RIGHT JUSTIFIED
;IN THE FIELD WIDTH SPECIFIED BY THE NEXT BYTE
;IN THE PARAMETER LIST.  IF THE NUMBER IS TOO 
;BIG FOR THE FIELD, THE FIELD IS EXTENDED ON 
;THE RIGHT.

INTEG:	DCX	D
	DCX	D
	DCX	D
	PUSH	D	;BYTE COUNTER
	MOV	D,-1(X)	;GET VALUE
	MOV	E,-2(X)
	PUSH	X
	POP	B
	LXI	X,-6	;RESERVE STACK SPACE FOR DIGIT STRING
	DADX	S
	SPIX
	PUSH	H	;FILE BUFFER ADDRESS
	PUSH	B	;PARAMETER LIST POINTER
	LXI	B,5
	DADX	B	;DIGIT STRING POINTER
	BIT	7,D	;TEST SIGN
	JRZ	POSNUM
	MVI	0(X),'-';NEGATIVE NUMBER
	DCX	X
	XRA	A	;CLEAR CARRY
	MOV	H,A
	MOV	L,A
	MOV	B,A
	DSBC	D
	JMPR	NUM

POSNUM:	XCHG		;POSITIVE NUMBER
	MOV	0(X),A	;ZERO SIGN BYTE
	DCX	X
NUM:	MOV	C,A	;ZERO CHARACTER COUNT
	LXI	D,10000
	CALL	FIGURE
	LXI	D,1000
	CALL	FIGURE
	LXI	D,100
	CALL	FIGURE
	LXI	D,10
	CALL	FIGURE
	MOV	B,L	;LAST DIGIT
	CALL	ADIGIT
	MOV	B,A
	DADX	B
	INX	X	;X POINTS TO THE SIGN
	MOV	A,0(X)
	CPI	'-'
	JRNZ	CHK0
	INR	C
	JMPR	NEGA

CHK0:	CMP	C
	JRNZ	POSN
	MVI	0(X),'0'	;OUTPUT A ZERO
	INR	C
	JMPR	NEGA

POSN:	DCX	X
NEGA:	MOV	B,C
	POP	H
	MOV	A,M	;GET FIELD  LENGTH
	XTHL		;FILE BUFFER ADDRESS
;			;SAVE PARAMETER LIST POINTER
	SUB	B
	JRC	PERFIT	;EXTEND THE FIELD TO MATCH
	JRZ	PERFIT	;FIELD MATCHES
	MOV	D,A
	MVI	C,' '	;PAD THE NUMBER TO MATCH THE FIELD
PAD:	CALL	PRINT
	DCR	D
	JRNZ	PAD
PERFIT:	MOV	C,0(X)	;PRINT THE DIGIT STRING
	CALL	PRINT
	DCX	X
	DJNZ	PERFIT
;NUMBER IS PRINTED CLEANUP MESS AND RETURN
	POP	X	;RESTORE LIST POINTER
	DCX	X
	DCX	X
	DCX	X
	XCHG		;REMOVE DIGIT STRING FROM STACK
	LXI	H,6
	DAD	S
	SPHL
	XCHG
	POP	D	;RESTORE PARAMETER BYTE COUNTER
	XRA	A	;CLEAR A
	RET

;FIGURE COUNTS HOW MANY TIMES DE GOES INTO HL
FIGURE:	XRA	A	;CLEAR CARRY
	DCR	B
CONT:	INR	B	;COUNTER
	DSBC	D
	JRNC	CONT
TOOFAR:	DAD	D	;PUT BACK LAST TRY

;ADIGIT ADDS A DIGIT TO THE STRING ON THE STACK
;IF THE FIRST NON-ZERO DIGIT HAS BEEN
;ENCOUNTERED. IT ALSO INCREMENTS THE DIGIT COUNTER.

ADIGIT:	CMP	B
	JRNZ	NUDIG
	CMP	C	;DIGIT IS A 0
	RZ		;FIRST DIGIT
NUDIG:	MVI	A,30H	;ASCII
	ADD	B
	MOV	0(X),A	;ADD DIGIT TO STRING
	DCX	X
	INR	C	;DIGIT COUNTER
	XRA	A
	MOV	B,A
	RET


;NONTXT OUTPUTS A DATA STREAM TO A NON-TEXT DISK FILE
NONTXT:
	PUSH	H	;SAVE FILE BUFFER ADDRESS
NONTX1:	LXI	B,-4	;UPDATE PARAMETER POINTER
	DADX	B
	XCHG
	DAD	B
	XCHG
	MOV	H,2(X)	;GET BYTE COUNT
	MOV	L,1(X)
NTLP:	MOV	C,0(X)	;GET NEXT DATA BYTE
	DCX	X	;POINTER
	DCX	H	;BYTE COUNT
	DCX	D	;PARAMETER COUNT
	XTHL
	CALL	DIS	;TO THE DATA
	XTHL
	MOV	A,H	;DONE?
	ORA	L
	JRNZ	NTLP
	MOV	A,D	;END OF PARAMETER LIST
	ORA	E	;ALL PARAMETERS ARE EITHER TEXT OR NON-TEXT
	JRNZ	NONTX1
	POP	H	;FILE BUFFER COUNT
	JMP	CLEAN

;BUFFER ADDRESS IS NON-ZERO AND TO THE CONSOLE CRT
;IF THE FILE BUFFER ADDRESS IS ZERO.

PRINT:	XRA	A	;KEEP THE A-REG A ZERO
	CMP	H
	JRNZ	DIS
	CMP	L
	JRNZ	DIS
	CALL	CO	;CONSOLE
	XRA	A
	RET

DIS:	DCX	H
	DCX	H
	DCX	H	;FBA
	BIT	7,M	;CONSOLE FLAG SET? (CON:)
	JRZ	DIS1	;NO
	CALL	CO	;YES, CON:
	XRA	A
	INX	H
	INX	H
	INX	H	;FCB
	RET
DIS1:	BIT	6,M	;LISTING DEVICE? (LST:)
	INX	H
	INX	H
	INX	H	:FCB
	JZ	DIS2	;NO
; OUTPUT TO PRINTER
	XRA	A
	CALL	PUSHBD	;SAVE ALL REGS.
	MOV	E,C
	MVI	C,5	;CP/M LIST OUTPUT FUNCTION
	CALL	CPM
	JMP	POPHDB
; OUTPUT TO DISK	
DIS2:	CALL	BYTOT	;DISK FILE
	MVI	A,0
	RNC
	DCX	H
	DCX	H
	DCX	H
	BSET	1,M	;EOF FLAG SET INDICATES DISC WRITE ERROR
	INX	H
	INX	H
	INX	H
	RET
«eof»
DataMuseum.dk

CP/M

⟦db19badf3⟧ TextFile

Derivation

TextFile
