;       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
;


You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.