home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol004 / 3740util.asm < prev    next >
Assembly Source File  |  1984-04-29  |  61KB  |  3,076 lines
  1.     TITLE    '3740UTIL - 3740/CP/M UTILITY'
  2. ;
  3. ;PROGRAM    3740UTIL - 3740 DISK UTILITY
  4. ;PROGRAMMER    ROBERT    M. WHITE
  5. ;        8530 STONEHAVEN
  6. ;        BOISE, ID  83704
  7. ;        (208) 377-0336
  8. ;DATE WRITTEN    AUGUST 15, 1979
  9. ;DATE FINISHED    DECEMBER 23, 1979
  10. ;UPDATES
  11. ;        APRIL 21, 1980 - CHANGED DATASET LIST FUNCTION
  12. ;            (11) TO PRINT 80 CHARS.  BEFORE IT USED
  13. ;            BUFFER WRITE, THIS CAUSED BAD DISPLAYS
  14. ;            IF THE DATA CONTAINED IMBEDDED '$'s.
  15. ;PURPOSE    THIS PROGRAM GIVES THE USER THE CAPABILITY
  16. ;        OF CONVERTING IBM 374X DISKETTES TO CP/M
  17. ;        FORMAT AND VICE VERSA.  ALSO, CERTAIN
  18. ;        OTHER MAINTENANCE FUNCTIONS ARE PROVIDED.
  19. ;INPUT
  20. ;OUTPUT
  21. ;OUTLINE
  22. ;REMARKS
  23. ;        1. REFERENCES FOR THIS PROGRAM ARE IBM
  24. ;           MANUALS:
  25. ;           A. GA21-9182, IBM GENERAL INFORMATION
  26. ;              MANUAL ON DISKETTES
  27. ;        2. THIS PROGRAM IS BASED ON IBM'S BASIC
  28. ;           DATA EXCHANGE FORMAT.  THE ABOVE MANUALS
  29. ;           DESCRIBE THIS FORMAT.  IN PARTICULAR,
  30. ;           IT WAS WRITTEN TO FORMAT DATA ACCEPTABLE
  31. ;           TO THE 3741 AND 3540 DISKETTE READER 
  32. ;           FOR EXCHANGE OF DATA BETWEEN CP/M AND
  33. ;           IBM 370 MAINFRAME.
  34. ;        3. ALL CP/M FILE NAMES ARE ASSUMED TO BE
  35. ;           THE EIGHT BYTE DATASET NAME ENTERED IN 
  36. ;           THE PARTICULAR FUNCTION WITH A FILE TYPE
  37. ;           OF 'DAT'.  OTHER THAN THIS, BOTH THE CP/M
  38. ;           AND IBM FILE NAMES ARE IDENTICAL.
  39. ;        4. ALL DISPLAYS ARE BASED ON THE SOROC-120.
  40. ;           IN PARTICULAR, THE CLEAR SCREEN FUNCTION
  41. ;           IS USED THROUGHOUT THE PROGRAM.
  42. ;        5. SEE 'EQUATES' SECTION FOR INSURING PROPER
  43. ;           OPERATIONAL ENVIRONMENT.
  44. ;FUTURE UPDATES
  45. ;        1. ADD TAB CONDENSATION FEATURE IN IBM-CP/M
  46. ;           SOURCE TRANSFER.
  47. ;        2. ADD ABILITY TO MAP DISK USAGE.
  48. ;        3. ADD ABILITY TO ALLOCATE FILES DYNAMICLY.
  49. ;           (I.E.  SPECIFYING NUMBER OF RECORDS ONLY)
  50. ;        4. ADD ABILITY TO LIST CP/M DISK DIRECTORY.
  51.  
  52. ;MACLIBS
  53.     MACLIB    DOWHILES
  54.     MACLIB    EQUATES
  55.     MACLIB    MACROS
  56.     MACLIB    NCOMPARE
  57.     MACLIB    SELECTS
  58.     MACLIB    SYMSTACK
  59.     MACLIB    WHENS
  60.  
  61. ;EQUATES
  62.     EQUATES
  63. @TRNASEB SET    TRUE
  64. @TRNEBAS SET    TRUE
  65. @OUTTRN    SET    TRUE
  66. NBIOS    EQU    TRUE    ;TRUE IF USING NEW BIOS FOR CP/M 2.0
  67. SPOOLER EQU    FALSE    ;TRUE IF KLH SPOOLER IS IN NEW BIOS
  68. Z80    EQU    FALSE    ;TRUE IF CPU IS Z80
  69.  
  70.     IF    SPOOLER    ;DISP TO SPECIAL BIOS 2.0 JUMPS
  71. JMPDSP    EQU    033H+9
  72.     ELSE
  73. JMPDSP    EQU    033H
  74.     ENDIF
  75. $+PRINT
  76. $-PRINT
  77.  
  78. ;IN-LINE MACROS
  79. $-PRINT
  80. ;
  81. ;        MOVE ASCII TO EBCDIC.
  82. MOVAE    MACRO    DST,SRC,LEN
  83.     LOCAL    OVERSUB,LOOP
  84.     JMP    OVERSUB
  85. @MVAE:    DS    0
  86.     MOV    A,M        ;;GET NEXT BYTE.
  87.     CALL    TRNASEB        ;;TRANSLATE TO EBCDIC.
  88.     STAX    DE        ;;SAVE IT.
  89.     INX    HL        ;;BUMP PTRS.
  90.     INX    DE
  91.     DCR    C        ;;DECR COUNT.
  92.     JNZ    @MVAE        ;;LOOP FOR ALL CHARACTERS.
  93.     RET
  94. OVERSUB:
  95. ;
  96. ;        MOVE EBCDIC TO ASCII.
  97. MOVAE    MACRO    D,S,L
  98.     IF    NOT NUL D
  99.     LXI    DE,D        ;;POINT OT DESTINATION.
  100.     ENDIF
  101.     IF    NOT NUL S
  102.     LXI    HL,S        ;;POINT TO SOURCE.
  103.     ENDIF
  104.     IF    NOT NUL L
  105.     LSR    C,L        ;;GET LENGTH.
  106.     ENDIF
  107.     CALL    @MVAE        ;;DO THE MOVE.
  108.     ENDM
  109.     MOVAE    DST,SRC,LEN
  110.     ENDM
  111. ;
  112. ;        PRINT AN EBCIDIC FIELD.
  113. PRNTEAF MACRO    ?STR,FLD,LNG
  114.     IF    NOT NUL ?STR
  115.     MVC    TBUFF,?STR    ;;MOVE IT TO THE BUFFER.
  116.     ENDIF
  117.     MOVEA    <>,FLD,LNG
  118.     MVI    A,CR        ;;ADD CR.
  119.     STAX    DE
  120.     INX    DE
  121.     MVI    A,LF        ;;ADD LF.
  122.     STAX    DE
  123.     INX    DE
  124.     MVI    A,'$'        ;;ADD EOL MARKER.
  125.     STAX    DE
  126.     CPM    CPB,TBUFF    ;;PRINT THE BUFFER.
  127.     ENDM
  128. ;
  129.  
  130.  
  131. ;        MOVE EBCDIC TO ASCII.
  132. MOVEA    MACRO    DST,SRC,LEN
  133.     LOCAL    OVERSUB,LOOP
  134.     JMP    OVERSUB
  135. @MVEA:    DS    0
  136.     MOV    A,M        ;;GET NEXT BYTE.
  137.     CALL    TRNEBAS        ;;TRANSLATE TO ASCII.
  138.     STAX    DE        ;;SAVE IT.
  139.     INX    HL        ;;BUMP PTRS.
  140.     INX    DE
  141.     DCR    C        ;;DECR COUNT.
  142.     JNZ    @MVEA        ;;LOOP FOR ALL CHARACTERS.
  143.     RET
  144. OVERSUB:
  145. MOVEA    MACRO    D,S,L
  146.     IF    NOT NUL D
  147.     LXI    DE,D        ;;POINT OT DESTINATION.
  148.     ENDIF
  149.     IF    NOT NUL S
  150.     LXI    HL,S        ;;POINT TO SOURCE.
  151.     ENDIF
  152.     IF    NOT NUL L
  153.     LSR    C,L        ;;GET LENGTH.
  154.     ENDIF
  155.     CALL    @MVEA        ;;DO THE MOVE.
  156.     ENDM
  157.     MOVEA    DST,SRC,LEN
  158.     ENDM
  159. ;
  160. ;
  161. ;
  162. ;
  163. ;
  164. ;        * * *  BEGINNING OF PROGRAM  * * *
  165. ;
  166.     ORG    TPABGN        ;ORG TO BEGINNING OF TPA
  167. ;        ESTABLISH STACK POINTER.
  168.     LHLD    6        ;GET ADDRESS OF BEGINNING OF CP/M.
  169.     DCX    HL
  170.     SPHL            ;INIT STACK.
  171.     CPM    DRDS        ;RESET ALL DISKS.
  172.     JMP    MAINMENU
  173. ;
  174. ;
  175. ;        * *  SPECIAL BIOS JUMPS * *
  176. BIOSSEL:            ;SELECT DISK.
  177.     PUSH    H
  178.     LHLD    1
  179.     MVI    L,000H+JMPDSP
  180.     XTHL
  181.     RET
  182.  
  183. BIOSHOM:            ;HOME DISK.
  184.     PUSH    H
  185.     LHLD    1
  186.     MVI    L,003H+JMPDSP
  187.     XTHL
  188.     RET
  189.  
  190. BIOSSEK:            ;SEEK TRACK.
  191.     PUSH    H
  192.     LHLD    1
  193.     MVI    L,006H+JMPDSP
  194.     XTHL
  195.     RET
  196.  
  197. BIOSRED:            ;READ SECTOR.
  198.     PUSH    H
  199.     LHLD    1
  200.     MVI    L,009H+JMPDSP
  201.     XTHL
  202.     RET
  203.  
  204. BIOSWRT:            ;WRITE SECTOR.
  205.     PUSH    H
  206.     LHLD    1
  207.     MVI    L,00CH+JMPDSP
  208.     XTHL
  209.     RET
  210.  
  211.  
  212.  
  213. ;        * *  MAIN PROGRAM LOOP  * *
  214. ;
  215. ;        DISPLAY BASE MENU.
  216. MAINMENU: DS    0
  217. $-PRINT
  218.     PRINT    <27,'*',0,0>    ;CLEAR SCREEN.
  219.     PRINT    <'* * *  3740 IBM UTILITY  * * *',CR,LF>
  220.     PRINT    <'SELECT ONE OF THE FOLLOWING:',CR,LF>
  221.     PRINT    <'   0 - RETURN TO CP/M',CR,LF>
  222.     PRINT    <'   1 - INITIALIZE A DISKETTE',CR,LF>
  223.     PRINT    <'   2 - CHANGE A VOLUME SERIAL NUMBER',CR,LF>
  224.     PRINT    <'   3 - CHANGE A DATASET ENTRY',CR,LF>
  225.     PRINT    <'   4 - DELETE A DATASET ENTRY',CR,LF>
  226.     PRINT    <'   5 - DISPLAY A DATASET ENTRY',CR,LF>
  227.     PRINT    <'   6 - LIST THE DIRECTORY',CR,LF>
  228.     PRINT    <'   7 - TRANSFER CP/M TO 3740 (BLOCK)',CR,LF>
  229.     PRINT    <'   8 - TRANSFER 3740 TO CP/M (BLOCK)',CR,LF>
  230.     PRINT    <'   9 - TRANSFER CP/M TO 3740 (SOURCE)',CR,LF>
  231.     PRINT    <'  10 - TRANSFER 3740 TO CP/M (SOURCE)',CR,LF>
  232.     PRINT    <'  11 - DISPLAY AN IBM DATASET',CR,LF>
  233.     INPUT    'ENTER CHOICE: ',TBUFF
  234.     PRINT    <CR,LF>
  235. ;
  236. ;
  237. ;        IF NO INPUT, ISSUE ERROR MSG.
  238.     LDA    TBUFF+1        ;GET INPUT COUNT.
  239.     CPI    0        ;LENGTH CHECK (1-2)
  240.     JZ     MAINERR        ;...ISSUE ERROR.
  241.     CPI    2+1
  242.     JNC    MAINERR
  243. ;
  244. ;
  245. ;        CONVERT INPUT TO BINARY.
  246.     DECIN    TBUFF+2,TBUFF+1    ;GET INPUT NUMBER.
  247.     CPI    11+1        ;IF INVALID NUMBER
  248.     JNC    MAINERR        ;...ISSUE ERROR MESSAGE.
  249. ;
  250. ;
  251. ;               CLEAR THE SCREEN FOR EACH ROUTINES OUTPUT.
  252.         PUSH    PSW             ;SAVE OPTION CODE.
  253.         PRINT   <27,'*',0,0>    ;ISSUE CLEAR SCREEN.
  254.         POP     PSW             ;RESTORE OPTION CODE.
  255. ;
  256. ;
  257. ;        CALL THE APPROPRIATE ROUTINE.
  258. ;
  259.     ADD    A        ;INDEX INTO TABLE.
  260.     LXI    HL,FNCTBL    
  261.     ADDHA
  262. ;
  263.     MOV    E,M        ;GET ENTRY.
  264.     INX    HL
  265.     MOV    D,M
  266. ;
  267.     LXI    HL,MAINMENU    ;SET RETURN PTR.
  268.     PUSH    HL
  269. ;
  270.     XCHG        ;CALL THE ROUTINE.
  271.     PCHL
  272. ;
  273. ;
  274. ;        ISSUE ERROR MESSAGE AND RE-PRINT MENU.
  275. MAINERR: DS    0
  276.     PRINT    <'***INVALID REPLY***',CR,LF>
  277.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  278.     JMP    MAINMENU
  279. ;
  280. ;
  281. ;
  282. ;
  283. $+PRINT
  284. $-PRINT
  285. ;        * * *  RETURN TO CPM  * * *
  286. ;PURPOSE
  287. ;        THIS ROUTINE RETURNS CONTROL TO CP/M ISSUEING
  288. ;        A WARM START AND DISK RESET.
  289. ;INPUT
  290. ;OUTPUT
  291. ;REMARKS
  292. ;
  293. ;
  294. ;
  295. ;        DO INITIALIZATION.
  296. RTNCPM:    DS    0
  297.     PRINT    <'*** RETURN TO CPM ***',CR,LF>
  298.     PRINT    <'PUT MASTER CP/M DISK IN DRIVE A.',CR,LF>
  299.     INPUT    'PRESS <ENTER> WHEN READY. ',TBUFF
  300.     CPM    DRDS        ;RESET ALL DRIVES.
  301.     JMP    CPMEXIT        ;COLD START CP/M.
  302. ;
  303. ;
  304. ;
  305. ;
  306. $+PRINT
  307. $+PRINT
  308. ;        * * *  INITIALIZE A DISKETTE  * * *
  309. ;PURPOSE
  310. ;        THIS ROUTINE ALLOWS THE USER TO FORMAT A
  311. ;        DISKETTE TO IBM FORMAT.  FIRST, IT BUILDS
  312. ;        THE DIRECTORY AND THEN BLANKS ALL REMAINING
  313. ;        RECORDS.
  314. ;INPUT
  315. ;        DISK DRIVE OF DISK TO BE FORMATTED
  316. ;        VOLUME SERIAL NUMBER FOR THE DISK
  317. ;OUTPUT
  318. ;        FORMATTED DISK
  319. ;REMARKS
  320. ;
  321. ;
  322. ;
  323. ;        DO INITIALIZATION.
  324. INITDISK: DS    0
  325.     PRINT    <'*** INITIALIZE A DISK  ***',CR,LF>
  326. ;
  327. ;
  328. ;        GET DISK DRIVE.
  329.     CALL    INPDSKNO
  330.     STA    DIRDSK        ;SAVE IT.
  331. ;
  332. ;
  333. ;        GET VOLUME SERIAL NUMBER.
  334.     FILL    VOLSER,6,' '
  335. INITDIRV: DS    0
  336.     INPUT    'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF
  337.     PRINT
  338.     LDA    TBUFF+1        ;VERIFY LENGTH.
  339.     CPI    1
  340.     JC    $+8        ;...INVALID.
  341.     CPI    6+1
  342.     JC    INITDIRG    ;...VALID
  343.     PRINT    <'*** INVALID REPLY ***',CR,LF>
  344.     JMP    INITDIRV
  345. INITDIRG: DS    0
  346.     MVC    VOLSER,TBUFF+2,TBUFF+1
  347. ;
  348. ;
  349. ;        WRITE SECTORS (1-4 AND 6)
  350.     FILL    DIRBUF,80,040H
  351.     FILL    DIRBUF+80,48,000H
  352.     MVI    A,1        ;SET SECTOR TO 1.
  353.     STA    DIRSCT
  354.     DOWHILE DIRSCT,LSS,5
  355.     CALL    WRTDIR
  356.     LDA    DIRSCT        ;BUMP SCTOR NUMBER.
  357.     INR    A
  358.     STA    DIRSCT
  359.     ENDDO
  360.     MVI    A,6
  361.     CALL    WRTDIR
  362. ;
  363. ;
  364. ;        WRITE SECTOR 5 (ERMAP).
  365.     MOVAE    DIRBUF,CERMAP,5
  366.     MVI    A,5
  367.     CALL    WRTDIR
  368. ;
  369. ;
  370. ;        WRITE SECTOR 7 (VOL1).
  371.     MOVAE    DIRBUF,CVOL1,4    ;PUT 'VOL1' IN COL 1.
  372.     MOVAE    DIRBUF+4,VOLSER,6 ;PUT VOLSER IN COL 5.
  373.     MVI    A,0E6H        ;PUT 'W' IN COL 80.
  374.     STA    DIRBUF+79
  375.     MVI    A,7
  376.     CALL    WRTDIR
  377. ;
  378. ;
  379. ;        WRITE SECTORS 8-26 (DATA).
  380.     MVI    A,8
  381.     STA    DIRSCT
  382.     DOWHILE    DIRSCT,LSS,27
  383.     CALL    DFTDIR
  384.     LDA    DIRSCT
  385.     CALL    WRTDIR
  386.     LDA    DIRSCT
  387.     INR    A
  388.     STA    DIRSCT
  389.     ENDDO
  390. ;
  391. ;
  392. ;        WRITE REMAINING DISK BUFFERS.
  393.     FILL    DATBUF1,80,040H
  394.     FILL    DATBUF1+80,48,000H
  395.     LDA    DIRDSK        ;DATA DISK = DIR DSK
  396.     STA    DATDSK1
  397.     MVI    A,1        ;DATA TRK = 1
  398.     STA    DATTRK1
  399. ;
  400.     DOWHILE    DATTRK1,LSS,78
  401.     MVI    A,1        ;DATA SCT = 1
  402.     STA    DATSCT1
  403.     DOWHILE DATSCT1,LSS,27
  404.     CALL    WRTDAT1        ;WRITE THE BUFFER.
  405.     LDA    DATSCT1        ;BUMP SCTNO BY 1.
  406.     INR    A
  407.     STA    DATSCT1
  408.     ENDDO
  409.     LDA    DATTRK1        ;BUMP TRKNO BY 1.
  410.     INR    A
  411.     STA    DATTRK1
  412.     ENDDO
  413. ;
  414. ;
  415. ;        ISSUE COMPLETION MESSAGE.
  416.     PRINT    <'*** INITIALIZATION IS COMPLETE ***',CR,LF>
  417.     INPUT   'PRESS <ENTER> TO CONTINUE.',TBUFF
  418. ;
  419. ;
  420. ;        RETURN TO CALLER.
  421.     RET
  422. ;
  423. ;
  424. ;
  425. ;
  426. $+PRINT
  427. $-PRINT
  428. ;        * * *  CHANGE A VOLUME SERIAL NUMBER  * * *
  429. ;PURPOSE
  430. ;        THIS ROUTINE ALLOWS THE USER TO CHANGE AN IBM
  431. ;        VOLUME SERIAL NUMBER AS FOUND IN THE 'VOL1'
  432. ;        SECTOR (00008).
  433. ;INPUT
  434. ;        DISK DRIVE OF IBM DISKETTE
  435. ;        VOLUME SERIAL NUMBER (OPTIONAL)
  436. ;OUTPUT
  437. ;        THE VOLUME SERIAL NUMBER IS CHANGED IF ENTERED.
  438. ;REMARKS
  439. ;
  440. ;
  441. ;
  442. ;        DO INITIALIZATION.
  443. CHGVOL: DS    0
  444.     PRINT    <'*** CHANGE A VOLUME SERIAL NUMBER ***',CR,LF>
  445. ;
  446. ;
  447. ;        GET THE DISK DRIVE AND VERIFY IT.
  448.     CALL    INPDSKNO    ;GET IT.
  449.     STA    DIRDSK        ;SAVE IT.
  450.     CALL    VERIBMD        ;VERIFY IBM DISK.
  451.     JC    CHGVOLE        ;...DIDN'T VERFIY, MSG WAS GIVEN.
  452. ;
  453. ;
  454. ;        PRINT THE VOLUME SERIAL NUMBER.
  455.     PRNTEAF    'CURRENT VOLUME SERIAL NUMBER: ',DIRBUF+4,6
  456.     MOVEA    VOLSER,DIRBUF+4,6
  457. ;
  458. ;
  459. ;        GET VOLUME SERIAL NUMBER.
  460. CHGVOLIV: DS    0
  461.     PRINT    <'(OPTIONALLY) '>
  462.     INPUT    'ENTER VOLUME SERIAL NUMBER (1-6 CHARS): ',TBUFF
  463.     PRINT
  464.     LDA    TBUFF+1        ;VERIFY LENGTH.
  465.     CPI    1
  466.     JC    CHGVOLIB    ;...NO ENTRY, SKIP REPLACE.
  467.     CPI    6+1
  468.     JC    CHGVOLIG    ;...VALID
  469.     PRINT    <'*** INVALID REPLY ***',CR,LF>
  470.     JMP    CHGVOLIV
  471. CHGVOLIG: DS    0
  472.     FILL    VOLSER,6,020H
  473.     MVC    VOLSER,TBUFF+2,TBUFF+1
  474. CHGVOLIB: DS    0
  475. ;
  476. ;
  477. ;        WRITE THE SECTOR BACK OUT.
  478.     MOVAE    DIRBUF+4,VOLSER,6    ;PUT VOLSER IN BUFFER.
  479.     MVI    A,7        ;WRITE OUT SECTOR 7 (VOL1).
  480.     CALL    WRTDIR
  481. ;
  482. ;
  483. ;        RETURN TO CALLER.
  484.     PRINT    <'*** CHANGE IS SUCCESSFUL.***',CR,LF>
  485. CHGVOLE: DS    0
  486.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  487.     RET
  488. ;
  489. ;
  490. ;
  491. ;
  492. $+PRINT
  493. $-PRINT
  494. ;        * * *  CHANGE A DATASET ENTRY  * * *
  495. ;PURPOSE
  496. ;        THIS ROUTINE ACTIVATES A DIRECTORY ENTRY AND/OR
  497. ;        ALLOWS THE USER TO CHANGE DIRECTORY INFORMATION
  498. ;        PERTAINING TO THAT DATASET.
  499. ;INPUT
  500. ;        IBM DISKETTE DISK DRIVE
  501. ;        DIRECTORY SECTOR NUMBER AS GIVEN IN DIRECTORY LIST
  502. ;OUTPUT
  503. ;        THE DIRECTORY ENTRY IS UPDATED.
  504. ;REMARKS
  505. ;
  506. ;
  507. ;
  508. ;        DO INITIALIZATION.
  509. CHGDIR: DS    0
  510.     PRINT    <'*** CHANGE A DATASET ENTRY ***',CR,LF>
  511. ;
  512. ;
  513. ;        GET DISK DRIVE.
  514.     CALL    INPDSKNO    ;GET IT.
  515.     STA    DIRDSK        ;SAVE IT.
  516.     CALL    VERIBMD        ;VERIFY IBM DISK.
  517.     RC
  518. ;
  519. ;
  520. ;        GET THE SECTOR NUMBER.
  521.     CALL    INPSCTNO    ;GET IT.
  522.     STA    DIRSCT        ;SAVE IT.
  523. ;
  524. ;
  525. ;        PRINT THE ENTRY.
  526.     CALL    REDDIR        ;READ THE ENTRY.
  527.     CALL    PRTDIR        ;PRINT IT.
  528. ;
  529. ;
  530. ;        PRINT CHANGE MESSAGES.
  531.     PRINT
  532.     PRINT    <'CHANGE ONLY THE FIELDS THAT YOU WANT UPDATED.',CR,LF>
  533.     PRINT    <'IF YOU DO NOT ENTER ANY DATA, THE FIELD',CR,LF>
  534.     PRINT    <'REMAINS UNCHANGED.',CR,LF>
  535.     PRINT
  536. ;
  537. ;
  538. ;        CHANGE THE FIELDS AND UPDATE THE RECORD.
  539.     MVI    A,0C8H        ;INSURE ACTIVE DATASET.
  540.     STA    DSHD
  541.     CALL    INPDIR        ;CHANGE THE FIELDS.
  542.     LDA    DIRSCT        ;UPDATE THE RECORD.
  543.     CALL    WRTDIR
  544.     PRINT    <'***CHANGE IS SUCCESSFUL.***',CR,LF>
  545. ;
  546. ;
  547. ;        RETURN TO CALLER.
  548.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  549.     RET
  550. ;
  551. ;
  552. ;
  553. ;
  554. $+PRINT
  555. $-PRINT
  556. ;        * * *  DELETE A DATASET ENTRY  * * *
  557. ;PURPOSE
  558. ;        THIS FUNCTION ALLOWS THE USER TO DELETE A
  559. ;        SPECIFIED DIRECTORY ENTRY.  THE ENTRY IS MARKED
  560. ;        AS DELETED AND INITIALIZED TO ITS INITIAL FORMAT
  561. ;        AS WHEN THE ENTIRE DIRECTORY WAS INITIALIZED.
  562. ;INPUT
  563. ;        IBM DISK DRIVE
  564. ;        DIRECTORY SECTORY NUMBER
  565. ;OUTPUT
  566. ;        DELETED INITIAL DIRECTORY ENTRY
  567. ;REMARKS
  568. ;        1. AT THIS POINT, WE HAVE FOUND THAT THE AM2 FIELD
  569. ;           OF THE RECORD DOES NOT HAVE TO INDICATE DELETED
  570. ;           RECORD.
  571. ;
  572. ;
  573. ;
  574. ;        DO INITIALIZATION.
  575. DELDIR: DS    0
  576.     PRINT    <'*** DELETE A DATASET ENTRY ***',CR,LF>
  577. ;
  578. ;
  579. ;        GET DISK DRIVE.
  580.     CALL    INPDSKNO    ;GET IT.
  581.     STA    DIRDSK        ;SAVE IT.
  582.     CALL    VERIBMD        ;VERIFY IBM DISK.
  583.     RC            ;...NOT IBM FORMAT!!
  584. ;
  585. ;
  586. ;        GET THE SECTOR NUMBER.
  587.     CALL    INPSCTNO    ;GET IT.
  588.     STA    DIRSCT        ;SAVE IT.
  589. ;
  590. ;
  591. ;        DELETE THE ENTRY.
  592.     LDA    DIRSCT        ;INITIALIZE THE ENTRY.
  593.     CALL    DFTDIR
  594.     LDA    DIRSCT        ;WRITE IT BACK TO DISK.
  595.     CALL    WRTDIR
  596. ;
  597. ;
  598. ;        RETURN TO CALLER.
  599.     PRINT    <'***DELETION IS SUCCESSFUL.***',CR,LF>
  600.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  601.     RET
  602. ;
  603. ;
  604. ;
  605. ;
  606. $+PRINT
  607. $-PRINT
  608. ;        * * *  DISPLAY A DATASET ENTRY  * * *
  609. ;PURPOSE
  610. ;        THIS ROUTINE DISPLAYS A SINGLE DIRECTORY ENTRY.
  611. ;        IT IS PRIMARILY USED TO INSURE THAT AN ENTRY
  612. ;        WAS CHANGED PROPERLY.
  613. ;INPUT
  614. ;        IBM DISK DRIVE
  615. ;        DIRECTORY SECTOR NUMBER
  616. ;OUTPUT
  617. ;        DIRECTORY ENTRY IS DISPLAYED
  618. ;REMARKS
  619. ;
  620. ;
  621. ;
  622. ;        DO INITIALIZATION.
  623. DSPLDIR: DS    0
  624.     PRINT    <'*** DISPLAY A DIRECTORY ENTRY ***',CR,LF>
  625. ;
  626. ;
  627. ;        GET DISK DRIVE.
  628.     CALL    INPDSKNO    ;GET IT.
  629.     STA    DIRDSK        ;SAVE IT.
  630.     CALL    VERIBMD        ;VERIFY IBM DISK.
  631.     RC
  632. ;
  633. ;
  634. ;        GET THE SECTOR NUMBER.
  635.     CALL    INPSCTNO    ;GET IT.
  636.     STA    DIRSCT        ;SAVE IT.
  637. ;
  638. ;
  639. ;        PRINT THE ENTRY.
  640.     CALL    REDDIR        ;READ THE ENTRY.
  641.     CALL    PRTDIR        ;PRINT IT.
  642. ;
  643. ;
  644. ;        RETURN TO CALLER.
  645.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  646.     RET
  647. ;
  648. ;
  649. ;
  650. ;
  651. $+PRINT
  652. $-PRINT
  653. ;        * * *  LIST THE DIRECTORY  * * *
  654. ;PURPOSE
  655. ;        THIS ROUTINE DISPLAYS THE ENTIRE IBM DISKETTE
  656. ;        DIRECTORY AND ALL PERTINENT DATA ASSOCIATED
  657. ;        WITH IT.
  658. ;INPUT
  659. ;        IBM DISK DRIVE
  660. ;OUTPUT
  661. ;        THE DIRECTORY IS DISPLAYED.
  662. ;REMARKS
  663. ;
  664. ;
  665. ;
  666. ;        DO INITIALIZATION.
  667. LISTDIR: DS    0
  668.     PRINT    <'*** LIST THE DIRECTORY ***',CR,LF>
  669. ;
  670. ;
  671. ;        GET THE DISK NUMBER.
  672.     CALL    INPDSKNO    ;GET IT.
  673.     STA    DIRDSK        ;SAVE IT.
  674. ;
  675. ;
  676. ;        READ AND VERIFY THE VOLSER.
  677.     CALL    VERIBMD        ;VERIFY 'VOL1' ID.
  678.     JC    LISTDIRR    ;...BAD VOL1.
  679.     PRINT    <27,'*'>    ;CLEAR THE SCREEN.
  680.     PRNTEAF    '              DIRECTORY FOR ',DSHD+4,6
  681.     PRINT    <'                                           '>
  682.     PRINT    <'         M VL B S W V',CR,LF>
  683.     PRINT    <'SCT DATASET D LRECL  BOE   EOE   EOD  CREDT'>
  684.     PRINT    <'  EXPDT  V SQ I S P C',CR,LF>
  685. ;
  686. ;
  687. ;        LIST ALL DIRECTORY ENTRIES.
  688.     MVI    C,8        ;SET BEGINNING SECTOR.
  689.     MOV    A,C
  690.     DOWHILE <>,LSS,27    ;PRINT SECTORS 8-26.
  691.     CALL    LISTDIRE    ;LIST THE ENTRY.
  692.     INR    C        ;BUMP SECTOR.
  693.     MOV    A,C        ;SET FOR DOWHILE.
  694.     ENDDO
  695. ;
  696. ;
  697. ;        RETURN TO CALLER.
  698. LISTDIRR: DS    0
  699.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  700.     RET
  701. ;
  702. ;
  703. ;
  704. $+PRINT
  705. $-PRINT
  706.  
  707. ;        * *  LIST A DIRECORTY ENTRY  * *
  708. ;
  709. ;        DO INITIALIZATION.
  710. LISTDIRE: DS    0
  711.     PUSH    BC        ;SAVE REGS.
  712. ;
  713. ;
  714. ;        READ SECTOR.
  715.     MOV    A,C        ;GET SECTOR.
  716.     CALL    REDDIR        ;READ IT.
  717. ;
  718. ;
  719. ;        BUILD OUTPUT LINE.
  720.     FILL    TBUFF,80,' '    ;MOVE SPACES TO TBUFF.
  721.     LXI    HL,CSCTNO    ;  SECTOR NUMBER
  722.     LDA    DIRSCT
  723.     SUI    8
  724.     ADD    A
  725.     ADDHA
  726.     MVC    TBUFF,,2
  727.     WHEN    DIRSCT,EQL,8
  728.     MVC    TBUFF,'08'
  729.     ENDW
  730.     MOVEA    TBUFF+3,DSID,8    ;  DATASET NAME
  731.     WHEN    DSHD,EQL,0C4H    ;  **DELETED**
  732.     MVI    A,'D'
  733.     STA    TBUFF+12
  734.     ENDW
  735.     MOVEA    TBUFF+14,DSBLK,5    ;  LRECL
  736.     MOVEA    TBUFF+20,DSBOE,5    ;  BOE
  737.     MOVEA    TBUFF+26,DSEOE,5    ;  EOE
  738.     MOVEA    TBUFF+32,DSEOD,5    ;  EOD
  739.     MOVEA    TBUFF+38,DSCREDT,6
  740.     MOVEA    TBUFF+45,DSEXPDT,6    ;  EXP DATE
  741.     MOVEA    TBUFF+52,DSMVI,1    ;  MULTI-VOL IND
  742.     MOVEA    TBUFF+54,DSVLSQ,2    ;  VOL SEQ
  743.     MOVEA    TBUFF+57,DSBYPI,1    ;  BYP IND
  744.     MOVEA    TBUFF+59,DSSS,1        ;  SECURE IND
  745.     MOVEA    TBUFF+61,DSWP,1        ;  WRITE PRO IND
  746.     MOVEA    TBUFF+63,DSVCI,1    ;  VERI/COPY IND
  747. ;
  748. ;
  749. ;        PRINT THE LINE.
  750.     MVC    TBUFF+72,CEOL,3
  751.     PRINT    TBUFF,$
  752. ;
  753. ;
  754. ;        RETURN TO CALLER.
  755.     POP    BC        ;RESTORE REGS.
  756.     RET
  757. ;
  758. ;
  759. ;
  760. ;
  761. ;
  762. ;
  763. ;
  764. ;
  765. $+PRINT
  766. $-PRINT
  767. ;        * * *  TRANSFER CP/M TO 3740 (BLOCK)  * * *
  768. ;PURPOSE
  769. ;        THIS ROUTINE TRANSFERS A DATASET FROM CP/M TO
  770. ;        IBM FORMAT IN BLOCK MODE.  BLOCK MODE ASSUMES
  771. ;        EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS
  772. ;        ARE ONE SECTOR.
  773. ;INPUT
  774. ;        CP/M INPUT DRIVE
  775. ;        IBM OUTPUT DRIVE
  776. ;        EIGHT-BYTE DATASET NAME
  777. ;OUTPUT
  778. ;        THE FILE IS MOVED TO THE IBM DISKETTE.
  779. ;REMARKS
  780. ;        1.  IT IS ASSUMED THAT THE INPUT FILE NAME
  781. ;            IS THE EIGHT-BYTE DATASET NAME CONCATENATED
  782. ;            WITH A FILE TYPE OF 'DAT'.
  783. ;        2.  IT IS ASSUMED THAT THE IBM FILE HAS BEEN
  784. ;            PRE-ALLOCATED ON THE DISK WITH ENOUGH SPACE
  785. ;            DEFINED TO HOLD THE INPUT FILE.
  786. ;
  787. ;
  788. ;
  789. ;        DO INITIALIZATION.
  790. TRSCIBLK: DS    0
  791.     PRINT    <'*** TRANSFER CP/M TO 3740 (BLOCK) ***',CR,LF>
  792.     XRA    A        ;ZERO ERROR COUNT.
  793.     STA    TRSERR
  794. ;
  795. ;
  796. ;        GET INPUT AND OPEN FILES.
  797.     CALL    TRSGETIN    ;GET INPUT PARMS.
  798.     MVI    A,0        ;OPEN CP/M FOR INPUT.
  799.     CALL    CPMOPEN
  800.     JC    TRSCIBEN    ;...UNSUCCESSFUL.
  801.     MVI    A,1        ;OPEN IBM FOR OUTPUT.
  802.     LXI    HL,DATDSK2
  803.     CALL    IBMOPEN
  804.     JC    TRSCIBEN
  805. ;
  806. ;
  807. ;        GET THE BLOCK LENGTH FOR MOVE.
  808.     MOVEA    TBUFF,DSBLK,5    ;GET THE DATASET BLOCK LENGTH.
  809.     DECIN    TBUFF,5        ;CONVERT TO BINARY.
  810.     XCHG            ;GET BINARY BLOCK LENGTH.
  811.     SHLD    BLKLEN        ;SAVE IT.
  812. ;
  813. ;
  814. ;        GET AN CP/M BLOCK.
  815. TRSCIBLP: DS    0
  816.     CPM    CSTAT        ;CHECK FOR SUSPEND.
  817.     CPM    DRINT        ;GET CP/M CURRENT DRIVE.
  818.     SELDSK            ;SELECT THE DISK DRIVE.
  819.     CPM    DDMA,DATA1    ;SET FOR CP/M BUFFER.
  820.     CPM    DRR,TRSFCB    ;READ THE BLOCK.
  821.     WHEN    <>,NEQ,0
  822.     WHEN    <>,NEQ,1
  823.     PRINT    <'*** CP/M READ ERROR ***',CR,LF>
  824.     BUMP    TRSERR
  825.     ENDW
  826. ;                ;** EOF REACHED **
  827.     JMP    TRSCIBOK    ;CLOSE FILES.
  828.     ENDW
  829. ;
  830. ;
  831. ;        MOVE BLOCK TO IBM BUFFER.
  832.     FILL    DATA2,128,000H    ;MOVE LOW VALUES TO BUFFER.
  833.     MOVAE    DATA2,DATA1,BLKLEN ;MOVE IN THE DATA.
  834. ;
  835. ;
  836. ;        IF PAST EOE, ISSUE ERROR.
  837.     CLC    DATTRK2,TDSEOE,2
  838.     JC    TRSCIBNF
  839.     JZ    TRSCIBNF
  840.     PRINT    <'*** IBM EXTENT FULL ***',CR,LF>
  841.     BUMP    TRSERR
  842.     JMP    TRSCIBOK
  843. TRSCIBNF: DS    0
  844. ;
  845. ;
  846. ;        WRITE IBM BLOCK.
  847.     CALL    WRTDAT2        ;WRITE THE BLOCK.
  848. ;
  849. ;
  850. ;        BUMP THE IBM TRK/SCT.
  851.     BUMP    DATSCT2
  852.     WHEN    DATSCT2,GTR,26
  853.     MVI    A,1
  854.     STA    DATSCT2
  855.     BUMP    DATTRK2
  856.     ENDW
  857.     JMP    TRSCIBLP
  858. ;
  859. ;
  860. ;        CLOSE ALL FILES.
  861. TRSCIBOK: DS    0
  862.     MVI    A,0        ;CP/M FILE.
  863.     CALL    CPMCLOSE
  864.     MVI    A,1        ;IBM FILE.
  865.     LXI    HL,DATTRK2
  866.     CALL    IBMCLOSE
  867. ;
  868. ;
  869. ;        RETURN TO CALLER.
  870. TRSCIBEN: DS    0
  871.     WHEN    TRSERR,EQL,0
  872.     PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
  873.     ENDW
  874.     WHEN    TRSERR,NEQ,0
  875.     PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
  876.     PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
  877.     ENDW
  878.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  879.     RET
  880. ;
  881. ;
  882. ;
  883. ;
  884. $+PRINT
  885. $-PRINT
  886. ;        * * *  TRANSFER 3740 TO CP/M (BLOCK)  * * *
  887. ;PURPOSE
  888. ;        THIS ROUTINE TRANSFERS A DATASET FROM IBM TO 
  889. ;        CP/M FORMAT IN BLOCK MODE.  BLOCK MODE ASSUMES
  890. ;        EACH SECTOR ON BOTH THE INPUT AND OUTPUT DISKS
  891. ;        ARE ONE SECTOR.
  892. ;INPUT
  893. ;        CP/M OUTPUT DRIVE
  894. ;        IBM INPUT DRIVE
  895. ;        EIGHT-BYTE DATASET NAME
  896. ;OUTPUT
  897. ;        THE FILE IS MOVED TO THE CP/M DISK.   
  898. ;REMARKS
  899. ;        1.  IT IS ASSUMED THAT THE INPUT FILE NAME
  900. ;            IS THE EIGHT-BYTE DATASET NAME CONCATENATED
  901. ;            WITH A FILE TYPE OF 'DAT'.
  902. ;
  903. ;
  904. ;
  905. ;        DO INITIALIZATION.
  906. TRSICBLK: DS    0
  907.     PRINT    <'*** TRANSFER 3740 TO CP/M (BLOCK) ***',CR,LF>
  908.     XRA    A        ;ZERO ERROR COUNT.
  909.     STA    TRSERR
  910. ;
  911. ;
  912. ;        GET INPUT AND OPEN FILES.
  913.     CALL    TRSGETIN    ;GET INPUT PARMS.
  914.     MVI    A,0        ;OPEN IBM FOR INPUT.
  915.     LXI    HL,DATDSK1
  916.     CALL    IBMOPEN
  917.     JC    TRSICBEN    ;...UNSUCCESSFUL.
  918.     MVI    A,1        ;OPEN CP/M FOR OUTPUT.
  919.     CALL    CPMOPEN
  920.     JC    TRSICBEN
  921. ;
  922. ;
  923. ;        GET BLOCK LENGTH OF IBM DATASET.
  924.     MOVEA    TBUFF,DSBLK,5    ;GET ASCII BLOCK LENGTH.
  925.     DECIN    TBUFF,5        ;CONVERT IT TO BINARY.
  926.     XCHG            ;SAVE IT.
  927.     SHLD    BLKLEN
  928. ;
  929. ;
  930. ;        GET AN IBM BLOCK.
  931. TRSICBLP: DS    0
  932.     CPM    CSTAT        ;CHECK FOR SUSPEND.
  933.     CLC    DATTRK1,TDSEOD,2 ;END OF FILE?
  934.     CMC
  935.     JC    TRSICBOK    ;...YES.
  936.     CALL    REDDAT1        ;GET THE BLOCK.
  937. ;
  938. ;
  939. ;        MOVE BLOCK TO CP/M BUFFER.
  940.     FILL    DATA2,128,000H    ;ZERO OUTPUT BUFFER.
  941.     MOVEA    DATA2,DATA1,BLKLEN
  942.     MVI    A,00DH        ;INSERT <CR><LF> PAIR FOR CP/M
  943.     STAX    DE
  944.     INX    DE
  945.     MVI    A,00AH
  946.     STAX    DE
  947. ;    
  948. ;
  949. ;        WRITE CP/M BLOCK.
  950.     CPM    DRINT        ;GET CP/M CURRENT DRIVE.
  951.     SELDSK            ;SELECT DISK DRIVE.
  952.     CPM    DDMA,DATA2
  953.     CPM    DWR,TRSFCB
  954.     WHEN    <>,NEQ,0        ;...WRITE ERROR.
  955.     PRINT    <'*** CP/M WRITE ERROR ***',CR,LF>
  956.     BUMP    TRSERR
  957.     JMP    TRSICBOK
  958.     ENDW
  959. ;
  960. ;
  961. ;        BUMP TO NEXT IBM BLOCK.
  962.     BUMP    DATSCT1        ;BUMP SECTOR BY 1.
  963.     WHEN    DATSCT1,GTR,26
  964.     MVI    A,1        ;SECTOR = 1
  965.     STA    DATSCT1
  966.     BUMP    DATTRK1
  967.     ENDW
  968.     JMP    TRSICBLP
  969. ;
  970. ;
  971. ;        CLOSE ALL FILES.
  972. TRSICBOK: DS    0
  973.     MVI    A,0        ;IBM FILE.
  974.     LXI    HL,DATTRK1
  975.     CALL    IBMCLOSE
  976.     MVI    A,1        ;CP/M FILE.
  977.     CALL    CPMCLOSE
  978. ;
  979. ;
  980. ;        RETURN TO CALLER.
  981. TRSICBEN: DS    0
  982.     WHEN    TRSERR,EQL,0
  983.     PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
  984.     ENDW
  985.     WHEN    TRSERR,NEQ,0
  986.     PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
  987.     PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
  988.     ENDW
  989.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  990.     RET
  991. ;
  992. ;
  993. ;
  994. ;
  995. $+PRINT
  996. $-PRINT
  997. ;        * * *  TRANSFER CP/M TO 3740 (SOURCE)  * * *
  998. ;PURPOSE
  999. ;        THIS ROUTINE TRANSFERS A CP/M SOURCE FILE TO AN
  1000. ;        IBM FILE ONE LINE AT A TIME.  <TAB>'S ARE EX-
  1001. ;        PANDED AS THEY ARE ENCOUNTERED.  EOF WILL OCCUR
  1002. ;        WHEN (A) A 01AH IS ENCOUNTERED OR (B) THE PHYSICAL
  1003. ;        EOF IS ENCOUNTERED.  NOTE THAT <CR><LF>'S ARE 
  1004. ;        NOT TRANSFERRED.
  1005. ;INPUT
  1006. ;        CP/M DISK DRIVE
  1007. ;        IBM DISK DRIVE
  1008. ;        DATASET NAME
  1009. ;OUTPUT
  1010. ;        IBM DATASET
  1011. ;REMARKS
  1012. ;        1.  EACH LINE OF TEXT IS TRANSFERRED AS ONE PHYSICAL
  1013. ;            RECORD ON THE IBM DRIVE.  THE IBM BEGINNING-OF-EXTENT
  1014. ;            POINTER INDICATES WHERE THE TRANSFER IS TO BEGIN.
  1015. ;        2.  IT IS ASSUMED THAT THE IBM DATASET HAS BEEN 
  1016. ;            PRE-ALLOCATED WITH ENOUGH SPACE TO HOLD THE
  1017. ;            ENTIRE CP/M DATASET.
  1018. ;
  1019. ;
  1020. ;
  1021. ;        DO INITIALIZATION.
  1022. TRSCISRC: DS    0
  1023.     PRINT    <'*** TRANSFER CP/M TO 3740 (SOURCE) ***',CR,LF>
  1024.     XRA    A        ;ZERO ERROR COUNT.
  1025.     STA    TRSERR
  1026. ;
  1027. ;
  1028. ;        GET INPUT AND OPEN FILES.
  1029.     CALL    TRSGETIN    ;GET INPUT PARMS.
  1030.     MVI    A,0        ;OPEN CP/M FOR INPUT.
  1031.     CALL    CPMOPEN
  1032.     JC    TRSCISEN    ;...UNSUCCESSFUL.
  1033.     MVI    A,1        ;OPEN IBM FOR OUTPUT.
  1034.     LXI    HL,DATDSK2
  1035.     CALL    IBMOPEN
  1036.     JC    TRSCISEN
  1037.     CALL    TRSCISGT    ;GET THE FIRST CP/M BLOCK.
  1038.     JC    TRSCISOK    ;...**EOF REACHED**
  1039. ;
  1040. ;
  1041. ;        GET THE BLOCK LENGTH FOR MOVE.
  1042.     MOVEA    TBUFF,DSBLK,5    ;GET THE DATASET BLOCK LENGTH.
  1043.     DECIN    TBUFF,5        ;CONVERT TO BINARY.
  1044.     XCHG            ;GET BINARY BLOCK LENGTH.
  1045.     SHLD    BLKLEN        ;SAVE IT.
  1046. ;
  1047. ;
  1048. ;        GET THE NEXT LINE OF CP/M TEXT.
  1049. TRSCISLP: DS    0
  1050.     CALL    TRSCISGL    ;GET THE LINE.
  1051.     JC    TRSCISOK    ;...**EOF REACHED**
  1052. ;
  1053. ;
  1054. ;        MOVE BLOCK TO IBM BUFFER.
  1055.     FILL    DATA2,128,000H    ;MOVE LOW VALUES TO BUFFER.
  1056.     MOVAE    DATA2,TBUFF,BLKLEN ;MOVE IN THE DATA.
  1057. ;
  1058. ;
  1059. ;        IF PAST EOE, ISSUE ERROR.
  1060.     CLC    DATTRK2,TDSEOE,2
  1061.     JC    TRSCISNF
  1062.     JZ    TRSCISNF
  1063.     PRINT    <'*** IBM EXTENT FULL ***',CR,LF>
  1064.     BUMP    TRSERR
  1065.     JMP    TRSCISOK
  1066. TRSCISNF: DS    0
  1067. ;
  1068. ;
  1069. ;        WRITE IBM BLOCK.
  1070.     CALL    WRTDAT2        ;WRITE THE BLOCK.
  1071. ;
  1072. ;
  1073. ;        BUMP THE IBM TRK/SCT.
  1074.     BUMP    DATSCT2
  1075.     WHEN    DATSCT2,GTR,26
  1076.     MVI    A,1
  1077.     STA    DATSCT2
  1078.     BUMP    DATTRK2
  1079.     ENDW
  1080.     JMP    TRSCISLP
  1081. ;
  1082. ;
  1083. ;        CLOSE ALL FILES.
  1084. TRSCISOK: DS    0
  1085.     MVI    A,0        ;CP/M FILE.
  1086.     CALL    CPMCLOSE
  1087.     MVI    A,1        ;IBM FILE.
  1088.     LXI    HL,DATTRK2
  1089.     CALL    IBMCLOSE
  1090. ;
  1091. ;
  1092. ;        RETURN TO CALLER.
  1093. TRSCISEN: DS    0
  1094.     WHEN    TRSERR,EQL,0
  1095.     PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
  1096.     ENDW
  1097.     WHEN    TRSERR,NEQ,0
  1098.     PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
  1099.     PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
  1100.     ENDW
  1101.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  1102.     RET
  1103. ;
  1104. ;
  1105. ;        * *  GET A LINE OF CP/M TEXT  * *
  1106. TRSCISGL: DS    0
  1107.     FILL    TBUFF,128,' '    ;MOVE SPACES TO BUFFER.
  1108.     LXI    DE,TBUFF    ;POINT TO BEGINNING OF BUFFER.
  1109. ;
  1110. ;
  1111. ;        MOVE THE TEXT TO THE BUFFER.
  1112. TRSCISGN: DS    0
  1113.     PUSH    DE        ;SAVE BUFFER PTR.
  1114.     CALL    TRSCISGB    ;GET THE NEXT BYTE.
  1115.     POP    DE        ;RESTORE BUFFER PTR.
  1116.     RC            ;...**EOF REACHED**
  1117. ;
  1118. ;        HANDLE SPECIAL CHARACTERS.
  1119.     WHEN    <>,EQL,009H    ;**<TAB>**
  1120.     INX    DE        ;BUMP OUTPUT PTR.
  1121.     MOV    A,E        ;ALIGN TO 8 BYTE BOUNDARY.
  1122.     ANI    7
  1123.     JNZ    $-4
  1124.     JMP    TRSCISGN    ;GO GET NEXT BYTE.
  1125.     ENDW
  1126.     WHEN    <>,EQL,00DH    ;**<CR> OR <EOL>**
  1127.     CALL    TRSCISGB    ;GET TRAILING <LF>.
  1128.     RET
  1129.     ENDW
  1130.     WHEN    <>,EQL,00AH    ;**<LF> OR <EOL>**
  1131.     RET
  1132.     ENDW
  1133. ;
  1134. ;        ADD CHARACTER TO BUFFER.
  1135.     STAX    DE
  1136.     INX    DE        ;BUMP BUFFER PTR.
  1137.     JMP    TRSCISGN
  1138. ;
  1139. ;
  1140. ;
  1141. ;        * *  GET A BYTE  * *
  1142. TRSCISGB: DS    0
  1143.     LHLD    TRSBUFP        ;POINT INTO CP/M BUFFER.
  1144.     LDA    TRSBUFA        ;GET REMAINING # OF BYTES.
  1145.     WHEN    <>,EQL,0    ;...NEED A NEW BLOCK.
  1146.     CALL    TRSCISGT    ;READ IT.
  1147.     RC            ;...**EOF REACHED**
  1148.     ENDW
  1149. ;
  1150. ;
  1151.     MOV    C,M        ;GET THE NEXT BYTE.
  1152.     INX    HL        ;BUMP BUFFER PTR.
  1153.     DCR    A        ;DECR BUFFER COUNT.
  1154.     SHLD    TRSBUFP        ;SAVE BUFFER PTR AND CNT.
  1155.     STA    TRSBUFA
  1156.     MOV    A,C
  1157. ;
  1158. ;
  1159.     WHEN    <>,EQL,01AH    ;**LOGICAL EOF**
  1160.     STC
  1161.     RET
  1162.     ENDW
  1163.     ORA    A        ;RESET CY.
  1164.     RET
  1165. ;
  1166. ;
  1167. ;
  1168. ;        * *  GET A CP/M BLOCK  * *
  1169. TRSCISGT: DS    0
  1170.     CPM    CSTAT        ;CHECK FOR SUSPEND.
  1171.     CPM    DRINT        ;GET CP/M CURRENT DRIVE.
  1172.     SELDSK            ;SELECT THE DISK DRIVE.
  1173.     CPM    DDMA,DATA1    ;SET FOR CP/M BUFFER.
  1174.     CPM    DRR,TRSFCB    ;READ THE BLOCK.
  1175.     WHEN    <>,NEQ,0
  1176.     WHEN    <>,NEQ,1
  1177.     PRINT    <'*** CP/M READ ERROR ***',CR,LF>
  1178.     BUMP    TRSERR
  1179.     ENDW
  1180. ;                ;** EOF REACHED **
  1181.     STC
  1182.     ENDW
  1183. ;        SET UP VARIABLES AND RETURN.
  1184.     LXI    HL,DATA1    ;CURRENT BUFFER PTR
  1185.     SHLD    TRSBUFP
  1186.     MVI    A,128        ;# OF BYTES REMAINING
  1187.     STA    TRSBUFA
  1188.     RET
  1189. ;
  1190. ;
  1191. ;
  1192. ;
  1193. ;
  1194. ;
  1195. $+PRINT
  1196. $-PRINT
  1197. ;        * * *  TRANSFER 3740 TO CP/M (SOURCE)  * * *
  1198. ;PURPOSE
  1199. ;        THIS ROUTINE TRANSFERS A IBM DATASET TO A CP/M
  1200. ;        SOURCE FILE ONE LINE AT A TIME.  LINES ARE ENDED
  1201. ;        WITH <CR><LF> PAIRS AND OUTPUTTED CONTIGUOUSLY.
  1202. ;        INITIALLY, THE OUTPUT BUFFER IS INITIALIZED TO    
  1203. ;        01AH (LOGICAL EOF).  THEREFORE, ALL CONSTRAINTS
  1204. ;        FOR A CP/M SOURCE FILE ARE MET.
  1205. ;INPUT
  1206. ;        CP/M DISK DRIVE
  1207. ;        IBM DISK DRIVE
  1208. ;        DATASET NAME
  1209. ;OUTPUT
  1210. ;        CP/M DATASET
  1211. ;REMARKS
  1212. ;        1.  IF THE DATASET WAS PREVIOUSLY CREATED ON THE CP/M
  1213. ;            DRIVE.  IT IS DELETED AND RE-ALLOCATED. 
  1214. ;
  1215. ;
  1216. ;
  1217. ;        DO INITIALIZATION.
  1218. TRSICSRC: DS    0
  1219.     PRINT    <'*** TRANSFER 3740 TO CP/M (SOURCE) ***',CR,LF>
  1220.     XRA    A        ;ZERO ERROR COUNT.
  1221.     STA    TRSERR
  1222. ;
  1223. ;
  1224. ;        GET INPUT AND OPEN FILES.
  1225.     CALL    TRSGETIN    ;GET INPUT PARMS.
  1226.     MVI    A,0        ;OPEN IBM FOR INPUT.
  1227.     LXI    HL,DATDSK1
  1228.     CALL    IBMOPEN
  1229.     JC    TRSICSEN    ;...UNSUCCESSFUL.
  1230.     MVI    A,1        ;OPEN CP/M FOR OUTPUT.
  1231.     CALL    CPMOPEN
  1232.     JC    TRSICSEN
  1233.     CALL    TRSICSIN    ;INITIALIZE OUTPUT BUFFER.
  1234. ;
  1235. ;
  1236. ;        GET BLOCK LENGTH OF IBM DATASET.
  1237.     MOVEA    TBUFF,DSBLK,5    ;GET ASCII BLOCK LENGTH.
  1238.     DECIN    TBUFF,5        ;CONVERT IT TO BINARY.
  1239.     XCHG            ;SAVE IT.
  1240.     SHLD    BLKLEN
  1241. ;
  1242. ;
  1243. ;        GET AN IBM BLOCK.
  1244. TRSICSLP: DS    0
  1245.     CPM    CSTAT        ;CHECK FOR SUSPEND.
  1246.     CLC    DATTRK1,TDSEOD,2 ;END OF FILE?
  1247.     CMC
  1248.     JC    TRSICSOK    ;...YES.
  1249.     CALL    REDDAT1        ;GET THE BLOCK.
  1250. ;
  1251. ;
  1252. ;        MOVE BLOCK TO CP/M BUFFER.
  1253.     MOVEA    TBUFF,DATA1,BLKLEN
  1254.     LXI    HL,TBUFF    ;POINT TO BUFFER.
  1255.     LDA    BLKLEN        ;PUT BLKLEN IN REMAINING COUNT.
  1256.     STA    TWRKC3
  1257. ;
  1258.     DOWHILE TWRKC3,NEQ,0    ;** LOOP FOR FULL BUFFER **
  1259.     MOV    A,M        ;GET THE NEXT BYTE.
  1260.     INX    HL        ;BUMP PTR.
  1261.     PUSH    HL        ;SAVE IT.
  1262.     CALL    TRSICSPB    ;ADD THE BYTE.
  1263.     POP    HL
  1264.     JC    TRSICSOK    ;...** WRITE ERROR **
  1265.     BUMP    TWRKC3,-1    ;DECR REMAINING COUNT.
  1266.     ENDDO
  1267. ;
  1268.     MVI    A,00DH        ;ADD TRAILING <CR><LF>.
  1269.     CALL    TRSICSPB
  1270.     MVI    A,00AH
  1271.     CALL    TRSICSPB
  1272. ;    
  1273. ;
  1274. ;        BUMP TO NEXT IBM BLOCK.
  1275.     BUMP    DATSCT1        ;BUMP SECTOR BY 1.
  1276.     WHEN    DATSCT1,GTR,26
  1277.     MVI    A,1        ;SECTOR = 1
  1278.     STA    DATSCT1
  1279.     BUMP    DATTRK1
  1280.     ENDW
  1281.     JMP    TRSICSLP
  1282. ;
  1283. ;
  1284. ;        CLOSE ALL FILES.
  1285. TRSICSOK: DS    0
  1286.     CALL    TRSICSPT    ;PUT THE LAST BLOCK.
  1287.     MVI    A,0        ;IBM FILE.
  1288.     LXI    HL,DATTRK1
  1289.     CALL    IBMCLOSE
  1290.     MVI    A,1        ;CP/M FILE.
  1291.     CALL    CPMCLOSE
  1292. ;
  1293. ;
  1294. ;        RETURN TO CALLER.
  1295. TRSICSEN: DS    0
  1296.     WHEN    TRSERR,EQL,0
  1297.     PRINT    <'*** TRANSFER SUCCESSFUL ***',CR,LF>
  1298.     ENDW
  1299.     WHEN    TRSERR,NEQ,0
  1300.     PRINT    <'*** TRANSFER NOT COMPLETED ***',CR,LF>
  1301.     PRINT    <'PLEASE DELETE OUTPUT FILE.',CR,LF>
  1302.     ENDW
  1303.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  1304.     RET
  1305. ;
  1306. ;
  1307. ;        * *  PUT A BYTE TO CP/M FILE  * *
  1308. ;
  1309. ;        PUT BYTE IN BUFFER.
  1310. TRSICSPB: DS    0
  1311.     LHLD    TRSBUFP        ;GET BUFFER POINTER.
  1312.     MOV    M,A        ;ADD THE BYTE.
  1313.     INX    HL        ;BUMP BUFFER PTR.
  1314.     SHLD    TRSBUFP        ;SAVE IT.
  1315. ;
  1316. ;        IF FULL BUFFER, WRITE IT OUT.
  1317.     BUMP    TRSBUFA,-1    ;DECR REMAINING BYTE CNT.
  1318.     WHEN    TRSBUFA,EQL,0    ;** FULL BUFFER **
  1319.     CALL    TRSICSPT    ;ADD THE RECORD.
  1320.     RC            ;...** WRITE ERROR **
  1321.     CALL    TRSICSIN    ;INITIALIZE BUFFER.
  1322.     ENDW
  1323. ;
  1324. ;        RETURN TO CALLER.
  1325.     ORA    A
  1326.     RET
  1327. ;
  1328. ;
  1329. ;        * *  WRITE CP/M BLOCK  * *
  1330. ;
  1331. TRSICSPT: DS    0
  1332.     CPM    DRINT        ;GET CP/M CURRENT DRIVE.
  1333.     SELDSK            ;SELECT DISK DRIVE.
  1334.     CPM    DDMA,DATA2
  1335.     CPM    DWR,TRSFCB
  1336.     WHEN    <>,NEQ,0        ;...WRITE ERROR.
  1337.     PRINT    <'*** CP/M WRITE ERROR ***',CR,LF>
  1338.     BUMP    TRSERR
  1339.     STC            ;INDICATE ERROR.
  1340.     RET
  1341.     ENDW
  1342.     ORA    A
  1343.     RET
  1344. ;
  1345. ;
  1346. ;        * *  INITIALIZE OUTPUT BUFFER  * *
  1347. TRSICSIN: DS    0
  1348.     FILL    DATA2,128,01AH    ;INITIALIZE BUFFER TO LOGICAL EOF.
  1349.     LXI    HL,DATA2    ;RESET BUFFER PTR.
  1350.     SHLD    TRSBUFP
  1351.     MVI    A,128        ;RESET REMAINING BYTE COUNT.
  1352.     STA    TRSBUFA
  1353.     RET
  1354. ;
  1355. ;
  1356. ;
  1357. ;
  1358. $+PRINT
  1359. $-PRINT
  1360. ;        * * *  DISPLAY AN IBM DATASET  * * *
  1361. ;PURPOSE
  1362. ;        THIS ROUTINE DISPLAYS THE CONTENTS OF A PARTICULAR
  1363. ;        IBM DATASET TO THE USER.  NOTE THAT ALL RECORDS
  1364. ;        ARE DISPLAYED.
  1365. ;INPUT
  1366. ;        IBM DISK DRIVE
  1367. ;        IBM EIGHT-BYTE DATASET NAME
  1368. ;OUTPUT
  1369. ;        THE CONTENTS OF THE FILE ARE LISTED ON THE SCREEN.
  1370. ;REMARKS
  1371. ;
  1372. ;
  1373. ;
  1374. ;        DO INITIALIZATION.
  1375. DSPIBMDS: DS    0
  1376.     PRINT    <'*** DISPLAY AN IBM DATASET ***',CR,LF>
  1377.     XRA    A        ;ZERO ERROR COUNT.
  1378.     STA    TRSERR
  1379. ;
  1380. ;
  1381. ;        GET IBM DISK DRIVE.
  1382.     PRINT    <'(IBM) '>
  1383.     CALL    INPDSKNO    ;GET IT.
  1384.     STA    IBMDSKNO    ;SAVE IT.
  1385. ;
  1386. ;
  1387. ;        GET DATASET NAME.
  1388. DSPIBMDD: DS    0
  1389.     INPUT    'ENTER DATASET NAME (1-8 CHARS): ',TBUFF
  1390.     PRINT
  1391.     LDA    TBUFF+1        ;CHECK FOR 1-8 CHARS.
  1392.     CPI    1
  1393.     JC    DSPIBMDB
  1394.     CPI    8+1
  1395.     JC    DSPIBMDG
  1396. DSPIBMDB: DS    0
  1397.     PRINT    <'*** INVALID REPLY ***',CR,LF>
  1398.     JMP    DSPIBMDD
  1399. DSPIBMDG: DS    0
  1400.     FILL    TDSN,8,020H    ;INITIALIZE DATASET NAME.
  1401.     MVC    TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN.
  1402. ;
  1403. ;
  1404. ;        GET INPUT FILE.
  1405.     MVI    A,0        ;OPEN IBM FOR INPUT.
  1406.     LXI    HL,DATDSK1
  1407.     CALL    IBMOPEN
  1408.     JC    DSPIBMD1    ;...UNSUCCESSFUL.
  1409. ;
  1410. ;
  1411. ;        GET BLOCK LENGTH OF IBM DATASET.
  1412.     MOVEA    TBUFF,DSBLK,5    ;GET ASCII BLOCK LENGTH.
  1413.     DECIN    TBUFF,5        ;CONVERT IT TO BINARY.
  1414.     XCHG            ;SAVE IT.
  1415.     SHLD    BLKLEN
  1416. ;
  1417. ;
  1418. ;        GET AN IBM BLOCK.
  1419. DSPIBMDL: DS    0
  1420.     CPM    CSTAT        ;CHECK FOR SUSPEND.
  1421.     CLC    DATTRK1,TDSEOD,2 ;END OF FILE?
  1422.     CMC
  1423.     JC    DSPIBMD2    ;...YES.
  1424.     CALL    REDDAT1        ;GET THE BLOCK.
  1425. ;
  1426. ;
  1427. ;        PRINT 80 CHARS OF INFO.
  1428.     MVI    C,80        ;SET COUNTER.
  1429.     LXI    HL,DATA1    ;POINT TO DATA.
  1430. DSPIBMRL: DS    0
  1431.     MOV    A,M        ;GET A CHAR.
  1432.     CALL    TRNEBAS        ;TRANSLATE IT TO ASCII.
  1433.     CALL    OUTTRN        ;REMOVE NON-PRINTABLE CHARS.
  1434.     PUSH    BC        ;SAVE REGS.
  1435.     CPM    CWRITE,,??    ;PUT THE CHAR.
  1436.     POP    BC        ;RESTORE REGS.
  1437.     INX    HL        ;BUMP CHAR PTR.
  1438.     DCR    C        ;LOOP FOR ALL CHARS.
  1439.     JNZ    DSPIBMRL
  1440. ;
  1441. ;
  1442. ;        BUMP TO NEXT IBM BLOCK.
  1443.     BUMP    DATSCT1        ;BUMP SECTOR BY 1.
  1444.     WHEN    DATSCT1,GTR,26
  1445.     MVI    A,1        ;SECTOR = 1
  1446.     STA    DATSCT1
  1447.     BUMP    DATTRK1
  1448.     ENDW
  1449.     JMP    DSPIBMDL
  1450. ;
  1451. ;
  1452. ;        CLOSE ALL FILES.
  1453. DSPIBMD2: DS    0
  1454.     MVI    A,0        ;IBM FILE.
  1455.     LXI    HL,DATTRK1
  1456.     CALL    IBMCLOSE
  1457. ;
  1458. ;
  1459. ;        RETURN TO CALLER.
  1460. DSPIBMD1: DS    0
  1461.     WHEN    TRSERR,EQL,0
  1462.     PRINT    <'*** DISPLAY SUCCESSFUL ***',CR,LF>
  1463.     ENDW
  1464.     WHEN    TRSERR,NEQ,0
  1465.     PRINT    <'*** ERROR DURING DISPLAY ***',CR,LF>
  1466.     ENDW
  1467.     INPUT    'PRESS <ENTER> TO CONTINUE.',TBUFF
  1468.     RET
  1469. ;
  1470. ;
  1471. ;
  1472. ;
  1473. $+PRINT
  1474. $-PRINT
  1475. ;        * * *  GET TRANSFER INPUT  * * *
  1476. ;PURPOSE
  1477. ;        THIS ROUTINE QUIRIES THE OPERATOR FOR THE
  1478. ;        CP/M DRIVE, IBM DRIVE AND EIGHT-BYTE DATASET
  1479. ;        NAME TO BE USED IN THE TRANSFERS.
  1480. ;INPUT
  1481. ;        CP/M DISK DRIVE
  1482. ;        IBM DISK DRIVE
  1483. ;        EIGHT BYTE DATASET NAME
  1484. ;OUTPUT
  1485. ;        CPMDSKNO CONTAINS THE CP/M DISK DRIVE.
  1486. ;        IBMDSKNO CONTAINS THE IBM DISK DRIVE.
  1487. ;        TDSN CONTAINS THE EIGHT-BYTE DATASET NAME.
  1488. ;REMARKS
  1489. ;
  1490. ;
  1491. ;
  1492. ;        DO INITIALIZATION.
  1493. TRSGETIN: DS    0
  1494. ;
  1495. ;
  1496. ;        GET CP/M DISK DRIVE.
  1497. TRSGETCD: DS    0
  1498.     PRINT    <'(CP/M) '>
  1499.     CALL    INPDSKNO    ;GET IT.
  1500.     STA    CPMDSKNO    ;SAVE IT.
  1501. ;
  1502. ;
  1503. ;        GET IBM DISK DRIVE.
  1504.     PRINT    <'(IBM) '>
  1505.     CALL    INPDSKNO    ;GET IT.
  1506.     STA    IBMDSKNO    ;SAVE IT.
  1507. ;
  1508. ;
  1509. ;        INSURE IBM DRIVE IS SEPERATE FROM CP/M DRIVE.
  1510.     WHEN    IBMDSKNO,EQL,CPMDSKNO
  1511.     PRINT    <'*** IBM AND CP/M DRIVES MUST BE DIFFERENT. ***',CR,LF>
  1512.     PRINT    <'*** PLEASE RE-ENTER. ***',CR,LF>
  1513.     JMP    TRSGETCD
  1514.     ENDW
  1515. ;
  1516. ;
  1517. ;        GET DATASET NAME.
  1518. TRSGETD: DS    0
  1519.     INPUT    'ENTER DATASET NAME (1-8 CHARS): ',TBUFF
  1520.     PRINT
  1521.     LDA    TBUFF+1        ;CHECK FOR 1-8 CHARS.
  1522.     CPI    1
  1523.     JC    TRSGETDB
  1524.     CPI    8+1
  1525.     JC    TRSGETDG
  1526. TRSGETDB: DS    0
  1527.     PRINT    <'*** INVALID REPLY ***',CR,LF>
  1528.     JMP    TRSGETD
  1529. TRSGETDG: DS    0
  1530.     FILL    TDSN,8,020H    ;INITIALIZE DATASET NAME.
  1531.     MVC    TDSN,TBUFF+2,TBUFF+1 ;MOVE IT IN.
  1532. ;
  1533. ;
  1534. ;        RETURN TO CALLER.
  1535.     RET
  1536. ;
  1537. ;
  1538. ;
  1539. ;
  1540. $+PRINT
  1541. $-PRINT
  1542. ;        * * *  OPEN A CP/M FILE  * * *
  1543. ;PURPOSE
  1544. ;        THIS ROUTINE OPENS THE CP/M INPUT/OUTPUT
  1545. ;        FILE WITH THE APPROPRIATE HOUSEKEEPING.
  1546. ;INPUT
  1547. ;        A=0 (OPEN INPUT)
  1548. ;        A=1 (OPEN OUTPUT)
  1549. ;OUTPUT
  1550. ;REMARKS
  1551. ;
  1552. ;
  1553. ;
  1554. ;        DO INITIALIZATION.
  1555. CPMOPEN: DS    0
  1556.     SAVE
  1557.     PUSH    PSW        ;SAVE INPUT/OUTPUT INDICATOR.
  1558. ;
  1559. ;
  1560. ;        SELECT THE DISK DRIVE.
  1561.     CPM    DRINT        ;GET CP/M CURRENT DRIVE.
  1562.     SELDSK            ;COORDINATE BIOS.
  1563.     CPM    DDMA,TBUFF    ;SET DMA TO DEFAULT BUFFER.
  1564.     CPM    DSD,,CPMDSKNO    ;ISSUE LOGIN FOR DISK.
  1565. ;
  1566. ;
  1567. ;        SET UP CP/M FCB.
  1568.     FILL    TRSFCB,33,000H
  1569.     MVC    TRSFCB+FCBFN,TDSN,8
  1570.     MVC    TRSFCB+FCBFT,'DAT'
  1571. ;
  1572. ;
  1573. ;        IF OUTPUT, CREATE FILE.
  1574.     POP    PSW
  1575.     WHEN    <>,EQL,1
  1576.     CPM    DDF,TRSFCB    ;DELETE IT FIRST.
  1577.     CPM    DCRF,TRSFCB    ;CREATE IT.
  1578.     WHEN    <>,EQL,255    ;...UNSUCCESSFUL.
  1579.     PRINT    <'*** CP/M OUTPUT FILE DIRECTORY FULL ***',CR,LF>
  1580.     BUMP    TRSERR
  1581.     ENDW
  1582.     ENDW
  1583. ;
  1584. ;
  1585. ;        OPEN THE FILE.
  1586.     CPM    DOF,TRSFCB    ;ISSUE OPEN.
  1587.     WHEN    <>,EQL,255    ;...UNSUCCESSFUL.
  1588.     PRINT    <'*** CP/M FILE OPEN FAILURE ***',CR,LF>
  1589.     BUMP    TRSERR
  1590.     ENDW
  1591. ;
  1592. ;
  1593. ;        RETURN TO CALLER.
  1594.     RESTORE
  1595.     ORA    A        ;RESET CY.
  1596.     WHEN    TRSERR,NEQ,0    ;IF ERROR, CY:ON.
  1597.     STC
  1598.     ENDW
  1599.     RET
  1600. ;
  1601. ;
  1602. ;
  1603. ;
  1604. $+PRINT
  1605. $-PRINT
  1606. ;        * * *  CLOSE A CP/M FILE  * * *
  1607. ;PURPOSE
  1608. ;        THIS ROUTINE CLOSES A CP/M FILE WITH THE
  1609. ;        APPROPRIATE HOUSEKEEPING.
  1610. ;INPUT
  1611. ;        A=0 (CLOSE INPUT)
  1612. ;        A=1 (CLOSE OUTPUT)
  1613. ;OUTPUT
  1614. ;REMARKS
  1615. ;
  1616. ;
  1617. ;
  1618. ;        DO INITIALIZATION.
  1619. CPMCLOSE: DS    0
  1620.     SAVE            ;SAVE REGS.
  1621. ;
  1622. ;
  1623. ;        SELECT THE DISK DRIVE.
  1624.     CPM    DRINT        ;GET CP/M CURRENT DRIVE.
  1625.     SELDSK            ;COORDINATE BIOS.
  1626.     CPM    DDMA,TBUFF    ;SET DMA FOR DEFAULT BUFFER.
  1627. ;
  1628. ;
  1629. ;        CLOSE THE FILE.
  1630.     CPM    DCF,TRSFCB    ;ISSUE CLOSE.
  1631.     WHEN    <>,EQL,255    ;...UNSUCCESSFUL.
  1632.     PRINT    <'*** CP/M CLOSE FAILURE ***',CR,LF>
  1633.     BUMP    TRSERR
  1634.     ENDW
  1635. ;
  1636. ;
  1637. ;        RETURN TO CALLER.
  1638.     RESTORE            ;RESTORE REGS.
  1639.     ORA    A        ;RESET CY.
  1640.     WHEN    TRSERR,NEQ,0    ;IF ERROR, CY:ON.
  1641.     STC
  1642.     ENDW
  1643.     RET
  1644. ;
  1645. ;
  1646. ;
  1647. ;
  1648. $+PRINT
  1649. $-PRINT
  1650. ;        * * *  CLOSE AN IBM FILE  * * *
  1651. ;PURPOSE
  1652. ;        THIS ROUTINE OPENS AN IBM FILE WITH THE
  1653. ;        APPROPRIATE HOUSEKEEPING.
  1654. ;INPUT
  1655. ;        A = 0 - INPUT FILE
  1656. ;            1 - OUTPUT FILE
  1657. ;        HL => INTERNAL DATA SECTOR
  1658. ;OUTPUT
  1659. ;REMARKS
  1660. ;
  1661. ;
  1662. ;
  1663. ;        DO INITIALIZATION.
  1664. IBMCLOSE: DS    0
  1665.     SAVE            ;SAVE REGS.
  1666.     WHEN    <>,NEQ,1    ;SKIP IF NOT OUTPUT.
  1667.     JMP    IBMCLSEN
  1668.     ENDW
  1669. ;
  1670. ;
  1671. ;        DSEOD = DATA TRK/SCT
  1672.     MOV    D,M        ;GET TRK.
  1673.     INX    HL
  1674.     MOV    E,M        ;GET SCT.
  1675.     LXI    HL,TBUFF    ;CONVERT TO EXTERNAL.
  1676.     CALL    OUTTRSAD
  1677.     MOVAE    DSEOD,TBUFF,5    ;CONVERT TO EBCDIC.
  1678. ;
  1679. ;
  1680. ;        REWRITE THE DIRECTORY ENTRY.
  1681.     LDA    DIRSCT        ;GET THE SECTOR.
  1682.     CALL    WRTDIR        ;WRITE IT OUT.
  1683. ;
  1684. ;
  1685. ;        RETURN TO CALLER.
  1686. IBMCLSEN: DS    0
  1687.     RESTORE            ;RESTORE REGS.
  1688.     ORA    A        ;RESET CY.
  1689.     WHEN    TRSERR,NEQ,0    ;IF ERROR, CY:ON.
  1690.     STC
  1691.     ENDW
  1692.     RET
  1693. ;
  1694. ;
  1695. ;
  1696. ;
  1697. $+PRINT
  1698. $-PRINT
  1699. ;        * * *  OPEN AN IBM FILE  * * *
  1700. ;PURPOSE
  1701. ;        THIS ROUTINE OPENS AN IBM FILE WITH
  1702. ;        THE APPROPRIATE HOUSEKEEPING.
  1703. ;INPUT
  1704. ;        A=0 (OPEN INPUT)
  1705. ;        A=1 (OPEN OUTPUT)
  1706. ;        HL <= TRK/SCT AREA (2 BYTES)
  1707. ;OUTPUT
  1708. ;        TRK/SCT AREA = DSEOD
  1709. ;REMARKS
  1710. ;
  1711. ;
  1712. ;
  1713. ;        DO INITIALIZATION.
  1714. IBMOPEN: DS    0
  1715.     SAVE            ;SAVE REGS.
  1716. ;
  1717. ;
  1718. ;        GET IBM DISK DRIVE.
  1719.     LDA    IBMDSKNO    ;DIRDSK.
  1720.     MOV    M,A        ;SAVE IN DATA AREA.
  1721.     INX    HL
  1722.     PUSH    HL
  1723.     STA    DIRDSK
  1724. ;
  1725. ;
  1726. ;        SCAN IBM DISK DRIVE FOR DATASET.
  1727.     MVI    A,8        ;SET FOR FIRST DIR ENTRY.
  1728.     STA    DIRSCT
  1729.     DOWHILE DIRSCT,LEQ,26
  1730.     CALL    REDDIR        ;READ THE DIRECTORY.
  1731.     MOVEA    TBUFF,DSID,8    ;COMPARE DATASET NAMES.
  1732.     CLC    TBUFF,TDSN,8
  1733.     JZ    IBMOPNFD    ;...FOUND IT.
  1734.     BUMP    DIRSCT
  1735.     ENDDO
  1736.     PRINT    <'*** IBM DATASET NOT FOUND ***',CR,LF>
  1737.     BUMP    TRSERR
  1738.     POP    PSW
  1739.     JMP    IBMOPNEN
  1740. IBMOPNFD: DS    0
  1741. ;
  1742. ;
  1743. ;        GET BEGINNING OF EXTENT.
  1744.     MOVEA    TBUFF,DSBOE,5
  1745.     LXI    HL,TBUFF    ;CONVERT TO BINARY.
  1746.     CALL    VERTRSAD
  1747.     JNC    IBMOPNGB
  1748.     PRINT    <'*** IBM BAD BOE FOUND ***',CR,LF>
  1749.     BUMP    TRSERR
  1750. IBMOPNGB: DS    0
  1751.     MOV    A,H        ;SAVE IT.
  1752.     MOV    H,L
  1753.     MOV    L,A
  1754.     SHLD    TDSBOE
  1755. ;
  1756. ;
  1757. ;        GET END OF EXTENT.
  1758.     MOVEA    TBUFF,DSEOE,5
  1759.     LXI    HL,TBUFF    ;CONVERT TO BINARY.
  1760.     CALL    VERTRSAD
  1761.     JNC    IBMOPNGE
  1762.     PRINT    <'*** IBM BAD EOE FOUND ***',CR,LF>
  1763.     BUMP    TRSERR
  1764. IBMOPNGE: DS    0
  1765.     MOV    A,H        ;SAVE IT.
  1766.     MOV    H,L
  1767.     MOV    L,A
  1768.     SHLD    TDSEOE
  1769. ;
  1770. ;
  1771. ;        GET END OF DATA.
  1772.     MOVEA    TBUFF,DSEOD,5
  1773.     LXI    HL,TBUFF    ;CONVERT TO BINARY.
  1774.     CALL    VERTRSAD
  1775.     JNC    IBMOPNGD
  1776.     PRINT    <'*** IBM BAD EOD FOUND ***',CR,LF>
  1777.     BUMP    TRSERR
  1778. IBMOPNGD: DS    0
  1779.     MOV    A,H        ;SAVE IT.
  1780.     MOV    H,L
  1781.     MOV    L,A
  1782.     SHLD    TDSEOD
  1783. ;
  1784. ;
  1785. ;        DATA TRK/SCT = BOE
  1786.     POP    HL
  1787.     XCHG
  1788.     MVC    <>,TDSBOE,2
  1789. ;
  1790. ;
  1791. ;        RETURN TO CALLER.
  1792. IBMOPNEN: DS    0
  1793.     RESTORE            ;RESTORE REGS.
  1794.     ORA    A        ;RESET CY.
  1795.     WHEN    TRSERR,NEQ,0    ;IF ERROR, CY:ON.
  1796.     STC
  1797.     ENDW
  1798.     RET
  1799. ;
  1800. ;
  1801. ;
  1802. ;
  1803. $+PRINT
  1804. $-PRINT
  1805. ;        * *  INPUT DISK DRIVE NUMBER  * *
  1806. ;PURPOSE    THIS ROUTINE INPUTS A DISK DRIVE NUMBER
  1807. ;        AND VERIFIES IT.
  1808. ;INPUT        NONE
  1809. ;OUTPUT        A = DRIVE NO (0-3)
  1810. ;
  1811. ;
  1812. ;        DO INITIALIZATION.
  1813. INPDSKNO: DS    0
  1814.     SAVE    BC,DE,HL
  1815. ;
  1816. ;        REQUEST DRIVE NO.
  1817. INPDSKL: DS    0
  1818.     INPUT    'ENTER DISK DRIVE (A-D): ',TBUFF
  1819.     PRINT    <CR,LF>
  1820. ;
  1821. ;        VERIFY INPUT.
  1822.     LDA    TBUFF+1        ;IF INPUT LEN <>1 THEN ERR.
  1823.     CPI    1
  1824.     JNZ    INPDSKER
  1825.     LDA    TBUFF+2        ;VERIFY A-D.
  1826.     CPI    'A'
  1827.     JC    INPDSKER
  1828.     CPI    'D'+1
  1829.     JNC    INPDSKER
  1830. ;
  1831. ;        RETURN TO CALLER WITH ANSWER.
  1832.     SUI    'A'        ;MAKE RELATIVE TO ZERO.
  1833.     RESTORE HL,DE,BC
  1834.     RET
  1835. ;
  1836. ;        ERROR - RETRY.
  1837. INPDSKER: DS    0
  1838.     PRINT    <'***INVALID REPLY***',CR,LF>
  1839.     JMP    INPDSKL
  1840. ;
  1841. ;
  1842. ;
  1843. ;
  1844. $+PRINT
  1845. $-PRINT
  1846. ;        * *  INPUT DIRECTORY ENTRY  * *
  1847. ;PURPOSE
  1848. ;INPUT
  1849. ;OUTPUT
  1850. ;REMARKS
  1851. ;        1.  INSURE THAT THE FIELDS ARE ENTERED IN THE SAME
  1852. ;            SEQUENCE AS THE FIELDS ARE PRINTED IN 'PRTDIR'.
  1853. ;
  1854. ;
  1855. ;
  1856. ;        DO INITIALIZATION.
  1857. INPDIR:    DS    0
  1858.     SAVE            ;SAVE REGS.
  1859. ;
  1860. ;
  1861. ;        ENTER DATSET ID.
  1862.     LXI    HL,$        ;SET FOR ERROR.
  1863.     PUSH    HL
  1864.     INPUT    'ENTER DATASET ID: ',TBUFF
  1865.     PRINT
  1866.     LDA    TBUFF+1        ;VERIFY LEN (1-8).
  1867.     CPI    1
  1868.     JC    INPIDB
  1869.     CPI    8+1
  1870.     JNC    INPERR
  1871.     FILL    DSID,8,040H    ;MOVE SPACES TO FIELD.
  1872.     MOVAE    DSID,TBUFF+2,TBUFF+1
  1873. INPIDB:    POP    HL        ;RESET STACK FOR NEXT INP.
  1874. ;
  1875. ;
  1876. ;        ENTER LOGICAL RECORD LENGTH.
  1877.     LXI    HL,$        ;SET FOR ERROR.
  1878.     PUSH    HL
  1879.     INPUT    'ENTER LOGICAL RECORD LENGTH (NNNNN): ',TBUFF
  1880.     PRINT
  1881.     LDA    TBUFF+1        ;CHECK FOR PROPER LENGTH.
  1882.     ORA    A        ;...SKIP IF NO ENTRY.
  1883.     JZ    INPLRC
  1884.     CPI    5    
  1885.     JNZ    INPERR        ;...INVALID
  1886.     DECIN    TBUFF+2,5    ;CONVERT TO INTERNAL FORMAT.
  1887.     JC    INPERR        ;...INVALID
  1888.     MOV    A,E        ;GET VALUE.
  1889.     CPI    1        ;RANGE CHECK (1-128).
  1890.     JC    INPERR
  1891.     CPI    128+1
  1892.     JNC    INPERR
  1893.     MOVAE    DSBLK,TBUFF+2,5 ;MOVE IT TO DIR BUFFER.
  1894. INPLRC: POP    HL        ;RESET STACK FOR NEXT INPUT.
  1895. ;
  1896. ;
  1897. ;        ENTER BEGINNING OF EXTENT.
  1898.     LXI    HL,$        ;SET FOR ERROR.
  1899.     PUSH    HL
  1900.     PRINT    <'(BEGINNING OF EXTENT) '>
  1901.     CALL    INPTRSAD    ;GET TT0SS FOR BOE.
  1902.     JC    INPERR        ;...INVALID INPUT.
  1903.     LDA    TBUFF+1        ;CHECK IF INPUT GIVEN.
  1904.     ORA    A
  1905.     JZ    INPBOE
  1906.     MOVAE    DSBOE,TBUFF+2,5 ;MOVE IT IN PLACE.
  1907. INPBOE: POP    HL
  1908. ;
  1909. ;
  1910. ;        ENTER END OF EXTENT.
  1911.     LXI    HL,$        ;SET FOR ERROR.
  1912.     PUSH    HL
  1913.     PRINT    <'(END OF EXTENT) '>
  1914.     CALL    INPTRSAD    ;GET TT0SS FOR BOE.
  1915.     JC    INPERR        ;...INVALID INPUT.
  1916.     LDA    TBUFF+1        ;CHECK IF INPUT GIVEN.
  1917.     ORA    A
  1918.     JZ    INPEOE
  1919.     MOVAE    DSEOE,TBUFF+2,5 ;MOVE IT IN PLACE.
  1920. INPEOE: POP    HL
  1921. ;
  1922. ;
  1923. ;        ENTER END OF DATA.
  1924.     LXI    HL,$        ;SET FOR ERROR.
  1925.     PUSH    HL
  1926.     PRINT    <'(END OF DATA) '>
  1927.     CALL    INPTRSAD    ;GET TT0SS FOR BOE.
  1928.     JC    INPERR        ;...INVALID INPUT.
  1929.     LDA    TBUFF+1        ;CHECK IF INPUT GIVEN.
  1930.     ORA    A
  1931.     JZ    INPEOD
  1932.     MOVAE    DSEOD,TBUFF+2,5 ;MOVE IT IN PLACE.
  1933. INPEOD: POP    HL
  1934. ;
  1935. ;
  1936. ;        ENTER CREATION DATE.
  1937. ;
  1938. ;
  1939. ;        ENTER EXPIRATION DATE.
  1940. ;
  1941. ;
  1942. ;        ENTER MULTI-VOLUME IND.
  1943.     LXI    HL,$        ;SET FOR ERROR.
  1944.     PUSH    HL
  1945.     INPUT    'ENTER MULTI-VOLUME IND (C, L, OR BLANK): ',TBUFF
  1946.     PRINT
  1947.     LDA    TBUFF+1        ;VERIFY LEN (1-8).
  1948.     CPI    1
  1949.     JC    INPMVIB
  1950.     JNZ    INPERR
  1951.     LDA    TBUFF+2        ;GET CHAR INPUTTED.
  1952.     CPI    'C'        ;MUST BE C, L, OR BLANK.
  1953.     JZ    $+13
  1954.     CPI    'L'
  1955.     JZ    $+8
  1956.     CPI    ' '
  1957.     JNZ    INPERR
  1958.     CALL    TRNASEB        ;MAKE IT EBCDIC.
  1959.     STA    DSMVI        ;SAVE IT.
  1960. INPMVIB:    POP    HL        ;RESET STACK FOR NEXT INP.
  1961. ;
  1962. ;
  1963. ;        ENTER VOLUME SEQUENCE NUMBER.
  1964.     LXI    HL,$        ;SET FOR ERROR.
  1965.     PUSH    HL
  1966.     INPUT    'ENTER VOLUME SEQUENCE NUMBER (NN): ',TBUFF
  1967.     PRINT
  1968.     LDA    TBUFF+1        ;CHECK FOR PROPER LENGTH.
  1969.     ORA    A        ;...SKIP IF NO ENTRY.
  1970.     JZ    INPVLS
  1971.     CPI    2    
  1972.     JNZ    INPERR        ;...INVALID
  1973.     DECIN    TBUFF+2,2    ;CONVERT TO INTERNAL FORMAT.
  1974.     JC    INPERR        ;...INVALID
  1975.     MOV    A,E        ;GET VALUE.
  1976.     CPI    1        ;RANGE CHECK (1-99).
  1977.     JC    INPERR
  1978.     CPI    99+1
  1979.     JNC    INPERR
  1980.     MOVAE    DSVLSQ,TBUFF+2,2 ;MOVE IT TO DIR BUFFER.
  1981. INPVLS: POP    HL        ;RESET STACK FOR NEXT INPUT.
  1982. ;
  1983. ;
  1984. ;        ENTER BYPASS IND.
  1985.     LXI    HL,$        ;SET FOR ERROR.
  1986.     PUSH    HL
  1987.     INPUT    'ENTER BYPASS IND (B OR BLANK): ',TBUFF
  1988.     PRINT
  1989.     LDA    TBUFF+1        ;VERIFY LEN (1-8).
  1990.     CPI    1
  1991.     JC    INPBYPIB
  1992.     JNZ    INPERR
  1993.     LDA    TBUFF+2
  1994.     CPI    'B'
  1995.     JZ    $+8
  1996.     CPI    ' '
  1997.     JNZ    INPERR
  1998.     CALL    TRNASEB        ;MAKE IT EBCDIC.
  1999.     STA    DSBYPI        ;SAVE IT.
  2000. INPBYPIB:    POP    HL        ;RESET STACK FOR NEXT INP.
  2001. ;
  2002. ;
  2003. ;        ENTER SECURITY IND.
  2004.     LXI    HL,$        ;SET FOR ERROR.
  2005.     PUSH    HL
  2006.     INPUT    'ENTER SECURITY IND (NON-BLANK OR BLANK): ',TBUFF
  2007.     PRINT
  2008.     LDA    TBUFF+1        ;VERIFY LEN (1-8).
  2009.     CPI    1
  2010.     JC    INPSSP
  2011.     JNZ    INPERR
  2012.     LDA    TBUFF+2
  2013.     CALL    TRNASEB        ;MAKE IT EBCDIC.
  2014.     STA    DSSS        ;SAVE IT.
  2015. INPSSP:    POP    HL        ;RESET STACK FOR NEXT INP.
  2016. ;
  2017. ;
  2018. ;        ENTER WRITE PROTECT IND.
  2019.     LXI    HL,$        ;SET FOR ERROR.
  2020.     PUSH    HL
  2021.     INPUT    'ENTER WRITE PROTECT IND (P OR BLANK): ',TBUFF
  2022.     PRINT
  2023.     LDA    TBUFF+1        ;VERIFY LEN (1-8).
  2024.     CPI    1
  2025.     JC    INPWPB
  2026.     JNZ    INPERR
  2027.     LDA    TBUFF+2
  2028.     CPI    'P'
  2029.     JZ    $+8
  2030.     CPI    ' '
  2031.     JNZ    INPERR
  2032.     CALL    TRNASEB        ;MAKE IT EBCDIC.
  2033.     STA    DSWP        ;SAVE IT.
  2034. INPWPB:    POP    HL        ;RESET STACK FOR NEXT INP.
  2035. ;
  2036. ;
  2037. ;        ENTER VERIFY/COPY IND.
  2038.     LXI    HL,$        ;SET FOR ERROR.
  2039.     PUSH    HL
  2040.     INPUT    'ENTER VERIFY/COPY IND (C, V, OR BLANK): ',TBUFF
  2041.     PRINT
  2042.     LDA    TBUFF+1        ;VERIFY LEN (1-8).
  2043.     CPI    1
  2044.     JC    INPVCIB
  2045.     JNZ    INPERR
  2046.     LDA    TBUFF+2
  2047.     CPI    'C'
  2048.     JZ    $+13
  2049.     CPI    'V'
  2050.     JZ    $+8
  2051.     CPI    ' '
  2052.     JNZ    INPERR
  2053.     CALL    TRNASEB        ;MAKE IT EBCDIC.
  2054.     STA    DSVCI        ;SAVE IT.
  2055. INPVCIB:    POP    HL        ;RESET STACK FOR NEXT INP.
  2056. ;
  2057. ;
  2058. ;        RETURN TO CALLER.
  2059.     RESTORE
  2060.     RET
  2061. ;
  2062. ;
  2063. ;        ISSUE ERROR MESSAGE.
  2064. INPERR:    DS    0
  2065.     PRINT    <'***INVALID REPLY***',CR,LF>
  2066.     RET
  2067. ;
  2068. ;
  2069. ;
  2070. ;
  2071. $+PRINT
  2072. $-PRINT
  2073. ;        * *  INPUT SECTOR NUMBER  * *
  2074. ;PURPOSE    THIS ROUTINE INPUTS A SECTOR NUMBER
  2075. ;        AND VERIFIES IT.
  2076. ;INPUT        NONE
  2077. ;OUTPUT
  2078. ;        A = SECTOR NUMBER (8-26)
  2079. ;
  2080. ;
  2081. ;        DO INITIALIZATION.
  2082. INPSCTNO: DS    0
  2083.     SAVE    BC,DE,HL
  2084. ;
  2085. ;        REQUEST SECTOR NO.
  2086. INPSCTL: DS    0
  2087.     INPUT    'ENTER SECTOR NUMBER (8-26): ',TBUFF
  2088.     PRINT
  2089. ;
  2090. ;        VERIFY INPUT.
  2091.     LDA    TBUFF+1        ;IF INPUT LEN <1 THEN ERR.
  2092.     CPI    1
  2093.     JC    INPSCTER
  2094.     CPI    2+1        ;IF INPUT LEN > 2, THEN ERR.
  2095.     JNC    INPSCTER
  2096.     DECIN    TBUFF+2,TBUFF+1
  2097.     JC    INPSCTER    ;...CONVERSION ERROR.
  2098.     MOV    A,E
  2099.     CPI    8        ;IF <8 THEN
  2100.     JC    INPSCTER    ;   ERROR.
  2101.     CPI    26+1        ;IF >26 THEN
  2102.     JNC    INPSCTER    ;...ERROR.
  2103. ;
  2104. ;        RETURN TO CALLER WITH ANSWER.
  2105.     RESTORE HL,DE,BC
  2106.     RET
  2107. ;
  2108. ;        ERROR - RETRY.
  2109. INPSCTER: DS    0
  2110.     PRINT    <'***INVALID REPLY***',CR,LF>
  2111.     JMP    INPSCTL
  2112. ;
  2113. ;
  2114. ;
  2115. ;
  2116. $+PRINT
  2117. $-PRINT
  2118. ;        * *  INPUT TRACK/SECTOR NUMBER  * *
  2119. ;PURPOSE
  2120. ;INPUT
  2121. ;OUTPUT
  2122. ;        H = TRACK NUMBER
  2123. ;        L = SECTOR NUMBER
  2124. ;REMARKS
  2125. ;
  2126. ;
  2127. ;
  2128. ;        DO INITIALIZATION.
  2129. INPTRSAD: DS    0
  2130. ;
  2131. ;
  2132. ;        GET THE DATA TRACK/SECTOR.
  2133. INPTRSL: DS    0
  2134.     INPUT    'ENTER TRACK/SECTOR (TT0SS): ',TBUFF
  2135.     PRINT
  2136. ;
  2137. ;
  2138. ;        VERIFY AND CONVERT INPUT.
  2139.     LDA    TBUFF+1        ;IF INPUT LENGTH <> 5, THEN ERROR.
  2140.     ORA    A        ;CHECK FOR INPUT GIVEN OR NOT.
  2141.     JZ    INPTRSOK    ;...NO.
  2142.     CPI    5
  2143.     JNZ    INPTRSER
  2144. ;
  2145.     LXI    HL,TBUFF+2    ;VERIFY CONTENTS.
  2146.     CALL    VERTRSAD
  2147.     JC    INPTRSER    ;...INVALID.
  2148. ;
  2149. ;
  2150. ;        RETURN TO CALLER.
  2151. INPTRSOK: DS    0
  2152.     ORA    A        ;RESET CARRY.
  2153.     RET
  2154. ;
  2155. ;
  2156. ;        HANDLE INPUT ERROR.
  2157. INPTRSER: DS    0
  2158.     STC            ;SET CARRY.
  2159.     RET
  2160. ;
  2161. ;
  2162. ;
  2163. $+PRINT
  2164. $-PRINT
  2165. ;        * *  OUTPUT DATA TRACK/SECTOR  * *
  2166. ;PURPOSE
  2167. ;INPUT
  2168. ;        D = TRACK NUMBER
  2169. ;        E = SECTOR NUMBER
  2170. ;        HL <= 5 BYTE TRACK/SECTOR (TT0SS)
  2171. ;OUTPUT
  2172. ;        SAME AS INPUT   
  2173. ;REMARKS
  2174. ;
  2175. ;
  2176. ;        DO INITIALIZATION.
  2177. OUTTRSAD: DS    0
  2178.     SAVE            ;SAVE REGS.
  2179. ;
  2180. ;
  2181. ;        OUTPUT THE TRACK.
  2182.     MOV    A,D        ;SET FOR CALL.        .
  2183.     CALL    OUTTRSSB    ;DO IT.
  2184. ;
  2185. ;
  2186. ;        OUTPUT THE '0'.
  2187.     MVI    M,'0'
  2188.     INX    HL
  2189. ;
  2190. ;
  2191. ;        OUTPUT THE SECTOR.
  2192.     MOV    A,E        ;SET FOR CALL
  2193.     CALL    OUTTRSSB    ;DO IT.
  2194. ;
  2195. ;
  2196. ;        RETURN TO CALLER.
  2197.     RESTORE            ;RESTORE REGS.
  2198.     RET
  2199. ;
  2200. ;
  2201. ;        OUTPUT A TRACK/SECTOR ADDRESS.
  2202. OUTTRSSB: DS    0
  2203.     PUSH    DE        ;SAVE TRK/SCT.
  2204.     PUSH    HL        ;SAVE OUTPUT PTR.
  2205.     BAU8    TWRKC3        ;CONVERT TO ASCII.
  2206.     POP    HL        ;RESTORE OUTPUT PTR.
  2207.     XCHG            ;DE <= OUTPUT
  2208.     MVC    <>,TWRKC3+1,2    ;GET TRK/SCT.
  2209.     XCHG
  2210.     POP    DE        ;RESTORE TRK/SCT.
  2211.     RET
  2212. ;
  2213. ;
  2214. ;
  2215. ;
  2216. $+PRINT
  2217. $-PRINT
  2218. ;        * *  VERIFY DATA TRACK/SECTOR  * *
  2219. ;PURPOSE
  2220. ;INPUT
  2221. ;        HL <= 5 BYTE TRACK/SECTOR (TT0SS)
  2222. ;OUTPUT
  2223. ;        H = TRACK NUMBER
  2224. ;        L = SECTOR NUMBER
  2225. ;REMARKS
  2226. ;
  2227. ;
  2228. ;        DO INITIALIZATION.
  2229. VERTRSAD: DS    0
  2230. ;
  2231. ;
  2232. ;        VERIFY THE TRACK.
  2233.     DECIN    ,2        ;CONVERT IT TO DECIMAL.
  2234.     JC    VERTRSER    ;...INVALID.
  2235.     CPI    1        ;RANGE CHECK (1-74)
  2236.     JC    VERTRSER
  2237.     CPI    74+1
  2238.     CMC
  2239.     JC    VERTRSER
  2240.     STA    VERTRSTK    ;SAVE IT.
  2241. ;
  2242. ;
  2243. ;        VERIFY THE SECTOR NUMBER.
  2244.     DECIN    ,3        ;CONVERT IT TO DECIMAL.
  2245.     JC    VERTRSER    ;...INVALID.
  2246.     CPI    1        ;RANGE CHECK (1-26).
  2247.     JC    VERTRSER
  2248.     CPI    26+1
  2249.     CMC
  2250.     JC    VERTRSER
  2251. ;
  2252. ;
  2253. ;        RETURN TO CALLER.
  2254.     LDA    VERTRSTK    ;PUT TRACK NUMBER IN H.
  2255.     MOV    D,A
  2256.     XCHG            ;HL = TRK/SCT
  2257.     ORA    A        ;RESET CARRY.
  2258.     RET
  2259. ;
  2260. ;
  2261. ;        HANDLE ERROR.
  2262. VERTRSER: DS    0
  2263.     RET
  2264. ;
  2265. ;
  2266. ;        CONSTANTS AND VARIABLES.
  2267. VERTRSTK: DS    1        ;TRACK NUMBER SAVE AREA
  2268. ;
  2269. ;
  2270. ;
  2271. $+PRINT
  2272. $-PRINT
  2273. ;        * *  VERIFY IBM DISK  * *
  2274. ;PURPOSE
  2275. ;INPUT
  2276. ;OUTPUT
  2277. ;REMARKS
  2278. ;
  2279. ;
  2280. ;
  2281. ;        DO INITIALIZATION.
  2282. VERIBMD: DS    0
  2283.     SAVE        ;SAVE REGS.
  2284. ;
  2285. ;
  2286. ;        READ THE VOLSER SECTOR.
  2287.     MVI    A,7        ;READ SECTOR 7.
  2288.     CALL    REDDIR
  2289. ;
  2290. ;
  2291. ;        VERIFY 'VOL1' ID.
  2292.     MOVEA    TBUFF,DSHD,4    ;VERIFY VOL1 CONSTANT.
  2293.     CLC    TBUFF,CVOL1,4
  2294.     JZ    VERIBMDE    ;...OK.
  2295.     PRINT    <'*** DISK VOLUME SERIAL NUMBER NOT FOUND ***',CR,LF>
  2296.     STC            ;...ERROR.
  2297. ;
  2298. ;
  2299. ;        RETURN TO CALLER.
  2300. VERIBMDE: DS    0
  2301.     RESTORE
  2302.     RET
  2303. ;
  2304. ;
  2305. ;
  2306. ;
  2307. $+PRINT
  2308. $-PRINT
  2309. ;        * *  VERIFY SECTOR NUMBER  * *
  2310. ;PURPOSE
  2311. ;INPUT
  2312. ;OUTPUT
  2313. ;REMARKS
  2314. ;
  2315. ;
  2316. ;
  2317. ;        DO INITIALIZATION.
  2318. VERPTR: DS    0
  2319. ;
  2320. ;
  2321. ;        RIGHT JUSTIFY INPUT.
  2322.     FILL    PTRIN,5,'0'    ;DEFAULT TO ALL ZEROES.
  2323.     LDA    TBUFF+1        ;GET INPUT LENGTH.
  2324.     CPI    1        ;VERFIY LENGTH IS 1-5.
  2325.     JC    PTRNONE
  2326.     CPI    5+1
  2327.     CMC
  2328.     RC
  2329.     MOV    C,A        ;SAVE IT.
  2330.     LXI    DE,PTRIN+4    ;MOVE DESCENDING.
  2331.     LXI    HL,TBUFF+2
  2332.     ADDHA
  2333.     DCX    HL
  2334.     MOV    A,M        ;DO THE MOVE.
  2335.     STAX    DE
  2336.     DCX    HL
  2337.     DCX    DE
  2338.     DCR    C
  2339.     JNZ    $-5
  2340. ;
  2341. ;
  2342. ;        VERIFY THE TRACK.
  2343.     DECIN    PTRIN,2
  2344.     RC            ;...ERROR.
  2345.     MOV    A,E
  2346.     CPI    76+1
  2347.     CMC
  2348.     RC            ;...ERROR.
  2349. ;
  2350. ;
  2351. ;        VERIFY '0'.
  2352.     LDA    PTRIN+2
  2353.     CPI    '0'
  2354.     STC
  2355.     RNZ
  2356. ;
  2357. ;
  2358. ;        VERIFY SECTOR AND RETURN.
  2359.     DECIN    PTRIN+3,2
  2360.     RC            ;...ERROR.
  2361.     MOV    A,E
  2362.     CPI    1        ;RANGE CHECK 1-26.
  2363.     RC
  2364.     CPI    26+1
  2365.     CMC
  2366.     RET
  2367. ;
  2368. ;
  2369. ;        RETURN W/O VERIFY.
  2370. PTRNONE: DS    0
  2371.     MVI    A,1        ;RESET CY BUT KEEP NZ.
  2372.     ORA    A
  2373.     RET
  2374. ;
  2375. ;
  2376. ;        AREAS USED
  2377. PTRIN:    DS    5        ;TRK/SCT PTR
  2378. ;
  2379. ;
  2380. ;
  2381. ;
  2382. $+PRINT
  2383. $-PRINT
  2384. ;        * *  PRINT DIRECTORY ENTRY  * *
  2385. ;PURPOSE
  2386. ;INPUT
  2387. ;OUTPUT
  2388. ;REMARKS
  2389. ;
  2390. ;
  2391. ;
  2392. ;        DO INITIALIZATION.
  2393. PRTDIR:    DS    0
  2394.     SAVE            ;SAVE REGS.
  2395. ;
  2396. ;
  2397. ;        PRINT FIELDS.
  2398.     PRNTEAF    'DATASET NAME = ',DSID,8
  2399.     WHEN    DSHD,EQL,0C4H
  2400.     PRINT    <'    * * * DELETED * * *',CR,LF>
  2401.     ENDW
  2402.     PRNTEAF    'LRECL = ',DSBLK,5
  2403.     PRNTEAF    'BOE = ',DSBOE,5
  2404.     PRNTEAF    'EOE = ',DSEOE,5
  2405.     PRNTEAF    'EOD = ',DSEOD,5
  2406.     PRNTEAF    'CREDT = ',DSCREDT,6
  2407.     PRNTEAF    'EXPDT = ',DSEXPDT,6
  2408.     PRNTEAF    'MULTI-VOLUME IND = ',DSMVI,1
  2409.     PRNTEAF    'VOL SEQ IND = ',DSVLSQ,2
  2410.     PRNTEAF    'BYPASS IND = ',DSBYPI,1
  2411.     PRNTEAF 'SECURE IND = ',DSSS,1
  2412.     PRNTEAF    'WRITE PROTECT IND = ',DSWP,1
  2413.     PRNTEAF    'VERIFY/COPY IND = ',DSVCI,1
  2414. ;
  2415. ;
  2416. ;        RETURN TO CALLER.
  2417.     RESTORE            ;RESTORE REGS.
  2418.     RET
  2419. ;
  2420. ;
  2421. ;
  2422. ;
  2423. $+PRINT
  2424. $-PRINT
  2425. ;        * *  DEFAULT DIR BUF DATA  * *
  2426. ;PURPOSE
  2427. ;INPUT
  2428. ;OUTPUT
  2429. ;REMARKS
  2430. ;
  2431. ;
  2432. ;
  2433. ;        DO INITIALIZATION.
  2434. DFTDIR:    DS    0
  2435.     STA    DIRSCT
  2436. ;
  2437. ;
  2438. ;        INITIALIZE BUFFER.
  2439.     FILL    DIRBUF,80,040H        ;EBCDIC SPACES
  2440.     FILL    DIRBUF+80,48,000H
  2441.     MOVAE    DSHD,CHDR1,4        ;DDR1
  2442.     MOVAE    DSID,CDSIDD,4        ;DATA
  2443.     LXI    HL,CSCTNO        ;SECTOR NUMBER
  2444.     LDA    DIRSCT
  2445.     SUI    8
  2446.     ADD    A
  2447.     ADDHA
  2448.     MOVAE    DSID+4,,2
  2449.     MOVAE    DSBLK,CLRL80,5        ;00080
  2450.     MOVAE    DSBOE,CSPRTRK,5        ;74001
  2451.     MOVAE    DSEOE,CHGHTRK,5        ;73026
  2452.     MOVAE    DSEOD,CSPRTRK,5        ;74001
  2453. ;
  2454. ;
  2455. ;        SET BOE,EOE,EOD FOR SECTOR 8.
  2456.     WHEN    DIRSCT,EQL,8
  2457.     MVI    A,'H'            ;HDR1
  2458.     CALL    TRNASEB
  2459.     STA    DSHD
  2460.     MOVAE    DSBOE,CLOWTRK,5        ;01001
  2461.     MOVAE    DSEOD,CLOWTRK,5        ;01001
  2462.     ENDW
  2463. ;
  2464. ;
  2465. ;        RETURN TO CALLER.
  2466.     RET
  2467. ;
  2468. ;
  2469. ;
  2470. ;
  2471. $+PRINT
  2472. $-PRINT
  2473. ;        * *  READ A DIRECTORY SECTOR  * *
  2474. ;PURPOSE
  2475. ;INPUT
  2476. ;        A = SECTOR NUMBER
  2477. ;OUTPUT
  2478. ;
  2479. ;
  2480. ;
  2481. ;        DO INITIALIZATION.
  2482. REDDIR:    DS    0
  2483.     STA    DIRSCT        ;SAVE SECTOR NUMBER.
  2484.     XRA    A        ;SET TRKNO = 0.
  2485.     STA    DIRTRK
  2486. ;
  2487. ;
  2488. ;        READ THE SECTOR USING BIOS.
  2489.     SELDSK    DIRDSK        ;SELECT THE DISK.
  2490.     IF    NBIOS
  2491.     LDA    DIRDSK        ;SELECT IT PHYSICALLY.
  2492.     MOV    C,A
  2493.     CALL    BIOSSEL
  2494.     LDA    DIRTRK        ;SET THE TRACK.
  2495.     MOV    C,A
  2496.     CALL    BIOSSEK
  2497.     LDA    DIRSCT        ;READ THE SECTOR
  2498.     MOV    C,A
  2499.     LXI    H,DIRBUF    ;INTO DIRBUF.
  2500.     CALL    BIOSRED
  2501.     ELSE
  2502.     SETTRK    DIRTRK        ;SET THE TRACK NO.
  2503.     SETSEC    DIRSCT        ;SET THE SECTOR NO.
  2504.     RC            ;...INVALID SECTOR.
  2505.     LXI    BC,DIRBUF    ;SET DMA TO DIRBUF.
  2506.     CALLBIOS DSETDMA
  2507.     CALLBIOS DREAD        ;READ THE SECTOR.
  2508.     ENDIF
  2509.  
  2510. ;
  2511. ;
  2512. ;        RETURN TO CALLER.
  2513.     RET
  2514. ;
  2515. ;
  2516. ;
  2517. ;
  2518. $+PRINT
  2519. $-PRINT
  2520. ;        * *  WRITE A DIRECTORY SECTOR  * *
  2521. ;PURPOSE
  2522. ;INPUT
  2523. ;        A = SECTOR NUMBER
  2524. ;OUTPUT
  2525. ;
  2526. ;
  2527. ;
  2528. ;        DO INITIALIZATION.
  2529. WRTDIR:    DS    0
  2530.     STA    DIRSCT        ;SAVE SECTOR NUMBER.
  2531.     XRA    A        ;SET TRKNO = 0.
  2532.     STA    DIRTRK
  2533. ;
  2534. ;
  2535. ;        READ THE SECTOR USING BIOS.
  2536.     SELDSK    DIRDSK        ;SELECT THE DISK.
  2537.     IF    NBIOS
  2538.     LDA    DIRDSK        ;SELECT IT PHYSICALLY.
  2539.     MOV    C,A
  2540.     CALL    BIOSSEL
  2541.     LDA    DIRTRK        ;SET THE TRACK.
  2542.     MOV    C,A
  2543.     CALL    BIOSSEK
  2544.     LDA    DIRSCT        ;WRITE THE SECTOR
  2545.     MOV    C,A
  2546.     LXI    H,DIRBUF    ;FROM DIRBUF.
  2547.     CALL    BIOSWRT
  2548.     ELSE
  2549.     SETTRK    DIRTRK        ;SET THE TRACK NO.
  2550.     SETSEC    DIRSCT        ;SET THE SECTOR NO.
  2551.     RC            ;...INVALID SECTOR.
  2552.     LXI    BC,DIRBUF    ;SET DMA TO DIRBUF.
  2553.     CALLBIOS DSETDMA
  2554.     CALLBIOS DWRITE        ;READ THE SECTOR.
  2555.     ENDIF
  2556. ;
  2557. ;
  2558. ;        RETURN TO CALLER.
  2559.     RET
  2560. ;
  2561. ;
  2562. ;
  2563. ;
  2564. $+PRINT
  2565. $-PRINT
  2566. ;        * *  READ A DATA 1 SECTOR  * *
  2567. ;PURPOSE
  2568. ;INPUT
  2569. ;        A = SECTOR NUMBER
  2570. ;OUTPUT
  2571. ;
  2572. ;
  2573. ;
  2574. ;        DO INITIALIZATION.
  2575. REDDAT1:    DS    0
  2576. ;
  2577. ;
  2578. ;        READ THE SECTOR USING BIOS.
  2579.     SELDSK    DATDSK1        ;SELECT THE DISK.
  2580.     IF    NBIOS
  2581.     LDA    DATDSK1        ;SELECT IT PHYSICALLY.
  2582.     MOV    C,A
  2583.     CALL    BIOSSEL
  2584.     LDA    DATTRK1        ;SET THE TRACK.
  2585.     MOV    C,A
  2586.     CALL    BIOSSEK
  2587.     LDA    DATSCT1        ;READ THE SECTOR
  2588.     MOV    C,A
  2589.     LXI    H,DATBUF1    ;INTO DATBUF1.
  2590.     CALL    BIOSRED
  2591.     ELSE
  2592.     SETTRK    DATTRK1        ;SET THE TRACK NO.
  2593.     SETSEC    DATSCT1        ;SET THE SECTOR NO.
  2594.     RC            ;...INVALID SECTOR.
  2595.     LXI    BC,DATBUF1    ;SET DMA TO DIRBUF.
  2596.     CALLBIOS DSETDMA
  2597.     CALLBIOS DREAD        ;READ THE SECTOR.
  2598.     ENDIF
  2599. ;
  2600. ;
  2601. ;        RETURN TO CALLER.
  2602.     RET
  2603. ;
  2604. ;
  2605. ;
  2606. ;
  2607. $+PRINT
  2608. $-PRINT
  2609. ;        * *  WRITE A DATA 1 SECTOR  * *
  2610. ;PURPOSE
  2611. ;INPUT
  2612. ;        A = SECTOR NUMBER
  2613. ;OUTPUT
  2614. ;
  2615. ;
  2616. ;
  2617. ;        DO INITIALIZATION.
  2618. WRTDAT1:    DS    0
  2619. ;
  2620. ;
  2621. ;        READ THE SECTOR USING BIOS.
  2622.     SELDSK    DATDSK1        ;SELECT THE DISK.
  2623.     IF    NBIOS
  2624.     LDA    DATDSK1        ;SELECT IT PHYSICALLY.
  2625.     MOV    C,A
  2626.     CALL    BIOSSEL
  2627.     LDA    DATTRK1        ;SET THE TRACK.
  2628.     MOV    C,A
  2629.     CALL    BIOSSEK
  2630.     LDA    DATSCT1        ;WRITE THE SECTOR
  2631.     MOV    C,A
  2632.     LXI    H,DATBUF1    ;FROM DATBUF1.
  2633.     CALL    BIOSWRT
  2634.     ELSE
  2635.     SETTRK    DATTRK1        ;SET THE TRACK NO.
  2636.     SETSEC    DATSCT1        ;SET THE SECTOR NO.
  2637.     RC            ;...INVALID SECTOR.
  2638.     LXI    BC,DATBUF1    ;SET DMA TO DIRBUF.
  2639.     CALLBIOS DSETDMA
  2640.     CALLBIOS DWRITE        ;READ THE SECTOR.
  2641.     ENDIF
  2642. ;
  2643. ;
  2644. ;        RETURN TO CALLER.
  2645.     RET
  2646. ;
  2647. ;
  2648. ;
  2649. ;
  2650. $+PRINT
  2651. $-PRINT
  2652. ;        * *  READ A DATA 2 SECTOR  * *
  2653. ;PURPOSE
  2654. ;INPUT
  2655. ;        A = SECTOR NUMBER
  2656. ;OUTPUT
  2657. ;
  2658. ;
  2659. ;
  2660. ;        DO INITIALIZATION.
  2661. REDDAT2:    DS    0
  2662. ;
  2663. ;
  2664. ;        READ THE SECTOR USING BIOS.
  2665.     SELDSK    DATDSK2        ;SELECT THE DISK.
  2666.     IF    NBIOS
  2667.     LDA    DATDSK2        ;SELECT IT PHYSICALLY.
  2668.     MOV    C,A
  2669.     CALL    BIOSSEL
  2670.     LDA    DATTRK2        ;SET THE TRACK.
  2671.     MOV    C,A
  2672.     CALL    BIOSSEK
  2673.     LDA    DATSCT2        ;READ THE SECTOR
  2674.     MOV    C,A
  2675.     LXI    H,DATBUF2    ;INTO DATBUF2.
  2676.     CALL    BIOSRED
  2677.     ELSE
  2678.     SETTRK    DATTRK2        ;SET THE TRACK NO.
  2679.     SETSEC    DATSCT2        ;SET THE SECTOR NO.
  2680.     RC            ;...INVALID SECTOR.
  2681.     LXI    BC,DATBUF2    ;SET DMA TO DATBUF2.
  2682.     CALLBIOS DSETDMA
  2683.     CALLBIOS DREAD        ;READ THE SECTOR.
  2684.     ENDIF
  2685. ;
  2686. ;
  2687. ;        RETURN TO CALLER.
  2688.     RET
  2689. ;
  2690. ;
  2691. ;
  2692. ;
  2693. $+PRINT
  2694. $-PRINT
  2695. ;        * *  WRITE A DATA 2 SECTOR  * *
  2696. ;PURPOSE
  2697. ;INPUT
  2698. ;        A = SECTOR NUMBER
  2699. ;OUTPUT
  2700. ;
  2701. ;
  2702. ;
  2703. ;        DO INITIALIZATION.
  2704. WRTDAT2:    DS    0
  2705. ;
  2706. ;
  2707. ;        READ THE SECTOR USING BIOS.
  2708.     SELDSK    DATDSK2        ;SELECT THE DISK.
  2709.     IF    NBIOS
  2710.     LDA    DATDSK2        ;SELECT IT PHYSICALLY.
  2711.     MOV    C,A
  2712.     CALL    BIOSSEL
  2713.     LDA    DATTRK2        ;SET THE TRACK.
  2714.     MOV    C,A
  2715.     CALL    BIOSSEK
  2716.     LDA    DATSCT2        ;WRITE THE SECTOR
  2717.     MOV    C,A
  2718.     LXI    H,DATBUF2    ;FROM DATBUF2.
  2719.     CALL    BIOSWRT
  2720.     ELSE
  2721.     SETTRK    DATTRK2        ;SET THE TRACK NO.
  2722.     SETSEC    DATSCT2        ;SET THE SECTOR NO.
  2723.     RC            ;...INVALID SECTOR.
  2724.     LXI    BC,DATBUF2    ;SET DMA TO DIRBUF.
  2725.     CALLBIOS DSETDMA
  2726.     CALLBIOS DWRITE        ;READ THE SECTOR.
  2727.     ENDIF
  2728. ;
  2729. ;
  2730. ;        RETURN TO CALLER.
  2731.     RET
  2732. ;
  2733. ;
  2734. ;
  2735. ;
  2736. ;        * * *  PROGRAM CONSTANTS AND AREAS  * * *
  2737. ;
  2738. ;        * *  GENERAL  * *
  2739. ;
  2740. $-PRINT
  2741. ;        *  MAIN FUNCTION TABLE  *
  2742. FNCTBL:    DS    0
  2743.     DW    RTNCPM        ;00 - RETURN TO CPM
  2744.     DW    INITDISK    ;01 - INITIALIZE A DISKETTE
  2745.     DW    CHGVOL        ;02 - CHANGE A VOLUME SERIAL NUMBER
  2746.     DW    CHGDIR        ;03 - CHANGE A DATASET ENTRY
  2747.     DW    DELDIR        ;04 - DELETE A DATASET
  2748.     DW    DSPLDIR        ;05 - DISPLAY A DATASET ENTRY
  2749.     DW    LISTDIR        ;06 - LIST THE DIRECTORY
  2750.     DW    TRSCIBLK    ;07 - TRANSFER CP/M TO 3740 (BLOCKED)
  2751.     DW    TRSICBLK    ;08 - TRANSFER 3740 TO CP/M (BLOCKED)
  2752.     DW    TRSCISRC    ;09 - TRANSFER CP/M TO 3740 (SOURCE)
  2753.     DW    TRSICSRC    ;10 - TRANSFER 3740 TO CP/M (SOURCE)
  2754.     DW    DSPIBMDS    ;11 - DISPLAY AN IBM DATASET
  2755. ;
  2756. ;        *  CONSTANTS  *
  2757. CVOL1:    DB    'VOL1'        ;VOLUME SECTOR ID
  2758. CHDR1:    DB    'DDR1'        ;DATASET SECTOR ID
  2759. CSPRTRK: DB    '74001'        ;SPARE TRACK PTR
  2760. CHGHTRK: DB    '73026'        ;HIGH TRACK PTR
  2761. CLOWTRK: DB    '01001'        ;LOW TRACK PTR
  2762. CLRL80: DB    '00080'        ;DEFAULT RECORD LENGTH
  2763. CDSIDD:    DB    'DATA'        ;DEFAULT DATASET ID
  2764. CERMAP: DB    'ERMAP'        ;ERMAP SECTOR ID
  2765. CSCTNO: DB    '  091011121314151617'    ;ASCII SECTOR NUMBERS.
  2766.     DB    '181920212223242526'
  2767. CEOL:    DB    CR,LF,'$'
  2768. CSPACES: DB    '        '    ;8 SPACES
  2769. ;
  2770. ;        * GENERAL VARIABLES *
  2771. VOLSER: DS    6        ;VOLUME SERIAL NUMBER
  2772. ;
  2773. ;        * TRANSFER VARIABLES *
  2774. CPMDSKNO: DS    1        ;CP/M DISK DRIVE
  2775. IBMDSKNO: DS    1        ;IBM DISK DRIVE
  2776. TDSN:    DS    8        ;DATASET NAME
  2777. TDSBOE:    DS    2        ;IBM BOE (INTERNAL)
  2778. TDSEOE:    DS    2        ;IBM EOE (INTERNAL)
  2779. TDSEOD:    DS    2        ;IBM EOD (INTERNAL)
  2780. BLKLEN: DS    2        ;IBM BLOCK LENGTH (INTERNAL)
  2781. TRSFCB:    DS    33        ;CP/M FCB FOR TDSN
  2782. TWRKC3:    DS    3        ;CHAR WORK AREA
  2783. TRSERR:    DS    1        ;TRANSFER ERROR COUNT
  2784. TRSBUFP: DS    2        ;CURRENT BUFFER POINTER.
  2785. TRSBUFA: DS    1        ;CURRENT # OF BYTES REMAINING IN BUFFER
  2786. ;
  2787. ;
  2788. $+PRINT
  2789. $-PRINT
  2790. ;        * *  DISK I/O BUFFERS  * *
  2791. ;
  2792. ;        * IBM DIRECTORY BUFFER *
  2793. DIRDSK:    DS    1        ;CURRENT DISK NO
  2794. DIRTRK:    DS    1        ;CURRENT TRACK NO
  2795. DIRSCT:    DS    1        ;CURRENT SECTOR NO
  2796. DIRBUF:    DS    0
  2797. DSHD:    DS    4        ;'HDR1'
  2798.     DS    1        ;RESERVED
  2799. DSID:    DS    8        ;DATASET IDENTIFIER
  2800.     DS    9        ;**RESERVED
  2801. DSBLK:    DS    5        ;BLOCK LENGTH OR PHYSICAL
  2802. ;                ;RECORD SIZE
  2803. DSATTR:    DS    1        ;RECORD ATTRIBUTE
  2804. ;                ;  B - RECORDS UNBLOCKED, UNSPANNED
  2805. ;                ;  R - RECORDS BLOCKED, SPANNED
  2806. ;                ;  B - RECORDS BLOCKED, UNSPANNED
  2807. DSBOE:    DS    5        ;GEGINNING OF EXTENT
  2808. DSPRL:    DS    1        ;PHYSICAL RECORD LENGTH
  2809. ;                ;  B - 128 BYTES
  2810. ;                ;  1 - 256 BYTES
  2811. ;                ;  2 - 512 BYTES
  2812. DSEOE:    DS    5        ;END OF EXTENT
  2813. DSRBF:    DS    1        ;RECORD/BLOCK FORMAT
  2814. ;                ;  MUST BE B OR F
  2815. DSBYPI:    DS    1        ;BYPASS INDICATOR
  2816. ;                ;  B - TRANSFER DATA
  2817. ;                ;  B - BYPASS TRANSFER
  2818. DSSS:    DS    1        ;DATASET SECURITY
  2819. ;                ;  B - NOT SECURED
  2820. ;                ;  ANYTHING - SECURED
  2821. DSWP:    DS    1        ;WRITE PROTECT
  2822. ;                ;  B - READ AND WRITE VALID
  2823. ;                ;  P - READ ONLY
  2824. DSETI:    DS    1        ;EXCHANGE TYPE INDICATOR
  2825. ;                ;  B - BASIC DATA EXCHANGE
  2826. ;                ;  ANYTHING - ADDITIONAL
  2827. ;                ;      CHECKING REQUIRED
  2828. DSMVI:    DS    1        ;MULTI-VOLUME INDICATOR
  2829. ;                ;  B - DATASET RESIDES ON
  2830. ;                ;      VOLUME ONLY
  2831. ;                ;  C - DATASET IS CONTINUED
  2832. ;                ;      ON ANOTHER VOLUME
  2833. ;                ;  L - LAST VOLUME OF DATA-
  2834. ;                ;      SET
  2835. DSVLSQ:    DS    2        ;VOLUME SEQUENCE NUMBER
  2836. DSCREDT: DS    6        ;CREATION DATE (YYMMDD)
  2837. DSRL:    DS    4        ;RECORD LENGTH
  2838. DSONRS:    DS    5        ;OFFSET TO NEXT RECORD SPACE
  2839.     DS    4        ;**RESERVED
  2840. DSEXPDT: DS    6        ;EXPIRATION DATE (YYMMDD)
  2841. DSVCI:    DS    1        ;VERIFY/COPY INDICATOR
  2842. ;                ;  B - DATASET CREATED
  2843. ;                ;  C - SUCCESSFULLY COPIED
  2844. ;                ;  V - DATASET VERIFIED
  2845.     DS    1        ;**RESERVED
  2846. DSEOD:    DS    5        ;END OF DATA
  2847.     DS    1        ;**RESERVED
  2848. DSLV:    DS    48        ;**RESERVED - LOW VALUES
  2849. ;
  2850. ;        *  DATA BUFFER 1  *
  2851. DATDSK1: DS    1        ;CURRENT DISK NO
  2852. DATTRK1: DS    1        ;CURRENT TRACK
  2853. DATSCT1: DS    1        ;CURRENT SECTOR
  2854. DATBUF1: DS    0
  2855. DATA1:    DS    80
  2856.     DS    48        ;FILLER
  2857. ;
  2858. ;        *  DATA BUFFER 2  *
  2859. DATDSK2: DS    1        ;CURRENT DISK NO
  2860. DATTRK2: DS    1        ;CURRENT TRACK NO
  2861. DATSCT2: DS    1        ;CURRENT SECTOR NO
  2862. DATBUF2: DS    0
  2863. DATA2:    DS    80
  2864.     DS    48        ;FILLER
  2865. ;
  2866. ;
  2867. ;
  2868. $+PRINT
  2869. $-PRINT
  2870. ;FILE        TRNSUBS.LIB
  2871. ;        * * * *  CHARACTER TRANSLATIONS  * * * *
  2872. ;PURPOSE    THESE ROUTINES PROVIDE THE MEANS OF TRANS-
  2873. ;        LATING CHARACTERS FROM ASCII TO EBCDIC OR
  2874. ;        VICE VERSA.  ALSO, THEY PROVIDE A MEANS
  2875. ;        FOR REMOVING UNWANTED CHARACTERS FROM PRINT
  2876. ;        LINES SUCH AS FOR A DUMP OF CORE.
  2877. ;INPUT
  2878. ;        A = CHARACTER TO BE TRNASLATED
  2879. ;OUTPUT
  2880. ;        A = TRANSLATED CHARACTER
  2881. ;REMARKS
  2882. ;        1.  EACH SUBROUTINE WILL ONLY BE GENERATED
  2883. ;            IF ITS GLOBAL IS SET TO TRUE.  THE GLO-
  2884. ;            BALS ARE:
  2885. ;            @TRNASEB - ASCII TO EBCDIC
  2886. ;            @TRNEBAS - EBCDIC TO ASCII
  2887. ;            @OUTTRN - OUTPUT TRANSLATION
  2888. ;
  2889. ;
  2890. ;
  2891. ;
  2892. ;
  2893. $+PRINT
  2894. $-PRINT
  2895. ;        * * *  TRANSLATE ASCII TO EBCDIC  * * *
  2896. ;PURPOSE    THIS ROUTINE TRANSLATES AN ASCII CHARACTER
  2897. ;        TO EBCDIC.
  2898. ;INPUT
  2899. ;        A = ASCII CHARACTER
  2900. ;OUTPUT
  2901. ;        A = EBCDIC CHARACTER
  2902. ;
  2903. ;
  2904. ;        DO INITIALIZATION.
  2905.     IF    @TRNASEB
  2906. TRNASEB: DS    0
  2907.     PUSH    BC        ;SAVE REGS.
  2908.     PUSH    HL
  2909.     MOV    C,A
  2910. ;
  2911. ;        TRANSLATE THE CHAR BY INDEXING INTO TABLE.
  2912.     ANI    07FH        ;ZERO HIGH ORDER BIT.
  2913.     MVI    B,0        ;BC=A
  2914.     MOV    C,A
  2915.     LXI    HL,ASEBTBL    ;HL=>TABLE.
  2916.     DAD    BC        ;INDEX INTO TABLE.
  2917.     MOV    A,M        ;GET TRNLTD CHAR.
  2918. ;
  2919. ;        RETURN TO CALLER.
  2920.     POP    HL        ;RESTORE REGS.
  2921.     POP    BC
  2922.     RET
  2923. ;
  2924. ;
  2925. ;
  2926. ;        * *  ASCII TO EBCDIC TRANSLATION TABLE  * *
  2927. ;
  2928. ASEBTBL: DS    0
  2929.     DB    000H,001H,002H,003H,004H,02DH,02EH,02FH        ;000-007
  2930.     DB    016H,005H,025H,00BH,00CH,00DH,00EH,00FH        ;008-015
  2931.     DB    010H,011H,012H,013H,014H,03DH,032H,026H        ;016-023
  2932.     DB    018H,019H,03FH,027H,01CH,01DH,01EH,01FH        ;024-031
  2933.     DB    040H,05AH,07FH,07BH,05BH,06CH,050H,07DH        ;032-039
  2934.     DB    04DH,05DH,05CH,04EH,06BH,060H,04BH,061H        ;040-047
  2935.     DB    0F0H,0F1H,0F2H,0F3H,0F4H,0F5H,0F6H,0F7H        ;048-055
  2936.     DB    0F8H,0F9H,07AH,05EH,04CH,07EH,06EH,06FH        ;056-063
  2937.     DB    07CH,0C1H,0C2H,0C3H,0C4H,0C5H,0C6H,0C7H        ;064-071
  2938.     DB    0C8H,0C9H,0D1H,0D2H,0D3H,0D4H,0D5H,0D6H        ;072-079
  2939.     DB    0D7H,0D8H,0D9H,0E2H,0E3H,0E4H,0E5H,0E6H        ;080-087
  2940.     DB    0E7H,0E8H,0E9H,0ADH,0E0H,0BDH,05FH,06DH        ;088-095
  2941.     DB    079H,081H,082H,083H,084H,085H,086H,087H        ;096-103
  2942.     DB    088H,089H,091H,092H,093H,094H,095H,096H        ;104-111
  2943.     DB    097H,098H,099H,0A2H,0A3H,0A4H,0A5H,0A6H        ;112-119
  2944.     DB    0A7H,0A8H,0A9H,0C0H,06AH,0D0H,0A1H,007H        ;120-127
  2945.     ENDIF
  2946. ;
  2947. ;
  2948. ;
  2949. ;
  2950. $+PRINT
  2951. $-PRINT
  2952. ;        * * *  TRANSLATE EBCDIC TO ASCII  * * *
  2953. ;PURPOSE    THIS ROUTINE TRANSLATES AN EBCDIC CHARACTER
  2954. ;        TO ASCII.
  2955. ;INPUT
  2956. ;        A = EBCDIC CHARACTER
  2957. ;OUTPUT
  2958. ;        A = ASCII CHARACTER
  2959. ;
  2960. ;
  2961. ;        DO INITIALIZATION.
  2962.     IF    @TRNEBAS
  2963. TRNEBAS: DS    0
  2964.     PUSH    BC        ;SAVE REGS.
  2965.     PUSH    HL
  2966.     MOV    C,A
  2967. ;
  2968. ;        TRANSLATE THE CHAR BY INDEXING INTO TABLE.
  2969.     MVI    B,0        ;BC=A
  2970.     MOV    C,A
  2971.     LXI    HL,EBASTBL    ;HL=>TABLE.
  2972.     DAD    BC        ;INDEX INTO TABLE.
  2973.     MOV    A,M        ;GET TRNLTD CHAR.
  2974. ;
  2975. ;        RETURN TO CALLER.
  2976.     POP    HL        ;RESTORE REGS.
  2977.     POP    BC
  2978.     RET
  2979. ;
  2980. ;
  2981. ;
  2982. ;        * *  EBCDIC TO ASCII TRANSLATION TABLE  * *
  2983. ;
  2984. EBASTBL: DS    0
  2985.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;00-07
  2986.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;08-0F
  2987.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;10-17
  2988.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;18-1F
  2989.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;20-27
  2990.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;28-2F
  2991.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;30-37
  2992.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;38-3F
  2993.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;40-47
  2994.     DB    020H,020H,020H,02EH,03CH,028H,02BH,07CH        ;48-4F
  2995.     DB    026H,020H,020H,020H,020H,020H,020H,020H        ;50-57
  2996.     DB    020H,020H,021H,024H,02AH,029H,03BH,07EH        ;58-5F
  2997.     DB    02DH,02FH,020H,020H,020H,020H,020H,020H        ;60-67
  2998.     DB    020H,020H,020H,02CH,025H,05FH,03EH,03FH        ;68-6F
  2999.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;70-77
  3000.     DB    020H,020H,03AH,023H,040H,027H,03DH,022H        ;78-7F
  3001.     DB    024H,020H,020H,020H,020H,020H,020H,020H        ;80-87
  3002.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;88-8F
  3003.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;90-97
  3004.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;98-9F
  3005.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;A0-A7
  3006.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;A8-AF
  3007.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;B0-B7
  3008.     DB    020H,020H,020H,020H,020H,020H,020H,020H        ;B8-BF
  3009.     DB    020H,041H,042H,043H,044H,045H,046H,047H        ;C0-C7
  3010.     DB    048H,049H,020H,020H,020H,020H,020H,020H        ;C8-CF
  3011.     DB    020H,04AH,04BH,04CH,04DH,04EH,04FH,050H        ;D0-D7
  3012.     DB    051H,052H,020H,020H,020H,020H,020H,020H        ;D8-DF
  3013.     DB    020H,020H,053H,054H,055H,056H,057H,058H        ;E0-E7
  3014.     DB    059H,05AH,020H,020H,020H,020H,020H,020H        ;E8-EF
  3015.     DB    030H,031H,032H,033H,034H,035H,036H,037H        ;F0-F7
  3016.     DB    038H,039H,020H,020H,020H,020H,020H,020H        ;F8-FF
  3017.     ENDIF
  3018. ;
  3019. ;
  3020. ;
  3021. ;
  3022. $+PRINT
  3023. $-PRINT
  3024. ;        * * *  OUPUT TRANSLATION  * * *
  3025. ;
  3026. ;PURPOSE    THE FOLLOWING ROUTINE AND TABLE ARE
  3027. ;        USED FOR OUTPUT TRANSLATION OF NON-
  3028. ;        PRINTABLE CHARACTERS.  FOR INSTANCE,
  3029. ;        IF THE CHARACTER IS A <CR>, IT WILL
  3030. ;        BE PRINTED AS A SPACE.
  3031. ;PROGRAMMER    ROBERT M. WHITE
  3032. ;DATE CODED    MAY 23, 1977
  3033. ;INPUT        A = CHARACTER TO BE TRANSLATED.
  3034. ;OUTPUT        A = TRANSLATED CHARACTER
  3035. ;
  3036. ;
  3037. ;
  3038. ;        DO INITIALIZATION.
  3039.     IF    @OUTTRN
  3040. OUTTRN: DS    0
  3041.     PUSH    BC        ;SAVE REGS.
  3042.     PUSH    HL
  3043.     MOV    C,A
  3044. ;
  3045. ;        TRANSLATE THE CHAR BY INDEXING INTO TABLE.
  3046.     ANI    07FH        ;ZERO HIGH ORDER BIT.
  3047.     MVI    B,0        ;BC=A
  3048.     MOV    C,A
  3049.     LXI    HL,OUTTBL    ;HL=>TABLE.
  3050.     DAD    BC        ;INDEX INTO TABLE.
  3051.     MOV    A,M        ;GET TRNLTD CHAR.
  3052. ;
  3053. ;        RETURN TO CALLER.
  3054.     POP    HL        ;RESTORE REGS.
  3055.     POP    BC
  3056.     RET
  3057. ;
  3058. ;
  3059. ;        * *  TRANSLATION TABLE  * *
  3060. OUTTBL:    DB    '                '    ;000 - 015
  3061.     DB    '                '    ;016 - 031
  3062.     DB    ' !"#$%&',027H,'()*+,-./'    ;032 - 047
  3063.     DB    '0123456789:;<=>?'    ;048 - 063
  3064.     DB    '@ABCDEFGHIJKLMNO'    ;064 - 079
  3065.     DB    'PQRSTUVWXYZ[\]^_'    ;080 - 095
  3066.     DB    ' abcdefghijklmno'    ;096 - 111
  3067.     DB    'pqrstuvwxyz{|}  '    ;112 - 127
  3068.     ENDIF
  3069. ;
  3070. ;
  3071. ;
  3072. ;
  3073. $+PRINT
  3074. ;END        TRNSUBS.LIB
  3075.     END
  3076.