Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE/CONTROL/SEQIO.LIB

;	SEQUENTIAL FILE I/O LIBRARY
;
FILERR	SET	0000H	;REBOOT AFTER ERROR
@BDOS	EQU	0005H	;BDOS ENTRY POINT
@TFCB	EQU	005CH	;DEFAULT FILE CONTROL BLOCK
@TBUF	EQU	0080H	;DEFAULT BUFFER ADDRESS
;
;	BDOS FUNCTIONS
@MSG	EQU	9	;SEND MESSAGE
@OPN	EQU	15	;FILE OPEN
@CLS	EQU	16	;FILE CLOSE
@DIR	EQU	17	;DIRECTORY SEARCH
@DEL	EQU	19	;FILE DELETE
@FRD	EQU	20	;FILE READ OPERATION
@FWR	EQU	21	;FILE WRITE OPERATION
@MAK	EQU	22	;FILE MAKE
@REN	EQU	23	;FILE RENAME
@DMA	EQU	26	;SET DMA ADDRESS
;
@SECT	EQU	128	;SECTOR SIZE
EOF	EQU	1AH	;END OF FILE
CR	EQU	0DH	;CARRIAGE RETURN
LF	EQU	0AH	;LINE FEED
TAB	EQU	09H	;HORIZONTAL TAB
;
@KEY	EQU	1	;KEYBOARD
@CON	EQU	2	;CONSOLE DISPLAY
@RDR	EQU	3	;READER
@PUN	EQU	4	;PUNCH
@LST	EQU	5	;LIST DEVICE
;
;	KEYWORDS FOR "FILE" MACRO
INFILE	EQU	1	;INPUT FILE
OUTFILE	EQU	2	;OUTPUTFILE
SETFILE	EQU	3	;SETUP NAME ONLY
;
;	THE FOLLOWING MACROS DEFINE SIMPLE SEQUENTIAL
;	FILE OPERATIONS:
;
FILLNAM	MACRO	FC,C
;;	FILL THE FILE NAME/TYPE GIVEN BY FC FOR C CHARACTERS
@CNT	SET	C	;;MAX LENGTH
	IRPC	?FC,FC	;;FILL EACH CHARACTER
;;	MAY BE END OF COUNT OR NUL NAME
	IF	@CNT=0 OR NUL ?FC
	EXITM
	ENDIF
	DB	'&?FC'	;;FILL ONE MORE
@CNT	SET	@CNT-1	;;DECREMENT MAX LENGTH
	ENDM		;;OF IRPC ?FC
;;
;;	PAD REMAINDER
	REPT	@CNT	;;@CNT IS REMAINDER
	DB	' '	;;PAD ONE MORE BLANK
	ENDM		;;OF REPT
	ENDM
;
FILLDEF	MACRO	FCB,?FL,?LN
;;	FILL THE FILE NAME FROM THE DEFAULT FCB
;;	FOR LENGTH ?LN (9 OR 12)
	LOCAL	PSUB
	JMP	PSUB	;;JUMP PAST THE SUBROUTINE
@DEF:	;;THIS SUBROUTINE FILLS FROM THE TFCB (+16)
	MOV	A,M	;;GET NEXT CHARACTER TO A
	STAX	D	;;STORE TO FCB AREA
	INX	H
	INX	D
	DCR	C	;;COUNT LENGTH DOWN TO 0
	JNZ	@DEF
	RET
;;	END OF FILL SUBROUTINE
PSUB:
FILLDEF	MACRO	?FCB,?F,?L
	LXI	H,@TFCB+?F	;;EITHER @TFCB OR @TFCB+16
	LXI	D,?FCB
	MVI	C,?L		;;LENGTH = 9,12
	CALL	@DEF
	ENDM
	FILLDEF	FCB,?FL,?LN
	ENDM
;
FILLNXT	MACRO
;;	INITIALIZE BUFFER AND DEVICE NUMBERS
@NXTB	SET	0	;;NEXT BUFFER LOCATION
@NXTD	SET	@LST+1	;;NEXT DEVICE NUMBER
FILLNXT	MACRO
	ENDM
	ENDM
;
FILLFCB	MACRO	FID,DN,FN,FT,BS,BA
;;	FILL THE FILE CONTROL BLOCK WITH DISK NAME
;;	FID IS AN INTERNAL NAME FOR THE FILE,
;;	DN IS THE DRIVE NAME (A,B..), OR BLANK
;;	FN IS THE FILE NAME, OR BLANK
;;	FT IS THE FILE TYPE 
;;	BS IS THE BUFFER SIZE
;;	BA IS THE BUFFER ADDRESS
	LOCAL	PFCB
;;
;;	SET UP THE FILE CONTROL BLOCK FOR THE FILE
;;	LOOK FOR FILE NAME = 1 OR 2
@C	SET	1	;;ASSUME TRUE TO BEGIN WITH
	IRPC	?C,FN	;;LOOK THROUGH CHARACTERS OF NAME
	IF	NOT ('&?C' = '1' OR '&?C' = '2')
@C	SET	0	;;CLEAR IF NOT 1 OR 2
	ENDM
;;	@C IS TRUE IF FN = 1 OR 2 AT THIS POINT
	IF	@C	;;THEN FN = 1 OR 2
;;	FILL FROM DEFAULT AREA
	IF	NUL FT	;;TYPE SPECIFIED?
@C	SET	12	;;BOTH NAME AND TYPE
	ELSE
@C	SET	9	;;NAME ONLY
	ENDIF
	FILLDEF	FCB&FID,(FN-1)*16,@C	;;TO SELECT THE FCB
	JMP	PFCB	;;PAST FCB DEFINITION
	DS	@C	;;SPACE FOR DRIVE/FILENAME/TYPE
	FILLNAM	FT,12-@C	;;SERIES OF DB'S
	ELSE
	JMP	PFCB	;;PAST INITIALIZED FCB
	IF	NUL DN
	DB	0	;;USE DEFAULT DRIVE IF NAME IS ZERO
	ELSE
	DB	'&DN'-'A'+1	;;USE SPECIFIED DRIVE
	ENDIF
	FILLNAM	FN,8	;;FILL FILE NAME
;;	NOW GENERATE THE FILE TYPE WITH PADDED BLANKS
	FILLNAM	FT,3	;;AND THREE CHARACTER TYPE
	ENDIF
FCB&FID	EQU	$-12	;;BEGINNING OF THE FCB
	DB	0	;;EXTENT FIELD 00 FOR SETFILE
;;	NOW DEFINE THE 3 BYTE FIELD, AND DISK MAP
	DS	20	;;X,X,RC,DM0...DM15,CR FIELDS
;;
	IF	FID&TYP<=2	;;IN/OUTFILE
;;	GENERATE CONSTANTS FOR INFILE/OUTFILE
	FILLNXT		;;@NXTB=0 ON FIRST CALL
	IF	BS+0<@SECT
;;	BS NOT SUPPLIED, OR TOO SMALL
@BS	SET	@SECT	;;DEFAULT TO ONE SECTOR
	ELSE
;;	COMPUTE EVEN BUFFER ADDRESS
@BS	SET	(BS/@SECT)*@SECT
	ENDIF
;;
;;	NOW DEFINE BUFFER BASE ADDRESS
	IF	NUL BA
;;	USE NEXT ADDRESS AFTER @NXTB
FID&BUF	SET	BUFFERS+@NXTB
;;	COUNT PAST THIS BUFFER
@NXTB	SET	@NXTB+@BS
	ELSE
FID&BUF	SET	BA
	ENDIF
;;	FID&BUF IS BUFFER ADDRESS
FID&ADR:
	DW	FID&BUF
;;
FID&SIZ	EQU	@BS	;;LITERAL SIZE
FID&LEN:
	DW	@BS	;;BUFFER SIZE
FID&PTR:
	DS	2	;;SET IN INFILE/OUTFILE
;;	SET DEVICE NUMBER
@&FID	SET	@NXTD	;;NEXT DEVICE
@NXTD	SET	@NXTD+1
	ENDIF	;;OF FID&TYP<=2 TEST
PFCB:	ENDM
;
FILE	MACRO	MD,FID,DN,FN,FT,BS,BA
;;	CREATE FILE USING MODE MD:
;;		INFILE = 1	INPUT FILE
;;		OUTFILE = 2	OUTPUT FILE
;;		SETFILE = 3	SETUP FCB
;;	(SEE FILLFCB FOR REMAINING PARAMETERS)
	LOCAL	PSUB,MSG,PMSG
	LOCAL	PND,EOD,EOB,PNC
;;	CONSTRUCT THE FILE CONTROL BLOCK
;;
FID&TYP	EQU	MD	;;SET MODE FOR LATER REF'S
	FILLFCB	FID,DN,FN,FT,BS,BA
	IF	MD=3	;;SETUP FCB ONLY, SO EXIT
	EXITM
	ENDIF
;;	FILE CONTROL BLOCK AND RELATED PARAMETERS
;;	ARE CREATED INLINE, NOW CREATE IO FUNCTION
	JMP	PSUB	;;PAST INLINE SUBROUTINE
	IF	MD=1	;;INPUT FILE
GET&FID:
	ELSE
PUT&FID:
	PUSH	PSW	;;SAVE OUTPUT CHARACTER
	ENDIF
	LHLD	FID&LEN	;;LOAD CURRENT BUFFER LENGTH
	XCHG		;;DE IS LENGTH
	LHLD	FID&PTR	;;LOAD NEXT TO GET/PUT TO HL
	MOV	A,L	;;COMPUTE CUR-LEN
	SUB	E
	MOV	A,H
	SBB	D	;;CARRY IF NEXT<LENGTH
	JC	PNC	;;CARRY IF LEN GTR CURRENT
;;	END OF BUFFER, FILL/EMPTY BUFFERS
	LXI	H,0
	SHLD	FID&PTR	;;CLEAR NEXT TO GET/PUT
PND:
;;	PROCESS NEXT DISK SECTOR:
	XCHG		;;FID&PTR TO DE
	LHLD	FID&LEN	;;DO NOT EXCEED LENGTH
;;	DE IS NEXT TO FILL/EMPTY, HL IS MAX LEN
	MOV	A,E	;;COMPUTE NEXT-LEN
	SUB	L	;;TO GET CARRY IF MORE
	MOV	A,D
	SBB	H	;;TO FILL
	JNC	EOB
;;	CARRY GEN'ED, HENCE MORE TO FILL/EMPTY
	LHLD	FID&ADR	;;BASE OF BUFFERS
	DAD	D	;;HL IS NEXT BUFFER ADDR
	XCHG
	MVI	C,@DMA	;;SET DMA ADDRESS
	CALL	@BDOS	;;DMA ADDRESS IS SET
	LXI	D,FCB&FID	;;FCB ADDRESS TO DE
	IF	MD=1	;;READ BUFFER FUNCTION
	MVI	C,@FRD	;;FILE READ FUNCTION
	ELSE
	MVI	C,@FWR	;;FILE WRITE FUNCTION
	ENDIF
	CALL	@BDOS	;;RD/WR TO/FROM DMA ADDRESS
	ORA	A	;;CHECK RETURN CODE
	JNZ	EOD	;;END OF FILE/DISK?
;;	NOT END OF FILE/DISK, INCREMENT LENGTH
	LXI	D,@SECT	;;SECTOR SIZE
	LHLD	FID&PTR	;;NEXT TO FILL
	DAD	D
	SHLD	FID&PTR	;;BACK TO MEMORY
	JMP	PND	;;PROCESS ANOTHER SECTOR
;;
EOD:
;;	END OF FILE/DISK ENCOUNTERED
	IF	MD=1	;;INPUT FILE
	LHLD	FID&PTR	;;LENGTH OF BUFFER
	SHLD	FID&LEN	;;RESET LENGTH
	ELSE
;;	FATAL ERROR, END OF DISK
	LOCAL	EMSG
	MVI	C,@MSG	;;WRITE THE ERROR
	LXI	D,EMSG
	CALL	@BDOS	;;ERROR TO CONSOLE
	POP	PSW	;;REMOVE STACKED CHARACTER
	JMP	FILERR	;;USUALLY REBOOTS
EMSG:	DB	CR,LF
	DB	'DISK FULL: &FID'
	DB	'$'
	ENDIF
;;
EOB:
;;	END OF BUFFER, RESET DMA AND POINTER
	LXI	D,@TBUF
	MVI	C,@DMA
	CALL	@BDOS
	LXI	H,0
	SHLD	FID&PTR	;;NEXT TO GET
;;
PNC:
;;	PROCESS THE NEXT CHARACTER
	XCHG		;;INDEX TO GET/PUT IN DE
	LHLD	FID&ADR	;;BASE OF BUFFER
	DAD	D	;;ADDRESS OF CHAR IN HL
	XCHG		;;ADDRESS OF CHAR IN DE
	IF	MD=1	;;INPUT PROCESSING DIFFERS
	LHLD	FID&LEN	;;FOR EOF CHECK
	MOV	A,L	;;0000?
	ORA	H
	MVI	A,EOF	;;END OF FILE?
	RZ		;;ZERO FLAG IF SO
	LDAX	D	;;NEXT CHAR IN ACCUM
	ELSE
;;	STORE NEXT CHARACTER FROM ACCUMULATOR
	POP	PSW	;;RECALL SAVED CHAR
	STAX	D	;;CHARACTER IN BUFFER
	ENDIF
	LHLD	FID&PTR	;;INDEX TO GET/PUT
	INX	H
	SHLD	FID&PTR	;;POINTER UPDATED
;;	RETURN WITH NON ZERO FLAG IF GET
	RET
;;
PSUB:	;;PAST INLINE SUBROUTINE
	XRA	A		;;ZERO TO ACC
	STA	FCB&FID+12	;;CLEAR EXTENT
	STA	FCB&FID+32	;;CLEAR CUR REC
	LXI	H,FID&SIZ	;;BUFFER SIZE
	SHLD	FID&LEN		;;SET BUFF LEN
	IF	MD=1	;;INPUT FILE
	SHLD	FID&PTR	;;CAUSE IMMEDIATE READ
	MVI	C,@OPN	;;OPEN FILE FUNCTION
	ELSE		;;OUTPUT FILE
	LXI	H,0	;;SET NEXT TO FILL
	SHLD	FID&PTR	;;POINTER INITIALIZED
	MVI	C,@DEL
	LXI	D,FCB&FID	;;DELETE FILE
	CALL	@BDOS	;;TO CLEAR EXISTING FILE
	MVI	C,@MAK	;;CREATE A NEW FILE
	ENDIF
;;	NOW OPEN (IF INPUT), OR MAKE (IF OUTPUT)
	LXI	D,FCB&FID
	CALL	@BDOS	;;OPEN/MAKE OK?
	INR	A	;;255 BECOMES 00
	JNZ	PMSG
	MVI	C,@MSG	;;PRINT MESSAGE FUNCTION
	LXI	D,MSG	;;ERROR MESSAGE
	CALL	@BDOS	;;PRINTED AT CONSOLE
	JMP	FILERR	;;TO RESTART
MSG:	DB	CR,LF
	IF	MD=1	;;INPUT MESSAGE
	DB	'NO &FID FILE'
	ELSE
	DB	'NO DIR SPACE: &FID'
	ENDIF
	DB	'$'
PMSG:
	ENDM
;
PUT	MACRO	DEV
;;	WRITE CHARACTER FROM ACCUM TO DEVICE
	IF	@&DEV <= @LST
;;	SIMPLE OUTPUT
	PUSH	PSW	;;SAVE CHARACTER
	MVI	C,@&DEV	;;WRITE CHAR FUNCTION
	MOV	E,A	;;READY FOR OUTPUT
	CALL	@BDOS	;;WRITE CHARACTER
	POP	PSW	;;RESTORE FOR TESTING
	ELSE
	CALL	PUT&DEV
	ENDM
;
FINIS	MACRO	FID
;;	CLOSE THE FILE(S) GIVEN BY FID
	IRP	?F,<FID>
;;	SKIP ALL BUT OUTPUT FILES
	IF	?F&TYP=2
	LOCAL	EOB?,PEOF,MSG,PMSG
;;	WRITE ALL PARTIALLY FILLED BUFFERS
EOB?:	;;ARE WE AT THE END OF A BUFFER?
	LHLD	?F&PTR	;;NEXT TO FILL
	MOV	A,L	;;ON BUFFER BOUNDARY?
	ANI	(@SECT-1) AND 0FFH
	JNZ	PEOF	;;PUT EOF IF NOT 00
	IF	@SECT>255
;;	CHECK HIGH ORDER BYTE ALSO
	MOV	A,H
	ANI	(@SECT-1) SHR 8
	JNZ	PEOF	;;PUT EOF IF NOT 00
	ENDIF
;;	ARRIVE HERE IF END OF BUFFER, SET LENGTH
;;	AND WRITE ONE MORE BYTE TO CLEAR BUFFS
	SHLD	?F&LEN	;;SET TO SHORTER LENGTH
PEOF:	MVI	A,EOF	;;WRITE ANOTHER EOF
	PUSH	PSW	;;SAVE ZERO FLAG
	CALL	PUT&?F
	POP	PSW	;;RECALL ZERO FLAG
	JNZ	EOB?	;;NON ZERO IF MORE
;;	BUFFERS HAVE BEEN WRITTEN, CLOSE FILE
	MVI	C,@CLS
	LXI	D,FCB&?F	;;READY FOR CALL
	CALL	@BDOS
	INR	A	;;255 IF ERR BECOMES 00
	JNZ	PMSG
;;	FILE CANNOT BE CLOSED
	MVI	C,@MSG
	LXI	D,MSG
	CALL	@BDOS
	JMP	PMSG	;;ERROR MESSAGE PRINTED
MSG:	DB	CR,LF
	DB	'CANNOT CLOSE &?F'
	DB	'$'
PMSG:
	ENDIF
	ENDM	;;OF THE IRP
	ENDM
;
ERASE	MACRO	FID
;;	DELETE THE FILE(S) GIVEN BY FID
	IRP	?F,<FID>
	MVI	C,@DEL
	LXI	D,FCB&?F
	CALL	@BDOS
	ENDM	;;OF THE IRP
	ENDM
;
DIRECT	MACRO	FID
;;	PERFORM DIRECTORY SEARCH FOR FILE
;;	SETS ZERO FLAG IF NOT PRESENT
	LXI	D,FCB&FID
	MVI	C,@DIR
	CALL	@BDOS
	INR	A	;00 IF NOT PRESENT
	ENDM
;
RENAME	MACRO	NEW,OLD
;;	RENAME FILE GIVEN BY "OLD" TO "NEW"
	LOCAL	PSUB,REN0
;;	INCLUDE THE RENAME SUBROUTINE ONCE
	JMP	PSUB
@RENS:	;;RENAME SUBROUTINE, HL IS ADDRESS OF
	;;OLD FCB, DE IS ADDRESS OF NEW FCB
	PUSH	H	;;SAVE FOR RENAME
	LXI	B,16	;;B=00,C=16
	DAD	B	;;HL = OLD FCB+16
REN0:	LDAX	D	;;NEW FCB NAME
	MOV	M,A	;;TO OLD FCB+16
	INX	D	;;NEXT NEW CHAR
	INX	H	;;NEXT FCB CHAR
	DCR	C	;;COUNT DOWN FROM 16
	JNZ	REN0
;;	OLD NAME IN FIRST HALF, NEW IN SECOND HALF
	POP	D	;;RECALL BASE OF OLD NAME
	MVI	C,@REN	;;RENAME FUNCTION
	CALL	@BDOS
	RET		;;RENAME COMPLETE
PSUB:
RENAME	MACRO	N,O	;;REDEFINE RENAME
	LXI	H,FCB&O	;;OLD FCB ADDRESS
	LXI	D,FCB&N	;;NEW FCB ADDRESS
	CALL	@RENS	;;RENAME SUBROUTINE
	ENDM
	RENAME	NEW,OLD
	ENDM
;
GET	MACRO	DEV
;;	READ CHARACTER FROM DEVICE
	IF	@&DEV <= @LST
;;	SIMPLE INPUT
	MVI	C,@&DEV
	CALL	@BDOS
	ELSE
	CALL	GET&DEV
	ENDM
;