home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG006.ARK / TLOAD.ASM < prev    next >
Assembly Source File  |  1984-04-29  |  5KB  |  235 lines
  1. ;TARBELL LOAD - LOADS TAPES
  2. ;SAVED WITH TSAVE COMMAND
  3. ;
  4. ;FORMAT IS:    TLOAD FN1.FT1
  5. ;    OR:    TLOAD FN1.FT1 FN2.FT2
  6. ;
  7. ;FN1.FT1 IS THE NAME OF THE FILE TO BE CREATED ON DISK,
  8. ;FN2.FT2 IS THE NAME THE FILE WAS TSAVED UNDER, IF
  9. ;DIFFERENT THAN FN1.FT1
  10. ;
  11. FCB    EQU    5CH    ;SYSTEM FCB
  12.     ORG    100H    ;TO TPA
  13.     CALL    START    ;SKIP ID
  14. ID    DB    '(TLOAD 8/1/77)',0DH,0AH,'$'
  15. START    POP    D    ;GET ID MSG
  16.     MVI    C,PRINT
  17.     CALL    BDOS    ;PRINT ID
  18. ;INIT PRIVATE STACK
  19.     LXI    H,0    ;HL=0
  20.     DAD    SP    ;HL=CCP'S STACK
  21.     SHLD    STACK    ;SAVE CCP'S STACK POINTER
  22.     LXI    SP,STACK ;GET LOCAL STACK
  23. ;ERASE FN1.OLD IF IT EXISTS
  24.     LXI    H,FCB    ;POINT TO FCB
  25.     LXI    D,MYFCB ;AND TO MY FCB
  26.     MVI    B,9    ;MOVE LENGTH
  27.     CALL    MOVE    ;MOVE FILENAME TO MYFCB
  28.     LXI    D,MYFCB    ;POINT TO FN1.OLD FCB
  29.     MVI    C,DELT    ;DELETE FUNCTION
  30.     CALL    BDOS    ;DELETE FN1.OLD, IGNORE ERRS
  31. ;SAVE FN1.FT1 OR FN2.FT2 FOR TAPE HEADER MATCH
  32.     LXI    H,FCB+1    ;GET FN1.FT1 POINTER
  33.     LXI    D,TAPEN    ;POINT DE TO SAVE NAME AREA
  34.     MVI    B,11    ;NAME LENGTH
  35.     LDA    FCB+17    ;IS FM2.FT2 BLANK?
  36.     CPI    ' '
  37.     JZ    MOVEN    ;YES, SAVE FN1.FT1
  38. ;SECOND NAME HAS BEEN SPECIFIED
  39.     LXI    H,FCB+17 ;POINT TO FN2.FT2
  40. MOVEN    CALL    MOVE    ;SAVE THE TAPE NAME
  41. ;
  42. ;IF IT EXISTS, RENAME FN1.FT1 TO FN1.OLD
  43. ;
  44.     LXI    H,MYFCB    ;POINT TO FN1.OLD
  45.     LXI    D,FCB+16    ;POINT TO SYSFCB+16
  46.     MVI    B,16    ;INIT MOVE LENGTH
  47.     CALL    MOVE    ;SET UP FOR
  48.     LXI    D,FCB    ;RENAME
  49.     MVI    C,REN    ;FUNCTION, THEN
  50.     CALL    BDOS    ;DO THE RENAME,
  51.             ;IGNORE ERRORS.
  52. ;
  53. ;MAKE FN1.FT1 A NEW FILE
  54. ;
  55.     LXI    D,FCB    ;POINT TO FCB
  56.     MVI    C,MAKE    ;C=MAKE FUNCTION
  57.     CALL    BDOS    ;MAKE THE FILE
  58.     INR    A    ;SPACE IN DIRECTORY?
  59.     JNZ    DIROK    ;YES
  60. ;
  61. ;NO DIRECTORY SPACE - PRINT ERROR, EXIT
  62. ;
  63.     LXI    D,NODIR    ;POINT TO ERR MSG
  64. ERXIT    MVI    C,PRINT    ;GET PRINT FUNCTION
  65.     CALL    BDOS    ;PRINT ERROR MESSAVGE
  66. EXIT    LHLD    STACK    ;GET CCP'S STACK
  67.     SPHL        ;RESTORE STACK
  68.     RET        ;RETURN TO CCP
  69. ;
  70. ;MAKE WAS SUCCESSFUL - OPEN FILE
  71. ;
  72. DIROK    LXI    D,FCB    ;POINT TO FCB
  73.     MVI    C,OPEN    ;GET 'OPEN' FUNCTION
  74.     CALL    BDOS    ;OPEN THE FILE
  75.     INR    A    ;SHOULD BE OK
  76.     JNZ    RDLP    ;OPEN WAS OK
  77. ;
  78. ;OPEN FAILED - EXIT
  79. ;
  80.     LXI    D,OPNER    ;POINT TO ERR MSG
  81.     JMP    ERXIT    ;PRINT MSG, EXIT
  82. ;
  83. ;OPEN WAS OK - START READING
  84. ;
  85. RDLP    EQU    $    ;READ LOOP
  86.     MVI    A,10H    ;GET TARBELL RESET CHAR
  87.     OUT    6EH    ;RESET TARBELL
  88. ;
  89. ;READ THE TAPE HEADER
  90. ;
  91.     MVI    B,11    ;# OF CHARS TO MATCH
  92.     LXI    H,TAPEN     ;POINT TO NAME TO MATCH
  93.     LXI    D,73B0H    ;'POKE' VDM ADDR TO SHOW NAME
  94. HEADR    CALL    TBIN    ;READ CHAR
  95.     STAX    D    ;POKE NAME ON VDM
  96.     CMP    M    ;MATCH?
  97.     JZ    MATCH    ;YES
  98. ;
  99. ;NO MATCH - TRY AGAIN
  100. ;
  101.     JMP    RDLP
  102. ;
  103. ;HEADER CHAR MATCHED, SEE IF DONE
  104. ;
  105. MATCH    INX    D    ;POINT TO NEXT CHAR
  106.     INX    H    ;POINT TO NEXT CHAR
  107.     DCR    B    ;11 MATCHED?
  108.     JNZ    HEADR    ;NO
  109. ;
  110. ;GOT HEADER MATCH, START READING
  111. ;
  112.     LXI    H,BUFF    ;POINT TO BUFFER
  113.     CALL    TBIN    ;READ THE NUMBER OF SECTORS
  114.     STA    NSEC    ;SAVE NUMBER OF SECTORS
  115.     MOV    B,A    ;SAVE IN B
  116.     ORA    A    ;ZERO SECTORS (I.E. EOF)?
  117.     JZ    EOF    ;YES, EOF
  118.     XRA    A
  119.     STA    CKSUM    ;INIT CKSUM TO 0
  120. SECT    MVI    C,128    ;C=BYTES/SECTOR
  121. CHAR    CALL    TBIN    ;READ A CHAR
  122.     MOV    M,A    ;STORE IT
  123.     INX    H    ;INCR BUFF POINTER
  124.     DCR    C    ;MORE IN SECTOR?
  125.     JNZ    CHAR    ;YES
  126.     DCR    B    ;MORE SECTORS?
  127.     JNZ    SECT    ;YES
  128. ;VERIFY CKSUM
  129.     CALL    TBIN    ;READ CKSUM
  130.     LDA    CKSUM
  131.     ORA    A
  132.     JZ    NOCKS
  133. ;GOT CHECKSUM ERR
  134.     LXI    D,CSERM
  135.     MVI    C,PRINT
  136.     CALL    BDOS
  137. ;
  138. ;HAVE READ 1 BUFFER FULL, WRITE IT TO DISK
  139. ;
  140. NOCKS    LXI    H,BUFF    ;GET BUFF ADDR
  141.     SHLD    BUFAD    ;INIT 'WRITE FROM' ADDR
  142. WRLP    LHLD    BUFAD    ;GET CURRENT BUFF ADDR
  143.     XCHG        ;MOVE TO D,E
  144.     LXI    H,128    ;HL=BUFF LENGTH
  145.     DAD    D    ;POINT TO NEXT BUFFER
  146.     SHLD    BUFAD    ;UPDATE BUFF ADDR
  147.     MVI    C,STDMA    ;SET UP DMA
  148.     CALL    BDOS    ;..ADDR
  149.     LXI    D,FCB    ;WRITE
  150.     MVI    C,WRITE    ;..A
  151.     CALL    BDOS    ;..SECTOR
  152.     ORA    A    ;CHECK STATUS
  153.     JZ    WROK    ;WRITE WAS OK
  154. ;
  155. ;WRITE ERROR
  156. ;
  157.     ADI    '0'    ;GET ERROR NUMBER FROM STAT
  158.     STA    WRERN    ;SAVE ERROR #
  159.     LXI    D,WRERR    ;GET MESSAGE ADDR
  160.     JMP    ERXIT    ;PRINT MESSAGE, EXIT
  161. WROK    LDA    NSEC    ;ARE WE
  162.     DCR    A    ;..DONE
  163.     STA    NSEC    ;..WRITING THIS SECTOR?
  164.     JNZ    WRLP    ;NO
  165.     JMP    RDLP    ;YES, READ NEXT BUFFER
  166. ;
  167. ;EOF REACHED - CLOSE FILE
  168. ;
  169. EOF    LXI    D,FCB
  170.     MVI    C,CLOSE
  171.     CALL    BDOS
  172.     INR    A    ;CLOSE OK?
  173.     JNZ    EXIT    ;YES, RETURN
  174. ;CLOSE ERROR
  175.     LXI    D,CLSER
  176.     JMP    ERXIT
  177. OPNER    DB    'OPEN FAILED$'
  178. NODIR    DB    'NO DIR. SPACE$'
  179. WRERR    DB    'WRITE ERR '
  180. WRERN    DB    0,'$'
  181. CSERM    DB    'CKSUM',13,10,'$' 
  182. CLSER    DB    'CLOSE ERR$'
  183. ;MOVE ROUTINE, FROM HL TO DE FOR LENGTH IN B
  184. MOVE    MOV    A,M
  185.     STAX    D
  186.     INX    H
  187.     INX    D
  188.     DCR    B
  189.     JNZ    MOVE
  190.     RET
  191. ;TARBELL INPUT ROUTINE
  192. TBIN    IN    6EH
  193.     ANI    10H
  194.     JNZ    TBIN
  195.     IN    6FH
  196. ;CALC CKSUM
  197.     PUSH    H
  198.     LXI    H,CKSUM
  199.     PUSH    PSW    ;SAVE CHAR
  200.     XRA    M    ;CALC CKSUM
  201.     MOV    M,A    ;SAVE CKSUM
  202.     POP    PSW
  203.     POP    H
  204.     RET
  205.     DS    30    ;STACK SPACE
  206. STACK    DS    2    ;SAVE STACK POINTER HERE
  207. TAPEN    DS    11    ;TAPE SAVE NAME
  208. MYFCB    DS    9    ;0,FILENAME
  209.     DB    'OLD'    ;FOR DELETE, RENAME
  210.     DB    0
  211.     DS    20    ;END OF FCB
  212. CKSUM    DS    1    ;CHECKSUM 
  213. NSEC    DS    1    ;NUMBER OF SECTORS READ
  214. BUFAD    DW    BUFF    ;CURR DMA BUFF POINTER
  215. BUFF    EQU    $    ;START OF BUFFER
  216. ;
  217. ; BDOS EQUATES (VERSION 2)
  218. ;
  219. RDCON    EQU    1
  220. WRCON    EQU    2
  221. PRINT    EQU    9
  222. OPEN    EQU    15    ;0FFH=NOT FOUND
  223. CLOSE    EQU    16    ;   "    "
  224. SRCHF    EQU    17    ;   "    "
  225. SRCHN    EQU    18    ;   "    "
  226. DELT    EQU    19    ;NO RET CODE
  227. READ    EQU    20    ;0=OK, 1=EOF
  228. WRITE    EQU    21    ;0=OK, 1=ERR, 2=?, 0FFH=NO DIR SPC
  229. MAKE    EQU    22    ;0FFH=BAD
  230. REN    EQU    23    ;0FFH=BAD
  231. STDMA    EQU    26
  232. BDOS    EQU    5
  233. REIPL    EQU    0
  234.     END    100H
  235.