home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Oakland CPM Archive
/
oakcpm.iso
/
cpmug
/
cpmug006.ark
/
SLOAD.ASM
< prev
next >
Wrap
Assembly Source File
|
1984-04-29
|
4KB
|
231 lines
;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