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
/
MBUG
/
MBUG084.ARC
/
ZPILOT.Z80
< prev
Wrap
Text File
|
1979-12-31
|
7KB
|
342 lines
;Z-80 PILOT
BDOS: EQU 5
SFCB: EQU 5CH
FTYP: EQU 65H
FTYP1: EQU 66H
FEXT: EQU 68H ; EXTENT
FNR: EQU 7CH ; RECORD NUMBER
OSLVL: EQU 0 ; RETURN TO CP/M
;
;
; READ IN PILOT SOURCE FILE
; <NAME>.PLT
;
ORG 100H ; FOR CP/M
LD SP,WORK
LD A,'P'
LD (FTYP),A
LD BC,'TL'
LD (FTYP1),BC ; FTYPE:='PLT'
XOR A
LD (FEXT),A ; EXTENT:=0
LD (FNR),A ; RECORD NO:=0
;
LD C,15
LD DE,SFCB
CALL BDOS ; OPEN FILE
CP 255 ; IF =255 THEN FILE NOT FOUND
JR NZ,RDLPX
LD DE,HUH
LD C,9
CALL BDOS
JP 0 ; GO BYE-BYE
;
HUH: DB 'HUH - NO FILE .PLT $'
;
;
RDLPX: LD DE,WORK
RDLP: PUSH DE
LD C,26 ; SET DMA ADDRESS
CALL BDOS
LD DE,SFCB
LD C,20 ; READ RECORD
CALL BDOS
POP DE
LD HL,128
ADD HL,DE
EX DE,HL ; DMA ADR:=DMA ADR+128
;
OR A
JR Z,RDLP
;
LD HL,WORK
;
;COMMAND TABLE
PILOT: LD B,':'
LD C,EOF
CALL ADVANC ;INCREMENT LINE POINTER
JP NZ,OSLVL ;END OF PROGRAM
LD (MARKER),HL
BACKUP: DEC HL
LD A,(HL)
CP ' '
JR Z,BACKUP
CP 'E'
JP Z,OSLVL
CP 'J'
JR Z,JUMP
CP 'M'
JR Z,MATCH
CP 'N'
JR Z,NO
CP 'R' ;REMARK
JR Z,NXTLIN
CP 'Y'
JR Z,YES
CP 'A'
JR Z,ACCEPT ;UNRECOG & NULL COMMANDS
JR TYPE ;ARE TAKEN TO BE "TYPE"
;
;COMMANDS
NO: EXX
SUB A
CP B
EXX ;IF THE MATCH FLAG IS OFF
JR Z,BACKUP ;EXECUTE CURRENT COMMAND
JR NXTLIN ;ELSE GO TO THE NEXT LINE
;
YES: EXX
SUB A
CP B
EXX ;IF THE MATCH FAG IS ON
JR NZ,BACKUP ;EXECUTE CURRENT COMMAND
JR NXTLIN ;ELSE GO THE NEXT LINE
;
JUMP: CALL TEXT ;PUT HL ON THE LABEL
LD DE,LABEL ;AND DE ON LABEL BUFFER
LD A,'*'
CALL SEARCH ;SEEK *LABEL IN THE TEXT
JR Z,PILOT
LD E,'*' ;MESSAGE *
LD C,2 ; IF LABEL WAS NOT FOUND
CALL BDOS
JR NXTLIN
;
TYPE: LD HL,(MARKER)
;
NXTCHR: INC HL
PUSH HL
LD E,(HL)
LD C,2 ; OUTPUT NEXT CHAR
CALL BDOS
POP HL
LD A,(HL)
CP ASCICR
JR NZ,NXTCHR ; UNTIL CR
;
LD E,LF ; ALSO DO LF
LD C,2
CALL BDOS
;
NXTLIN: LD HL,(MARKER)
JR PILOT ;RETURN FOR NEXT INSTRUCTIONS
;
MATCH: CALL TEXT ;ROLL UP TO
NXTSTR: LD (STRING),HL ;FIRST CARACTER IN MATCH
EX DE,HL ;SPIKE DE
EXX
SUB A
LD B,A ;RESET THE MATCH FLAG
EXX
LD HL,RESPNS
LD B,ASCICR
LD C,',' ;SEEK THE MATCH STRING
CALL FIND ;IN THE RESPONSE BUFFER
JR NZ,MORE ;IF FAIL, SEEK NEXT STRING
EXX
INC A
LD B,A ;SET MATCH FLAG FOR HIT
EXX
JR NXTLIN
MORE: EX DE,HL
ADV: LD A,(HL) ;ROLL UP TO NEXT STRING
CP ASCICR ;END THE OF MATCH STRINGS
JR Z,NXTLIN
CP ',' ;STRING DELIMITER
INC HL
JR NZ,ADV
JR NXTSTR
;
ACCEPT: ;GET INPUT LINE FROM USER
LD E,'>'
LD C,2
CALL BDOS ; SEND ACCEPT PROMPT
;
LD C,10
LD DE,IBUF
CALL BDOS ; READ LINE/BUFFERED
LD E,LF
LD C,2
CALL BDOS ; ADD LINE FEED
LD HL,INPUT
LD A,(IBUF1)
LD E,A
LD D,0
ADD HL,DE
LD (HL),ASCICR ; FLAG END OF LINE WITH CR
;
LD HL,INPUT ;SOURCE IS INPUT BUFFER
; TO RETURN TO CP/M USE CTRL-C
LD DE,RESPNS ;TARGET IS RESPONSE BUFFER
LD BC,LINLIM ;TRANSFER USER'S INPUT
LDIR ;TO THE RESPONSE BUFFER
LABELX: LD HL,(MARKER)
LABELA: DEC HL ;CHECK FOR LABEL
LD A,(HL)
CP ASCICR ;IF THERE IS NO LABEL
JR Z,NXTLIN ;RETURN FOR NEXT INSTRUCT
CP '*' ;LABEL DESIGNATOR
JR NZ,LABELA
INC HL ;SOURCE IS THE LABEL
LD DE,LABEL ;TARGET IS LABEL BUFFER
LD A,'\' ;LABEL REFERENCE MARK
CALL SEARCH ;IF ACCEPT HAS NO LABEL
JR NZ,NXTLIN ;RETURN FOR NEXT INSTRUCT
;DELET/LABEL FROM TEXT
PUSH HL ;START OF TAIL = /LABEL+1
LD E,EOF ;END-OF-TAIL MARK
CALL SPAN ;LENGTH OF TAIIIL IS IN BC
LD (TALSIZ),BC
POP HL ;SOURCE IS START OF TAIL
LD DE,(POINTR) ;TARGET IS START OF /LABEL
PUSH DE
LDIR ;CLOSE UP TAIL OVER /LABEL
DEC DE
PUSH DE ;CURRENT BOTTOM
;MEASURE LENGTH OF RESPONSE
LD HL,RESPNS
LD E,ASCICR
CALL SPAN
POP HL ;CURRENT BOTTOM
DEC BC ;ACCOUNT FOR CR
PUSH BC ;LENGTH OF RESPONSE IN BC
; MOVE TAIL OUT OF BC BYTES
PUSH HL
ADD HL,BC
EX DE,HL ;TARGET IS THE NEW BOTTOM
POP HL ;TARGET IS THE OLD BOTTOM
LD BC,(TALSIZ) ;LENGTH OF TAIL IS IN BC
LDDR ;MOVE OUT THE TAIL
; MOVE RESPONSE INTO TEXT
POP BC ;LENGTH OF RESPONSE IN BC
POP DE ;TARGET IS START OF INSERT
LD HL,RESPNS ;SOURCE IS RESPONSE BUFFER
LDIR
; TRUNCATE LINE IF TOO LONG
BACK: DEC DE
LD A,(DE)
CP ':' ;CARRY DE BACK TO MARKER
JR NZ,BACK
LD BC,LINLIM+1 ;CUNT UP ONE LINE LENGTH
ROLLUP: INC DE
LD A,(DE)
CP ASCICR
JR Z,LABELX ;SUBSTITUTION COMPLETED
DJNZ ROLLUP
ROLLBK: DEC DE
LD A,(DE)
CP ' '
JR NZ,ROLLBK
; INSERT CR: IN TEXT AT END OF FIRST LINE
LD A,ASCICR
LD (DE),A ;SALVAGE TAIL AS :NEW LINE
EX DE,HL ;PUT HL ON THE TAIL
LD E,EOF
CALL SPAN ;LENGTH OF TAIL IS IN BC
PUSH HL ;SOURCE IS THE OLD BOTTOM
INC HL
EX DE,HL ;TARGET IS OLD BOTTOM + 1
POP HL
LDDR ;MOVE OUT TEXT BY 1 BYTE
LD A,':' ;SET A MARKER ON RESIDUUM
LD (HL),A
; LOOK FOR /LABEL AGAIN & REPEAT UNTIL EOF
JR LABELX
;
; SUBROUTINES
ADVANC: INC HL
ADVNCE: LD A,(HL)
CP C ; TERMINATOR IN C
JR Z,NOFIND
CP B ;ROLL HL UP TO CHAR IN B
JR NZ,ADVANC
RET
NOFIND: INC A ;SET NZ CONDITION FOR FAIL
RET
;
SEARCH: LD (DE),A ;ENTRY FROM JUMP & ACCEPT
LD (STRING),DE
INC DE ;START LABEL BUFFER WITH
LD BC,6 ;SPECIAL CHARACTER
LDIR ;* IF JUMP, / IF ACCEPT
LD A,' ' ;LABEL TO LABEL BUFFER
LD (DE),A ;ADD BLANK FOR A DELIMITER
LD B,EOF
LD C,A ; SEARCH ENTIRE TEXT
LD HL,WORK ; FROM TOP TO BOTTOM
FIND: LD (POINTR),HL ;ENTRY FROM MATCH
LD A,B
CP (HL)
JR Z,FAIL ; FAIL
LD DE,(STRING)
LD A,(DE)
CP (HL)
INC HL
JR NZ,FIND ; FIND MATCH ON FIRST CHAR
MATCHX: INC DE ; THEN CHECK FOR MATCH
LD A,(DE) ; IN REST OF STRING
CP C
JR Z,END ; HIT
CP ASCICR
JR Z,END ; HIT
CP (HL)
INC HL
JR Z,MATCHX
LD HL,(POINTR)
INC HL
JR FIND
FAIL: INC A ; SET NZ COND. FOR FAIL
RET
;
END: BIT MTCHFL,B ; TEST IF IN SEARCH
RET Z ; RETURN IF IN MATCH
LD A,(HL)
CP ' ' ; PREVENTS CONFUSION
RET Z
CP ',' ; OF LABEL SUCH AS
RET Z
CP '.' ; ANT & ANTLER
RET Z
CP ASCICR
JR NZ,FIND
RET ; RETURN Z CONDITION IF HIT
;
SPAN: LD BC,1
COUNT: INC HL
INC BC
LD A,(HL) ; RETURN LENGTH BC STRING
CP E
JR NZ,COUNT
RET
;
TEXT: LD HL,(MARKER) ; STARTING AT THE :
BLANKS: INC HL
LD A,(HL) ; ROOLS HL UP TO THE FIRST
CP ' '
JR Z,BLANKS ; WORD IN THE TEXT LINE
RET
;
;
; CONSTANTS
;
MTCHFL: EQU 7
LINLIM: EQU 81
LF: EQU 10
ASCICR: EQU 13
EOF: EQU 01AH
;
; WORKSPACE
;
LABEL: DS 6
TALSIZ: DS 2
MARKER: DS 2
POINTR: DS 2
STRING: DS 2
RESPNS: DS 1
IBUF: DB 80 ; FLAG BUFFER LENGTH
IBUF1: DB 0 ; ACTUAL LINE LEN.
INPUT: DS 80 ; ACTUAL BUFFER
DS 50 ; STACK AREA
WORK: EQU $