ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/SIMTEL/CPMUG/CPMUG084.ARK/SEQIO22.LIB

Text File | 1984-04-29 | 18KB | 725 lines

;    SEQUENTIAL FILE I/O LIBRARY

;    VRS 2.2    Jack Riley, Boulder Colorado(RCPM phone: [phone])
;
;    This is a highly modified version of the original by unknown author
;    believed to be Ward Christensen.
;    It has been expanded to include the following new features:
;    1) An APPEND mode to the FILE macro to allow the opening of files
;       with automatic positioning to the EOF. Both GET and PUT macros
;       are expanded to allow full random access to the file. Random
;       access reads and writes are used instead of sequential(and also
;       in other modes of use of the FILE macro so 1.4 is now incompatible).
;    2) PUBLIC and NONLOC options have been added to the FILE macro
;       to allow access to files not in the current user area or on the
;       current disk drive. The GET and PUT macros also handle the switching
;       needed to provide for multiple opens in multiple areas. The way
;       they work is to momentarily switch the user area to the one needed
;       for the file undergoing an IO operation. A return is made to the
;       'home' user area to allow for 'local' file accesses or switches
;       to other areas to access other files. This is not completely
;       satisfactory and one could wish for a more elegant method which
;       should have been available under CPM. Also an additional byte
;       has been added to the FCB generated by FILLFCB to contain the
;       user area. The NONLOC option prevents an otherwise automatic
;       sequence to look first in the current user area and on the current
;       disk for the file, then switch the user area, then the disk to
;       the default locations. When PUBLIC is included in an invocation
;       of FILE, then code accessing default and current values is made.
;       The allocations for these variables is shown below.
;        DEFAULT$USER:
;            DB    0    ; or other user area
;        DEFAULT$DISK:
;            DB    'x'-'A'    ; where x is the default
;        CUR$USER:
;            DB    0FFH    ; necessary initial value
;        CUR$DISK:
;            DB    0FFH    ;  "           "
;
;       The intention was to allow the default values to be modified
;       at run time(one of the failings of MACRO-economics) so that
;       determinations of the availability of hard disks, for example,
;       could be included. Also it is sometimes nice to have these
;       values at the very beginning of a program so that DDT-style
;       customizations can be made.
;    3) A SECTBUF parameter has been added to FILE to turn off the
;       standard character buffering previously provided. It seemed
;       reasonable to provide this new open machinery even when
;       simple sector buffering was intended. Also when SECTBUF=NONE
;       all buffering is turned off and only the new open code is
;       produced. This can also be done through use of the POPEN macro
;       directly(without FCB's being generated).

FILERR    SET    0000H    ;REBOOT AFTER ERROR
@FALSE    SET    0000H
@TRUE    SET    NOT @FALSE
@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
@MAK    EQU    22    ;FILE MAKE
@REN    EQU    23    ;FILE RENAME
@DMA    EQU    26    ;SET DMA ADDRESS
@FRD    EQU    33    ;FILE RANDOM READ OPERATION
@FWR    EQU    34    ;FILE RANDOM WRITE OPERATION
@CFS    EQU    35    ;COMPUTE FILE SIZE
@SETRR    EQU    36    ;SET RANDOM RECORD
;
@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
NONE    EQU    1
SECTBUFF    EQU    @TRUE
NONLOC    EQU    @TRUE
INFILE    EQU    1    ;INPUT FILE
OUTFILE    EQU    2    ;OUTPUTFILE
SETFILE    EQU    3    ;SETUP NAME ONLY
APPEND    EQU    4    ;APPEND TO FILE
;
;    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    EQU $
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    MD,FID,DN,FN,FT,BS,BA
;;    FILL THE FILE CONTROL BLOCK WITH DISK NAME
;;    DEFINE FILE USING MODE MD:
;;        INFILE = 1    INPUT FILE
;;        OUTFILE = 2    OUTPUT FILE
;;        SETFILE = 3    SETUP FCB
;;    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
;;
FID&TYP    SET    MD    ;;SET MODE FOR LATER REF'S
;;    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
    ENDIF
    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    23    ;;X,X,RC,DM0...DM15,CR,R0,R1,R2 FIELDS
    DB    0FFH    ;; DEFAULT CURRENT USER AREA
;;
    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    EQU $
    DW    FID&BUF
;;
FID&SIZ    EQU    @BS    ;;LITERAL SIZE
FID&LEN    EQU $
    DW    @BS    ;;BUFFER SIZE
FID&PTR    EQU $
    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    EQU $
    ENDM
;
FILE    MACRO    FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF
;;    (SEE FILLFCB FOR PARAMETERS)
FID&FLG    SET    1
    IF NUL PU
FID&PUB    SET    0
    ELSE
FID&PUB    SET    1
    ENDIF

@SETRC    SET    @SETRR
    IF    FMODE=APPEND
@SETRC    SET    @CFS
    GFILE    FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF,0
FID&TYP    SET    OUTFILE        ;;SET MODE FOR LATER REF'S
    ENDIF
    GFILE    FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF,@SETRC
    ENDM
;
GFILE    MACRO    FMODE,FID,DN,FN,FT,BS,BA,PU,NOLOC,SECTBUF,@SETRC
    LOCAL    PSUB,MSG,PMSG
    LOCAL    PND,EOD,EOB,PNC,GLOOP,SAMEUSR
;;    CONSTRUCT THE FILE CONTROL BLOCK
;;
MD    SET    FMODE
    IF    FMODE=APPEND
    IF    @SETRC=0
MD    SET    INFILE
    ELSE
MD    SET    OUTFILE
    ENDIF
    ENDIF
    IF    FID&FLG
    FILLFCB    MD,FID,DN,FN,FT,BS,BA
    ENDIF
    IF    MD=SETFILE    ;;SETUP FCB ONLY, SO EXIT
    EXITM
    ENDIF
;;    FILE CONTROL BLOCK AND RELATED PARAMETERS
;;    ARE CREATED INLINE, NOW CREATE IO FUNCTION
BLOCKING    SET    @TRUE
    IF    NUL SECTBUF    ;;INPUT FILE
    JMP    PSUB    ;;PAST INLINE SUBROUTINE
    IF    MD=OUTFILE
PUT&FID    EQU $
    PUSH    PSW    ;;SAVE OUTPUT CHARACTER
    ELSE
GET&FID    EQU $
    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
    ELSE
    IF    SECTBUF=NONE
BLOCKING    SET    @FALSE
    ENDIF
    ENDIF
    IF    BLOCKING
    LXI    H,0
    SHLD    FID&PTR    ;;CLEAR NEXT TO GET/PUT
PND    EQU $
;;    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
    IF    FID&PUB
    LDA    FCB&FID+36    ;; GET USER AREA OF FILE
    CPI    0FFH
    JZ    SAMEUSR
    MVI    C,32
    MOV    E,A
    CALL    @BDOS        ;; GO TO FILE USER AREA
SAMEUSR    EQU    $
    ENDIF
    LXI    D,FCB&FID    ;;FCB ADDRESS TO DE
    IF    MD=INFILE    ;;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
    IF    FID&PUB
    CALL    RESET$SYSTEM
    ENDIF
    ORA    A    ;;CHECK RETURN CODE
    JNZ    EOD    ;;END OF FILE/DISK?
;;    NOT END OF FILE/DISK, INCREMENT LENGTH
    LHLD    FCB&FID+33    ;;INDEX TO RANDOM RECORD #
    INX    H
    SHLD    FCB&FID+33    ;;POINTER UPDATED
    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    EQU $
;;    END OF FILE/DISK ENCOUNTERED
    IF    MD=INFILE    ;;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    EQU $
    DB    @CR,@LF
    DB    'DISK FULL: &FID'
    DB    '$'
    ENDIF
;;
EOB    EQU $
;;    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    EQU $
    IF    NUL SECTBUF
;;    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=INFILE    ;;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
    ENDIF
    RET
    ENDIF        ; IF BLOCKING
;;
PSUB    EQU $
    IF    FID&FLG
    ;;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=INFILE    ;;INPUT FILE
    SHLD    FID&PTR    ;;CAUSE IMMEDIATE READ
    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
LOCALT    SET    NUL NOLOC
    IF    NOT FID&PUB OR LOCALT
    PUSH    D
    MVI    C,@OPN    ;;OPEN FILE FUNCTION
    CALL    @BDOS    ;;OPEN/MAKE OK?
    INR    A    ;;255 BECOMES 00
    POP    D
    JNZ    PMSG
    ENDIF        ; NUL NOLOC OR NUL PU
    IF    FID&PUB AND MD=INFILE
    POPEN    NOLOC
    JNZ    PMSG
    ENDIF
    IF    FMODE=APPEND
    MVI    A,EOF    ;; PRIME THE BUFFER
    STA    FID&BUF
    LXI    H,0    ;;SET NEXT TO FILL
    SHLD    FID&PTR    ;;POINTER INITIALIZED
    LXI    D,FCB&FID
    MVI    C,@MAK
    CALL    @BDOS
    INR    A    ;;255 BECOMES 00
    JNZ    PMSG
    ENDIF
    MVI    C,@MSG    ;;PRINT MESSAGE FUNCTION
    LXI    D,MSG    ;;ERROR MESSAGE
    CALL    @BDOS    ;;PRINTED AT CONSOLE
    JMP    FILERR    ;;TO RESTART
MSG    EQU $
    DB    @CR,@LF
    IF    MD=INFILE AND NOT (FMODE=APPEND)    ;;INPUT MESSAGE
    DB    'NO &FID FILE'
    ELSE
    DB    'NO DIR SPACE: &FID'
    ENDIF
    DB    '$'

    IF    @SETRC=0
BACK&FID    EQU    $
    LXI    H,FID&SIZ    ;;RESET THE LENGTH, IT MAY BE ZERO
    SHLD    FID&LEN        ;;IF NO EOF CHARACTER WAS FOUND
    LHLD    FID&PTR        ;;GET INDEX TO GET/PUT
    MOV    A,L        ;;IF =0000 NO EOF CHARACTER TO BACK UP OVER
    ORA    H
    RZ
    DCX    H
    SHLD    FID&PTR    ;;POINTER UPDATED
@@&FID    EQU    $
    LHLD    FCB&FID+33    ;;INDEX TO RANDOM RECORD #
    MOV    A,L        ;;=0000? BE SURE WE DON'T GO BELOW
    ORA    H
    RZ
    DCX    H
    SHLD    FCB&FID+33    ;;POINTER UPDATED
    RET
    ENDIF
PMSG    EQU $
    ENDIF
    IF    NOT (@SETRC=0)
    MVI    C,@SETRC    ; GET RANDOM RECORD #
    LXI    D,FCB&FID
    CALL    @BDOS
    IF    FMODE=APPEND
    CALL    @@&FID
GLOOP    EQU    $        ; MOVE TO EOF IN LAST RECORD
    CALL    GET&FID
    CPI    EOF
    JNZ    GLOOP
    CALL    BACK&FID
    ENDIF        ; FMODE=APPEND
    IF    FID&PUB
    CALL    RESET$SYSTEM
    ENDIF        ; FID&PUB
    ENDIF        ; @SETRC
FID&FLG    SET    0
    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=OUTFILE
    LOCAL    EOB?,PEOF,MSG,PMSG,SAMEUSR
;;    WRITE ALL PARTIALLY FILLED BUFFERS
EOB?    EQU $
    ;;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    EQU $
    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
    IF    ?F&PUB
    LDA    FCB&?F+36    ;; GET USER AREA OF FILE
    CPI    0FFH
    JZ    SAMEUSR
    MVI    C,32
    MOV    E,A
    CALL    @BDOS        ;; GO TO FILE USER AREA
SAMEUSR    EQU    $
    ENDIF
    LXI    D,FCB&?F    ;;FCB ADDRESS TO DE
    MVI    C,@CLS
    CALL    @BDOS        ;; CLOSE THE FILE
    IF    ?F&PUB
    CALL    RESET$SYSTEM
    ENDIF
    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    EQU $
    DB    @CR,@LF
    DB    'CANNOT CLOSE &?F'
    DB    '$'
PMSG    EQU $
    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    EQU $
    ;;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    EQU $
    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    EQU $
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
;
POPEN    MACRO    NOLOC
;    DE is assumed to point to the file FCB on entry
OPEN    SET    0FH
    LOCAL    PSUB,LEAVE
;OPEN MAST.CAT
*  OPTION 1:  TRY TO OPEN FILE IN CURRENT USER NUMBER ON CURRENT DISK
    JMP    PSUB
@OPEN    EQU    $
    PUSH    D    ; save the FCB
    MVI    A,0FFH    ; DECLARE CURRENT USER AREA ON FILE
    STA    FILEUA
    MVI    C,12    ; GET VERSION NUMBER
    CALL    @BDOS
    MOV    A,H    ; CP/M 1.X?
    ORA    L
    JZ    START2$DISK    ; CHECK FOR DEFAULT DISK IF SO

*  OPTION 2:  TRY TO OPEN FILE IN USER 0 ON CURRENT DISK
    MVI    E,0FFH    ; GET CURRENT USER NUMBER
    MVI    C,32    ; GET USER CODE
    CALL    @BDOS
    MOV    C,A
    LDA    DEFAULT$USER    ; CHECK IF AT DEFAULT USER
    CMP    C
    JZ    START2$DISK    ; DON'T TRY IF AT DEFAULT USER AREA
    STA    FILEUA        ; WHERE THE FILE IS IF ANYWHERE
    MOV    E,A
    MOV    A,C
    STA    CUR$USER    ; WHERE WE ARE(SAVE FOR LATER)
    MVI    C,32    ; SET USER CODE TO DEFAULT$USER
    CALL    @BDOS
    IF    NUL NOLOC
    POP    D    ; GET BACK FCB
    PUSH    D    ; PRESERVE THE STACK
    MVI    C,OPEN
    CALL    @BDOS    ; TRY TO OPEN FILE AGAIN
    CPI    255    ; NOT PRESENT?
    JNZ    LEAVE
    ENDIF        ; NUL NOLOC
*  OPTION 3:  TRY TO OPEN FILE IN USER 0 ON DEFAULT DISK IF NOT CURRENT DISK
START2$DISK    EQU    $
    MVI    C,25    ; DETERMINE IF CURRENT DISK IS THE DEFAULT
    CALL    @BDOS
    MOV    C,A
    LDA    DEFAULT$DISK    ; CHECK IF AT DEFAULT DISK
    CMP    C
    IF    NUL NOLOC
    JZ    LEAVE        ;FAILURE TO OPEN SINCE NOTHING LEFT TO TRY
    ENDIF
    POP    H        ; FCB INTO HL
    PUSH    H        ; PRESERVE STACK
    IF    NUL NOLOC
    ELSE
    JZ    START3$DISK
    ENDIF
    INR    A        ; ADD ONE TO DISK NUMBER
    MOV    M,A    ; PUT INTO FCB
START3$DISK    EQU    $
    XCHG        ; FCB INTO DE
    MVI    C,15    ; OPEN FILE
    CALL    @BDOS
    CPI    255    ; NOT PRESENT?

LEAVE    EQU    $
    POP    D    ; GET THE FCB AGAIN(AND CLEAN UP STACK)
    PUSH    PSW    ; SAVE OPEN STATUS ON FILE
    LXI    H,36
    DAD    D
    LDA    FILEUA        ; GET THE USER AREA FOR THE FILE
    MOV    M,A        ; PUT USER AREA INTO FCB
    POP    PSW
    RET
;
RESET$SYSTEM    EQU    $
    PUSH    PSW
    LDA    CUR$USER    ; CHECK USER
    CPI    0FFH    ; 0FFH=NO CHANGE
    JZ    RESET$RET
    MOV    E,A    ; USER IN E
    MVI    C,32    ; GET/SET USER CODE
    CALL    @BDOS
RESET$RET    EQU    $
    POP    PSW
    RET

FILEUA    EQU    $
    DS    1
PSUB    EQU    $
POPEN    MACRO
    CALL    @OPEN
    ENDM
    POPEN
    ENDM