CP/M

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

/ CP/M / CPM_CDROM.iso / lambda / soundpot / a / cfa03.lbr / CFA03.AZM / CFA03.ASM

Wrap

Assembly Source File | 1993-10-26 | 36.9 KB | 1,433 lines

; This program is derived from MAKE26.ASM ; See file CFA03.HIS for upgrade notes and programmer credits. ; See file CFA03.DOC for full instructions, usage notes, warnings, etc. ;============================================================================= ; P R O G R A M E Q U A T E S ;============================================================================= VERSION EQU 03 ; a preliminary release FALSE EQU 0 TRUE EQU NOT FALSE ZCPR3 EQU FALSE ;true for ZCPR3 version, false for plain CP/M ; MAKE SURE TO SET THIS CORRECTLY. WHEEL EQU FALSE ;true to test wheel byte before running WHLADR EQU 3EH ;wheel byte location TAGS EQU TRUE ; true to set filename bytes 1-4 (ldr) SPLIT EQU FALSE ; true for experimental file splitter (ldr) SEGSIZ EQU 3 ; size (in extents) for split segments ; 1=16k, 2=32k, 3=48k, etc... (ldr) BDOS EQU 0005H ;BDOS entry address DMAADDR EQU 0080H ;default CP/M file buffer FCB EQU 005CH ;default CP/M FCB TFCB EQU 006CH ;temporary FCB Z3ENV EQU 00000H ;ZCPR3 environment address filled in by Z3INS CR EQU 0DH ;(z3env not presently needed anyway) LF EQU 0AH TAB EQU 09H BELL EQU 07H ;============================================================================= ; M A I N P R O G R A M C O D E ;----------------------------------------------------------------------------- ORG 0100H CFA: IF ZCPR3 ;ZCPR3 initialization (not actually needed here, but if one ;runs the install program it will not report a bad utility) JMP START DB 'Z3ENV' DB 1 ;external environment DW Z3ENV ;environment address (value is not used here) ENDIF ;ZCPR3 START: ;set up local stack pointer LXI H,0 ;get CP/M stack pointer DAD SP SHLD OLDSTK ;save it for later return LXI SP,NEWSTK ;set up new local stack ;perform setup tasks IF WHEEL LDA WHLADR ;get wheel byte ORA A ;is it set? JZ EREXIT ;no/don't run ENDIF ;wheel CALL SIGNON ;print signon message CALL CHKHLP ;see if help requested and go there if so CALL INIT ;set up data areas CALL SETDU ;handle current and specified DU areas CALL GETOPT ;get option from command line (abort if bad) CALL CHKRO ;abort if destination drive is R/O and option ;..requests change in files ;begin main work of program CALL SRCHF ;locate first directory entry (abort if none) LOOP: CALL SETPTR ;set DMAPTR to point to disk directory FCB CALL CHKFIL ;check for applicable file CNC CALLOPT ;if applicable file, process option NEXTFIL: ;go on to next file LXI H,DIRCODE ;point to the directory code INR M ;increase it one MOV A,M ;get new value CPI 04 ;check for four FCB entries completed JNZ LOOP ;if not, go back and continue ;process this group of four files and go on to next LXI H,CHGFLAG ;point to change flag MOV A,M ;get it into A MVI M,0 ;reset it ORA A ;set flags from original value CNZ WRTDE ;if changes were made, write the buffer back ;sequence through files to get new buffer-full of FCB's SRNXT: LXI D,AMBFIL ;point to any-match FCB MVI C,12H ;BDOS search-next function CALL BDOS CPI 0FFH ;see if end of entries JZ QUIT ;quit if no more files CPI 0 ;loop until buffer is updated by BDOS JNZ SRNXT ;jump until dircode is zero STA DIRCODE ;save the 0 in dircode JMP LOOP ; and loop again ;============================================================================= ; O P T I O N P R O C E S S I N G R O U T I N E S ;----------------------------------------------------------------------------- IF TAGS ; code for setting file tags (ldr) ; Selects tag 1 to set high. TAG1: LHLD DMAPTR ;point to disk directory FCB entry LXI D,1 ;offset to tag 1 CALL SETHI ; set control bit HIGH (ldr) RET ;----------------------------------------------------------------------------- ; Selects tag 1 to set low. UNTAG1: LHLD DMAPTR ;point to disk directory FCB entry LXI D,1 ;offset to tag 1 CALL SETLO ; set control bit LOW (ldr) RET ;----------------------------------------------------------------------------- ; Selects tag 2 to set high. TAG2: LHLD DMAPTR ;point to disk directory FCB entry LXI D,2 ;offset to tag 2 CALL SETHI ; set control bit HIGH (ldr) RET ;----------------------------------------------------------------------------- ; Selects tag 2 to set low. UNTAG2: LHLD DMAPTR ;point to disk directory FCB entry LXI D,2 ;offset to tag 2 CALL SETLO ; set control bit LOW (ldr) RET ;----------------------------------------------------------------------------- ; Selects tag 3 to set high. TAG3: LHLD DMAPTR ;point to disk directory FCB entry LXI D,3 ;offset to tag 3 CALL SETHI ; set control bit HIGH (ldr) RET ;----------------------------------------------------------------------------- ; Selects tag 3 to set low. UNTAG3: LHLD DMAPTR ;point to disk directory FCB entry LXI D,3 ;offset to tag 3 CALL SETLO ; set control bit LOW (ldr) RET ;----------------------------------------------------------------------------- ; Selects tag 4 to set high. TAG4: LHLD DMAPTR ;point to disk directory FCB entry LXI D,4 ;offset to tag 4 CALL SETHI ; set control bit HIGH (ldr) RET ;----------------------------------------------------------------------------- ; Selects tag 4 to set low. UNTAG4: LHLD DMAPTR ;point to disk directory FCB entry LXI D,4 ;offset to tag 4 CALL SETLO ; set control bit LOW (ldr) RET ENDIF ; TAGS end of code for 1-4 tags (ldr) ;------------------------------------------------------------------------------ ; Selects SYS file attribute. SETSYS: LHLD DMAPTR ;point to disk directory FCB entry LXI D,10 ;offset 10 to DIR/SYS byte CALL SETHI ; set control bit HIGH (ldr) RET ;----------------------------------------------------------------------------- ; Selects DIR file attribute. SETDIR: LHLD DMAPTR ;point to disk directory FCB entry LXI D,10 ;offset 10 to SYS/DIR byte CALL SETLO ; set control bit LOW (ldr) RET ;----------------------------------------------------------------------------- ; Selects R/O file attribute. SETRO: LHLD DMAPTR ;point to disk directory FCB entry LXI D,9 ;offset 9 to R/O-R/W byte CALL SETHI ; set control bit HIGH (ldr) RET ;----------------------------------------------------------------------------- ; Selects R/W file attribute SETRW: LHLD DMAPTR ;point to disk directory FCB entry LXI D,9 ;offset 9 to R/O-R/W byte CALL SETLO ; set control bit LOW (ldr) RET ;----------------------------------------------------------------------------- ; Selects ARC file attribute. SETARC: LHLD DMAPTR ;point to disk directory FCB entry LXI D,11 ;offset 10 to ARCHIVE byte CALL SETHI ; set control bit HIGH (ldr) RET ;----------------------------------------------------------------------------- ; Selects Non-ARC file attribute. SETNRC: LHLD DMAPTR ;point to disk directory FCB entry LXI D,11 ;offset 10 to ARCHIVE byte CALL SETLO ; set control bit LOW (ldr) RET ;----------------------------------------------------------------------------- ; Erase the file by writing E5 as the user number tag. We know that the file ; is not already erased because of the work of subroutine CHKFIL earlier. ; Therefore, we must set the change flag to show the need to write the sector ; back out to disk. ERASE: LHLD DMAPTR MVI M,0E5H CALL SETCHGFL ;show need to write sector back to disk CALL REPORT ;report the new file status RET ;----------------------------------------------------------------------------- ; Unerase the file by writing the current user number into the tag byte in ; place of the E5. The comments under ERASE apply here, too. UNERA: LDA DEFUSR ;get logged in user number LHLD DMAPTR MOV M,A ;put it into disk directory user # tag CALL SETCHGFL ;show need to write sector back to disk CALL REPORT ;report the new file status RET ;----------------------------------------------------------------------------- ; This routine sets selected attribute or tag byte HIGH. If the file ; was not already set this way, the CHGFLAG is set to indicate the ; necessity of writing the modified sector out to disk. (ldr) SETHI: DAD D MOV A,M ; get selected byte ORA A ; test current state of control bit CP SETCHGFL ; if not already high, set change flag ORI 80H ; make sure it is set MOV M,A ; write modified byte back out CALL REPORT ; report the new file status RET ;----------------------------------------------------------------------------- ; This routine sets selected attribute or tag byte LOW. If the file ; was not already set this way, the CHGFLAG is set to indicate the ; necessity of writing the modified sector out to disk. (ldr) SETLO: DAD D MOV A,M ; get selected byte ORA A ; sign flag shows state of SYS bit CM SETCHGFL ; if not already low, set change flag ANI 7FH ; clear the high bit MOV M,A ; write modified byte back to buffer CALL REPORT ; report the new file status RET ;----------------------------------------------------------------------------- ; Change the user number of the file. CHUSER: LDA OPTION ;get user number LHLD DMAPTR ;point to place to put it MOV M,A ;put new user number in directory CALL SETCHGFL ;show need to write sector back out to disk CALL REPORT ;report the new file status RET ;----------------------------------------------------------------------------- IF SPLIT ; (ldr) ; EXPERIMENTAL FEATURE enabled with SPLIT EQU TRUE. Use at your own risk. ; Chops a file into little pieces. CHGFLAG is set regardless. (ldr) CHOP: LHLD DMAPTR ; point to disk directory FCB entry LXI D,9 ; offset first byte in filetype DAD D LDA EXTLTR MOV M,A ; change first letter of filetype LHLD DMAPTR ; point to disk directory FCB entry LXI D,12 ; offset to extent byte DAD D LDA MRKSEG MOV M,A ; change extent number INR A ; bump the extent counter STA MRKSEG ; and store it CPI SEGSIZ ; see if we've reached the limit JNZ CHOPX ; if not, keep it as is SUB A ; otherwise zero it out STA MRKSEG ; store extent counter (again) LDA EXTLTR ; load letter for filename INR A ; increment it STA EXTLTR ; and store it, too CHOPX: CALL SETCHGFL ; set change flag CALL REPORT ; report the new file status RET ;----------------------------------------------------------------------------- ; EXPERIMENTAL FEATURE enabled with SPLIT EQU TRUE. Use at your own risk. ; Join hacked little pieces into one file. CHGFLAG is set regardless. ; Reverse of CHOP operation. Renames files with character '-' as first ; byte of filetype. (ldr) BIND: LHLD DMAPTR ; point to disk directory FCB entry LXI D,12 ; offset to extent DAD D LDA MRKSEG ; get current extent number MOV M,A ; restore original extent INR A ; increment it STA MRKSEG ; and store for next round LHLD DMAPTR ; point to disk directory FCB entry LXI D,9 ; first byte of filetype DAD D MVI A,'-' ; arbitrary code to mark Bind MOV M,A ; write modified byte back to buffer CALL SETCHGFL ; set change flag CALL REPORT ; report the new file status RET ENDIF ; SPLIT (ldr) ;----------------------------------------------------------------------------- ; This code reports the attributes of the files acted on and, if required, ; the erased or unerased status. This code is called directly by the blank ; option and indirectly by all the other option processors after they have ; finished performing their changes on the files. REPORT: CALL PRTFN ;print the file name CALL ILPRT ;print spacer and equal sign DB ' = ',0 CALL PRTOPT ;print the option letter or number MVI C,3 ;put in three more blank spaces CALL PRTBLK CALL PRTATTR ;print file attributes LDA OPTION ;see if files erased CPI 'E' CZ PRTERA ;if so, print erased message LDA OPTION CPI 'U' ;see if files unerased CZ PRTUNE ;if so, print unerased message RET ;============================================================================= ; P R O G R A M F L O W R O U T I N E S ;----------------------------------------------------------------------------- ; CALLOPT ; This routine uses the value of OPTION to look up the processing routine ; to which to branch. CALLOPT: LXI H,JMPTBL ;point to jump table LDA OPTION ;get user number or option letter MOV B,A ;save it in B LOOKUP: MOV A,M ;get option letter from table INX H ;point to jump address ORA A ;end of table? JZ JMPOPT2 ;if so, jump CMP B ;do we match a table entry JZ JMPOPT1 ;if so, go to code to get jump address INX H ;else jump over jump address to INX H ;..next option character JMP LOOKUP ;and try again JMPOPT1: MOV A,M ;get low part of jump address into A INX H ;point to high part of address MOV H,M ;get it into H MOV L,A ;jump address is in HL PCHL ;jump to it JMPOPT2: LXI H,CHUSER ;default to change user routine PCHL ;jump to it JMPTBL: DB ' ' DW REPORT IF TAGS ; (ldr) DB 'F' DW TAG1 DB 'G' DW UNTAG1 DB 'H' DW TAG2 DB 'I' DW UNTAG2 DB 'J' DW TAG3 DB 'K' DW UNTAG3 DB 'L' DW TAG4 DB 'M' DW UNTAG4 ENDIF ; TAGS (ldr) DB 'S' DW SETSYS DB 'D' DW SETDIR DB 'R' DW SETRO DB 'W' DW SETRW DB 'A' DW SETARC DB 'N' DW SETNRC DB 'E' DW ERASE DB 'U' DW UNERA IF SPLIT ; (ldr) DB 'C' DW CHOP DB 'B' DW BIND ENDIF ;SPLIT (ldr) DB 0 ;end of table mark ;----------------------------------------------------------------------------- ; QUIT ; Restores the original CP/M stack, and returns to CP/M. If indicated by the ; reset flag, it resets the disk system. The logged DU area when the program ; was invoked is restored. The entry point QUIT2 is used by code CHKHL ; which that doesn't change the logged in directory. QUIT: LDA DEFDRV ;get original default drive CALL LOGDRV ;log it in LDA DEFUSR ;get original default user CALL LOGUSR ;log it in ;see if we need to reset the disk system QUIT1: LDA RSTFLAG ORA A ;if reset flag is clear JZ QUIT2 ;..we can skip disk system reset ;reset the disk system MVI C,0DH CALL BDOS ;restore the original stack QUIT2: LHLD OLDSTK ;get original stack pointer SPHL ;set it up CALL CRLF ;one last blank line RET ;back to CP/M IF WHEEL EREXIT: ;if using wheel byte and wheel not set CALL ILPRT ;we pretend the program doesn't exist DB 'CFA?',0 ;by printing phony CCP error. JMP QUIT2 ENDIF ;wheel ;============================================================================= ; F I L E S E L E C T I O N S U B R O U T I N E S ;----------------------------------------------------------------------------- ; CHKFIL ; This subroutine checks to see whether or not the FCB pointed to in the ; DMA buffer is one that should be acted on. If not, the routine returns ; with the zero flag set. CHKFIL: CALL CHKUN ;check user number and erased status of file RC ;return with carry set to skip file CALL CHKFN ;next check the file name for a match RET ;return showing status of name match ;----------------------------------------------------------------------------- ; CHKUN ; This subroutine checks the user number status of a file and sets the carry ; flag if the file should be skipped over. If the option is UNERASE and the ; file is not an erased file, it should be skipped. If the option is not ; unerase and the file is an erased file, then likewise it should be skipped. ; Finally, if the file is in a user number other than the logged in user, it ; should also be skipped. CHKUN: ;test file erased status LHLD DMAPTR ;point to user number tag of file MOV A,M ;get the tag CPI 0E5H ;carry flag set if not erased PUSH PSW ;save flag ;test program option status LDA OPTION ;get the option CPI 'U' ;is it unerase? JNZ CHKUN1 ;if not, skip to CHKUN1 ;case of unerase option POP PSW ;carry flag set if not erased RET ;file not erased will be skipped ;case of option other than unerase CHKUN1: POP PSW CMC ;carry flag set if file erased RC ;erased file will be skipped ;now check for user number in source area LDA ALLUSR ;see if "all users" was requested CPI '#' ; JZ CHKUN2 ;if so, skip over compare... LDA SRCUSR ;get source user number CMP M ;compare to file tag RZ ;if OK, return (carry is clear) STC ;else set carry CHKUN2: RET ;..and return ;----------------------------------------------------------------------------- ; CHKFN ; This subroutine compares the name of the file in the FCB in the DMA buffer ; with the specification from the command line. CHKFN: ;set up pointers and character count LHLD DMAPTR ;get pointer to FCB in DMA buffer INX H ;point to first character in the name LXI D,FCB+1 ;set DE to name in FCB from command line MVI C,0BH ;load count for compare CP1: LDAX D ;get fcb command line character CPI '?' ;see if anything matches JZ MATCH ;if it is '?', consider it a match SUB M ;get difference (see next instruction) ANI 7FH ;clear attribute bit JZ MATCH ;if zero, characters match STC ;else set carry RET ;..and return MATCH: INX D ;point to next characters INX H DCR C ;decrease count of characters JNZ CP1 ;loop until zero RET ;carry is clear showing names match ;============================================================================= ; D I S K O P E R A T I O N S U B R O U T I N E S ;----------------------------------------------------------------------------- ; SRCHF ; This subroutine uses the fully ambiguous file spec at AMBFIL to locate the ; first directory entry on the disk. The directory code (0-3) is saved. If ; no directory entry is found, then the program gives a message and branches ; to QUIT for a prompt return. SRCHF: LXI D,AMBFIL ;point to match any filename.typ MVI C,11H ;bdos search first function CALL BDOS ;do it STA DIRCODE ;save directory code CPI 0FFH ;see if end of entries RNZ ;if something found, return CALL ILPRT ;else give a message DB BELL DB 'Empty disk?',0 JMP QUIT ;----------------------------------------------------------------------------- ; WRTDE ; This routine writes the directory buffer back to the disk. I also sets the ; reset flag so that the disk system will be reset on program termination. WRTDE: LXI H,RSTFLAG ;point to the flag MVI M,0FFH ;set the flag MVI C,1H ;set BIOS write to directory ; C = 0 write to allocated ; C = 1 write to directory ; C = 2 write to unallocated CALL WRITE ;do the write ORA A ;check for error RZ ;if none, return CALL ILPRT DB BELL DB 'Bad Sector Write Error',0 JMP QUIT ;----------------------------------------------------------------------------- ; WRITE ; This routine is filled in during the operation of the program and performs ; a direct BIOS sector write operation on the currently selected track and ; sector. WRITE: JMP 0000 ;vector to bios write routine ;============================================================================= ; P R I N T I N G R O U T I N E S ;----------------------------------------------------------------------------- ; PRTFN ; This subroutine displays (at the beginning of the next line of the screen) ; the name of the file pointed to in the DMA buffer. PRTFN: CALL CRLF ;print cr/lf LHLD DMAPTR ;address of file fcb INX H ;skip to file name LXI D,BLNKCNT ;point to blanks counter XCHG ;exchange pointers MVI M,0 ;preset blank count to zero MVI C,8 ;length of file name CALL PRTSTR ;print the name first MVI A,'.' ;print the period CALL CHAROUT MVI C,3 ;now print the file type CALL PRTSTR MOV C,M ;get number of blanks needed for fill CALL PRTBLK ;print the blanks RET ;----------------------------------------------------------------------------- ; PRTOPT ; This subroutine prints out the option as a letter or as a number as ; appropriate. PRTOPT: LDA OPTION ;get the option value CPI 20H ;if it's a user number, carry will be set JNC CHAROUT ;if not number, just print the character MVI B,'0'-1 ;preset for two-digit calculation later CPI 10 ;see if single digit JNC TWODIG ;if not, print two digits ADI '0' ;else convert to ASCII JMP CHAROUT ;and print it TWODIG: INR B ;count tens digit in B SUI 10 ;keep subtracting 10 until carry is set JNC TWODIG ADI 10 ;get remainder (units digit) back MOV C,A ;save it in C MOV A,B ;print tens digit CALL CHAROUT MOV A,C ;print units digit ADI '0' JMP CHAROUT ;----------------------------------------------------------------------------- ; PRTATTR ; This subroutine prints the attribute status (SYS or DIR and R/O or R/W) ; of the file currently being worked on. PRTATTR: LHLD DMAPTR ;point to file FCB LXI D,9 ;offset to R/O-R/W byte DAD D PUSH H ;save pointer for reuse below MOV A,M RAL ;move R/O bit into carry PUSH PSW ;save flags CC PRTRO ;if carry, print read-only POP PSW ;get flags back to test again CNC PRTRW ;if not carry, print read-write POP H ;get pointer back INX H ;point to SYS/DIR byte PUSH H ;save pointer for reuse below MOV A,M RAL ;move SYS/DIR bit into carry PUSH PSW ;save flags CC PRTSYS ;if carry, print SYS POP PSW ;get them back CNC PRTDIR ;if not carry, print DIR POP H INX H MOV A,M RAL ;move ARCHIVE bit into carry PUSH PSW ;save flags CC PRTARC ;if carry, print ARC POP PSW ;get them back CNC PRTNRC ;if not carry, print Non-ARC RET ;----------------------------------------------------------------------------- ; MESSAGE PRINTING ROUTINES PRTRO: CALL ILPRT ;file is read-only DB ' R/O',0 RET PRTRW: CALL ILPRT ;file is read-write DB ' R/W',0 RET PRTSYS: CALL ILPRT ;file has SYS attribute DB ' SYS',0 RET PRTDIR: CALL ILPRT ;file has DIR attribute DB ' DIR',0 RET PRTARC: CALL ILPRT ;file has ARC attribute DB ' ARCHIVE',0 RET PRTNRC: CALL ILPRT ;file has NO ARC attribute DB ' Non-ARC',0 RET PRTERA: CALL ILPRT ;file erased DB ' <ERASED>',0 RET PRTUNE: CALL ILPRT ;file unerased DB ' <UNERASED>',0 RET ;----------------------------------------------------------------------------- ; HELP ; This code displays the built in help screen and then jumps to QUIT to ; return to CP/M. Entire menu re-written for this version. (ldr) HELP: CALL ILPRT DB 'Usage:',TAB IF ZCPR3 DB 'CFA [dir:]filename.typ X[#]',CR,LF,LF DB ' where dir: is optional directory specifier in DU:',CR,LF DB ' or named directory form,' ENDIF ;ZCPR3 IF NOT ZCPR3 DB 'CFA [d:]filename.typ X[#]',CR,LF,LF DB ' where d: is optional drive specifier,' ENDIF ;NOT ZCPR3 DB ' and X may be ONE of these:',CR,LF,LF DB 'Number 0-31',CR,LF DB ' Moves file to user area X',CR,LF,LF IF TAGS ; (ldr) DB 'File tags:',TAB,TAB,TAB ENDIF ;TAGS (ldr) DB 'File attributes:',CR,LF IF TAGS ; (ldr) DB ' F or G Tag 1, on/off',TAB,TAB ENDIF ;TAGS (ldr) DB ' R or W: $R/O or $R/W',CR,LF IF TAGS ; (ldr) DB ' H or I Tag 2, on/off',TAB,TAB ENDIF ;TAGS (ldr) DB ' S or D: $SYS or $DIR',CR,LF IF TAGS ;(ldr) DB ' J or K Tag 3, on/off',TAB,TAB ENDIF ;TAGS (ldr) DB ' A or N: $ARC or $Non-ARC',CR,LF IF TAGS ;(ldr) DB ' L or M Tag 4, on/off',CR,LF ENDIF ;TAGS (ldr) DB LF ; end of usual file tags and attributes DB 'File erase or unerase:',CR,LF DB ' E or U: Erase or Unerase (into current user)' DB CR,LF,LF IF SPLIT ; (ldr) DB 'File splitting (handle with care):',CR,LF DB ' C: Cut file into segments, each ' DB SEGSIZ+48, ' extents long',CR,LF DB ' B: Bind files previously Cut' DB CR,LF,LF ENDIF ;SPLIT (ldr) DB 'Add "#" after any letter option to work in ALL user areas' DB 0 ; end of help text JMP QUIT2 ;============================================================================= ; G E N E R A L - P U R P O S E S U B R O U T I N E S ;----------------------------------------------------------------------------- ; CRTOUT ; This subroutine sends the character in register A to the console. Registers ; BC, DE, and HL are preserved. CHAROUT: PUSH H ;save registers PUSH D PUSH B MOV E,A ;get character into E MVI C,06 ;BDOS direct console I/O CALL BDOS POP B ;restore registers POP D POP H RET ;----------------------------------------------------------------------------- ; CRLF ; This routine sends a carriage return and linefeed to the console. CRLF: CALL ILPRT DB CR,LF,0 RET ;----------------------------------------------------------------------------- ; FILL ; This subroutine fills memory starting at HL for a length B with the byte ; in A. FILL: MOV M,A INX H DCR B JNZ FILL RET ;----------------------------------------------------------------------------- ; ILPRT ; This subroutine prints the string that follows its call. The string must ; be terminated with a null (0). ILPRT: POP H ;get address following call into HL ILPRT1: MOV A,M ;get character from message INX H ;point to next character ORA A ;test for null indicating end of message JZ ILPRT2 ;if end, fix up return address MOV E,A ;have BDOS send character it to console MVI C,2 PUSH H ;save pointer to string CALL BDOS POP H ;restore pointer JMP ILPRT1 ;process it ILPRT2: PUSH H ;set up return address to just past message RET ;----------------------------------------------------------------------------- ; PRTSTR ; This subroutine prints a string of characters pointed to by DE. The number ; of characters is in the C register. Blanks are not printed; instead, the ; blanks counter pointed to by HL is incremented. PRTSTR: LDAX D ;get character CPI ' ' ;see if it is a blank CZ UPCOUNT ;if so, up the count CNZ CHAROUT ;if not, output the character INX D DCR C ;check count JNZ PRTSTR RET UPCOUNT: PUSH PSW ;save flags INR M ;increase the blank counter POP PSW ;restore flags RET ;----------------------------------------------------------------------------- ; PRTBLK ; This subroutine prints blank spaces given by the count in C. The routine ; will work even for a count of zero. PRTBLK: INR C ;turn 0 into 1 PRTBL1: DCR C ;check count RZ ;return if count exhausted MVI A,' ' ;set character to print CALL CHAROUT JMP PRTBL1 ;============================================================================= ; S E T U P S U B R O U T I N E S ;----------------------------------------------------------------------------- ; SIGNON ; This subroutine displays the program signon message. SIGNON: CALL ILPRT DB CR,LF,'CFA - v' DB VERSION / 10 + '0' DB '.' DB VERSION MOD 10 + '0' IF ZCPR3 DB ' for ZCPR3' ENDIF ;ZCPR3 DB CR,LF,0 RET ;----------------------------------------------------------------------------- ; CHKHLP ; This subroutine checks to see if the user has invoked the program in a ; way to request the built-in help screen. The help screen is shown if the ; command has no tail or if the tail begins with a slash. CHKHLP: LDA FCB+1 ;get first character of first parameter CPI ' ' ;no name? JZ HELP ;if so, go to HELP CPI '/' ;parameter starts with slash? JZ HELP ;if so, go to HELP RET ;return with flag set appropriately ;----------------------------------------------------------------------------- ; INIT ; This subroutine initializes the data areas in the program so that GO ; command will re-run the program correctly. INIT: XRA A ;zero the accumulator STA CHGFLAG ;preset control flags STA RSTFLAG STA DIRCODE IF SPLIT ;(ldr) STA MRKSEG ; zero extent counter MVI A,'A' STA EXTLTR ; set first letter for segment rename ENDIF ;SPLIT LXI H,AMBFIL2 MVI B,16 CALL FILL ;clear the fcb MVI A,'?' MVI B,16 LXI H,AMBFIL CALL FILL LHLD 0001 ;get warmboot address (base of bios + 3) LXI D,27H ;offset for jump to bios write DAD D ;compute address for write routine SHLD WRITE + 1 ;load our vector with this address RET ;----------------------------------------------------------------------------- ; SETDU ; This subroutine gets and saves the values of the currently logged in drive ; and user area and the drive and user specified (if any) on the command line ; for the files to be operated on. SETDU: ;get currently logged in user number MVI C,20H ;BDOS get/set user number function MVI E,0FFH ;get user flag CALL BDOS STA DEFUSR STA SRCUSR ;save for now as source user also ;get the currently logged in drive MVI C,19H ;bdos get drive number function CALL BDOS ;get drive number STA DEFDRV INR A ;change range 1-16 and STA SRCDRV ;..save for now as source drive also ;now log in the drive and user in file spec LDA FCB ;get drive spec from FCB ORA A ;see if default specified JZ SETDU1 STA SRCDRV ;save source drive SUI 1 ;get in range 0-15 CALL LOGDRV ;log in the drive XRA A ;and change FCB to show default drive STA FCB SETDU1: IF ZCPR3 LDA FCB+13 ;get user number from S1 byte STA SRCUSR ;save as source user area CALL LOGUSR ;log in the user number ENDIF ;ZCPR3 RET ;----------------------------------------------------------------------------- ; These two routines log in the drive or user number given in the A register. ; No registers are preserved. LOGDRV: MOV E,A MVI C,0EH CALL BDOS RET LOGUSR: MOV E,A MVI C,20H CALL BDOS RET ;----------------------------------------------------------------------------- ; GETOPT ; Process option specified on the command line. If there is an error, the ; routine jumps to HELP which in turn jumps to QUIT. If a named directory ; is specified for the destination on the command line, then its user number ; is obtained from address TFCB+13. The drive is checked to make sure that ; the destination is on the same drive. GETOPT: IF ZCPR3 ;check for destination specified using named directory LDA TFCB ;check for drive number ORA A ;if zero, no DIR: or DU: given JZ GETOPT1 ;check for correct drive spec LXI H,SRCDRV ;point to source drive value CMP M JNZ BADDRV ;if not the same, jump to bad drive message ;get the user number LDA TFCB + 13 STA OPTION ;store user number as option JMP CHKNUM ;check for valid user number BADDRV: CALL ILPRT ;destination and source drives not same DB BELL DB 'Source and Destination Drives must be same',0 JMP QUIT ENDIF ;ZCPR3 GETOPT1: LXI H,TFCB ;point to parsed second parameter MOV A,M ;make sure it wasn't of form 'D:' ORA A ;drive byte should be zero JNZ BADOPT INX H ;now look at data entered MOV A,M ;get the first character CALL GETNUM ;try to read it as a number JC LETTER ;if not, must be a letter or bad MOV B,A ;save digit in B STA OPTION ;..and as interim option INX H ;try next character MOV A,M CPI ' ' ;if it is a blank JZ CHKNUM ;..go to test user number value CALL GETNUM ;see if second character is a number JC BADOPT ;if not, we have a bad option spec MOV C,A ;save second digit MOV A,B ;get first digit back ADD A ;double it three times to make 8x ADD A ADD A ADD B ;now add original in twice to make 10x ADD B ADD C ;finally, add in second digit STA OPTION ;..and save the final result ;check for valid user number (in range and not same ;as logged in user number) CHKNUM: LDA OPTION ;make sure we have the user number CPI 32 ;test for valid user number range JNC BADNUM LXI H,SRCUSR ;see if same as source user CMP M JZ SAMENUM ;if so, give message RET LETTER: ;check for valid letter option PUSH PSW ;save option letter INX H ;check whether option followed by '#' MOV A,M CPI '#' JNZ LETTER0 ;not "all users" switch, don't save it STA ALLUSR LETTER0: POP PSW ;get option character back LXI H,OPTLIST ;point to list of valid options MOV C,M ;get number of options in list LETTER1: ;loop through them checking INX H CMP M ;compare to list entry JZ GOODOPT ;if it matches, we have a good option DCR C ;else, count down JNZ LETTER1 ;..and try again JMP HELP ;we get here if option is not valid GOODOPT: ;we have a good option letter STA OPTION RET BADOPT: ;we have a bad option specifier CALL ILPRT DB BELL,0 ; if bad option, just a bell, then menu JMP HELP BADNUM: ;we have an illegal user number CALL ILPRT DB BELL DB 'User number must be 0-31',0 JMP QUIT SAMENUM: ;give message about already in that user area CALL ILPRT DB BELL DB 'Destination/Source user numbers must be different',0 JMP QUIT ;subroutine to check for number character ;returns with carry set if not a number GETNUM: CPI '0' ;see if less than '0' RC ;if so, set carry flag as signal CPI '9'+1 ;see if more than '9' CMC ;reverse sense of carry flag RC ;if >9, return with carry set SUI '0' ;convert to number value RET ;carry is clear ;list of valid options OPTLIST: DB ENDLIST-OPTLIST ;number of options in list DB ' SDRWANEU' ;valid options IF TAGS ; include options for tags DB 'FGHIJKLM' ; (ldr) ENDIF ; TAGS IF SPLIT ; include options for file splitting DB 'CB' ; (ldr) ENDIF ; SPLIT ENDLIST: ; just a marker, no code. ;----------------------------------------------------------------------------- ; CHKRO ; This routine checks to see if the destination drive is read-only. If it ; is, an appropriate error message is displayed and the program aborts with ; a jump to QUIT. If the option is display only (option = space char), then ; this test is skipped. CHKRO: LDA OPTION ;see if display option is in effect CPI ' ' RZ ;if so, skip rest of test MVI C,1DH ;get R/O vector from BDOS CALL BDOS ;calculate number of left-shifts needed LDA SRCDRV ;get the target drive number CMA ;complement it (makes 255-SRCDRV) ADI 17 ;makes A = 16 - SRCDRV (value 1-16) ;shift word in HL to put bit of R/O vector for ;specified drive into high bit position CHKRO1: DCR A ;test for done JZ CHKRO2 ;if so, jump DAD H ;shift HL to left JMP CHKRO1 ;and loop CHKRO2: DAD H ;move high bit into carry flag RNC ;if not R/O, return CALL ILPRT ;else print R/O error message DB BELL DB 'Drive is R/O',0 JMP QUIT ;abort program ;============================================================================= ; M I S C E L L A N E O U S R O U T I N E S ;----------------------------------------------------------------------------- ; SETPTR ; This subroutine uses the value of the directory code to calculate a pointer ; to the FCB in the DMA buffer. This is done by multiplying the directory code ; by 32 and adding it to the DMA address (DMAADDR). The result is saved in ; DMAPTR. SETPTR: LDA DIRCODE ;get the directory code ADD A ;offset by 32 bytes per entry ADD A ADD A ADD A ADD A MOV E,A ;move value into DE MVI D,0 LXI H,DMAADDR ;get buffer address DAD D ;compute offset into buffer SHLD DMAPTR ;save the address into the buffer RET ;----------------------------------------------------------------------------- ; SETCHGFL ; This subroutine sets the change-flag to show that the directory sector ; has been modified and needs to be written out to disk. SETCHGFL: PUSH PSW MVI A,0FFH ;set the sector change flag STA CHGFLAG POP PSW RET ;============================================================================= ; D A T A A R E A ;----------------------------------------------------------------------------- OLDSTK: ;place to keep old stack pointer DS 2 BLNKCNT: ;count of blank characters in file name DS 1 CHGFLAG: ;flag for change requiring write DS 1 RSTFLAG: ;flag for need to reset disk system DS 1 AMBFIL: ;working fcb DS 16 AMBFIL2: ;space for rest of FCB DS 19 OPTION: ;storage for new user number or option DS 1 ALLUSR: ;storage for "all users" switch DS 1 DIRCODE: ;storage for directory code (0-3) DS 1 DMAPTR: ;address of FCB in DMA buffer DS 2 DEFDRV: ;current default drive DS 1 SRCDRV: ;source drive DS 1 DEFUSR: ;current default user number DS 1 SRCUSR: ;source user area from file spec DS 1 IF SPLIT ; (ldr) MRKSEG: DS 1 ; extent counter for split segments EXTLTR: DS 1 ; letter code for renamed segments ENDIF ;SPLIT DS 60 ;room for local stack NEWSTK: END