home *** CD-ROM | disk | FTP | other *** search
- ; THIS WORK WAS PREPARED UNDER CONTRACT TO THE LISTER HILL NATIONAL CENTER
- ; FOR BIOMEDICAL COMMUNICATIONS, NATIONAL LIBRARY OF MEDICINE, BETHESDA,
- ; MARYLAND BY JOHN A. STARKWEATHER OF THE UNIVERSITY OF CALIFORNIA AT
- ; SAN FRANCISCO.
- ;
- ;
- ;
- ; P I L O T 8080 V E R S I O N 1.2
- ;
- ; 9/15/77
- ; MODIFIED TO INTERFACE WITH CPM. 11/11/77 JOHN I. FREDERICK
- ;
- ;
- ;
- CPM: EQU 5 ;JIF
- ORIGN: EQU 0100H ;JIF
- PSTRT: EQU ORIGN ;JIF
- SYSDAT: EQU 0E00H ;JIF
- PBUFB: EQU 1100H ;JIF
- PBUFF: EQU PBUFB ;JIF
- STKPR: EQU 1000H ;JIF
- MNTR: EQU 0 ;JIF RETURN TO CPM
- MON: EQU 1000H ;JIF
- INITL: EQU MON ;JIF
- BUFAD: EQU MON+3 ;JIF
- JMPTAB: EQU MON+5 ;JIF
- ;ORIGN EQU 06000H ;ORIGIN OF PROGRAM.
- ;PSTRT EQU ORIGN+2E0H ;START OF PILOT INTERPRETER.
- ;PBUFB EQU ORIGN+1000H ;BEGINNING OF PROGRAM BUFFER.
- ;PBUFE EQU ORIGN+1FFFH ;END OF PROGRAM BUFFER.
- LINE EQU 72 ;MAX INPUT AT STARTUP.
- ;VIDEO EQU 0FE77H ;EXTERNAL VIDEO DISPLAY ADDR.
- ;MNTR EQU 0008H ;EXTERNAL MONITOR ADDRESS
- ;STKPR EQU ORIGN+100H ;START OF STACK
- ;
- ;PORT EQU 0F6H ;MDS CONSOLE INPUT PORT
- ;STPORT EQU 0F7H ;MDS CONSOLE STATUS PORT
- ;RDA EQU 02H ;READ DATA AVAILABLE MASK.
- ;TBE EQU 01H ;TRANSMIT BUFFER EMPTY MASK.
- ;
- ;INTSRT EQU 38H ;MDS INTERRUPT 7 FOR RESTARTING PILOT.
- ;
- ; ORG INTSRT ;RESTART PROGRAM BY USE OF INTERRUPT 7.
- ; ASEG
- ; JMP START ;ENTRY SETS NORMAL I/O
- ;
- ;LXI H,CTV ;ENTRY TO USE VIDEO OUTPUT
- ;SHLD CO+1 ; AT STARTUP
- ;SHLD LO+1
- ;SHLD PO+1
- ;JMP RSTRT
- ;CTV: PUSH B
- ;MOV B,C
- ;CALL VIDEO
- ;POP B
- ;RET
- ;
- ; JUMP TABLE FOR I/O ROUTINES
- ; RELOCATED TO MONITOR JIF
- ; ONLY TTY ROUTINES ARE PROVIDED INTERNALLY
- ;
- CI: EQU JMPTAB ;JIF
- CO: EQU JMPTAB+3 ;JIF
- RI: EQU JMPTAB+6 ;JIF
- LO: EQU JMPTAB+9H ;JIF
- PO: EQU JMPTAB+0CH ;JIF
- EXIT: EQU JMPTAB+0FH ;JIF
- EDIT: EQU JMPTAB+12H ;JIF
- ASCAN: EQU JMPTAB+15H ;JIF
- ; ORG STKPR
- ;CI: JMP CHI ;CHAR INPUT TO A REG.
- ;CO: JMP CHO ;CHAR OUTPUT FROM C REG.
- ;RI: JMP CHI ;READER INPUT TO A REG.
- ;LO: JMP CHO ;LIST OUTPUT FROM C REG.
- ;PO: JMP CHO ;PUNCH OUTPUT FROM C REG.
- ;EXIT: JMP MNTR ;RETURN TO MONITOR
- ;EDIT: JMP MNTR ;CALL TO EDITOR
- ;ASCAN: JMP BASIC ;ALTERN INTERPRETER
- ;
- ; DATA AREAS
- ORG SYSDAT ;JIF
- TOPP: DW 0 ;TOP OF PROGRAM STORAGE
- HLSAV: DW 0 ;TEMPORARY POINTER (HL)
- HLLSAV: DW 0 ;TEMPORARY POINTER (HL)
- HL2SAV: DW 0 ;TEMPORARY POINTER (HL)
- DESAV: DW 0 ;TEMPORARY POINTER (DE)
- LLSAV: DW 0 ;LAST LINE POINTER
- RETSAV: DW 0 ;ZERO LEVEL OF STACK
- DW 0 ;LEVEL 1
- DW 0 ;LEVEL 2
- DW 0 ;LEVEL 3
- DW 0 ;LEVEL 4
- DW 0 ;LEVEL 5
- DW 0 ;LEVEL 6
- DW 0 ;LEVEL 7 (TOP)
- APTR: DW 0 ;A STMT POINTER
- EPTR: DW 0 ;ENTRY POINTER
- CPTR: DW 0 ;CHAR POINTER
- IPTR: DW 0 ;INPUT BUFFER POINTER
- MPTR: DW 0 ;M-STMT POINTER
- MEMTP: DW 0 ;LAST MEMORY LOCATION
- OUTADR: DW 0 ;CO,LOPO OUTPUT VECTOR
- SCANB: DW 0 ;SCAN BEGINNING ADDR
- CHMAX: DS 1 ;MAXCHARSACCEPTED
- LEVEL: DS 1 ;CURRENT RTURN LEVEL
- LNSKP: DS 1 ;LINE NUMBER SKIP
- MBRCH: DS 1 ;M-BREAK CHAR
- SCNT: DS 1 ;STRING COUNT
- TEMP: DS 1 ;TEMPORARY BINARY VALUE
- VARSAV: DS 1 ;VARIABLE SAVED
- YNSW: DS 1 ;YN-SWITCH, 000: NO MATCH
- TSAVE: DS 81 ;T-TEXT AREA
- EBUFF: DS 81 ;ENTRY BUFFER AREA
- MSAVE: DS 81 ;M LIST AREA
- LABSAV: DS 12 ;LABEL SAVE AREA
- LASTOP: DS 11 ;LAST OP CODE
- NVAR: DS 53 ;NUMERIC VARIABLE STORAGE
- WORD: DS 81 ;WORD AREA
- ;
- ; START AND TERMINATION OF MAIN PROGRAM
- ; ORG HERE CAN SET BEGINNING OF ROM AREA
- ;
- ORG PSTRT
- ;START: LXI SP,STKPR ;INITIALIZE STACK POINTER
- START: CALL INITL ;JIF
- JMP ARO ;JIF
- JMP BASIC ;JIF
- JMP INTR ;JIF
- ARO:
- ; LXI H,PBUFE-1 ;INITIALIZE APTR
- ; SHLD APTR
- ; LXI H,IOJMP ;SET NORMAL I/O VECTORS
- ; LXI D,CI
- ; MVI C,24
- ; CALL BLKTFR
- JMP RSTRT
- ;IOJMP: JMP CHI ;COPY OF STD JMP TABLE
- ; JMP CHO
- ; JMP CHI
- ; JMP CHO
- ; JMP CHO
- ; JMP MNTR
- ; JMP MNTR
- ; JMP BASIC
- ;
- RSTRT: LXI SP,STKPR ;INIT STACK ON RESTART
- CALL INIT ;INITIALIZE THE REST
- CALL SCAN ;SCAN THE BUFFER
- JMP RSTRT ;START OVER
- ;
- DB '020677',0DH
- ;
- DB 'PILOT-8080, 1.1',0DH
- ;
- ;
- ;
- ; INITIALIZE DATA FOR NEW PROGRAM
- ;
- INIT: LXI H,IBUFF ;RESET INPUT POINTER
- SHLD IPTR ; TO FRONT OF BUFFER
- SHLD SCANB ;SET SCAN BEGINNING
- LHLD BUFAD ;JIF
- ; LXI H,PBUFE ;SET LAST MEMORY LOC
- SHLD MEMTP
- CALL NEWN ;SET A-POINTER
- CALL INITV ;INITIALIZE VARIABLES
- MVI M,1 ; SET STOP
- MVI A,LINE ;RESET INMAX TO LINE
- STA CHMAX
- XRA A ;ZERO RETURN LEVEL
- STA LEVEL
- STA LNSKP ;ZERO LN NO. SKIP
- LXI H,CO ;RESET CONSOLE OUTPUT
- SHLD OUTADR
- RET
- ;
- ; SCAN OF INPUT BUFFER
- ; ENTER: HL=BUFFER ADDR
- ; RETURNS: HL=LAST ADDR, B=LAST CHAR (01)
- ;
- SCAN: LHLD IPTR ;GET POINTER
- MOV A,M ;GET FIRST CHAR
- CPI 1 ;IF END MARKER
- RZ ; THEN RETURN
- CPI 0DH ;IF NOT END OF LINE
- JNZ CKEND ; THEN CK FOR SOURCE END
- INX H ; ELSE BUMP POINTER
- JMP SCAN+3 ; AND CONTINUE
- CKEND: CALL CNTLN ;HL=EOL, A=BR CHAR
- CPI 1 ;IF END MARKER
- RZ ; THEN RETURN
- INX H ;HL=START OF NEXT LINE
- SHLD IPTR ;SAVE THAT ADDR
- DCX H ;HL=BREAK CHAR
- CALL BACKUP ;RESET HL TO CURRENT LINE
- CALL SKLN ;SKIP ANY LN NOS., ETC.
- CALL GETCH ; GET FIRST TEXT CHAR
- CPI ':' ;IF COLON
- CZ CONTIN ; THEN CONTINUE SAME OP
- JZ SCAN ; IF CALLED THEN NEXT SCAN
- CPI '*' ;IF ASTERISK
- CZ GETWD ; THEN SKIP LABEL
- JZ SCAN+3 ;IF CALLED THEN RESCAN
- CALL OPS ;PROCESS OPERATIONS
- JMP SCAN
- ;
- CONTIN: INX H ;COLON ADDR + 1
- SHLD HLSAV ;SAVE IT
- LXI H,LASTOP ; ADDR LAST OP CODE
- SHLD LLSAV ;SAVE OP CODE ADDR
- MVI B,':'
- CALL INDX ;ADDR COLON POS
- CALL OLDOP ;USE PART OF OPS
- XRA A ; SET RETURN FLAG
- RET
- ;
- ; OP CODES-- INTERPRET OPERATION
- ; ENTER: HL = FIRST NON-BLANK CHAR IN LINE
- ; RETURNS: RETURN (ZERO) FLAG SET
- ;
- OPS: SHLD LLSAV ;SAVE OP CODE ADDR
- CALL SAVOP ;SAVE OP CODE
- LHLD LLSAV ;ADDR OP CODE
- MVI B,':' ; LOOK FOR COLON
- CALL INDX ;IF NOT FOUND
- MOV A,C
- ORA A
- JZ ALTSC ; THEN TRY ALTERN SCAN
- INX H ;COLON ADDR + 1
- SHLD HLSAV ;SAVE IT
- DCX H ;ADDR POS OF COLON
- OLDOP: DCX H ;ADDR POS BEFORE COLON
- CALL YNCHK ;IF YN-SW OFF(Y) OR ON(N)
- ORA A ; (A=000)
- RZ ; THEN RETURN
- CALL VARCHK ;IF VARIABLE PRESENT < 1
- RZ ; THEN RETURN
- LHLD LLSAV ;ADDR OP CODE
- CALL GETCTL ;GET THE CONTROL WORD
- CALL CTLMCH ;CALL SPECIFIC CONTROL
- CPI 1 ;IF CONTROL FOUND
- RNZ ; THEN RETURN
- ALTSC: LHLD LLSAV ;ADDR FIRST CHAR
- CALL ASCAN ;TRY ALTERN SCAN
- RZ ;IF OK, THEN RETURN
- LHLD LLSAV ;ELSE ADDR FIRST CHAR
- SHLD HLSAV ;SET POINTER
- CALL TOP ;DISPLAY TEXT
- RET
- ;
- ; TEXT CHECK FOR PRESENCE OF LINE FEEDS,
- ; LINE COUNTS, OR LINE NUMBERS.
- ; SETS LNSKP TO NO. OF CHARS TO SKIP BEFORE TEXT
- ;
- TXTCK: LXI H,PBUFF ;ADDR PROGRAM TEXT
- CALL CNTLN ;ADDR CR
- INX H
- MOV A,M ;GET NEXT CHAR
- CPI 0AH ;IF NOT LF
- JNZ CKLC ; THEN CK FOR LINE COUNT
- CALL CNTLN ;ELSE CK ANOTHER LINE
- INX H
- MOV A,M
- CPI 0AH ;IF NOT LF
- JNZ CKLC ; THEN CK FOR LINE COUNT
- LDA LNSKP ;ELSE ADD 1 TO LNSKP
- ADI 1
- STA LNSKP
- CKLC: LXI H,PBUFF ;CK FOR LINE COUNT
- CALL CNTLN ;ADDR CR
- INX H ; NEXT CHAR
- CALL SKLN ;SKIP ANY LF
- MOV E,M ;GET POSSIBLE LINE COUNT
- MVI D,0
- DCX D ;DECR IT
- DAD D ;ADDR LINE END
- MOV A,M ;GET CHAR
- CPI 0DH ;IF NOT CR
- JNZ CKLN ; THEN CK FOR LINE NO.
- INX H ;ELSE CK ANOTHER LINE
- CALL SKLN
- MOV E,M
- DCX D
- DAD D
- MOV A,M
- CPI 0DH ;IF NOT CR
- JNZ CKLN ; THEN CK FOR LINE NOS.
- LDA LNSKP ;ELSE ADD 1 TO LNSKP
- ADI 1
- STA LNSKP
- CKLN: LXI H,PBUFF+1 ;NOW LOOK FOR LN NOS.
- CALL CNTLN ;ADDR CR
- INX H ; NEXT CHAR
- CALL SKLN ;SKIP LF OR LN CNT
- MOV A,M ;GET CHAR AFTER LN CT
- CALL NUM ;IF NOT ASCII NUMBER
- RNZ ; THEN QUIT
- LDA LNSKP ;ELSE ADD 4 TO LNSKP
- ADI 4
- STA LNSKP
- RET
- ;
- NUM: CPI '0' ;CHECK FOR ASCII NUMBER
- RM ;TOO LOW
- CPI '9'+1
- JM YNUM
- ORA H ;TOO HIGH
- RET
- YNUM: XRA A ;OK
- RET
- ;
- ; SKIP LINE NUMBER AND LINE COUNT
- ; BASED ON VALUE OF LNSKP
- ;
- SKLN: LDA LNSKP ;GET SKIP COUNT
- ORA A ;IF ZERO
- RZ ; THEN RETURN
- INX H ;SKIP A CHARACTER
- DCR A ;DECR COUNT
- JMP SKLN+3 ;MORE
- ;
- ; CHECK FOR Y OR N CONDITIONS
- ; Y AND N FOLLOWING OP CODE
- ; ACT AS A SWITCH ALONG WITH YN-SWITCH
- ; ENTER: HL = ADDR OF COLON
- ; RETURNS: A = 000 IF NO ACTION REQUIRED
- ; ELSE A = CHAR BEFORE COLON
- ; HL = ADDR OF LAST CHAR BEFORE COLON
- ;
-
- YNCHK: CALL GETLCH ;GET LAST CHARACTER
- CPI 'Y' ;IF Y
- JZ YCHK
- CPI 'N' ;IF N
- JZ NCHK
- ORA A ; ELSE SET SWITCH ON
- RET ; AND RETURN WITH CHAR
- YCHK: LDA YNSW ;IF YN-SWITCH
- ORA A ; SHOWS MATCH
- JZ DONT ; THEN QUIT
- ORA H ; ELSE SET SWITCH ON
- RET ; AND RETURN
- NCHK: LDA YNSW
- ORA A ; SHOWS NO MATCH
- JNZ DONT ; THEN QUIT
- ORA H ; ELSE SET SWITCH ON
- RET ; AND RETURN
- DONT: XRA A ; SET SWITCH OFF
- RET ; AND RETURN
- ;
- ; CHECK FOR NUMERIC VARIABLE CONDITIONS
- ; VARIABLE IN PARENTHESES AFTER OP CODE
- ; CAUSES EXECUTION IF VALUE +1 OR MORE
- ; ENTER: A = LAST CHAR BEFORE COLON
- ; RETURNS: ZERO FLAG OFF IF NO ACTION REQUIRED
- ;
- VARCHK: CPI ')' ;IF VARIABLE PRESENT
- JZ VCHK ; THEN CHECK IT
- ORA H ; ELSE SET SWITCH ON
- RET ; AND RETURN
- VCHK: DCX H ;DECR POINTER
- DCX H ; TWICE
- MOV A,M ; GET CHAR
- CPI '(' ;IF PAREN NOT PRESENT
- JNZ BADFRM ; THEN COMPLAIN
- INX H ;BUMP POINTER
- MOV B,M ; SAVE CHAR IN B
- CALL VARMCH ;LOOK IT UP
- CPI 1 ;IF END MARKER
- JZ BADFRM ; THEN COMPLAIN
- INX H ; ELSE POINT AT VALUE
- MOV A,M ; GET VALUE
- CPI 01
- JM VOFF ; THEN QUIT
- ORA H ; ELSE SET SWITCH ON
- RET ; AND RETURN
- VOFF: XRA A ; SET SWITCH OFF
- RET ; AND RETURN
- ;
- BADFRM: LHLD LLSAV ;SHOW THE LINE
-
- CALL TOP+3
- LXI H,EXPMSG
- CALL ERROR
- RET
- ;
- ; VARIABLE MATCH - LOOKUP OF VARIABLE NAME/VALUE LIST
- ; ENTER: VARIABLE NAME CHAR IN B REGISTER
- ; RETURNS: HL = ADDR OF MATCHED NAME
- ; IF VAR NOT IN LIST THEN A = 01
- ;
- VARMCH: LXI H,NVAR
- MOV A,M
- CPI 1 ;IF LIST END
- RZ ; THEN RETURN
- CMP B ;IF MATCH
- RZ ; THEN RETURN
- INX H ; ELSE LOOK AGAIN
- INX H
- JMP VARMCH+3
- ;
- ; CONTROL MATCH- CALLS SPECIFIC CONTROL OPERATIONS
- ; ENTER: 'WORD':CONTROL WORD
- ; RETURNS: IF WORD NOT IN LIST, THEN 01 RETURNED
- ; HL: START OF NEXT WORD
- ;
- CTLMCH: LXI D,CTLST ; DE=CONTROL LIST ADDR
- CALL LSTMCH ;LOOK FOR WORD
- CPI 1 ;IF NOT FOUND
- RZ ; THEN RETURN
- XCHG
- INX H
- LXI D,RTRN ;PUT RETURN ON STACK
- PUSH D
- MOV E,M
- INX H
- MOV D,M
- PUSH D ;CALL ADDR ON STACK
- RET
- RTRN: XRA A
- RET
- ;
- ; LIST MATCH - LOOKUP OF WORD/ADDRESS LIST
- ; ENTER: 'WORD' = WORD TO BE FOUND
- ; DE = ADDR OF BEGINNING OF LIST
- ; RETURNS: DE = ADDR OF POINTER (L BYTE)
- ; IF WORD NOT IN LIST THEN A = 01
- ;
- LSTMCH: LXI H,WORD ; HL=INPUT WORD
- CALL CMPR ;COMPARE WORD WITH LIST
- ORA A ; IF MATCH
-
- RNZ ; THEN RETURN
- INX H ;ELSE HL = DE
- XCHG
- INX H ;AND INCR HL TO
- INX H ;NEXT LIST ADDR
- INX H
- MOV A,M ; GET NEXT LIST CHAR
- CPI 1 ;IF END MARKER
- RZ ; THEN RETURN
- XCHG ;ELSE RESET DE TO NEXT ITEM
- JMP LSTMCH ; AND TRY IT
- ;
- ; CONTROL LIST - OP CODES AND KEYWORDS
- ;
- CTLST: DB 'T',0DH
-
- DW TOP
- DB 'A',0DH
- DW AOP
- DB 'M',0DH
- DW MOP
- DB 'MC',0DH
- DW MC
- DB 'J',0DH
- DW JOP
- DB 'R',0DH
- DW ROP
- DB 'C',0DH
- DW COP
- DB 'U',0DH
- DW UOP
- DB 'E',0DH
- DW EOP
- DB 'Y',0DH
- DW TOP
- DB 'N',0DH
- DW TOP
- DB 'LOAD',0DH
- ;LOAD NEW PROGRAM
- DW LOAD
- DB 'INMAX',0DH
- ;LIMITS CHARS ACCEPTED
- DW INMAX
- DB 'NEW$',0DH
- ;ERASE $TEXT
- DW NEWN
- DB 'DP',0DH
- ;DISPLAY PROGRAM
- DW DPRG
- DB 'PRINT',0DH
- ;PRINT PROGRAM
- DW LPRG
- DB 'SAVE',0DH
- ;SAVE PROGRAM
- DW SPRG
- DB 'IEP',0DH
- ;INTERPRET EXIST PROG
- DW IEP
- DB 'BYE',0DH
- DW EXIT
- DB 'EDIT',0DH
- DW EDIT
- ;COMMON DATAPOINT PILOT CODES NOT IN OPERATION
- DB 'CA',0DH
- DW CURSR
- DB 'CE',0DH
- DW CLRE
- DB 'CL',0DH
- DW CLRL
- DB 'CH',0DH
- DW CLRH
- DB 'RL',0DH
- DW ROLL
- ; DB 'WA',0DH
- ; DW WAIT
- DB 1
- ;
- CURSR: MVI C,1BH
- CALL CO
- MVI C,'&'
- CALL CO
- MVI C,61H
- CALL CO
- LHLD HLSAV
- CURS1: MOV A,M
- CPI ','
- JZ CURS3
- CPI 0DH
- JZ CURS4
- MOV C,A
- CURS2: CALL CO
- INX H
- JMP CURS1
- CURS3: MVI C,'r'
- JMP CURS2
- CURS4: MVI C,'C'
- CALL CO
- RET
- CLRE: MVI C,1BH
- CALL CO
- MVI C,'J'
- CALL CO
- RET
- CLRL: MVI C,1BH
- CALL CO
- MVI C,'K'
- CALL CO
- RET
- CLRH: MVI C,1BH
- CALL CO
- MVI C,'H'
- CALL CO
- JMP CLRE
- ROLL: MVI C,1BH
- CALL CO
- MVI C,'S'
- CALL CO
- RET
- ;WAIT: RET
- ;
- ; INTERPRET EXISTING PROGRAM
- ; STARTS SCAN OF PROGRAM BUFFER
- ;
- IEP: LXI H,PBUFF
- SHLD IPTR ;SET POINTER
- SHLD SCANB ; AND SCAN BEGINNING
- CALL TXTCK ;CHK FOR CHARS TO SKIP
- RET
- ;
- INMAX: CALL NMCTL ;E = NUMBER CONTROL
- MOV A,E
- CPI 73 ;LIMIT TO 72
- JM INMX2
- MVI A,72
- MOV E,A
- INMX2: LXI H,CHMAX ; SET INPUT CHAR MAX
- MOV M,E
- RET
- ;
- ; CHAR TO BINARY CONVERSION FOR CONTROL ARGUMENTS
- ; NUMBER CONTROL - FINDS 1 OR 2 DIGIT NUMBER OR NAME
- ; OF VARIABLE IN NEXT WORD. NEGATIVE VALUES SET TO ZERO.
- ; ENTER: HLSAV = EXPRESSION ADDRESS
- ; RETURNS: E = BINARY VERSION OF THE NUMBER
- ; A = 0DH IF ALREADY AT END OF LINE
- ; HLSAV = BR CHAR ADDR
- ;
- NMCTL: LHLD HLSAV ;EXPRESSION ADDR
- CALL GETCH ;GET CHAR
- CPI 0DH ; IF CR
- RZ ; THEN RETURN
- CALL GETWD ;GET NEXT WORD
- DCX H ;BACK UP TO BR CHAR
- SHLD HLSAV ;SAVE POINTER
- LXI H,WORD ; IN 'WORD'
- CALL LETTER ;IF NOT LETTER
- JNZ CVNUM ; THEN CONVERT A NUMBER
- MOV B,M ; ELSE SAVE CHAR IN B
- CALL VARMCH ;LOOK IT UP
- CPI 1 ;IF END MARKER
- CZ BADFRM ; THEN COMPLAIN
- RZ ; AND RETURN
- INX H ;ELSE POINT AT VALUE
- MOV E,M ; PUT VALUE IN E
- JMP CVNUM+3 ; AND QUIT
- CVNUM: CALL GETNM ;CONVERT NUMBER
- MOV A,E ; GET VALUE
- ORA A
- RP ;RETURN IF POSITIVE
- MVI E,0 ; ELSE SET TO ZERO
- RET
- ;
- ; JUMP TO LABEL NAME
- ; ENTER: HLSAV = EXPRESSION FIELD
- ; RETURNS: HL RESET OR MESSAGE
- ;
- JOP: LHLD HLSAV ;ADDR EXPRESSION
- CALL GETCH ;GET FIRST CHAR
- CPI '*' ;IF *
- JZ JOP2 ; THEN MOVE WORD
- MVI A,'*'
- STA WORD ;ELSE ADD *
- LXI D,WORD+1 ; THEN MOVE WORD
- LHLD HLSAV
- CALL WDTFR
- JMP JOP2+3 ;AND CONTINUE
- JOP2: CALL GETWD ;GET NEXT WORD
- LHLD SCANB ; START OF SCAN AREA
- CALL LOOKL ;LOOK FOR IT
- CPI 1 ;IF LABEL NOT FOUND
- CZ NTFND ; THEN COMPLAIN
- RZ ; AND RETURN
- INX H
- SHLD IPTR ;NEW SCAN POSITION
- RET ;RESTART SCAN
- ;
- ;
- NTFND: LXI H,WORD ; SHOW THE LABEL
- CALL DSPLY
- LXI H,BLMSG
- CALL ERROR
- RET
- ;
- UOP: CALL SAVRET ;SAVE RETURN POINTER
- JMP JOP
- ;
- ; SET A BLOCK OF LENGTH C TO CHAR B
- ;
- BLKSET: MOV M,B ; STORE ONE CHAR
- INX H ;BUMP ADDR
- MOV A,C ; DECR COUNT
- SUI 1
- MOV C,A ; IF COUNT NOT ZERO
- JNZ BLKSET ; THEN STORE ANOTHER
- RET
- ;
- ; BLANK THE INPUT BUFFER
- ;
- BLKBF: LHLD APTR ;DE=TOP OF BUFFER
- XCHG
- LXI H,PBUFF ;HL=BOTTOM OF BUFFER
- MVI B,' '
- BLKB2: MOV M,B
- INX H
- CALL ADRCMP
- JNZ BLKB2
- RET
- ;
- ; ADDRESS COMPARISON - COMPARES HL + DE
- ; RETURNS: ZERO AND SIGN FLAGS SET AS THOUGH
- ; A CONTAINED HL AND DE WAS COMPARED
- ; CALLED BY BLKBF
- ;
- ADRCMP: MOV A,H ; GET H
- CMP D ;COMPARE D
- RM ;IF D > H THEN RETURN
- RNZ ;IF D NOT = H THEN RETURN
- MOV A,L ; GET L
- CMP E ;COMPARE E
- RET ; AND RETURN
- ;
- ; CHARACTER TO BINARY CONVERSION
- ; GET A DECIMAL NUMBER-- UP TO 99
- ; ENTER: HL= CHAR ADDR OF ONE OR TWO DIGIT NUMBER
- ; RETURNS: BINARY NUMBER IN E
- ; IF INPUT NOT NUMERIC, THEN E = 0
- ;
- GETNM: MVI E,0 ; INIT. OUTPUT VALUE
- INX H ;LOOK AT NEXT CHAR
- CALL BRCHAR ;IF BREAK CHAR
- JZ SDIG ; THEN SINGLE DIGIT
- CPI '+'
- JZ SDIG
- CPI '-'
- JZ SDIG
- DCX H ;ELSE BACK UP
- MOV A,M ; GET FIRST CHAR
- CPI '0' ;LIMIT RANGE
- RM ; TO NUMERALS
- CPI '9'+1
- RP
- SUI '0' ;REMOVE ASCII BIAS
- ADD A ;MULT. BY 10
- MOV E,A ; E=A*2
- ADD A ; A*4
- ADD A ; A*8
- ADD E ; A+E=A*10
- MOV E,A ; SAVE IT
- INX H ;HL=HL+1
- UNITS: MOV A,M ; GET SECOND CHAR
- CPI '0' ;LIMIT RANGE
- RM ; TO NUMERALS
- CPI '9'+1
- RP
- SUI '0' ;REMOVE ASCII BIAS
- ADD E ;ADD NEW DIGIT
- MOV E,A ; TO E
- RET
- SDIG: DCX H ;BACK UP POINTER
- JMP UNITS ;CONVERT UNITS POSITION
- ;
- ; BINARY TO CHARACTER CONVERSION
- ; PUT BINARY NUMBER IN DECIMAL CHARS -99 TO +99
- ; ENTER: BINARY NUMBER IN E
- ; HL = CHARACTER AREA
- ; RETURNS: HL = ADDR OF 0DH AFTER RIGHT DIGIT
- ;
- PUTNM: MVI C,0 ; INITIALIZE C
- MOV A,E ; GET BINARY NUMBER
- ORA A ; IF NEGATIVE
- CM NEG ; THEN SHOW MINUS SIGN
- CPI 10 ;IF < 10
- JM FRMCH ; THEN FORM CHAR
- SUI 10 ; ELSE SUBTR 10
- MOV E,A ; SAVE IN E
- MOV A,C ; INCR TENS COUNT
- ADI 1
- MOV C,A
- JMP PUTNM+2 ; AND LOOP
- FRMCH: MOV A,C ; GET TENS COUNT
- ADI '0' ;ADD ASCII BIAS
- CPI '0' ;IF CHAR IS 0
- JZ FRMU ; THEN FORM UNITS
- MOV M,A ; STORE THE CHAR
- INX H ;BUMP CHAR ADDR
- FRMU: MOV A,E ; GET THE UNITS
- ADI '0' ;ADD ASCII BIAS
- MOV M,A ; STORE THE CHAR
- INX H ;BUMP POINTER
- MVI A,0DH ; STORE EOL
- MOV M,A
- RET
- ;
- NEG: MVI A,'-' ; STORE MINUS SIGN
- MOV M,A
- INX H ;BUMP CHAR ADDRESS
- XRA A ; MAKE BINARY POSITIVE
- SUB E
- MOV E,A ; SAVE IN E
- RET
- ;
- ; LOOK FOR *LABEL OR $NAME OF STRING VARIABLE
- ; (LOOKL OR LOOKS)
- ; ENTER: 'WORD'=LABEL TO BE FOUND, HL=SCAN ADDR
- ; RETURNS: HL = ADDR OF BLANK AFTER LABEL
- ; IF LABEL NOT FOUND THEN A = 01
- ;
- LOOKS: XRA A ;SET TEMP FOR NO SKIPS
- STA TEMP
- JMP LOOK
- LOOKL: ORA H ;SET TEMP ON FOR SKIPS
- STA TEMP
- CALL SKLN ;SKIP ANY LINE NOS.
- LOOK: CALL GETCH ;NEXT CHAR
- CPI 1 ;IF DATA END
- RZ ; THEN RETURN
- CPI '*' ;IF *
- JZ CHK ; THEN CHECK THE LABEL
- CPI '$' ;IF $
- JZ CHK ; THEN CHECK STRING NAME
- CALL CNTLN ;ELSE GO TO NEXT LINE
- INX H
- LDA TEMP ;IF TEMP=0
- ORA A
- JZ LOOK ; THEN NO SKIPS
- JMP LOOK-3 ;ELSE SKIP LN NOS.
- CHK: SHLD HLSAV ;SAVE POINTER
- CALL CNTWD ;C = WORD LENGTH
- MOV A,C
- CPI 13 ;LIMIT TO 12 CHARS
- JM MVLAB
- MVI C,12
- MVLAB: LHLD HLSAV ;RETRIEVE POINTER
- LXI D,LABSAV ; DESTIN ADDR
- CALL BLKTFR ;MOV A,BSAV=LABEL
- XCHG ;HL:DESTIN BR CHAR+1
- DCX H ; DESTIN BR CHAR
- MVI A,0DH ; REPLACE WITH 0DH
- MOV M,A
- LXI H,LABSAV
- LXI D,WORD ; WORD ADDR
- CALL CMPR ;COMPARE THEM
- ORA A ; LOOK AT A REGISTER
- JNZ LFND ;IF MATCH THEN LABEL FOUND
- LHLD HLSAV ;ELSE RETRIEVE POINTER
- CALL CNTWD ;SKIP LABEL
- JMP LOOK ; AND CONTINUE
- LFND: LHLD HLSAV ;RETRIEVE POINTER
- CALL CNTWD ;SKIP LABEL
- RET ; AND RETURN
- ;
- ; COMPARE STRINGS X AND Y
- ; ENTER: HL= X ITEM ADDR, DE= Y ITEM ADDR
- ; BOTH ITEMS TERMINATE IN 0DH
- ; RETURNS: A=0 FOR NO MATCH,
- ; HL AND DE AT 0DH ADDRESS
- ;
- CMPR: MOV A,M ; GET X CHAR
- CPI 0DH ; IF END OF LINE
- JZ XEND ; THEN END OF X ITEM
- MOV C,A ; SAVE X CHAR IN C
- INX H ;ADDR Y ITEM
- XCHG
- MOV A,M ; GET Y CHAR
- CPI 0DH ; IF END OF LINE
- JZ YENDB ; THEN END OF Y ITEM
- CMP C ;IF A(Y) NOT= C(X)
- JNZ NOMCH ;THEN NO MATCH
- INX H ;ADDR NEXT X ITEM
- XCHG
- JMP CMPR ;START OVER
- XEND: XCHG ;ADDR Y ITEM
- MOV A,M ; GET Y CHAR
- CPI 0DH ; IF END OF LINE
- JZ MCH ; THEN MATCH FOUND
- CALL CNTWD ;ADDR Y BR CHAR
- XCHG ;SET DE
- XRA A ; NOMATCH
- RET
- NOMCH: CALL CNTWD ;ADDR Y BR CHAR
- YENDB: XCHG ; SET DE
- CALL CNTWD ;ADDR X BR CHAR
- XRA A ; NO MATCH
- RET
- MCH: XCHG ;SET DE & HL
- ORA H ; MATCH
- RET
- ;
- ; GET CHARACTER-- SKIPS LEADING BLANKS
- ; ENTER: HL=SOURCE ADDR
- ; RETURNS: HL=NEXT NON-BLANK ADDR, A=CHAR
- ;
- GETCH: MOV A,M ; GET CHARACTER
- CPI 20H ;IF NOT BLANK
- RNZ ; THEN RETURN
- INX H ; ELSE GET NEXT CHAR
- JMP GETCH
- ;
- ; GET LAST CHAR - SCANS BACKWARD, SKIPS BLANKS AND CR'S
- ; ENTER: HL = STRING ADDR
- ; RETURNS: HL = LAST NON-BLANK CHAR, A = CHAR
- ;
- GETLCH: MOV A,M ; GET CHARACTER
- CPI 20H ;IF NOT BLANK
- RNZ ; THEN RETURN
- DCX H ;ELSE GET NEXT CHAR
- JMP GETLCH
- ;
- ; GET WORD -- UP TO FIRST BREAK CHARACTER
- ; IGNORESáLEADING BLANKS
- ; ENTER: HL=SOURCE ADDR
- ; RETURNS: 'WORD'=SOURCE STRING + 0DH
- ; HL= BR CHAR+1 ADDR, B= BR CHAR
- ; DE= 'WORD' ADDR AFTER 0DH
- ; C = NO OF CHARS MOVED INCL BR CHAR
- ;
- GETWD: CALL GETCH ;IGNORE LEADING BLANKS
- LXI D,WORD ; DESTIN ADDR
- CALL WDTFR ;MOVE IT
- RET
- ;
- ; COUNT WORD
- ; ENTER: HL=SOURCE ADDR
- ; RETURNS: HL=BR CHAR ADDR
- ; A,B=BR CHAR, C=COUNT INCL BR CHAR
- ;
- CNTWD: MVI C,1 ; COUNT=1
- CALL BRCHAR ;IF CHAR=BREAK
- RZ ; C=CHAR COUNT
- MOV A,C ; GET COUNT
- ADI 1 ;C=C+1
- MOV C,A ; STORE IT
- INX H ;HL=NEXT
- JMP CNTWD+2 ;NEXT CHAR
- ;
- ; WORD TRANSFER
- ; MOVES STRING FROM HL TO DE + 0DH ADDED
- ; ENTER: HL= SOURCE ADDR, DE= DESTIN ADDR
- ; RETURNS: HL= SOURCE ADDR AFTER BR CHAR
- ; DE= DESTIN ADDR AFTER 0DH
- ; B= BR CHAR
- ; C= NO OF CHARS MOVED INCL BR CHAR
- ;
- WDTFR: MVI C,1 ; INIT COUNT
- CALL BRCHAR ;IF BREAK CHAR
- JZ MVBR ; THEN END OF SOURCE
- INX H ;HL= DESTIN ADDR
- XCHG
- MOV M,B ; MOVE CHARACTER
- MOV A,C ; INCR COUNT
- ADI 1
- MOV C,A
- INX H ;HL= NEXT SOURCE ADDR
- XCHG
- JMP WDTFR+2
- MVBR: INX H ;HL= DESTIN BR CHAR ADDR
- XCHG
- MVI A,0DH ; REPLACE WITH 0DH
- MOV M,A
- INX H ;HL= SOURCE BR CHAR ADDR+1
- XCHG
- XRA A ; SET RETURN FLAG
- RET
- ;
- ; GET CONTROL WORD IN 'WORD'
- ; REPLACES FINAL Y OR N WITH 0DH
- ; ENTER: HL = SOURCE ADDR
- ;
- GETCTL: LXI D,WORD ; DESTIN ADDR
- CALL WDTFR ;MOVE WORD
- MOV A,C ; GET COUNT
- CPI 3 ;IF < 3 CHARS MOVED
- RM ; THEN RETURN
- MOV H,D ; ADDR WORD
- MOV L,E
- DCX H ;AVOID COLON
- DCX H
- CALL GETLCH ;GET LAST CHAR
- CPI 'Y' ;IF Y
- JZ YNOUT ; THEN REMOVE IT
- CPI 'N' ;IF NOT N
- RNZ ; THEN RETURN
- YNOUT: MVI A,0DH ; REPLACE Y OR N
- MOV M,A ; WITH 0DH
- RET
- ;
- ; SAVE OP CODE THROUGH COLON IN LASTOP
- ;
- SAVOP: MVI B,':'
- CALL INDX ;COUNT CHARS TO COLON
- LHLD LLSAV ;ADDR OP CODE
- LXI D,LASTOP
- CALL BLKTFR ;MOVE CHAR STRING
- RET
- ;
- ; COUNT LINE
- ; ENTER: HL=SOURCE ADDR
- ; RETURNS: C=CHAR COUNT INCL 0DH OR 01
- ; HL=BREAK POS., A=BR CHAR
- ;
- CNTLN: MVI C,1 ; COUNT=1
- MOV A,M ; GET CHARACTER
- CPI 0DH ; IF 0DH
- RZ ; C=CHAR COUNT
- CPI 1 ;IF 01
- RZ ; C=CHAR COUNT
- MOV A,C ; GET COUNT
- ADI 1 ;C=C+1
- MOV C,A ; STORE IT
- INX H ;HL=NEXT
- JMP CNTLN+2 ;NEXT CHAR
- ;
- ; BACKUP-- DECREMENTS HL BY VALUE OF C-1
- ; ENTER: HL START VALUE, C=COUNT
- ; RETURNS: NEW HL VALUE
- ;
- BACKUP: MOV A,C ; GET COUNT
- CPI 1 ;IF COUNT=1
- RZ ; THEN RETURN
- SUI 1 ;C=C-1
- MOV C,A ; STORE C
- DCX H ;HL=HL-1
- JMP BACKUP
- ;
- ; BREAK CHARACTER SEARCH
- ; ENTER: HL=CHAR ADDR
- ; RETURNS: A, B = CHARACTER
- ; IF BR CHAR THEN Z FLAG TRUE
- ;
- BRCHAR: MOV A,M ; GET CHAR
- MOV B,A ; AND SAVE IT
- CPI ' ' ;CHECK FOR VARIOUS
- RZ ;BREAK CHARACTERS
- CPI 0DH ; END OF LINE
- RZ
- CPI ','
- RZ
- CPI ';'
- RZ
- CPI ':'
- RZ
- CPI '.'
- RZ
- CPI '?'
- RZ
- CPI 21H ;EXCLAMATION
- RZ
- CPI '"' ;DOUBLE QUOTE
- RZ
- CPI '(' ;L PARENS
- RZ
- CPI ')' ;R PARENS
- RZ
- CPI 27H ;APOSTROPHE
- RZ
- CPI 1 ;END OF LIST
- RET ;BR CHAR NOT FOUND
- ;
- ; INDEX - FIND CHAR POSITION OF MATCHED STRING
- ; ENTER: HLSAV = STRING ADDR, HLLSAVE = SUBSTR ADDR
- ; RETURNS: C = CHAR POS OF MATCH, IF NOMATCH, C=0
- ; HLSAV = STRING ADDR OF FIRST MATCHED CHAR
- ; EPTR = ADDR OF NEXT CHAR AFTER MATCH
- ;
- INDEX: XRA A
- STA SCNT ;INIT STRING COUNT
- INDE2: LHLD HLSAV ;ADDR STRING
- XCHG ;DE = STRING ADDR
- LHLD HLLSAV ;ADDR SUBSTRING
- MOV B,M ;FIRST SUBSTR CHAR IN B
- INX H ;ADDR STRING
- XCHG
- CALL INDX ;LOOK FOR FIRST CHAR
- MOV A,C
- ORA A ; IF NOT FOUND
- RZ ; THEN RETURN
- SHLD HLSAV ; ELSE SAVE POINTER
- LDA SCNT ;GET OLD STRING COUNT
- ADD C ;ADD NEW COUNT
- STA SCNT ; IN SCNT
- LHLD HLLSAV ;ADDR SUBSTR
- CALL CNTLN ;COUNT SUBSTR CHARS
- MOV A,C ; REDUCE COUNT TO
- SUI 1 ; ALPHA CHARS
- MOV C,A
- LXI D,WORD ; MOVE SAME NUMBER OF
- LHLD HLSAV ; CHARS FROM STRING
- CALL BLKTFR ; TO 'WORD'
- SHLD EPTR ;SAVE NEXT CHAR ADDR
- XCHG ;ADDR END OF 'WORD'
- MVI A,0DH ; TERMINATE WITH 0DH
- MOV M,A
- LHLD HLLSAV ;ADDR SUBSTR
- XCHG ;DE = SUBSTR ADDR
- LXI H,WORD ; ADDR PORTION OF STRING
- CALL CMPR ;COMPARE THEM
- ORA A ; IF FOUND
- JNZ SETCNT ; THEN SET POSITION COUNT
- LHLD HLSAV ; ELSE GET STRING POINTER
- INX H ; BUMP IT
- SHLD HLSAV ; SAVE IT
- JMP INDE2 ; AND TRY AGAIN
- SETCNT: LXI H,SCNT ; PUT STRING COUNT IN C
- MOV C,M
- RET ; AND RETURN
- ;
- ; INDX - FIND CHARACTER POSITION OF SINGLE LETTER
- ; ENTER: HL = STRING ADDR, B= CHAR
- ; RETURNS: C = CHAR POS OF MATCH, IF NOMATCH, C=0
- ; HL = ADDR OF MATCHED CHAR OR EOL
- ;
- INDX: MVI C,1 ; INIT C REGISTER
- MOV A,M ; GET CHAR
- CMP B ;IF B-CHAR FOUND
- RZ ; THEN RETURN
- CPI 0DH ; IF END OF LINE
- JZ ZC ; THEN ZERO COUNT
- MOV A,C ; ELSE
- ADI 1 ; BUMP COUNT
- MOV C,A
- INX H ; BUMP ADDR
- JMP INDX+2 ; GO TO NEXT
- ZC: XRA A ; RETURN WITH
- MOV C,A ; C = 0
- RET
- ;
- ; SINDX - SPECIAL INDEX FOR POSITION OF $ OR #
- ; ENTER: HL = STRING ADDRESS
- ; RETURNS: BA = $, #, OR 0DH; C = CHAR POS
- ; HL = ADDR OF MATCHED CHAR
- ;
- SINDX: MVI C,1 ; INIT C REGISTER
- MOV A,M ; GET CHAR
- CPI '$' ;IF $
- RZ ; THEN RETURN
- CPI 043O ;IF #
- RZ ; THEN RETURN
- CPI 0DH ; IF EOL
- RZ ; THEN RETURN
- MOV A,C ; ELSE
- ADI 1 ;BUMP COUNT
- MOV C,A
- INX H ;BUMP ADDR
- JMP SINDX+2 ;GO TO NEXT
- ;
- ; LETTER TESTS WHETHER CHARACTER IS UPCASE A-Z
- ; ENTER: HL = ADDR OF CHAR
- ; RETURNS: ZERO FLAG TRUE IF IT IS
- ; B = CHARACTER
- ;
- LETTER: MOV A,M ; GET CHAR
- MOV B,M ; SAVE IN B
- CPI 41H ;CHECK RANGE
- JM NOTL ;TOO LOW?
- CPI 5AH
- JP NOTL ;TOO HIGH?
- XRA A ; ELSE RESET ZERO FLAG
- RET ; AND RETURN IF LETTER
- NOTL: ORA H ; RETURN IF NOT LETTER
- RET
- ;
- ; SETUP GETS CHAR COUNT AND SETS ADDR FOR TEXT MOVES
- ;
- SETUP: CALL CNTLN ;C=CHAR COUNT
- MOV B,C ; SAVE COUNT
- CALL BACKUP ;RESET HL
- MOV C,B ; RESET COUNT
- RET
- ;
- ; T OPERATION--DISPLAY 'T' STATEMENT
- ; ENTER: HLSAV= FIRST CHAR OF T EXPRESSION FIELD
- ;
- TOP: LHLD HLSAV ;RETRIEVE POINTER
- SHLD CPTR ;SAVE CHAR POINTER
- SHLD LLSAV ;SAVE FIRST CHAR ADDR
- LXI H,TSAVE ; DESTIN START ADDR
- SHLD DESAV ;SAVE DESTIN ADDR
- XCHG ;AND KEEP IN DE
- TMORE: LHLD CPTR ;GET CHAR POINTER
- CALL SINDX ;LOOK FOR $ OR #
- CPI '$' ;IF $ FOUND
- JZ GETXT ; THEN GET LABELED TEXT
- CPI 043O ;IF # FOUND
- JZ GETNUM ; THEN GET NUMBER
- JMP TMOVE ;ELSE MOVE REST OF TEXT
- GETXT: CALL INSERT ;INSERT TEXT
- CPI 1 ;IF FOUND (A NOT 01)
- JNZ TMORE ; THEN CONTINUE
- LXI D,TSAVE ; ELSE DISPLAY THE LINE
- LHLD LLSAV
- JMP TALL
- GETNUM: CALL INSNUM ;INSERT NUMBER
- JMP GETXT+3 ; AND SEE IF FOUND
- TMOVE: LHLD DESAV ;DESTIN ADDR
- XCHG
- LHLD CPTR ;ADDRESS INPUT
- TALL: CALL SETUP ;C = CHAR COUNT
- CALL BLKTFR ;MOVE T-TEXT
- MVI A,0DH ; TERMINATE
- XCHG
- MOV M,A
- LXI H,TSAVE ; ADDRESS TEXT
- CALL DSPLY ;DISPLAY T STATEMENT
- XRA A ; SET RETURN FLAG
- RET
- ;
- ; INSERT NUMERIC VALUE INTO T-STATEMENT
- ; ENTER: C = POSITION OF '#'
- ; RETURNS: TSAVE CONTAINS ASSEMBLED T-TEXT
- ; IF LABEL NOT FOUND, THEN A = 01
- ;
- INSNUM: MOV A,C ; GET POSITION OF #
- SUI 1 ;REDUCE COUNT BY 1
- JZ VBL ;IF 0 THEN GET VARIABLE
- MOV C,A
- LHLD DESAV ;DESTIN ADDR
- XCHG
- LHLD CPTR ;GET CHAR POINTER
- CALL BLKTFR ;MOVE FRONT OF TEXT
- VBL: MOV B,H
- MOV C,L
- XCHG
- SHLD DESAV ;SAVE DESTIN POINTER
- MOV H,B ; GET CHAR POINTER
- MOV L,C
- INX H ;BUMP TO VAR NAME
- MOV C,M ; SAVE NAME IN C
- INX H ;BUMP ADDR
- SHLD CPTR ;SAVE CHAR POINTER
- MOV B,C ; PUT VAR NAME IN B
- CALL VARMCH ;LOOK UP VAR NAME
- CPI 1 ;IF NOT FOUND (A = 01)
- RZ ; THEN RETURN
- INX H ;ELSE POINT AT VALUE
- MOV E,M ; GET VALUE IN E
- LXI H,WORD ; PUT DIGITS IN WORD
- CALL PUTNM
- LHLD DESAV ;DESTIN ADDR
- XCHG
- LXI H,WORD ; DIGIT CHAR ADDR
- CALL SETUP ;C = CHAR COUNT+1
- MOV A,C
- SUI 1
- MOV C,A ; C = CHAR COUNT
- CALL BLKTFR ;MOVE DIGITS
- XCHG
- SHLD DESAV ;SAVE DESTIN ADDR
- XRA A ; SET RETURN FLAG
- RET
- ;
- ; INSERT LABELED TEXT INTO T-STATEMENT
- ; ENTER: C = POSITION OF '$'
- ; RETURNS: TSAVE CONTAINS ASSEMBLED T-TEXT
- ; IF LABEL NOT FOUND, THEN A = 01
- ;
- INSERT: MOV A,C ; GET POSITION COUNT
- SUI 1 ;REDUCE COUNT BY 1
- JZ LBL ;IF 0 THEN POINT TO LABEL
- MOV C,A
- LHLD DESAV ;DESTIN ADDR
- XCHG
- LHLD CPTR ;GET CHAR POINTER
- CALL BLKTFR ;MOVE FRONT OF TEXT
- LBL: MOV B,H ; SAVE CHAR POINTER IN BC
- MOV C,L
- XCHG
- SHLD DESAV ;SAVE DESTIN POINTER
- MOV H,B ; GET CHAR POINTER
- MOV L,C
- CALL GETWD ;GET LABEL
- DCX H ;ADDR BR CHAR
- SHLD CPTR ;SAVE CHAR POINTER
- LHLD APTR ;HL = START OF LIST
- INX H
- CALL LOOKS ;LOOK FOR STRING NAME
- CPI 1 ;IF NOT FOUND (A = 01)
- RZ ; THEN RETURN
- CALL GETA ; ELSE GET A-TEXT
- RET
- ;
- ; GET A-TEXT POINTED TO BY MATCHED LABEL
- ; ENTER: HL = BLANK AFTER MATCHED LABEL
- ; DESAV = DESTIN ADDRESS
- ; RETURNS: A-TEXT MOVED TO DESTINATION
- ; DESAV = NEXT DESTIN ADDRESS
- ;
- GETA: INX H ;ADDR FIRST A-CHAR
- MOV B,H ; BC = A-TEXT ADDR
- MOV C,L
- LHLD DESAV ;DESTIN ADDR
- XCHG
- MOV H,B ; HL = A-TEXT ADDR
- MOV L,C
- CALL SETUP ;C = CHAR COUNT
- MOV A,C ; REDUCE COUNT TO
- SUI 1 ; EXCLUDE MOVE OF 0DH
- MOV C,A
- CALL BLKTFR ;MOVE A-TEXT
- XCHG
- SHLD DESAV ;SAVE DESTIN POINTER
- XRA A ; SET RETURN FLAG
- RET
- ;
- ; A OPERATION-- ACCEPT INPUT
- ; ENTER: HLSAV = ADDR AFTER COLON
- ; RETURNS: INPUT IN EBUFF
- ; 'CTL Z' ALLOWS SINGLE STATEMENT EXECUTION OR QUIT
- ;
- AOP: LHLD HLSAV ;ADDR EXPRESSION
- CALL GETCH ;GET FIRST CHAR
- CPI '$' ;IF NOT $
- JNZ NIN ; THEN LOOK FOR #
- LXI D,LABSAV ; ELSE ADDR DESTIN
- CALL WDTFR ; SAVE THE LABEL
- CALL ENTRY ;GET THE ENTRY
- CALL ASTORE ; STORE IT
- RET ; THEN EXIT
- NIN: CPI 043O ;IF NOT #
- JNZ CENT ; THEN CALL ENTRY
- INX H ;ELSE ADDR VARIABLE
- MOV A,M ; GET THE NAME
- STA VARSAV ;AND SAVE IT
- CALL ENTRY ;GET THE ENTRY
- CALL CKNUM ;REQUIRE NUMERIC
- CALL NSTORE ; STORE THE NUMBER
- RET ;THEN EXIT
- CENT: CALL ENTRY
- RET
- ;
- ENTRY: CALL KEYIN ;GET ONE LINE IN EBUFF
- LXI H,EBUFF ;IF ENTRY NOT CTL Z
- MOV A,M
- CPI 1AH
- RNZ ;THEN RETURN
- INX H ;ELSE BUMP POINTER
- MOV A,M ;GET CHAR
- CPI 0DH ;IF CR
- JZ RSTRT ; THEN RESTART
- CALL OPS ;ELSE DO IMMED OP
- JMP ENTRY ; AND ACCEPT MORE INPUT
- ;
- CKNUM: CPI '0' ;CHECK FOR NUMBER
- JM NERR ;TOO LOW
- CPI '9'+1
- RM ;MUST BE NUMBER
- NERR: LXI H,NMSG ;OUT OF RANGE
- CALL ERROR ;SEND MESSAGE
- CALL ENTRY ;TRY AGAIN
- JMP CKNUM
- ;
- ; A ITEM STORE - STORAGE OF LABELED TEXT FROM ENTRY
- ; FROM TOP OF INPUT BUFFER AREA AND SETS POINTER
- ;
- ASTORE: LXI H,EBUFF ; SOURCE ADDR
- CALL CNTLN ;C = CHAR COUNT
- MOV B,C ; DUPL COUNT IN B
- LHLD APTR ;LAST A-ADDR
- CALL DECA ;BACK UP DESTIN ADDRESS
- MOV A,C ; IF CHAR COUNT = 0
- ORA A
- RZ ; THEN RETURN
- LXI H,EBUFF ; SOURCE ADDR
- CALL BLKTFR ;MOVE TEXT
- LXI H,LABSAV ; ADDR LABEL
- CALL CNTLN ;C = CHAR COUNT
- MOV B,C ; DUPL COUNT IN B
- LHLD APTR ;GET A-POINTER
- CALL DECA ;BACK UP ADDR
- MOV A,C ; IF CHAR COUNT = 0
- ORA A
- RZ ; THEN RETURN
- LXI H,LABSAV ; SOURCE ADDR
- CALL BLKTFR ;MOVE THE LABEL
- MOV L,E ; ADDR A-TEXT
- MOV H,D
- DCX H ;BACK UP ONE CHAR
- MVI A,' ' ;AND SET
- MOV M,A ; BLANK THERE
- RET
- ;
- ; DECREMENT ADDRESS FOR TEXT STORAGE
- ; ENTER: HL = LAST (LOWEST) ADDRESS USED (01)
- ; B & C = CHAR COUNT IN WORD TO BE MOVED
- ; RETURNS:DE = DESTIN ADDR, C = CHAR COUNT
- ; APTR POINTS AT STOP(01) BELOW LIST
- ;
- DECA: MOV E,L ;DESTIN ADDR IN DE
- MOV D,H
- DCX H ;DECR POINTER
- MOV A,M ; GET CHARACTER
- CPI 1 ;IF 01 (END OF SPACE)
- JZ STOVF ; THEN STORAGE OVERFLOW
- MOV A,B ; DECR COUNT
- SUI 1
- MOV B,A
- JNZ DECA ;BACK UP AGAIN?
- SHLD APTR ;SAVE A-POINTER
- MVI M,1 ;SET STOP
- RET
- ;
- STOVF: LXI H,NRMSG ; COMPLAIN OF OVERFLOW
- CALL ERROR
- MVI C,0 ; SET CHAR COUNT = 0
- RET
- ;
- ; NUMBER STORAGE - STORAGE OF NUMERIC VALUE FROM ENTRY
- ; AS VALUE OF VARIABLE NAME IN A-STATEMENT
- ;
- NSTORE: LXI H,EBUFF ; SOURCE ADDR
- CALL GETCH ;ADDR 1ST CHAR
- CALL GETNM ;GET THE NUMBER
- LXI H,VARSAV ; GET THE NAME IN B
- MOV B,M
- CALL VARMCH ;LOOK IT UP
- CPI 1 ;IF END MARKER
- CZ BADFRM ;THEN COMPLAIN
- RZ ; AND RETURN
- INX H ; ELSE BUMP TO NEXT
- MOV M,E
- RET
- ;
- ; M OPERATION - MOVING WINDOW STRING MATCH
- ; COMPARE ITEMS IN LIST WITH LAST INPUT
- ; M-ITEMS HAVE MULTIPLE BLANKS REDUCED TO ONE
- ; INPUT HAS BLANK ADDED AT EACH END AND
- ; MULTIPLE BLANKS REDUCED TO ONE.
- ; ENTER: HLSAV = ADDR AFTER LAST COLON, INPUT IN EBUFF
- ; RETURNS: YNSW = 0 IF MATCH NOT FOUND WITH LAST ENTRY
- ;
- MC: LXI H,MBRCH ;SET BR CHAR
- MVI M,'^' ; TO CARET (SHIFT N)
- JMP MOP1
- MOP: LXI H,MBRCH ;SET BR CHAR TO COMMA
- MVI M,','
- MOP1: LHLD HLSAV ;ADDR EXPRESSION FIELD
- SHLD MPTR ;INIT M-POINTER
- NEXTM: CALL MMOV ;MSAVE = M-ITEM
- LHLD MPTR ;ADDR M-ITEM
- SHLD HLSAV
- CALL SQUEZ ;REDUCE MULTIPLE BLANKS
- LXI H,EBUFF
- SHLD HLSAV ;HLSAV = STRING ADDR
- CALL PAD ;ADD BLANKS AT EACH END
- CALL SQUEZ ;REDUCE MULTIPLE BLANKS
- LXI H,EBUFF ; PUT EBUFF ADDR
- SHLD HLSAV ; IN HLSAV
- LXI H,MSAVE ; PUT MSAVE ADDR
- SHLD HLLSAV ; IN HLLSAV
- CALL INDEX ;LOOK FOR M-ITEM
- MOV A,C
- ORA A ; IF ITEM FOUND
- CNZ SWY ; THEN SET SWITCH YES
- RNZ ; AND RETURN
- LHLD MPTR ;RETRIEVE M-POINTER
- DCX H ;ADDR BR CHAR
- MOV A,M ; IF END OF LINE
- CPI 0DH
- JZ MDONE ; THEN QUIT
- INX H ;ADDR NEXT CHAR
- MOV A,M ; IF END OF LINE
- CPI 0DH
- JZ MDONE ; THEN QUIT
- JMP NEXTM ;ELSE MORE M-ITEMS
- MDONE: CALL SWN ;SET SWITCH NO
- RET
- ;
- SWY: ORA H ; SET YN SWITCH YES
- STA YNSW
- RET
- ;
- SWN: XRA A ; SET YN SWITCH NO
- STA YNSW
- RET
- ;
- ; M-MOVE: MOVE M-ITEM TO MSAVE
- ; ITEMS ARE SEPARATED BY COMMA OR TERMINATED BY 0DH
- ; ENTER: MPTR = M-ITEM ADDRESS
- ; RETURNS: HL & MPTR = NEXT M-ITEM ADDR
- ; B = BR CHAR
- ;
- MMOV: LHLD MPTR ;GET M-POINTER
- LXI D,MSAVE ; DESTIN ADDR
- MMOV2: CALL MBR ;IF BR CHAR OR EOL
- JZ SMOV ; THEN STOP THE MOVE
- INX H
- XCHG ;HL = DESTIN ADDR
- MOV M,B ; MOVE CHAR
- INX H
- XCHG ;HL = NEXT SOURCE ADDR
- JMP MMOV2 ;CHECK THE NEXT CHAR
- SMOV: INX H
- XCHG ;HL = DESTIN BR CHAR ADDR
- MVI A,0DH ; PUT AN 0DH THERE
- MOV M,A
- INX H
- XCHG ;HL = NEXT M-ITEM ADDR
- SHLD MPTR ;SAVE M-POINTER
- RET
- ;
- ; M-BREAK CHAR BETWEEN ITEMS
- ; ENTER: HL = CHAR ADDR
- ; RETURNS: A,B = CHAR. IF BR CHAR THEN Z FLAG TRUE
- ;
- MBR: MOV A,M ; GET CHAR
- MOV B,A ; SAVE IT
- CPI 0DH ; IF EOL
- RZ ; THEN RETURN
- LDA MBRCH ;GET CURRENT BR CHAR
- CMP B
- RET
- ;
- ; PAD ADDS A BLANK TO EACH END OF A STRING
- ; ENTER: HLSAV = STRING ADDRESS
- ;
- PAD: LXI H,WORD
- MVI A,' ' ; SET BLANK AT FRONT OF
- MOV M,A
- INX H ;DE = DESTIN ADDR
- XCHG
- LHLD HLSAV ;GET SOURCE ADDR
- CALL CNTLN ;C = CHAR COUNT
- LHLD HLSAV ;GET SOURCE ADDR
- CALL BLKTFR ;MOVE TEXT
- XCHG ;ADDR NEW TEXT END
- DCX H ;SET BLANK AT
- MVI A,' ' ; END OF
- MOV M,A ; TEMP STRING
- INX H ;SET EOL
- MVI A,0DH
- MOV M,A
- LHLD HLSAV ;MOVE NEW STRING
- XCHG ; TO ORIGINAL
- LXI H,WORD ; LOCATION
- CALL CNTLN
- LXI H,WORD
- CALL BLKTFR
- RET
- ;
- ; SQUEZ REDUCES MULTIPLE BLANKS TO A SINGLE BLANK
- ; ENTER: HLSAV = STRING ADDRESS
- ;
- SQUEZ: LHLD HLSAV ;ADDR STRING
- SHLD HLLSAV ;SAVE POINTER
- MOV A,M ; GET CHAR
- CKEOL: CPI 0DH ; IF EOL
- RZ ; THEN RETURN
- CPI ' ' ;IF BLANK
- JZ CKNC ; THEN CHECK NEXT CHAR
- INX H ;ELSE BUMP ADDR
- JMP SQUEZ+3 ; AND CONTINUE
- CKNC: INX H ;IF NEXT CHAR IS
- CKNC1: MOV A,M ; NOT BLANK
- CPI ' ' ; THEN CHECK IF EOL
- JNZ CKEOL
- SHLD HLLSAV ;ELSE SAVE ADDRESS
- CALL SHIFT ; REMOVE A BLANK
- LHLD HLLSAV ; RETRIEVE ADDRESS
- JMP CKNC1 ; AND CONTINUE
- ;
- ; SHIFT STRING CHARS LEFT WITH LOSS OF FIRST CHAR
- ; ENTER: HL = ADDR OF STRING
- ; RETURNS: HL = ADDR OF 0DH
- ;
- SHIFT: INX H ;ADDR NEXT CHAR
- MOV B,M ; GET IT IN B
- DCX H ;MOVE IT
- MOV M,B
- MOV A,M
- CPI 0DH ; IF IT WAS EOL
- RZ ; THEN RETURN
- INX H ; ELSE MOVE ANOTHER
- JMP SHIFT
- ;
- ; C OPERATION: COMPUTE WITH TEXT OF STATEMENT
- ; LIMITED TO: X = NN (NN = INTEGER -99 TO +99)
- ; OR X = X + NN OR X = X - NN
- ; OR X = X + X OR X = X - X
- ; WHERE X = SINGLE LETTER VARIABLE NAME A-Z
- ; FIRST LETTER ONLY OF LONGER NAME GETS USED
- ; ENTER: HLSAV = ADDR OF EXPRESSION FIELD
- ;
- COP: LHLD HLSAV ;ADDR EXPRESSION FIELD
- MVI B,'=' ; LOOK FOR EQUAL SIGN
- CALL INDX
- MOV A,C
- ORA A ; IF NOT PRESENT
- JZ EXMSG ; THEN COMPLAIN
- INX H ;BUMP POINTER
- CALL GETCH ;GET THE CHAR
- CPI '-' ;IF NOT MINUS SIGN
- JNZ CGVAL ; THEN GET THE VALUE
- SHLD HLLSAV ;SAVE THE POINTER
- XRA A
- STA TEMP ;SET TEMP = 0
- LHLD HLLSAV ;RETRIEVE POINTER
- JMP SUBV ; AND SUBTRACT
- CGVAL: CALL GVALUE ;GET THE VALUE
- LXI H,TEMP ; SAVE IT
- MOV M,E
- LHLD CPTR ;RETRIEVE CHAR POINTER
- INX H ;BUMP POINTER
- CALL GETCH ;GET CHAR
- CPI 0DH ; IF END OF LINE
- JZ AVAL ; THEN ASSIGN VALUE
- CPI '-' ;IF MINUS
- JZ SUBV ; THEN SUBTRACT VALUE
- CPI '+' ;IF PLUS
- JZ ADDV ; THEN ADD VALUE
- CALL GVALUE ;ELSE GET VALUE
- JMP AVAL ;ASSIGN VALUE
- ADDV: INX H ;BUMP POINTER
- CALL GVALUE ;GET THE VALUE
- LDA TEMP ;GET OLD VALUE
- ADD E ;ADD VALUES
- CPI 100 ;IF > 99
- JP OVMSG ; THEN COMPLAIN
- MOV E,A ; ELSE FORM NEW VALUE
- JMP AVAL ;ASSIGN VALUE
- SUBV: INX H ;BUMP POINTER
- CALL GVALUE ;GET THE VALUE
- LDA TEMP ;GET OLD VALUE
- SUB E ;SUBTRACT VALUES
- CPI 9DH ;IF >= -99
- JP AVAL-1 ; THEN CONTINUE
- CPI 100 ;IF > 99
- JP UNMSG ; THEN COMPLAIN
- MOV E,A
- AVAL: CALL ASSIGN
- RET
- ;
- EXMSG: CALL TOP ;SHOW THE BAD EXPR
- LXI H,EXPMSG
- CALL ERROR
- RET
- ;
- OVMSG: MVI E,99 ; SET VALUE TO 99
- CALL ASSIGN
- CALL TOP ;SHOW THE EXPR
- LXI H,OVFMSG
- CALL ERROR
- RET
- ;
- UNMSG: MVI E,9DH ; SET VALUE TO -99
- CALL ASSIGN
- CALL TOP
- LXI H,UNFMSG
- CALL ERROR
- RET
- ;
- ; GVALUE - GETS VALUE OF CONSTANT OR VARIABLE
- ; ENTER: HL = ADDRESS OF CHAR NAMING THE VARIABLE
- ; CPTR = ADDRESS OF CHAR
- ; RETURNS: E = VALUE
- ; CPTR = ADDRESS OF THE CHARACTER
- ;
- GVALUE: CALL GETCH ;GET CHAR
- MOV E,A ; SAVE IN E
- CALL LETTER ;IF LETTER
- JZ LTR ; THEN PROCEED
- CALL GETNM ;ELSE EXPECT NUMBER
- SHLD CPTR ;SAVE CHAR POINTER
- RET
- LTR: SHLD CPTR ;SAVE CHAR POINTER
- CONV: MOV B,M ; SAVE CHAR IN B
- CALL VARMCH ;LOOK IT UP
- CPI 1 ;IF END MARKER
- CZ BADFRM ; THEN COMPLAIN
- RZ ; AND RETURN
- INX H ;ELSE POINT AT VALUE
- MOV E,M ; SAVE VALUE IN E
- RET
- ;
- ; ASSIGN SETS A NEW VALUE TO AN OLD OR NEW VARIABLE
- ; ENTER: HLSAV = ADDR OF EXPRESSION FIELD
- ; BINARY VALUE IN E
- ;
- ASSIGN: LHLD HLSAV ;ADDR EXPRESSION FIELD
- CALL GETCH ;GET FIRST CHAR
- CALL LETTER ;IF NOT A LETTER
- JNZ EXMSG ; THEN COMPLAIN
- MOV B,M ; GET CHAR IN B
- CALL VARMCH ;LOOK IT UP
- CPI 1 ;IF END MARKER
- CZ BADFRM ; THEN COMPLAIN
- RZ ; AND RETURN
- INX H ; ELSE BUMP TO VALUE ADDR
- MOV M,E
- RET ; AND RETURN
- ;
- ; BASIC INTERPRETATION -
- ; IF PROGRAM TEXT IS NOT LEGAL PILOT, THEN
- ; AN ALTERNATE INTERPRETER SUCH AS BASIC CAN BE
- ; SUPPLIED TO BE TRIED BEFORE PILOT COMPLAINS.
- ;
- BASIC: ORA H ;DUMMY ILLEGAL RETURN
- RET
- ;
- ; R OPERATION -
- ; ENTER: HLSAV = R-STATEMENT ADDRESS
- ;
- ROP: RET
- ;
- ; E OPERATION - RETURNS FROM CALL OR ENDS PROGRAM
- ;
- EOP: LDA LEVEL ;IF RETURN LEVEL = 0
- ORA A ; THEN QUIT
- JZ RSTRT
- CALL RESRET ; ELSE SET RETURN FROM
- RET ; PILOT CALL
- ;
- LOAD: LXI H,PBUFF
- CALL INPUT
- RET
- ;
- ; NEW$ DELETES $NAMES BY RESETTING A-POINTER
- ;
- NEWN: LHLD APTR ;REMOVE STOP CHAR
- MVI M,20H
- LHLD MEMTP ;ADDR MEMTP
- MVI M,1 ;PLACE STOP CHAR
- DCX H
- SHLD APTR ;STORE MEMTP-1 ADDRESS
- RET
- ;
- ; INITIALIZE NUMERIC VARIABLES
- ; SETS A-Z TO ZERO VALUE
- ;
- INITV: LXI H,NVAR ;ADDR FRONT OF VAR LIST
- MVI B,'A' ;START WITH 'A'
- MOV A,B
- NV: CPI 'Z'+1 ;IF ALPHABET COMPLETE
- RZ ;THEN RETURN
- MOV M,A ; STORE THE LETTER
- INX H ;BUMP ADDRESS
- MVI A,0
- MOV M,A ; STORE ZERO
- INX H ;BUMP THE ADDRESS
- MOV A,B ; GET LETTER
- ADI 1 ;CHANGE TO NEXT LETTER
- MOV B,A ; SAVE IN B
- JMP NV ;NEXT VARIABLE
- ;
- ; SAVE RETURN POINTER IN STACK
- ; ENTER: IPTR = START OF NEXT SOURCE LINE
- ; RETURNS: LEVEL BUMPED ONE HIGHER
- ; IPTR COPIED AT LEVEL POSITION
- ;
- SAVRET: LXI H,LEVEL ;GET CURRENT LEVEL
- MOV A,M
- ADI 1 ;BUMP TO NEXT LEVEL
- CPI 8 ;IF < 8
- JM SAV2 ; THEN CONTINUE
- LXI H,STMSG ;ELSE STACK OVERFLOW
- CALL ERROR
- RET
- SAV2: MOV M,A ; STORE IT
- ADD A ;DOUBLE IT
- MOV C,A ; SAVE IN C
- LHLD IPTR ;PUT IPTR IN DE
- XCHG
- LXI H,RETSAV ; GET BASE ADDR
- MOV A,L
- ADD C ;BASE + 2 X LEVEL
- MOV L,A ; HL = STACK ADDR
- MOV M,D ; SAVE IPTR
- ADI 1
- MOV L,A ; HL = STACK ADDR+1
- MOV M,E
- RET
- ;
- ; RESET RETURN POINTER FROM STACK
- ; RETURNS: IPTR SET TO LAST SAVED RETURN
- ; LEVEL REDUCED BY ONE
- ;
- RESRET: LDA LEVEL ;GET RETURN LEVEL
- ADD A ;DOUBLE IT
- MOV C,A ; SAVE IN C
- LXI H,RETSAV ; GET BASE ADDR
- MOV A,L
- ADD C ;BASE + 2 X LEVEL
- MOV L,A ; HL = STACK ADDR
- MOV D,M ; SAVE POINTER IN DE
- ADI 1
- MOV L,A ; HL = STACK ADDR+1
- MOV E,M
- XCHG
- SHLD IPTR ;RESET IPTR
- LXI H,LEVEL ;REDUCE LEVEL
- MOV A,M
- SUI 1
- MOV M,A
- RET
- ;
- ; BLOCK TRANSFER FROM HL TO DE, C CHARACTERS
- ; RETURNS: HL AND DE AT LAST CHAR+1 ADDR
- ;
- BLKTFR: MOV A,C ; GET COUNT
- ORA A ; IF COUNT = 0
- RZ ; THEN RETURN
- MOV B,M ; GET A SOURCE CHARACTER
- INX H ;GET NEXT DEST ADDR
- XCHG
- MOV M,B ; PUT IT IN DEST LOCATION
- INX H ;GET NEXT SOURCE ADDR
- XCHG
- MOV A,C ; DECREMENT COUNT
- SUI 1
- MOV C,A
- JNZ BLKTFR ;IF NONZERO THEN NEXT
- RET
- ;
- ; KEYBOARD INPUT TO EBUFF
- ; ENTER: CHMAX= MAXIMUM CHARS ALLOWED IN LINE
- ; DEL (SHIFT O) OR RUBOUT CANCELS LAST CHAR
- ; CTL/U CANCELS CURRENT LINE
- ; USES B FOR CHAR COUNT, C FOR OUTPUT
- ;
- KEYIN: LXI H,EBUFF ;POINT AT EBUFF
- SHLD EPTR ;SAVE POINTER
- LXI H,CHMAX ;GET MAX COUNT
- MOV B,M
- KIN2: LHLD EPTR ;RETRIEVE POINTER
- CALL CI ;GET CHAR AND ECHO
- CPI 5FH ;IF DEL
- JZ CANC ; THEN CANCEL LAST CHAR
- CPI 7FH ;IF RUBOUT
- JZ CANC ; THEN CANCEL LAST CHAR
- CPI 15H ;IF CTL/U
- JZ CANL ; THEN CANCEL LINE
- CPI 61H ;FORCE UPPER CASE
- JM NTR
- XRI 20H
- NTR: MOV M,A ;STORE THE CHAR
- INX H ;INCR POINTER
- SHLD EPTR ;SAVE IT
- CPI 0DH ;IF CR
- JZ KOUT ; THEN STOP ENTRY
- DCR B ;ELSE DECR CHAR COUNT
- MOV A,B
- ORA A ;IF COUNT NOT 0
- JNZ KIN2 ; THEN NEXT CHAR
- MVI C,0DH ;ELSE END WITH CR
- MOV M,C
- CALL CO ; AND SEND IT
- KOUT: CALL LF ;SEND LINE FEED
- RET ; AND RETURN
- CANL: MVI C,3CH ;SEND <
- CALL CO
- CALL CRLF ;SEND CRLF
- JMP KEYIN ; START OVER
- CANC: MOV A,B ;INCR CHAR COUNT
- LXI H,CHMAX ; UNLESS AT BEGINNING
- MOV C,M
- CMP C
- JZ KIN2
- INR B
- LHLD EPTR
- DCX H ;DECR POINTER
- SHLD EPTR
- JMP KIN2+3
- ;
- CRLF: MVI C,0DH
- CALL CO
- LF: MVI C,0AH
- CALL CO
- RET
- ;
- ; INPUT PROGRAM TO BUFFER AREA
- ; DEL (SHIFT O) CANCELS LAST CHAR, CTL/U CANCELS LINE
- ; TERMINATES WITH CTL/Z (1AH)
- ;
- INPUT: CALL BLKBF ;BLANK THE BUFFER
- LXI H,PBUFF ;SET POINTER
- INPT1: MOV A,M ;GET EXISTING CHAR
- SHLD LLSAV ;SAVE FIRST CHAR ADDR
- CPI 1 ;IF END MARK
- JZ CHOP ; THEN CHOP ENTRY
- CALL RI ;GET CHAR
- CPI ' ' ;IF NOT BLANK
- JNZ INPT3+3 ; THEN CONTINUE
- JMP INPT1 ;ELSE SKIP LEADING BLANK
- INPT2: MOV A,M ;GET EXISTING CHAR
- CPI 1 ;IF END MARK
- JZ CHOP ; THEN CHOP ENTRY
- INPT3: CALL RI ;GET CHARACTER
- CPI 0 ;IGNORE NULLS
- JZ INPT3
- CPI 7FH ;IGNORE RUBOUTS
- JZ INPT3
- CPI 1AH ;IF TERM CHAR CTL/Z
- JZ INEND ; THEN END OF INPUT
- CPI 15H ;IF CTL/U
- JZ KLN ; THEN KILL THE LINE
- CPI 5FH ;IF DEL
- JZ CLC ; THEN CANCEL LAST CHAR
- MOV M,A ;ELSE STORE THE CHAR
- INX H ;AND INCR THE POINTER
- CPI 0DH ;IF NOT CR
- JNZ INPT2 ; THEN GET NEXT CHAR
- CALL LF ;ELSE SEND LF
- JMP INPT1 ;AND GET NEXT NEW LINE
- INPT4: MOV M,A ;STORE CHAR
- INX H ;INCR POINTER
- JMP INPT2
- CLC: DCX H ;CANCEL LAST CHAR
- JMP INPT3
- KLN: MVI C,3CH ;SEND <
- CALL CO
- CALL CRLF ;SEND CRLF
- LHLD LLSAV ;ADDR FRONT OF LINE
- JMP INPT3
- CHOP: LHLD LLSAV ;ADDR FRONT OF LINE
- CALL DSPLY
- LXI H,IOVMSG
- CALL ERROR
- INEND: MVI M,1 ;STORE END MARK
- SHLD TOPP ;STORE ADDRESS
- CALL CRLF ;SEND CRLF
- LXI H,LEVEL ;ZERO RETURN LEVEL
- MVI M,0
- RET
- ;
- ; DISPLAY A CHARACTER STRING TO CR OR 01
- ; ENTER: HL = STARTING ADDRESS
- ; OUTADR CONTAINS ADDRESS OF CO, LO, OR PO
- ;
- DSPLY: MOV A,M ;GET A CHARACTER
- INX H ;BUMP POINTER
- MOV D,H ;SAVE IT
- MOV E,L
- CPI 1 ;IF 01
- RZ ; THEN RETURN
- MOV C,A ;PUT CHAR IN C
- LHLD OUTADR ;MAKE AN INDIRECT CALL
- CALL OVCTR ; TO SEND THE CHAR
- CPI 0DH ;IF CR
- JZ ENDOL ; THEN EOL
- XCHG ;ELSE RETRIEVE POINTER
- JMP DSPLY ;AND DISPLAY MORE
- ENDOL: MVI C,0AH ;SEND LINE FEED
- LHLD OUTADR ;MAKE AN INDIRECT CALL
- CALL OVCTR ; TO SEND IT
- XCHG ;RETRIEVE POINTER
- CALL SKLN ;SKIP ANY LINE NOS.
- RET
- OVCTR: PCHL
- ;
- ; OUTPUT PROGRAM IN MEMORY TO 01 END MARK
- ;
- PRGOUT: LXI H,PBUFF ;PGM START ADDR
- CALL DSPLY ;DISPLAY ONE LINE
- CPI 1 ;IF NOT END MARK
- JNZ PRGOUT+3 ; THEN MORE
- RET
- ;
- DPRG: LXI H,CO ;DISPLAY PROGRAM IN MEMORY
- SHLD OUTADR
- CALL PRGOUT
- RET
- ;
- LPRG: LXI H,LO ;LIST PROGRAM IN MEMORY
- SHLD OUTADR
- CALL PRGOUT
- LXI H,CO ;RESET TO CONSOLE
- SHLD OUTADR
- RET
- ;
- SPRG: LXI H,PO ;SAVE PROGRAM
- SHLD OUTADR
- CALL PRGOUT
- LXI H,CO ;RESET TO CONSOLE
- SHLD OUTADR
- RET
- ;
- ; I/O ROUTINES
- ; USE STPORT (MDS-0F7H) FOR STATUS, PORT (MDS-0F6H) FOR DATA
- ; STATUS BIT 1 (2H) FOR READ DATA AVAIL (RDA)
- ; BIT 0 (1H) FOR TRANSMIT BUFFER EMPTY (TBE)
- ;
- ; OUTPUT CHAR FROM C
- ; LOOKS FOR CTL/Z INPUT FOR PANIC EXIT
- ;
- ;CHO: IN STPORT ;GET STATUS
- ; ANI RDA ;IF NO INPUT
- ; JZ CHO1 ;THEN CONTINUE
- ; CALL CI ;ELSE SEE WHAT IT IS
- ; CPI 1AH ;IF CNTRL/Z
- ; JZ INTR ;THEN INTERRUPT
- ;CHO1: IN STPORT ;NOW FOR STANDARD OUTPUT
- ; ANI TBE
- ; JZ CHO1
- ; MOV A,C
- ; OUT PORT
- ; RET
- ;
- INTR: PUSH H ;SAVE REGISTERS
- PUSH D
- PUSH B
- LXI H,INTMSG ;INTERRUPT MESSAGE
- CALL ERROR
- CALL ENTRY ;ALLOW RESTART
- POP B ;ELSE CONTINUE
- POP D
- POP H
- RET
- ;
- ; INPUT CHAR TO A AND ECHO
- ;
- ;CHI: IN STPORT ;NORMAL INPUT
- ; ANI RDA
- ; JZ CHI
- ; IN PORT
- ; ANI 7FH
- CHI: PUSH B
- MVI C,1
- CALL CPM
- POP B
- MOV C,A
- CALL CO
- RET
- ;
- ; ERROR - DISPLAYS ERROR MESSAGE
- ; ENTER: HL = ADDRESS OF MESSAGE
- ; RETURNS: ZERO FLAG SET
- ;
- ERROR: CALL DSPLY
- XRA A
- RET
- ;
- ; ERROR MESSAGES
- ;
- BLMSG: DB '- LABEL NOT FOUND',0DH
- ;
- IOVMSG: DB '/OVERFLOW',0DH
- ;
- NRMSG: DB '*NO ROOM',0DH
- ;
- EXPMSG: DB '*ILLEGAL EXPRESSION',0DH
- ;
- OVFMSG: DB '*VALUE > 99',0DH
- ;
- UNFMSG: DB '*VALUE < -99',0DH
- ;
- STMSG: DB '*USE DEPTH EXCEEDED',0DH
- ;
- NMSG: DB '*NUMERIC RESPONSE REQUIRED',0DH
- ;
- INTMSG: DB '*INTERRUPTED',0DH
- ;
- IBUFF: DB 'T:',0DH
- DB 'T:PILOT-8080, 1.1',0DH
- ;
- ; DB ':LOAD A NEW PROGRAM?',0DH
- ;
- ; DB 'A:',0DH
- ;
- ; DB 'M: Y',0DH
- ;
- ; DB 'JN:*%',0DH
- ;
- ; DB 'T:ENTER PILOT PROGRAM',0DH
- ;
- ; DB ':TERMINATE INPUT WITH CTL/Z',0DH
- ;
- DB 'LOAD:',0DH
- ;
- DB '*% IEP:',0DH
- ;
- ; ORG HERE CAN SET START OF RAM PROGRAM BUFFER SPACE
- ;
- ; RELOCATED TO END OF MONITOR ;JIF
- ; ORG PBUFB
- ;PBUFF: DB 1
- ;
- ; SOURCE PROGRAM AND $STRING STORAGE HERE TO MEMTP
- ;DISPLACEMENTS NEEDED IN PMON JIF
- END START