; SAP v60 Sort And Pack directory 07/27/87 ; VERS EQU 60 ; Current version number ; ASEG ; Needed for M80, ignore any errors ; ORG 100H ; Ignore error with ASM, LASM, MAC, etc. ; JMP START ; Bypasses the erase option ; ; ; This program reads the disk directory tracks, sorts them alphabeti- ; cally and then replaces them on the disk after first erasing the ; entire directory area with E5's. This erasure clears all previous ; file names that might remain after the new list is replaced. Sort- ; ing the directory in this manner offers several advantages: ; ; 1) allows 'DIR' to show an alphabetized listing ; 2) minimizes potential problems when using "UNERASE" pgms ; 3) speeds up access via 'SD' and other special programs ; 4) assists on working directly on the disk with 'DU', etc. ; 5) prevents somebody else from reading files you erased ; 6) option of erasing all files of zero-length (except those ; starting with '-' for catalog use with MAST.CAT or to ; name your disks, identify user areas, etc. ; ; - Notes by Irv Hoff W6FFC ; ;----------------------------------------------------------------------- ; recent updates ; ; 07/27/87 1. Rewrote setup routine so the program works on the current ; v60 drive unless a different one is requested. To select a ; different drive (which will be displayed on the progress ; line): ; ; B>SAP - default drive ; B>SAP D: - with or without colon ; B>SAP d - upper or lower case ; ; 2. Added a small help guide per Paul Foote's suggestion: ; ; B>SAP ? - small help guide ; ; 3. Added a "please wait...' statement since the program ; takes several seconds to see if there is enough memory ; available to handle the requested disk directory, etc. ; (A 50k TPA can handle more than 1300 filenames.) ; 5. Added the disk drive to the progress line so you know for ; sure what drive it is actually working on. 12 bytes. ; 6. Added routine submitted by Bill Duerr to check the S2 ; byte to properly handle files in excess of 512k. ; 7. Added an assembly time option for erasing zero length ; files, per earlier versions. This does not affect ; those special files for cataloging like -.123 or for ; directory guides such as -MODEM, -UPLOADS. etc. This ; should put the versions back in synch once more as ; there were two version 50 programs among others written ; prior to this version 50. (One of which was for Z80 ; only and required using the Z80MR assembler.) If you ; want to sit there typing "Yes, Yes, Yes, Yes" to erase ; zero-length files, just stick with v54, I certainly ; wasn't interested and several others weren't either. ; ; 103h = 00h deletes zero-length files ; = 0FFh (anyting but zero) keeps them ; ; 8. Removed superfluous v1.4 routines. Currently some 15 ; bytes still available to stay under 2k arbitrary limit. ; - Irv Hoff ; PRACSA RCPM ; ; 06/30/87 1. Exit program with warm boot upon disc error. ; v54.1 2. Changed error messages in combination with BDOS error ; messages not to exceed CRT width. ; 3. Added bell with indicated prompts. ; 4. Other message changes. ; 5. Changed 2 comments referencing DateStamper(TM) file which ; caused ASM v2.2 errors. ; 6. Changed labels 'I' and 'J' to 'IND' and 'JND' for those ; who want to change to Z80 mnemonics. ; 7. Other minor code changes. ; - Ernest Barnhard ; N8DVE on AB17 RCPM ; ; 05/21,87 1. Fixed 0-length file user code display for codes >9, ; v54 shortened the write protect tab message a bit to make ; room within our arbitrary-but-nice 2K. ; 2. Deleted $'s from labels and values for M80 and SYSLIB- ; modified RMAC (ASM still does the trick). ; - Bruce Morgen ; North American 180 Group ; ; 09/15/87 Fixed non-CP/M v2.2 error exit. ; v53 - Bridger Mitchell ; (Plu*Perfect Systems) ; ; 07/01/85 1. Fixed unbalanced stack in DODATE which caused erratic ; v52 exit behavior in some circumstances. ; 2. Minor tidy up of some comments and exit. ; - Bridger Mitchell ; (Plu*Perfect Systems) ; ; 02/23/85 Preserved original attributes of DateStamper(TM) file. ; v51 - Bridger Mitchell ; (Plu*Perfect Systems) ; ; 11/13/84 1. Added support for DateStamper(TM) time-and-date file, if ; v50 present on disk. The datestamp entries are rewritten ; in the new directory order, with updated checksums. ; 2. New, faster sort routine swaps pointers rather than di- ; rectory entries. ; 3. Directory writes speeded up by flushing only the final ; record. ; 4. Zero-length files are erased only if confirmed by user. ; 5. Prompt for drive if no command line. ; 6. Erase temporary files of form 'filename.$$$' ; 7. Removed the 'PACK' routine. As written, it converted ; 'FILENAME.N$$' extent=0 files to 'FILENAME.$$$' ; extent=n-'0'. If the intent was to erase temporary ; files, it should be done BEFORE sorting, as v50 now ; does. - Bridger Mitchell ; (Plu*Perfect Systems) ; ; 09/17/84 Added 'Previously sorted' statement that was included in v37 ; v40 but got dropped from v38 when the Shell-Metnzer sort was put ; in. It still rewrites the directory even if previously ; sorted, to insure erased programs at end of directory are ; properly cleared. - Irv Hoff W6FFC ; ; 07/27/84 Corrected sorting of last directory entry. ; v39 - WOD ; ; 10/16/83 Now using a Shell-Metzner sort which speeds the sorting time ; v38 considerably, especially on large directories. ; ; Sigi Kluger ; ; 07/27/83 Shows an error flag for MP/M and CP/M+ both. Rewrites the ; v37 directory even if previously sorted, to insure erased pro- ; grams at end of directory are properly cleared. ; - Irv Hoff W6FFC ; ; 1977 Written by L. E. Hughes. Modified extensively since by Bruce ; Ratoff, Keith Petersen, James Prest, Ron Fowler, Frank Gaude', ; Sigi Kluger, Irv Hoff and likely others. ; ;======================================================================= ; NO EQU 0 YES EQU NOT NO ; ; Set the following equate to YES to erase 0-length files not having a ; '-' for catalog names. NO retains all zero-length files. ; ERAZRO EQU YES ; YES erases 0-length files with no '-' ; ; General equates ; BDOS EQU 0005H CR EQU 0DH LF EQU 0AH BS EQU 08H BEL EQU 07H ; JMPUNC EQU 0C3H ; 8080 unconditional jump opcode DPBLEN EQU 15 ; Size of CP/M 2.2 disk parameter block ; ZROERA: DW ERAZRO ; 103h = 0FFh to erase files, 00h to not ; (16 bit value to satisfy ASM.COM) ; ;----------------------------------------------------------------------- ; ; START OF PROGRAM ; ;----------------------------------------------------------------------- ; ; Obtain BIOS vectors ; START: LXI D,WBOOT LHLD 0001H ; Get BIOS address MVI B,53 CALL MOVE ; LXI SP,STACK ; Use our own stack ; CALL ILPRT DB CR,LF,'Sort and pack directory v' DB VERS/10 +'0',(VERS MOD 10) +'0' DB ' - 07/27/87',CR,LF,CR,LF,0 ; LDA FCB+1 CPI '?' ; Requesting some help? JNZ START1 ; CALL ILPRT DB 'Examples of how to use:',CR,LF,CR,LF DB ' B>SAP - current drive',CR,LF DB ' B>SAP D: - with or without colon',CR,LF DB ' B>SAP d - upper or lower case',CR,LF,0 RST 0 ; Finished ; START1: CALL ILPRT DB 'please wait...',0 MVI C,VERNO ; Check for CP/M ver 2.2 CALL BDOS DCR H ; H=1 for MPM JZ MPMYES ; Exit if MPM, we can't use it MOV A,L ; HL = 0022H if CP/M ver 2.2 CPI 22H+1 ; Check for MPM or CP/M 3.0 JNC MPMYES ; Exit if CP/M 3.0, we can't use it STA VERFLG ; Store the version ; ;----------------------------------------------------------------------- ; ; MAIN PROGRAM LOOP ; ;----------------------------------------------------------------------- ; SAP: CALL SETUP CALL TSTWRT CALL RDDIR CALL CLEAN CALL SORT CALL WRDIR ; Write directory and DateStamper(TM) CALL ILPRT ; file ; DB 'DONE',CR,LF,0 ; EXIT: LDA ODISK ; Restore login status MOV E,A MVI C,SELDRV ; Sets BIOS drive too CALL BDOS LDA OUSER MOV E,A MVI C,USERFN CALL BDOS RST 0 ; Warm boot - required after ; Change in directory checksum ; ;----------------------------------------------------------------------- ; ; INITIALIZATION ; ;----------------------------------------------------------------------- ; ; Setup for selecting drive and loading disk parameter block ; SETUP: XRA A STA CLNFLG MVI C,USERFN ; Save original drive and user number MVI E,0FFH CALL BDOS STA OUSER MVI C,GETDSK CALL BDOS STA ODISK STA CURDSK ; ; Checks to see if a specific drive was requested (with or without colon) ; LDA FCB+1 ; Requested drive include a colon? CPI 'A' JC SETUP1 ; If not, exit CPI 'P' JNC SETUP2 ; Acceptable drives A-P only SUI 40H ; Convert to binary JMP SETUP3 ; Go log it in ; SETUP1: LDA FCB ; See if any drive was requsted CPI 'A'-40H JC LOGIT ; If a 0, log in current drive CPI 'P'+1-40H ; Acceptable drives A-P only JC SETUP3 ; SETUP2: CALL ILPRT DB CR,'++ Drive out of range ++',CR,LF,0 JMP EXIT ; Out of range ; SETUP3: DCR A ; Change to DRI's drive requirement STA CURDSK ; Store for current disk ; LOGIT: MOV E,A ; Log in designated drive thru BDOS MVI C,SELDRV CALL BDOS ; MVI E,0 ; Set user 0 MVI C,USERFN CALL BDOS ; LDA CURDSK ; BIOS call to get DPH to HL MOV C,A CALL SELDSK ; CALL CPM22 ; LHLD DRM ; Number of directory entries INX H ; Relative to 1 SHLD SCOUNT PUSH H DAD H ; Allocate 2*#dir entries LXI D,BUFFER ; For pointer words DAD D SHLD BUFBAS POP H PUSH H CALL ROTRHL ; Divide by 4 CALL ROTRHL ; To get record count SHLD DIRLEN CALL ROTRHL ; And by 8 for time&date SHLD TDCNT ; ; Check for sufficient memory ; POP H ; # entries *32 DAD H ; x2 DAD H ; x4 DAD H ; x8 DAD H ; x16 DAD H ; x32 XCHG LHLD BUFBAS ; + BUFBASE DAD D XCHG LHLD 6 ; - available TPA CALL SUBDE RNC CALL ILPRT DB CR,LF DB 'Not enough memory!' DB CR,LF,BEL,0 JMP EXIT ;..... ; CPM22: MOV E,M ; CP/M 2.2 routine INX H MOV D,M INX H XCHG SHLD RECTBL XCHG LXI D,8 ; Offset to DPB within header DAD D ; Returned by SELDSK in CP/M 2.2 MOV A,M ; Get adrress of DPB INX H MOV H,M MOV L,A LXI D,DPB ; Point to destestination: our DPB MVI B,DPBLEN JMP MOVE ;..... ; ; Read and write first directory record to ensure writable disk ; TSTWRT: MVI C,RESET CALL BDOS CALL SETCUR LHLD SYSTRK CALL DOTRAK LXI H,1 CALL DOREC LXI H,TBUFF MOV B,H MOV C,L CALL SETDMA CALL READ ORA A JNZ RTERR MVI C,1 ; Directory write forces flush CALL WRITE ORA A JNZ WTERR CALL CKTD ; See if DateStamper(TM) file is on disk RET ;..... ; ; WTERR: CALL ILPRT DB CR,LF DB 'Can''t write disk -- write-protect tab?' DB CR,LF,BEL,0 JMP EXIT ; RTERR: CALL ILPRT DB CR,LF DB 'Can''t read disk!' DB CR,LF,BEL,0 JMP EXIT ; ;----------------------------------------------------------------------- ; ; READ & WRITE DIRECTORY ; ;----------------------------------------------------------------------- ; ; Write directory ; WRDIR: LDA NOSWAP ORA A JNZ WRDIR1 CALL ILPRT DB '(Previously sorted) - ',0 LDA CLNFLG ; If in sorted order ORA A ; And no erasures RZ ; We're all done ; WRDIR1: CALL ILPRT DB 'Writing, ',0 ; WRDIR2: CALL DMA80 ; Set default DMA LHLD DIRLEN SHLD DIRCNT LXI H,BUFFER ; Set initial pointer SHLD PTR MVI A,1 ; Flag write operation CALL DODIR CALL DODATE ; Then update the DateStamper(TM) file RET ;..... ; ; Read directory, get current drive to include in display ; RDDIR: MVI C,GETDSK ; Get the current disk drive CALL BDOS ADI 'A' ; Convert to ASCII STA RDDIR1 CALL ILPRT DB CR,' ' ; RDDIR1: DB ' : --> Reading, ',0 LHLD DIRLEN SHLD DIRCNT LHLD BUFBAS SHLD ADDR ; For read DMA address LXI H,BUFFER SHLD PTR MVI A,0 ; READFLG ; DODIR: STA WRFLAG LHLD SYSTRK CALL DOTRAK ; Set the track LXI H,0 SHLD RECORD ; DLOOP: LHLD RECORD ; Get records per track INX H XCHG LHLD SPT ; Current record CALL SUBDE ; Record - SPT XCHG JNC NOTROV ; ; Track overflow, bump to next ; LHLD TRACK INX H CALL DOTRAK LXI H,1 ; Rewind record number ; NOTROV: CALL DOREC ; Set current record LDA WRFLAG ; Time to figure out ORA A ; If we are reading JNZ DWRT ; Or writing ; ; Reading ; LHLD ADDR MOV B,H ; Set up DMA address MOV C,L CALL SETDMA CALL READ ORA A ; Test flags on read JNZ RERROR ; NZ=error LHLD ADDR MVI B,4 ; Install pointers for 4 entries in this XCHG ; record. LHLD PTR ; PLP: MOV M,E INX H MOV M,D INX H PUSH H LXI H,32 DAD D XCHG POP H DCR B JNZ PLP SHLD PTR XCHG SHLD ADDR ; New DMA ; ; Common Read/write code ; MORE: LHLD DIRCNT ; Countdown entries DCX H SHLD DIRCNT MOV A,H ; Test for zero left ORA L JNZ DLOOP ; Loop till zero ; ; Directory I/O done, reset DMA address ; DMA80: LXI B,TBUFF JMP SETDMA ;..... ; ; Write-directory code ; DWRT: MVI B,4 LXI D,TBUFF ; DWRT1: PUSH B ; Copy 4 sorted entries to buffer CALL NXTENT CALL MOVE32 POP B DCR B JNZ DWRT1 MVI C,0 ; Write allocated... LHLD DIRCNT DCX H MOV A,H ORA L JNZ DWRT3 ; Unless it's the last record MVI C,1 ; Which must be flushed ; DWRT3: CALL WRITE ORA A JNZ WERROR JMP MORE ;..... ; ; Return HL = pointer to next sorted entry ; NXTENT: PUSH D LHLD PTR MOV E,M INX H MOV D,M INX H SHLD PTR XCHG POP D RET ;..... ; ; Track and record update routines ; DOTRAK: SHLD TRACK MOV B,H MOV C,L JMP SETTRK ; DOREC: SHLD RECORD MOV B,H MOV C,L LHLD RECTBL XCHG DCX B CALL RECTRN MOV B,H MOV C,L LDA VERFLG ORA A RZ JMP SETREC ; ;----------------------------------------------------------------------- ; ; CLEAN OUT ERASED ENTRIES ; ;----------------------------------------------------------------------- ; ; Also any zero-length files, if affirmed by user. ; Preserve '-' zero-length (catalog) filenames. ; CLEAN: LXI H,0 ; IND = 0 ; CLNLOP: SHLD IND CALL INDEX ; HL = BUF + 32 * IND MOV A,M ; Jump if this is a deleted file CPI 0E5H JZ FILLE5 MOV B,H ; Save index in BC MOV C,L LXI D,9 ; If filetype is '$$$' DAD D MVI A,'$' CMP M JNZ CLN1 INX H CMP M JNZ CLN1 INX H CMP M JZ FILLE5 ; Erase it ; CLN1: LXI H,12 DAD B MOV A,M ; Check extent field ORA A JNZ CLBUMP ; Skip if not extent 0 INX H ; Point to record count field INX H MOV A,M ; Get S2 byte (extended RC) ANI 0FH ; For CP/M 2.2 MOV E,A INX H MOV A,M ; Check record count field ORA E JNZ CLBUMP ; Jump if non-zero ; LDA ZROERA ; Erase 0-length files? ORA A JZ CLBUMP ; Zero does not erase so exit ; LHLD IND ; Clear all 32 bytes of CALL INDEX ; Directory entry to E5 INX H MOV A,M ; Get first character of filename DCX H ; MAST.CAT catalog programs CPI '-' ; Have diskname of zero length JZ CLBUMP ; That starts with '-', do not erase ; FILLE5: LHLD IND ; Recompute entry address of this file CALL INDEX MVI C,32 ; Number of bytes to clear MVI A,0E5H ; Fill with E5's ; FILLE6: CMP M JNZ FILLE7 INX H DCR C JNZ FILLE6 JMP CLBUMP ; Already clean ; FILLE7: STA CLNFLG ; FILLOP: MOV M,A ; Make it all E5's INX H DCR C JNZ FILLOP ; CLBUMP: LHLD DRM ; Get count of filenames INX H XCHG LHLD IND ; Our current count INX H PUSH H CALL SUBDE ; Subtract POP H JC CLNLOP ; Loop till all cleaned RET ;..... ; ; Type 'FILENAME.TYP' at (HL) ; FNFT: MVI B,8 CALL TYPEFN MVI A,'.' CALL AOUT MVI B,3 ; TYPEFN: PUSH B MOV A,M CALL AOUT INX H POP B DCR B JNZ TYPEFN RET ;..... ; ; AOUT: PUSH B PUSH H MOV C,A CALL CO POP H POP B RET ; ;----------------------------------------------------------------------- ; ; PRINT A STRING ; ;----------------------------------------------------------------------- ; ; Address is on top of stack, preserves 'BC' ; ILPRT: XTHL ; Get address from stack MOV A,M ; Get character INX H ; Point to next address XTHL ; Restore to stack ORA A ; Are we done? RZ ; Yes, return past string ; CALL AOUT ; Preserves HL,BC JMP ILPRT ; Continue ;..... ; INDEX: DAD H ; x2 for *32 DAD H ; x4 DAD H ; x8 DAD H ; x16 DAD H ; x32 XCHG LHLD BUFBAS DAD D RET ;..... ; MOVE16: MVI B,16 JMP MOVE ; MOVE32: MVI B,32 ; ; Move (B) bytes from (HL) to (DE) ; MOVE: MOV A,M STAX D INX H INX D DCR B JNZ MOVE RET ; ;----------------------------------------------------------------------- ; ; SORT THE DIRECTORY ; ; This sort routine is adapted from SOFTWARE TOOLS by ; Kernigan and Plaugher. Routine extracted from SD. ; ;----------------------------------------------------------------------- ; SORT: XRA A STA NOSWAP ; Zero the flag in case already sorted CALL ILPRT DB 'Sorting, ' DB 0 LHLD SCOUNT ; Number of entries LDA TDFLAG ORA A JZ L0 DCX H ; Skip past TIME&DAT entry SHLD SCOUNT ; L0: ORA A ; Clear carry MOV A,H ; GAP=GAP/2 RAR MOV H,A MOV A,L RAR MOV L,A ORA H ; Is it zero? RZ ; Then none left MOV A,L ; Make GAP odd ORI 1 MOV L,A SHLD GAP INX H ; IIN=GAP+1 ; L2: SHLD IND XCHG LHLD GAP MOV A,E ; JND=IND-GAP SUB L MOV L,A MOV A,D SBB H MOV H,A ; L3: SHLD JND XCHG LHLD GAP ; JG=JND+GAP DAD D SHLD JG CALL COMPAR ; Compare (JND) and (JG) ; L3A: JP L5 ; If A(JND)<=A(JG) LHLD JND XCHG LHLD JG CALL SWAP ; Exchange A(JND) and A(JG) LHLD JND ; JND=JND-GAP XCHG LHLD GAP MOV A,E SUB L MOV L,A MOV A,D SBB H MOV H,A JM L5 ; If JND>0 GOTO L3 ORA L ; Check for zero JNZ L3 ; * shortened ; L5: LHLD SCOUNT ; For later XCHG LHLD IND ; IND=IND+1 INX H MOV A,E ; If IND<=N GOTO L2 SUB L MOV A,D SBB H JP L2 LHLD GAP JMP L0 ;..... ; ; Returns SIGNED comparison ; COMPAR: CALL GETBAS DAD H ; *2 DAD B ; +base XCHG ; 1st pointer to DE temporarily DAD H DAD B XCHG ; 2nd pointer now in DE, first in HL MOV C,M ; Put 1st pointer in BC INX H MOV B,M XCHG ; 2nd pointer now in HL, first in BC MOV E,M INX H MOV D,M XCHG ; ; Should be 1+11+ext+s2, sort by USERNO, NAME,TYPE, EXTENT and S2 byte ; MVI E,12 ; Will do S2 independently, making 13 ; COMPBH: MOV A,M ; 7-bit signed compare of (BC), (HL) ANI 7FH ; Strip high bit MOV D,A LDAX B ANI 7FH ; Strip high bit CMP D INX B INX H RNZ DCR E JNZ COMPBH ; ; User number file name and file type are equal, now check S2 byte for ; any files in excess of 512k ; INX B INX H INX B INX H MOV A,M ; 4-bit signed compare of (BC), (HL) ANI 0FH ; Strip all but low order nibble MOV D,A LDAX B ANI 0FH ; Strip all but low order nibble CMP D RNZ ; ; S2 byte is equal, now go back to extent ; DCX B DCX H DCX B DCX H MOV A,M ; 7-bit signed compare of (BC), (HL) ANI 7FH ; Strip any high bits set MOV D,A LDAX B ANI 7FH ; Strip any high bits set CMP D RET ;..... ; ; Swap entries in the order table ; SWAP: MVI A,0FFH STA NOSWAP CALL GETBAS DAD H ; *2 DAD B ; + base XCHG DAD H ; *2 DAD B ; + base MOV C,M LDAX D XCHG MOV M,C STAX D INX H INX D MOV C,M LDAX D XCHG MOV M,C STAX D RET ;..... ; GETBAS: LXI B,BUFFER-2 ; If TIME&DAT file LDA TDFLAG ORA A RZ INX B ; Start at 2nd entry INX B RET ;..... ; ;----------------------------------------------------------------------- ; ; DATESTAMPER SUPPORT CODE ; ; 1. checks for presence of DateStamper(TM) file ; 2. re-writes time and date entries in sorted order ; corresponding to the new directory order. ;----------------------------------------------------------------------- ; ; Check 1st directory entry for the DateStamper(TM) file ; CKTD: LXI H,TDNAM0 ; User # 0 too MVI B,12 PUSH H PUSH B LXI D,TDFCB ; Initialize USERNO.NAME in FCB now CALL MOVE XRA A MVI B,36-12 ; ZLP: STAX D INX D DCR B JNZ ZLP POP B POP H LXI D,TBUFF ; See if it's the time&dat file CALL MATCH7 JNZ NOTD MVI A,0FFH JMP SETTD ; NOTD: XRA A ; SETTD: STA TDFLAG ; Set flag if special file present RET ;..... ; ; Rewrite the TIME&DAT file in sorted order ; ; 1. read the file to (bufbase) ; 2. use ptrs to index to each 16-byte entry ; 3. write new records ; DODATE: LDA TDFLAG ORA A RZ ; No TIME&DAT file MVI C,RESET ; Directory has been changed CALL BDOS ; Force new checksum in BDOS CALL SETCUR ; ; 1. open file to get all attributes ; 2. reset read-only bit ; LXI D,TDFCB PUSH D MVI C,OPEN CALL BDOS INR A POP D JZ TDOERR LXI H,TDFCB+9 ; Set file R/W MOV A,M ANI 7FH MOV M,A MVI C,ATTFN CALL BDOS ; DOD1: MVI B,0 ; Record counter LHLD BUFBAS ; TDRLP: XCHG PUSH D PUSH B MVI C,DMAFN CALL BDOS LXI D,TDFCB MVI C,READFN CALL BDOS ORA A POP B POP D JNZ RDDONE INR B LXI H,80H DAD D JMP TDRLP ;..... ; RDDONE: LHLD BUFBAS ; ; Check the checksum for all records ; CKLP: PUSH B CALL CKSUM CMP M INX H POP B JZ SOK CALL ILPRT DB CR,LF DB 'Checksum error in original ' DB '"!!!TIME&.DAT" file -- proceeding' DB CR,LF,BEL,0 ; SOK: DCR B JNZ CKLP ; ; Initialize for writing ; XRA A STA TDFCB+12 ; Extent STA TDFCB+32 ; Currebt record CALL DMA80 LXI H,BUFFER ; Initialize pointer SHLD PTR LHLD TDCNT ; WTLP1: PUSH H ; ; Copy 8 Time&Date entries to TBUFF ; LXI D,TBUFF MVI B,8 ; WTLP2: PUSH B ; +1 PUSH D ; +2 LHLD PTR ; Get pointer to next entry MOV E,M INX H MOV D,M INX H SHLD PTR ; Save next pointer ; ; DateStamper(TM) entries are 16 bytes ; LHLD BUFBAS ; Get: BUFBASE + [(PTR)-BUFBASE]/2 PUSH H XCHG CALL SUBDE ; (PTR)-BUFBASE CALL ROTRHL ; /2 POP D ; + BUFBASE DAD D ; POP D ; Move it to tbuff CALL MOVE16 ; De points to next slot in tbuff POP B ; +0 DCR B JNZ WTLP2 LXI H,TBUFF ; Update the record's checksum byte CALL CKSUM MOV M,A LXI D,TDFCB ; Write the record MVI C,WRITFN ; DBUG: CALL BDOS ORA A POP H JNZ TDWERR DCX H ; Count down MOV A,H ORA L JNZ WTLP1 LXI D,TDFCB ; Close TIME&DAT file PUSH D MVI C,CLOSE CALL BDOS POP D INR A JZ TDCERR LXI H,TDFCB+9 ; Return file to R/O status MOV A,M ORI 80H MOV M,A MVI C,ATTFN JMP BDOS ; ; Checksum 1st 127 bytes at (HL) ; CKSUM: MVI B,127 XRA A ; CKSU1: ADD M INX H DCR B JNZ CKSU1 RET ;..... ; TDNAM0: DB 0,'!!!TIME&DAT' ; TDOERR: CALL ILPRT DB CR,LF DB 'Can''t open ',0 ; FNERR: CALL ILPRT DB '"!!!TIME&.DAT" file!' DB BEL,CR,LF,0 RET ; TDWERR: CALL ILPRT DB CR,LF DB 'Write error ',0 JMP FNERR ; TDCERR: CALL ILPRT DB CR,LF DB 'Close error ' DB 0 JMP FNERR ; ;----------------------------------------------------------------------- ; ; MISCELLANEOUS SUPPORT ROUTINES ; ;----------------------------------------------------------------------- ; SETCUR: LDA CURDSK MOV E,A ; Put drive back MVI C,SELDRV JMP BDOS ;..... ; ; Compare B bytes at DE and HL (without attributes ) ; MATCH7: LDAX D XRA M ANI 7FH ; Ignore attributes RNZ INX H INX D DCR B JNZ MATCH7 RET ;..... ; ; Utility subtraction subroutine...HL = HL-DE ; SUBDE: MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A RET ;..... ; ; Divide HL by 2 ; ROTRHL: ORA A ; Clear carry MOV A,H RAR MOV H,A MOV A,L RAR MOV L,A RET ;..... ; ; Come here if we get a read error ; RERROR: CALL ILPRT DB CR,LF DB '=> READ ERROR - NO CHANGE made' DB CR,LF,BEL,0 JMP EXIT ;..... ; ; Come here if we get a write error ; WERROR: CALL ILPRT DB CR,LF DB '=> WRITE ERROR - directory left in UNKNOWN condition' DB CR,LF,BEL,0 JMP EXIT ;..... ; ; M/PM OR CP/M 3.0 not allowed with this program ; MPMYES: CALL ILPRT DB CR,LF DB 'SAP v' DB VERS/10 +'0',(VERS MOD 10) +'0' DB ' runs with CP/M 1.4 or CP/M 2.2' DB BEL,CR,LF,0 RST 0 ; Warm boot ;..... ; ;----------------------------------------------------------------------- ; ; Data area ; ADDR: DS 2 DIRLEN: DS 2 DIRCNT: DS 2 IND: DS 2 JND: DS 2 GAP: DS 2 JG: DS 2 ; RECTBL: DS 2 RECORD: DS 2 TRACK: DS 2 ; TDCNT: DS 2 ; NOSWAP: DS 1 VERFLG: DS 1 WRFLAG: DS 1 TDFLAG: DS 1 CLNFLG: DS 1 ; ;----------------------------------------------------------------------- ; ; Disk parameter block: ; DPB: SPT: DS 2 BSH: DS 1 BLM: DS 1 EXM: DS 1 DSM: DS 2 DRM: DS 2 AL0: DS 1 AL1: DS 1 CKS: DS 2 SYSTRK: DS 2 CURDSK: DS 1 ODISK: DS 1 OUSER: DS 1 BUFBAS: DS 2 PTR: DS 2 SCOUNT: DS 2 ; TDFCB: DS 36 ; DateStamper(TM) file control block ;..... ; ;----------------------------------------------------------------------- ; VECTRS: DS 53 ; Room for jump vectors ; WBOOT EQU VECTRS+3 ; Do not change these equates CSTS EQU VECTRS+6 CI EQU VECTRS+9 CO EQU VECTRS+12 LO EQU VECTRS+15 PO EQU VECTRS+18 RI EQU VECTRS+21 HOME EQU VECTRS+24 SELDSK EQU VECTRS+27 SETTRK EQU VECTRS+30 SETREC EQU VECTRS+33 SETDMA EQU VECTRS+36 READ EQU VECTRS+39 WRITE EQU VECTRS+42 LSTS EQU VECTRS+45 RECTRN EQU VECTRS+48 ;..... ; ;----------------------------------------------------------------------- ; ; BDOS functions ; VERNO EQU 12 ; Provides CP/M version number RESET EQU 13 ; BDOS reset drives function SELDRV EQU 14 ; Select drive function OPEN EQU 15 CLOSE EQU 16 USERFN EQU 32 ; BDOS user # function ATTFN EQU 30 GETDSK EQU 25 ; BDOS "get disk #" function DMAFN EQU 26 READFN EQU 20 WRITFN EQU 21 ; BDOS EQU 0005H TBUFF EQU 80H FCB EQU 5CH ;..... ; ;----------------------------------------------------------------------- ; DS 32 ; Minimum stack depth ; EVEN EQU ($+255)/256*256 ; Start buffer on even page, which also ; Increase stack area greatly ORG EVEN ; STACK EQU $-2 ; BUFFER: DS 0 ; END START