CP/M

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

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug038.ark / PACKUP.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 14.8 KB | 574 lines

; ; TITLE PACK UP THE BUFFER AND MOVE ROUTINES FOR FAST.COM ; FILENAME PACKUP.ASM ; AUTHOR Robert A. Van Valzah 12/25/78 ; LAST REVISED R.A.V. 5/20/79 ; REASON MOVED DEFAULT OPTION STRING TO 130H ; ; BOOT EQU 0 CURDSK EQU 4 BDOS EQU 5 ; FCB1 EQU 5CH FCB2 EQU 6CH DBUF EQU 80H DIRTRK EQU 2 ;DIRECTORY TRACK MTYTRK EQU 0FFH ;TRACK NUMBER SHOWING A DDB IS EMPTY SECLEN EQU 80H ;LENGTH OF A SECTOR IN BYTES ; ; ORG 100H ENTRY: JMP SKIPMES DB 'Copyright (C) 1979, Robert A. Van Valzah' DB 0,0,0,0,0 ;SO DFLTOPT IS AT NICE EASY BOUNDRY ; DFLTOPT: ;OPTION STRING TO USE IF NONE SUPPLIED DB '[RS] ' ; ; SECTOR ORDER TABLES ; TRKSEC: DB 26,25,24,23,22,21,20,19,18,17,16,15,14 DB 13,12,11,10, 9, 8, 7, 6, 5, 4, 3, 2, 1 DB 0 ;EOT MARKER ; RESERVE SPACE FOR DOUBLE DENSITY SECTOR TABLE DB 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0 DB 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0 ; DIRSEC: DB 25, 23, 21, 19, 17, 15, 14, 13 DB 11, 9, 8, 7, 5, 3, 2, 1 DB 0 ;EOT MARKER ; RESERVE SPACE FOR DOBLE DENSITY DB 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0 PAGE ; ; < < < < < < FILE NAME PARSING SUBROUTINES > > > > > > ; ; GETFN GETS A FILE NAME FROM TEXT POINTED TO BY REG HL INTO ; AN FCB POINTED TO BY REG DE. LEADING DELIMETERS ARE ; IGNORED. ; ENTRY HL FIRST CHARACTER TO BE SCANED ; DE FIRST BYTE OF FCB ; EXIT HL CHARACTER FOLLOWING FILE NAME ; GETFN: CALL INITFCB ;FILL FCB WITH DEFAULTS CALL GETSTART ;SCAN TO FIRST CHARACTER OF NAME RZ ;END OF LINE WAS FOUND - LEAVE FCB BLANK CALL GETDRV ;GET DRIVE SPEC. IF PRESENT CALL GETPS ;GET PRIMARY AND SECONDARY NAME RET ; ; INITFCB FILLS AN FCB WITH THE DEFAULT INFORMATION. THE ; DRIVE SPEC IS DEFAULTED TO THE CURRENT DRIVE, AND THE ; PRIMARY AND SECONDARY NAME BYTES ARE FILLED WITH BLANKS. ; ENTRY DE FIRST BYTE OF FCB ; EXIT DE PRESERVED ; A,C CLOBBERED ; INITFCB: PUSH D ;SAVE FCB START XRA A ;INIT DRIVE SPEC STAX D INX D ;POINT TO PRIMARY NAME FIELD MVI A,' ' ;CHAR TO FILL NAMES WITH MVI C,11 ;LENGTH OF PRI AND SEC NAMES BLANKL: STAX D INX D DCR C JNZ BLANKL POP D ;RESTORE FCB START POINTER RET PAGE ; ; GETSTART ADVANCES THE TEXT POINTER (REG HL) TO THE FIRST ; NON DELIMITER CHARACTER (I.E. IGNORES BLANKS). RETURNS A ; FLAG IF END OF LINE (00H OR ';') IS FOUND WHILE SCANING. ; EXIT HL POINTING TO FIRST NON DELIMITER ; A CLOBBERED ; ZERO SET IF END OF LINE WAS FOUND ; GETSTART: CALL GETCH ;SEE IF POINTING TO DELIM? RNZ ;NOPE - RETURN CPI ';' ;END OF LINE? RZ ;YUP - RETURN W/FLAG ORA A RZ ;YUP - RETURN W/FLAG INX H ;NOPE - MOVE OVER IT JMP GETSTART ;AND TRY NEXT CHAR ; ; GETDRV CHECKS FOR THE PRESENCE OF A DRIVE SPEC AT THE TEXT ; POINTER, AND IF PRESENT FORMATS IT INTO THE FCB AND ; ADVANCES THE TEXT POINTER OVER IT. ; ENTRY HL TEXT POINTER ; DE POINTER TO FIRST BYTE OF FCB ; EXIT HL POSSIBLY UPDATED TEXT POINTER ; DE POINTER TO SECOND (PRIMARY NAME) BYTE OF FCB ; GETDRV: INX D ;POINT TO NAME IF SPEC NOT FOUND INX H ;LOOK AHEAD TO SEE IF ':' PRESENT MOV A,M DCX H ;PUT BACK IN CASE NOT PRESENT CPI ':' ;IS A DRIVE SPEC PRESENT? RNZ ;NOPE - RETURN MOV A,M ;YUP - GET THE ASCII DRIVE NAME SUI 'A'-1 ;CONVERT TO FCB DRIVE SPEC DCX D ;POINT BACK TO DRIVE SPEC BYTE STAX D ;STORE SPEC INTO FCB INX D ;POINT BACK TO NAME INX H ;SKIP OVER DRIVE NAME INX H ;AND OVER ':' RET PAGE ; ; GETPS GETS THE PRIMARY AND SECONDARY NAMES INTO THE FCB. ; ENTRY HL TEXT POINTER ; EXIT HL CHARACTER FOLLOWING SECONDARY NAME (IF PRESENT) ; GETPS: MVI C,8 ;MAX LENGTH OF PRIMARY NAME CALL GETNAM ;PACK PRIMARY NAME INTO FCB MOV A,M ;SEE IF TERMINATED BY A PERIOD CPI '.' RNZ ;NOPE - SECONDARY NAME NOT GIVEN ;RETURN DEFAULT (BLANKS) INX H ;YUP - MOVE TEXT POINTER OVER PERIOD FTPOINT: ;YUP - UPDATE FCB POINTER TO SECONDARY MOV A,C ORA A JZ GETFT INX D DCR C JMP FTPOINT GETFT: MVI C,3 ;MAX LENGTH OF SECONDARY NAME CALL GETNAM ;PACK SECONDARY NAME INTO FCB RET PAGE ; ; GETNAM COPIES A NAME FROM THE TEXT POINTER INTO THE FCB FOR ; A GIVEN MAXIMUM LENGTH OR UNTIL A DELIMITER IS FOUND, WHICH ; EVER OCCURS FIRST. IF MORE THAN THE MAXIMUM NUMBER OF ; CHARACTERS IS PRESENT, CHARACTER ARE IGNORED UNTIL A ; A DELIMITER IS FOUND. ; ENTRY HL FIRST CHARACTER OF NAME TO BE SCANED ; DE POINTER INTO FCB NAME FIELD ; C MAXIMUM LENGTH ; EXIT HL POINTING TO TERMINATING DELIMITER ; DE NEXT EMPTY BYTE IN FCB NAME FIELD ; C MAX LENGTH - NUMBER OF CHARACTERS TRANSFERED ; GETNAM: CALL GETCH ;ARE WE POINTING TO A DELIMITER YET? RZ ;IF SO, NAME IS TRANSFERED INX H ;IF NOT, MOVE OVER CHARACTER CPI '*' ;AMBIGIOUS FILE REFERENCE? JZ AMBIG ;IF SO, FILL THE REST OF FIELD WITH '?' STAX D ;IF NOT, JUST COPY INTO NAME FIELD INX D ;INCREMENT NAME FIELD POINTER DCR C ;IF NAME FIELD FULL? JNZ GETNAM ;NOPE - KEEP FILLING JMP GETDEL ;YUP - IGNORE UNTIL DELIMITER AMBIG: MVI A,'?' ;FILL CHARACTER FOR WILD CARD MATCH FILL?: STAX D ;FILL UNTIL FIELD IS FULL INX D DCR C JNZ FILL? ;FALL THRU TO INGORE REST OF NAME GETDEL: CALL GETCH ;POINTING TO A DELIMITER? RZ ;YUP - ALL DONE INX H ;NOPE - IGNORE ANTOHER ONE JMP GETDEL PAGE ; ; GETCH GETS THE CHARACTER POINTED TO BY THE TEXT POINTER ; AND SETS THE ZERO FLAG IF IT IS A DELIMITER. ; ENTRY HL TEXT POINTER ; EXIT HL PRESERVED ; A CHARACTER AT TEXT POINTER ; Z SET IF A DELIMITER ; GETCH: MOV A,M ;GET THE CHARACTER IRPC CHAR,<.,; :=<>> CPI '&CHAR' RZ ENDM ORA A ;SET ZERO FLAG ON END OF TEXT RET PAGE ; ; ; <<<<<< OPTION STRING PARSING SUBROUTINES >>>>>> ; ; ; GETOPT GETS AN OPTION STRING FROM TEXT POINTED TO BY REG HL ; IF NO OPTION STRING IS PRESENT, THE DEFAULT STRING (DFLTOPT) ; IS PARSED INSTEAD. AN OPTION STRING STARTS WITH '['. ; GETOPT: CALL GETSTART ;GET FIRST CHARACTER OF ARGUMENT CPI '[' ;IS THIS THE START OF AN OPTION STRING? JZ SCANOPT ;IF SO - GO PARSE ARGUMENT STRING PUSH H ;IF NOT - SAVE ARGUMENT TXA AND . . . LXI H,DFLTOPT ;PARSE DEFAULT STRING INSTEAD CALL SCANOPT POP H ;GET ARG TXA BACK RET ; ; SCAN AN OPTION STRING, CALLING DDB CREATION ROUTINES TO GIVE ; REQUESTED OPTIONS ; SCANOPT: XCHG ;SAVE OPTION TXA WHILE . . . LHLD BDOS+1 ;INITIALIZING DDB ALLOCATIN POINTER MVI L,0 ;MOVE DOWN TO PAGE BOUNDRY SHLD BUFSTRT XCHG ;GET OPTION TXA BACK INX H ;MOVE OVER '[' SCANDRV: CALL GETODRV ;GET DRIVE SPEC IF PRESENT MOV A,C ;SAVE DRIVE SPEC FOR DDB CREATION STA BUFDRV SCANBUF: CALL GETOBUF ;GET BUFFER SPEC MOV A,C ;WAS A BUFFER SPEC PRESENT? CPI 4 JNZ OPTOK ;YES - THAT'S AN OK OPTION MOV A,B ;NO - IT'S OK ONLY IF . . . ORA A ;A DRIVE SPEC WAS PRESENT JZ OPTOK OPTERR: ;GIVE OPTION ERROR AND REBOOT LXI D,OPTMES MVI C,9 CALL BDOS JMP 0 ; OPTMES: DB 'INVALID OPTION', 13, 10, '$' ; OPTOK: PUSH H ;SAVE TXA DURING CREATION CALL CRTBUF ;CREATE THE REQUESTED BUFFERS POP H ;GET TXA BACK CALL GETOBUF ;SEE IF ANY MORE BUFF SPEC PRESENT MOV A,C CPI 4 JNZ OPTOK ;YES - GO CREATE THEM CALL GETOCH ;NO - SEE IF OUT OF OPTION SPEC JNZ SCANDRV ;NO - EXPECT ANOTHER DRIVE SPEC RET ;YES - OUR JOB HERE IS DONE ; ; GET AN OPTION DRIVE SPEC FROM TEXT, RETURNED IN REG C. ; IF NOT PRESENT, RETURN CURRENTLY LOGGED DISK AND SET FLAG. ; GETODRV: LDA CURDSK ;GET CURRENT DISK IN CASE OF FAILURE MOV C,A MVI B,0FFH ;SET DEFAULT FLAG ALSO MOV A,M ;GET POSSIBLE DRIVE SPEC CHR SUI 'A' ;LESS THAN 'A' RC ;YES - RETURN TAKING DEFAULT CPI 'D'-'A'+1 ;GREATER THAN 'D'? RNC ;YES - RETURN TAKING DEFAULT MOV C,A ;NO - VALID SPEC WAS PRESENT, RETURN MVI B,0 ;IT IN REG C, AND RESET DEFAULT FLAG INX H ;MOVE OVER VALID DRIVE SPEC CHARACTER RET ; ; GET OPTION BUFFER SPECIFICATION, RETURNING CORRESPONDING ; TOKEN IN REG C. ; BUFFER TOKEN ; SPEC RETURNED ; ====== ======== ; R 0 READ ; W 1 WRITE TRACK ; S 2 SEEK (DIRECTORY) ; Y 3 YES (ALL OF THE ABOVE) ; <NULL> 4 NONE OF THE ABOVE ; GETOBUF: MVI C,4 ;PREPARE TO RETURN NULL IF CALL GETOCH RZ ;END OF OPTION IS FOUND INX H ;ASSUME WE WILL FIND A SPEC, MOVE OVER DCR C ;GET YES TOKEN CPI 'Y' ;RETURN IF YES SPEC RZ DCR C ;GET SEEK TOKEN CPI 'S' ;RETURN IF SEEK SPEC RZ DCR C ;GET WRITE TOKEN CPI 'W' ;RETURN IF WRITE TOKEN RZ DCR C ;GET READ TOKEN CPI 'R' ;RETURN IF READ TOKEN RZ DCX H ;SPEC NOT FOUND - BACKUP TO UNKNOWN CHR MVI C,4 ;AND RETURN DEFAULT TOKEN RET ; ; GET AN OPTION CHARACTER FROM THE TEXT POINTER. SET FLAGS ; IF END OF OPTION STRING FOUND ; GETOCH: MOV A,M ;GET A CHARCTER CPI ' ' ;SPACE TERMINATES AN OPTION STRING RZ CPI ']' ;SO DOES RIGHT BRACKET, BUT INX H ;MOVE TEXT POINTER OVER IT RZ DCX H ;NOT ']', GET TXA BACK ORA A ;RETURN FLAG IF END OF ARGUMENT TO FAST RET PAGE ; ; ; <<<<<< DDB CREATION SUBROUTINES >>>>>> ; ; ; CREATE ONE OR MORE DDB'S FROM A BUFFERING SPEC TOKEN AND ; A DRIVE SPEC ; CRTBUF: MOV A,C ;GET BUFFER TOKEN ORA A ;READ TRACK? JZ CRT$R ;YES - CREATE A READ DDB DCR C ;WRITE TRACK? JZ CRT$W ;YES - CREATE A WRITE DDB DCR C ;SEEK JZ CRT$S ;YES - CREATE A SEEK DDB CALL CRT$R ;NONE OF THE ABOVE, MUST BE NULL OR Y CALL CRT$S ;AND BOTH NEED READ AND SEEK DCR C ;NULL? RNZ ;YES - READ AND SEEK ARE DONE - RETURN CALL CRT$W ;NO - I.E. YES - CREATE WRITE DDB ALSO RET ; ; CREATE A READ TRACK DDB ; CRT$R: LXI H,RDBUF ;POINT TO READ DDB ADDRESS TABLE IN FAST JMP CRT$TDDB ;CONTINE TO CREATE A FULL TRACK DDB ; ; CREATE A WRITE TRACK DDB ; CRT$W: LXI H,WRBUF ;POINT TO WRITE DDB ADDRESS TABLE CRT$TDDB: LXI D,TRKSEC ;POINT TO FULL TRACK SECTOR TABLE CALL CRT$DDB ;CREATE A GENERALIZED DDB MVI A,MTYTRK ;SET DDB TO EMPTY TRACK STAX D RET ; ; CREATE A SEEK DDB ; CRT$S: LXI H,DIRBUF ;POINT TO DIRECTORY DDB ADDRESS TABLE LXI D,DIRSEC ;PARTIAL TRACK (DIRECTORY) SECTOR TABLE CALL CRT$DDB MVI A,DIRTRK ;INITIALIZE TRACK TO DIRECTORY TRACK STAX D RET ; ; GENERALIZED CREATE DDB ROUTINE. A DDB FOR THE DRIVE IN ; BUFDRV IS CREATED USING THE SECTOR TABLE PASSED IN REG DE. ; THE ADDRESS OF THE DDB IS FILLED INTO THE DDB ADDRESS ; TABLE WITHIN FAST. MEMORY IS DOWNSIZED BY THE LENGTH OF ; THE DDB. ; CRT$DDB: PUSH B ;SAVE CALLERS REG BC PUSH H ;SAVE DDB ADDRESS TABLE POINTER LHLD BUFSTRT ;GET HIGHEST BYTE NOW IN USE DCX H ;POINT TO NEXT FREE BYTE MVI M,0 ;PUT IN END OF DDB MARKER LDAX D ;GET LAST SECTOR NUMBER TO REG A LXI B,-(SECLEN+2) ;NEGATIVE LENGHT BETWEEN SECTORS FILLSEC: DAD B ;POINT TO UPDATE FLAG MVI M,0 ;RESET UPDATE FLAG DCX H ;POINT TO SECTOR NUMBER FIELD MOV M,A ;FILL IN ANOTHER SECTOR NUMBER LDA LEN+1 ;HIGH ORDER LENGTH INTO REG A ADI (HIGH CODE1)+1 ;ADD FAST START ADDRESS TO GIVE ;HIGH ORDER MINIMUM BUFFER START CMP H ;IS NEW BUFFER START LESS THAN MIN? JNC OMERR ;YES - GIVE OUT OF MEMORY ERROR INX D ;POINT TO NEXT SECTOR NUMBER FROM TABLE LDAX D ;GET NEXT SECTOR ORA A ;END OF TABLE? JNZ FILLSEC ;NO - KEEP ALLOCATING SECTORS DCX H ;NOW POINTING TO DRIVE FIELD OF DDB LDA BUFDRV ;GET DRIVE FOR THIS DDB MOV M,A ;AND FILL IT IN DCX H ;AND LEAVE ROOM FOR TRACK NUMBER SHLD BUFSTRT ;DOWNSIZE MEMORY XCHG ;DDB ADDRESS TO REG DE POP H ;POINTER TO DDB ADDRESS TABLE TO REG HL ADD A ;DOUBLE DRIVE NUMBER TO INDEX INTO TABLE MOV C,A ;FORM INDEX IN REG BC MVI B,0 DAD B ;ADD INDEX TO BASE MOV A,M ;MAKE SURE NO DDB EXISTS FOR THIS SPEC INX H ORA M JNZ OPTERR ;ONE EXISTS - SPECIFIED TWICE ERROR MOV M,D ;EMPTY SO FAR, SO FILL IN DDB ADDRESS DCX H MOV M,E POP B ;RESTORE CALLERS REG BC RET ; OMERR: MVI C,9 ;PRINT ERROR MESSAGE AND BOOT LXI D,OMMES CALL BDOS JMP BOOT ; OMMES: DB 'OUT OF MEMORY$' RET PAGE ; ; ; <<<<<<< MAIN LINE CODE STARTS HERE >>>>>>>> ; SKIPMES: LXI SP,STACK ;SETUP LOCAL STACK LDA DBUF ;GET LENGHT OF ARGUMENT TO FAST COMMAND ADI DBUF+1 ;COMPUTE ADDRESS OF LAST CHAR + 1 MOV L,A MVI H,HIGH DBUF MVI M,0 ;FOLLOW ARGUMENT WITH A 0 TO EASE PARSING ; ; REPACK ARGUMENT BUFFER TO ELIMINATE ARGUMENTS TO FAST. ; LXI H,DBUF+1 ;POINT TO FIRST CHAR OF ARG CALL GETOPT ;GET OPTIONS AS NECESSARY LXI D,COMFCB ;PACK TRANSIENT FCB INTO FAST CALL GETFN ;MOVE TEXT POINTER PAST COM FILE NAME LXI D,DBUF+1 ;DESTINATION FOR REPACKED ARG MOV A,L ;COMPUTE LENGTH OF FAST ARGUMENT SUB E MOV C,A ;SAVE IN REG C LDA DBUF ;GET TOTAL ARG LEGTH SUB C ;SUBTRACT FAST ARG LENGTH STA DBUF ;LEAVING LENGTH OF TRANSIENT ARG MOV C,A ;THIS IS ALSO LENGTH TO REPACK INR C ;ADD ONE FOR END OF TEXT BYTE CALL MOVESUB ;ACTUALLY DO THE REPACKING ; LXI H,DBUF+1 ;NOW PACK FCB'S FOR TRANSIENT LXI D,FCB1 CALL GETFN ;PACK FCB1 LXI D,FCB2 CALL GETFN ;PACK FCB2 LXI H,COMFCB+9 ;FILL IN TRANSIENT FILE TYPE 'COM' MVI M,'C' INX H MVI M,'O' INX H MVI M,'M' PAGE ; ; NOW THAT DBUF AND FCB'S HAVE BEEN REPACKED, BEGIN THE UPWARD ; MOVEMENT AND RELOCATION OF FAST. ; LHLD LEN ;GET LENGTH OF FAST CODE MOV B,H ;INTO BC TO MOV C,L LDA BUFSTRT+1 ;GET PAGE OF LOWEST BUFFER SUB B ;DOWNSIZE MEMORY BY LENGHT OF FAST MOV H,A PUSH H ;SAVE DEST FOR ENTRY WHEN RELOC IS DONE LXI D,CODE1 ;POINTER TO CODE ORGED FOR 0 MOVEREL: PUSH B ;SAVE LENGTH PUSH H ;SAVE DEST MOVE: LDAX D ;GET A BYTE FROM CODE 1 IMAGE MOV M,A ;MOVE TO DEST INX D ;BUMP CODE 1 POINTER INX H ;BUMP DEST POINTER DCX B ;MOVED WHOLE THING YET? MOV A,B ORA C JNZ MOVE POP H ;GET DEST BACK POP B ;GET LENGTH BACK PUSH D ;PUSH BASE OF RELTBL MOV D,H ;BIAS IN REG D NEWBYT: XTHL ;GET RELOC TBL ADR MOV E,M ;KEEP A REL BYTE IN REG E INX H ;BUMP RELOC TBL POINTER XTHL ;PUT TBL PTR BACK RELBYT: MOV A,E ;GET RELOC BYTE RLC ;MOVE A BIT INTO CARY MOV E,A ;SAVE THE REST OF THE RELOC BITS JNC NOREL ;BIT WAS 0, DON'T RELOCATE THIS BYTE MOV A,D ;GET BIAS TO ADD ADD M ;ADD TO BYTE FROM DEST MOV M,A NOREL: INX H ;BUMP DEST POINTER DCX B ;DONE WITH ALL BYTES? MOV A,B ORA C JZ MOVEDONE ;YUP - VECTOR TO REL BASE MOV A,L ;NOPE - TEST IF AT 8 BYTE BOUNDRY ANI 0000$0111B ;IF SO, TIME FOR A NEW BYTE FROM TABLE JNZ RELBYT ;NOT AT BOUNDRY JMP NEWBYT ;AT A BOUNDRY MOVEDONE: POP B ;REMOVE RELOC TBL ADR FROM STACK RET ;VECTOR TO FAST ENTRY ; MOVESUB: MOV A,M STAX D INX D INX H DCR C JNZ MOVESUB RET ; ; RAM AREAS ; DS 20 ;STACK SPACE STACK: ; BUFDRV DB 0 ;TEMP FOR OPTION DRIVE SPEC SCAN BUFSTRT DW 0 ;LOWEST ADDRESS USED FOR BUFFERS ; ORG (($-1) OR 255) + 1 ;ORG TO NEXT PAGE BOUNDRY BIAS: ;BIAS USED TO LOAD FAST ORGED FOR 0 CODE1: ;BASE ADDRESS OF CODE ORGED FOR 0 DS 3 ;MOVE OVER ENTRY JMP LEN: ;WORD HOLDING LENGTH OF FAST CODE DS 2 COMFCB: ;FCB FOR COM FILE TO BE LOADED DS 33 ORG CODE1+100H ;FIRST ADDRESS NOT OVERLAID DS 6 ;SPACE FOR BDOS SERIAL NUMBER DS 3 ;SPACE FOR JMP TO REAL BDOS RDBUF DS 8 ;READ TRACK DDB ADDRESS TABLE WRBUF DS 8 ;WRITE TRACK DDB ADDRESS TABLE DIRBUF DS 8 ;DIRECTORY DDB ADDRESS TABLE ; END ENTRY