home *** CD-ROM | disk | FTP | other *** search
- ;TARBELL LOAD - LOADS TAPES
- ;SAVED WITH TSAVE COMMAND
- ;
- ;FORMAT IS: TLOAD FN1.FT1
- ; OR: TLOAD FN1.FT1 FN2.FT2
- ;
- ;FN1.FT1 IS THE NAME OF THE FILE TO BE CREATED ON DISK,
- ;FN2.FT2 IS THE NAME THE FILE WAS TSAVED UNDER, IF
- ;DIFFERENT THAN FN1.FT1
- ;
- FCB EQU 5CH ;SYSTEM FCB
- ORG 100H ;TO TPA
- CALL START ;SKIP ID
- ID DB '(TLOAD 8/1/77)',0DH,0AH,'$'
- START POP D ;GET ID MSG
- MVI C,PRINT
- CALL BDOS ;PRINT ID
- ;INIT PRIVATE STACK
- LXI H,0 ;HL=0
- DAD SP ;HL=CCP'S STACK
- SHLD STACK ;SAVE CCP'S STACK POINTER
- LXI SP,STACK ;GET LOCAL STACK
- ;ERASE FN1.OLD IF IT EXISTS
- LXI H,FCB ;POINT TO FCB
- LXI D,MYFCB ;AND TO MY FCB
- MVI B,9 ;MOVE LENGTH
- CALL MOVE ;MOVE FILENAME TO MYFCB
- LXI D,MYFCB ;POINT TO FN1.OLD FCB
- MVI C,DELT ;DELETE FUNCTION
- CALL BDOS ;DELETE FN1.OLD, IGNORE ERRS
- ;SAVE FN1.FT1 OR FN2.FT2 FOR TAPE HEADER MATCH
- LXI H,FCB+1 ;GET FN1.FT1 POINTER
- LXI D,TAPEN ;POINT DE TO SAVE NAME AREA
- MVI B,11 ;NAME LENGTH
- LDA FCB+17 ;IS FM2.FT2 BLANK?
- CPI ' '
- JZ MOVEN ;YES, SAVE FN1.FT1
- ;SECOND NAME HAS BEEN SPECIFIED
- LXI H,FCB+17 ;POINT TO FN2.FT2
- MOVEN CALL MOVE ;SAVE THE TAPE NAME
- ;
- ;IF IT EXISTS, RENAME FN1.FT1 TO FN1.OLD
- ;
- LXI H,MYFCB ;POINT TO FN1.OLD
- LXI D,FCB+16 ;POINT TO SYSFCB+16
- MVI B,16 ;INIT MOVE LENGTH
- CALL MOVE ;SET UP FOR
- LXI D,FCB ;RENAME
- MVI C,REN ;FUNCTION, THEN
- CALL BDOS ;DO THE RENAME,
- ;IGNORE ERRORS.
- ;
- ;MAKE FN1.FT1 A NEW FILE
- ;
- LXI D,FCB ;POINT TO FCB
- MVI C,MAKE ;C=MAKE FUNCTION
- CALL BDOS ;MAKE THE FILE
- INR A ;SPACE IN DIRECTORY?
- JNZ DIROK ;YES
- ;
- ;NO DIRECTORY SPACE - PRINT ERROR, EXIT
- ;
- LXI D,NODIR ;POINT TO ERR MSG
- ERXIT MVI C,PRINT ;GET PRINT FUNCTION
- CALL BDOS ;PRINT ERROR MESSAVGE
- EXIT LHLD STACK ;GET CCP'S STACK
- SPHL ;RESTORE STACK
- RET ;RETURN TO CCP
- ;
- ;MAKE WAS SUCCESSFUL - OPEN FILE
- ;
- DIROK LXI D,FCB ;POINT TO FCB
- MVI C,OPEN ;GET 'OPEN' FUNCTION
- CALL BDOS ;OPEN THE FILE
- INR A ;SHOULD BE OK
- JNZ RDLP ;OPEN WAS OK
- ;
- ;OPEN FAILED - EXIT
- ;
- LXI D,OPNER ;POINT TO ERR MSG
- JMP ERXIT ;PRINT MSG, EXIT
- ;
- ;OPEN WAS OK - START READING
- ;
- RDLP EQU $ ;READ LOOP
- MVI A,10H ;GET TARBELL RESET CHAR
- OUT 6EH ;RESET TARBELL
- ;
- ;READ THE TAPE HEADER
- ;
- MVI B,11 ;# OF CHARS TO MATCH
- LXI H,TAPEN ;POINT TO NAME TO MATCH
- LXI D,73B0H ;'POKE' VDM ADDR TO SHOW NAME
- HEADR CALL TBIN ;READ CHAR
- STAX D ;POKE NAME ON VDM
- CMP M ;MATCH?
- JZ MATCH ;YES
- ;
- ;NO MATCH - TRY AGAIN
- ;
- JMP RDLP
- ;
- ;HEADER CHAR MATCHED, SEE IF DONE
- ;
- MATCH INX D ;POINT TO NEXT CHAR
- INX H ;POINT TO NEXT CHAR
- DCR B ;11 MATCHED?
- JNZ HEADR ;NO
- ;
- ;GOT HEADER MATCH, START READING
- ;
- LXI H,BUFF ;POINT TO BUFFER
- CALL TBIN ;READ THE NUMBER OF SECTORS
- STA NSEC ;SAVE NUMBER OF SECTORS
- MOV B,A ;SAVE IN B
- ORA A ;ZERO SECTORS (I.E. EOF)?
- JZ EOF ;YES, EOF
- XRA A
- STA CKSUM ;INIT CKSUM TO 0
- SECT MVI C,128 ;C=BYTES/SECTOR
- CHAR CALL TBIN ;READ A CHAR
- MOV M,A ;STORE IT
- INX H ;INCR BUFF POINTER
- DCR C ;MORE IN SECTOR?
- JNZ CHAR ;YES
- DCR B ;MORE SECTORS?
- JNZ SECT ;YES
- ;VERIFY CKSUM
- CALL TBIN ;READ CKSUM
- LDA CKSUM
- ORA A
- JZ NOCKS
- ;GOT CHECKSUM ERR
- LXI D,CSERM
- MVI C,PRINT
- CALL BDOS
- ;
- ;HAVE READ 1 BUFFER FULL, WRITE IT TO DISK
- ;
- NOCKS LXI H,BUFF ;GET BUFF ADDR
- SHLD BUFAD ;INIT 'WRITE FROM' ADDR
- WRLP LHLD BUFAD ;GET CURRENT BUFF ADDR
- XCHG ;MOVE TO D,E
- LXI H,128 ;HL=BUFF LENGTH
- DAD D ;POINT TO NEXT BUFFER
- SHLD BUFAD ;UPDATE BUFF ADDR
- MVI C,STDMA ;SET UP DMA
- CALL BDOS ;..ADDR
- LXI D,FCB ;WRITE
- MVI C,WRITE ;..A
- CALL BDOS ;..SECTOR
- ORA A ;CHECK STATUS
- JZ WROK ;WRITE WAS OK
- ;
- ;WRITE ERROR
- ;
- ADI '0' ;GET ERROR NUMBER FROM STAT
- STA WRERN ;SAVE ERROR #
- LXI D,WRERR ;GET MESSAGE ADDR
- JMP ERXIT ;PRINT MESSAGE, EXIT
- WROK LDA NSEC ;ARE WE
- DCR A ;..DONE
- STA NSEC ;..WRITING THIS SECTOR?
- JNZ WRLP ;NO
- JMP RDLP ;YES, READ NEXT BUFFER
- ;
- ;EOF REACHED - CLOSE FILE
- ;
- EOF LXI D,FCB
- MVI C,CLOSE
- CALL BDOS
- INR A ;CLOSE OK?
- JNZ EXIT ;YES, RETURN
- ;CLOSE ERROR
- LXI D,CLSER
- JMP ERXIT
- OPNER DB 'OPEN FAILED$'
- NODIR DB 'NO DIR. SPACE$'
- WRERR DB 'WRITE ERR '
- WRERN DB 0,'$'
- CSERM DB 'CKSUM',13,10,'$'
- CLSER DB 'CLOSE ERR$'
- ;MOVE ROUTINE, FROM HL TO DE FOR LENGTH IN B
- MOVE MOV A,M
- STAX D
- INX H
- INX D
- DCR B
- JNZ MOVE
- RET
- ;TARBELL INPUT ROUTINE
- TBIN IN 6EH
- ANI 10H
- JNZ TBIN
- IN 6FH
- ;CALC CKSUM
- PUSH H
- LXI H,CKSUM
- PUSH PSW ;SAVE CHAR
- XRA M ;CALC CKSUM
- MOV M,A ;SAVE CKSUM
- POP PSW
- POP H
- RET
- DS 30 ;STACK SPACE
- STACK DS 2 ;SAVE STACK POINTER HERE
- TAPEN DS 11 ;TAPE SAVE NAME
- MYFCB DS 9 ;0,FILENAME
- DB 'OLD' ;FOR DELETE, RENAME
- DB 0
- DS 20 ;END OF FCB
- CKSUM DS 1 ;CHECKSUM
- NSEC DS 1 ;NUMBER OF SECTORS READ
- BUFAD DW BUFF ;CURR DMA BUFF POINTER
- BUFF EQU $ ;START OF BUFFER
- ;
- ; BDOS EQUATES (VERSION 2)
- ;
- RDCON EQU 1
- WRCON EQU 2
- PRINT EQU 9
- OPEN EQU 15 ;0FFH=NOT FOUND
- CLOSE EQU 16 ; " "
- SRCHF EQU 17 ; " "
- SRCHN EQU 18 ; " "
- DELT EQU 19 ;NO RET CODE
- READ EQU 20 ;0=OK, 1=EOF
- WRITE EQU 21 ;0=OK, 1=ERR, 2=?, 0FFH=NO DIR SPC
- MAKE EQU 22 ;0FFH=BAD
- REN EQU 23 ;0FFH=BAD
- STDMA EQU 26
- BDOS EQU 5
- REIPL EQU 0
- END 100H
-