home *** CD-ROM | disk | FTP | other *** search
- ;QCAT.ASM
- ;V0.6
- ;6/23/78 QUICK CATALOG ROUTINE
- ;
- ;DEFINE MOVE MACRO FOR CONVENIENCE
- ;
- MOVE MACRO ?F,?T,?L,?I
- IF NOT NUL ?F
- LXI D,?F
- ENDIF
- IF NOT NUL ?T
- LXI H,?T
- ENDIF
- IF NOT NUL ?L
- MVI B,?L
- ENDIF
- IF NOT NUL ?I
- LOCAL H,Z
- CALL Z
- H DB ?I
- Z MVI B,Z-H
- POP D
- ENDIF
- CALL MOVER
- ENDM
- ;CPM FUNCTION MACRO -
- ; CPM FNC,ADDR
- CPM MACRO ?F,?A,?T
- PUSH B
- PUSH D
- PUSH H
- IF NOT NUL ?A
- LXI D,?A
- ENDIF
- IF NOT NUL ?T
- MOV E,A ;;FOR TYPE
- ENDIF
- MVI C,?F
- CALL BDOS
- POP H
- POP D
- POP B
- ENDM
- ;
- ORG 100H
- LXI H,0
- DAD SP
- SHLD STACK
- LXI SP,STACK
- ;
- ;SAVE THE INPUT DISK NAME, IF THERE IS ONE
- ;
- LXI H,BUFF
- LDA FCB+1
- CPI ' '
- JZ NONAME
- CPI '-'
- JZ GOTDASH
- BADNAME CALL ERXIT
- DB '++MUST USE DISK NAME WITH ''-'' AS '
- DB 'THE FIRST CHARACTER,',0DH,0AH
- DB 'AND NNN AS THE FILETYPE$'
- GOTDASH LDA FCB+9
- MOV A,M
- CPI ' '
- JZ BADNAME
- MOVE FCB+1,BUFF,8
- MOVE ,,,'.'
- MOVE FCB+9,,3
- MVI M,0DH
- INX H
- MVI M,0AH
- INX H
- MVI A,1
- STA FCB ;COUNT THE '-' NAME
- NONAME PUSH H
- CATMSG CALL ILPRT
- DB 'LOAD DISK TO BE CATALOGED, '
- DB 'THEN PRESS D: ',0
- CPM RDCON
- ANI 5FH ;MAKE UPPER CASE
- CPI 'D'
- JNZ CATMSG
- ;MAKE FCB ALL '?'
- MOVE ,FCB+1,,'???????????'
- ;READ THE DIRECTORY ENTRIES
- ;
- POP H
- MVI C,SRCHF
- JMP CALLB
- LOOP MVI C,SRCHN
- CALLB PUSH H
- LXI D,FCB
- CALL BDOS
- POP H
- INR A
- JZ NOMORE
- ;
- ;MOVE THE NAME INTO THE BUFFER
- ;
- DCR A ;GET BACK ORIG VALUE
- ANI 3
- PUSH H
- MOV L,A
- MVI H,0
- DAD H ;X32
- DAD H
- DAD H
- DAD H
- DAD H
- LXI D,80H
- DAD D
- ;HL NOW POINTS TO ENTRY
- XCHG
- INX D ;SKIP FIRST BYTE
- POP H
- MOVE ,,8
- MVI M,'.'
- INX H
- MOVE ,,3
- MVI M,0DH
- INX H
- MVI M,0AH
- INX H
- ;INCREMENT FILE COUNT
- LDA FCT
- INR A
- STA FCT
- JMP LOOP ;GET NEXT
- ;
- ;NO MORE ENTRIES
- ;
- NOMORE MVI M,'Z'-40H
- SHLD ENDADDR ;SAVE FOR WRITE
- NEXTS LDA FCT ;GET FILE COUNT
- DCR A
- STA FCT
- JZ DONE ;ALL DONE
- ;
- ;PASS THRU THE BUFF, SORTING IT.
- ;
- MOV C,A ;SAVE COUNT
- LXI D,BUFF
- COMPR LXI H,14
- DAD D
- PUSH D
- PUSH H
- MVI B,14 ;COMPARE LENGTH
- CLCLP LDAX D
- CMP M
- JC NEXTC
- JNZ DIFF
- SAME INX D
- INX H
- DCR B
- JNZ CLCLP
- NEXTC POP H
- POP D
- XCHG
- NEXTC2 DCR C ;MORE?
- JNZ COMPR ;CHECK NEXT 2
- ;
- ;COMPLETED PASS THRU BUFF
- ;
- JMP NEXTS
- ;
- ;UNEQUAL COMPARE
- ;
- DIFF POP H
- POP D ;GET POINTERS
- ;SWAP
- MVI B,14
- PUSH B
- SWAP MOV C,M
- LDAX D
- MOV M,A
- MOV A,C
- STAX D
- INX D
- INX H
- DCR B
- JNZ SWAP
- POP B
- JMP NEXTC2
- ;
- ;SORT ALL DONE - WRITE 'NAMES.SUB'
- ;
- DONE LDA BUFF
- CPI '-'
- JZ NAMEOK
- CALL ILPRT
- DB '++MISSING ''-'' NAME ON DISK OR '
- DB 'QCAT COMMAND',0DH,0AH
- DB 'RELOAD CATALOG DISK, PRESS RETURN',0
- CPM RDCON
- CALL ERXIT
- DB '++RUN QCAT, THIS TIME WITH NAME OPERAND$'
- NAMEOK CALL ILPRT
- DB 'MOUNT CATALOG DISK, PRESS RETURN',0
- CPM RDCON
- CPM RESETDK ;RESET DISK, KILLING R/O STATUS
- CPM SELDK,0
- MOVE ,FCB+1,,'NAMES SUB'
- CPM ERASE,FCB
- CPM MAKE,FCB
- INR A
- JZ BADMAKE
- LXI D,BUFF
- WRLP PUSH D
- CPM STDMA
- CPM WRITE,FCB
- ORA A
- JNZ WRERR
- POP D
- LXI H,80H
- DAD D
- XCHG
- MOV A,D
- LDA ENDADDR+1
- INR A
- CMP D
- JNC WRLP
- CPM STDMA,80H
- CPM CLOSE,FCB
- CALL ERXIT
- DB '++DONE. NOW ISSUE COMMAND:',0DH,0AH
- DB 'UCAT$'
- WRERR CALL ERXIT
- DB '++WRITE ERROR$'
- BADMAKE CALL ERXIT
- DB '++CAN''T MAKE NAMES.SUB$'
- ;
- ;INLINE PRINT
- ;
- ILPRT MVI A,0DH
- CALL TYPE
- MVI A,0AH
- CALL TYPE
- XTHL
- ILPLP MOV A,M
- CALL TYPE
- INX H
- MOV A,M
- ORA A
- JNZ ILPLP
- INX H
- XTHL
- RET
- ;
- ;TYPE CHAR IN A
- ;
- TYPE CPM WRCON,,TYPE
- RET
- ;
- ;CHAR MOVE ROUTINE, (DE) -> (HL) LEN IN B
- ;
- MOVER LDAX D
- MOV M,A
- INX D
- INX H
- DCR B
- JNZ MOVER
- RET
- FCT DB 0 ;FILE COUNT
- ENDADDR DS 2 ;END OF FILE
- ;FOLLOWING FROM 'EQU5.LIB'---->
- DS 40H ;STACK AREA
- STACK DS 2
- ;
- ;EXIT WITH ERROR MESSAGE
- ERXIT MVI A,0DH
- CALL TYPE
- MVI A,0AH
- CALL TYPE
- POP D ;GET MSG
- MVI C,PRINT
- CALL BDOS
- ;EXIT, RESTORING STACK AND RETURN
- EXIT LHLD STACK
- SPHL
- RET ;TO CCP
- BUFF EQU $
- ;BDOS/CBIOS EQUATES (VERSION 6)
- RDCON EQU 1
- WRCON EQU 2
- PRINT EQU 9
- RESETDK EQU 13
- SELDK EQU 14
- OPEN EQU 15
- CLOSE EQU 16
- SRCHF EQU 17
- SRCHN EQU 18
- ERASE EQU 19
- READ EQU 20
- WRITE EQU 21
- MAKE EQU 22
- STDMA EQU 26
- BDOS EQU 5
- FCB EQU 5CH
-