TITLE '3740UTIL - 3740/CP/M UTILITY' ; ;PROGRAM 3740UTIL - 3740 DISK UTILITY ;PROGRAMMER ROBERT M. WHITE ; 8530 STONEHAVEN ; BOISE, ID 83704 ; (208) 377-0336 ;DATE WRITTEN AUGUST 15, 1979 ;DATE FINISHED DECEMBER 23, 1979 ;UPDATES ; APRIL 21, 1980 - CHANGED DATASET LIST FUNCTION ; (11) TO PRINT 80 CHARS. BEFORE IT USED ; BUFFER WRITE, THIS CAUSED BAD DISPLAYS ; IF THE DATA CONTAINED IMBEDDED '$'s. ;PURPOSE THIS PROGRAM GIVES THE USER THE CAPABILITY ; OF CONVERTING IBM 374X DISKETTES TO CP/M ; FORMAT AND VICE VERSA. ALSO, CERTAIN ; OTHER MAINTENANCE FUNCTIONS ARE PROVIDED. ;INPUT ;OUTPUT ;OUTLINE ;REMARKS ; 1. REFERENCES FOR THIS PROGRAM ARE IBM ; MANUALS: ; A. GA21-9182, IBM GENERAL INFORMATION ; MANUAL ON DISKETTES ; 2. THIS PROGRAM IS BASED ON IBM'S BASIC ; DATA EXCHANGE FORMAT. THE ABOVE MANUALS ; DESCRIBE THIS FORMAT. IN PARTICULAR, ; IT WAS WRITTEN TO FORMAT DATA ACCEPTABLE ; TO THE 3741 AND 3540 DISKETTE READER ; FOR EXCHANGE OF DATA BETWEEN CP/M AND ; IBM 370 MAINFRAME. ; 3. ALL CP/M FILE NAMES ARE ASSUMED TO BE ; THE EIGHT BYTE DATASET NAME ENTERED IN ; THE PARTICULAR FUNCTION WITH A FILE TYPE ; OF 'DAT'. OTHER THAN THIS, BOTH THE CP/M ; AND IBM FILE NAMES ARE IDENTICAL. ; 4. ALL DISPLAYS ARE BASED ON THE SOROC-120. ; IN PARTICULAR, THE CLEAR SCREEN FUNCTION ; IS USED THROUGHOUT THE PROGRAM. ; 5. SEE 'EQUATES' SECTION FOR INSURING PROPER ; OPERATIONAL ENVIRONMENT. ;FUTURE UPDATES ; 1. ADD TAB CONDENSATION FEATURE IN IBM-CP/M ; SOURCE TRANSFER. ; 2. ADD ABILITY TO MAP DISK USAGE. ; 3. ADD ABILITY TO ALLOCATE FILES DYNAMICLY. ; (I.E. SPECIFYING NUMBER OF RECORDS ONLY) ; 4. ADD ABILITY TO LIST CP/M DISK DIRECTORY. ;MACLIBS MACLIB DOWHILES MACLIB EQUATES MACLIB MACROS MACLIB NCOMPARE MACLIB SELECTS MACLIB SYMSTACK MACLIB WHENS ;EQUATES EQUATES @TRNASEB SET TRUE @TRNEBAS SET TRUE @OUTTRN SET TRUE NBIOS EQU TRUE ;TRUE IF USING NEW BIOS FOR CP/M 2.0 SPOOLER EQU FALSE ;TRUE IF KLH SPOOLER IS IN NEW BIOS Z80 EQU FALSE ;TRUE IF CPU IS Z80 IF SPOOLER ;DISP TO SPECIAL BIOS 2.0 JUMPS JMPDSP EQU 033H+9 ELSE JMPDSP EQU 033H ENDIF $+PRINT $-PRINT ;IN-LINE MACROS $-PRINT ; ; MOVE ASCII TO EBCDIC. MOVAE MACRO DST,SRC,LEN LOCAL OVERSUB,LOOP JMP OVERSUB @MVAE: DS 0 MOV A,M ;;GET NEXT BYTE. CALL TRNASEB ;;TRANSLATE TO EBCDIC. STAX DE ;;SAVE IT. INX HL ;;BUMP PTRS. INX DE DCR C ;;DECR COUNT. JNZ @MVAE ;;LOOP FOR ALL CHARACTERS. RET OVERSUB: ; ; MOVE EBCDIC TO ASCII. MOVAE MACRO D,S,L IF NOT NUL D LXI DE,D ;;POINT OT DESTINATION. ENDIF IF NOT NUL S LXI HL,S ;;POINT TO SOURCE. ENDIF IF NOT NUL L LSR C,L ;;GET LENGTH. ENDIF CALL @MVAE ;;DO THE MOVE. ENDM MOVAE DST,SRC,LEN ENDM ; ; PRINT AN EBCIDIC FIELD. PRNTEAF MACRO ?STR,FLD,LNG IF NOT NUL ?STR MVC TBUFF,?STR ;;MOVE IT TO THE BUFFER. ENDIF MOVEA <>,FLD,LNG MVI A,CR ;;ADD CR. STAX DE INX DE MVI A,LF ;;ADD LF. STAX DE INX DE MVI A,'$' ;;ADD EOL MARKER. STAX DE CPM CPB,TBUFF ;;PRINT THE BUFFER. ENDM ; ; MOVE EBCDIC TO ASCII. MOVEA MACRO DST,SRC,LEN LOCAL OVERSUB,LOOP JMP OVERSUB @MVEA: DS 0 MOV A,M ;;GET NEXT BYTE. CALL TRNEBAS ;;TRANSLATE TO ASCII. STAX DE ;;SAVE IT. INX HL ;;BUMP PTRS. INX DE DCR C ;;DECR COUNT. JNZ @MVEA ;;LOOP FOR ALL CHARACTERS. RET OVERSUB: MOVEA MACRO D,S,L IF NOT NUL D LXI DE,D ;;POINT OT DESTINATION. ENDIF IF NOT NUL S LXI HL,S ;;POINT TO SOURCE. ENDIF IF NOT NUL L LSR C,L ;;GET LENGTH. ENDIF CALL @MVEA ;;DO THE MOVE. ENDM MOVEA DST,SRC,LEN ENDM ; ; ; ; ; ; * * * BEGINNING OF PROGRAM * * * ; ORG TPABGN ;ORG TO BEGINNING OF TPA ; ESTABLISH STACK POINTER. LHLD 6 ;GET ADDRESS OF BEGINNING OF CP/M. DCX HL SPHL ;INIT STACK. CPM DRDS ;RESET ALL DISKS. JMP MAINMENU ; ; ; * * SPECIAL BIOS JUMPS * * BIOSSEL: ;SELECT DISK. PUSH H LHLD 1 MVI L,000H+JMPDSP XTHL RET BIOSHOM: ;HOME DISK. PUSH H LHLD 1 MVI L,003H+JMPDSP XTHL RET BIOSSEK: ;SEEK TRACK. PUSH H LHLD 1 MVI L,006H+JMPDSP XTHL RET BIOSRED: ;READ SECTOR. PUSH H LHLD 1 MVI L,009H+JMPDSP XTHL RET BIOSWRT: ;WRITE SECTOR. PUSH H LHLD 1 MVI L,00CH+JMPDSP XTHL RET ; * * MAIN PROGRAM LOOP * * ; ; DISPLAY BASE MENU. MAINMENU: DS 0 $-PRINT PRINT <27,'*',0,0> ;CLEAR SCREEN. PRINT <'* * * 3740 IBM UTILITY * * *',CR,LF> PRINT <'SELECT ONE OF THE FOLLOWING:',CR,LF> PRINT <' 0 - RETURN TO CP/M',CR,LF> PRINT <' 1 - INITIALIZE A DISKETTE',CR,LF> PRINT <' 2 - CHANGE A VOLUME SERIAL NUMBER',CR,LF> PRINT <' 3 - CHANGE A DATASET ENTRY',CR,LF> PRINT <' 4 - DELETE A DATASET ENTRY',CR,LF> PRINT <' 5 - DISPLAY A DATASET ENTRY',CR,LF> PRINT <' 6 - LIST THE DIRECTORY',CR,LF> PRINT <' 7 - TRANSFER CP/M TO 3740 (BLOCK)',CR,LF> PRINT <' 8 - TRANSFER 3740 TO CP/M (BLOCK)',CR,LF> PRINT <' 9 - TRANSFER CP/M TO 3740 (SOURCE)',CR,LF> PRINT <' 10 - TRANSFER 3740 TO CP/M (SOURCE)',CR,LF> PRINT <' 11 - DISPLAY AN IBM DATASET',CR,LF> INPUT 'ENTER CHOICE: ',TBUFF PRINT ; ; ; IF NO INPUT, ISSUE ERROR MSG. LDA TBUFF+1 ;GET INPUT COUNT. CPI 0 ;LENGTH CHECK (1-2) JZ MAINERR ;...ISSUE ERROR. CPI 2+1 JNC MAINERR ; ; ; CONVERT INPUT TO BINARY. DECIN TBUFF+2,TBUFF+1 ;GET INPUT NUMBER. CPI 11+1 ;IF INVALID NUMBER JNC MAINERR ;...ISSUE ERROR MESSAGE. ; ; ; CLEAR THE SCREEN FOR EACH ROUTINES OUTPUT. PUSH PSW ;SAVE OPTION CODE. PRINT <27,'*',0,0> ;ISSUE CLEAR SCREEN. POP PSW ;RESTORE OPTION CODE. ; ; ; CALL THE APPROPRIATE ROUTINE. ; ADD A ;INDEX INTO TABLE. LXI HL,FNCTBL ADDHA ; MOV E,M ;GET ENTRY. INX HL MOV D,M ; LXI HL,MAINMENU ;SET RETURN PTR. PUSH HL ; XCHG ;CALL THE ROUTINE. PCHL ; ; ; ISSUE ERROR MESSAGE AND RE-PRINT MENU. MAINERR: DS 0 PRINT <'***INVALID REPLY***',CR,LF> INPUT 'PRESS TO CONTINUE.',TBUFF JMP MAINMENU ; ; ; ; $+PRINT $-PRINT ; * * * RETURN TO CPM * * * ;PURPOSE ; THIS ROUTINE RETURNS CONTROL TO CP/M ISSUEING ; A WARM START AND DISK RESET. ;INPUT ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. RTNCPM: DS 0 PRINT <'*** RETURN TO CPM ***',CR,LF> PRINT <'PUT MASTER CP/M DISK IN DRIVE A.',CR,LF> INPUT 'PRESS WHEN READY. ',TBUFF CPM DRDS ;RESET ALL DRIVES. JMP CPMEXIT ;COLD START CP/M. ; ; ; ; $+PRINT $+PRINT ; * * * INITIALIZE A DISKETTE * * * ;PURPOSE ; THIS ROUTINE ALLOWS THE USER TO FORMAT A ; DISKETTE TO IBM FORMAT. FIRST, IT BUILDS ; THE DIRECTORY AND THEN BLANKS ALL REMAINING ; RECORDS. ;INPUT ; DISK DRIVE OF DISK TO BE FORMATTED ; VOLUME SERIAL NUMBER FOR THE DISK ;OUTPUT ; FORMATTED DISK ;REMARKS ; ; ; ; DO INITIALIZATION. INITDISK: DS 0 PRINT <'*** INITIALIZE A DISK ***',CR,LF> ; ; ; GET DISK DRIVE. CALL INPDSKNO STA DIRDSK ;SAVE IT. ; ; ; GET VOLUME SERIAL NUMBER. FILL VOLSER,6,' ' INITDIRV: DS 0 INPUT 'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LENGTH. CPI 1 JC $+8 ;...INVALID. CPI 6+1 JC INITDIRG ;...VALID PRINT <'*** INVALID REPLY ***',CR,LF> JMP INITDIRV INITDIRG: DS 0 MVC VOLSER,TBUFF+2,TBUFF+1 ; ; ; WRITE SECTORS (1-4 AND 6) FILL DIRBUF,80,040H FILL DIRBUF+80,48,000H MVI A,1 ;SET SECTOR TO 1. STA DIRSCT DOWHILE DIRSCT,LSS,5 CALL WRTDIR LDA DIRSCT ;BUMP SCTOR NUMBER. INR A STA DIRSCT ENDDO MVI A,6 CALL WRTDIR ; ; ; WRITE SECTOR 5 (ERMAP). MOVAE DIRBUF,CERMAP,5 MVI A,5 CALL WRTDIR ; ; ; WRITE SECTOR 7 (VOL1). MOVAE DIRBUF,CVOL1,4 ;PUT 'VOL1' IN COL 1. MOVAE DIRBUF+4,VOLSER,6 ;PUT VOLSER IN COL 5. MVI A,0E6H ;PUT 'W' IN COL 80. STA DIRBUF+79 MVI A,7 CALL WRTDIR ; ; ; WRITE SECTORS 8-26 (DATA). MVI A,8 STA DIRSCT DOWHILE DIRSCT,LSS,27 CALL DFTDIR LDA DIRSCT CALL WRTDIR LDA DIRSCT INR A STA DIRSCT ENDDO ; ; ; WRITE REMAINING DISK BUFFERS. FILL DATBUF1,80,040H FILL DATBUF1+80,48,000H LDA DIRDSK ;DATA DISK = DIR DSK STA DATDSK1 MVI A,1 ;DATA TRK = 1 STA DATTRK1 ; DOWHILE DATTRK1,LSS,78 MVI A,1 ;DATA SCT = 1 STA DATSCT1 DOWHILE DATSCT1,LSS,27 CALL WRTDAT1 ;WRITE THE BUFFER. LDA DATSCT1 ;BUMP SCTNO BY 1. INR A STA DATSCT1 ENDDO LDA DATTRK1 ;BUMP TRKNO BY 1. INR A STA DATTRK1 ENDDO ; ; ; ISSUE COMPLETION MESSAGE. PRINT <'*** INITIALIZATION IS COMPLETE ***',CR,LF> INPUT 'PRESS TO CONTINUE.',TBUFF ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * * CHANGE A VOLUME SERIAL NUMBER * * * ;PURPOSE ; THIS ROUTINE ALLOWS THE USER TO CHANGE AN IBM ; VOLUME SERIAL NUMBER AS FOUND IN THE 'VOL1' ; SECTOR (00008). ;INPUT ; DISK DRIVE OF IBM DISKETTE ; VOLUME SERIAL NUMBER (OPTIONAL) ;OUTPUT ; THE VOLUME SERIAL NUMBER IS CHANGED IF ENTERED. ;REMARKS ; ; ; ; DO INITIALIZATION. CHGVOL: DS 0 PRINT <'*** CHANGE A VOLUME SERIAL NUMBER ***',CR,LF> ; ; ; GET THE DISK DRIVE AND VERIFY IT. CALL INPDSKNO ;GET IT. STA DIRDSK ;SAVE IT. CALL VERIBMD ;VERIFY IBM DISK. JC CHGVOLE ;...DIDN'T VERFIY, MSG WAS GIVEN. ; ; ; PRINT THE VOLUME SERIAL NUMBER. PRNTEAF 'CURRENT VOLUME SERIAL NUMBER: ',DIRBUF+4,6 MOVEA VOLSER,DIRBUF+4,6 ; ; ; GET VOLUME SERIAL NUMBER. CHGVOLIV: DS 0 PRINT <'(OPTIONALLY) '> INPUT 'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LENGTH. CPI 1 JC CHGVOLIB ;...NO ENTRY, SKIP REPLACE. CPI 6+1 JC CHGVOLIG ;...VALID PRINT <'*** INVALID REPLY ***',CR,LF> JMP CHGVOLIV CHGVOLIG: DS 0 FILL VOLSER,6,020H MVC VOLSER,TBUFF+2,TBUFF+1 CHGVOLIB: DS 0 ; ; ; WRITE THE SECTOR BACK OUT. MOVAE DIRBUF+4,VOLSER,6 ;PUT VOLSER IN BUFFER. MVI A,7 ;WRITE OUT SECTOR 7 (VOL1). CALL WRTDIR ; ; ; RETURN TO CALLER. PRINT <'*** CHANGE IS SUCCESSFUL.***',CR,LF> CHGVOLE: DS 0 INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; ; $+PRINT $-PRINT ; * * * CHANGE A DATASET ENTRY * * * ;PURPOSE ; THIS ROUTINE ACTIVATES A DIRECTORY ENTRY AND/OR ; ALLOWS THE USER TO CHANGE DIRECTORY INFORMATION ; PERTAINING TO THAT DATASET. ;INPUT ; IBM DISKETTE DISK DRIVE ; DIRECTORY SECTOR NUMBER AS GIVEN IN DIRECTORY LIST ;OUTPUT ; THE DIRECTORY ENTRY IS UPDATED. ;REMARKS ; ; ; ; DO INITIALIZATION. CHGDIR: DS 0 PRINT <'*** CHANGE A DATASET ENTRY ***',CR,LF> ; ; ; GET DISK DRIVE. CALL INPDSKNO ;GET IT. STA DIRDSK ;SAVE IT. CALL VERIBMD ;VERIFY IBM DISK. RC ; ; ; GET THE SECTOR NUMBER. CALL INPSCTNO ;GET IT. STA DIRSCT ;SAVE IT. ; ; ; PRINT THE ENTRY. CALL REDDIR ;READ THE ENTRY. CALL PRTDIR ;PRINT IT. ; ; ; PRINT CHANGE MESSAGES. PRINT PRINT <'CHANGE ONLY THE FIELDS THAT YOU WANT UPDATED.',CR,LF> PRINT <'IF YOU DO NOT ENTER ANY DATA, THE FIELD',CR,LF> PRINT <'REMAINS UNCHANGED.',CR,LF> PRINT ; ; ; CHANGE THE FIELDS AND UPDATE THE RECORD. MVI A,0C8H ;INSURE ACTIVE DATASET. STA DSHD CALL INPDIR ;CHANGE THE FIELDS. LDA DIRSCT ;UPDATE THE RECORD. CALL WRTDIR PRINT <'***CHANGE IS SUCCESSFUL.***',CR,LF> ; ; ; RETURN TO CALLER. INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; ; $+PRINT $-PRINT ; * * * DELETE A DATASET ENTRY * * * ;PURPOSE ; THIS FUNCTION ALLOWS THE USER TO DELETE A ; SPECIFIED DIRECTORY ENTRY. THE ENTRY IS MARKED ; AS DELETED AND INITIALIZED TO ITS INITIAL FORMAT ; AS WHEN THE ENTIRE DIRECTORY WAS INITIALIZED. ;INPUT ; IBM DISK DRIVE ; DIRECTORY SECTORY NUMBER ;OUTPUT ; DELETED INITIAL DIRECTORY ENTRY ;REMARKS ; 1. AT THIS POINT, WE HAVE FOUND THAT THE AM2 FIELD ; OF THE RECORD DOES NOT HAVE TO INDICATE DELETED ; RECORD. ; ; ; ; DO INITIALIZATION. DELDIR: DS 0 PRINT <'*** DELETE A DATASET ENTRY ***',CR,LF> ; ; ; GET DISK DRIVE. CALL INPDSKNO ;GET IT. STA DIRDSK ;SAVE IT. CALL VERIBMD ;VERIFY IBM DISK. RC ;...NOT IBM FORMAT!! ; ; ; GET THE SECTOR NUMBER. CALL INPSCTNO ;GET IT. STA DIRSCT ;SAVE IT. ; ; ; DELETE THE ENTRY. LDA DIRSCT ;INITIALIZE THE ENTRY. CALL DFTDIR LDA DIRSCT ;WRITE IT BACK TO DISK. CALL WRTDIR ; ; ; RETURN TO CALLER. PRINT <'***DELETION IS SUCCESSFUL.***',CR,LF> INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; ; $+PRINT $-PRINT ; * * * DISPLAY A DATASET ENTRY * * * ;PURPOSE ; THIS ROUTINE DISPLAYS A SINGLE DIRECTORY ENTRY. ; IT IS PRIMARILY USED TO INSURE THAT AN ENTRY ; WAS CHANGED PROPERLY. ;INPUT ; IBM DISK DRIVE ; DIRECTORY SECTOR NUMBER ;OUTPUT ; DIRECTORY ENTRY IS DISPLAYED ;REMARKS ; ; ; ; DO INITIALIZATION. DSPLDIR: DS 0 PRINT <'*** DISPLAY A DIRECTORY ENTRY ***',CR,LF> ; ; ; GET DISK DRIVE. CALL INPDSKNO ;GET IT. STA DIRDSK ;SAVE IT. CALL VERIBMD ;VERIFY IBM DISK. RC ; ; ; GET THE SECTOR NUMBER. CALL INPSCTNO ;GET IT. STA DIRSCT ;SAVE IT. ; ; ; PRINT THE ENTRY. CALL REDDIR ;READ THE ENTRY. CALL PRTDIR ;PRINT IT. ; ; ; RETURN TO CALLER. INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; ; $+PRINT $-PRINT ; * * * LIST THE DIRECTORY * * * ;PURPOSE ; THIS ROUTINE DISPLAYS THE ENTIRE IBM DISKETTE ; DIRECTORY AND ALL PERTINENT DATA ASSOCIATED ; WITH IT. ;INPUT ; IBM DISK DRIVE ;OUTPUT ; THE DIRECTORY IS DISPLAYED. ;REMARKS ; ; ; ; DO INITIALIZATION. LISTDIR: DS 0 PRINT <'*** LIST THE DIRECTORY ***',CR,LF> ; ; ; GET THE DISK NUMBER. CALL INPDSKNO ;GET IT. STA DIRDSK ;SAVE IT. ; ; ; READ AND VERIFY THE VOLSER. CALL VERIBMD ;VERIFY 'VOL1' ID. JC LISTDIRR ;...BAD VOL1. PRINT <27,'*'> ;CLEAR THE SCREEN. PRNTEAF ' DIRECTORY FOR ',DSHD+4,6 PRINT <' '> PRINT <' M VL B S W V',CR,LF> PRINT <'SCT DATASET D LRECL BOE EOE EOD CREDT'> PRINT <' EXPDT V SQ I S P C',CR,LF> ; ; ; LIST ALL DIRECTORY ENTRIES. MVI C,8 ;SET BEGINNING SECTOR. MOV A,C DOWHILE <>,LSS,27 ;PRINT SECTORS 8-26. CALL LISTDIRE ;LIST THE ENTRY. INR C ;BUMP SECTOR. MOV A,C ;SET FOR DOWHILE. ENDDO ; ; ; RETURN TO CALLER. LISTDIRR: DS 0 INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; $+PRINT $-PRINT ; * * LIST A DIRECORTY ENTRY * * ; ; DO INITIALIZATION. LISTDIRE: DS 0 PUSH BC ;SAVE REGS. ; ; ; READ SECTOR. MOV A,C ;GET SECTOR. CALL REDDIR ;READ IT. ; ; ; BUILD OUTPUT LINE. FILL TBUFF,80,' ' ;MOVE SPACES TO TBUFF. LXI HL,CSCTNO ; SECTOR NUMBER LDA DIRSCT SUI 8 ADD A ADDHA MVC TBUFF,,2 WHEN DIRSCT,EQL,8 MVC TBUFF,'08' ENDW MOVEA TBUFF+3,DSID,8 ; DATASET NAME WHEN DSHD,EQL,0C4H ; **DELETED** MVI A,'D' STA TBUFF+12 ENDW MOVEA TBUFF+14,DSBLK,5 ; LRECL MOVEA TBUFF+20,DSBOE,5 ; BOE MOVEA TBUFF+26,DSEOE,5 ; EOE MOVEA TBUFF+32,DSEOD,5 ; EOD MOVEA TBUFF+38,DSCREDT,6 MOVEA TBUFF+45,DSEXPDT,6 ; EXP DATE MOVEA TBUFF+52,DSMVI,1 ; MULTI-VOL IND MOVEA TBUFF+54,DSVLSQ,2 ; VOL SEQ MOVEA TBUFF+57,DSBYPI,1 ; BYP IND MOVEA TBUFF+59,DSSS,1 ; SECURE IND MOVEA TBUFF+61,DSWP,1 ; WRITE PRO IND MOVEA TBUFF+63,DSVCI,1 ; VERI/COPY IND ; ; ; PRINT THE LINE. MVC TBUFF+72,CEOL,3 PRINT TBUFF,$ ; ; ; RETURN TO CALLER. POP BC ;RESTORE REGS. RET ; ; ; ; ; ; ; ; $+PRINT $-PRINT ; * * * TRANSFER CP/M TO 3740 (BLOCK) * * * ;PURPOSE ; THIS ROUTINE TRANSFERS A DATASET FROM CP/M TO ; IBM FORMAT IN BLOCK MODE. BLOCK MODE ASSUMES ; EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS ; ARE ONE SECTOR. ;INPUT ; CP/M INPUT DRIVE ; IBM OUTPUT DRIVE ; EIGHT-BYTE DATASET NAME ;OUTPUT ; THE FILE IS MOVED TO THE IBM DISKETTE. ;REMARKS ; 1. IT IS ASSUMED THAT THE INPUT FILE NAME ; IS THE EIGHT-BYTE DATASET NAME CONCATENATED ; WITH A FILE TYPE OF 'DAT'. ; 2. IT IS ASSUMED THAT THE IBM FILE HAS BEEN ; PRE-ALLOCATED ON THE DISK WITH ENOUGH SPACE ; DEFINED TO HOLD THE INPUT FILE. ; ; ; ; DO INITIALIZATION. TRSCIBLK: DS 0 PRINT <'*** TRANSFER CP/M TO 3740 (BLOCK) ***',CR,LF> XRA A ;ZERO ERROR COUNT. STA TRSERR ; ; ; GET INPUT AND OPEN FILES. CALL TRSGETIN ;GET INPUT PARMS. MVI A,0 ;OPEN CP/M FOR INPUT. CALL CPMOPEN JC TRSCIBEN ;...UNSUCCESSFUL. MVI A,1 ;OPEN IBM FOR OUTPUT. LXI HL,DATDSK2 CALL IBMOPEN JC TRSCIBEN ; ; ; GET THE BLOCK LENGTH FOR MOVE. MOVEA TBUFF,DSBLK,5 ;GET THE DATASET BLOCK LENGTH. DECIN TBUFF,5 ;CONVERT TO BINARY. XCHG ;GET BINARY BLOCK LENGTH. SHLD BLKLEN ;SAVE IT. ; ; ; GET AN CP/M BLOCK. TRSCIBLP: DS 0 CPM CSTAT ;CHECK FOR SUSPEND. CPM DRINT ;GET CP/M CURRENT DRIVE. SELDSK ;SELECT THE DISK DRIVE. CPM DDMA,DATA1 ;SET FOR CP/M BUFFER. CPM DRR,TRSFCB ;READ THE BLOCK. WHEN <>,NEQ,0 WHEN <>,NEQ,1 PRINT <'*** CP/M READ ERROR ***',CR,LF> BUMP TRSERR ENDW ; ;** EOF REACHED ** JMP TRSCIBOK ;CLOSE FILES. ENDW ; ; ; MOVE BLOCK TO IBM BUFFER. FILL DATA2,128,000H ;MOVE LOW VALUES TO BUFFER. MOVAE DATA2,DATA1,BLKLEN ;MOVE IN THE DATA. ; ; ; IF PAST EOE, ISSUE ERROR. CLC DATTRK2,TDSEOE,2 JC TRSCIBNF JZ TRSCIBNF PRINT <'*** IBM EXTENT FULL ***',CR,LF> BUMP TRSERR JMP TRSCIBOK TRSCIBNF: DS 0 ; ; ; WRITE IBM BLOCK. CALL WRTDAT2 ;WRITE THE BLOCK. ; ; ; BUMP THE IBM TRK/SCT. BUMP DATSCT2 WHEN DATSCT2,GTR,26 MVI A,1 STA DATSCT2 BUMP DATTRK2 ENDW JMP TRSCIBLP ; ; ; CLOSE ALL FILES. TRSCIBOK: DS 0 MVI A,0 ;CP/M FILE. CALL CPMCLOSE MVI A,1 ;IBM FILE. LXI HL,DATTRK2 CALL IBMCLOSE ; ; ; RETURN TO CALLER. TRSCIBEN: DS 0 WHEN TRSERR,EQL,0 PRINT <'*** TRANSFER SUCCESSFUL ***',CR,LF> ENDW WHEN TRSERR,NEQ,0 PRINT <'*** TRANSFER NOT COMPLETED ***',CR,LF> PRINT <'PLEASE DELETE OUTPUT FILE.',CR,LF> ENDW INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; ; $+PRINT $-PRINT ; * * * TRANSFER 3740 TO CP/M (BLOCK) * * * ;PURPOSE ; THIS ROUTINE TRANSFERS A DATASET FROM IBM TO ; CP/M FORMAT IN BLOCK MODE. BLOCK MODE ASSUMES ; EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS ; ARE ONE SECTOR. ;INPUT ; CP/M OUTPUT DRIVE ; IBM INPUT DRIVE ; EIGHT-BYTE DATASET NAME ;OUTPUT ; THE FILE IS MOVED TO THE CP/M DISK. ;REMARKS ; 1. IT IS ASSUMED THAT THE INPUT FILE NAME ; IS THE EIGHT-BYTE DATASET NAME CONCATENATED ; WITH A FILE TYPE OF 'DAT'. ; ; ; ; DO INITIALIZATION. TRSICBLK: DS 0 PRINT <'*** TRANSFER 3740 TO CP/M (BLOCK) ***',CR,LF> XRA A ;ZERO ERROR COUNT. STA TRSERR ; ; ; GET INPUT AND OPEN FILES. CALL TRSGETIN ;GET INPUT PARMS. MVI A,0 ;OPEN IBM FOR INPUT. LXI HL,DATDSK1 CALL IBMOPEN JC TRSICBEN ;...UNSUCCESSFUL. MVI A,1 ;OPEN CP/M FOR OUTPUT. CALL CPMOPEN JC TRSICBEN ; ; ; GET BLOCK LENGTH OF IBM DATASET. MOVEA TBUFF,DSBLK,5 ;GET ASCII BLOCK LENGTH. DECIN TBUFF,5 ;CONVERT IT TO BINARY. XCHG ;SAVE IT. SHLD BLKLEN ; ; ; GET AN IBM BLOCK. TRSICBLP: DS 0 CPM CSTAT ;CHECK FOR SUSPEND. CLC DATTRK1,TDSEOD,2 ;END OF FILE? CMC JC TRSICBOK ;...YES. CALL REDDAT1 ;GET THE BLOCK. ; ; ; MOVE BLOCK TO CP/M BUFFER. FILL DATA2,128,000H ;ZERO OUTPUT BUFFER. MOVEA DATA2,DATA1,BLKLEN MVI A,00DH ;INSERT PAIR FOR CP/M STAX DE INX DE MVI A,00AH STAX DE ; ; ; WRITE CP/M BLOCK. CPM DRINT ;GET CP/M CURRENT DRIVE. SELDSK ;SELECT DISK DRIVE. CPM DDMA,DATA2 CPM DWR,TRSFCB WHEN <>,NEQ,0 ;...WRITE ERROR. PRINT <'*** CP/M WRITE ERROR ***',CR,LF> BUMP TRSERR JMP TRSICBOK ENDW ; ; ; BUMP TO NEXT IBM BLOCK. BUMP DATSCT1 ;BUMP SECTOR BY 1. WHEN DATSCT1,GTR,26 MVI A,1 ;SECTOR = 1 STA DATSCT1 BUMP DATTRK1 ENDW JMP TRSICBLP ; ; ; CLOSE ALL FILES. TRSICBOK: DS 0 MVI A,0 ;IBM FILE. LXI HL,DATTRK1 CALL IBMCLOSE MVI A,1 ;CP/M FILE. CALL CPMCLOSE ; ; ; RETURN TO CALLER. TRSICBEN: DS 0 WHEN TRSERR,EQL,0 PRINT <'*** TRANSFER SUCCESSFUL ***',CR,LF> ENDW WHEN TRSERR,NEQ,0 PRINT <'*** TRANSFER NOT COMPLETED ***',CR,LF> PRINT <'PLEASE DELETE OUTPUT FILE.',CR,LF> ENDW INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; ; $+PRINT $-PRINT ; * * * TRANSFER CP/M TO 3740 (SOURCE) * * * ;PURPOSE ; THIS ROUTINE TRANSFERS A CP/M SOURCE FILE TO AN ; IBM FILE ONE LINE AT A TIME. 'S ARE EX- ; PANDED AS THEY ARE ENCOUNTERED. EOF WILL OCCUR ; WHEN (A) A 01AH IS ENCOUNTERED OR (B) THE PHYSICAL ; EOF IS ENCOUNTERED. NOTE THAT 'S ARE ; NOT TRANSFERRED. ;INPUT ; CP/M DISK DRIVE ; IBM DISK DRIVE ; DATASET NAME ;OUTPUT ; IBM DATASET ;REMARKS ; 1. EACH LINE OF TEXT IS TRANSFERRED AS ONE PHYSICAL ; RECORD ON THE IBM DRIVE. THE IBM BEGINNING-OF-EXTENT ; POINTER INDICATES WHERE THE TRANSFER IS TO BEGIN. ; 2. IT IS ASSUMED THAT THE IBM DATASET HAS BEEN ; PRE-ALLOCATED WITH ENOUGH SPACE TO HOLD THE ; ENTIRE CP/M DATASET. ; ; ; ; DO INITIALIZATION. TRSCISRC: DS 0 PRINT <'*** TRANSFER CP/M TO 3740 (SOURCE) ***',CR,LF> XRA A ;ZERO ERROR COUNT. STA TRSERR ; ; ; GET INPUT AND OPEN FILES. CALL TRSGETIN ;GET INPUT PARMS. MVI A,0 ;OPEN CP/M FOR INPUT. CALL CPMOPEN JC TRSCISEN ;...UNSUCCESSFUL. MVI A,1 ;OPEN IBM FOR OUTPUT. LXI HL,DATDSK2 CALL IBMOPEN JC TRSCISEN CALL TRSCISGT ;GET THE FIRST CP/M BLOCK. JC TRSCISOK ;...**EOF REACHED** ; ; ; GET THE BLOCK LENGTH FOR MOVE. MOVEA TBUFF,DSBLK,5 ;GET THE DATASET BLOCK LENGTH. DECIN TBUFF,5 ;CONVERT TO BINARY. XCHG ;GET BINARY BLOCK LENGTH. SHLD BLKLEN ;SAVE IT. ; ; ; GET THE NEXT LINE OF CP/M TEXT. TRSCISLP: DS 0 CALL TRSCISGL ;GET THE LINE. JC TRSCISOK ;...**EOF REACHED** ; ; ; MOVE BLOCK TO IBM BUFFER. FILL DATA2,128,000H ;MOVE LOW VALUES TO BUFFER. MOVAE DATA2,TBUFF,BLKLEN ;MOVE IN THE DATA. ; ; ; IF PAST EOE, ISSUE ERROR. CLC DATTRK2,TDSEOE,2 JC TRSCISNF JZ TRSCISNF PRINT <'*** IBM EXTENT FULL ***',CR,LF> BUMP TRSERR JMP TRSCISOK TRSCISNF: DS 0 ; ; ; WRITE IBM BLOCK. CALL WRTDAT2 ;WRITE THE BLOCK. ; ; ; BUMP THE IBM TRK/SCT. BUMP DATSCT2 WHEN DATSCT2,GTR,26 MVI A,1 STA DATSCT2 BUMP DATTRK2 ENDW JMP TRSCISLP ; ; ; CLOSE ALL FILES. TRSCISOK: DS 0 MVI A,0 ;CP/M FILE. CALL CPMCLOSE MVI A,1 ;IBM FILE. LXI HL,DATTRK2 CALL IBMCLOSE ; ; ; RETURN TO CALLER. TRSCISEN: DS 0 WHEN TRSERR,EQL,0 PRINT <'*** TRANSFER SUCCESSFUL ***',CR,LF> ENDW WHEN TRSERR,NEQ,0 PRINT <'*** TRANSFER NOT COMPLETED ***',CR,LF> PRINT <'PLEASE DELETE OUTPUT FILE.',CR,LF> ENDW INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; * * GET A LINE OF CP/M TEXT * * TRSCISGL: DS 0 FILL TBUFF,128,' ' ;MOVE SPACES TO BUFFER. LXI DE,TBUFF ;POINT TO BEGINNING OF BUFFER. ; ; ; MOVE THE TEXT TO THE BUFFER. TRSCISGN: DS 0 PUSH DE ;SAVE BUFFER PTR. CALL TRSCISGB ;GET THE NEXT BYTE. POP DE ;RESTORE BUFFER PTR. RC ;...**EOF REACHED** ; ; HANDLE SPECIAL CHARACTERS. WHEN <>,EQL,009H ;**** INX DE ;BUMP OUTPUT PTR. MOV A,E ;ALIGN TO 8 BYTE BOUNDARY. ANI 7 JNZ $-4 JMP TRSCISGN ;GO GET NEXT BYTE. ENDW WHEN <>,EQL,00DH ;** OR ** CALL TRSCISGB ;GET TRAILING . RET ENDW WHEN <>,EQL,00AH ;** OR ** RET ENDW ; ; ADD CHARACTER TO BUFFER. STAX DE INX DE ;BUMP BUFFER PTR. JMP TRSCISGN ; ; ; ; * * GET A BYTE * * TRSCISGB: DS 0 LHLD TRSBUFP ;POINT INTO CP/M BUFFER. LDA TRSBUFA ;GET REMAINING # OF BYTES. WHEN <>,EQL,0 ;...NEED A NEW BLOCK. CALL TRSCISGT ;READ IT. RC ;...**EOF REACHED** ENDW ; ; MOV C,M ;GET THE NEXT BYTE. INX HL ;BUMP BUFFER PTR. DCR A ;DECR BUFFER COUNT. SHLD TRSBUFP ;SAVE BUFFER PTR AND CNT. STA TRSBUFA MOV A,C ; ; WHEN <>,EQL,01AH ;**LOGICAL EOF** STC RET ENDW ORA A ;RESET CY. RET ; ; ; ; * * GET A CP/M BLOCK * * TRSCISGT: DS 0 CPM CSTAT ;CHECK FOR SUSPEND. CPM DRINT ;GET CP/M CURRENT DRIVE. SELDSK ;SELECT THE DISK DRIVE. CPM DDMA,DATA1 ;SET FOR CP/M BUFFER. CPM DRR,TRSFCB ;READ THE BLOCK. WHEN <>,NEQ,0 WHEN <>,NEQ,1 PRINT <'*** CP/M READ ERROR ***',CR,LF> BUMP TRSERR ENDW ; ;** EOF REACHED ** STC ENDW ; SET UP VARIABLES AND RETURN. LXI HL,DATA1 ;CURRENT BUFFER PTR SHLD TRSBUFP MVI A,128 ;# OF BYTES REMAINING STA TRSBUFA RET ; ; ; ; ; ; $+PRINT $-PRINT ; * * * TRANSFER 3740 TO CP/M (SOURCE) * * * ;PURPOSE ; THIS ROUTINE TRANSFERS A IBM DATASET TO A CP/M ; SOURCE FILE ONE LINE AT A TIME. LINES ARE ENDED ; WITH PAIRS AND OUTPUTTED CONTIGUOUSLY. ; INITIALLY, THE OUTPUT BUFFER IS INITIALIZED TO ; 01AH (LOGICAL EOF). THEREFORE, ALL CONSTRAINTS ; FOR A CP/M SOURCE FILE ARE MET. ;INPUT ; CP/M DISK DRIVE ; IBM DISK DRIVE ; DATASET NAME ;OUTPUT ; CP/M DATASET ;REMARKS ; 1. IF THE DATASET WAS PREVIOUSLY CREATED ON THE CP/M ; DRIVE. IT IS DELETED AND RE-ALLOCATED. ; ; ; ; DO INITIALIZATION. TRSICSRC: DS 0 PRINT <'*** TRANSFER 3740 TO CP/M (SOURCE) ***',CR,LF> XRA A ;ZERO ERROR COUNT. STA TRSERR ; ; ; GET INPUT AND OPEN FILES. CALL TRSGETIN ;GET INPUT PARMS. MVI A,0 ;OPEN IBM FOR INPUT. LXI HL,DATDSK1 CALL IBMOPEN JC TRSICSEN ;...UNSUCCESSFUL. MVI A,1 ;OPEN CP/M FOR OUTPUT. CALL CPMOPEN JC TRSICSEN CALL TRSICSIN ;INITIALIZE OUTPUT BUFFER. ; ; ; GET BLOCK LENGTH OF IBM DATASET. MOVEA TBUFF,DSBLK,5 ;GET ASCII BLOCK LENGTH. DECIN TBUFF,5 ;CONVERT IT TO BINARY. XCHG ;SAVE IT. SHLD BLKLEN ; ; ; GET AN IBM BLOCK. TRSICSLP: DS 0 CPM CSTAT ;CHECK FOR SUSPEND. CLC DATTRK1,TDSEOD,2 ;END OF FILE? CMC JC TRSICSOK ;...YES. CALL REDDAT1 ;GET THE BLOCK. ; ; ; MOVE BLOCK TO CP/M BUFFER. MOVEA TBUFF,DATA1,BLKLEN LXI HL,TBUFF ;POINT TO BUFFER. LDA BLKLEN ;PUT BLKLEN IN REMAINING COUNT. STA TWRKC3 ; DOWHILE TWRKC3,NEQ,0 ;** LOOP FOR FULL BUFFER ** MOV A,M ;GET THE NEXT BYTE. INX HL ;BUMP PTR. PUSH HL ;SAVE IT. CALL TRSICSPB ;ADD THE BYTE. POP HL JC TRSICSOK ;...** WRITE ERROR ** BUMP TWRKC3,-1 ;DECR REMAINING COUNT. ENDDO ; MVI A,00DH ;ADD TRAILING . CALL TRSICSPB MVI A,00AH CALL TRSICSPB ; ; ; BUMP TO NEXT IBM BLOCK. BUMP DATSCT1 ;BUMP SECTOR BY 1. WHEN DATSCT1,GTR,26 MVI A,1 ;SECTOR = 1 STA DATSCT1 BUMP DATTRK1 ENDW JMP TRSICSLP ; ; ; CLOSE ALL FILES. TRSICSOK: DS 0 CALL TRSICSPT ;PUT THE LAST BLOCK. MVI A,0 ;IBM FILE. LXI HL,DATTRK1 CALL IBMCLOSE MVI A,1 ;CP/M FILE. CALL CPMCLOSE ; ; ; RETURN TO CALLER. TRSICSEN: DS 0 WHEN TRSERR,EQL,0 PRINT <'*** TRANSFER SUCCESSFUL ***',CR,LF> ENDW WHEN TRSERR,NEQ,0 PRINT <'*** TRANSFER NOT COMPLETED ***',CR,LF> PRINT <'PLEASE DELETE OUTPUT FILE.',CR,LF> ENDW INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; * * PUT A BYTE TO CP/M FILE * * ; ; PUT BYTE IN BUFFER. TRSICSPB: DS 0 LHLD TRSBUFP ;GET BUFFER POINTER. MOV M,A ;ADD THE BYTE. INX HL ;BUMP BUFFER PTR. SHLD TRSBUFP ;SAVE IT. ; ; IF FULL BUFFER, WRITE IT OUT. BUMP TRSBUFA,-1 ;DECR REMAINING BYTE CNT. WHEN TRSBUFA,EQL,0 ;** FULL BUFFER ** CALL TRSICSPT ;ADD THE RECORD. RC ;...** WRITE ERROR ** CALL TRSICSIN ;INITIALIZE BUFFER. ENDW ; ; RETURN TO CALLER. ORA A RET ; ; ; * * WRITE CP/M BLOCK * * ; TRSICSPT: DS 0 CPM DRINT ;GET CP/M CURRENT DRIVE. SELDSK ;SELECT DISK DRIVE. CPM DDMA,DATA2 CPM DWR,TRSFCB WHEN <>,NEQ,0 ;...WRITE ERROR. PRINT <'*** CP/M WRITE ERROR ***',CR,LF> BUMP TRSERR STC ;INDICATE ERROR. RET ENDW ORA A RET ; ; ; * * INITIALIZE OUTPUT BUFFER * * TRSICSIN: DS 0 FILL DATA2,128,01AH ;INITIALIZE BUFFER TO LOGICAL EOF. LXI HL,DATA2 ;RESET BUFFER PTR. SHLD TRSBUFP MVI A,128 ;RESET REMAINING BYTE COUNT. STA TRSBUFA RET ; ; ; ; $+PRINT $-PRINT ; * * * DISPLAY AN IBM DATASET * * * ;PURPOSE ; THIS ROUTINE DISPLAYS THE CONTENTS OF A PARTICULAR ; IBM DATASET TO THE USER. NOTE THAT ALL RECORDS ; ARE DISPLAYED. ;INPUT ; IBM DISK DRIVE ; IBM EIGHT-BYTE DATASET NAME ;OUTPUT ; THE CONTENTS OF THE FILE ARE LISTED ON THE SCREEN. ;REMARKS ; ; ; ; DO INITIALIZATION. DSPIBMDS: DS 0 PRINT <'*** DISPLAY AN IBM DATASET ***',CR,LF> XRA A ;ZERO ERROR COUNT. STA TRSERR ; ; ; GET IBM DISK DRIVE. PRINT <'(IBM) '> CALL INPDSKNO ;GET IT. STA IBMDSKNO ;SAVE IT. ; ; ; GET DATASET NAME. DSPIBMDD: DS 0 INPUT 'ENTER DATASET NAME (1-8 CHARS): ',TBUFF PRINT LDA TBUFF+1 ;CHECK FOR 1-8 CHARS. CPI 1 JC DSPIBMDB CPI 8+1 JC DSPIBMDG DSPIBMDB: DS 0 PRINT <'*** INVALID REPLY ***',CR,LF> JMP DSPIBMDD DSPIBMDG: DS 0 FILL TDSN,8,020H ;INITIALIZE DATASET NAME. MVC TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN. ; ; ; GET INPUT FILE. MVI A,0 ;OPEN IBM FOR INPUT. LXI HL,DATDSK1 CALL IBMOPEN JC DSPIBMD1 ;...UNSUCCESSFUL. ; ; ; GET BLOCK LENGTH OF IBM DATASET. MOVEA TBUFF,DSBLK,5 ;GET ASCII BLOCK LENGTH. DECIN TBUFF,5 ;CONVERT IT TO BINARY. XCHG ;SAVE IT. SHLD BLKLEN ; ; ; GET AN IBM BLOCK. DSPIBMDL: DS 0 CPM CSTAT ;CHECK FOR SUSPEND. CLC DATTRK1,TDSEOD,2 ;END OF FILE? CMC JC DSPIBMD2 ;...YES. CALL REDDAT1 ;GET THE BLOCK. ; ; ; PRINT 80 CHARS OF INFO. MVI C,80 ;SET COUNTER. LXI HL,DATA1 ;POINT TO DATA. DSPIBMRL: DS 0 MOV A,M ;GET A CHAR. CALL TRNEBAS ;TRANSLATE IT TO ASCII. CALL OUTTRN ;REMOVE NON-PRINTABLE CHARS. PUSH BC ;SAVE REGS. CPM CWRITE,,?? ;PUT THE CHAR. POP BC ;RESTORE REGS. INX HL ;BUMP CHAR PTR. DCR C ;LOOP FOR ALL CHARS. JNZ DSPIBMRL ; ; ; BUMP TO NEXT IBM BLOCK. BUMP DATSCT1 ;BUMP SECTOR BY 1. WHEN DATSCT1,GTR,26 MVI A,1 ;SECTOR = 1 STA DATSCT1 BUMP DATTRK1 ENDW JMP DSPIBMDL ; ; ; CLOSE ALL FILES. DSPIBMD2: DS 0 MVI A,0 ;IBM FILE. LXI HL,DATTRK1 CALL IBMCLOSE ; ; ; RETURN TO CALLER. DSPIBMD1: DS 0 WHEN TRSERR,EQL,0 PRINT <'*** DISPLAY SUCCESSFUL ***',CR,LF> ENDW WHEN TRSERR,NEQ,0 PRINT <'*** ERROR DURING DISPLAY ***',CR,LF> ENDW INPUT 'PRESS TO CONTINUE.',TBUFF RET ; ; ; ; $+PRINT $-PRINT ; * * * GET TRANSFER INPUT * * * ;PURPOSE ; THIS ROUTINE QUIRIES THE OPERATOR FOR THE ; CP/M DRIVE, IBM DRIVE AND EIGHT-BYTE DATASET ; NAME TO BE USED IN THE TRANSFERS. ;INPUT ; CP/M DISK DRIVE ; IBM DISK DRIVE ; EIGHT BYTE DATASET NAME ;OUTPUT ; CPMDSKNO CONTAINS THE CP/M DISK DRIVE. ; IBMDSKNO CONTAINS THE IBM DISK DRIVE. ; TDSN CONTAINS THE EIGHT-BYTE DATASET NAME. ;REMARKS ; ; ; ; DO INITIALIZATION. TRSGETIN: DS 0 ; ; ; GET CP/M DISK DRIVE. TRSGETCD: DS 0 PRINT <'(CP/M) '> CALL INPDSKNO ;GET IT. STA CPMDSKNO ;SAVE IT. ; ; ; GET IBM DISK DRIVE. PRINT <'(IBM) '> CALL INPDSKNO ;GET IT. STA IBMDSKNO ;SAVE IT. ; ; ; INSURE IBM DRIVE IS SEPERATE FROM CP/M DRIVE. WHEN IBMDSKNO,EQL,CPMDSKNO PRINT <'*** IBM AND CP/M DRIVES MUST BE DIFFERENT. ***',CR,LF> PRINT <'*** PLEASE RE-ENTER. ***',CR,LF> JMP TRSGETCD ENDW ; ; ; GET DATASET NAME. TRSGETD: DS 0 INPUT 'ENTER DATASET NAME (1-8 CHARS): ',TBUFF PRINT LDA TBUFF+1 ;CHECK FOR 1-8 CHARS. CPI 1 JC TRSGETDB CPI 8+1 JC TRSGETDG TRSGETDB: DS 0 PRINT <'*** INVALID REPLY ***',CR,LF> JMP TRSGETD TRSGETDG: DS 0 FILL TDSN,8,020H ;INITIALIZE DATASET NAME. MVC TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN. ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * * OPEN A CP/M FILE * * * ;PURPOSE ; THIS ROUTINE OPENS THE CP/M INPUT/OUTPUT ; FILE WITH THE APPROPRIATE HOUSEKEEPING. ;INPUT ; A=0 (OPEN INPUT) ; A=1 (OPEN OUTPUT) ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. CPMOPEN: DS 0 SAVE PUSH PSW ;SAVE INPUT/OUTPUT INDICATOR. ; ; ; SELECT THE DISK DRIVE. CPM DRINT ;GET CP/M CURRENT DRIVE. SELDSK ;COORDINATE BIOS. CPM DDMA,TBUFF ;SET DMA TO DEFAULT BUFFER. CPM DSD,,CPMDSKNO ;ISSUE LOGIN FOR DISK. ; ; ; SET UP CP/M FCB. FILL TRSFCB,33,000H MVC TRSFCB+FCBFN,TDSN,8 MVC TRSFCB+FCBFT,'DAT' ; ; ; IF OUTPUT, CREATE FILE. POP PSW WHEN <>,EQL,1 CPM DDF,TRSFCB ;DELETE IT FIRST. CPM DCRF,TRSFCB ;CREATE IT. WHEN <>,EQL,255 ;...UNSUCCESSFUL. PRINT <'*** CP/M OUTPUT FILE DIRECTORY FULL ***',CR,LF> BUMP TRSERR ENDW ENDW ; ; ; OPEN THE FILE. CPM DOF,TRSFCB ;ISSUE OPEN. WHEN <>,EQL,255 ;...UNSUCCESSFUL. PRINT <'*** CP/M FILE OPEN FAILURE ***',CR,LF> BUMP TRSERR ENDW ; ; ; RETURN TO CALLER. RESTORE ORA A ;RESET CY. WHEN TRSERR,NEQ,0 ;IF ERROR, CY:ON. STC ENDW RET ; ; ; ; $+PRINT $-PRINT ; * * * CLOSE A CP/M FILE * * * ;PURPOSE ; THIS ROUTINE CLOSES A CP/M FILE WITH THE ; APPROPRIATE HOUSEKEEPING. ;INPUT ; A=0 (CLOSE INPUT) ; A=1 (CLOSE OUTPUT) ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. CPMCLOSE: DS 0 SAVE ;SAVE REGS. ; ; ; SELECT THE DISK DRIVE. CPM DRINT ;GET CP/M CURRENT DRIVE. SELDSK ;COORDINATE BIOS. CPM DDMA,TBUFF ;SET DMA FOR DEFAULT BUFFER. ; ; ; CLOSE THE FILE. CPM DCF,TRSFCB ;ISSUE CLOSE. WHEN <>,EQL,255 ;...UNSUCCESSFUL. PRINT <'*** CP/M CLOSE FAILURE ***',CR,LF> BUMP TRSERR ENDW ; ; ; RETURN TO CALLER. RESTORE ;RESTORE REGS. ORA A ;RESET CY. WHEN TRSERR,NEQ,0 ;IF ERROR, CY:ON. STC ENDW RET ; ; ; ; $+PRINT $-PRINT ; * * * CLOSE AN IBM FILE * * * ;PURPOSE ; THIS ROUTINE OPENS AN IBM FILE WITH THE ; APPROPRIATE HOUSEKEEPING. ;INPUT ; A = 0 - INPUT FILE ; 1 - OUTPUT FILE ; HL => INTERNAL DATA SECTOR ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. IBMCLOSE: DS 0 SAVE ;SAVE REGS. WHEN <>,NEQ,1 ;SKIP IF NOT OUTPUT. JMP IBMCLSEN ENDW ; ; ; DSEOD = DATA TRK/SCT MOV D,M ;GET TRK. INX HL MOV E,M ;GET SCT. LXI HL,TBUFF ;CONVERT TO EXTERNAL. CALL OUTTRSAD MOVAE DSEOD,TBUFF,5 ;CONVERT TO EBCDIC. ; ; ; REWRITE THE DIRECTORY ENTRY. LDA DIRSCT ;GET THE SECTOR. CALL WRTDIR ;WRITE IT OUT. ; ; ; RETURN TO CALLER. IBMCLSEN: DS 0 RESTORE ;RESTORE REGS. ORA A ;RESET CY. WHEN TRSERR,NEQ,0 ;IF ERROR, CY:ON. STC ENDW RET ; ; ; ; $+PRINT $-PRINT ; * * * OPEN AN IBM FILE * * * ;PURPOSE ; THIS ROUTINE OPENS AN IBM FILE WITH ; THE APPROPRIATE HOUSEKEEPING. ;INPUT ; A=0 (OPEN INPUT) ; A=1 (OPEN OUTPUT) ; HL <= TRK/SCT AREA (2 BYTES) ;OUTPUT ; TRK/SCT AREA = DSEOD ;REMARKS ; ; ; ; DO INITIALIZATION. IBMOPEN: DS 0 SAVE ;SAVE REGS. ; ; ; GET IBM DISK DRIVE. LDA IBMDSKNO ;DIRDSK. MOV M,A ;SAVE IN DATA AREA. INX HL PUSH HL STA DIRDSK ; ; ; SCAN IBM DISK DRIVE FOR DATASET. MVI A,8 ;SET FOR FIRST DIR ENTRY. STA DIRSCT DOWHILE DIRSCT,LEQ,26 CALL REDDIR ;READ THE DIRECTORY. MOVEA TBUFF,DSID,8 ;COMPARE DATASET NAMES. CLC TBUFF,TDSN,8 JZ IBMOPNFD ;...FOUND IT. BUMP DIRSCT ENDDO PRINT <'*** IBM DATASET NOT FOUND ***',CR,LF> BUMP TRSERR POP PSW JMP IBMOPNEN IBMOPNFD: DS 0 ; ; ; GET BEGINNING OF EXTENT. MOVEA TBUFF,DSBOE,5 LXI HL,TBUFF ;CONVERT TO BINARY. CALL VERTRSAD JNC IBMOPNGB PRINT <'*** IBM BAD BOE FOUND ***',CR,LF> BUMP TRSERR IBMOPNGB: DS 0 MOV A,H ;SAVE IT. MOV H,L MOV L,A SHLD TDSBOE ; ; ; GET END OF EXTENT. MOVEA TBUFF,DSEOE,5 LXI HL,TBUFF ;CONVERT TO BINARY. CALL VERTRSAD JNC IBMOPNGE PRINT <'*** IBM BAD EOE FOUND ***',CR,LF> BUMP TRSERR IBMOPNGE: DS 0 MOV A,H ;SAVE IT. MOV H,L MOV L,A SHLD TDSEOE ; ; ; GET END OF DATA. MOVEA TBUFF,DSEOD,5 LXI HL,TBUFF ;CONVERT TO BINARY. CALL VERTRSAD JNC IBMOPNGD PRINT <'*** IBM BAD EOD FOUND ***',CR,LF> BUMP TRSERR IBMOPNGD: DS 0 MOV A,H ;SAVE IT. MOV H,L MOV L,A SHLD TDSEOD ; ; ; DATA TRK/SCT = BOE POP HL XCHG MVC <>,TDSBOE,2 ; ; ; RETURN TO CALLER. IBMOPNEN: DS 0 RESTORE ;RESTORE REGS. ORA A ;RESET CY. WHEN TRSERR,NEQ,0 ;IF ERROR, CY:ON. STC ENDW RET ; ; ; ; $+PRINT $-PRINT ; * * INPUT DISK DRIVE NUMBER * * ;PURPOSE THIS ROUTINE INPUTS A DISK DRIVE NUMBER ; AND VERIFIES IT. ;INPUT NONE ;OUTPUT A = DRIVE NO (0-3) ; ; ; DO INITIALIZATION. INPDSKNO: DS 0 SAVE BC,DE,HL ; ; REQUEST DRIVE NO. INPDSKL: DS 0 INPUT 'ENTER DISK DRIVE (A-D): ',TBUFF PRINT ; ; VERIFY INPUT. LDA TBUFF+1 ;IF INPUT LEN <>1 THEN ERR. CPI 1 JNZ INPDSKER LDA TBUFF+2 ;VERIFY A-D. CPI 'A' JC INPDSKER CPI 'D'+1 JNC INPDSKER ; ; RETURN TO CALLER WITH ANSWER. SUI 'A' ;MAKE RELATIVE TO ZERO. RESTORE HL,DE,BC RET ; ; ERROR - RETRY. INPDSKER: DS 0 PRINT <'***INVALID REPLY***',CR,LF> JMP INPDSKL ; ; ; ; $+PRINT $-PRINT ; * * INPUT DIRECTORY ENTRY * * ;PURPOSE ;INPUT ;OUTPUT ;REMARKS ; 1. INSURE THAT THE FIELDS ARE ENTERED IN THE SAME ; SEQUENCE AS THE FIELDS ARE PRINTED IN 'PRTDIR'. ; ; ; ; DO INITIALIZATION. INPDIR: DS 0 SAVE ;SAVE REGS. ; ; ; ENTER DATSET ID. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER DATASET ID: ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LEN (1-8). CPI 1 JC INPIDB CPI 8+1 JNC INPERR FILL DSID,8,040H ;MOVE SPACES TO FIELD. MOVAE DSID,TBUFF+2,TBUFF+1 INPIDB: POP HL ;RESET STACK FOR NEXT INP. ; ; ; ENTER LOGICAL RECORD LENGTH. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER LOGICAL RECORD LENGTH (NNNNN): ',TBUFF PRINT LDA TBUFF+1 ;CHECK FOR PROPER LENGTH. ORA A ;...SKIP IF NO ENTRY. JZ INPLRC CPI 5 JNZ INPERR ;...INVALID DECIN TBUFF+2,5 ;CONVERT TO INTERNAL FORMAT. JC INPERR ;...INVALID MOV A,E ;GET VALUE. CPI 1 ;RANGE CHECK (1-128). JC INPERR CPI 128+1 JNC INPERR MOVAE DSBLK,TBUFF+2,5 ;MOVE IT TO DIR BUFFER. INPLRC: POP HL ;RESET STACK FOR NEXT INPUT. ; ; ; ENTER BEGINNING OF EXTENT. LXI HL,$ ;SET FOR ERROR. PUSH HL PRINT <'(BEGINNING OF EXTENT) '> CALL INPTRSAD ;GET TT0SS FOR BOE. JC INPERR ;...INVALID INPUT. LDA TBUFF+1 ;CHECK IF INPUT GIVEN. ORA A JZ INPBOE MOVAE DSBOE,TBUFF+2,5 ;MOVE IT IN PLACE. INPBOE: POP HL ; ; ; ENTER END OF EXTENT. LXI HL,$ ;SET FOR ERROR. PUSH HL PRINT <'(END OF EXTENT) '> CALL INPTRSAD ;GET TT0SS FOR BOE. JC INPERR ;...INVALID INPUT. LDA TBUFF+1 ;CHECK IF INPUT GIVEN. ORA A JZ INPEOE MOVAE DSEOE,TBUFF+2,5 ;MOVE IT IN PLACE. INPEOE: POP HL ; ; ; ENTER END OF DATA. LXI HL,$ ;SET FOR ERROR. PUSH HL PRINT <'(END OF DATA) '> CALL INPTRSAD ;GET TT0SS FOR BOE. JC INPERR ;...INVALID INPUT. LDA TBUFF+1 ;CHECK IF INPUT GIVEN. ORA A JZ INPEOD MOVAE DSEOD,TBUFF+2,5 ;MOVE IT IN PLACE. INPEOD: POP HL ; ; ; ENTER CREATION DATE. ; ; ; ENTER EXPIRATION DATE. ; ; ; ENTER MULTI-VOLUME IND. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER MULTI-VOLUME IND (C, L, OR BLANK): ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LEN (1-8). CPI 1 JC INPMVIB JNZ INPERR LDA TBUFF+2 ;GET CHAR INPUTTED. CPI 'C' ;MUST BE C, L, OR BLANK. JZ $+13 CPI 'L' JZ $+8 CPI ' ' JNZ INPERR CALL TRNASEB ;MAKE IT EBCDIC. STA DSMVI ;SAVE IT. INPMVIB: POP HL ;RESET STACK FOR NEXT INP. ; ; ; ENTER VOLUME SEQUENCE NUMBER. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER VOLUME SEQUENCE NUMBER (NN): ',TBUFF PRINT LDA TBUFF+1 ;CHECK FOR PROPER LENGTH. ORA A ;...SKIP IF NO ENTRY. JZ INPVLS CPI 2 JNZ INPERR ;...INVALID DECIN TBUFF+2,2 ;CONVERT TO INTERNAL FORMAT. JC INPERR ;...INVALID MOV A,E ;GET VALUE. CPI 1 ;RANGE CHECK (1-99). JC INPERR CPI 99+1 JNC INPERR MOVAE DSVLSQ,TBUFF+2,2 ;MOVE IT TO DIR BUFFER. INPVLS: POP HL ;RESET STACK FOR NEXT INPUT. ; ; ; ENTER BYPASS IND. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER BYPASS IND (B OR BLANK): ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LEN (1-8). CPI 1 JC INPBYPIB JNZ INPERR LDA TBUFF+2 CPI 'B' JZ $+8 CPI ' ' JNZ INPERR CALL TRNASEB ;MAKE IT EBCDIC. STA DSBYPI ;SAVE IT. INPBYPIB: POP HL ;RESET STACK FOR NEXT INP. ; ; ; ENTER SECURITY IND. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER SECURITY IND (NON-BLANK OR BLANK): ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LEN (1-8). CPI 1 JC INPSSP JNZ INPERR LDA TBUFF+2 CALL TRNASEB ;MAKE IT EBCDIC. STA DSSS ;SAVE IT. INPSSP: POP HL ;RESET STACK FOR NEXT INP. ; ; ; ENTER WRITE PROTECT IND. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER WRITE PROTECT IND (P OR BLANK): ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LEN (1-8). CPI 1 JC INPWPB JNZ INPERR LDA TBUFF+2 CPI 'P' JZ $+8 CPI ' ' JNZ INPERR CALL TRNASEB ;MAKE IT EBCDIC. STA DSWP ;SAVE IT. INPWPB: POP HL ;RESET STACK FOR NEXT INP. ; ; ; ENTER VERIFY/COPY IND. LXI HL,$ ;SET FOR ERROR. PUSH HL INPUT 'ENTER VERIFY/COPY IND (C, V, OR BLANK): ',TBUFF PRINT LDA TBUFF+1 ;VERIFY LEN (1-8). CPI 1 JC INPVCIB JNZ INPERR LDA TBUFF+2 CPI 'C' JZ $+13 CPI 'V' JZ $+8 CPI ' ' JNZ INPERR CALL TRNASEB ;MAKE IT EBCDIC. STA DSVCI ;SAVE IT. INPVCIB: POP HL ;RESET STACK FOR NEXT INP. ; ; ; RETURN TO CALLER. RESTORE RET ; ; ; ISSUE ERROR MESSAGE. INPERR: DS 0 PRINT <'***INVALID REPLY***',CR,LF> RET ; ; ; ; $+PRINT $-PRINT ; * * INPUT SECTOR NUMBER * * ;PURPOSE THIS ROUTINE INPUTS A SECTOR NUMBER ; AND VERIFIES IT. ;INPUT NONE ;OUTPUT ; A = SECTOR NUMBER (8-26) ; ; ; DO INITIALIZATION. INPSCTNO: DS 0 SAVE BC,DE,HL ; ; REQUEST SECTOR NO. INPSCTL: DS 0 INPUT 'ENTER SECTOR NUMBER (8-26): ',TBUFF PRINT ; ; VERIFY INPUT. LDA TBUFF+1 ;IF INPUT LEN <1 THEN ERR. CPI 1 JC INPSCTER CPI 2+1 ;IF INPUT LEN > 2, THEN ERR. JNC INPSCTER DECIN TBUFF+2,TBUFF+1 JC INPSCTER ;...CONVERSION ERROR. MOV A,E CPI 8 ;IF <8 THEN JC INPSCTER ; ERROR. CPI 26+1 ;IF >26 THEN JNC INPSCTER ;...ERROR. ; ; RETURN TO CALLER WITH ANSWER. RESTORE HL,DE,BC RET ; ; ERROR - RETRY. INPSCTER: DS 0 PRINT <'***INVALID REPLY***',CR,LF> JMP INPSCTL ; ; ; ; $+PRINT $-PRINT ; * * INPUT TRACK/SECTOR NUMBER * * ;PURPOSE ;INPUT ;OUTPUT ; H = TRACK NUMBER ; L = SECTOR NUMBER ;REMARKS ; ; ; ; DO INITIALIZATION. INPTRSAD: DS 0 ; ; ; GET THE DATA TRACK/SECTOR. INPTRSL: DS 0 INPUT 'ENTER TRACK/SECTOR (TT0SS): ',TBUFF PRINT ; ; ; VERIFY AND CONVERT INPUT. LDA TBUFF+1 ;IF INPUT LENGTH <> 5, THEN ERROR. ORA A ;CHECK FOR INPUT GIVEN OR NOT. JZ INPTRSOK ;...NO. CPI 5 JNZ INPTRSER ; LXI HL,TBUFF+2 ;VERIFY CONTENTS. CALL VERTRSAD JC INPTRSER ;...INVALID. ; ; ; RETURN TO CALLER. INPTRSOK: DS 0 ORA A ;RESET CARRY. RET ; ; ; HANDLE INPUT ERROR. INPTRSER: DS 0 STC ;SET CARRY. RET ; ; ; $+PRINT $-PRINT ; * * OUTPUT DATA TRACK/SECTOR * * ;PURPOSE ;INPUT ; D = TRACK NUMBER ; E = SECTOR NUMBER ; HL <= 5 BYTE TRACK/SECTOR (TT0SS) ;OUTPUT ; SAME AS INPUT ;REMARKS ; ; ; DO INITIALIZATION. OUTTRSAD: DS 0 SAVE ;SAVE REGS. ; ; ; OUTPUT THE TRACK. MOV A,D ;SET FOR CALL. . CALL OUTTRSSB ;DO IT. ; ; ; OUTPUT THE '0'. MVI M,'0' INX HL ; ; ; OUTPUT THE SECTOR. MOV A,E ;SET FOR CALL CALL OUTTRSSB ;DO IT. ; ; ; RETURN TO CALLER. RESTORE ;RESTORE REGS. RET ; ; ; OUTPUT A TRACK/SECTOR ADDRESS. OUTTRSSB: DS 0 PUSH DE ;SAVE TRK/SCT. PUSH HL ;SAVE OUTPUT PTR. BAU8 TWRKC3 ;CONVERT TO ASCII. POP HL ;RESTORE OUTPUT PTR. XCHG ;DE <= OUTPUT MVC <>,TWRKC3+1,2 ;GET TRK/SCT. XCHG POP DE ;RESTORE TRK/SCT. RET ; ; ; ; $+PRINT $-PRINT ; * * VERIFY DATA TRACK/SECTOR * * ;PURPOSE ;INPUT ; HL <= 5 BYTE TRACK/SECTOR (TT0SS) ;OUTPUT ; H = TRACK NUMBER ; L = SECTOR NUMBER ;REMARKS ; ; ; DO INITIALIZATION. VERTRSAD: DS 0 ; ; ; VERIFY THE TRACK. DECIN ,2 ;CONVERT IT TO DECIMAL. JC VERTRSER ;...INVALID. CPI 1 ;RANGE CHECK (1-74) JC VERTRSER CPI 74+1 CMC JC VERTRSER STA VERTRSTK ;SAVE IT. ; ; ; VERIFY THE SECTOR NUMBER. DECIN ,3 ;CONVERT IT TO DECIMAL. JC VERTRSER ;...INVALID. CPI 1 ;RANGE CHECK (1-26). JC VERTRSER CPI 26+1 CMC JC VERTRSER ; ; ; RETURN TO CALLER. LDA VERTRSTK ;PUT TRACK NUMBER IN H. MOV D,A XCHG ;HL = TRK/SCT ORA A ;RESET CARRY. RET ; ; ; HANDLE ERROR. VERTRSER: DS 0 RET ; ; ; CONSTANTS AND VARIABLES. VERTRSTK: DS 1 ;TRACK NUMBER SAVE AREA ; ; ; $+PRINT $-PRINT ; * * VERIFY IBM DISK * * ;PURPOSE ;INPUT ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. VERIBMD: DS 0 SAVE ;SAVE REGS. ; ; ; READ THE VOLSER SECTOR. MVI A,7 ;READ SECTOR 7. CALL REDDIR ; ; ; VERIFY 'VOL1' ID. MOVEA TBUFF,DSHD,4 ;VERIFY VOL1 CONSTANT. CLC TBUFF,CVOL1,4 JZ VERIBMDE ;...OK. PRINT <'*** DISK VOLUME SERIAL NUMBER NOT FOUND ***',CR,LF> STC ;...ERROR. ; ; ; RETURN TO CALLER. VERIBMDE: DS 0 RESTORE RET ; ; ; ; $+PRINT $-PRINT ; * * VERIFY SECTOR NUMBER * * ;PURPOSE ;INPUT ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. VERPTR: DS 0 ; ; ; RIGHT JUSTIFY INPUT. FILL PTRIN,5,'0' ;DEFAULT TO ALL ZEROES. LDA TBUFF+1 ;GET INPUT LENGTH. CPI 1 ;VERFIY LENGTH IS 1-5. JC PTRNONE CPI 5+1 CMC RC MOV C,A ;SAVE IT. LXI DE,PTRIN+4 ;MOVE DESCENDING. LXI HL,TBUFF+2 ADDHA DCX HL MOV A,M ;DO THE MOVE. STAX DE DCX HL DCX DE DCR C JNZ $-5 ; ; ; VERIFY THE TRACK. DECIN PTRIN,2 RC ;...ERROR. MOV A,E CPI 76+1 CMC RC ;...ERROR. ; ; ; VERIFY '0'. LDA PTRIN+2 CPI '0' STC RNZ ; ; ; VERIFY SECTOR AND RETURN. DECIN PTRIN+3,2 RC ;...ERROR. MOV A,E CPI 1 ;RANGE CHECK 1-26. RC CPI 26+1 CMC RET ; ; ; RETURN W/O VERIFY. PTRNONE: DS 0 MVI A,1 ;RESET CY BUT KEEP NZ. ORA A RET ; ; ; AREAS USED PTRIN: DS 5 ;TRK/SCT PTR ; ; ; ; $+PRINT $-PRINT ; * * PRINT DIRECTORY ENTRY * * ;PURPOSE ;INPUT ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. PRTDIR: DS 0 SAVE ;SAVE REGS. ; ; ; PRINT FIELDS. PRNTEAF 'DATASET NAME = ',DSID,8 WHEN DSHD,EQL,0C4H PRINT <' * * * DELETED * * *',CR,LF> ENDW PRNTEAF 'LRECL = ',DSBLK,5 PRNTEAF 'BOE = ',DSBOE,5 PRNTEAF 'EOE = ',DSEOE,5 PRNTEAF 'EOD = ',DSEOD,5 PRNTEAF 'CREDT = ',DSCREDT,6 PRNTEAF 'EXPDT = ',DSEXPDT,6 PRNTEAF 'MULTI-VOLUME IND = ',DSMVI,1 PRNTEAF 'VOL SEQ IND = ',DSVLSQ,2 PRNTEAF 'BYPASS IND = ',DSBYPI,1 PRNTEAF 'SECURE IND = ',DSSS,1 PRNTEAF 'WRITE PROTECT IND = ',DSWP,1 PRNTEAF 'VERIFY/COPY IND = ',DSVCI,1 ; ; ; RETURN TO CALLER. RESTORE ;RESTORE REGS. RET ; ; ; ; $+PRINT $-PRINT ; * * DEFAULT DIR BUF DATA * * ;PURPOSE ;INPUT ;OUTPUT ;REMARKS ; ; ; ; DO INITIALIZATION. DFTDIR: DS 0 STA DIRSCT ; ; ; INITIALIZE BUFFER. FILL DIRBUF,80,040H ;EBCDIC SPACES FILL DIRBUF+80,48,000H MOVAE DSHD,CHDR1,4 ;DDR1 MOVAE DSID,CDSIDD,4 ;DATA LXI HL,CSCTNO ;SECTOR NUMBER LDA DIRSCT SUI 8 ADD A ADDHA MOVAE DSID+4,,2 MOVAE DSBLK,CLRL80,5 ;00080 MOVAE DSBOE,CSPRTRK,5 ;74001 MOVAE DSEOE,CHGHTRK,5 ;73026 MOVAE DSEOD,CSPRTRK,5 ;74001 ; ; ; SET BOE,EOE,EOD FOR SECTOR 8. WHEN DIRSCT,EQL,8 MVI A,'H' ;HDR1 CALL TRNASEB STA DSHD MOVAE DSBOE,CLOWTRK,5 ;01001 MOVAE DSEOD,CLOWTRK,5 ;01001 ENDW ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * READ A DIRECTORY SECTOR * * ;PURPOSE ;INPUT ; A = SECTOR NUMBER ;OUTPUT ; ; ; ; DO INITIALIZATION. REDDIR: DS 0 STA DIRSCT ;SAVE SECTOR NUMBER. XRA A ;SET TRKNO = 0. STA DIRTRK ; ; ; READ THE SECTOR USING BIOS. SELDSK DIRDSK ;SELECT THE DISK. IF NBIOS LDA DIRDSK ;SELECT IT PHYSICALLY. MOV C,A CALL BIOSSEL LDA DIRTRK ;SET THE TRACK. MOV C,A CALL BIOSSEK LDA DIRSCT ;READ THE SECTOR MOV C,A LXI H,DIRBUF ;INTO DIRBUF. CALL BIOSRED ELSE SETTRK DIRTRK ;SET THE TRACK NO. SETSEC DIRSCT ;SET THE SECTOR NO. RC ;...INVALID SECTOR. LXI BC,DIRBUF ;SET DMA TO DIRBUF. CALLBIOS DSETDMA CALLBIOS DREAD ;READ THE SECTOR. ENDIF ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * WRITE A DIRECTORY SECTOR * * ;PURPOSE ;INPUT ; A = SECTOR NUMBER ;OUTPUT ; ; ; ; DO INITIALIZATION. WRTDIR: DS 0 STA DIRSCT ;SAVE SECTOR NUMBER. XRA A ;SET TRKNO = 0. STA DIRTRK ; ; ; READ THE SECTOR USING BIOS. SELDSK DIRDSK ;SELECT THE DISK. IF NBIOS LDA DIRDSK ;SELECT IT PHYSICALLY. MOV C,A CALL BIOSSEL LDA DIRTRK ;SET THE TRACK. MOV C,A CALL BIOSSEK LDA DIRSCT ;WRITE THE SECTOR MOV C,A LXI H,DIRBUF ;FROM DIRBUF. CALL BIOSWRT ELSE SETTRK DIRTRK ;SET THE TRACK NO. SETSEC DIRSCT ;SET THE SECTOR NO. RC ;...INVALID SECTOR. LXI BC,DIRBUF ;SET DMA TO DIRBUF. CALLBIOS DSETDMA CALLBIOS DWRITE ;READ THE SECTOR. ENDIF ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * READ A DATA 1 SECTOR * * ;PURPOSE ;INPUT ; A = SECTOR NUMBER ;OUTPUT ; ; ; ; DO INITIALIZATION. REDDAT1: DS 0 ; ; ; READ THE SECTOR USING BIOS. SELDSK DATDSK1 ;SELECT THE DISK. IF NBIOS LDA DATDSK1 ;SELECT IT PHYSICALLY. MOV C,A CALL BIOSSEL LDA DATTRK1 ;SET THE TRACK. MOV C,A CALL BIOSSEK LDA DATSCT1 ;READ THE SECTOR MOV C,A LXI H,DATBUF1 ;INTO DATBUF1. CALL BIOSRED ELSE SETTRK DATTRK1 ;SET THE TRACK NO. SETSEC DATSCT1 ;SET THE SECTOR NO. RC ;...INVALID SECTOR. LXI BC,DATBUF1 ;SET DMA TO DIRBUF. CALLBIOS DSETDMA CALLBIOS DREAD ;READ THE SECTOR. ENDIF ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * WRITE A DATA 1 SECTOR * * ;PURPOSE ;INPUT ; A = SECTOR NUMBER ;OUTPUT ; ; ; ; DO INITIALIZATION. WRTDAT1: DS 0 ; ; ; READ THE SECTOR USING BIOS. SELDSK DATDSK1 ;SELECT THE DISK. IF NBIOS LDA DATDSK1 ;SELECT IT PHYSICALLY. MOV C,A CALL BIOSSEL LDA DATTRK1 ;SET THE TRACK. MOV C,A CALL BIOSSEK LDA DATSCT1 ;WRITE THE SECTOR MOV C,A LXI H,DATBUF1 ;FROM DATBUF1. CALL BIOSWRT ELSE SETTRK DATTRK1 ;SET THE TRACK NO. SETSEC DATSCT1 ;SET THE SECTOR NO. RC ;...INVALID SECTOR. LXI BC,DATBUF1 ;SET DMA TO DIRBUF. CALLBIOS DSETDMA CALLBIOS DWRITE ;READ THE SECTOR. ENDIF ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * READ A DATA 2 SECTOR * * ;PURPOSE ;INPUT ; A = SECTOR NUMBER ;OUTPUT ; ; ; ; DO INITIALIZATION. REDDAT2: DS 0 ; ; ; READ THE SECTOR USING BIOS. SELDSK DATDSK2 ;SELECT THE DISK. IF NBIOS LDA DATDSK2 ;SELECT IT PHYSICALLY. MOV C,A CALL BIOSSEL LDA DATTRK2 ;SET THE TRACK. MOV C,A CALL BIOSSEK LDA DATSCT2 ;READ THE SECTOR MOV C,A LXI H,DATBUF2 ;INTO DATBUF2. CALL BIOSRED ELSE SETTRK DATTRK2 ;SET THE TRACK NO. SETSEC DATSCT2 ;SET THE SECTOR NO. RC ;...INVALID SECTOR. LXI BC,DATBUF2 ;SET DMA TO DATBUF2. CALLBIOS DSETDMA CALLBIOS DREAD ;READ THE SECTOR. ENDIF ; ; ; RETURN TO CALLER. RET ; ; ; ; $+PRINT $-PRINT ; * * WRITE A DATA 2 SECTOR * * ;PURPOSE ;INPUT ; A = SECTOR NUMBER ;OUTPUT ; ; ; ; DO INITIALIZATION. WRTDAT2: DS 0 ; ; ; READ THE SECTOR USING BIOS. SELDSK DATDSK2 ;SELECT THE DISK. IF NBIOS LDA DATDSK2 ;SELECT IT PHYSICALLY. MOV C,A CALL BIOSSEL LDA DATTRK2 ;SET THE TRACK. MOV C,A CALL BIOSSEK LDA DATSCT2 ;WRITE THE SECTOR MOV C,A LXI H,DATBUF2 ;FROM DATBUF2. CALL BIOSWRT ELSE SETTRK DATTRK2 ;SET THE TRACK NO. SETSEC DATSCT2 ;SET THE SECTOR NO. RC ;...INVALID SECTOR. LXI BC,DATBUF2 ;SET DMA TO DIRBUF. CALLBIOS DSETDMA CALLBIOS DWRITE ;READ THE SECTOR. ENDIF ; ; ; RETURN TO CALLER. RET ; ; ; ; ; * * * PROGRAM CONSTANTS AND AREAS * * * ; ; * * GENERAL * * ; $-PRINT ; * MAIN FUNCTION TABLE * FNCTBL: DS 0 DW RTNCPM ;00 - RETURN TO CPM DW INITDISK ;01 - INITIALIZE A DISKETTE DW CHGVOL ;02 - CHANGE A VOLUME SERIAL NUMBER DW CHGDIR ;03 - CHANGE A DATASET ENTRY DW DELDIR ;04 - DELETE A DATASET DW DSPLDIR ;05 - DISPLAY A DATASET ENTRY DW LISTDIR ;06 - LIST THE DIRECTORY DW TRSCIBLK ;07 - TRANSFER CP/M TO 3740 (BLOCKED) DW TRSICBLK ;08 - TRANSFER 3740 TO CP/M (BLOCKED) DW TRSCISRC ;09 - TRANSFER CP/M TO 3740 (SOURCE) DW TRSICSRC ;10 - TRANSFER 3740 TO CP/M (SOURCE) DW DSPIBMDS ;11 - DISPLAY AN IBM DATASET ; ; * CONSTANTS * CVOL1: DB 'VOL1' ;VOLUME SECTOR ID CHDR1: DB 'DDR1' ;DATASET SECTOR ID CSPRTRK: DB '74001' ;SPARE TRACK PTR CHGHTRK: DB '73026' ;HIGH TRACK PTR CLOWTRK: DB '01001' ;LOW TRACK PTR CLRL80: DB '00080' ;DEFAULT RECORD LENGTH CDSIDD: DB 'DATA' ;DEFAULT DATASET ID CERMAP: DB 'ERMAP' ;ERMAP SECTOR ID CSCTNO: DB ' 091011121314151617' ;ASCII SECTOR NUMBERS. DB '181920212223242526' CEOL: DB CR,LF,'$' CSPACES: DB ' ' ;8 SPACES ; ; * GENERAL VARIABLES * VOLSER: DS 6 ;VOLUME SERIAL NUMBER ; ; * TRANSFER VARIABLES * CPMDSKNO: DS 1 ;CP/M DISK DRIVE IBMDSKNO: DS 1 ;IBM DISK DRIVE TDSN: DS 8 ;DATASET NAME TDSBOE: DS 2 ;IBM BOE (INTERNAL) TDSEOE: DS 2 ;IBM EOE (INTERNAL) TDSEOD: DS 2 ;IBM EOD (INTERNAL) BLKLEN: DS 2 ;IBM BLOCK LENGTH (INTERNAL) TRSFCB: DS 33 ;CP/M FCB FOR TDSN TWRKC3: DS 3 ;CHAR WORK AREA TRSERR: DS 1 ;TRANSFER ERROR COUNT TRSBUFP: DS 2 ;CURRENT BUFFER POINTER. TRSBUFA: DS 1 ;CURRENT # OF BYTES REMAINING IN BUFFER ; ; $+PRINT $-PRINT ; * * DISK I/O BUFFERS * * ; ; * IBM DIRECTORY BUFFER * DIRDSK: DS 1 ;CURRENT DISK NO DIRTRK: DS 1 ;CURRENT TRACK NO DIRSCT: DS 1 ;CURRENT SECTOR NO DIRBUF: DS 0 DSHD: DS 4 ;'HDR1' DS 1 ;RESERVED DSID: DS 8 ;DATASET IDENTIFIER DS 9 ;**RESERVED DSBLK: DS 5 ;BLOCK LENGTH OR PHYSICAL ; ;RECORD SIZE DSATTR: DS 1 ;RECORD ATTRIBUTE ; ; B - RECORDS UNBLOCKED, UNSPANNED ; ; R - RECORDS BLOCKED, SPANNED ; ; B - RECORDS BLOCKED, UNSPANNED DSBOE: DS 5 ;GEGINNING OF EXTENT DSPRL: DS 1 ;PHYSICAL RECORD LENGTH ; ; B - 128 BYTES ; ; 1 - 256 BYTES ; ; 2 - 512 BYTES DSEOE: DS 5 ;END OF EXTENT DSRBF: DS 1 ;RECORD/BLOCK FORMAT ; ; MUST BE B OR F DSBYPI: DS 1 ;BYPASS INDICATOR ; ; B - TRANSFER DATA ; ; B - BYPASS TRANSFER DSSS: DS 1 ;DATASET SECURITY ; ; B - NOT SECURED ; ; ANYTHING - SECURED DSWP: DS 1 ;WRITE PROTECT ; ; B - READ AND WRITE VALID ; ; P - READ ONLY DSETI: DS 1 ;EXCHANGE TYPE INDICATOR ; ; B - BASIC DATA EXCHANGE ; ; ANYTHING - ADDITIONAL ; ; CHECKING REQUIRED DSMVI: DS 1 ;MULTI-VOLUME INDICATOR ; ; B - DATASET RESIDES ON ; ; VOLUME ONLY ; ; C - DATASET IS CONTINUED ; ; ON ANOTHER VOLUME ; ; L - LAST VOLUME OF DATA- ; ; SET DSVLSQ: DS 2 ;VOLUME SEQUENCE NUMBER DSCREDT: DS 6 ;CREATION DATE (YYMMDD) DSRL: DS 4 ;RECORD LENGTH DSONRS: DS 5 ;OFFSET TO NEXT RECORD SPACE DS 4 ;**RESERVED DSEXPDT: DS 6 ;EXPIRATION DATE (YYMMDD) DSVCI: DS 1 ;VERIFY/COPY INDICATOR ; ; B - DATASET CREATED ; ; C - SUCCESSFULLY COPIED ; ; V - DATASET VERIFIED DS 1 ;**RESERVED DSEOD: DS 5 ;END OF DATA DS 1 ;**RESERVED DSLV: DS 48 ;**RESERVED - LOW VALUES ; ; * DATA BUFFER 1 * DATDSK1: DS 1 ;CURRENT DISK NO DATTRK1: DS 1 ;CURRENT TRACK DATSCT1: DS 1 ;CURRENT SECTOR DATBUF1: DS 0 DATA1: DS 80 DS 48 ;FILLER ; ; * DATA BUFFER 2 * DATDSK2: DS 1 ;CURRENT DISK NO DATTRK2: DS 1 ;CURRENT TRACK NO DATSCT2: DS 1 ;CURRENT SECTOR NO DATBUF2: DS 0 DATA2: DS 80 DS 48 ;FILLER ; ; ; $+PRINT $-PRINT ;FILE TRNSUBS.LIB ; * * * * CHARACTER TRANSLATIONS * * * * ;PURPOSE THESE ROUTINES PROVIDE THE MEANS OF TRANS- ; LATING CHARACTERS FROM ASCII TO EBCDIC OR ; VICE VERSA. ALSO, THEY PROVIDE A MEANS ; FOR REMOVING UNWANTED CHARACTERS FROM PRINT ; LINES SUCH AS FOR A DUMP OF CORE. ;INPUT ; A = CHARACTER TO BE TRNASLATED ;OUTPUT ; A = TRANSLATED CHARACTER ;REMARKS ; 1. EACH SUBROUTINE WILL ONLY BE GENERATED ; IF ITS GLOBAL IS SET TO TRUE. THE GLO- ; BALS ARE: ; @TRNASEB - ASCII TO EBCDIC ; @TRNEBAS - EBCDIC TO ASCII ; @OUTTRN - OUTPUT TRANSLATION ; ; ; ; ; $+PRINT $-PRINT ; * * * TRANSLATE ASCII TO EBCDIC * * * ;PURPOSE THIS ROUTINE TRANSLATES AN ASCII CHARACTER ; TO EBCDIC. ;INPUT ; A = ASCII CHARACTER ;OUTPUT ; A = EBCDIC CHARACTER ; ; ; DO INITIALIZATION. IF @TRNASEB TRNASEB: DS 0 PUSH BC ;SAVE REGS. PUSH HL MOV C,A ; ; TRANSLATE THE CHAR BY INDEXING INTO TABLE. ANI 07FH ;ZERO HIGH ORDER BIT. MVI B,0 ;BC=A MOV C,A LXI HL,ASEBTBL ;HL=>TABLE. DAD BC ;INDEX INTO TABLE. MOV A,M ;GET TRNLTD CHAR. ; ; RETURN TO CALLER. POP HL ;RESTORE REGS. POP BC RET ; ; ; ; * * ASCII TO EBCDIC TRANSLATION TABLE * * ; ASEBTBL: DS 0 DB 000H,001H,002H,003H,004H,02DH,02EH,02FH ;000-007 DB 016H,005H,025H,00BH,00CH,00DH,00EH,00FH ;008-015 DB 010H,011H,012H,013H,014H,03DH,032H,026H ;016-023 DB 018H,019H,03FH,027H,01CH,01DH,01EH,01FH ;024-031 DB 040H,05AH,07FH,07BH,05BH,06CH,050H,07DH ;032-039 DB 04DH,05DH,05CH,04EH,06BH,060H,04BH,061H ;040-047 DB 0F0H,0F1H,0F2H,0F3H,0F4H,0F5H,0F6H,0F7H ;048-055 DB 0F8H,0F9H,07AH,05EH,04CH,07EH,06EH,06FH ;056-063 DB 07CH,0C1H,0C2H,0C3H,0C4H,0C5H,0C6H,0C7H ;064-071 DB 0C8H,0C9H,0D1H,0D2H,0D3H,0D4H,0D5H,0D6H ;072-079 DB 0D7H,0D8H,0D9H,0E2H,0E3H,0E4H,0E5H,0E6H ;080-087 DB 0E7H,0E8H,0E9H,0ADH,0E0H,0BDH,05FH,06DH ;088-095 DB 079H,081H,082H,083H,084H,085H,086H,087H ;096-103 DB 088H,089H,091H,092H,093H,094H,095H,096H ;104-111 DB 097H,098H,099H,0A2H,0A3H,0A4H,0A5H,0A6H ;112-119 DB 0A7H,0A8H,0A9H,0C0H,06AH,0D0H,0A1H,007H ;120-127 ENDIF ; ; ; ; $+PRINT $-PRINT ; * * * TRANSLATE EBCDIC TO ASCII * * * ;PURPOSE THIS ROUTINE TRANSLATES AN EBCDIC CHARACTER ; TO ASCII. ;INPUT ; A = EBCDIC CHARACTER ;OUTPUT ; A = ASCII CHARACTER ; ; ; DO INITIALIZATION. IF @TRNEBAS TRNEBAS: DS 0 PUSH BC ;SAVE REGS. PUSH HL MOV C,A ; ; TRANSLATE THE CHAR BY INDEXING INTO TABLE. MVI B,0 ;BC=A MOV C,A LXI HL,EBASTBL ;HL=>TABLE. DAD BC ;INDEX INTO TABLE. MOV A,M ;GET TRNLTD CHAR. ; ; RETURN TO CALLER. POP HL ;RESTORE REGS. POP BC RET ; ; ; ; * * EBCDIC TO ASCII TRANSLATION TABLE * * ; EBASTBL: DS 0 DB 020H,020H,020H,020H,020H,020H,020H,020H ;00-07 DB 020H,020H,020H,020H,020H,020H,020H,020H ;08-0F DB 020H,020H,020H,020H,020H,020H,020H,020H ;10-17 DB 020H,020H,020H,020H,020H,020H,020H,020H ;18-1F DB 020H,020H,020H,020H,020H,020H,020H,020H ;20-27 DB 020H,020H,020H,020H,020H,020H,020H,020H ;28-2F DB 020H,020H,020H,020H,020H,020H,020H,020H ;30-37 DB 020H,020H,020H,020H,020H,020H,020H,020H ;38-3F DB 020H,020H,020H,020H,020H,020H,020H,020H ;40-47 DB 020H,020H,020H,02EH,03CH,028H,02BH,07CH ;48-4F DB 026H,020H,020H,020H,020H,020H,020H,020H ;50-57 DB 020H,020H,021H,024H,02AH,029H,03BH,07EH ;58-5F DB 02DH,02FH,020H,020H,020H,020H,020H,020H ;60-67 DB 020H,020H,020H,02CH,025H,05FH,03EH,03FH ;68-6F DB 020H,020H,020H,020H,020H,020H,020H,020H ;70-77 DB 020H,020H,03AH,023H,040H,027H,03DH,022H ;78-7F DB 024H,020H,020H,020H,020H,020H,020H,020H ;80-87 DB 020H,020H,020H,020H,020H,020H,020H,020H ;88-8F DB 020H,020H,020H,020H,020H,020H,020H,020H ;90-97 DB 020H,020H,020H,020H,020H,020H,020H,020H ;98-9F DB 020H,020H,020H,020H,020H,020H,020H,020H ;A0-A7 DB 020H,020H,020H,020H,020H,020H,020H,020H ;A8-AF DB 020H,020H,020H,020H,020H,020H,020H,020H ;B0-B7 DB 020H,020H,020H,020H,020H,020H,020H,020H ;B8-BF DB 020H,041H,042H,043H,044H,045H,046H,047H ;C0-C7 DB 048H,049H,020H,020H,020H,020H,020H,020H ;C8-CF DB 020H,04AH,04BH,04CH,04DH,04EH,04FH,050H ;D0-D7 DB 051H,052H,020H,020H,020H,020H,020H,020H ;D8-DF DB 020H,020H,053H,054H,055H,056H,057H,058H ;E0-E7 DB 059H,05AH,020H,020H,020H,020H,020H,020H ;E8-EF DB 030H,031H,032H,033H,034H,035H,036H,037H ;F0-F7 DB 038H,039H,020H,020H,020H,020H,020H,020H ;F8-FF ENDIF ; ; ; ; $+PRINT $-PRINT ; * * * OUPUT TRANSLATION * * * ; ;PURPOSE THE FOLLOWING ROUTINE AND TABLE ARE ; USED FOR OUTPUT TRANSLATION OF NON- ; PRINTABLE CHARACTERS. FOR INSTANCE, ; IF THE CHARACTER IS A , IT WILL ; BE PRINTED AS A SPACE. ;PROGRAMMER ROBERT M. WHITE ;DATE CODED MAY 23, 1977 ;INPUT A = CHARACTER TO BE TRANSLATED. ;OUTPUT A = TRANSLATED CHARACTER ; ; ; ; DO INITIALIZATION. IF @OUTTRN OUTTRN: DS 0 PUSH BC ;SAVE REGS. PUSH HL MOV C,A ; ; TRANSLATE THE CHAR BY INDEXING INTO TABLE. ANI 07FH ;ZERO HIGH ORDER BIT. MVI B,0 ;BC=A MOV C,A LXI HL,OUTTBL ;HL=>TABLE. DAD BC ;INDEX INTO TABLE. MOV A,M ;GET TRNLTD CHAR. ; ; RETURN TO CALLER. POP HL ;RESTORE REGS. POP BC RET ; ; ; * * TRANSLATION TABLE * * OUTTBL: DB ' ' ;000 - 015 DB ' ' ;016 - 031 DB ' !"#$%&',027H,'()*+,-./' ;032 - 047 DB '0123456789:;<=>?' ;048 - 063 DB '@ABCDEFGHIJKLMNO' ;064 - 079 DB 'PQRSTUVWXYZ[\]^_' ;080 - 095 DB ' abcdefghijklmno' ;096 - 111 DB 'pqrstuvwxyz{|} ' ;112 - 127 ENDIF ; ; ; ; $+PRINT ;END TRNSUBS.LIB END