ftp.barnyard.co.uk

home *** CD-ROM | disk | FTP | other *** search

/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / MACLIB / SEQIO.LIB < prev next >

Wrap

Text File | 2000-06-30 | 10KB | 439 lines

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