home *** CD-ROM | disk | FTP | other *** search
- ;TARBELL SOURCE LOAD
- ;COMPATIBLE WITH CCOS
- ;
- ;DELETES LINE NUMBERS, CHANGES SPACES TO TABS,
- ;ATTEMPTS TO INSERT ';' BEFORE OPERAND COMMENTS
- ORG 100H ;TO TPA
- FCB EQU 5CH
- TFCB EQU FCB+16 ;TEMP FCB FOR RENAME
- TAB EQU 9 ;ASCII TAB
- CURS EQU 3FFEH ;VDM CURSOR
- LXI SP,STACK ;GET PRIVATE STACK
- ;IF FILE EXISTS, RENAME IT TO 'NAME.BAK'
- LXI D,FCB
- MVI C,SRCHF ;FIND IN DIRECTORY
- CALL BDOS
- INR A ;FF=>NOT FOUND
- JZ NEWF ;NEW FILE
- ;FILE ALREADY EXISTS - ERASE BACKUP COPY
- LXI H,FCB ;POINT TO FCB
- LXI D,TFCB ;POINT TO TEMP FCB
- MVI B,16 ;GET MOVE LENGTH
- CALL MOVE ;MOVE IT
- LXI H,BAK ;POINT TO 'BAK'
- LXI D,TFCB+9
- MVI B,3 ;MOVE LENGTH
- CALL MOVE
- ;ERASE BACKUP FILE
- LXI D,TFCB
- MVI C,DELT
- CALL BDOS ;DELETE BACKUP
- ;RENAME CURRENT NAME TO NAME.BAK
- LXI D,FCB
- MVI C,REN
- CALL BDOS ;RENAME
- ;MAKE NEW FILE
- NEWF LXI D,FCB
- MVI C,MAKE
- CALL BDOS
- INR A ;ROOM IN DIRECTORY?
- JNZ NEWOK ;YES
- ;NO ROOM IN DIRECTORY
- LXI D,NORMG
- ERXIT MVI C,09
- CALL BDOS ;PRINT ERROR MESSAGE
- JMP 0 ;--EXIT--
- NORMG DB 'NO ROOM IN DIRECTORY$'
- READY DB 'TURN ON TAPE $'
- BAK DB 'BAK'
- ;NEW FILE MAKE WAS OK
- ;TYPE 'READY' MESSAGE
- NEWOK LXI D,READY
- MVI C,9
- CALL BDOS
- ;TYPE NAME ON SCREEN
- LHLD CURS ;GET CURSOR
- MVI B,5 ;FILE NAME LENGTH
- MVI A,10H ;TARBELL RESET
- OUT 6EH ;RESET
- NAME CALL TBIN
- MOV M,A
- INX H
- DCR B ;NAME PRINTED?
- JNZ NAME
- SHLD CURS
- ;READ THE TARBELL FILE
- LXI H,BUFF ;POINT TO END OF PROGRAM
- ;READ A LINE FROM TARBELL
- LINE CALL TBIN ;READ LINE LENGTH
- DCR A ;IS IS EOF?
- JZ EOF ;YES
- ;SKIP LINE NO
- MVI B,5 ;NNNN' '
- SKIP1 CALL TBIN
- DCR B
- JNZ SKIP1
- ;READ LABEL, OR BLANK
- RDLB CALL TBIN
- CPI '*'
- JZ COMM ;READ COMMENT IN AS IS
- CPI ' ' ;UNLABELED STMT?
- JZ NOLAB
- CPI 13 ;END OF LINE?
- JZ EOL
- ;MOVE LABEL
- MVLB MOV M,A
- CALL CHECK
- JMP RDLB ;LOOP READING LABEL
- ;NO LABEL, OR END OF LABEL
- NOLAB MVI M,TAB ;STORE TAB CHAR
- CALL CHECK ;POINT TO OP CODE
- ;READ OP CODE
- RDOP CALL TBIN
- CPI ' '
- JZ ENDOP
- CPI 13
- JZ EOL ;END OF LINE
- MOV M,A ;STORE OP CODE CHAR
- CALL CHECK
- JMP RDOP ;CONTINUE READING OP CODE
- ;END OF OP CODE
- ENDOP MVI M,TAB ;INSERT TAB
- CALL CHECK
- ;MOVE OPERAND
- MVOPE CALL TBIN
- CPI ' ' ;END OF OPERAND?
- JZ BUFFE ;YES
- CPI 13 ;END OF LINE?
- JZ EOL ;YES
- MOV M,A
- CALL CHECK
- JMP MVOPE
- ;END OF OPERAND
- BUFFE MVI M,TAB ;TAB TO COMMENTS
- CALL CHECK
- MVI A,';' ;OPERAND COMMENT
- ;MOVE COMMENTS
- COMM MOV M,A ;STORE '*' OR ';'
- CALL CHECK
- CALL TBIN
- CPI 13
- JNZ COMM
- ;STORE CR/LF FOR END OF LINE
- EOL MVI M,13
- CALL CHECK
- MVI M,10 ;LINEFEED
- CALL CHECK
- JMP LINE ;READ NEXT LINE
- ;EOF REACHED
- EOF MVI M,'Z'-40H ;EOF CHAR
- ;OPEN FILE
- LXI D,FCB
- MVI C,OPEN
- CALL BDOS
- INR A
- JZ OPERR
- ;WRITE THE FILE
- WRLP LXI D,80H ;POINT TO FILE BUFFER
- LHLD BUFAD ;POINT TO BUFFER
- MVI B,80H ;MAX MOVE LENGTH
- WMOVE MOV A,M ;GET CHAR
- STAX D ;STORE IT
- INX H
- INX D
- CPI 'Z'-40H ;EOF?
- JZ FINAL ;YES, FINAL WRITE
- DCR B ;128 MOVED?
- JNZ WMOVE
- CALL WRSEC ;WRITE THE RECORD
- LHLD BUFAD ;GET BUFFER ADDRESS
- LXI D,128 ;GET BUFFER LENGTH
- DAD D ;CALC NEW ADDR
- SHLD BUFAD ;SAVE BUFFER ADDR
- JMP WRLP
- ;WRITE FINAL BLOCK
- FINAL CALL WRSEC
- LXI D,FCB
- MVI C,CLOSE
- CALL BDOS ;CLOSE THE FILE
- INR A ;OK?
- JZ CLSER
- LXI D,OKMSG
- JMP ERXIT
- OKMSG DB 'DONE$'
- CLSER LXI D,CLSERM
- JMP ERXIT
- CLSERM DB 'CLOSE ERR$'
- ;WRITE A RECORD
- WRSEC LXI D,FCB
- MVI C,WRITE
- CALL BDOS
- ORA A ;WROTE OK?
- RZ
- ;WRITE ERROR
- LXI D,WERMG
- JMP ERXIT
- WERMG DB 'WRITE ERR$'
- ;OPEN ERROR
- OPERR LXI D,OPERM
- JMP ERXIT
- OPERM DB 'OPEN ERR$'
- ;MOVE CHAR ROUTINE, HL TO DE, LENGTH IN B
- MOVE MOV A,M
- STAX D
- INX H
- INX D
- DCR B
- JNZ MOVE
- RET
- ;ROUTINE TO INX H AND CHECK MEMORY OVERALY
- CHECK INX H
- LDA 7 ;GET BDOS PAGE ADDR
- CMP H ;CHECK
- RNC ;RET IF OK
- LDA 6 ;GET BDOS PAGE DISPL
- CMP L
- RNC
- ;MEMORY OVERLAY
- LXI D,NOSTG
- JMP ERXIT
- NOSTG DB 'FILE WON''T FIT IN MEMORY$'
- ;TARBELL INPUT ROUTINE
- TBIN IN 6EH
- ANI 10H
- JNZ TBIN
- IN 6FH
- RET
- ;
- DS 30 ;STACK AREA
- STACK DS 2
- BUFAD DW BUFF
- BUFF EQU $ ;READ PROGRAM INTO HERE
- ;
- ; 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
-