CP/M

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

/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / sap38.lbr / SAP38.AZM / SAP38.ASM

Wrap

Assembly Source File | 1993-10-25 | 11.9 KB | 735 lines

; v3.8 SORT AND PACK CP/M DISK DIRECTORY - 10/16/83 ; ; THIS PROGRAM READS THE DISK DIRECTORY TRACKS, SORTS THEM ALPHABETICALLY ; THEN REPLACES THEM ON THE DISK. ALL UNUSED OR ERASED AREAS ON THE DIR- ; ECTORY TRACK ARE REFORMATTED WITH CONTINUOUS 'E5' CHARACTERS. (THIS ; ERASES PREVIOUS FILE NAMES WHICH HAVE BEEN DEACTIVATED.) SORTING THE ; DIRECTORY IN THIS MANNER OFFERS MANY ADVANTAGES. SOME OF THEM ARE: ; ; 1) ALLOWS 'DIR' TO SHOW AN ALPHABETIZED LISTING ; 2) ELIMINATES POTENTIAL PROBLEMS WITH "UNERASE" PROGRAMS ; 3) SPEEDS UP ACCESS VIA 'SD' AND OTHER SPECIAL PROGRAMS ; 4) ASSISTS ON WORKING DIRECTLY ON THE DISK WITH 'DUU', ETC. ; 5) REMOVES FILES FROM THE DISK SOMEBODY ELSE COULD RECOVER ; ; - Notes by Irv Hoff W6FFC ; ; 1977 Written by L. E. Hughes. Modified extensively since by Bruce ; Ratoff, Keith Petersen, James Prest, Ron Fowler, Frank Gaude, ; Irv Hoff and likely others. ; ; 10/16/83 Now using a Shell-Metzner sort which speeds the sorting time ; considerably, especially on large directories. (SFK) ; ; 07/27/83 Shows an error flag for MP/M and CP/M+ both. Rewrites dir- ; tory even if previously sorted, to insure erased programs at ; v3.7 end of directory are properly cleared. ; - Irv Hoff ; ;======================================================================= ; ; TRUE: EQU 0FFH FALSE: EQU 0 ; BDOS: EQU 5 CR: EQU 0DH DPBLEN: EQU 15 ;SIZE OF CP/M2 DISK PARAMETER BLOCK FCB: EQU 5CH GETDSK: EQU 25 ;BDOS "GET DISK #" FUNCTION LF: EQU 0AH SELDRV: EQU 14 ;SELECT DRIVE VERNO: EQU 12 ;PROVIDES CP/M VERSION NUMBER ;..... ; ; ORG 100H ; JMP VECTRS ;JMP AROUND IDENTIFICATION MSG ; ; ; OBTAIN BIOS VECTORS ; VECTRS: JMP GETVEC ; DS 53 ;ROOM FOR JUMP VECTORS ; WBOOT: EQU VECTRS+3 ;DO NOT CHANGE THESE EQUATES CSTS: EQU VECTRS+6 CI: EQU VECTRS+9 CO: EQU VECTRS+12 LO: EQU VECTRS+15 PO: EQU VECTRS+18 RI: EQU VECTRS+21 HOME: EQU VECTRS+24 SELDSK: EQU VECTRS+27 SETTRK: EQU VECTRS+30 SETSEC: EQU VECTRS+33 SETDMA: EQU VECTRS+36 READ: EQU VECTRS+39 WRITE: EQU VECTRS+42 LSTS: EQU VECTRS+45 ;ONLY IN CP/M2 SECTRN: EQU VECTRS+48 ;ONLY IN CP/M2 ;..... ; ; GETVEC: LXI D,WBOOT LHLD 1 MVI B,53 CALL MOVE ; ;======================================================================= ; ; PROGRAM STARTS HERE ; ;======================================================================= ; ; START: LXI H,0 DAD SP ;GET ADDRESS OF CP/M STACK SHLD STACK ;STORE IT SO WE CAN GO BACK TO IT LXI SP,STACK ;NOW USE OUR OWN STACK CALL ILPRT ;PRINT MSG: DB CR,LF,'SORT AND PACK DIRECTORY v3.8 10/16/83',CR,LF,0 MVI C,VERNO ;CHECK FOR CP/M VER 2.2 CALL BDOS MOV A,H ;H=1 FOR MPM ORA A JNZ MPMYES ;EXIT IF MPM, WE CAN'T USE IT MOV A,L ;HL = 0022H IF CP/M VER 2.2 CPI 22H+1 ;CHECK FOR MPM OR CP/M+ JNC MPMYES ;EXIT IF CP/M+, WE CAN'T USE IT STA VERFLG ;STORE THE VERSION ; ; ;======================================================================= ; ; MAIN PROGRAM ROUTINE ; ;======================================================================= ; ; SAP: CALL SETUP CALL RDDIR CALL CLEAN CALL SORT CALL PACK CALL WRDIR CALL ILPRT DB 'DONE',CR,LF,0 JMP EXIT ;..... ; ; ;======================================================================= ; ; SUBROUTINES ; ;======================================================================= ; ; CLEAN: LXI H,0 ;I = 0 ; CLNLOP: SHLD I CALL INDEX ;HL = BUF + 16 * I MOV A,M ;JUMP IF THIS IS A DELETED FILE CPI 0E5H JZ FILL$E5 LXI D,12 DAD D ;HL = HL + 12 MOV A,M ;CHECK EXTENT FIELD ORA A JNZ CLBUMP ;SKIP IF NOT EXTENT ZERO INX H ;POINT TO RECORD COUNT FIELD INX H MOV A,M ;GET S2 BYTE (EXTENDED RC) ANI 0FH ; FOR CPM2, 0 FOR CPM1 MOV E,A INX H MOV A,M ;CHECK RECORD COUNT FIELD ORA E JNZ CLBUMP ;JUMP IF NON-ZERO LHLD I ;CLEAR ALL 32 BYTES OF CALL INDEX ; DIRECTORY ENTRY TO E5 INX H MOV A,M ;GET FIRST CHAR OF FILENAME DCX H ; WARD CHRISTENSONS CAT PGMS CPI '-' ; HAVE DISKNAME OF ZERO LENGTH JZ CLBUMP ; THAT START WITH '-', DON'T DELETE ; FILLE5: MVI C,32 ;NUMBER OF BYTES TO CLEAR ; FILLOP: MVI M,0E5H ;MAKE IT ALL E5'S INX H DCR C JNZ FILLOP ; CLBUMP: LHLD DRM ;GET COUNT OF FILENAMES INX H XCHG LHLD I ;OUR CURRENT COUNT INX H PUSH H CALL SUBDE ;SUBTRACT POP H JC CLNLOP ;LOOP TILL ALL CLEANED RET ;..... ; ; CP/M 1.4 ROUTINE ; CPM14: LHLD BDOS+1 MVI L,0 MVI A,(JMP) STA SECTRN PUSH H LXI D,15 ;SECTRAN OFFSET FROM BDOS IN CPM 1.4 DAD D SHLD SECTRN+1 POP H LXI D,3AH ;OFFSET FROM BDOS TO 1.4 DPB DAD D MVI D,0 MOV E,M INX H XCHG SHLD SPT XCHG MOV E,M INX H XCHG SHLD DRM XCHG MOV A,M INX H STA BSH MOV A,M INX H STA BLM MOV E,M INX H XCHG SHLD DSM XCHG MOV E,M INX H XCHG SHLD AL0 XCHG MOV E,M XCHG SHLD SYSTRK RET ;..... ; ; ; CP/M 2.2 ROUTINE ; CPM22: MOV E,M INX H MOV D,M INX H XCHG SHLD SECTBL XCHG LXI D,8 ;OFFSET TO DPB WITHIN HEADER DAD D ;RETURNED BY SELDSK IN CPM2 MOV A,M ;GET ADRS OF DPB INX H MOV H,M MOV L,A LXI D,DPB ;POINT TO DEST: OUR DPB MVI B,DPBLEN CALL MOVE RET ;..... ; ; DODIR: STA WRFLAG LHLD SYSTRK CALL DOTRAK ;SET THE TRACK LXI H,0 SHLD SECTOR LHLD DRM ;NUMBER OF DIR ENTRIES INX H ;RELATIVE TO 1 CALL ROTRHL ;DIVIDE BY 4 CALL ROTRHL ; TO GET SECTOR COUNT SHLD DIRCNT LXI H,BUF SHLD ADDR ;FOR DMA ADDRESS ; DIRLOP: LHLD SECTOR ;GET SECTORS PER TRACK INX H XCHG LHLD SPT ;CURRENT SECTOR CALL SUBDE ; SECTOR - SPT XCHG JNC NOTROV ; ; ; TRACK OVERFLOW, BUMP TO NEXT ; LHLD TRACK INX H CALL DOTRAK LXI H,1 ;REWIND SECTOR NUMBER ; NOTROV: CALL DOSEC ;SET CURRENT SECTOR LHLD ADDR MOV B,H ;SET UP DMA ADDRESS MOV C,L CALL SETDMA LDA WRFLAG ;TIME TO FIGURE OUT ORA A ; IF WE ARE READING JNZ DWRT ; OR WRITING ; ; ; READ ; CALL READ ORA A ;TEST FLAGS ON READ JNZ RERROR ;NZ=ERROR JMP MORE ;GOOD READ, GO DO MORE ;..... ; ; ; TRACK AND SECTOR UPDATE ROUTINES ; DOTRAK: SHLD TRACK MOV B,H MOV C,L CALL SETTRK RET DOSEC: SHLD SECTOR MOV B,H MOV C,L LHLD SECTBL XCHG DCX B CALL SECTRN MOV B,H MOV C,L LDA VERFLG ORA A RZ CALL SETSEC RET ;..... ; ; ; WRITE ; DWRT: MVI C,1 ;FOR CPM/2 DEBLOCKING BIOS'S CALL WRITE ORA A ;TEST FLAGS ON WRITE JNZ WERROR ;NZ=BAD DIRECTORY WRITE JMP MORE ;..... ; ; EXIT: LDA NOBOOT ;SEE IF BOOT IS NEEDED ORA A JNZ EXIT1 ;FLAG IS SET IF ALREADY ALPHABETIZED JMP 0000H ;A REWRITTEN DIRECTORY NEEDS A WARM BOOT ; EXIT1: LHLD STACK ;GET ADDRESS OF ORIGINAL CP/M STACK SPHL ;RESET STACK ADDRESS RET ;..... ; ; ; PRINT A STRING: ADDRESS IS ON TOP OF STACK ; ILPRT: XTHL ;GET ADR FROM STACK MOV A,M ;GET CHARACTER INX H ;POINT TO NEXT ADR XTHL ;RESTORE TO STACK ORA A ;ARE WE DONE? RZ ;YES, RETURN PAST STRING PUSH H ;IN CASE CBIOS CLUBBERS IT MOV C,A ;CHARACTER TO C FOR CP/M CALL CO ;PRINT CHARACTER POP H JMP ILPRT ;CONTINUE ;..... ; ; INDEX: DAD H DAD H DAD H DAD H DAD H LXI D,BUF DAD D RET ;..... ; ; ; GOOD READ OR WRITE ; MORE: LHLD ADDR ;BUMP DMA ADRS FOR NEXT PASS LXI D,80H DAD D SHLD ADDR LHLD DIRCNT ;COUNTDOWN ENTRIES DCX H SHLD DIRCNT MOV A,H ;TEST FOR ZERO LEFT ORA L JNZ DIRLOP ;LOOP TILL ZERO ; ; ; DIRECTORY I/O DONE, RESET DMA ADDRESS ; LXI B,80H CALL SETDMA RET ;..... ; ; ; MOVE UTILITY SUBROUTINE ; MOVE: MOV A,M STAX D INX H INX D DCR B JNZ MOVE RET ;..... ; ; ; MPM OR CP/M+ NOT ALLOWED WITH THIS PROGRAM ; MPMYES: CALL ILPRT DB CR,LF,'** SAP not useable with MPM or CP/M+ **',0 JMP EXIT ;..... ; ; PACK: LXI H,0 ;I = 0 ; PACK1: SHLD I CALL INDEX ;HL = BUF + 16 * I LXI D,9 DAD D ;HL = HL + 9 MOV A,M ;JUMP IF FILETYPE NOT 'X$$' SUI '0' ; WHERE 0.LE.X.LE.9 JC PACK2 CPI 10 JNC PACK2 STA J INX H MOV A,M CPI '$' JNZ PACK2 INX H MOV A,M CPI '$' JNZ PACK2 INX H ;SET EXTENT NUMBER TO X LDA J MOV M,A DCX H ;SET FILETYPE TO '$$$' MVI M,'$' DCX H MVI M,'$' DCX H MVI M,'$' ; PACK2: LHLD I ;I = I + 1 INX H XCHG LHLD DRM INX H XCHG PUSH H CALL SUBDE POP H ;LOOP UNTIL I > DRM JC PACK1 RET ;..... ; ; ; READ AND WRITE DIRECTORY ROUTINES ; RDDIR: CALL ILPRT DB CR,LF,'---> Reading, ',0 XRA A STA NOBOOT ;ZERO THE FLAG JMP DODIR ;ZERO THE WRITE FLAG FOR NOW ;..... ; ; ; COME HERE IF WE GET A READ ERROR ; RERROR: CALL ILPRT ;PRINT: DB '++ READ ERROR - Exiting to CP/M - NO CHANGE made' DB CR,LF,0 JMP EXIT ;..... ; ; ; DIVIDE HL BY 2 ; ROTRHL: ORA A ;CLEAR CARRY MOV A,H RAR MOV H,A MOV A,L RAR MOV L,A RET ;..... ; ; ; SETUP FOR SELECTING DRIVE AND LOADING DISK PARM BLOCK ; SETUP: LDA FCB DCR A JP SETUP1 ;EXIT IF DISK DRIVE MENTIONED MVI C,GETDSK ;OTHERWISE GET CURRENT DEFAULT DRIVE CALL BDOS ;SO QUERY 'BDOS' FOR DRIVE ; SETUP1: MOV C,A CALL SELDSK LDA VERFLG ;IF CPM 1.4 ORA A JZ CPM14 ;IF 1.4, THEN DO IT THE 1.4 WAY JMP CPM22 ;MUST BE 2.2 THEN SINCE NOT MPM ;..... ; ; ; SORT THE DIRECTORY ; SORT: CALL ILPRT DB 'Sorting, ',0 ; ; SHELL-METZNER SORT ; LHLD I SHLD SNUMRECW LXI H,BUF SHLD SSTADR PUSH H ; AND SAVE IT LXI H,32 SHLD SRECLEN PUSH H ; AND SAVE IT ; ; NOW DIVIDE # OF FIELDS BY 2 ; DIVIDE: LHLD SNUMRECW ;GET VALUE CALL ROTRHL SHLD SNUMRECW ;SAVE RESULT MOV A,L ;IF SNUMRECW<>0 ORA H ; THEN JNZ NOTDONE ; NOT DONE ; ; ALL FIELDS SORTED ; POP B ;CLEAN UP STACK POP D RET ; NOTDONE:XCHG LHLD I MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A SHLD SRECLEN LXI H,1 SHLD SSORTV1 SHLD SSTADR DCR L POP B PUSH B NDONE1: DAD D DCX B MOV A,B ORA C JNZ NDONE1 SHLD SSORTV2 XCHG POP B POP H PUSH H PUSH B NDONE2: SHLD SSORTV4 SHLD SSORTV3 XCHG DAD D XCHG COMPARE:POP B PUSH B COMPAR1:LDAX D ANI 7FH PUSH B PUSH PSW MOV A,M ANI 7FH MOV B,A POP PSW SUB B POP B JNZ NOTEQU INX H INX D DCX B MOV A,B ORA C JNZ COMPAR1 JMP NOSWITCH ; ; THE CONDITION AT NOTEQU: HAS TO ; BE CHANGED FOR DESCENDING SORT. ; NOTEQU: JNC NOSWITCH SWITCH: PUSH B MOV B,M LDAX D MOV M,A MOV A,B STAX D INX H INX D POP B DCX B MOV A,B ORA C JNZ SWITCH LHLD SNUMRECW MOV A,H CMA MOV D,A MOV A,L CMA MOV E,A LHLD SSORTV1 DAD D JNC NOSWITCH INX H SHLD SSORTV1 LHLD SSORTV3 XCHG LHLD SSORTV2 MOV A,E SUB L MOV L,A MOV A,D SBB H MOV H,A SHLD SSORTV3 JMP COMPARE ; NOSWITCH: LHLD SSTADR INX H SHLD SSTADR SHLD SSORTV1 XCHG LHLD SRECLEN MOV A,L SUB E MOV A,H SBB D JC DIVIDE LHLD SSORTV4 POP D PUSH D DAD D XCHG LHLD SSORTV2 XCHG JMP NDONE2 ;..... ; ; ; UTILITY SUBTRACTION SUBROUTINE... ; HL=HL-DE ; SUBDE: MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A RET ;..... ; ; WRDIR: CALL ILPRT DB 'Writing, ',0 MVI A,1 JMP DODIR ;..... ; ; ; COME HERE IF WE GET A WRITE ERROR ; WERROR: CALL ILPRT ;PRINT: DB '++ WRITE ERROR - Exiting to CP/M - directory left ' DB 'in UNKNOWN condition ++',CR,LF,0 JMP EXIT ;..... ; ; ; DATA AREA ; ADDR: DS 2 DIRCNT: DS 2 I: DS 2 J: DS 2 MAPPTR: DS 2 NOBOOT: DS 1 NOSWAP: DS 1 SECTBL: DS 2 SECTOR: DS 2 TRACK: DS 2 VERFLG: DS 1 WRFLAG: DS 1 SRECLEN:DS 2 SSTADR: DS 2 SSORTV1:DS 2 SSORTV2:DS 2 SSORTV3:DS 2 SSORTV4:DS 2 SNUMRECW:DS 2 ;..... ; ; ; DISK PARAMETER BLOCK: ; DPB: SPT: DS 2 BSH: DS 1 BLM: DS 1 EXM: DS 1 DSM: DS 2 DRM: DS 2 AL0: DS 1 AL1: DS 1 CKS: DS 2 SYSTRK: DS 2 ;..... ; ; DS 26 ;STACK NEVER GETS THIS DEEP STACK: DS 2 ;SPACE FOR OLD STACK ADDRESS ; ; EVEN: EQU ($+255)/256*256 ;START BUFFER ON EVEN PAGE ; ORG EVEN ; BUF: DS 0 ;..... ; ; END ; TRACTION SUBROUTINE... ; HL=