CP/M

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

/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol008 / pastocpm.asm < prev next >

Wrap

Assembly Source File | 1984-04-29 | 11.4 KB | 660 lines

TITLE '"PASTOCPM" - Convert Pascal file to CP/M file' ;From DR. DOBB'S - August 1979 ;Copyright (C) 1979 Ronald G. Parsons ;Modified by T. Mueller 9/1/79 ; Changes include: ; Provisions for designating disk drives. ; Re-ordering calls to disk routines to be of the form: ; select disk, select track, select sector, read/write. ; Cleaned up handling of null codes in .TEXT files. ; Set up new stack area and data buffers. ; Changed exit to simple return, no re-boot. ; Guaranteed .TEXT file on CP/M disk ends in EOF. ; Memory size independance for BIOS calls. ;9/22/79 - Corrected handling of DLE as last byte of read block. ; ;Transfers a Pascal file to CP/M file. ; ;Syntax -- PASTOCPM <[d:]CP/M filename> <[d:]Pascal filename> ; ;Disk drive (d:) identifiers may be entered. If none are supplied ; defaults are: CP/M file on logged drive, Pascal file on drive B:. ; ;Transfers the Pascal filename on a Pascal disk ; to the CP/M filename on a CP/M disk. If the CP/M file already exists, ; you will be asked for permission to overwrite. ;If the Pascal file is a .TEXT file, then two blocks are skipped ; and tabs replaced by spaces. LF is added after each CR. ;If the Pascal file is a .CODE file, then one block is skipped. ;If file is neither .TEXT or .CODE, the copy is exact. ; ; DLE EQU 10H DENTSZ EQU 26 ;DIRECTORY ENTRY SIZE IN BYTES DTITLE EQU 6 ;OFFSET TO ENTRY TITLE ; ORG 100H START LXI H,0 DAD SP SHLD STACK LXI SP,STACK ;SET UP PRIVATE STACK ; MVI C,LOGGED ;GET LOGGED DISK DRIVE CALL BDOS STA LDRIVE LDA FCB ;GET CP/M DRIVE ORA A JNZ DOIT ;NOT LOGGED DRIVE LDA LDRIVE ;GET LOGGED DRIVE INR A STA FCB ;FORCE SELECTION OF DRIVE DOIT LXI H,BUFF ;GET PASCAL FILE NAME LXI D,SYSTLE+1 MVI A,1 STA RDRIVE ;SET PASCAL DEFAULT TO DRIVE B SCN1 CALL SCBLK ;FIND NON-BLANK JZ SCN1 SCN2 CALL SCBLK ;FIND BLANK JNZ SCN2 SCN3 CALL SCBLK ;FIND START OF SECOND PARM JZ SCN3 INX H MOV A,M CPI ':' ;CHECK IF DRIVE ENTERED DCX H JNZ SCN4 MOV A,M ;GET DRIVE SUI 'A' STA RDRIVE ;SAVE READ DRIVE INX H INX H ;SKIP DRIVE SCN4 PUSH H LXI H,RDRIVE LDA FCB DCR A CMP M ;CHECK IF READ AND WRITE DRIVES ARE SAME POP H JZ DRVERR MVI C,0 PFN2 MOV A,M ORA A JZ PFN3 STAX D INX H INX D INR C JMP PFN2 ; PFN3 MOV A,C ;GET FILENAME LENGTH STA SYSTLE ORA A JZ NOFLNM ;CHECK FOR .TEXT OR .CODE FILENAME LXI D,TEXT+6 DCX H ;HL POINTS TO END OF FILENAME PUSH H MVI C,5 TEXTLP LDAX D CMP M JNZ NOTEXT ;FILENAME DOES NOT END IN .TEXT DCX H DCX D DCR C JNZ TEXTLP LXI H,TXTFLG ;GOT .TEXT FILE MVI M,2 LXI D,TEXT MVI C,WRITECB CALL BDOS ; NOTEXT POP H ;POINT TO END OF FILENAME LXI D,CODE+6 MVI C,5 CODELP LDAX D CMP M JNZ NOTCODE ;FILENAME DOES NOT END IN .CODE DCX H DCX D DCR C JNZ CODELP LXI H,TXTFLG MVI M,1 ;GOT .CODE FILE LXI D,CODE MVI C,WRITECB CALL BDOS ; NOTCODE LXI D,FCB MVI C,OPENF ;OPEN FILE CALL BDOS CPI 0FFH ;NON-EXISTANT? JZ CREF ;YES - CREATE IT LXI D,PERMSG ;GET PERMISSION TO DELETE IT MVI C,WRITECB CALL BDOS ; RDCHR MVI C,READC ;READ CONSOLE CALL BDOS CPI ABORT JZ EXIT CPI CR JNZ RDCHR ;INVALID RESPONSE, TRY AGAIN MVI E,LF MVI C,WRITEC ;CHARACTER TO CONSOLE CALL BDOS LXI D,FCB MVI C,DELETEF ;KILL FILE CALL BDOS ; CREF LXI D,FCB MVI C,CREATEF ;CREATE FILE CALL BDOS CPI 0FFH ;ERROR? JZ CERROR ;YES ; ;INITIALIXE BUFFER POINTERS ; INIT LXI H,BUFF SHLD BOL LXI H,BUFF+127 SHLD EOB LXI H,BLKBUF+512 SHLD BUFADD ; LXI B,DIRTOP ;READ DIRECTORY INTO THIS CALL READ$DIR ; LXI H,DIRTOP ;SET DIRECTORY ENTRY POINTER LXI D,DENTSZ ; TO FIRST ENTRY AFTER VOLUME NAME DAD D SHLD DENTP ; CALL FIND$FILE ;FIND THE FILE ; LHLD DENTP ;START OF DIRECTORY ENTRY MOV E,M INX H MOV D,M PUSH D ;SAVE FIRST BLOCK INX H MOV E,M INX H MOV D,M XCHG ;LAST BLOCK+1 IN HL DAD H ;X2 DAD H ;X4 SHLD LSTLSN ;(LAST LSN + 1) * 4 POP H ;GET FIRST BLOCK LDA TXTFLG SKPBL1 DCR A ;SKIP BLOCKS DEPENDING ON JM SKPBL2 ; .TEXT OR .CODE INX H JMP SKPBL1 ; SKPBL2 DAD H ;X2 DAD H ;X4 SHLD LSN ;(FIRST LSN) * 4 ; LR80B CALL R80B ;READ 128 BYTES LDA EOFFLAG ORA A ;LAST PASCAL SECTOR READ? JNZ FILL1A ;YES CALL WB ;WRITE BUFFER JMP LR80B ; FILL1A CALL CT ;FILL BUFFER WITH EOF CALL WB ;WRITE BUFFER LDA TXTFLG CPI 2 ;.TEXT? JNZ FILL2 ;NO LHLD EOB MOV A,M CPI EOF ;CHECK IF LAST SECTOR WRITTEN HAS EOF JZ FILL2 LXI H,BUFF SHLD BOL JMP FILL1A FILL2 LXI D,FCB MVI C,CLOSEF ;CLOSE FILE CALL BDOS EXIT LXI D,BUFF MVI C,DMAADD CALL BDOS LDA LDRIVE ;GET LOGGED DRIVE MOV E,A MVI C,SELECTD ;RESTORE LOGGED DRIVE CALL BDOS LHLD STACK SPHL ;RESTORE SP RET ;JOB DONE - GO BACK ; ;********************************************************* ; ; SUBROUTINES ; ;********************************************************* ; ;READ DIRECTORY'S 4 BLOCKS TO BUFFER ;BUFFER ADDRESS IS ALREADY IN REG-BC ; READ$DIR: MVI E,4 ;DIRECTORY IS 4 BLOCKS LONG LXI H,2 ; AND STARTS AT BLOCK 2 CALL SYSRD ;GET IT RET ; ; FIND$FILE: MVI C,77 ;STOP AFTER THE 77'TH ENTRY LHLD DENTP ;GET STARTING ENTRY FI$SCH$LP: LXI D,DTITLE ;ADVANCE TO TILTE STRING DAD D LXI D,SYSTLE ;SET REG-DE TO COMPARISON STRING LDA SYSTLE ;COMPARISON LENGTH INR A ;COMPARE INCLUDES LENGTH BYTE MOV B,A FI$CMP$LP: LDAX D CMP M JNZ FI$CONT ;IT'S NOT THIS ONE INX D INX H DCR B ;CHECK FOR END OF STRING JNZ FI$CMP$LP ;NOT YET JMP FI$FOUND ;FOUND IT ; FI$CONT: LHLD DENTP ;ON TO THE NEXT ENTRY LXI D,DENTSZ DAD D SHLD DENTP DCR C ;IS THERE ANY DIRECTORY LEFT? JNZ FI$SCH$LP ;YES FI$HANG: JMP NOFILE ;FILE NOT THERE ; FI$FOUND: RET ;GOT IT ; ; ;READ BLOCKS FROM PASCAL DISKETTE ; SYSRD PUSH D ;SAVE BLOCK COUNT PUSH H ; AND BLOCK NUMBER CALL READ$RX ;BUFFER IS ADVANCED BY 512 BYTES POP H POP D INX H ;ADVANCE TO NEXT BLOCK DCR E ;SEE IF WE'RE DONE JNZ SYSRD RET ; ; ;READ A PASCAL BLOCK ; READ$RX: DAD H ;THERE ARE 4 SECTORS TO A BLOCK DAD H ;MULT LOGICAL BLOCK BY 4 MVI E,4 RR$LP PUSH B ;SET BUFFER ADDRESS PUSH D PUSH H CALL SETDMA POP H ;NOW COMPUTE TRACK/SECTOR PUSH H CALL MAP ;CONVERTS LOGICAL SECTOR IN HL PUSH H LDA RDRIVE MOV E,A MVI C,SELECTD ;SELECT READ DISK CALL BDOS POP H MOV C,H ; INTO TRACK H, SECTOR L PUSH H CALL SETTRK POP H MOV C,L CALL SETSEC CALL READ ORA A JNZ RWERR POP H POP D POP B PUSH H ;ADVANCE THE BUFFER ADDRESS LXI H,128 DAD B MOV B,H MOV C,L POP H INX H ;ADVANCE THE BLOCK COUNT DCR E ;SEE IF WE CONTINUE JNZ RR$LP ;YES RET ; ; ;READ SECTOR GIVEN BY LSN ; RDSEC MVI C,DMAADD CALL BDOS LHLD LSN CALL MAP ;CONVERT LOGICAL SECTOR # TO TRACK/SECTOR MOV C,H PUSH H CALL SETTRK POP H MOV C,L CALL SETSEC CALL READ ORA A JNZ RWERR LHLD LSN INX H SHLD LSN RET ; ;CLEAR TO END OF BUFFER ; CT LHLD EOB INX H XCHG LHLD BOL CT1 CALL EQUAL RZ MVI M,EOF INX H JMP CT1 ; EQUAL MOV A,L CMP E RNZ MOV A,H CMP D RET ;ZERO IF DE=HL ; ;READ A SECTOR TO BUFFER ; R80B MVI B,128 LXI H,BUFF R80B1 PUSH B PUSH H CALL RB POP H POP B PUSH PSW LDA EOFFLAG ORA A JZ R80B2 ;NOT EOF POP PSW SHLD BOL RET ; R80B2 POP PSW MOV M,A INX H DCR B JNZ R80B1 RET ; ;WRITE 128 BYTE BUFFER ; WB LXI D,BUFF MVI C,DMAADD CALL BDOS LXI D,FCB MVI C,WRITER CALL BDOS ORA A JNZ RWERR RET ; ;SCAN FOR BLANKS IN COMMAND LINE ; SCBLK INX H MOV A,M CPI 0 ;CHECK IF END OF INPUT LINE JZ NOFLNM CPI ' ' RET ; ;PROCESS LF AND TAB FILL, GET BYTE FROM READ BUFFER ; RB LDA TXTFLG CPI 2 JNZ RBFB ;NOT .TEXT RCCKLF LDA NLF ;NEED LF? ORA A JZ RBCKTB XRA A STA NLF MVI A,LF RET ; RBCKTB LDA NTB ;NEED TAB? ORA A JZ RBFB DCR A STA NTB MVI A,' ' RET ; ;GET BYTE FROM READ BUFFER, AND FILL IF NEEDED ; RBFB LHLD BUFADD LXI D,BLKBUF+512 CALL EQUAL ;CHECK FOR END OF BUFFER JZ RBLK LDA TXTFLG CPI 2 ;.TEXT? JNZ NOTEXT2 LDA DFLAG ;WAS LAST CHAR DLE? ORA A JNZ RBFBT ;YES MOV A,M ORA A INX H SHLD BUFADD JZ RBFB ;SKIP BYTE OF ZERO CPI CR JNZ CKDLE STA NLF ;PUT LF AFTER CR RET ;PROCESS BYTE FOLLOWING DLE ; RBFBT MOV A,M INX H SHLD BUFADD SUI 32 ;GET INDENTATION STA NTB ;SAVE NUMBER OF COLUMNS TO INDENT XRA A STA DFLAG ;CLEAR TAB FLAG JMP RBCKTB ;DO BLANK EXPANSION ; ;CHECK FOR DLE CODE - USED FOR INDENTATION ; CKDLE CPI DLE RNZ STA DFLAG ;SET FLAG FOR DLE FOUND JMP RBFB ;GET NEXT BYTE (COUNT) ; NOTEXT2 MOV A,M INX H SHLD BUFADD RET ; ;READ 4 SECTORS (A PASCAL BLOCK) ; RBLK LHLD LSN ;GET START LOGICAL SECTOR NUMBER XCHG LHLD LSTLSN CALL EQUAL JZ SETEOF ;FOUND LAST SECTOR LDA RDRIVE ;GET READ DRIVE NUMBER MOV E,A MVI C,SELECTD ;SELECT DISK CALL BDOS LXI D,BLKBUF ;READ 4 SECTORS CALL RDSEC LXI D,BLKBUF+128 CALL RDSEC LXI D,BLKBUF+256 CALL RDSEC LXI D,BLKBUF+384 CALL RDSEC LXI H,BLKBUF SHLD BUFADD ;RESET POINTER TO START OF BUFFER JMP RBFB ; SETEOF LXI H,EOFFLAG MVI M,1 ;LAST SECTOR ALREADY READ RET ; ;ERROR MESSAGES ; NOFLNM LXI D,NOFLNMSG JMP GENERR ; NOFILE LXI D,NOFMSG JMP GENERR ; RWERR ORI '0' ;MAKE IT ASCII STA WERMSG LXI D,WERMSG GENERR MVI C,WRITECB CALL BDOS JMP EXIT ; CERROR LXI D,ERRMSG ORI '0' STA ERRMSG JMP GENERR ; DRVERR LXI D,DERMSG JMP GENERR ; ;TURN LSN INTO TRACK/SECTOR ; ;NOTE - TRACK 0 IS NOT USED, SO BLOCK 0 IS AT TRACK 1 SECTOR 1 ; ;ON ENTRY - REG-HL HAS LOGICAL BLOCK # * 4 = LOGICAL SECTOR # ;ON EXIT - REG-H HAS PHYSICAL TRACK ; REG-L HAS PHYSICAL SECTOR ; MAP PUSH B PUSH D CALL DIV26 MOV A,L ADD A MOV B,A MVI A,12 CMP L JNC MAPC INR B MAPC MOV C,E XRA A MOV D,A MOV H,A MOV L,B MVI A,6 MAP$LOOP: DAD D DCR A JNZ MAP$LOOP PUSH B CALL DIV26 POP B INR L MOV H,C INR H POP D POP B RET ; ; DIV26 LXI B,-26 MVI E,0FFH DIVL INR E DAD B MOV A,H ORA A JP DIVL LXI B,26 DAD B RET ; ; ; ;BIOS ENTRIES ; SETTRK LHLD 1 MVI L,1EH PCHL ; SETSEC LHLD 1 MVI L,21H PCHL ; SETDMA LHLD 1 MVI L,24H PCHL ; READ LHLD 1 MVI L,27H PCHL ; NOFLNMSG DB CR,LF,'ERROR - Missing file name$' NOFMSG DB CR,LF,'"Pascal" file does not exist$' WERMSG DB ' Read/Write ERROR$' PERMSG DB CR,LF,'"CP/M" file already exists.' DB CR,LF,'C/R to continue, CTRL-C to abort$' ERRMSG DB ' ERROR in file Create or Open$' TEXT DB CR,LF,'.TEXT file being processed$' CODE DB CR,LF,'.CODE file being processed$' DERMSG DB CR,LF,'ERROR - Both files on same drive$' ; ; TXTFLG DB 0 DENTP DS 2 EOFFLAG DB 0 NLF DB 0 NTB DB 0 DFLAG DB 0 BUFADD DS 2 LSN DS 2 LSTLSN DS 2 BOL DS 2 EOB DS 2 SYSTLE DS 22 RDRIVE DS 1 ;DRIVE FOR READ LDRIVE DS 1 ;LOGGED DRIVE ON ENTRY ; DS 64 ;STACK AREA STACK DS 2 ;ENTRY SP BLKBUF DS 512 DIRTOP DS 2048 ; ; ;CP/M EQUATES ; BDOS EQU 5 FCB EQU 5CH BUFF EQU 80H READC EQU 1 ;READ CONSOLE CHARACTER WRITEC EQU 2 ;WRITE CONSOLE CHARACTER WRITECB EQU 9 ;WRITE CONSOLE BUFFER SELECTD EQU 14 ;SELECT DRIVE OPENF EQU 15 ;OPEN FILE CLOSEF EQU 16 ;CLOSE FILE DELETEF EQU 19 ;DELETE FILE WRITER EQU 21 ;WRITE RECORD CREATEF EQU 22 ;CREATE FILE LOGGED EQU 25 ;GET LOGGED DRIVE DMAADD EQU 26 ;SET DMA ADDRESS ; CR EQU 0DH LF EQU 0AH ABORT EQU 3 ;CRTL-C EOF EQU 1AH ; END START