home *** CD-ROM | disk | FTP | other *** search
- ; SUPER DIRECTORY PROGRAM
- ; SD132
- ; 17 Apr 88
- ;
- ; Read SD.INF for detailed instructions on configuring SD for your
- ; system. For information regarding this utility's modification
- ; history, read SD.HIS.
- ;
- ; This program is being distributed ready
- ; to use on a CP/M v2.2 computer with two
- ; disk drives and no ZCPR in use.
- ;
- ; (Options often changed for RCPM use are
- ; marked with an asterisk.) The typical
- ; RCPM Sysop might change only these:
- ;
- ; a) 3 options starting at MAXDRV
- ; b) how many drives at LODRV and
- ; c) 5 options starting at USEF
- ; d) USELCW needs wheel to prevent
- ; showing archive bits
- ;
- ;
- ; NOTE: This version can be assembled with
- ; ASM, LASM, M80, MAC or SLRMAC.
- ;
- ; SD displays the directory of a CP/M disk, sorted alphabetically, with
- ; the file size in k, rounded to the nearest CP/M block size. It also
- ; displays library and archive files with the file size in k, if the $L
- ; option is selected.
- ;
- ; Current versions of SD automatically adjust for any block size and di-
- ; rectory length under CP/M 2.2, 3.0 or MP/M. They can also handle any
- ; number of disk drives or skip those not available. Current features:
- ;
- ; 1) Automatic pauses when the screen fills up except when the
- ; F, N, or P options are specified
- ; 2) Searching individual or multiple drives and/or user areas
- ; 3) Unconditional or optional disk system reset before execution
- ; begins
- ; 4) Directing output to a disk file called DISK.DIR and append-
- ; ing to that file on subsequent runs
- ; 5) Summary line output giving drive and user information, num-
- ; ber of files matched, how much space they consume and free
- ; space remaining on the disk
- ; 6) Displaying or suppressing "system" files
- ; 7) Accepting ambiguous filenames with or without a drive name
- ; 8) Printer output (automatically suppresses the [more] pauses)
- ; 9) Optional help menu with '?'
- ; 10) Displaying number of records used by files
- ; 11) Alphabetization of files sorted by type (extent)
- ; 12) Selecting alternate list format - vertical if horizontal
- ; is default, and vice versa.
- ; 13) Shows contents of .ARC, .ARK or .LBR files with $L option
- ; 14) Summary line output optionally contains name of ZCPR3 named
- ; directory, if selected
- ; 15) ZCPR3 named directory may be used in command line instead
- ; of DU: if selected
- ; 16) ZCPR3 Public user areas may be displayed with or without
- ; WHEEL byte
- ;
- ;-----------------------------------------------------------------------
- ;
- ; ASEG ; Needed for M80 and RMAC, ignore error
- ;
- ORG 0100H
- ;
- JMP START
- ;
- NO EQU 0
- YES EQU NOT NO ; (Some assemblers don't like 0FFh)
- ;
- ; Define version number
- ;
- MAIN EQU 1 ; Main block number
- VER EQU 32 ; Current version
- MONTH EQU 04 ; Month
- DAY EQU 17 ; Day
- YEAR EQU 88 ; Year
- ;
- ;-----------------------------------------------------------------------
- ; options
- ;
- MAXDRV EQU NO ; *Yes if MAXD byte is supported
- MAXUR EQU NO ; *Yes if MAXU byte is supported
- WHEEL EQU NO ; *Yes if using ZCPR wheel byte
-
- MXDRV EQU 3DH ; *Set to max drive address if MAXDRV=Yes
- MXUSR EQU 3FH ; *Set to max user address if MAXUR=Yes
- MXZUSR EQU 15 ; Maximum user # allowed with WHEEL set
- WHLOC EQU 3EH ; *Set to wheel location if WHEEL=Yes
-
- PRBRDR EQU NO ; Yes = print quasi-borders for libraries
- VLIST EQU YES ; Yes for normal vertical alphabetization
- WMBOOT EQU NO ; If warmboot is needed on exit
-
- DB 'Z3ENV' ; For ZCPR3 Environment ID
- DB 1 ; Class 1, External
- DW 0 ; Environment Address. If using ZCPR33
- ; This can be left as is.
- ;-------------------------------
- ;
- ; Drive/User area lookup table:
- ; ----------------------------
- ; Change the following table as appropriate for your version of CP/M.
- ; You can limit the maximum user area without wheel byte independently
- ; for any drive available. Use 0FFh for drives that are not available.
- ;
- ; CP/M v2.2 has 16 user areas, 0-15
- ; CP/M v3.0 has 32 user areas, 0-31
- ;
- ; NOTE: Use your editor to move the "HIDRV" line below the correct
- ; number of drives for your system. This not only saves time when the
- ; highest drive has been reached, but will display a drive/user error
- ; message which otherwise will not be shown.
- ;
- LODRV EQU $ ; Mark beginning of drive/user table
-
- DB 15 ; Maximum user area for drive A
- DB 15 ; " " " " " B
- HIDRV EQU $ ; Mark end of drive/user table
- DB 0FFH ; " " " " " C
- DB 0FFH ; " " " " " D
- DB 0FFH ; " " " " " E
- DB 0FFH ; " " " " " F
- DB 0FFH ; " " " " " G
- DB 0FFH ; " " " " " H
- DB 0FFH ; " " " " " I
- DB 0FFH ; " " " " " J
- DB 0FFH ; " " " " " K
- DB 0FFH ; " " " " " L
- DB 0FFH ; " " " " " M
- DB 0FFH ; " " " " " N
- DB 0FFH ; " " " " " O
- DB 0FFH ; " " " " " P
- ;
- ;-------------------------------
- ;
- ; Command line options:
- ; --------------------
- ; If any of the following equates are set NO, it prevents their use by
- ; any user (including the SYSOP) unless the wheel byte has been set for
- ; SYSOP use. If running an RCPM, you may wish to say NO for those with
- ; an asterisk, such as USEF, USERO, USEP and USES to prevent others from
- ; using them - the wheel byte makes them available for SYSOP use.
- ;
- ; NOTE: For RCPM use, all 5 would normally be set to "NO" to prevent
- ; remote use, but would be available to the Sysop with the WHEEL byte.
- ;
- USEF EQU YES ; *Allow making a local disk copy?
- USEO EQU YES ; *Allow showing only $SYS files?
- USEP EQU YES ; *Allow making local printer listing?
- USER EQU YES ; *Allow disk system reset?
- USES EQU YES ; *Allow showing all, and $SYS files?
- ;
- ;-------------------------------
- ;
- ; Showing tagged attributes
- ; -------------------------
- ; Displaying files with tagged attributes ($R/O, $SYS, $ARC etc.) in an
- ; in an unique manner so they are easy to find, if present.
- ;
- ; Example:
- ; FILENAME.SyS - $SYS attribute set
- ; FILENAME.doC - $SYS and $R/O both set
- ; FILENAME.com - $SYS, $R/O and $ARC all set
- ;
- ; The following equates will permit SD to display the files with tagged
- ; attributes in lower case letters (a-z) as in example above.
- ;
- USELC EQU YES ; Allow lower case letters (a-z)
- USELCW EQU YES ; *Allow lower case without wheel byte?
- ;
- ;-----------------------------------------------------------------------
- ;
- ; Reverse video options
- ; ---------------------
- ; The following equate will permit SD to display the files with tagged
- ; attributes in either reverse video or bright/dim modes. This will al-
- ; low any character tagged to be visible, as opposed to the USELD method.
- ; Up to 7 bytes for enter and exit video modes are provided. These can
- ; be easily patched with DDT, etc.
- ;
- REVID EQU NO ; Yes = inverse or bright/dim display
- ;
- ; The following equate will highlight/underline the summary line
- ;
- ULINE EQU NO ; Yes = highlight/underline summary
- ;
- ;
- ; Reverse video control bytes
- ; ---------------------------
- ; If byte at RVON is 0, simple lower case will be used to display file
- ; attributes.
- ;
- IF REVID
- RVON: DB 0,0,0,0,0,0,0 ; Up to 7 characters for ENTER REVERSE
- DB 0 ; String Terminator MUST BE 0
- ;
- RVOFF: DB 0,0,0,0,0,0,0 ; Up to 7 characters for EXIT REVERSE
- DB 0 ; String Terminator MUST BE 0
- ENDIF ; REVID
- ;
- ; If byte at ULON is 0, no highlighting/underlining will be used in the
- ; banner line.
- ;
- IF ULINE
- ULON: DB 0,0,0,0,0,0,0 ; Up to 7 characters for ENTER ULINE
- DB 0 ; String Terminator, MUST BE 0
- ;
- ULOFF: DB 0,0,0,0,0,0,0 ; Up to 7 characters for EXIT ULINE
- DB 0 ; String Terminator MUST BE 0
- ENDIF ; ULINE
- ;
- ;-------------------------------
- ;
- ; Time/date options
- ; -----------------
- ; The following equate will get the TIMEON from BYE, if BYE is active.
- ; The message "Time on system is xx Minutes" will be displayed.
- ;
- TIMEON EQU NO ; Yes, gets TIMEON from BYE5
- ;
- ; The following equate will permit the date to be displayed using the
- ; European system DD/MM/YY or the American system MM/DD/YY. This only
- ; shows when using 'V' to display version number.
- ;
- EDATE EQU NO ; Yes = European, No = American
- ;
- ;-------------------------------
- ;
- ; Z3CPR options
- ; -------------
- ; for ZCPR33 users - leave all set to NO if not using ZCPR3
- ;
- ZCPR3 EQU NO ; Allow named directory in command line
- NDIRS EQU NO ; To display directory names
- SHOPUB EQU NO ; To display ZRDOS Public Directories
- WHLPUB EQU NO ; To make SHOPUB wheel dependent
- ZRDOS EQU NO ; Set to yes if using ZRDOS
- ;
- ; end of options
- ;-----------------------------------------------------------------------
- ;
- ; Reference items
- ; ---------------
- RECORD EQU 36
- FRN EQU 33
- FCR EQU 32
- READRN EQU 33
- HDRSIZ EQU 27
- ARCMAR EQU 26
-
- TMPLT0 EQU $ ; Start of initialization template
-
- IF VLIST
- DB 0
- ENDIF ; VLIST
-
- IF NOT VLIST
- DB 0FFH
- ENDIF ; NO VLIST
-
- DB 'A' ; All-users option flag
- DB 'C' ; File size in records option
- DB 'D' ; Multi-disk option flag
-
- IF USEF
- DB 'F' ; DISK.DIR file output option
- ENDIF ; USEF
-
- IF NOT USEF
- DB 'F'+80H
- ENDIF ; NOT USEF
-
- DB 'H' ; Show areas from current to highest
- DB 'L' ; Display library members flag
- DB 'N' ; No page-pause option flag
-
- IF USEO
- DB 'O' ; To show $SYS files only
- ENDIF ; USEO
-
- IF NOT USEO
- DB 'O'+80H
- ENDIF ; NOT USEO
-
- IF USEP
- DB 'P' ; Printer output option
- ENDIF ; USEP
-
- IF NOT USEP
- DB 'P'+80H
- ENDIF ; NOT USEP
-
- DB 'Q' ; To show only non-$ARC files
-
- IF USER
- DB 'R' ; Optional reset of disk system
- ENDIF ; USER
-
- IF NOT USER
- DB 'R'+80H
- ENDIF ; NOT USER
-
- IF USES
- DB 'S' ; Include $SYS files
- ENDIF ; USES
-
- IF NOT USES
- DB 'S'+80H
- ENDIF ; NOT USES
-
- DB 'T' ; Primary sort by file type
- DB 'V' ; Show SD version
- DB 'X' ; Alternate alphabetization
- ;
- ; End of option lookup table
- ;
- DW OUTBUF ; Next location in output buffer
- DB 128 ; # of bytes left in output buffer
- DB 0,'DISK DIR' ; Output Filename.typ
- ;
- TMPLT1 EQU $ ; End of initialization data template
-
- VERNAME:DB 13,10,'SD',MAIN+'0'
- DB VER/10+'0',VER MOD 10+'0',' -- '
-
- IF NOT EDATE
- DB MONTH/10+'0',MONTH MOD 10+'0','/'
- ENDIF ; NOT EDATE
-
- DB DAY/10+'0',DAY MOD 10+'0','/'
-
- IF EDATE
- DB MONTH/10+'0',MONTH MOD 10+'0','/'
- ENDIF ; EDATE
-
- DB YEAR/10+'0',YEAR MOD 10+'0'
-
- IF ZCPR3 ;
- DB ', ZCPR3/ARC/ARK Version'
- ENDIF ; ZCPR3
-
- DB 0
- ;
- ;-----------------------------------------------------------------------
- ; Program starts here
- ;-----------------------------------------------------------------------
- ;
- START: LXI H,0
- DAD SP ; HL=old stack
- SHLD STACK ; Save it
- LXI SP,STACK ; Get new stack
-
- IF NDIRS
- LHLD 0109H ; Get Environment Address
- MVI D,0
- MVI E,21 ; Offset to named Directory Buffer Addr.
- DAD D
- MOV E,M
- INX H
- MOV D,M ; DE Now contains NDR Address
- INX H
- MOV A,M
- ADI 1
- STA NUMDIR ; Maximum number of entries plus 1
- XCHG
- SHLD NAMADR ; Keep Address for later
- ENDIF ; NDIRS
- ;
- ; Clear Public User Areas so they can be displayed
- ;
- IF SHOPUB
- LHLD 0109H ; Get Environment Address
- MVI D,0
- MVI E,07EH
- DAD D ; HL Points to Public Drive Byte
- MOV A,M ; Get public DRV byte
- STA PUBDRV
- INX H
- MOV A,M ; Get public USR byte
- STA PUBUSR
- ENDIF ; SHOPUB
-
- IF WHLPUB
- LDA WHLOC
- ORA A
- JZ NOPUB
- ENDIF ; WHLPUB
-
- IF SHOPUB
- DCX H
- MVI A,0 ; Clear Public Areas temporarily
- MOV M,A
- INX H
- MOV M,A
-
- IF WHLPUB
- NOPUB: DS 0
- ENDIF ; WHLPUB
- ;
- ; (WHLPUB enabled, the R option is redundant)
- ;
- ENDIF ; SHOPUB
- ;
- ; See if help is wanted
- ;
- LXI H,FCB+1 ; Filename
- MOV A,M ; 1st Character
- CPI '?' ; Is it "?"
- JNZ INIT ; No, Continue
- INX H ; Yes, Next Char
- MOV A,M ; 2nd Character
- CPI ' ' ; Is it " "
- JNZ INIT ; If not, did not want help guide
- LDA FCB+9 ; Check for any extent
- CPI ' '
- JZ HELPME ; If none, wanted help
- ;
- ; Zero out the entire initialization data area
- ;
- INIT: LXI H,DATA0 ; Point to start of initialized data area
- PUSH H ; Save for non-zero filling later
- MVI C,DATA1-DATA0 ; Data area length
- XRA A ; Clear the "A" register
-
- ZFILL: MOV M,A ; Null the address
- INX H ; Pointer+1
- DCR C ; One less to go
- JNZ ZFILL
-
- IF SHOPUB ; In order for the Public Directories
- MVI A,0FFH ; To be displayed, Option 'R' must be
- STA ROPFLG ; Forced true.
- ENDIF ; SHOPUB
- ;
- ; Now copy non-zero initialization data from the template area
- ;
- POP H ; Load A(DATA0)
- LXI D,TMPLT0 ; Load A(TMPLT0)
- MVI C,TMPLT1-TMPLT0 ; Template area length
-
- NZFILL: LDAX D ; Load template byte
- MOV M,A ; Move to data area
- INX D ; Next location to store data
- INX H ; Next location to get data
- DCR C ; One less to go
- JNZ NZFILL
-
- LXI H,0 ; Clear HL
-
- IF ZRDOS
- MVI C,ZRDVER ; Get ZRDOS version
- CALL BDOS
- MOV A,L ; ZRDOS Version #
- STA ZRDFLG ; Save it
- ENDIF ; ZRDOS
-
- MVI C,CPMVER ; Get CP/M version
- CALL BDOS
- MOV A,L ; CP/M Version number
- STA VERFLG ; Save it
- STA SOHFLG ; Prevents initial unwanted CRLF
- CPI 20H ; Set carry if CP/M 1.4
- PUSH PSW ; Save for BYE test
- MVI E,0FFH ; Load current user number if CP/M 2
- MVI C,STUSER ; Fall through with A=0 if not
- CNC CPM ; Only if CP/M 2.0 or ZRDOS
- STA OLDUSR ; Initial user number
- STA NEWUSR ; New user = Initial user
- STA BASUSR ; Directories
- POP PSW ; Recover Version Flag
- MVI E,241 ; Special BYE5xx Call
- MVI C,STUSER ; Returns 77 if BYE5xx active
- CNC CPM ; BYE5nn not on CP/M 1.4 system
- SUI 77 ; Return code expected
- STA BYEACT ; BYEACT = 0, BYE5nn active
-
- IF TIMEON
- CALL TIME
- ENDIF ; TIMEON
-
- IF ZCPR3
- LDA FCB+13
- STA NEWUSR
- ENDIF ; ZCPR3
-
- IF NOT ZCPR3
- LXI H,TBUF+1 ; Point to command line buffer (CLB)
- MOV A,M ; CLB Character
- CPI '[' ; CP/M 3.0 style delimiter
- JZ CLOK ; (may follow command in CP/M 3.0)
- INX H ; CLB pointer +1
- ORA A ; Terminator?
- JNZ CLOK ; No, continue
- MOV M,A ; Yes, set 2nd terminator
-
- CLOK: LXI D,FCB ; A(file control block)
- CALL FNAME ; Process filename.typ
- MOV A,B ; Disk specification
- CPI 0FFH ; Current?
- JZ CLUS ; Yes
- STAX D ; No, set disk specification
-
- CLUS: MOV A,C ; User specification
- CPI 0FFH ; Current?
- JZ CLNON ; Yes
- STA NEWUSR ; No, set user specification
- STA BASUSR
- ENDIF ; NOT ZCPR3
-
- CLNON: MVI C,CURDSK
- CALL CPM ; Load current disk number
- STA OLDDSK ; Save for reset if needed
- INR A ; Adjust
- STA OUTFCB ; Save directory file drive
- LXI H,FCB ; A(file control block)
- MOV A,M ; Load directory search drive
- ORA A ; Any specified?
- JNZ START1 ; Yes, skip next routine
- LDA OLDDSK ; Otherwise, get default disk
- INR A ; Adjust
- JMP START2
-
- START1: PUSH PSW ; Save status
- MVI A,1
- STA DRVFLG ; Set DRVFLG = 1
- POP PSW ; Load status
-
- START2: MOV M,A ; Absolute drive code in directory FCB
- ;
- ; If at least one option is allowed, scan command line for the option
- ; field delimiter. The option field delimiter is considered valid only
- ; if it is preceded by at least 1 space (otherwise may be part of the
- ; directory filename). Any unrecognized options/illegal user numbers
- ; will be flagged.(We scan the command line buffer rather than the 2nd
- ; default FCB because all 8 options + 2 digit user number will not fit
- ; in the 2nd FCB name field).
- ;
- LXI H,TBUF ; CLB pointer
- MOV B,M ; CLB length
- ;
- ; Search for valid command line delimiter, if not found, assume no
- ; options. Show help menu if single "?" entered.
- ;
- SCNDOL: INX H ; CLB PTR+1
- DCR B ; CLB LEN-1
- JM DOPTN ; Exit if command line buffer empty
- MOV A,M ; CLB Character
- CPI '[' ; CPM+ style delimiter?
- JZ OPTDLM ; Yes
- CPI '$' ; CPM2 style delimiter?
- JZ SPB4 ; Yes
- CPI '/' ; ZCPR style delimiter?
- JNZ SCNDOL ; No
-
- SPB4: DCX H ; '$' found, space must precede
- MOV A,M ; Previous character
- INX H
- CPI ' '
- JNZ SCNDOL ; No space, ignore '$'
- ;
- ; Valid delimiter found. Scan the rest of the buffer for options.
- ; Errors past this point cause an abort.
- ;
- OPTDLM: XCHG ; DE = CLB pointer (swap pointers)
-
- SCNOPT: INX D ; CLB PRT+1
- DCR B ; CLB LEN-1
- JM DOPTN ; If option field exhausted, exit
-
- SCNAGN: LDAX D ; Load option character
- CPI ' ' ; Is it " "?
- JZ SCNOPT ; Yes, Ignore it
- CPI ']' ; CPM+ style terminator?
- JZ SCNOPT ; Options may follow terminator
- LXI H,OTBL-1 ; OTBL pointer
- MVI C,OEND-OTBL+1 ; OTLB length
-
- NOMACH: INX H ; OTLB pointer+1
- DCR C ; OTLB length-1
- JZ CLERR ; Error if option table end
-
- IF WHEEL ; ZCMD/ZCPR2/ZCPR3?
- PUSH PSW ; Save "A" value
- LDA WHLOC ; Load wheel byte
- ORA A ; Set Flags
- JZ NOMAC1 ; Not set, so forget it
- MOV A,M ; Load the table option
- ANI 5FH ; Allow the option
- MOV M,A ; Stuff back in table
-
- NOMAC1: POP PSW ; Restore "A" value
- ENDIF ; WHEEL
-
- CMP M ; Compare with table entry
- JNZ NOMACH ; If no match, check next
- MVI M,0 ; Else, activate the option
- JMP SCNOPT ; Continue scan
- ;.....
- ;
- ; Playback the command line up to the character that stopped the scan
- ; and exit
- ;
- CLERR: XRA A ; Clear "A" register
- INX D ; Tag end of CLB
- STAX D ; With terminator
- CALL CRLF ; New line
- LXI D,ERRMS2 ; 'Error'
- CALL PUTS
- LXI D,ERRTAG ; '->'
- CALL PUTS
- LXI H,TBUF+1 ; Playback CLB to error point
-
- CLELP: MOV A,M ; Character
- ORA A ; Zero?
- JZ CLEX ; Yes, exit
- CALL PUTCHR ; No, output to console
- INX H ; CLB pointer+1
- JMP CLELP ; Continue
-
- CLEX: MVI A,'?' ; Tag line with a '?' field
- CALL PUTCHR
- CALL CRLF ; New Line
-
- IF SHOPUB
- CALL RSTPUB
- ENDIF ; SHOPUB
-
- ;;;;; JMP 0000H ; And reset CCP, all finished
- JMP EXIT2
- ;.....
- ;
- ; Options input or not specified, and associated flags set.
- ;
- ; If D-option, swap error vectors, then start at drive A if no
- ; drive specified on command line.
- ;
- DOPTN: LDA DOPFLG ; If multi-disk flag set,
- ORA A ; Need to set error traps
- JNZ AOPTN ; If not, go check A-option
- CALL SWAPEM ; Swap BDOS error vector tables
- LDA DRVFLG ; Directory drive specified?
- ORA A
- JNZ AOPTN ; No, don't reset
- MVI A,1 ; Yes, Set FCB to A:
- STA FCB
- ;
- ; Start user at 0 if A-option selected without U-option
- ;
- AOPTN: LDA AOPFLG ; Check All-users option
- ORA A
- JNZ COPTN ; Jump if not
- LDA HOPFLG ; Asking to show all from current?
- ORA A
- JZ COPTN ; If yes, do not reset "A" to zero
- XRA A ; No, Start at user 0
- STA NEWUSR
- STA BASUSR
- ;
- ; Test if C-option and set indicator character 'r', else 'k'
- ;
- COPTN: LDA COPFLG ; File sizes wanted in records?
- ORA A
- MVI A,'k'
- JNZ COPTN1 ; Jump if not
- MVI A,'r'
-
- COPTN1: STA FSIZEC ; Indicator char after size
- ;
- ; Determine whether horizontal or vertical alphabetization.
- ; If X-option selected, use alternate format.
- ; Set flag and fence character accordingly.
- ;
- LDA XOPFLG ; Check for X option
- ORA A
- LDA VFLAG ; Get vertical flag
- JNZ XOPTN1 ; Jump if no X option
- CMA ; Else swap vertical/horizontal indicator
- STA VFLAG ; And change VFLAG other way
-
- XOPTN1: DS 0
- ;
- ; The following optionally resets the disk system. The reset must
- ; be done OUTSIDE of the multiple drive loop if the $F option is
- ; enabled because CP/M 1.4 will clobber the DMA buffer on reset.
- ;
- LDA ROPFLG ; Reset Disk?
- ORA A
- JNZ NOOPT
- ;
- ; Disk reset if R option entered on command line
- ;
- MVI C,RESET
- CALL CPM
- ;
- ; Validate drive code and user area numbers from the drive table
- ;
- NOOPT: LXI D,DRUMSG ; Get drive/user error message
- PUSH D
- LDA FCB ; Get directory drive code
- DCR A ; Normalize to range of 0-31
- CPI HIDRV-LODRV ; Compare with max drives on-line
- JNC ERXIT ; Drive error exit if out of range
-
- IF MAXDRV ; Look for MXDRV
- LXI H,MXDRV ; A(MXDRV) to HL
- MOV L,M ; (MXDRV) to L
- ENDIF ; MAXDRV
-
- IF MAXDRV
- INX H ; +1
- CMP L ; Check it
- JNC ERXIT ; Oops if not bigger
- ENDIF ; MAXDRV
- ;
- ; Skips any drives marked 0FFh, some computers do not have contiguous
- ; drives, such as Heath H89, etc.
- ;
- MOV E,A ; Drive code = table index
- MVI D,0
- LXI H,LODRV ; DUTBL Pointer
- DAD D ; DUTBL Pointer+INDEX
- MOV A,M ; User Number
- ORA A ; Set Status
- JM NDSK ; If negative, ignore drive
-
- IF WHEEL
- LDA WHLOC ; Get wheel byte
- ORA A ; Check it
- JZ USRCK ; If reset, restrict user
- MVI A,MXZUSR ; If set, max user = MXZUSR
- JMP USRCK1
- ENDIF ; WHEEL
-
- USRCK: LXI H,LODRV ; DUTBL PTR
- DAD D ; DUTLB PTR+INDEX
- MOV A,M ; Load max user for this drive
-
- IF MAXUR ; Use low memory values if smaller
- MOV H,A ; Current value of MAXUSR
- LDA MXUSR ; Alternate value
- ENDIF ; MAXUR
-
- IF MAXUR AND NOT ZCPR3
- SBI 1 ; MAXUSR is really maximum user+1
- ENDIF ; MAXUR AND NOT ZCPR3
-
- IF MAXUR
- CMP H ; Compare the two
- JNC USRCK1 ; OK if MAXU <= table value
- STA MAXUSR ; Else replace it
- ENDIF ; MAXUR
-
- USRCK1: MOV B,A ; Save max user for later testing
- ANI 1FH ; Insure in range 0-31
- STA MAXUSR ; Save it for later
- LXI H,NEWUSR ; Point to directory user area
- CMP M ; Compare with the maximum
- JC ERXIT ; User number illegal, error exit
- POP D ; Destroy error message pointer
- MOV A,B ; Check to see if this drive
- ORA A ; Has been mapped out
- JM NDSK ; Yes, skip this drive
- LXI H,FCB+1 ; No, point to name
- MOV A,M ; Any name specified?
- CPI '$' ; Delimiter?
- JZ WCD ; Yes, All files
- CPI '/' ; Unix/ZCPR3 delimiter?
- JZ WCD ; Yes, All files
- CPI '[' ; CP/M+ delimiter?
- JZ WCD
- CPI ' ' ; No, Filename specified
- JNZ GOTFCB
- ;
- ; No FCB - make FCB all '?'
- ;
- WCD: MVI B,11 ; Filename+typ length
-
- QLOOP: MVI M,'?' ; Store "?" in FCB
- INX H ; FCB pointer+1
- DCR B ; FCB length-1
- JNZ QLOOP ; Continue
-
- GOTFCB: MVI A,'?' ; Force wild extent
- STA FCB+12
- CALL SETSRC ; Set DMA for BDOS media change check
- LXI H,FCB ; Point to FCB drive code for directory
- MOV E,M ; Load drive code from FCB
- DCR E ; Normalize drive code for select
- MVI C,SELDSK ; Select directory drive to retrieve
- CALL CPM ; The proper allocation vector
- CALL CKVER ; Check version
- JC V14 ; Pre-2.x...get parameters the 1.4 way
- MVI C,DSKPAR ; If 2.2 or MP/M...request DPB
- CALL BDOS
- INX H
- INX H
- MOV A,M ; Load block shift
- STA BLKSHF ; Block Shift
- INX H ; Bump to block mask
- MOV A,M ; Load block mask
- STA BLKMSK ; Block Mask
- INX H
- INX H
- MOV E,M ; Get maximum block #
- INX H
- MOV D,M
- XCHG
- SHLD BLKMAX ; Maximum Block #
- XCHG
- INX H
- MOV E,M ; Load directory size
- INX H
- MOV D,M
- XCHG
- JMP FREE
-
- V14: LHLD BDOS+1 ; Get parameters 1.4 style
- MVI L,3BH ; Point to directory size
- MOV E,M ; Get it
- MVI D,0 ; Force high order to 0
- PUSH D ; Save for later
- INX H ; Point to block shift
- MOV A,M ; Fetch
- STA BLKSHF ; Save
- INX H ; Point to block mask
- MOV A,M ; Fetch it
- STA BLKMSK ; And save it
- INX H
- MOV E,M ; Get maximum block #
- MVI D,0
- XCHG
- SHLD BLKMAX ; Save it
- POP H ; Restore directory size
- JMP FREE20 ; Calculate free space from alloc vector
- ;
- ; Calculate number of K free on selected drive now so the FREE figure
- ; will not reflect either creation or additions to the DISK.DIR file.
- ; Note: This routine will not always function correctly as coded. To
- ; insure the proper calculation when the $F option is specified and
- ; cataloging multiple disks on a single drive, you should do a CTL-C
- ; AFTER the disk to be cataloged has been readied.
- ;
- FREE: SHLD DIRMAX ; Save max number of directory entries
- LDA VERFLG ; Check version number
- CPI 30H ; CP/M 3.0?
- JC FREE20 ; No, Use old method
- LDA FCB ; Load drive number
- DCR A ; Normalize
- MOV E,A ; Use compute free space BDOS call
- MVI C,46 ; Calculate free space
- CALL CPM
- MVI C,3 ; Answer is a 24-bit integer
-
- FRE3L1: LXI H,TBUF+2 ; Answer in 1st 3 bytes of TBUF
- MVI B,3 ; Convert from records to k
- ORA A ; By dividing by 8
-
- FRE3L2: MOV A,M ; LS byte record count
- RAR ; /2
- MOV M,A ; Replace
- DCX H ; Next byte record count
- DCR B ;
- JNZ FRE3L2 ; Loop for 3 bytes
- DCR C
- JNZ FRE3L1 ; Shift 3 times
- LHLD TBUF ; Now get result in k
- JMP SAVFRE ; Save Free Space
-
- FREE20: MVI C,DSKALL ; Allocation vector address
- CALL BDOS
- XCHG
- LHLD BLKMAX ; Max Block Number
- INX H
- LXI B,0 ; Init block count = 0
-
- GSPBYT: PUSH D ; Save allocation address
- LDAX D
- MVI E,8 ; Set to process 8 blocks
-
- GSPLUP: RAL ; Test bit
- JC NOTFRE
- INX B
-
- NOTFRE: MOV D,A ; Save bits
- DCX H ; Count down blocks
- MOV A,L
- ORA H
- JZ ENDALC ; Quit if out of blocks
- MOV A,D ; Restore bits
- DCR E ; Count down 8 bits
- JNZ GSPLUP ; Do another bit
- POP D ; Bump to next byte of allocation vector
- INX D
- JMP GSPBYT ; Process it
-
- ENDALC: POP D ; Clear stack of allocation vector pointer
- MOV L,C ; Copy blocks to HL
- MOV H,B
- LDA BLKSHF ; Load block shift factor
- SUI 3 ; Convert from records to k
- JZ SAVFRE ; Skip shifts if 1k blocks return free in HL
-
- FREKLP: DAD H ; Multiply blocks by k/block
- DCR A
- JNZ FREKLP
- ;
- SAVFRE: SHLD FREEBY ; Save free space for output later
- ;
- ; Reenter here on subsequent passes while in the all-users mode
- ;
- SETTBL: LHLD DIRMAX ; Load directory maximum size
- INX H ; Directory size is DIRMAX+1
- DAD H ; Double directory size
- LXI D,ORDER ; Too get order table size
- DAD D ; Allocate order table
- SHLD TBLOC ; Name tbl begins where order tbl ends
- SHLD NEXTT
- XCHG
- LHLD BDOS+1 ; Insure we have room to continue
- MOV A,E
- SUB L
- MOV A,D
- SBB H
- JNC OUTMEM
- CALL CKVER ; Set carry if pre-CP/M 2
- LDA NEWUSR ; Load directory user area
- MOV E,A
- MVI C,STUSER ; Get the user function
- CNC CPM ; Set new user number if CP/M 2
- ;
- ; Look up the FCB in the directory
- ;
- MVI A,'?' ; Check for wild FCB extent
- LXI H,FCB+12
- MOV M,A ; Match all extents
- INX H
- MOV M,A ; Match all S1 bytes
- INX H
- MOV M,A ; Match all S2 bytes
- LXI H,0
- SHLD COUNT ; Initialize match counter
- SHLD TOTFIL ; " total file counter
- SHLD TOTSIZ ; " total size counter
- CALL SETSRC ; Set DMA for directory search
- MVI C,SRCHF ; Load 'search first' function
- JMP LOOK ; Go search for 1st match
- ;
- ; Read more directory entries
- ;
- MORDIR: MVI C,SRCHN ; Search next function
-
- LOOK: LXI D,FCB ; A(file control block)
- CALL CPM ; Read directory entry
- INR A ; End (0FFH)?
- JZ SPRINT ; Yes, sort & print what we have
- ;
- ; Point to directory entry
- ;
- DCR A ; Undo previous INR A
- ANI 3 ; Make modulus 4
- ADD A ; Multiply
- ADD A ; By 32 because
- ADD A ; Each directory
- ADD A ; Entry is 32
- ADD A ; Bytes long
- LXI H,TBUF+1 ; Point to buffer (skip to FN/FT)
- ADD L ; Point to entry
- ADI 9 ; Point to sys byte
- MOV L,A ; Save (can't carry to H)
- LDA QOPFLG ; Find only non-$ARC files?
- ORA A
- JNZ OSYS ; No, check for only $SYS files
- INX H ; Yes, get the archive byte
- MOV A,M
- DCX H
- ORA A ; Check bit 7 for $ARC file
- JM MORDIR ; If set, ignore this filename
-
- OSYS: LDA OOPFLG ; Find only $SYS files?
- ORA A
- JNZ CKSYS
- MOV A,M ; Yes, get system byte
- ORA A ; Check bit 7 for $SYS file
- JP MORDIR ; If not set, ignore this filename
- JMP SYSFOK ; Else check for a match
-
- CKSYS: LDA SOPFLG ; Did user request $SYS files?
- ORA A
- JZ SYSFOK ; If yes, exit
- MOV A,M ; Get system byte back
- ORA A ; Check bit 7 for $SYS file
- JM MORDIR ; Skip that file
-
- SYSFOK: MOV A,L ; Go back now
- SUI 10 ; Back to user number (allocation flag)
- MOV L,A ; HL points to entry now
- LDA NEWUSR ; Get current user
- CMP M
- JNZ MORDIR ; Ignore if different
- INX H
- ;
- ; Move entry to table
- ;
- XCHG ; Entry to DE
- LHLD NEXTT ; Next table entry to HL
- MVI B,11 ; Entry length (name, type, extent)
-
- TMOVE: LDAX D ; Get entry character
-
- IF NOT (USELC OR REVID)
- ANI 7FH ; Remove attributes
- ENDIF ; NOT (USELC OR REVID)
-
- MOV M,A ; Store in table
- INX D
- INX H
- DCR B ; More?
- JNZ TMOVE
- INX D ; DE->> S1
- INX D ; DE->> S2
- LDAX D ; Get S2 byte, oflo=int(extents/32)
- PUSH H ; Save HL
- MOV L,A ; Set up 16-bit multiply
- MVI H,0
- MVI B,5
- CALL SHLL ; HL is now # of oflo extents
- DCX D ; DE->> S1
- DCX D ; DE->> extent
- LDAX D ; Get extent
- ADD L
- MOV L,A
- MOV A,H
- ACI 0
- MOV H,A ; HL has total extents
- MVI B,7
- CALL SHLL ; HL has total records less last ext
- INX D ; DE->> S1
- INX D ; DE->> S2
- INX D ; Point to sector count
- LDAX D ; Get it
- ADD L
- MOV L,A
- MOV A,H
- ACI 0
- MOV H,A ; HL has total records
- XTHL ; Do some fancy shuffling
- XCHG
- XTHL
- XCHG
- MOV M,D
- INX H
- MOV M,E
- POP D ; All back to normal
- INX H
- SHLD NEXTT ; Save updated table address
- XCHG
- LHLD COUNT ; Bump the # of matches made
- INX H
- SHLD COUNT
- LXI H,13 ; Size of next entry
- DAD D
- XCHG ; Future NEXTT is in DE
- LHLD BDOS+1 ; Pick up TPA end
- MOV A,E
- SUB L ; Compare NEXTT-TPA end
- MOV A,D
- SBB H
- JC MORDIR ; If TPA end > NEXTT, loop back for more
-
- OUTMEM: CALL ERXIT ; Exit if directory too large
- DB 'Memory',0
- ;
- ; Shift HL left by B bits
- ;
- SHLL: DAD H
- DCR B
- RZ
- JMP SHLL
- ;
- ; Sort and print
- ;
- SPRINT: CALL SETFOP ; Return to file output DMA & user #
- LHLD COUNT ; Get file name count
- MOV A,L
- ORA H ; Any found?
- JZ PRTOTL ; Exit if no files found
- PUSH H ; Save file count
- STA SUPSPC ; Enable leading zero suppression
- ;
- ; Initialize the order table
- ;
- LHLD TBLOC ; Get start of name table
- XCHG ; Into DE
- LXI H,ORDER ; Point to order table
- LXI B,13 ; Entry length
-
- BLDORD: MOV M,E ; Save low order address
- INX H
- MOV M,D ; Save high order address
- INX H
- XCHG ; Table address to HL
- DAD B ; Point to next entry
- XCHG
- XTHL ; Save table address, load loop counter
- DCX H ; Count down loop
- MOV A,L
- ORA H ; More?
- XTHL ; Load table address, save loop counter
- JNZ BLDORD ; Yes, go do another one
- POP H ; Clean loop counter off stack
- LHLD COUNT ; Get count
- SHLD SCOUNT ; Save as # to sort
- DCX H ; Only 1 entry?
- MOV A,L
- ORA H
- JZ DONE ; Yes, so skip sort
- ;
- ; This sort routine is adapted from SOFTWARE TOOLS
- ;
- LHLD SCOUNT ; Number of entries
-
- L1: 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?
- JZ DONE ; Then none left
- MOV A,L ; Make gap odd
- ORI 1
- MOV L,A
- SHLD GAP
- INX H ; I=GAP+1
-
- L2: SHLD I
- XCHG
- LHLD GAP
- MOV A,E ; J=I-GAP
- SUB L
- MOV L,A
- MOV A,D
- SBB H
- MOV H,A
-
- L3: SHLD J
- XCHG
- LHLD GAP ; JG=J+GAP
- DAD D
- SHLD JG
- CALL COMPARE ; Compare (J) and (JG)
- JP L4 ; If A(J)<=A(JG)
- LHLD J
- XCHG
- LHLD JG
- CALL SWAP ; Exchange a(J) and a(JG)
- LHLD J ; J=J-GAP
- XCHG
- LHLD GAP
- MOV A,E
- SUB L
- MOV L,A
- MOV A,D
- SBB H
- MOV H,A
- JM L4 ; If J>0 go to l3
- ORA L ; Check for zero
- JZ L4
- JMP L3
-
- L4: LHLD SCOUNT ; For later
- XCHG
- LHLD I ; I=I+1
- INX H
- MOV A,E ; If I<=n go to l2
- SUB L
- MOV A,D
- SBB H
- JP L2
- LHLD GAP
- JMP L1
- ;
- ; Sort is all done - print entries
- ;
- DONE: LDA FOPFLG ; File output flag
- ORA A ; Set?
- JNZ NOOUT ; No, skip open
- ;
- ; If all user option enabled, and we're not on the first pass, then the
- ; output file is already open and positioned, so we can skip the open.
- ;
- LXI H,OPNFLG ; Output file open flag
- CMP M ; A=0,set Z if OPNFLG=0 also
- JNZ NOOUT ; If OPNFLG not zero, skip open
- DCR M ; Else, set OPNFLG for next user #
- ;
- ; First pass on file append - prepare DISK.DIR to receive new
- ; or appended output.
- ;
- LXI D,OUTFCB ; Does output file exist?
- MVI C,SRCHF
- CALL CPM
- INR A
- JNZ OPENIT ; Yes, open for processing
- MVI C,MAKE ; Else, create output file
- CALL CPM
- INR A ; Successful?
- JNZ NOOUT ; Yes, Continue
- ;
- ; If make or open fails, declare error
- ;
- OPNERR: CALL ERXIT
- DB 'Open',0
- ;
- WRTERR: CALL ERXIT
- DB 'Write',0
- ;
- ; Output file already exists - open it and position
- ; it to the last record of the last extent.
- ;
- OPENIT: MVI C,OPEN ; Open 1st extent of output file
- CALL CPM
- INR A
- JZ OPNERR ; Bad deal if 1st won't open
-
- OPNMOR: LDA OUTFCB+15 ; Record count (RC)
- CPI 128
- JC LSTEXT ; If RC<128, this is last extent
- LXI H,OUTFCB+12
- INR M ; Else, increment to next extent
- MVI C,OPEN ; Try to open it
- CALL CPM
- INR A
- JNZ OPNMOR ; Continue opening extents to end
- DCR M ; Then, reopen preceding extent
- MVI C,OPEN
- CALL CPM
- LDA OUTFCB+15 ; Get RC for the last extent
- ;
- ; At this point, OUTFCB is opened to the last extent of the file, so
- ; read in the last record in the last extent.
- ;
- LSTEXT: ORA A ; Is this extent empty?
- JZ NOOUT ; Yes, starting a clean slate
- DCR A ; Normalize record count
- STA OUTFCB+32 ; Set record number to read
- MVI C,READ ; Read last record of file
- CALL CPM
- ORA A ; Successful read?
- JZ RDOK ; Yes, scan for EOF mark
-
- APERR: CALL ERXIT
- DB 'Append',0
- ;
- ; We now have the last record in the file in the buffer. Scan the last
- ; record for the EOF mark, indicate where we can start adding data.
- ;
- RDOK: LXI H,OUTBUF ; Point to output buffer start
- MVI B,128 ; Output buffer length
-
- SCAN: MOV A,M ; Character
- CPI 'Z'-40H ; End of file?
- JZ RESCR ; Yes, save pointers and reset CR
- INX H ; Pointer+1
- DCR B ; Length-1
- JNZ SCAN ; Continue to end of buffer
- ;
- ; If an explicit EOF mark or an implied EOF (last record is full) in
- ; the last buffer, move the FCB record and extent pointer back to cor-
- ; rect for the read operation so the first write operation will replace
- ; the last record of the DISK.DIR file.
- ;
- RESCR: PUSH H ; Save EOF buffer pointer
- PUSH B ; Save EOF buffer remaining
- LXI H,OUTFCB+32 ; Load current record again
- DCR M ; Record-1
- JP SAMEXT ; If CR>=0, still in same extent
- LXI H,OUTFCB+12 ; Else, move to previous extent
- DCR M
- MVI C,OPEN ; Then, reopen previous extent
- CALL CPM
- INR A
- JZ APERR ; Append error if can not reopen
- LDA OUTFCB+15 ; Else,
- DCR A ; Position to last record of
- STA OUTFCB+32 ; The extent
-
- SAMEXT: POP PSW ; Recall EOF location in buffer
- STA BUFCNT ; Set buffer counter
- POP H ; Recall next buffer pointer
- SHLD BUFPNT ; Set pointer for first addition
-
- NOOUT: LDA FIRSTT ; First time through?
- ORA A
- JNZ NOVOPT ; No, we've been here before
- MVI A,0FFH ; Yes,
- STA FIRSTT ; Set first time flag
- LDA VOPFLG ; Version display flag
- ORA A ; Set?
- JNZ NOVOPT ; No, skip version print
- LXI D,VERNAME ; Yes, print version
- CALL PUTS ; Print the string
- CALL CRLF
-
- NOVOPT: LHLD COUNT
- SHLD LCOUNT
- LXI H,0
- SHLD LBTOTL
- SHLD LMTOTL
- LXI H,ORDER ; Initialize order table pointer
- SHLD NEXTL
- SHLD NEXTT
- LDA VFLAG ; Check display form
- ORA A
- JNZ NEWLIN ; Jump if not vertical
- LHLD COUNT ; Code computes end of name table
- CALL MULT13 ; (or start of second table
- XCHG ; Where files to be stored after
- LHLD TBLOC ; Redundant extents removed)
- DAD D
- SHLD NEWPTR ; Save it twice
- SHLD XPOINT ; For later
- ;
- ; Output the directory files we've matched
- ;
- ENTRY: LHLD COUNT ; Files matched count
- DCX H ; Count-1
- SHLD COUNT
- MOV A,H ; Is this the last file?
- ORA L
- JZ OKPRNT ; Yes, last file so skip compare
- ;
- ; Compare each entry to make sure that it isn't part of a multiple
- ; extent file. Go only when we have the last extent of the file.
- ;
- PUSH B ; Save number of columns
- LDA VFLAG ; Check display form
- ORA A
- CNZ CKABRT ; If horiz, check for abort from keyboard
- LHLD NEXTT
- MVI A,11
- CALL COMPR ; Does this entry match next one?
- POP B ; Restore number of columns
- JNZ OKPRNT ; No, print it
- INX H
- INX H ; Skip, highest extent last in list
- SHLD NEXTT
- JMP ENTRY ; Loop back for next lowest extent
- ;
- ; VLIST substitution. If VLIST option chosen, OKPRINT moves unique
- ; filenames and sizes in "k" to a second table above the first for
- ; use later.
- ;
- OKPRNT: LHLD NEXTT ; Get order table pointer
- MOV E,M ; Get low order address
- INX H
- MOV D,M ; Get high order address
- INX H
- SHLD NEXTT ; Save updated table pointer
- XCHG ; Table entry to HL
- LDA VFLAG ; Check display form
- ORA A
- JNZ OKPR1 ; Jump if not vertical
- PUSH H ; Save address of byte to be moved
- LHLD NEWPTR ; Address in new table to put byte
- PUSH H ; Save address
- LXI D,13 ; Update address
- DAD D
- SHLD NEWPTR ; Save for later (end of table)
- POP H ; Set current move to address
- XCHG ; Swap pointers
- POP H ; Set current move from address
- MVI B,11 ; Filename.typ length
- CALL MOVE ; Move it
- PUSH D
- JMP OKPR2
-
- OKPR1: MVI B,8 ; Filename length
- CALL PUTSB ; Output
- MVI A,'.' ; Period after filename
- CALL PUTCHR ; Output
- MVI B,3 ; Filetype length
- CALL PUTSB ; Output
-
- OKPR2: CALL SIZEFL
- LHLD TOTSIZ ; DE = rounded size in K
- DAD D ; Add to total used
- SHLD TOTSIZ
- LHLD TOTFIL ; Increment filecount
- INX H
- SHLD TOTFIL
- XCHG
- LDA COPFLG ; Size wanted in records?
- ORA A
- JNZ OKPR3 ; Jump if not
- LHLD FILERC ; Else get record count
-
- OKPR3: LDA VFLAG ; Check display form
- ORA A
- JNZ OKPR4 ; Jump if not vertical
- POP D ; A(size to go)
- MOV A,H ; Move size to table two
- STAX D
- INX D
- MOV A,L
- STAX D
- ;
- ; One File Moved - Test to see if we have to move another
- ;
- LHLD COUNT ; Current file counter
- MOV A,H
- ORA L
- JZ PRTOTL ; Zero, output summary
- JMP ENTRY
- ;
- ; Output the size of the individual file
- ;
- OKPR4: CALL DECPRT ; Print it
- LDA FSIZEC ; Follow with 'k' or 'r'
- CALL PUTCHR
- ;
- ; One file output - test to see if we have to output another one.
- ;
- LHLD COUNT ; Current file counter
- MOV A,H
- ORA L ; Zero?
- JZ PRTOTL ; Yes, exit to summary output
- ;
- ; At least one more file to output,
- ; can we put it on the current line?
- ;
- DCR C
- PUSH PSW
- CNZ FENCE ; If room left output fence character
- POP PSW
- JNZ ENTRY ; Output another file
- ;
- ; Current line full, start a new one
- ;
- NEWLIN: MVI C,4 ; Reset names per line counter
- CALL CRLF ; Space down to next line
- JMP ENTRY ; Output another file
- ;.....
- ;
- ; Compute the size of the file/library and update our summary datum.
- ; This has been changed into a subroutine so that both the file size
- ; computation and a library size (when printing out library members)
- ; can be computed in K.
- ;
- SIZEFL: MOV D,M
- INX H
- MOV E,M ; Size in DE (records)
- XCHG
- SHLD FILERC ; Save record count
- XCHG
- LDA BLKMSK
- PUSH PSW
- ADD E
- MOV E,A
- MOV A,D
- ACI 0
- MOV D,A
- POP PSW
- CMA
- ANA E
- MOV E,A
- MVI B,3
-
- SHRR: MOV A,D
- ORA A
- RAR
- MOV D,A
- MOV A,E
- RAR
- MOV E,A
- DCR B
- JNZ SHRR
- RET
- ;
- ; Print HL in decimal with leading zero suppression
- ;
- DECPRT: XRA A ; Clear leading zero flag
- STA LZFLG
- LXI D,-10000
- LDA SUPSPC
- PUSH PSW
- XRA A
- STA SUPSPC
- CALL DIGIT
- POP PSW
- STA SUPSPC
- LXI D,-1000 ; Print 1000's digit
- CALL DIGIT
- LXI D,-100 ; Etc.
- CALL DIGIT
- LXI D,-10
- CALL DIGIT
- MVI A,'0' ; Get 1's digit
- ADD L
- JMP PUTCHR
-
- DIGIT: MVI B,'0' ; Start off with ASCII 0
-
- DIGLP: PUSH H ; Save current remainder
- DAD D ; Subtract
- JNC DIGEX ; Quit on overflow
- POP PSW ; Throw away remainder
- INR B ; Bump digit
- JMP DIGLP ; Loop back
-
- DIGEX: POP H ; Restore pointer
- MOV A,B
- CPI '0' ; Zero digit?
- JNZ DIGNZ ; No, type it
- LDA LZFLG ; Leading zero?
- ORA A
- MVI A,'0'
- JNZ PUTCHR ; Print digit
- LDA SUPSPC ; Get space suppression flag
- ORA A ; See if printing file totals
- RZ ; Yes, don't give leading spaces
- JMP SPACE ; Leading zero..print space
- ;
- DIGNZ: STA LZFLG ; Leading zero flag set
- JMP PUTCHR ; Print leading zero & digit
- ;.....
- ;
- ;-----------------------------------------------------------------------
- ; VLIST subroutines begin here
- ;
- ;Multiply contents of HL register by 13
- ;
- MULT13: MOV D,H
- MOV E,L
- DAD H
- DAD D
- DAD H
- DAD H
- DAD D
- RET
- ;.....
- ;
- ; Main VLIST subroutine to output a filename and column delimiter
- ;
- VENTRY: CALL PFILE1 ; Routine to print a filename
- RZ ; If at end of line return with zero set
- CC FENCE ; Print column delimiter if more
- LHLD JUMPER ; Put the jumper back in DE
- XCHG
- ORI 1 ; Insure non zero return
- RET
- ;.....
- ;
- PFILE1: MOV A,M ; Let's see what we have
- CPI 0FEH
- RNC
- ANI 7FH ; Strip parity bit
- PUSH B ; Save number of columns
- MVI B,8 ; Print filename and type
- CALL PUTSB
- MVI A,'.'
- CALL PUTCHR
- MVI B,3
- CALL PUTSB
- MOV D,M ; Get it into DE
- INX H
- MOV E,M
- XCHG ; HL <-> DE
- CALL DECPRT ; Print it out
- LDA FSIZEC ; Follow with 'k' or 'r'
- CALL PUTCHR
- POP B ; Load number of columns
- LHLD TOTFIL ; Load number of files left
- DCX H ; # files-1
- SHLD TOTFIL ; Resave it
- MOV A,H
- ORA L ; Zero yet?
- RZ ; Yes, no more files
- DCR C ; No, decrement it
- STC ; Force carry on
- RET ; This return
- ;.....
- ;
- ; End of VLIST routines
- ;-----------------------------------------------------------------------
- ;
- ; Show total space and files used
- ;
- PRTOTL: LDA VFLAG ; Check display form
- ORA A
- JZ PRTOT1 ; Jump if vertical
- LDA LOPFLG
- ORA A
- JNZ PRTOT1
- LHLD TOTFIL ; How many files matched?
- MOV A,H
- ORA L
- CNZ PRTLMEM ; Skip .LBR check if none found
-
- PRTOT1: XRA A ; Get a zero to
- STA SUPSPC ; Suppress leading spaces in totals
- LHLD TOTFIL ; How many files matched?
- MOV A,H
- ORA L
- JZ NXTUSR ; Skip summary if none found
- PUSH H ; Save TOTFIL
- STA FNDFLG ; Set file found flag
- LDA VFLAG ; Check display form
- ORA A
- JNZ PRTOT3 ; Horizontal = 0FFh, exit if not zero
- LDA SOHFLG
- ORA A
- JZ PRTOT2
- XRA A
- STA SOHFLG
- JMP PRTOT3
-
- PRTOT2: CALL CRLF
-
- PRTOT3: LXI D,TOTMS1 ; Print "13,10,' Drive'"
- CALL PUTS
- LDA FCB
- ADI 'A'-1
- CALL PUTCHR ; Output the drive code
- CALL CKVER
- JC NOUSER
- CALL PUTUSR ; Output user number
-
- IF NDIRS
- MVI A,' '
- CALL PUTCHR
- CALL NAMDIR
- ENDIF ; NDIRS
-
- LDA USRNR
- CPI 10
- LXI D,NOFMS2
- JC $+6
- LXI D,NOFMS2+1 ; Print some spaces
- CALL PUTS
- LDA BYEACT ; BYE active?
- ORA A
- JZ NOUSER ; Yes, skip ulcode
-
- IF ULINE
- LXI D,ULON ; Turn on underline
- CALL COUTS ; If not null
- ENDIF ; ULINE
-
- NOUSER: LXI D,TOTMS6 ; Print " Files: "
- CALL PUTS
- POP H ; Recall TOTFIL
- CALL DECPRT ; Print # of files matched
- LXI D,TOTMS4 ; No CRLF needed, display > 40
- CALL PUTS
- LHLD TOTSIZ ; Total k used by matched files
- CALL DECPRT ; Print file size
- LXI D,TOTMS5 ; Print "k"
- CALL PUTS
- CALL PRTFRE ; Print free space remaining
-
- IF ULINE
- LDA BYEACT ; Bye active?
- ORA A ;
- JZ NPRNT ; Yes, skip ULINE off
- LXI D,ULOFF ; Turn off underline
- CALL COUTS ; If not null
- ENDIF ; ULINE
- ;
- ; Summary line printed, now print detail files, first compute total
- ; printout lines.
- ;
- NPRNT: LDA VFLAG ; Check display form
- ORA A
- JNZ NXTUSR ; Jump if horizontal
- LXI B,3
- MOV A,C ; Get number of names per line
- CMA ; Negative of number of columns
- MOV E,A ; Into DE
- MVI D,0FFH
- LHLD TOTFIL ; Load total number of files
- DAD B ; Round up to a full line
- MVI C,0FFH
-
- NPRNT1: INR C ; C-reg will hold number of
- DAD D ; Lines to be displayed
- JC NPRNT1
- MOV A,C
- STA LINES ; Done, save it for later
- STA SUPSPC ; Allow spaces preceding file sizes
- ;
- ; Number lines times entry size = the number of bytes to skip in the
- ; second table when outputting files in vertical order.
- ;
- MOV L,A ; Put number of lines into HL
- MVI H,0
- CALL MULT13
- SHLD JUMPER ; Put it away
- ;
- ; Fill a record with FF at the end of table 2
- ;
- LHLD NEWPTR ; Now points to end of table 2
- MVI B,128
- MVI A,0FFH
-
- NPRNT2: MOV M,A
- INX H
- DCR B
- JNZ NPRNT2
- ;
- ; Increment the number of files for use later in VENTRY. This insures
- ; that a column delimiter will be printed after the last filename, if
- ; the file appears in other than the last column of the display.
- ;
- LXI H,TOTFIL
- INR M
- ;
- ; Print out a line of files
- ;
- NPRNT3: MVI C,4 ; Reset number of columns
- CALL CRLF ; Start a new line
- ;
- ; Print first filename
- ;
- LHLD XPOINT ; XPOINT = to start of second table
- CALL VENTRY ; At entry. Below, it is incremented
- ; For additional lines of printout
- JZ NLINE ; Either out of columns or out of files
- ;
- ; Print second filename
- ;
- LHLD XPOINT
- DAD D
- CALL VENTRY
- JZ NLINE
- ;
- ; Print third filename
- ;
- LHLD XPOINT
- DAD D
- DAD D
- CALL VENTRY
- JZ NLINE
- ;
- ; Print fourth filename
- ;
- LHLD XPOINT
- DAD D
- DAD D
- DAD D
- CALL VENTRY
-
- NLINE: LHLD XPOINT ; Increment XPOINT to next file
- LXI D,13
- DAD D
- SHLD XPOINT
- LHLD TOTFIL ; Out of files?
- MOV A,H
- ORA L
- JZ DOLIB ; Yes, Check for libraries
- LXI H,LINES ; No, just need a new line
- DCR M
- JNZ NPRNT3
-
- DOLIB: LDA LOPFLG
- ORA A
- JNZ NXTUSR
- LHLD TOTFIL ; How many files matched?
- MOV A,H
- ORA L
- CNZ PRTLMEM ; Skip library check if none found
- ;
- ; Directory for one user area completed. If all users option is select-
- ; ed, then go do another directory on the next user number until we ex-
- ; ceed the maximum user # for the selected drive.
- ;
- NXTUSR: LDA AOPFLG ; All user flag
- ORA A ; Set?
- JZ NXTUSU ; Set if zero, show all user areas
- LDA HOPFLG ; "H" flag to show remaining areas
- ORA A
- JNZ GOCLZ ; Non-zero, not set, exit
-
- NXTUSU: CALL CKVER ; Running CP/M 2?
- JC GOCLZ ; No, Skip user increment
- CALL CKABRT ; Yes, Check for user abort
- LDA MAXUSR ; No abort - get maximum user #
- LXI H,NEWUSR ; Increment directory user number
- INR M
- CMP M ; Next user # exceed maximum?
- JNC SETTBL ; No, more user areas to go
- LDA BASUSR ; Reset base user number for
- MOV M,A ; The next directory search
- ;
- ; We've finished all of our outputting. Flush the remainder of the out-
- ; put buffer and close the file before going to exit routine.
- ;
- GOCLZ: LXI H,OPNFLG ; Get file open status, reset flag
- MOV A,M ; To force reopen on next pass
- MVI M,0
- ORA A ; File open?
- JZ NXTDSK ; No, Skip closing DISK.DIR
- LXI H,BUFCNT
- MOV A,M ; Load # of unflushed characters in
- MVI M,128 ; Buffer, force BUFCNT to empty status
- ORA A ; If BUFCNT=128, buffer empty set sign
- JM DDCLOS ; Close DISK.DIR if buffer is empty
- JZ FLUSH ; Write last record to DISK.DIR if full
- LHLD BUFPNT ; Else pad unused buffer with CTL-Z
-
- PUTAGN: MVI M,'Z'-40H ; EOF marker
- INX H ; Next buffer location
- DCR A ; Count-1
- JNZ PUTAGN ; Continue buffer padding fill
-
- FLUSH: LXI D,OUTFCB ; Flush the last output buffer
- MVI C,WRITE
- CALL CPM
- ORA A
- JNZ WRTERR
-
- DDCLOS: LXI D,OUTFCB ; Close DISK.DIR output file
- MVI C,CLOSE
- CALL CPM
- ;
- ; Directory for all user areas finished. If the multi-disk option is
- ; enabled and selected, reset to the base user area and repeat the
- ; directory for next drive on-line until we either exceed the drives in
- ; our LODRV-HIDRV table, or the BDOS shuts us down with a select or bad
- ; record error, which will be intercepted back to the EXIT module.
- ;
- NXTDSK: LXI H,FNDFLG ; Load file found flag
- MOV A,M
- MVI M,0 ; Clear found flag for next drive
- ORA A
- JNZ NDSK ; Continue if at least 1 file found
- LXI H,FOPFLG
- DCR M
- PUSH H
- LXI D,NOFMS1 ; Print 1st part of no files message
- CALL PUTS ; Print it
- LXI D,NOFLM
- CALL PUTS ; Print message
- LDA FCB
- ADI 'A'-1
- CALL PUTCHR ; Output the drive
- CALL CKVER
- JC NOUSR1
- CALL PUTUSR ; Output the user number
-
- NOUSR1: LXI D,NOFMS3 ; Print divider
- CALL PUTS
- CALL PRTFRE ; Tag with free message
- LDA VFLAG ; Check display form
- ORA A
- CNZ CRLF ; Need another CRLF in horizontal mode
- POP H
- INR M
-
- NDSK: LDA DOPFLG ; Multi-disk selected?
- ORA A
- JNZ NPRT ; No, skip next check
- CALL CKABRT ; Check for user abort
- MVI A,HIDRV-LODRV ; Load max drive code to search
- LXI H,FCB ; Increment directory FCB drive code
- INR M
- CMP M ; Does next disk exceed maximum?
- JC NPRT
-
- IF MAXDRV
- LDA MXDRV ; Look at another value limit
- INR A
- CMP M ; Is it lower?
- JC NPRT ; Bail out if too low
- JMP NOOPT ; Search next disk
- ENDIF ; MAXDRV
-
- JNC NOOPT ; Search next disk if maxdr not true
- ;
- ; If no printer, fall through to EXIT
- ;
- NPRT: LDA POPFLG
- ORA A ; Printer active?
- JNZ EXIT ; No, just exit
- MVI C,LIST
- MVI E,13 ; Print a CRLF
- CALL CPM
- MVI E,10 ; Line feed
- CALL CPM
- JMP EXIT ; All done - exit to CCP
- ;.....
- ;
- ; Output the user number of the directory in decimal
- ;
- PUTUSR: LDA NEWUSR
- CPI 10 ; User no. < 10?
- JC DUX ; Yes, skip 10's digit
- STA USRNR
- PUSH B ; No, process 10's digit
- MVI C,'0'-1
-
- DUY: INR C ; Get tens digit
- SUI 10
- JNC DUY ; Loop until we've gone too far
- ADI 10
- MOV B,A ; Save units digit
- MOV A,C ; Print tens digit
- CALL PUTCHR
- MOV A,B ; Recall units digit
- POP B
-
- DUX: ADI '0' ; Make it ASCII
- JMP PUTCHR
-
- ;.....
- ;
- ; Force new line on output and check for page pause
- ;
- CRLF: MVI A,13 ; Send CR
- CALL PUTCHR
- MVI A,10 ; Send LF
- JMP PUTCHR
- ;.....
- ;
- ; Separate the directory output on a line with a space,
- ; the delimiter, followed by another space.
- ;
- FENCE: CALL SPACE
- MVI A,':' ; Fence character
- CALL PUTCHR ; Print it, then a space character
-
- SPACE: MVI A,' '
- ;
- ; Output character in A to console, and optionally to printer
- ; and/or the output file. Detects user abort request.
- ;
- PUTCHR: PUSH B
- PUSH D
- PUSH H
- PUSH PSW ; Save the character to output
- CALL HITYPE ; Send it to console
- POP PSW ; Restore the output character
- ANI 7FH ; Strip parity bit on character
- ;
- ; Test file output mode and skip to page pause test if not active
- ;
- MOV B,A ; Save stripped character to B
- CPI 10 ; At end of line?
- CZ CKABRT ; Check for user abort request
- LDA FOPFLG ; Is file output active?
- ORA A
- JNZ NOWRIT ; Go check for page pause if not
- ;
- ; File output mode active - make sure we have room in buffer to add
- ; the next character. If buffer full, write out current record first
- ; and then start a new record with current character.
- ;
- LHLD BUFPNT ; Load current buffer pointer
- LDA BUFCNT ; Load buffer capacity remaining
- ORA A ; Buffer full?
- JNZ PUTBUF ; No, Continue
- CALL SETFOP ; Yes, Set the DMA address
- LXI D,OUTFCB ; Else, write current buffer out
- MVI C,WRITE
- CALL CPM ; (call must save character in B)
- ORA A ; Error?
- JNZ WRTERR ; Yes, exit if disk full or R/O
- LXI H,OUTBUF ; Reset buffer pointer
- MVI A,128 ; Reset buffer capacity
-
- PUTBUF: MOV M,B ; Move char to next buffer position
- INX H ; Bump buffer pointer
- SHLD BUFPNT ; And save it
- DCR A ; Buffer char count-1
- STA BUFCNT ; And save it
-
- NOWRIT: MOV A,B ; Recall stripped character
- ANI 7FH ; Strip parity bit on character
- MOV E,A ; Setup list output call
- MVI C,LIST
- LDA POPFLG ; Load printer flag
- ORA A ; Set?
- CZ CPM ; Yes, print character
- MOV A,E ; Recall character
- CPI 10 ; Do we have a line feed?
- JNZ PUTRET ; Exit if not
- LDA NOPFLG ; Page pause function disabled?
- ORA A
- JZ PUTRET ; Yes, exit
- LDA POPFLG ; Load, printer flag
- ORA A ; Set?
- JZ PUTRET ; Yes, skip page pause
- LDA FOPFLG ; File output flag
- ORA A ; Set?
- JZ PUTRET ; Yes, skip page pause
-
- LDA LINCNT ; Load line count
- INR A ; Bump it
- STA LINCNT
- MVI L,23 ; Allows use of [more] to finish display
- CMP L ; End of the screen?
- JC PUTRET
-
- LXI D,EOSMSG ; Else, display pause message
- MVI C,PRINT ; Without checking for line feeds
- CALL BDOS
- CALL GETCH ; Wait for character
- CPI 'C'-40H ; Abort on CTL-C
- JZ EXIT1
- CPI 'K'-40H ; Or CTL-K
- JZ EXIT1
- CPI 'X'-40H ; Or CTL-X
- JZ EXIT1
- CPI ' ' ; See if printing character
- JC NOTEOS ; Exit if not
- JZ NOTEOS1 ; If a space, exit to different place
- ANI 5FH ; Change to upper-case
- CPI 'C' ; Can abort with c, C
- JZ EXIT1
- CPI 'K' ; Can abort with k, K
- JZ EXIT1
- CPI 'X' ; Can abort with x, X
- JZ EXIT1
-
- NOTEOS: XRA A ; Reset line count
-
- NOTEOS1:STA LINCNT
- LXI D,MORERA ; Overwrite the [more] display
- MVI C,PRINT
- CALL BDOS
- XRA A ; Reset the 'A' register
-
- PUTRET: POP H ; Exit from PUTCHR
- POP D
- POP B
- RET
- ;.....
- ;
- ; Output character, with low-case or reverse-video highlighting if high
- ; bit set and conditionals enabled.
- ;
- HITYPE: DS 0
-
- IF USELC OR REVID
- ORA A ; Check for attributes not set
- JP CONOUT ; No attribute..ignore this one
- ANI 7FH ; Attribute set, delete now
- ENDIF ; USELC OR REVID
-
- IF NOT USELCW AND WHEEL
- MOV E,A ; Save the character for later
- LDA WHLOC ; If wheel byte not set then
- ORA A ; Don't use lower case or REVID
- MOV A,E ; Get back the character to display
- JZ CONOUT
- ENDIF ; NOT USELCW AND WHEEL
-
- IF REVID
- PUSH PSW ; Save character
- LXI D,RVON ; Turn on reverse video
- CALL COUTS ; If not null
- POP PSW ; Restore character
- ENDIF ; REVID
-
- IF USELC
- CPI 'A' ; Change only from A-Z
- JC TYPEC
- CPI 'Z'+1
- JNC TYPEC ; Punctuation can change so leave it
- ORI 20H ; If attribute, make lower case
- ENDIF ; USELC
-
- IF USELC OR REVID
- TYPEC: CALL CONOUT ; Send the processed character
- ENDIF ; USELC OR REVID
-
- IF REVID
- LXI D,RVOFF ; Turn off reverse video
- CALL COUTS ; If not null
- ENDIF ; REVID
-
- IF USELC OR REVID
- RET
- ENDIF ; USELC OR REVID
- ;.....
- ;
- ; Output character in A to console
- ;
- CONOUT: MOV E,A ; Get character for BDOS entry
- MVI C,WRCON
- JMP BDOS ; Console Output
- ;.....
- ;
- ; Output (raw) null-terminated string at (DE) to console.
- ;
-
- COUTS: LDAX D ; Get byte of string
- ORA A ; Null?
- RZ ; Return if so
- PUSH D
- CALL CONOUT
- POP D
- INX D ; Next byte
- JMP COUTS
- ;.....
- ;
- ; Output bytes at HL of length B to console/printer/file
- ;
- PUTSB: MOV A,M
- CALL PUTCHR
- INX H
- DCR B
- JNZ PUTSB
- RET
- ;.....
- ;
- ; Output null-terminated string to console/printer/file
- ;
- PUTS: LDAX D ; Load character from DE string
- ANI 7FH ; Strip off parity
- ORA A ; Is a 0?
- RZ ; Yes, Terminate
- CALL PUTCHR ; Display character
- INX D ; Next string position
- JMP PUTS ; Continue
- ;.....
- ;
- ; Fetch character from console (without echo)
- ;
- GETCH: LHLD 0000H+1 ; Warm Boot Address
- MVI L,9 ; Direct Console
- CALL GOHL ; Get Character
- ANI 7FH ; Strip off any parity
- RET
- ;.....
- ;
- ; Check for a CTL-C or CTL-S entered from the keyboard. Jump to EXIT if
- ; CTL-C, pause on CTL-S.
- ;
- CKABRT: PUSH H
- PUSH D
- PUSH B
- MVI C,CONST
- CALL BDOS
- ORA A
- JZ CKAB3 ; No character, exit
- MVI C,RDCON
- CALL BDOS
- ANI 5FH
- CPI 'S'-40H
- JZ CKAB0
- CPI 'S'
- JNZ CKAB1
- CALL CKAB4
-
- CKAB0: MVI C,RDCON
- CALL BDOS
- ANI 5FH
-
- CKAB1: CPI 'C'-40H ; CTL-C?
- JZ CKAB2 ; Yes, quit
- CPI 'K'-40H
- JZ CKAB2
- CPI 'X'-40H
- JZ CKAB2
- CPI ' ' ; Any other CTL-character, abort
- JC CKAB3
- CALL CKAB4 ; Clear the character from screen
- CPI 'C'
- JZ CKAB2
- CPI 'K'
- JZ CKAB2
- CPI 'X'
- JNZ CKAB3
-
- CKAB2: LXI D,CKMS1
- CALL PUTS
- POP B
- POP D
- POP H
- JMP EX0 ; All done
-
- CKAB3: POP B
- POP D
- POP H
- RET
-
- CKAB4: PUSH PSW
- LXI D,CKMS2
- CALL PUTS
- POP PSW
- RET
- ;.....
- ;
- ; Call here to call address in HL
- ;
- GOHL: PCHL
- ;
- ; Enter BDOS, save all extended registers
- ;
- CPM: PUSH B ; Save Registers
- PUSH D
- PUSH H
-
- IF ZRDOS
- LDA ZRDFLG ; ZRDOS running?
- ORA A
- JNZ ZRD ; ZRDOS error trap and DOSs call
- ENDIF ; ZRDOS
-
- CALL BDOS
- MOV B,A ; Save return code
- LDA VERFLG ; Is this 3.0?
- CPI 30H
- MOV A,B
- JC CPM20 ; No, exit normally
- CPI 0FFH ; Yes, was return code FF?
- JNZ CPM20 ; No, exit normally
- MOV A,H ; Yes, check for error code
- ORA A
- JNZ DSKERR ; Exit if physical error
- MOV A,B ; Else, continue normally
-
- CPM20: POP H
- POP D
- POP B
- RET
- ;.....
- ;
- ; ZRDOS Error Trap and System Call exits to CPM20
- ;
- IF ZRDOS
- ZRD: CALL SETTRAP ; Set the warm boot trap
- CALL BDOS ; Do what we're told
- CALL RESTRAP ; Reset the trap
- JMP CPM20 ; Error free exit
- ;.....
- ;
- ; Set Warm Boot Trap in ZRDOS
- ;
- SETTRAP:PUSH H
- PUSH D
- PUSH B
- MVI C,SETWBT ; Set warm boot trap to come here
- LXI D,WBTRAP
- CALL BDOS
- POP B
- POP D
- POP H
- RET
- ;.....
- ;
- ; WBTRAP is where the ZRDOS returns control on warm boot (error)
- ;
- WBTRAP: LXI H,DSKERR ; Return here after trap reset
- PUSH H ; Save DSKERR on stack
- ;
- ; Reset Warm Boot Trap in ZRDOS
- ;
- RESTRAP:PUSH H
- PUSH D
- PUSH B
- PUSH PSW
- MVI C,RESWBT ; Reset warm boot trap
- CALL BDOS
- POP PSW
- POP B
- POP D
- POP H
- RET
- ENDIF ; ZRDOS
- ;.....
- ;
- ; For file output mode, return to old user area and set DMA for the file
- ; output buffer.
- ;
- SETFOP: CALL CKVER ; Clear carry if CP/M 2 or later
- LDA OLDUSR ; Get user number at startup
- MOV E,A
- MVI C,STUSER
- CNC CPM ; Reset old user number if CP/M 2
- LXI D,OUTBUF ; Move DMA from search buffer into
- JMP SET2 ; Output buffer
- RET
- ;.....
- ;
- ; Move disk buffer DMA to default buffer for directory search operations
- ; and BDOS media change routines (required for pre-CP/M 2 systems while
- ; in file output mode with active buffer).
- ;
- SETSRC: LXI D,TBUF ; Default DMA Address
-
- SET2: MVI C,STDMA ; Set DMA Address
- JMP CPM
- ;.....
- ;
- ; Print amount of free space remaining on selected drive
- ;
- PRTFRE: LXI D,TOTMS7 ; Print " Free: '
- CALL PUTS
- LHLD FREEBY
- CALL DECPRT ; Print k free
- LXI D,TOTMS8 ; Print "k "
- CALL PUTS
- LDA VFLAG ; Alphabetizing vertically?
- ORA A
- RZ ; If yes, finished
- JMP CRLF ; Else turn up an extra line
- ;.....
- ;
- ; Show string on the console
- ;
- SHOW: LDAX D ; Get character from DE string
- ANI 7FH ; Strip off parity
- ORA A ; Is it a 0?
- RZ ; Yes, terminate
- PUSH B ; Save registers
- PUSH D
- PUSH H
- CALL CONOUT ; Show character on console
- POP H ; Load registers
- POP D
- POP B
- INX D ; Next string position
- JMP SHOW ; Continue
- ;.....
- ;
- ; Compare routine for last extent of file search
- ;
- COMPR: PUSH H ; Save table address
- MOV E,M ; Load low order
- INX H
- MOV D,M ; Load high order
- INX H
- MOV C,M
- INX H
- MOV B,M
- ;
- ; BC, DE now point to entries to be compared
- ;
- XCHG
- MOV E,A ; Get count
-
- CMPLP: LDAX B
- XRA M ; Copy bit 7 of M
- ANI 7FH ; Into bit 7 of A
- XRA M
- CMP M ; Then compare
- INX H
- INX B
- JNZ NOTEQL ; Quit on mismatch
- DCR E ; Or end of count
- JNZ CMPLP
- ;
- NOTEQL: POP H
- RET ; Condition code tells all
- ;.....
- ;
- ; Swap entries in the order table
- ;
- SWAP: LXI B,ORDER-2 ; Table base
- 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
- ;.....
- ;
- ; New compare routine for sorting
- ;
- COMPARE:LXI B,ORDER-2
- DAD H
- DAD B
- XCHG
- DAD H
- DAD B
- XCHG
- MOV C,M
- INX H
- MOV B,M
- XCHG
- MOV E,C
- MOV D,B
- MOV C,M
- INX H
- MOV H,M
- MOV L,C
- MVI B,13 ; Count for normal sort
- LDA TOPFLG ; Check for sort by type
- ORA A
- JNZ CMPLPE ; Jump if normal sort
- PUSH H ; Save name pointers for later
- PUSH D
- LXI B,8 ; Point to file types
- DAD B
- XCHG
- DAD B
- XCHG
- MVI B,3 ; Count for type compare
- CALL CMPLPE
- POP D ; Retrieve name pointers
- POP H ;
- RNZ
- MVI B,8 ; Count for name compare
- CALL CMPLPE
- RNZ
- INX D ; Point to extent
- INX D
- INX D
- INX H
- INX H
- INX H
- MVI B,2 ; Count for extent compare
-
- CMPLPE: LDAX D ;
- XRA M ; Copy bit 7 of M
- ANI 7FH ; Into bit 7 of A
- XRA M ;
- CMP M ; Then compare
- INX D
- INX H
- RNZ
- DCR B
- JNZ CMPLPE
- RET
- ;.....
- ;
- ; Error exit
- ;
- ERXIT: MVI A,0FFH ; Error Flag
- STA FOPFLG ; Disable file output on error
- CALL CRLF ; Space down
- POP D ; Load message string pointer
- CALL PUTS ; Print message
- LXI D,ERRMS1 ; " Error"
- CALL PUTS ; Print message
- CALL CRLF ; Space down
- ;
- ; Exit - all done, restore stack
- ;
- EXIT: LDA DOPFLG ; Multi-disk selected?
- ORA A
- JNZ EX0 ; No, skip next
- CALL CKABRT ; Check for user abort
- MVI A,HIDRV-LODRV ; Maximum drive code to search
- LXI H,FCB ; Increment directory FCB drive code
- INR M
- CMP M ; Does next disk exceed maximum?
- JC EX0
-
- IF MAXDRV
- LDA MXDRV ; Look at another value limit
- INR A
- CMP M ; Is it lower?
- JC EX0 ; Bail out if too low
- JMP NOOPT ; Search next disk
- ENDIF ; MAXDRV
-
- JNC NOOPT ; Search next disk if MAXDR not true
-
- EX0: LDA VFLAG ; Check display form
- ORA A
- CZ CRLF ; Turn up a blank line at end if vertical
- MVI C,CONST ; Check console status
- CALL CPM
- ORA A ; Character waiting?
- MVI C,RDCON
- CNZ CPM ; Gobble up character
-
- IF ZRDOS
- LDA ZRDFLG ; ZRDOS running?
- ORA A
- JNZ EXIT2 ; Yes
- ENDIF ; ZRDOS
-
- LDA VERFLG ; Version flag
- CPI 30H ; CP/M 3.0?
- JC EXIT1 ; No
- MVI C,2DH ; Yes,
- MVI E,0 ; Reset error mode to default
- CALL CPM
- JMP EXIT2 ; Quit
-
- EXIT1: LDA DOPFLG ; If they were swapped
- ORA A
- CZ SWAPEM
-
- EXIT2 EQU $
-
- IF SHOPUB
- CALL RSTPUB
- ENDIF ; SHOPUB
-
- IF WMBOOT
- JMP 0000H
- ENDIF ; WMBOOT
-
- LDA OLDDSK ; Restore original drive
- MOV E,A
- MVI C,14
- CALL CPM
- LDA OLDUSR ; Restore original user area
- MOV E,A
- MVI C,32
- CALL CPM
-
- EXIT3: LHLD STACK ; Get old stack pointer
- SPHL ; Move back to old stack
- RET ; And return to CCP
- ;.....
- ;
- ; Restore Public areas if they were changed
- ;
- IF SHOPUB
- RSTPUB: LHLD 0109H
- MVI D,0
- MVI E,07EH
- DAD D
- LDA PUBDRV
- MOV M,A
- INX H
- LDA PUBUSR
- MOV M,A
- RET
- ENDIF ; SHOPUB
- ;.....
- ;
- IF NDIRS
- NAMDIR: MVI A,0
- STA CURDIR ; Initial check count
-
- NAMDR1: LHLD NAMADR ; Named directory buffer address
-
- NAMDR2: LDA FCB ; Get current Drive
- CMP M ; Does NDR entry match current drive?
- JNZ NXTDIR ; No, check next
- LDA NEWUSR ; Get current user
- INX H
- CMP M ; Does NDR entry match current user?
- JNZ NXTDIR ; No, check next
- MVI A,'[' ; Frame the name in brackets
- CALL PUTCHR
- MVI C,8 ; Number of Characters in entry
-
- DIRCHR: INX H ; Match, Point to Directory Name
- MOV A,M ; Get Character
- CPI 20H ; End of entry?
- JNZ DIRCH1 ; No
-
- DIRCH0: PUSH PSW
- MVI A,']' ; Print closing bracket
- CALL PUTCHR
- POP PSW
- JMP DIRCH2
-
- DIRCH1: CALL PUTCHR
- DCR C
- JNZ DIRCHR ; Output Eight characters
- JMP DIRCH0
- RET ; Done
- DIRCH2: MOV A,C
- ORA A
- RZ
- MVI A,20H ; Fill with spaces for neatness sake
- CALL PUTCHR
- DCR C
- JNZ DIRCH2
- RET
-
- NXTDIR: LDA CURDIR
- ADI 1 ; Increment Directory pointer
- STA CURDIR
- LXI H,NUMDIR
- CMP M ; Exceeded Max Entry?
- JZ NODIR ; Yes, there is no entry for this DU
- LHLD NAMADR ; Get base NDR address
- MVI D,0
- MVI E,18 ; Increment to next entry
-
- NXTD: DAD D
- DCR A ; Decrement count
- JNZ NXTD ; Until current Offset reached
- JMP NAMDR2 ; And check the entry for a match
- NODIR: MVI C,10 ; No match, output ten spaces
-
- NODIR1: MVI A,20H
- CALL PUTCHR
- DCR C
- JNZ NODIR1
- RET
- ENDIF ; NDIRS
- ;.....
- ;
- ; Trap BDOS select and sector error vectors to our own intercept routine
- ; so we can catch a reference to an illegal drive.
- ;
- SWAPEM: DS 0
-
- IF ZRDOS
- LDA ZRDFLG ; See if ZRDOS running
- ORA A
- RNZ ; Yes, quit this
- ENDIF ; ZRDOS
-
- LDA VERFLG ; Version flag
- CPI 30H ; Error mode call available?
- JC SWAP20 ; No, use BDOS error vectors
- MVI C,2DH ; Yes, use error mode call
- MVI E,0FFH ;
- CALL CPM ; Set "return code only" mode
- RET
-
- SWAP20: LHLD BDOS+1 ; Load pointer to base of BDOS
- INX H ; Swap new pointer if running a
- MOV E,M ; Program below the CCP
- INX H
- MOV D,M
- XCHG ; HL points to the proper vector
- MVI L,9 ; Point to record error vector
- LXI D,VECTBL ; Exchange with our vector table
- MVI A,4 ; 4 bytes to swap
-
- SWAPLP: MOV B,M ; Load byte from HL
- XCHG
- MOV C,M ; Load byte from DE
- MOV M,B ; Save byte from HL
- XCHG
- MOV M,C ; Save byte from DE
- INX H ; Increment exchange pointers
- INX D
- DCR A ; Counter-1
- JNZ SWAPLP ; Continue swapping
- RET
- ;.....
- ;
- ; Check CP/M version number. Return carry flag set if pre-CP/M 2. If
- ; CP/M 2 or later or MP/M (any version), return carry clear.
- ;
- CKVER: LDA VERFLG ; Version Flag
- CPI 20H ; CP/M 2.0?
- RET
- ;.....
- ;
- ; Return point from intercepted BDOS select and bad record errors.
- ;
- DSKERR: LXI SP,STACK ; Get out of BDOS' stack
- JMP EXIT ; And exit back to CCP
- ;.....
- ;
- ;-----------------------------------------------------------------------
- ; Start of FNAME routine
- ;
- ; Main module
- ; on entry, DE points to FCB to be filled, HL points to first
- ; byte of target string, RFCB is 36 bytes long
- ; on exit, B=disk number (1 for A, etc.) and C=user number
- ; HL points to terminating character
- ; A=0 and Z set if error in disk or user numbers
- ; A=0FFH and NZ if ok
- ;
- MAXDISK EQU 16 ; Maximum number of disks
- MAXUSER EQU 31 ; Maximum user number
-
- FNAME: PUSH D ; Save DE
- MVI A,0FFH ; Set default disk and user
- STA DISKNO
- STA USERNO
- MVI B,36 ; Initialize FCB
- PUSH D ; Save pointer
- XRA A ; A=0
-
- FNINI: STAX D ; Store zero
- INX D ; Point to next
- DCR B ; Count down
- JNZ FNINI
- POP D ; Get pointer back
- PUSH H ; Save pointer
- ;
- ; Scan for colon, comma, or space in string
- ;
- COLON: MOV A,M ; Scan for colon or space
- INX H ; Point to next
- CPI ':' ; Colon found?
- JZ COLON1
- CPI ',' ; Comma found?
- JZ GETF1
- CPI ' '+1 ; Delimiter?
- JC GETF1
- JMP COLON ; Continue if not EOL
- ;
- COLON1: POP H ; Clear stack
- MOV A,M ; Save possible drive specification
- CALL CAPS ; Capitalize
- CPI 'A' ; Digit if less than "A"
- JC USERCK ; Process user number
- SUI 'A' ; Change from ASCII to binary
- CPI MAXDISK ; Within bounds?
- JC SVDISK
- ;
- ERREXIT:XRA A ; Error indicator
- POP D ; Restore DE
- RET
- ;.....
- ;
- ; Log in specified disk
- ;
- SVDISK: INR A ; Adjust to 1 for "A"
- STA DISKNO ; Save flag
- INX H ; Point to next character
- ;
- ; Check for user
- ;
- USERCK: MOV A,M ; Get possible user #
- CPI ':' ; No user number
- JZ GETFILE
- CPI '?' ; All user numbers?
- JNZ USERC1
- STA USERNO ; Set value
- INX H ; Point to after
- MOV A,M ; Must be colon
- CPI ':'
- JZ GETFILE
- JMP ERREXIT ; Fatal error if not colon after ?
-
- USERC1: XRA A ; Zero user number
- MOV B,A ; B = A for user number
-
- USRLOOP:MOV A,M ; Get digit
- INX H ; Point to next
- CPI ':' ; Done?
- JZ USRDN
- SUI '0' ; Convert to binary
- JC ERREXIT ; User number error?
- CPI 10
- JNC ERREXIT
- MOV C,A ; Next digit in C
- MOV A,B ; Old number in A
- ADD A ; *2
- ADD A ; *4
- ADD B ; *5
- ADD A ; *10
- ADD C ; *10+new digit
- MOV B,A ; Result in B
- JMP USRLOOP
-
- USRDN: MOV A,B ; Get newer user number
- CPI MAXUSER+1 ; Within range?
- JNC ERREXIT
- STA USERNO ; Save in flag
- JMP GETFILE
- ;
- ; Extract file name
- ;
- GETF1: POP H ; Get pointer to byte
- ;
- GETFILE:MOV A,M ; Pointing to colon?
- CPI ':'
- JNZ GFILE1
- INX H ; Skip over colon
-
- GFILE1: MOV A,M ; Get next character
- CPI ',' ; Delimiter?
- JZ GFQUES
- CPI ' '+1 ; Not a delimiter?
- JNC GFILE2
-
- GFQUES: INX D ; Fill with ???
- MVI B,11 ; 11 bytes
- MVI A,'?'
-
- GFFILL: STAX D ; Put?
- INX D ; Point to next
- DCR B ; Count down
- JNZ GFFILL
-
- FNDONE: LDA DISKNO ; Get disk number
- MOV B,A ; In 'B'
- LDA USERNO ; Get user number
- MOV C,A ; In 'C'
- POP D ; Restore registers
- MVI A,0FFH ; No error
- ORA A ; Set flags
- RET
- ;
- ; Get file name fields
- ;
- GFILE2: MVI B,8 ; At most, 8 byte filename
- CALL SCANF ; Scan and fill
- MVI B,3 ; At most, 3 byte filetype
- MOV A,M ; Get delimiter
- CPI '.' ; Filename ending in "."?
- JNZ GFILE3
- INX H ; Point to character after "."
- CALL SCANF ; Scan and fill
- JMP FNDONE ; Done, return to "args"
-
- GFILE3: CALL SCANF4 ; Fill with spaces
- JMP FNDONE
- ;
- ; Scanner routine
- ;
- SCANF: CALL DELCK ; Check for delimiter
- JZ SCANF4 ; Fill with spaces if found
- INX D ; Next byte in filename
- CPI '*' ; Question mark fill ?
- JNZ SCANF1
- MVI A,'?' ; Place "?"
- STAX D
- JMP SCANF2
-
- SCANF1: STAX D ; Place character
- INX H ; Next position
-
- SCANF2: DCR B ; Count down
- JNZ SCANF ; Continue loop
-
- SCANF3: CALL DELCK ; Skip to delimiter
- RZ
- INX H ; Point to next
- JMP SCANF3
-
- SCANF4: INX D ; Next filename or filetype
- MVI A,' ' ; Fill with spaces
- STAX D
- DCR B ; Count down
- JNZ SCANF4
- RET
- ;.....
- ;
- ; Check character pointed to by HL for a delimiter,
- ; return with Zero flag set if the character is a delimiter
- ;
- DELCK: MOV A,M ; Get the character
- CALL CAPS ; Capitalize
- ORA A ; 0=delimiter
- RZ
- CPI ' '+1 ; Space character+1
- JC DELCK1 ; Space character or less
- CPI '='
- RZ
- CPI 5FH ; Underscore
- RZ
- CPI '.'
- RZ
- CPI ':'
- RZ
- CPI ';'
- RZ
- CPI ','
- RZ
- CPI '<'
- RZ
- CPI '>'
- RET
- ;
- DELCK1: CMP M ; Compare with self for OK
- RET
- ;.....
- ;
- CAPS: CPI 'a'
- RC
- CPI 'z'+1
- RNC
- SUI 20H
- RET
- ;.....
- ; End of FNAME routine
- ;-----------------------------------------------------------------------
- ;
- ; Subroutines to read library file directory
- ;
- PRTLMEM:LXI H,ORDER ; Initialize order table pointer
- SHLD NEXTL
- XRA A
- STA LNCNT
-
- ENTRYL: LHLD LCOUNT ; Get FCB count
- DCX H ; Decrement it
- SHLD LCOUNT
- MOV A,H ; Is this the last file?
- ORA L
- JZ LBRTST ; Yes, skip compare
- PUSH B
- CALL CKABRT ; Keyboard abort?
- LHLD NEXTL
- MVI A,11
- CALL COMPR ; This entry match next one?
- POP B
- JNZ LBRTST ; No, print it
- INX H
- INX H ; Skip, highest extent last in list
- SHLD NEXTL
- JMP ENTRYL ; Loop back for next lowest extent
- ;.....
- ;
- ; Exit Library member printing
- ;
- LBEXIT: LHLD LMTOTL
- MOV A,H
- ORA L
- RZ
- PUSH H ; Save member count
- XRA A ; Get a zero to
- STA SUPSPC ; Suppress leading spaces in totals
- LDA LNCNT
- MVI L,4 ; If last line is full, don't turn
- CMP L ; Up extra line
- CNZ CRLF ; If partial line, extra line needed
- LXI D,CONTM1 ; Print "There are "
- CALL PUTS
- POP H ; Get total member count back
- CALL DECPRT
- LXI D,MFILES ; Print "Members in "
- CALL PUTS
- LHLD LBTOTL
- CALL DECPRT
- LXI D,LIBR
- JMP PUTS
- ;
- ; Valid entry obtained - spit it out
- ;
- LBRTST: MVI A,1 ; Turn off .ARC/ARK
- STA ISARC
- LHLD NEXTL ; Load order table pointer
- MOV E,M ; Low order address
- INX H
- MOV D,M ; High order address
- INX H
- SHLD NEXTL ; Save updated table pointer
- LXI H,8
- DAD D
- CALL CKLBR
- JZ LBRSET
- CALL CKARC
- JNZ LBRNEX
- XRA A
- STA ISARC
-
- LBRSET: PUSH D
- LDA LNCNT
- MVI L,4
- CMP L
- CNZ CRLF
- PUSH PSW ; Just in case
- LXI D,LFMSP1 ; Long Library directory message
- LDA ISARC
- ORA A
- JNZ SARCM1
- LXI D,AFMSP1
-
- SARCM1: CALL PUTS ; Print it
- POP PSW ; Put it back
- LDA FCB ; Load current drive
- ADI 'A'-1 ; Convert to ASCII
- CALL PUTCHR ; Print it
- CALL PUTUSR ; Print user # after it
- MVI A,':' ; And colon
- CALL PUTCHR
- POP H
- PUSH H
- MVI B,8 ; Filename length
- CALL PUTSB
- MVI A,'.' ; Period after filename
- CALL PUTCHR
- MVI B,3 ; 3 characters of filetype
- CALL PUTSB
- CALL SIZEFL ; Compute size of library in k
- XCHG
- CALL DECPRT
- LXI D,LFMSP3
- CALL PUTS
- POP H
- ;
- ; Saves the library file name into LBRFCB
- ;
- LDA FCB
- LXI D,LBRFCB ; To
- STAX D
- INX D
- MVI B,11 ; Length
- CALL MOVE ; Do the move
- XCHG
- MVI B,25
-
- CLMFCB: MVI M,0
- INX H
- DCR B
- JNZ CLMFCB
- CALL SETLDMA
- LXI D,LBRFCB ; Point to file
- MVI C,OPEN ; Get function
- CALL CPM ; Open it
- MVI C,READ
- LXI D,LBRFCB
- CALL CPM
- CALL SETFOP
- LXI H,LBBUF
- MOV A,M
- ORA A
- JZ CKLDIR ; Check directory present?
-
- LDA ISARC
- ORA A
- JNZ BADLBR
- MOV A,M
- CPI ARCMAR
- JZ CKADIR
-
- BADLBR: LXI H,NLBRF
- LDA ISARC
- ORA A
- JNZ NBARC
- LXI H,NARCF
-
- NBARC: MVI B,25
- CALL PUTSB
- ;
- LMLEXI: CALL LBCLOS
- ;
- ; Do next library file
- ;
- LBRNEX: LHLD LCOUNT ; Check count
- MOV A,H
- ORA L
- JZ LBEXIT ; No more, all done
- JMP ENTRYL ; Else, get next .LBR file
- ;.....
- ;
- ; Close the library file
- ;
- LBCLOS: LXI D,LBRFCB
- MVI C,CLOSE
- CALL CPM
- RET
- ;.....
- ;
- ; Set the Library file DMA address
- ;
- SETLDMA:CALL CKVER ; Set carry if pre-CP/M 2
- LDA NEWUSR ; Get user area for directory
- MOV E,A
- MVI C,STUSER ; Get the user function
- CNC CPM ; And set new user number if CP/M 2
- LXI D,LBBUF
- MVI C,STDMA
- CALL CPM
- RET
- ;.....
- ;
- ; Check to see if there indeed is a LBR file directory
- ;
- CKLDIR: MVI B,11 ; Length of file name
- MVI A,' ' ; Space
- INX H
-
- CKDLP: CMP M
- JNZ BADLBR
- DCR B
- INX H
- JNZ CKDLP
- ;
- ; The first entry in the LBR directory is indeed blank. Now see if the
- ; directory size is > 0
- ;
- MOV E,M ; File starting location low
- INX H ; Must be zero here
- MOV A,M ; File starting location high
- ORA E ; Must be zero here also
- JNZ BADLBR
- INX H
- MOV E,M ; Get library size low
- INX H ; Point to library size high
- MOV D,M ; Get library size high
- MOV A,D
- ORA E ; Library must have some size
- JZ BADLBR
- DCX D
- XCHG
- SHLD SLFILE
- LHLD LBTOTL
- INX H
- SHLD LBTOTL
- MVI A,4
- STA LNCNT ; Reset names per line counter
- MVI B,3
- LXI H,17
- DAD D
- JMP LMTEST
-
- LFMLOP: LHLD SLFILE ; Get next buffer if more
- MOV A,L
- ORA H
- JZ LMLEXI
- DCX H
- SHLD SLFILE
- CALL SETLDMA
- MVI C,READ
- LXI D,LBRFCB
- CALL CPM
- CALL SETFOP
- MVI B,4 ; Get file count per record
- LXI H,LBBUF ; Get buffer starting address
-
- LMTEST: MOV A,M ; Get member open flag
- ORA A ; Test for open
- JZ PRMNAM
-
- LMTESA: LDA ISARC
- ORA A
- RZ
- LXI D,32 ; Member not open get offset
- DAD D ; To next and add it in
- DCR B ; Is buffer empty ?
- JNZ LMTEST ; No so test next entry
- JMP LFMLOP ; Yes, get next buffer
- ;
- PRMNAM: PUSH H ; Print member name and size
- PUSH B
- CALL CKABRT ; Keyboard abort?
- LXI H,LNCNT
- MVI A,4
- CMP M
- JNZ PRMNA1
-
- IF PRBRDR
- MVI A,'*' ; Load "A" with border character
- CALL PUTCHR ; Print it
- MVI A,' ' ;
- CALL PUTCHR ; Space between border and text
- ENDIF ; PRBRDR
-
- JMP PRMNA2
-
- PRMNA1: CALL SPACE
- MVI A,':'
- CALL PUTCHR
- CALL SPACE
-
- PRMNA2: POP B
- POP H
- PUSH H
- PUSH B
- INX H
- MVI B,8 ; Filename length
- CALL PUTSB
- MVI A,'.' ; Period after filename
- CALL PUTCHR
- MVI B,3 ; 3 characters of filetype
- CALL PUTSB
- INX H
- INX H
- MOV E,M
- INX H
- MOV D,M
- XCHG
- ;
- ; Output the size of the individual file
- ;
- PUSH D
- PUSH H
- XCHG
- LHLD LLENLOC
- XCHG
- DAD D
- SHLD LLENLOC
- POP H
- ;
- ; New code added to convert lib members from records to 'k'. Upon entry
- ; member's size in records is in HL.
- ;
- LDA COPFLG ; File sizes wanted in records?
- ORA A
- JZ PRMNA3 ; Jump if so
- LXI D,7 ; Round up to nearest 1k
- DAD D
- XCHG
- LXI H,0
- MOV A,E ; Low byte of record count in A
- RRC
- RRC
- RRC
- ANI 1FH
- MOV E,A ; And put it back
- MOV L,D ; Get the high byte if any
- MVI D,0 ; Clean out the old resting place
- DAD H ; Multiply it by 32 to convert to
- DAD H ; Number of k bytes
- DAD H
- DAD H
- DAD H
- DAD D ; And add in the low byte
-
- PRMNA3: POP D
- CALL DECPRT ; Go print it
- LDA FSIZEC ; Follow with 'k' or 'r'
- CALL PUTCHR
- ;
- ; Update library member total and name counter
- ;
- LHLD LMTOTL
- INX H
- SHLD LMTOTL
- LDA LNCNT
- DCR A
- STA LNCNT
- POP B
- POP H
- JNZ LMTESA ; And go output another file
- ;
- ; Current line full, start a new one
- ;
- MVI A,4
- STA LNCNT ; Reset names per line counter
- CALL CRLF ; Space down to next line
- JMP LMTESA
- ;.....
- ;
- ; Move characters from "HL" to "DE" length in "B"
- ;
- MOVE: MOV A,M ; Get a character
- STAX D ; Store it
- INX H ; To next "from"
- INX D ; To next "to"
- DCR B ; More?
- JNZ MOVE ; Yes, loop
- RET ; No, return
- ;.....
- ;
- ; Archive file subroutines
- ;
- CKADIR: XRA A
- DCR A
- STA GETABL ; Say buffer is full (first read by lbr test)
- LHLD LBTOTL ; Bump library count total
- INX H
- SHLD LBTOTL
- MVI A,4 ; LDA MNPL
- STA LNCNT ; Reset names per line counter
-
- ARCLP: CALL GET ; Get the next character from buffer
- CPI ARCMAR ; Is it archive header marker?
- JNZ BADLBR ; And abort if not
- CALL GET ; Get header version
- ORA A ; If zero, that's logical end of file,
- JZ LMLEXI ; And we're done
- LXI D,ANAME ; Set to fill header buffer
- MVI B,HDRSIZ ; Setup normal header size less file name
- CPI 1 ; But test if version 1
- JNZ GETHD1 ; Skip if not version 1
- LXI B,HDRSIZ-4 ; Else, header is 4 bytes less
-
- GETHD1: CALL GET ; Get header byte
- STAX D ; Store in buffer
- INX D
- DCR B
- JNZ GETHD1 ; Loop for all bytes
- LXI H,ARCFIL ; Prefill dummy arc FCB name with spaces
- MVI B,11
-
- FIXAN: MVI M,' '
- INX H
- DCR B
- JNZ FIXAN
- MVI B,5 ; Prefill rest of dummy FCB with zero
-
- FIXAE: MVI M,0
- INX H
- DCR B
- JNZ FIXAE
- LXI H,ANAME ; Get pointer to archive header buffer
- LXI D,ARCFIL ; Point to our dummy FCB
- MVI B,8 ; Get name length
-
- MANAME: MOV A,M ; Get character from header
- INX H
- ORA A
- JZ AEDONE ; Nothing in buffer so we're done
- CPI 02EH ; Is the char a point
- JZ DAEXT ; DO FILE EXTENT
- STAX D
- INX D
- DCR B
- JNZ MANAME
-
- DAEXT: LXI D,ARCFIL+8 ; Get dummy file extent address
- MVI B,3
- MOV A,M
- CPI 2EH
- JNZ AELOP
- INX H
-
- AELOP: MOV A,M ; Fill in the file extent
- ORA A
- JZ AEDONE
- STAX D
- INX H
- INX D
- DCR B
- JNZ AELOP
-
- AEDONE: LXI H,ASIZE
- MOV E,M ; Fetch BCDE from (HL)
- INX H
- MOV D,M
- INX H
- MOV C,M
- XRA A ; Clear flags
- MOV A,E ; Convert file length count in bytes
- RAL ; To length in records for output
- MOV A,D
- RAL
- MOV E,A
- MOV A,C
- RAL
- MOV D,A
- XCHG
- SHLD ARCFIL+13 ; Save file length
- LXI H,ARCFIL-1 ; Point to dummy FCB
- CALL PRMNAM ; List the file info
- LXI H,ASIZE ; Get remaining file size
- MOV A,M
- ANI 7FH
- LHLD ARCFIL+13 ; Save file length
- XCHG ; Save record offset
- LXI H,GETABL ; Point to offset of last byte read
- ADD M ; Add byte offsets
- CPI 80H ; Does it overflow current record?
- JC NRAD
- SUI 80H ; Adjust pointer
- INX D ; Bump record number
-
- NRAD: MOV M,A ; Update buffer pointer for new position
- MOV A,D ; Check record offset
- ORA E
- JZ LEXIT ; Return if none (still in same record)
- PUSH D ; Save record offset
- LXI D,LBRFCB
- MVI C,RECORD ; Compute current "random" record no.
- CALL CPM ; (I.e. next sequential record to read)
- LHLD LBRFCB+FRN ; Get result
- DCX H ; Adjust next record to current record
- POP D ; Restore record offset
- DAD D ; Compute new record no.
- JC BADLBR ; If >64k, it's past largest (8 Mb) file
- SHLD LBRFCB+FRN ; Save new record no.
- MVI C,READRN ; Read the random record
- CALL GETREC
- ORA A
- JNZ BADLBR ; File read error
- LXI H,LBRFCB+FCR ; Point to current record in extent
- INR M ; Bump for subsequent sequential read
-
- LEXIT: JMP ARCLP ; Loop for next file
- ;.....
- ;
- ; Get next sequential byte from archive file
- ;
- GET: PUSH B ; Save registers
- PUSH D
- PUSH H
- LDA GETABL ; Point to last byte read
- INR A ; At end of buffer?
- CPI 80H
- CNC GETNXT ; Yes, read next record and reset pointer
- STA GETABL ; Save new buffer pointer
- MOV L,A
- MVI H,0
- LXI D,LBBUF
- DAD D
- MOV A,M ; Fetch byte from there
- POP H ; Restore registers
- POP D
- POP B
- RET ; Return
- ;
- ; Get next sequential record from archive file
- ;
- GETNXT: MVI C,READ ; Setup read-sequential function code
- CALL GETREC
- ORA A
- JNZ RDERR
- PUSH PSW
- XRA A
- DCR A
- STA GETABL
- POP PSW
- RET
- ;
- RDERR: POP H ; Strip GETNXT return
- POP H ; Clean up the get stack
- POP D
- POP B
- POP H ; Strip get calling address
- JMP BADLBR ; Show error
- ;
- ; Get record (sequential or random) from archive file
- ;
- GETREC: PUSH H
- PUSH B
- CALL SETLDMA ; Set library DMA address
- LXI D,LBRFCB ; Setup FCB address
- POP B ; Restore read function
- CALL CPM ; Do it
- PUSH PSW ; Save read status
- CALL SETFOP ; Reset Print file DMA address
- POP PSW ; Restore read status
- POP H ; Restore buffer pointer
- RET
- ;.....
- ;
- ; Test file extent for ARC/ARK
- ;
- CKARC: PUSH H
- PUSH D
- PUSH B
- XCHG
- LXI H,ARCTYP
- MVI C,2 ; Number for the loop to test
- ;
- CKARL: LDAX D
- ANI 7FH
- CMP M
- JNZ CKARX
- INX H
- INX D
- DCR C
- JNZ CKARL
- ;
- ; The first 2 match now see if C or K for .ARC or .ARK
- ;
- LDAX D
- ANI 7FH
- CPI 'C' ; See if "C"
- JZ CKARX
- CPI 'K' ; See if "K"
-
- CKARX: POP B
- POP D
- POP H
- RET
- ;.....
- ;
- ; Test file extent for LBR
- ;
- CKLBR: PUSH H
- PUSH D
- PUSH B
- XCHG
- LXI H,LBRTYP
- MVI C,3
-
- CKLBL: LDAX D
- ANI 7FH
- CMP M
- JNZ CKLBX
- INX H
- INX D
- DCR C
- JNZ CKLBL
-
- CKLBX: POP B
- POP D
- POP H
- RET
- ;
- ; TIMEON routine
- ;
- ; Go through a search to see if BYE is active
- ;
- IF TIMEON
- TIME: LHLD 0001H ; Point to warm boot again
- DCX H ; If BYE active,
- MOV D,M ; Pick up pointer to BYE variables
- DCX H ; (COVECT) followed by "BYE"
- MOV E,M
- LXI H,15 ; Calculate address of BYE variable
- DAD D ; Where ptr to orig BIOS vector stored
- MOV E,M ; Load that address into DE
- INX H ; If BIOS active, DE now points to
- MOV D,M ; Original BIOS console output vector
- INX H ; Point to BYE signon message
- MOV A,M ; Get letter
- ANI 05FH ; Convert to upper case if needed
- CPI 'B' ; Try to match "BYE"
- RNZ ; Out if BYE not active
- INX H
- MOV A,M
- ANI 05FH ; Convert to u-case if needed
- CPI 'Y'
- RNZ
- INX H
- MOV A,M
- ANI 05FH ; Convert to u-case if needed
- CPI 'E'
- RNZ
-
- LXI D,6 ; Bye running, point to RTCBUF
- DAD D
- MOV E,M ; Get RTCBUF address
- INX H ; And copy
- MOV D,M ; In DE
- XCHG ; Put in HL
- LXI D,7 ; Offset to
- DAD D ; Time-on-system byte
- MOV A,M ; Load TOS byte
- LXI H,TONMS1 ; Where to store in ASCII
- CALL DEC8 ; Convert binary to ASCII
- LXI D,TONMSG
- CALL PUTS ; Print the message
- RET ; And return
- ;.....
- ;
- ; DEC8 will convert an 8 bit binary number in A to 3 ASCII
- ; bytes. HL points to the MSB location where the ASCII bytes
- ; will be stored. Leading zeros are suppressed, store spaces
- ; in your buffer before calling.
- ;
- DEC8: PUSH B
- PUSH D
- MVI E,0 ; Leading zero flag
- MVI D,100
-
- DEC81: MVI C,'0'-1
-
- DEC82: INR C
- SUB D ; 100 or 10
- JNC DEC82 ; Still +
- ADD D ; Now add it back
- MOV B,A ; Remainder
- MOV A,C ; Get 100/10
- CPI '1' ; Zero?
- JNC DEC83 ; Yes
- MOV A,E ; Check flag
- ORA A ; Reset?
- MOV A,C ; Restore byte
- JZ DEC84 ; Leading zeros are skipped
-
- DEC83: MOV M,A ; Store in buffer
- INX H ; Increment storage location
- MVI E,0FFH ; Set zero flag
-
- DEC84: MOV A,D
- SUI 90 ; 100 to 10
- MOV D,A
- MOV A,B ; Remainder
- JNC DEC81 ; Do it again
- ADI '0' ; Make ASCII
- MOV M,A ; And store it
- POP D
- POP B
- RET
-
- TONMSG: DB 13,10,'Minutes on System: '
- TONMS1: DB ' ',0
- ENDIF ; TIMEON
- ;
- ; end of TIMEON routine
- ;-----------------------------------------------------------------------
- ; help routine
- ;
- ; Help menu if ? is typed, using a fancy ZCMD or ZCPR system
- ;
- IF WHEEL
- HELPME: LXI D,OPTMSG ; Point at message
- CALL SHOW
- LDA WHLOC ; Check wheel
- ORA A ; If set, help out poor SYSOP
- JZ EXIT3 ; No - exit
- LXI D,SYSOP1 ; Point at message
- CALL SHOW
- JMP EXIT3 ; And exit
- ;
- ; This menu of options will appear to normal users (WHEEL not set).
- ; Modify the menus to accommodate your system requirements.
- ;
- OPTMSG: DB 13,10,13,10
- DB ' Available Options (start with a $ or / or'
- DB ' [ character):',13,10,13,10
- DB ' A - all user areas N - no page pause'
- DB ' [more]',13,10
- DB ' C - file sizes in records Q - show non-$ARCHived'
- DB ' files',13,10
- DB ' D - all drives T - order files'
- DB ' by EXT type',13,10
- DB ' H - Current area to highest V - show version'
- DB ' number',13,10
- DB ' L - list LBR/ARC/ARK members X - aux. format'
- DB ' (horiz/vert)',13,10,13,10
- DB ' Example - to list all drives and user areas,'
- DB ' no pauses:',13,10,13,10
- DB ' B0>SD $AND <ret>'
- DB 13,10,13,10,0
- ;
- ; This menu of options appears only when the WHEEL is set.
- ;
- SYSOP1: DB 13,10,' * * * Special SYSOP Options (WHEEL SET) * * *'
- DB 13,10,13,10
- DB ' F - file output (DISK.DIR) R - reset disk'
- DB ' system',13,10
- DB ' O - show $SYS files only S - include'
- DB ' $SYS files',13,10
- DB ' P - printer output',13,10,13,10
- DB 0
- ENDIF ; WHEEL
- ;
- ; Help menu if ? is typed, NOT using any fancy ZCMD or ZCPR system
- ;
- IF NOT WHEEL
- HELPME: LXI D,OPTMSG ; Point at message
- CALL SHOW
- JMP EXIT3 ; And exit
- ;
- OPTMSG: DB 13,10,13,10
- DB ' Available Options (start with a $ or / or'
- DB ' [ character):',13,10
- DB 13,10
- DB ' A - all user areas P - printer output'
- DB 13,10
- DB ' C - file sizes in records Q - show non $ARChived'
- DB ' files',13,10
- DB ' D - all drives R - reset disk system'
- DB 13,10
- DB ' F - file output (DISK.DIR) S - include $SYS'
- DB ' files',13,10
- DB ' H - Current area to highest T - order files'
- DB ' by EXT type',13,10
- DB ' L - list LBR/ARC/ARK members V - show version'
- DB ' number',13,10
- DB ' N - no page pause [more] X - aux. format'
- DB ' (horiz/vert)',13,10
- DB ' O - show $SYS files only',13,10,13,10
- DB ' Example - to list all drives and user areas,'
- DB ' no pauses:',13,10,13,10
- DB ' B0>SD $AND <ret>'
- DB 13,10,13,10,13,10,13,10,13,10,13,10,13,10
- DB 0
- ENDIF ; NOT WHEEL
- ;
- ; Messages and Error statements
- ;
- CKMS1: DB 13,10,'++ ABORTED ++',0
- CKMS2: DB 8,' ',8,0
- DRUMSG: DB 'Drive/User',0
- EOSMSG: DB '[more] ','$'
- MORERA: DB 13,' ',13,'$'
- ERRMS1: DB ' '
- ERRMS2: DB 'Error',0
- ERRTAG: DB ' ->',0
- NOFLM: DB '>> No detectable file(s) on ',0
- NOFMS1: DB 13,10,13,10,' ',0
- NOFMS2: DB ' ',0
- NOFMS3: DB ': ',0
- SOHFLG: DB 0
- TOTMS1: DB 13,10,' Drive ',0
- TOTMS4: DB '/',0
- TOTMS5: DB 'k ',0
- TOTMS6: DB ' Files: ',0
- TOTMS7: DB ' Free: ',0
- TOTMS8: DB 'k ',0
-
- IF PRBRDR
- CONTM1: DB 13,10,'** There are ',0
- MFILES: DB ' member files in ',0
- LIBR: DB ' library(s) and/or archive(s) **',0
- AFMSP1: DB 13,10,'** Archive directory for ',0
- LFMSP1: DB 13,10,'** Library directory for ',0
- LFMSP3: DB 'k'
- DB ' **'
- DB 13,10,0
- ENDIF ; PRBRDR
-
- IF NOT PRBRDR
- CONTM1: DB 13,10,'There are ',0
- MFILES: DB ' member files in ',0
- LIBR: DB ' library(s) and/or archive(s)',0
- AFMSP1: DB 13,10,'Archive directory for ',0
- LFMSP1: DB 13,10,'Library directory for ',0
- LFMSP3: DB 'k'
- DB 13,10,0
- ENDIF ; Not PRBRDR
-
- NLBRF: DB '++ Not a library file ++',13,10
- NARCF: DB '++ Not an archive file ++',13,10
- LBRTYP: DB 'LBR'
- ARCTYP: DB 'AR' ; We only test the first 2 in the loop.
- ; The C or K are tested separately.
- ;
- ; Permanently initialized data area
- ;
- VECTBL: DW DSKERR ; BDOS record error intercept vector
- DW DSKERR ; BDOS select error intercept vector
- ;
- ; End of code that must be stored on disk in the .COM file
- ;
- ; Data area reinitialized by code when SD is run or rerun
- ;
- DATA0 EQU $ ; Start of area to initialize
-
- OTBL EQU $ ; Mark start of option table
- VFLAG: DS 1
- AOPFLG: DS 1
- COPFLG: DS 1
- DOPFLG: DS 1
- FOPFLG: DS 1
- HOPFLG: DS 1
- LOPFLG: DS 1
- NOPFLG: DS 1
- OOPFLG: DS 1
- POPFLG: DS 1
- QOPFLG: DS 1
- ROPFLG: DS 1
- SOPFLG: DS 1
- TOPFLG: DS 1
- VOPFLG: DS 1
- XOPFLG: DS 1
-
- OEND EQU $ ; End of option table
- ;
- ; End of option lookup table
- ;
- BUFPNT: DS 2 ; Next location in output buffer
- BUFCNT: DS 1 ; Number of bytes left in output buffer
- OUTFCB: DS 1+8+3 ; User number, filename, and filetype
- ;
- ; Beginning of area reinitialized to zero each time SD.COM is run
- ;
- DS 21 ; Rest of DISK.DIR FCB
- DISKNO: DS 1 ; Disk number
- USERNO: DS 1 ; User number
- OPNFLG: DS 1 ; File open flag
- DRVFLG: DS 1 ; D option check for prior drive specificaton
- FNDFLG: DS 1 ; Files Matched Flag
- BYEACT: DS 1 ; BYE Active Flag
-
- LINCNT: DS 1 ; # lines printed on screen
- LLENLOC:DS 2 ; Running total of .LBR length
- LMTOTL: DS 2
- LBTOTL: DS 2
- LNCNT: DS 1
- LCOUNT: DS 2
- NEXTL: DS 2
- SLFILE: DS 2
- LINES: DS 1 ; Number of lines to be printed
- FIRSTT: DS 1 ; First time flag for version number
- ISARC: DS 1
- ;
- ; Uninitialized data area
- ;
- BASUSR: DS 1 ; Copy of original directory user #
- BLKMAX: DS 2 ; Highest block # on drive
- BLKMSK: DS 1 ; Records/block - 1
- BLKSHF: DS 1 ; Number shifts to mult by sec/blk
- COUNT: DS 2 ; Entry count
- DIRMAX: DS 2 ; Highest file # in directory
- FILERC: DS 2 ; File size in records
- FREEBY: DS 2 ; Number of k left on dir. drive
- FSIZEC: DS 1 ; File size character ('k' or 'r')
- GAP: DS 2 ; Sort routine storage
- I: DS 2 ; Sort routine storage
- J: DS 2 ; Sort routine storage
- JG: DS 2 ; Sort routine storage
- LZFLG: DS 1 ; 0 when printing leading zeros
- MAXUSR: DS 1 ; Max user # for drive
- NEWUSR: DS 1 ; User # selected by "$U" option
- NEXTT: DS 2 ; Next table entry
- OLDDSK: DS 1 ; Currently logged-in drive
- OLDUSR: DS 1 ; User number upon invocation
- SCOUNT: DS 2 ; # to sort
- SUPSPC: DS 1 ; Leading space flag
- TBLOC: DS 2 ; Start of name table
- TOTFIL: DS 2 ; Total number of files
- TOTSIZ: DS 2 ; Total size of all files
- USRNR: DS 1 ; User number
- VERFLG: DS 1 ; CP/M version number (0=pre-CP/M 2)
- ZRDFLG: DS 1 ; ZRDOS version number
-
- DATA1 EQU $ ; End of area to initialize
-
- IF NDIRS
- NAMADR: DS 2 ; Named Directory Buffer Address
- NUMDIR: DS 1 ; Number of entries
- CURDIR: DS 1 ; NDR Check counter
- ENDIF ; NDIRS
-
- IF SHOPUB
- PUBDRV: DS 1 ; Storage for Public Drive byte
- PUBUSR: DS 1 ; " " " User "
- ENDIF ; SHOPUB
-
- GETABL: DS 1
- LBRFCB: DS 36
- LBBUF: DS 128
-
- ANAME: DS 13
- ASIZE: DS 14
- ARCFIL: DS 16
-
- NEWPTR: DS 2 ; Start of second table
- XPOINT: DS 2
- JUMPER: DS 2 ; Increment for second table to
-
- OUTBUF: DS 128 ; Output file buffer
- ;
- ; BDOS equates
- ;
- BDOS EQU 0005H ; Entry Point for BDOS calls
- FCB EQU 005CH ; Default FCB Address
- TBUF EQU 0080H ; Default DMA Address
-
- RDCON EQU 1 ; Console input
- WRCON EQU 2 ; Console output
- LIST EQU 5 ; List output
- PRINT EQU 9 ; Print string
- CONST EQU 11 ; Get console status
- CPMVER EQU 12 ; Return CP/M version
- RESET EQU 13 ; Reset disk system
- SELDSK EQU 14 ; Select disk
- OPEN EQU 15 ; Open file
- CLOSE EQU 16 ; Close file
- SRCHF EQU 17 ; Search for first
- SRCHN EQU 18 ; Search for next
- READ EQU 20 ; Read sequential
- WRITE EQU 21 ; Write sequential
- MAKE EQU 22 ; Make file
- CURDSK EQU 25 ; Return current disk
- STDMA EQU 26 ; Set DMA Address
- DSKALL EQU 27 ; Get address of allocation vector
- DSKPAR EQU 31 ; Get address of disk parameters
- STUSER EQU 32 ; Set/get user number
-
- IF ZRDOS
- ZRDVER EQU 48 ; Return version (ZRDOS)
- SETWBT EQU 50 ; Set warm boot trap (ZRDOS)
- RESWBT EQU 52 ; Reset warm boot trap (ZRDOS)
- ENDIF ; ZRDOS
-
- DS 60 ; Stack area
- STACK: DS 2 ; Old stack pointer
-
- ORDER EQU $ ; Order table starts here
-
- END