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
/
BLOAD.ASM
next >
Wrap
Assembly Source File
|
1984-04-29
|
5KB
|
304 lines
;BLOAD -
;PROGRAM TO READ TARBELL 8K BASIC 3.1 TAPES
;AND CREATE A SOURCE FILE
TEST EQU 0H
;5/17/77 WRITTEN
ORG 100H
JMP START ;SKIP ID
DB '(BLOAD 5/17/77)','Z'-40H
START EQU $
;
IF NOT TEST
MVI C,DELT
CALL DKFNC ;ERASE OLD FILE
MVI C,MAKE
CALL DKFNC
INR A
JZ WRERR
ENDIF
;
LXI H,BUFF
;READ FILE INTO MEMORY FROM TAPE
RESET MVI A,10H
OUT 6EH
INIT CALL TBIN
CPI 0E6H
JZ INIT ;SKIP DOUBLE SYNC
STA 7300H ;SHOW CHAR BEING LOADED
RD3 MVI D,3
RDLP CALL TBIN
MOV M,A
INX H
ORA A
JNZ RD3
DCR D
JNZ RDLP
;CONVERT AND WRITE
LXI D,80H ;OUTPUT BUFFER ADDR
LXI H,BUFF
INX H ;SKIP NEXT
INX H ;..ADDR
LINE CALL BIASC ;CONV LINE #
CHAR MOV A,M ;GET A CHAR
INX H ;POINT TO NEXT
ORA A
JZ CRLF ;END OF LINE
JM KEYWD ;IT IS A TOKEN
;STORE CHAR
CALL STORE
JMP CHAR
;
CRLF MVI A,13
CALL STORE
MVI A,10
CALL STORE
MOV A,M ;GET NEXT LINE ADDR
INX H
ORA M
INX H
JNZ LINE ;GET NEXT LINE
;
IF NOT TEST
;
;ALL DONE - WRITE LAST BLOCK, CLOSE FILE
;
MVI A,'Z'-40H ;EOF CHAR
CALL STORE
MVI C,WRITE
CALL DKFNC
ORA A
JNZ WRERR
MVI C,CLOSE
CALL DKFNC
;
ENDIF
JMP 0
;
;PROCESS KEYWORD
;
KEYWD PUSH H ;SAVE INPUT POINTER
LXI H,TABLE ;POINT TO KEYWORD TABLE
SUI 7FH ;FUDGE
MOV C,A ;SAVE TOKEN #
PUSH D ;SAVE OUTPUT POINTER
KEY10 PUSH H ;SAVE START OF TOKEN
KEY20 MOV A,M ;GET CHAR
INX H ;POINT TO NEXT
ORA A ;SET COND
JP KEY20 ;KEEP GOING
DCR C ;RIGHT TOKEN?
POP D ;GET START OF TOKEN ADDR
JNZ KEY10 ;NOT RIGHT ONE
;
;GOT TOKEN
;
XCHG ;TOKEN TO H,L
POP D ;GET OUTPUT ADDR
;
;MOVE TOKEN TO OUTPUT
;
KEY30 MOV A,M ;GET CHAR OF TOKEN
ANI 7FH ;DELETE HI BIT
CALL STORE ;STORE IT
MOV A,M ;GET CHAR
INX H ;POINT TO NEXT
ORA A ;END OF TOKEN?
JP KEY30 ;..NO
POP H ;GET INPUT POINTER
JMP CHAR
;
;ROUTINE TO STORE OUTPUT, WRITE FULL BUFFER
;
STORE PUSH PSW ! PUSH B ! PUSH D ! PUSH H
MOV E,A
MVI C,WRCON
CALL BDOS ;PRINT CHAR
POP H ! POP D ! POP B ! POP PSW
;
IF NOT TEST
STAX D ;SAVE THE CHAR
INR E ;BUMP
RNZ
PUSH B
MVI C,WRITE
CALL DKFNC ;WRITE A SECTOR
POP B
MVI E,80H ;RE-INIT BUFFER ADDR
;
ENDIF
RET
IF NOT TEST
;
;DISK FUNCTIONS - FNC IS IN C
;
DKFNC PUSH H
PUSH D
LXI D,FCB
CALL BDOS
POP D
POP H
RET
;WRITE ERROR
WRERR LXI D,WRERM
MVI C,PRINT
CALL BDOS
JMP 0
WRERM DB 'WRITE ERROR$'
;
ENDIF
;TARBELL INPUT
TBIN IN 6EH
ANI 10H
JNZ TBIN
IN 6FH
RET
;
;CONVERT LINE $ FROM BINARY TO ASCII
;
BIASC PUSH B
MOV C,M ;GET LO ORD
INX H
MOV B,M ;GET HI ORD
INX H ;SKIP HI ORD
PUSH H
MOV H,B
MOV L,C
XRA A ;ZERO
STA ZSFLG ;ZERO SUPPRESS FLAG
LXI B,-10000
CALL SBT
LXI B,-1000
CALL SBT
LXI B,-100
CALL SBT
LXI B,-10
CALL SBT
MOV A,L
ORI '0'
CALL STORE
POP H
POP B
MVI A,' '
CALL STORE ;SPACE AFTER LINE #
RET
;
;SUBROUTINE TO ADD BC TO HL
;AND COUNT DECIMAL # TIMES
;
SBT PUSH D
MVI D,'0'
SBTLP PUSH H ;SAVE FOR RESTORE
DAD B ;'SUBTRACT'
JNC NOSBT ;COULDN'T SBTTRACT
INR D ;INCR DECIMAL VALUE
INX SP ;DELETE
INX SP ;SAVED HL
JMP SBTLP
NOSBT POP H ;RESTORE VALUE
MOV A,D ;GET DIGIT
POP D
CPI '0' ;IF NOT ZERO
JZ CKZER ;IS ZERO - CK '0' SUPPRESS
;NOT ZERO - TURN OFF ZERO SUPPRESS FLAG
STA ZSFLG
JMP STORE ;STORE THE CHAR
;IT IS A ZERO - CHECK FOR ZERO SUPPRESS
CKZER LDA ZSFLG ;GET THE FLAG
ORA A ;SET COND CODE
MVI A,'0'
JNZ STORE
RET ;NO STORE IF SUPPRESSED
;
; 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
FCB EQU 5CH
TABLE DB 'EN','D'+128
DB 'FO','R'+128
DB 'NEX','T'+128
DB 'DAT','A'+128
DB 'INPU','T'+128
DB 'DI','M'+128
DB 'REA','D'+128
DB 'LE','T'+128
DB 'GOT','O'+128
DB 'RU','N'+128
DB 'I','F'+128
DB 'RESTOR','E'+128
DB 'GOSU','B'+128
DB 'RETUR','N'+128
DB 'RE','M'+128
DB 'STO','P'+128
DB 'OU','T'+128
DB 'O','N'+128
DB 'NUL','L'+128
DB 'WAI','T'+128
DB 'POK','E'+128
DB 'PRIN','T'+128
DB 'DE','F'+128
DB 'CON','T'+128
DB 'LIS','T'+128
DB 'CLEA','R'+128
DB 'DLOA','D'+128
DB 'DSAV','E'+128
DB 'NE','W'+128
DB 'TAB','('+128
DB 'T','O'+128
DB 'SPC','('+128
DB 'F','N'+128
DB 'THE','N'+128
DB 'NO','T'+128
DB 'STE','P'+128
DB '+'+128
DB '-'+128
DB '*'+128
DB '/'+128
DB '^'+128
DB 'AN','D'+128
DB 'O','R'+128
DB '>'+128
DB '='+128
DB '<'+128
DB 'SG','N'+128
DB 'IN','T'+128
DB 'AB','S'+128
DB 'US','R'+128
DB 'FR','E'+128
DB 'IN','P'+128
DB 'PO','S'+128
DB 'SQ','R'+128
DB 'RN','D'+128
DB 'LO','G'+128
DB 'EX','P'+128
DB 'CO','S'+128
DB 'SI','N'+128
DB 'TA','N'+128
DB 'AT','N'+128
DB 'PEE','K'+128
DB 'LE','N'+128
DB 'STR','$'+128
DB 'VA','L'+128
DB 'AS','C'+128
DB 'CHR','$'+128
DB 'LEFT','$'+128
DB 'RIGHT','$'+128
DB 'MID','$'+128
DB 0 ;END OF TABLE
ZSFLG DB 0 ;ZERO SUPPRESS FLAG
BUFF EQU $ ;READ PROGRAM IN HERE
END 100H