home *** CD-ROM | disk | FTP | other *** search
-
- ; 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 <ret> - default drive
- ; B>SAP D: <ret> - with or without colon
- ; B>SAP d <ret> - upper or lower case
- ;
- ; 2. Added a small help guide per Paul Foote's suggestion:
- ;
- ; B>SAP ? <ret> - 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 <ret> - current drive',CR,LF
- DB ' B>SAP D: <ret> - with or without colon',CR,LF
- DB ' B>SAP d <ret> - 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