; VRS 2.2 Jack Riley, Boulder Colorado(RCPM phone: (303)499-9169)
;
; 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
