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
/
CPMUG032.ARK
/
TBASICA3.ASM
< prev
next >
Wrap
Assembly Source File
|
1984-04-29
|
53KB
|
2,274 lines
* RTN. C.3
* KEYBOARD INPUT
* OUT: A = ASCII CODE FOR CHARACTER INPUTTED
* USERS ROUTINE HAS RESPONSIBILITY FOR PROVIDING LOWER
* TO UPPER CASE CONVERSION, AND MAKING RUBOUT A
* 7F, HEXADECIMAL. THE PARITY BIT WILL BE RESET (ZERO)
KYIN ORI 1 ;CLEAR THE ZERO FLAG
JMP CONT1 ;USE CONTROL C ROUTINE
* RTN. C.4
* OUTPUT TO TERMINAL(S)
* IN: A = ASCII CODE FOR CHARACTER TO BE SENT
* THIS ROUTINE FINDS EACH CHANNEL THAT IS IN TERMINAL MODE,
* SENDS THE CHARACTER, AND UPDATES THE POSITION FLAGS.
* IF A LINE WILL BE OVERRUN, A CARRIAGE RETURN
* WILL BE INSERTED. IF A RUBOUT CHARACTER IS DETECTED,
* TWO ACTIONS ARE POSSIBLE. ONE, IF THE RUBOUT FLAG
* IS ZERO, A '@' WILL BE SENT. TWO, IF THE RUBOUT
* FLAG IS NONZERO, THE RUBOUT WILL BE SENT AND
* IT IS ASSUMED THAT THE TERMINAL WILL BACKSPACE
* AND ERASE THE LAST CHARACTER
TOUT LXI B,1 ;GET CHANNEL ONE FOR STARTERS
CALL EDIT1 ;CHECK FOR MEMORY STORE TIME
TOUTTAB1 PUSH PSW ;SAVE CHARACTER
CPI 0DH ;CARRIAGE RETURN?
JZ TOUTZ ;YUP
CPI 7FH ;RUBOUT?
JZ TOUTY ;YUP
CPI 09H ;IS IT A TAB?
JZ TOUTTAB ;YUP
LDA POSIT ;GET HEAD POSITION
INR A ;UPDATE
STA POSIT
TOUTX POP PSW ;RESTORE CHARACTER
TOUT1 PUSH PSW ;SAVE THE CHARACTER
MVI A,2 ;GET TERMINAL MODE CODE
CALL MFND ;FIND A TERMINAL CHANNEL
JNZ TOUT2 ;OH, OH, NO MORE TERMINALS
POP PSW ;GET THE CHARACTER BACK
PUSH B ;SAVE THE NEXT CHANNEL
PUSH PSW ;SAVE THE CHARACTER
XCHG ;PUT PARAMETERS ADDRESS IN HL
CPI 7FH ;IS IT A RUBOUT?
JZ TOUT3 ;SURE IS
CPI 0DH ;IS IT A CARRIAGE RETURN?
JZ TOUT4 ;YUP
INX H ;GET ADDRESS OF POSITION FLAG
TOUT9 INR M ;UPDATE POSITION FLAG
DCX H ;GET ADDRESS OF WIDTH FLAG
MOV A,M ;GET IT
INX H ;GET ADDRESS OF POSITION FLAG AGAIN
CMP M ;COMPARE
JNC TOUTB ;AH, NO OVERRUN
MVI M,0
MVI A,0DH ;GET A CARRIAGE RETURN CODE
LXI B,TOUTRET ;SET UP RETURN ADDRESS
PUSH B
XCHG ;PUT CHANNEL ADDRESS BACK IN HL
ANA A
PCHL ;SEND THE CR
TOUTRET MVI A,0AH ;SEND THE LF
ANA A
LXI B,TOUT6 ;PUSH THE RETURN ADDRESS
PUSH B
PCHL ;DO IT TO IT
TOUTTAB POP PSW
TOUTTAB2 MVI A,20H ;SEND A SPACE
LXI B,1
CALL TOUTTAB1
LDA POSIT ;CHECK IT
ANI 7
RZ ;DONE
JMP TOUTTAB2
TOUT6 XCHG ;PUT CHANNEL ADDRESS IN DE
MVI M,1 ;SET POSITION TO 1
TOUTB POP PSW ;GET CHARACTER BACK
PUSH PSW ;SAVE THE THING AGAIN
TOUT5 LXI B,TOUT7 ;SET UP RETURN ADDRESS
PUSH B
XCHG ;PUT CHANNEL ADDRESS BACK IN HL
ANA A
PCHL ;SEND THE CHARACTER
TOUT7 POP PSW ;GET THE CHARACTER BACK
POP B ;GET THE NEXT CHANNEL ADDRESS
JMP TOUT1 ;LOOP FOR ANOTHER TERMINAL
TOUT2 POP PSW ;CLEAN UP THE STACK
CPI 0DH ;WAS THIS A CR?
RNZ ;NOPE
MVI A,0AH ;SEND A LF TOO
LXI B,1
JMP TOUTTAB1 ;DO IT
TOUT3 INX H ;GET RUBOUT FLAG
INX H
MOV A,M
DCX H ;GET ADDRESS OF POSITION FLAG
ANA A ;SET FLAGS
JNZ TOUT8 ;A REAL RUBOUT!!
POP PSW ;GET A BACK
MVI A,'@' ;SEND A FAKE RUBOUT
PUSH PSW ;SAVE IT AGAIN
JMP TOUT9
TOUT8 DCR M ;UPDATE THE POSITION
MVI A,7FH ;GET A RUBOUT CODE
JP TOUT5 ;SEND IT
DCX H ;GET THE WIDTH FLAG ADDRESS
MOV A,M ;GET IT
INX H ;GET THE POSITION FLAG ADDRESS
MOV M,A ;STORE IT
MVI A,7FH ;GET A RUBOUT CODE
JMP TOUT5 ;SEND IT
TOUT4 INX H ;GET POSITION ADDRESS
MVI M,0 ;CLEAR IT
JMP TOUT5 ;SEND THE CARRIAGE RETURN
* RTN. C.6
* CASSETTE OUTPUT BYTE
* CARRY AND ZERO FLAGS SET UP AS IN CAIN
* IN: A = BYTE TO WRITE
COUT PUSH PSW
CPI 0DH ;IS IT A CR?
JZ COUTCR ;YUP
COUTA MVI A,8
LXI B,1 ;START WITH CHANNEL 1
CALL MFND ;FIND THE CASSETTE CHANNEL
JNZ COUTBA ;NONE FOUND
POP PSW ;GET FLAGS BACK
PCHL ;GO GET IT
COUTCR POP PSW
LXI B,COUTCR1
PUSH B
PUSH PSW
JMP COUTA
COUTCR1 MVI A,0AH
JMP COUT
COUTBA POP PSW
RET ;DONE
* BINARY PORT ROUTINES
* BINARY PORT OUTPUT
BPORT PUSH PSW ;SAVE BYTE AND FLAGS
LXI B,1 ;START WITH CHANNEL ONE
BPORT1 MVI A,20H ;BIT FOR BINARY OUTPUT PORT
CALL MFND ;LOOK FOR IT
JNZ BPORT2 ;NOT FOUND
POP PSW ;GET BYTE AND SET FLAGS
PUSH PSW ;SAVE 'EM AGAIN
PUSH B ;SAVE CHANNEL COUNT
LXI B,BPORT3 ;STUFF THE RETURN ADDRESS
PUSH B
PCHL ;GO TO THE PORT ROUTINE
BPORT3 POP B ;RESTORE
JMP BPORT1 ;TRY FOR ANOTHER ONE
BPORT2 POP PSW ;RESTORE STACK
RET ;DONE
* BINARY INPUT PORT
BINPOR LXI B,1 ;START WITH CHANNEL ONE
PUSH PSW ;SAVE 'EM
MVI A,10H ;INPUT PORT BIT
CALL MFND ;LOOK FOR IT
JNZ SPRAT ;NONE FOUND
POP PSW ;GOT IT
LXI B,BINPOR1 ;STUFF A RETURN ADDRESS
PUSH B
PCHL ;DO IT
BINPOR1 MVI B,23H ;TAPE READ ERROR?
JC ERROR ;YUP
RET ;NOPE, ALL'S OK
OBPORT PUSH B ;SAVE IT
MOV B,A
MVI A,1
ANA A
MOV A,B ;BACK
POP B
JMP BPORT
OBINPOR MVI A,1
ANA A
JMP BINPOR
* IN: CATV = 0 FOR TV, <> 0 FOR CASSETTE
* HL = ADDRESS OF FIRST CHARACTER IN LINE
* LAST CHARACTER IN LINE HAS BIT 7 SET
LNOT LDA CATV ;GET TV/CASSETTE FLAG
MOV B,A ;STICK IT IN B
MOV A,M ;GET THE CHARACTER TO A
ANA A ;SET FLAGS
PUSH PSW ;SAVE FLAGS
ANI 7FH ;STRIP UPPER BIT
MOV D,A ;SAVE THE CHARACTER
POP PSW ;RESTORE FLAGS
MOV A,D ;PUT THE CHARACTER BACK
PUSH H ;SAVE ADDRESS
PUSH PSW ;SAVE CHARACTER AND THE FLAGS
INR B ;CHECK FOR B=0
DCR B
JNZ LNOT2 ;CASSETTE MODE
POP PSW ;GET CHARACTER BACK
PUSH PSW ;SAVE IT AGAIN
CALL TOUT ;OUTPUT TO TERMINAL(S)
LNOT3 POP PSW ;GET FLAGS BACK
POP H ;GET ADDRESS BACK
INX H ;UPDATE INDEX
RM ;ALL DONE.....
ORI 1 ;CLEAR THE ZERO FLAG
JMP LNOT ;LOOP FOR ANOTHER CHARACTER
LNOT2 POP PSW ;GET THE CHARACTER BACK
PUSH PSW ;SAVE IT AGAIN
CALL COUT ;SEND IT TO THE CASSETTE(S)
JMP LNOT3 ;RESUME NORMAL SEQUENCE
* RTN. C.8
* LINE OUTPUT FOR TERMINALS
* IN: HL = FIRST ADDRESS OF STRING
* LAST CHARACTER IN STRING HAS BIT 7 SET
MSGER XRA A ;CLEAR CATV
STA CATV
JMP LNOT ;OUTPUT LINE
* RTN. C.9
* LINE OUTPUT FOR CASSETTE
* IN: HL = FIRST ADDRESS OF STRING
* LAST CHARACTER IN STRING HS BIT 7 SET
* OUT: CARRY SET IF NO CHARACTERS WERE INPUT
CLIN MVI A,0FFH ;SET CATV NONZERO
STA CATV
JMP LNOT ;OUTPUT LINE
* RTN. C.9
* LINE INPUT FOR CASSETTE AND KEYBOARD
* IN: HL = FIRST ADDRESS TO STORE STRING
LIIN LXI D,0 ;NUMBER OF CHARACTERS TO 0
MVI A,1
ANA A
LIIN1 PUSH D ;SAVE IT
PUSH H ;SAVE ADDRESS
PUSH PSW ;SAVE FLAGS
MOV C,A ;SAVE IN C
LDA CATV ;SEE IF THIS IS FOR CASSETTE
ANA A ;SET FLAGS
JNZ LIIN2 ;SURE IS
POP PSW ;RESTORE FLAGS
CALL KYIN ;GET A CHARACTER FROM KEYBOARD
LIIN3 CPI 7FH ;CHECK FOR A RUBOUT
POP H ;RESTORE ADDRESS
POP D ;RESTORE NUMBER OF CHARACTERS
JZ LIIN4 ;IT WAS
CPI 1 ;CHECK FOR FLAG CODE
JZ LIZZZ ;SURE WAS
CPI 3 ;CHECK FOR CONTROL C PUSHED
JZ RUN2 ;YUP, SO TERMINATE ANY RUN MODE
CPI 0DH ;CHECK FOR A CARRIAGE RETURN
JZ LIIN5 ;IT WAS
CPI 15H ;CHECK FOR CONTROL U
JZ LII00 ;SURE WAS
CPI 9 ;CHECK FOR TAB
JZ LIZZZ ;SURE IS
CPI 20H ;CHECK FOR OTHER CONTROL CHARACTERS
JC LII20 ;SURE IS
LIZZZ MOV M,A ;STORE THE CHARACTER
INX H ;UPDATE THE INDEX
INX D ;UPDATE NUMBER OF CHARACTERS
LDA CATV ;CHECK FOR CASSETTE MODE
ANA A ;SET FLAGS
JNZ LIIN6 ;IT IS
DCX H ;GET CHARACTER ADDRESS
MOV A,M ;GET CHARACTER
INX H ;BUMP INDEX UP
PUSH D
PUSH H ;SAVE ADDRESS
LIIN7 CALL TOUT ;ECHO IT
POP H ;RESTORE ADDRESS
POP D
LIIN6 ORI 1 ;CLEAR CARRY AND ZERO FLAGS
JMP LIIN1 ;LOOP FOR MORE CHARACTERS
LIIN2 POP PSW ;RESTORE FLAGS
CALL CAIN ;GET A CHARACTER FROM THE CASSETTE
JMP LIIN3 ;CONTINUE PROCESSING
LIIN4 DCX H ;BACK UP ONE
DCX D ;DECREMENT NUMBER OF CHARACTERS
JMP LIIN7-2 ;SENT THE RUBOUT CODE
LIIN5 DCX H ;BACK UP TO MARK THE LAST CHARACTER
MOV A,D ;CHECK FOR NO INPUT
ORA E
JNZ LIINW ;THERE IS SOME INPUT
STC
RC ;RETURN IF NO CHARACTERS WERE INPUT
LIINW MOV A,M ;GET THE LAST CHARACTER
CPI 5CH ;CHECK FOR A BACKSLASH
JZ LII68 ;SURE WAS
ORI 80H ;SET THE UPPER BIT
MOV M,A ;STUFF IT BACK
INX H ;GET NEXT POSITION
MVI M,0 ;CLEAR IT
LDA CATV ;CHECK FOR CASSETTE MODE
ANA A ;SET FLAGS
RNZ
CALL CRLF ;SEND A CARRIAGE RETURN
XRA A ;CLEAR CARRY
RET ;DONE...
LII00 MOV A,D ;CHECK FOR BEING AT FIRST CHARACTER
ORA E
JZ LIIN6 ;SURE WAS
MVI A,7FH ;SEND THE RUBOUT
PUSH H ;SAVE IT ALL
PUSH D
CALL TOUT
POP D ;RESTORE
POP H
DCX D ;UPDATE COUNT
DCX H
JMP LII00 ;DO IT AGAIN
* RTN. C.11
* SEND CARRIAGE RETURN
CRLF MVI A,0DH ;GET CARRIAGE RETURN CODE
CALL TOUT ;SEND IT
RET ;DONE....
* RTN. C.12
* INITIALIZE I/O SECTION
INIO CALL CRLF ;INITIALIZE ALL POSITIONS
XRA A ;SET CARRY, CLEAR ZERO
SUI 1
CALL CAIN ;SHUT OFF ANY CASSETTE INPUT
XRA A ;SET CARRY, CLEAR ZER
SUI 1
CALL COUT ;SHUT OFF ANY CASSETTE OUTPUT
XRA A ;INITIALIZE THE BINARY PORTS
SUI 1
CALL BPORT
XRA A
SUI 1
CALL BINPOR
RET ;DONE.
* RTN. C.13
* LINE INPUT FROM KEYBOARD
* IN: HL=FIRST ADDRESS TO STORE CODE
* OUT: CARRY SET IF NO CHARACTERS INPUTTED
LIKY XRA A ;CLEAR CATV
STA CATV
JMP LIIN ;DO IT
* RTN. C.14
* LINE INPUT FROM CASSETTE
* IN: HL= FIRST ADDRESS TO STORE CODE
* OUT: CARRY SET IF NO CHARACTERS INPUTTED
LICA MVI A,0FFH ;SET CATV
STA CATV
JMP LIIN ;DO IT
SMST DW 0
SMEN DW 0
* RTN. C.5
* CASSETTE INPUT BYTE
* CARRY AND ZERO FLAGS MUST BE PROPERLY SET UP
* CARRY FOR LAST BYTE
* ZERO FOR FIRST BYTE
CAIN PUSH PSW ;SAVE FLAGS
MVI A,4 ;CODE FOR CASSETTE INPUT
LXI B,1 ;CHANNEL TO START SEARCHING AT
CALL MFND ;FIND THE CASSETTE CHANNEL
POP PSW ;FLAGS BACK
CALL CAIN2 ;GET A BYTE
MVI B,23H ;ERROR CODE JUST IN CASE
JC ERROR ;TAPE ERROR
RET ;DONE...
CAIN2 PCHL
TOUTZ XRA A ;CLEAR POSIT
STA POSIT
JMP TOUTX
TOUTY LDA POSIT ;DECREMENT POSIT
DCR A
STA POSIT
JMP TOUTX
LII20 MVI A,1 ;CLEAR FLAGS
ANA A
JMP LIIN1 ;GET ANOTHER INPUT
LII68 MVI A,0DH ;GET CR CODE BACK
INX H ;UPDATE THE INDEX
JMP LIIN7-2 ;ECHO IT AND GET ANOTHER
* MODS MODULE
* RTN. M.1
* EDIT COMMAND EXECUTIVE
EDIT LHLD FSRC ;INITILIZE EDITED LINE POINTER
SHLD EDLNP
XRA A ;SET ENTER MODE
STA CMND
CALL GLFC ;LOOK FOR PARAMETER
JC SPRAT ;NO PARAMETER
XCHG ;OFFSET TO HL
SHLD EDITO ;SAVE IT
MOV H,B ;BC TO HL
MOV L,C
SHLD EDITS ;SAVE THE SYMBOL NUMBER
EDITJ LHLD EDITS ;GET THE SYMBOL NUMBER
MOV C,L ;TO BC
MOV B,H
LHLD EDITO ;GET THE OFFSET
XCHG ;TO DE
CALL LILO ;FIND THE LINE
SHLD EDLNP ;GET THE POINTER
EDITA LHLD ESRC
LXI D,300
DAD D
MVI M,80H ;STORE FAKEOUT FLAGS
INX H
MVI M,80H
INX H
SHLD DMPMM ;STORE DUMP TO MEMORY FLAG
LHLD EDLNP ;EDITED LINE POINTER
CALL DMST ;DUMP THE STATEMENT OUT
LHLD DMPMM ;SET THE LAST BIT
DCX H
MOV A,M
ORI 80H
MOV M,A
LXI H,0 ;CLEAR THE DUMP MEMORY FLAG
SHLD DMPMM
EDITH LHLD ESRC ;SET EDITING FLAGS
LXI D,302
DAD D
SHLD LLST
SHLD FLST
SHLD TMP9
EDITD LXI H,0 ;INPUT A COMMAND
SHLD TMP1 ;N=0
EDITB CALL KYIN ;GET A CHARACTER
CPI 7FH ;IS IT A RUBOUT??
JZ EDITD ;YUP, SO START OVER ON THE COMMAND
CPI 3AH ;IS IT A DIGIT
JNC EDITC ;NOPE
CPI 30H ;CHECK AGAIN
JC EDITC ;FOR SURE
ANI 0FH ;STRIP OF ASCII BITS
MVI B,10 ;MULTIPLY TMP1 BY TEN
LHLD TMP1 ;GET OLD N
XCHG ;TO DE
LXI H,0 ;CLEAR HL
EDITZ DAD D ;ADD
DCR B ;CHECK FOR DONENESS
JNZ EDITZ
CALL ADHL ;ADD THE NEW DIGIT
SHLD TMP1 ;STORE IT
JMP EDITB ;GET ANOTHER ONE
EDITC LXI B,17 ;NUMBER OF COMMAND TYPES
LXI H,EDITY ;COMMAND TABLE
CALL SRC8 ;SEARCH FOR THE COMMAND
JNZ EDITE ;NOT A COMMAND, ROCK!
PUSH B ;SAVE COMMAND NUMBER
LHLD TMP1 ;CHECK FOR N=0
MOV A,H
ORA L
JNZ EDITX ;NOPE
INX H
EDITX SHLD TMP1 ;OK
LHLD ESRC ;GET PLACE TO STORE PARAMETER STRING
MVI M,80H ;STORE THE FAKEOUT FLAGS
INX H
MVI M,80H
MOV A,C ;CHECK COMMAND NUMBER OUT
CPI 3
JZ EDITG
CPI 4
JZ EDITG
CPI 5
JZ EDITG
CPI 12
JNZ EDI45
EDITG PUSH H ;SAVE ADDRESS
CALL KYIN ;GET A CHARACTER
POP H ;GET ADDRESS BACK
CPI 7FH ;IS IT A RUBOUT?
POP B ;RESTORE STACK
JZ EDITD ;YUP, SO START OVER AGAIN
PUSH B ;BACK DOWN, BOY!
CPI 0DH ;IS IT A CARRIAGE RETURN?
JZ EDITF ;YUP, SO COMMAND IS FINISHED
MOV M,A ;NO, SO STORE THE CHARACTER
INX H ;UPDATE THE INDEX
JMP EDITG ;GO GET ANOTHER ONE
EDITF DCX H ;SET UPPER BIT ON LAST CHARACTER
MOV A,M
ORI 80H
MOV M,A
EDI45 POP B ;GET BACK COMMAND NUMBER
LXI H,EDITW-2 ;COMMAND ADDRESS TABLE
DAD B ;ADD OFFSET
DAD B
MOV E,M ;GET THE ADDRESS OUT
INX H
MOV D,M
XCHG ;TO HL
LXI D,EDITD ;SET UP RETURN ADDRESS
PUSH D
PCHL ;GOTO PROCESSOR
EDITE MVI A,'?' ;PRINT A QUESTION MARK
CALL TOUT ;TO INDICATE AN ILLEGAL COMMAND
CALL PSSU ;PRINT LINE UNTIL POINTER
JMP EDITD ;GET ANOTHER COMMAND
EDITY DB 'U'
DB 'D'
DB 'I'
DB 'C'
DB 'S'
DB 'Q'
DB 'R'
DB 'K'
DB 'F'
DB 'B'
DB 'A'
DB 'M'
DB 'L'
DB 'T'
DB 20H
DB 'X'
DB 'P'
EDITW DW PSSU
DW PSSD
DW PSSI
DW PSSC
DW PSSS
DW PSSQ
DW PSSR
DW PSSK
DW PSSF
DW PSSB
DW PSSA
DW PSSM
DW PSSL
DW PSST
DW PSSZ
DW PSSX
DW PSSP
EDIT1 PUSH PSW ;SAVE REGISTERS
PUSH H
LHLD DMPMM ;GET INDEX
PUSH PSW
MOV A,H ;SEE IF IT'S ZERO
ORA L
JZ EDXT11 ;SURE IS
POP PSW
CPI 0DH ;CHECK FOR CARRIAGE RETURN
JZ EDOT12 ;SURE WAS, SO IGNORE IT
MOV M,A ;STORE THE CHARACTER
INX H ;UPDATE THE INDEX
SHLD DMPMM ;SAVE IT
EDOT12 POP H ;RESTORE REGISTERS
POP PSW
RET ;DONE
EDXT11 POP PSW
JMP EDOT12
EDIT4 MOV A,D ;DE = 0
ORA E
RZ ;YUP, SO WE ARE DONE
PUSH H ;SAVE INDEXES
PUSH D
MOV A,M ;GET A CHARACTER
ANI 7FH ;STRIP ANY STROBE
CALL TOUT ;PRINT IT
POP D ;RESTORE INDEXES
POP H
INX H ;UPDATE
DCX D
JMP EDIT4 ;TRY AGAIN
EDIT5 LHLD TMP1
DCX H
SHLD TMP1
MOV A,H
ORA L
RET
EDIT6 LHLD FLST
CALL COUNT ;CHECK FOR POINTER OVERFLOW
DAD D
XCHG
LHLD LLST
CALL CMP16 ;CHECK IT OUT
RC ;IT'S OKAY
XCHG ;FIX IT
DCX H
SHLD LLST
RET ;DONE.
PSSK LHLD FLST ;GET FIRST CHARACTER POSITION
MVI M,0A0H ;STORE A SPACE, END
SHLD LLST ;POINTER SET
JMP PSSI1 ;INSERT MODE
PSSU MVI A,0DH ;PRINT A CARRIAGE RETURN
CALL TOUT ;SEND IT
LHLD FLST ;COMPUTE NUMBER OF CHARACTERS TO SEND
XCHG
LHLD LLST
CALL SUB16
XCHG ;RESULT TO DE
LHLD FLST ;GET FIRST CHARACTER TO DUMP
CALL EDIT4 ;DUMP 'EM
RET ;DONE
PSSD MVI A,5CH ;DUMP A BACKSLASH
CALL TOUT
PSSD4 LHLD LLST ;COUNT REMAINING CHARACTERS
CALL EDIT6 ;CHECK FOR OVERRUN OF POINTER
CALL COUNT
LXI H,1 ;IS IT ONE?
CALL CMP16
JZ PSSD1 ;YUP
LHLD LLST ;GET CHARACTER TO DELETE
PUSH D ;SAVE COUNT
PUSH H ;SAVE ADDRESS
MOV A,M ;GET THE CHARACTER
CALL TOUT ;DUMP IT
POP D ;GET BACK THE ADDRESS
POP B ;GET BACK THE COUNT
DCX B ;CORRECT
MOV L,E ;ADDRESS TO HL
MOV H,D
INX H ;GET ADDRESS PLUS ONE
MOV A,C ;CHECK FOR COUNT OF 0
ORA B
JZ PSSD8 ;SURE IS
CALL MOVE ;MOVE 'EM DOWN
PSSD2 CALL EDIT5 ;DECREMENT N
JNZ PSSD4 ;DO IT AGAIN
MVI A,5CH ;DUMP ANOTHER BACKSLASH
CALL TOUT
RET ;ALL DONE
PSSD1 LHLD LLST ;POINTER = FIRST CHARACTER?
XCHG ;TO DE
LHLD FLST
CALL CMP16 ;CHECK THEM
JZ PSSD3 ;SURE WERE THE SAME
XCHG ;LLST TO HL
MOV C,M ;CHARACTER TO C
DCX H ;SET NEW LAST CHARACTER
MOV A,M
ORI 80H
MOV M,A
INX H
SHLD LLST ;NEW POINTER
MOV A,C ;GET THE CHARACTER
ANI 7FH ;STRIP THE STROBE
CALL TOUT ;PRINT IT
JMP PSSD2 ;CONTINUE
PSSD3 XCHG ;LLST TO HL
MOV A,M ;CHECK THE CHARACTER THERE
CPI 80H
JZ PSSD2 ;NONE LEFT!
MVI M,80H ;SET AN 80 IN
ANI 7FH ;STRIP ANY STROBE
CALL TOUT ;PRINT IT
JMP PSSD2 ;CONTINUE
PSSS LHLD LLST ;SET SEARCH FLAG UP
SHLD TMP2
CALL EDIT6 ;CHECK FOR POINTER OVERRUN
LHLD ESRC ;CHECK FOR ANY INPUT
INX H
MOV A,M
CPI 80H
RZ ;NO INPUT, SO NO SEARCH
PSSS4 LHLD ESRC ;INITIALIZE INDEXES
XCHG ;TO DE
INX D ;CORRECT TO GET PAST FAKEOUT
LHLD TMP2
PSSS3 MOV A,M ;GET A CHARACTER
ANI 7FH ;STRIP STROBE OFF
MOV B,A ;TO B
LDAX D ;GET A CHARACTER
ANI 7FH ;STRIP THE STROBE
CMP B ;THE SAME?
JNZ PSSS1 ;NOPE
LDAX D ;CHECK FOR END OF SEARCH STRING
ANA A
JM PSSS2 ;SURE IS, SO WE'VE GOT A FIND
MOV A,M ;CHECK FOR END STRUCK
ANA A
JM PSSS1 ;SURE DID
INX D ;UPDATE INDEXES
INX H
JMP PSSS3 ;TRY ANOTHER CHARACTER
PSSS1 LHLD TMP2 ;UPDATE INPUT STRING TRY POSITION
PUSH H ;SAVE ADDRESS
MOV A,M ;GET A BYTE
CALL TOUT ;PRINT IT
POP H ;RESTORE ADDRESS
MOV A,M ;CHECK FOR END
ANA A
JM PSSS5 ;SURE IS
INX H
SHLD TMP2
JMP PSSS4 ;TRY AGAIN!
PSSS2 CALL EDIT5 ;DECREMENT N
JNZ PSSS1 ;MORE TO GO
LHLD TMP2 ;SET POINTER
SHLD LLST
RET ;DONE.
PSSI CALL PSSS ;PERFORM SEARCH FIRST
PSSI1 CALL KYIN ;GET A CHARACTER
CPI 0DH ;IS IT A CARRIAGE RETURN
JZ PSSID ;DONE
CPI 7FH ;IS IT A RUBOUT
JZ PSSI2 ;SURE WAS
PUSH PSW ;SAVE THE CHARACTER
CALL EDIT6 ;CHECK FOR POINTER OVERRUN
JC PSSI9 ;NOPE
MOV A,M ;GET LAST CHARACTER
ANI 7FH ;STRIP THE STROBE
MOV M,A
INX H ;SET IN THE FAKEOUT
MVI M,80H
SHLD LLST
PSSI9 LHLD LLST ;COUNT CHARACTERS REMAINING
CALL COUNT
MOV C,E
MOV B,D
MOV E,L
MOV D,H
INX D
CALL MOVE
XCHG ;FIND THE LAST CHARACTER
DAD B
DCX H
MOV A,M ;GET IT
CPI 80H ;IS IT A FAKEOUT?
JNZ PSSI7 ;NOPE
DCX H ;SURE WAS
MOV A,M ;SET UPPER BIT
ORI 80H
MOV M,A
PSSI7 XCHG ;HL BACK TO NORMAL
POP PSW ;RESTORE CHARACTER
MOV M,A ;STUFF IT IN
CALL TOUT ;ECHO IT
LHLD LLST ;UPDATE THE POINTER
INX H
SHLD LLST
JMP PSSI1
PSSI2 LXI H,1 ;SET UP N
SHLD TMP1
LHLD LLST ;FIX THE POINTER
DCX H ;BACK UP
SHLD LLST
MOV A,M ;CHECK FOR A FAKEOUT
CPI 80H
JNZ PSSI8 ;NOPE
DCX H
SHLD LLST
MOV A,M
ORI 80H ;SET END UP
MOV M,A
PSSI8 CALL PSSD ;KILL ONE
JMP PSSI1 ;CONTINUE
PSSD8 XCHG ;TO HL
DCX H ;GET LAST CHARACTER
MOV A,M ;SET UPPER BIT
ORI 80H
MOV M,A
JMP PSSD2 ;CONTINUE
PSSC CALL PSSS ;FIND THE STRING
LHLD ESRC ;FIND OUT HOW MANY CHARACTERS
INX H
CALL COUNT ;COUNT 'EM
XCHG
SHLD TMP1 ;SAVE AS N
CALL PSSD ;DELETE THAT MANY
JMP PSSI1 ;GO TO INSERT MODE
PSSQ MVI A,0FFH ;SET COMMAND MODE
STA CMND
JMP RSTRT ;BACK TO COMMAND LEVEL
EDIT2 LHLD INSR ;SET UP FOR DELETION
SHLD FLST
SHLD LINE ;SET UP LINE FLAG
SHLD LLST
JMP DLTE1 ;DELETE IT
PSSR CALL PSSP ;PRINT THE PRESENT LINE
LHLD FLST ;STORE A BLANK AT THE END
CALL COUNT
DAD D
MVI M,0
LHLD FRAV ;SET UP CODED LINE START
MVI A,0FFH ;SET UP EDIT MODE
STA EDITM
SHLD SLIN
LHLD EDLNP ;SET UP INSERTION POINT
SHLD INSR
XRA A ;CLEAR ESCN
STA ESCN
LHLD TMP9 ;SET UP FOR LINE DECODING
DCX H
JMP EXE77 ;DECODE AND ENTER THE LINE
PSSP MVI A,0DH ;PRINT A CR
CALL TOUT
LHLD FLST ;START OF LINE
CALL MSGER ;PRINT IT
MVI A,0DH ;PRINT A CR
CALL TOUT
LHLD FLST ;RESET POINTER
SHLD LLST
RET ;DONE.
PSSF LHLD TMP1 ;GET N
XCHG ;TO DE
LHLD EDITO ;GET OFFSET
DAD D ;ADD IT UP
SHLD EDITO ;SAVE NEW OFFSET
POP H ;CLEAN UP THE STACK
XRA A ;CLEAR EDIT MODE
STA EDITM
JMP EDITJ ;NEW LINE
PSSB LHLD TMP1 ;GET N
XCHG ;TO DE
LHLD EDITO ;GET OFFSET
CALL SUB16 ;BACK UP
SHLD EDITO ;SAVE NEW OFFSET
POP H ;CLEAN UP THE STACK
JMP EDITJ ;NEW LINE
PSSA CALL EDIT6 ;GET POINTER
CALL MSGER ;SEND IT OUT
LHLD FLST ;FIND END OF LINE
CALL COUNT
DAD D
INX H ;CORRECT
SHLD LLST ;SET POINTER
CALL PSSI1 ;INSERT AT END
RET ;DONE
PSSM LHLD ESRC ;SET UP SCAN FLAGS
SHLD NSCN
XRA A
STA ESCN
CALL USCN ;SCAN OFF FAKEOUT
POP H ;CLEAN UP THE STACK
JMP EDIT ;MOVE TO THE NEW LINE
PSSL MVI A,0DH ;DUMP A CR
CALL TOUT
PSSL1 CALL EDIT5 ;DECREMENT N
JZ PSSL2 ;ALL DONE
LHLD EDLNP ;DUMP STATEMENT AT POINTER
CALL DMST
LHLD EDITO ;GET OFFSET
INX H ;INCREMENT IT
SHLD EDITO
XCHG ;TO DE
LHLD EDITS ;GET SYMBOL NUMBER
MOV C,L ;TO BC
MOV B,H
CALL LILO ;FIND THE LINE
SHLD EDLNP
XCHG
LHLD ESRC ;SEE IF WE ARE DONE
XCHG
CALL CMP16
JNC PSSL2 ;DONE (END OF SOURCE)
JMP PSSL1 ;GET ANOTHER LINE
PSSL2 POP H ;CLEAN UP THE STACK
JMP EDITA ;INTO EDIT MODE
PSST CALL EDIT6 ;CHECK FOR OVERRUN
CALL MSGER ;PRINT IT
JMP PSSU ;PRINT UP TO POINTER
PSSZ CALL EDIT6 ;GET POINTER
MOV A,M ;GET THE CHARACTER
INX H ;INCREMENT POINTER
SHLD LLST
CALL TOUT ;DUMP THE CHARACTER
CALL EDIT5 ;CHECK FOR DONENESS
JNZ PSSZ ;NOPE
RET ;DONE
PSSX CALL EDIT6 ;CHECK FOR OVERRUN
XCHG ;TO DE
LHLD FLST ;CHECK FOR NO BACKUP
CALL CMP16
RZ ;DAT'S RIGHT FOLKS
DCX D
XCHG ;GET LAST CHARACTER
MOV A,M
SHLD LLST ;NEW POINTER
CALL TOUT ;PRINT IT
CALL EDIT5 ;CHECK FOR DONENESS
JNZ PSSX
RET ;ALL DONE
PSSS5 MVI A,'?' ;PRINT A QUESTION MARK
CALL TOUT
CALL PSSP ;PRINT THE LINE
POP H ;CLEAN UP THE STACK
JMP EDITH ;TRY AGAIN
PSSID LHLD LLST ;CHECK FOR 80 AT END
MOV A,M
CPI 80H
RNZ ;NOPE, SO ALL'S WELL
DCX H ;STRIP IT
MOV A,M
ORI 80H
MOV M,A
RET ;DONE.
EDI96 JMP RSTRT ;DONE
* INPUT TRANSLATOR MODULE
* RTN. D.1
* FIND SYMBOL IN SYMBOL TABLE AND DIRECTORY
* IN: HL POINTS TO NAME TO FIND
* OUT: ZERO CLEARED, SYMBOL IS NOT IN SYMBOL TABLE
* ZERO SET, SYMBOL IS IN THE SYMBOL TABLE, AND
* HL = SYMBOL POINTER
* DE = POINTS TO SYMBOL ID BYTE
* BC = SYMBOL NUMBER
* A = SYMBOL ID BYTE
SSRC XCHG ;FREE HL
LHLD SNUM ;GET NUMBER OF SYMBOLS IN TABLE
MOV B,H ;PUT IT IN BC
MOV C,L
LHLD STAB ;GET START OF SYMBOL TABLE
XCHG ;PUT 'EM IN THE RIGHT REGISTERS
CALL STSRH ;SEARCH THE SYMBOL TABLE
RNZ ;NO FIND EXIT
* RTN. D.2
* FIND SYMBOL DIRECTORY ENTRY
* IN: BC = SYBMOL NUMBER
* OUT: HL = SYMBOL POINTER
* DE = POINTS TO SYMBOL ID BYTE
* BC = SYMBOL NUMBER
* A = SYMBOL ID BYTE
DFND LHLD SDIR ;GET START OF SYMBOL DIRECTORY
LDA RURD
ANA A ;READY TO RUN?
JNZ DFND2 ;YUP
LDA RUNF ;ARE WE RUNNING
ANA A
JZ DFND2 ;NOPE
MVI B,26H
JMP ERROR
DFND2 DAD B ;HL=HL+BC*3
DAD B
DAD B
DCX H ;GET ADDRESS OF ID BYTE
PUSH H ;SAVE IT
DCX H ;GET ADDRESS OF POINTER MSD
MOV D,M ;PUT IT IN D
DCX H ;GET ADDRESS OF POINTER LSD
MOV E,M ;PUT IT IN E
POP H ;GET BACK ID BYTE ADDRESS
MOV A,M ;PUT IT IN A
XCHG ;POINTER TO HL
PUSH D ;SAVE ADDRESS
MOV D,A ;SAVE A
XRA A ;SET ZERO FLAG
MOV A,D ;RESTORE A
POP D ;RESTORE ADDRESS
RET ;DONE....
* RTN. D.3
* INSERT SYMBOL IN SYMBOL TABLE AND DIRECTORY
* IN: HL = POINTER TO SYMBOL NAME
* OUT: BC = SYMBOL NUMBER
* HL = POINTER TO SYMBOL ID BYTE
ITAB CALL COUNT ;COUNT CHARACTERS IN NAME
LDA CMND ;CHECK FOR COMMAND MODE
ANA A ;SET FLAGS
MVI B,18H ;SET ERROR TYPE JUST IN CASE
JNZ ERROR ;WHOSE THE STONE THAT TRIED THIS??
PUSH H ;SAVE ADDRESS AND NUMBER OF CHARACTERS
PUSH D
INX D ;DE=DE+3
INX D
INX D
LHLD SDIR ;GET START OF DIRECTORY
PUSH H ;SAVE IT
CALL SUB16 ;COMPUTE NEW START
PUSH H ;SAVE IT
LHLD SDIR ;HL=(STAB)-(SDIR)
XCHG
LHLD STAB
CALL SUB16
MOV B,H ;NUMBER OF BYTES IN DIRECTORY TO BC
MOV C,L
POP D ;GET BACK DESTINATION
POP H ;GET BACK START OF DIRECTORY
CALL MOVE ;MOVE IT BACK
XCHG ;NEW SDIR TO HL
SHLD SDIR ;STUFF IT IN
LHLD STAB ;GET START OF SYMBOL TABLE
POP D ;GET NUMBER OF CHARACTERS IN SYMBOL
PUSH D ;SAVE IT
CALL SUB16 ;COMPUTE NEW SYMBOL TABLE START
PUSH H ;SAVE IT
DAD D ;GET STAB BACK
XCHG ;TO DE
LHLD MEND ;GET END OF USEABLE MEMORY
CALL SUB16 ;COMPUTE NUMBER OF BYTES IN SYMBOL TABLE
INX H ;CORRECT
MOV B,H ;STICK IT IN BC
MOV C,L
POP D ;GET BACK NEW START OF SYMBOL TABLE
LHLD STAB ;GET OLD START
CALL MOVE ;MOVE IT DOWN
XCHG ;NEW START TO HL
SHLD STAB ;STUFF IT IN
POP D ;GET BACK NUMBER OF CHARACTERS
LHLD MEND ;END OF USEABLE MEMORY
CALL SUB16 ;COMPUTE LOCATION OF NEW SYMBOL
INX H ;CORRECT
XCHG ;TO DE
MOV B,H ;BC=HL
MOV C,L
POP H ;GET BACK SYMBOL LOCATION
CALL MOVE ;PUT IT IN THE SYMBOL TABLE
LHLD SNUM ;GET NUMBER OF SYMBOLS
INX H ;UPDATE IT
SHLD SNUM ;STICK IT BACK
MOV B,H ;BC=HL
MOV C,L
LHLD STAB ;GET FIRST ADDRESS OF SYMBOL TABLE
DCX H ;GET NEW SYMBOL ID BYTE
MVI M,0 ;CLEAR IT OUT
XRA A ;CLEAR RURD
STA RURD
RET ;DONE.
* RTN. D.4
* UPSCAN IN INPUT LINE
* UPDATES TSCN AND NSCN
* IF CARRY SET ON EXIT, THERE IS NO MORE DATA IN
* THIS INPUT LINE.
USCN LDA ESCN ;CHECK FOR NO MORE DATA
CPI 2 ;CHECK FOR DONENESS
STC ;SET CARRY JUST IN CASE
RZ ;RETURN IF END OF LINE AND NO MORE DATA
LHLD NSCN ;GET NEXT SCANOFF START
SHLD TSCN ;STUFF IT INTO THIS SCANOFF START
CPI 1 ;COMPARE
JNZ USCNA ;IT'S NOT
INX H ;UPDATE NSCN
SHLD NSCN
INR A ;IT IS
STA ESCN ;SET ESCN TO 2 TO INDICATE THE FACT
RET ;DONE
USCNA MOV A,M ;GET A CHARACTER
INX H ;UPDATE INDEX
ANA A ;SET FLAGS
JP USCNA ;LOOP TO TRY AGAIN
MVI C,0 ;CLEAR THE CHARACTER COUNTER
USCN2 MOV A,M ;GET A CHARACTER
ANA A ;SET FLAGS
SHLD NSCN ;KEEP NSCN UP TO DATE
JM USCN3 ;OH, OH, THIS IS THE END OF THE LINE
CPI 20H ;IS THIS A SPACE?
JNZ USCN4 ;NOPE
INX H ;GET NEXT CHARACTER AND IGNORE SPACE
JMP USCN2 ;TRY AGAIN
USCN4 SHLD NSCN ;SAVE THE NEXT SCANOFF START
USCN1 MOV A,M ;GET A CHARACTER
ANI 7FH ;STRIP OFF UPPER BIT
CPI '$' ;IS IT A DOLLAR SIGN?
JZ USCN7 ;YUP
CPI 30H ;CHECK FOR NUMERIC
JM USCN5 ;NOPE
CPI 7BH ;CHECK FOR LOWER CASE
JP USCN5 ;NOPE
CPI 61H ;CHECK AGAIN
JP USCN7 ;YUP
CPI 'Z'+1 ;CHECK FOR ALPHABETIC
JP USCN5 ;NOPE
CPI 'A' ;CHECK AGAIN FOR ALPHABETIC
JP USCN7 ;SURE IS
CPI '9'+1 ;CHECK AGAIN FOR NUMERIC
JP USCN5 ;MISSED OUT
USCN7 MOV A,M ;GET THE BYTE BACK
ANA A ;SET FLAGS
JM USCN3 ;END OF THE LINE, BUDDY
INX H
INR C ;UPDATE CHARACTER COUNTER
JMP USCN1 ;LOOP FOR MORE OF THEM
USCN5 DCR C ;C=0?
DCX H ;JUST IN CASE
JP USCN6 ;NOPE
INX H ;BACK TO NORMAL
MOV A,M ;GET THE BYTE BACK
ANA A ;SET FLAGS
JM USCN3 ;END OF THE LINE, FOLKS
CALL USCNO ;CHECK FOR POSSIBLE DOUBLE
JNZ USCN6 ;NOT POSSIBLE
INX H ;CHECK FURTHER
MOV A,M ;GET IT
CALL USCNO ;CHECK IT
JZ USCN6 ;DOUBLE
DCX H ;BACK TO NORMAL
USCN6 MOV A,M ;GET THE CHARACTER
ORI 80H ;SET THE UPPER BIT
MOV M,A ;STICK IT BACK
XRA A ;CLEAR CARRY
RET
USCN3 MVI A,1 ;SET ESCN
STA ESCN
MOV A,M ;GET LAST BYTE
CPI 0A0H ;CHECK FOR A SPACE
JZ USCNJ ;YUP
XRA A ;CLEAR CARRY
RET
USCNJ MVI A,2 ;SET ESCN TO INDICATE NO MORE
STA ESCN
RET
* RTN. D.5
* BACKSCAN INPUT LINE
* SETS TSCN AND NSCN
BSCN LDA ESCN ;CHECK END SCAN FLAG
ANA A ;SET FLAGS
JNZ BSCN1 ;DON'T CLEAR THE UPPER BIT
LHLD NSCN ;GET NEXT SCAN FLAG
BSCN3 MOV A,M ;GET A CHARACTER
ANA A ;SET FLAGS
JM BSCN2 ;FOUND IT
INX H ;GET NEXT CHARACTER LOCATION
JMP BSCN3 ;TRY AGAIN
BSCN2 ANI 7FH ;CLEAR THE UPPER BIT
MOV M,A ;STUFF IT BACK
BSCN1 LHLD TSCN ;NSCN=TSCN
SHLD NSCN
MVI C,2 ;SET UP COUNTER
BSCN4 DCX H ;GET LAST CHARACTER
MOV A,M ;GET A CHARACTER, STUPID.
ANA A ;SET FLAGS
JP BSCN4 ;TRY AGAIN
DCR C ;FIND TWO YET?
JNZ BSCN4 ;NOPE
BSCN5 INX H ;GET NEXT CHARACTER
MOV A,M ;GET THE CHARACTER
CPI 20H ;IS IT A SPACE?????
JZ BSCN5 ;YUP, SO TRY AGAIN
SHLD TSCN ;STORE NEW TSCN
LDA ESCN ;CHECK END FLAG OUT
RRC
ANI 1
STA ESCN
RET ;DONE..
* RTN. D.6
* GET SYMBOL NUMBER
* IN: HL = LABEL START
* A = ID BYTE FOR TYPE DESIRED
* OUT: BC = SYMBOL NUMBER
* CARRY SET IF ID BYTE WAS WRONG
* A = ID BYTE
GTNM PUSH PSW ;SAVE PARAMETERS
PUSH H
CALL SSRC ;SEARCH THE SYMBOL TABLE
JNZ GTNM1 ;OH, OH, WE'LL HAVE TO INSERT IT
POP H ;GET BACK PARAMETERS
POP D
CMP D ;SEE IF ID BYTES ARE THE SAME
RZ ;SURE WERE
STC ;FLAG THE FACT
RET
GTNM1 POP H ;GET BACK SYMBOL ADDRESS
CALL ITAB ;INSERT IN SYMBOL TABLE
POP PSW ;GET BACK ID BYTE
MOV M,A ;STORE IT
DCX H ;CLEAR THE POINTER OUT
MVI M,0
DCX H
MVI M,0
ANA A ;CLEAR CARRY
RET ;DONE...
* RTN. D.7
* LEGAL LABEL CHECK
* CHECKS THIS SCAN OFF AS A LABEL
* IF ILLEGAL, EXITS WITH CARRY SET
* OTHERWISE, CARRY IS CLEARED
LGLB LHLD TSCN ;GET THIS SCAN ADDRESS
MOV A,M ;GET A CHARACTER
ANI 7FH ;STRIP OFF UPPER BIT
CPI 7BH ;IS IT BIGGER THAN LOWER CASE?
JNC LGLB1 ;YUP
CPI 61H ;IS IT LOWER CASE?
JNC LGLB2 ;YUP
CPI 'Z'+1 ;IS IT BIGGER THAN ALPHABETIC?
JP LGLB1 ;YUP
CPI 'A' ;IS IT ALPHABETIC?
JP LGLB2 ;YUP
CPI '9'+1 ;IS IT BIGGER THAN NUMERIC?
JP LGLB1 ;YUP
CPI '0' ;IS IT NUMERIC
JP LGLB2 ;YUP
LGLB1 STC ;ILLEGAL EXIT
LGLB2 RET ;DONE.
* RTN. D.8
* LEGAL NUMBER CHECK
* IN: TSCN HAS LOCATION OF TRIAL NUMBER
* OUT: CARRY SET IF THIS IS NOT A NUMBER
* TMP10 HAS THE NUMBER TRANSLATED
* NSCN IS SET TO NEXT CHARACTER AFTER NUMBER
LGNM LHLD TSCN ;GET START OF TRIAL NUMBER
MOV A,M ;GET FIRST CHARACTER
ANI 7FH ;STRIP OFF UPPER BIT
CPI '.' ;IS IT A PERIOD?
JZ LGNM5 ;YUP
CPI '9'+1 ;IS IT BIGGER THAN A NUMBER
STC ;SET CARRY JUST IN CASE
RP ;RETURN IF IT'S NOT A DIGIT
CPI '0' ;SEE IF IT'S LESS THAN A DIGIT
RC ;RETURN IF IT'S NOT A DIGIT
LGNM5 LXI D,TMP10 ;GET PLACE TO PUT THE NUMBER
CALL STNM ;CONVERT TO NUMBER (OR AT LEAST TRY)
RC ;RETURN IF CONVERSION ERROR OCCURED
DCX H ;CORRECT ADDRESS TO GET LAST CHARACTER IN NUMBER
PUSH H ;SAVE ADDRESS
CALL BSCN ;GET RID OF END FLAG
CALL BSCN
POP H ;RESTORE ADDRESS
MOV A,M ;UPDATE END FLAG
ANA A ;SET FLAGS
JM LGNM3 ;JUMP IF END IS ALREADY REACHED
ORI 80H
MOV M,A
SHLD NSCN ;UPDATE NEXT SCAN OFF ADDRESS
CALL USCN ;GET ALL THE FLAGS RIGHT
XRA A ;CLEAR CARRY
RET ;DONE, LET'S GET OUT OF HERE
LGNM3 CALL USCN ;SCAN OFF TILL END
JNC LGNM3 ;LOOP FOR ANOTHER SCAN-OFF
XRA A ;CLEAR CARRY
RET ;DONE.
* RTN. D.9
* PROCESS OPERATOR
* ZERO SET IF IT WAS VALID OPERATOR
* A = CODE FOR OPERATOR
POPR LHLD TSCN ;GET SCAN START ADDRESS
LXI D,OTBL ;OPERATOR TABLE ADDRESS
LXI B,22 ;NUMBER OF OPERATOR TYPES
CALL STSRH ;SEARCH TABLE
JZ POPR1 ;OK, WE FOUND IT
RNZ
POPR1 MOV A,C ;GET THE ITEM NUMBER
CPI 22 ;CHECK FOR "&"
JZ POPRA ;SURE WAS
CPI 19 ;CHECK FOR DUPLICATE RANGE
JM POPR2 ;IT'S NOT
SUI 15 ;MAKE IT RIGHT (MAYBE)
CPI 6 ;SEE IF IT'S ><
JNZ POPR2 ;NOPE
INR A ;YUP
INR A
POPR2 ADI 0FH ;ADD OPCODE OFFSET
CPI 18H ;CHECK FOR EQUAL SIGN
JZ POPR5 ;YUP
POPR6 MOV B,A ;SAVE THE CODE
XRA A ;CLEAR CARRY, SET ZERO
MOV A,B ;GET THE CODE BACK
RET ;DONE!!!!!!
POPR5 LDA OPFLG ;CHECK FOR A "LET" STATEMENT
CPI 0A8H ;CHECK IT
MVI A,18H ;GET REGULAR EQUALS SIGN BACK
JNZ POPR6 ;FALSE ALARM
MVI A,0FH ;CODE FOR ASSIGNMENT OPERATOR
JMP POPR6 ;SEND IT
POPRA MVI A,1AH ;GET + CODE
RET ;DONE.
USCNO CPI '>' ;CHECK THESE THINGS OUT
RZ
CPI '<'
RZ
CPI '='
RET ;DONE
OTBL DB 'O'
DB 'R'+80H
DB 'A'
DB 'N'
DB 'D'+80H
DB 'N'
DB 'O'
DB 'T'+80H
DB '>'
DB '='+80H
DB '<'
DB '='+80H
DB '>'+80H
DB '<'+80H
DB '<'
DB '>'+80H
DB '='+80H
DB '-'+80H
DB '+'+80H
DB '/'+80H
DB '*'+80H
DB '-'+80H
DB 'N'
DB 'O'
DB 'T'+80H
DB 0DEH
DB '('+80H
DB ')'+80H
DB '='
DB '>'+80H
DB '='
DB '<'+80H
DB '>'
DB '<'+80H
DB '&'+80H
* RTN. D.10
* LINE DESCRIPTOR PROCESSOR
* PRODUCES STATEMENT NAME ON TRIAL DECODED STATEMENT, AND
* OPTIONALLY, THE +- OFFSET EXPRESSION
* ON RETURN, CARRY SET IF END OF LINE ENCOUNTERED
PLDS CALL USCN ;SCAN OFF THE LABEL
RC
CALL LGLB ;CHECK LEGALITY OF LABEL
MVI B,7 ;SET UP FOR ERROR 7
JC ERROR ;OH, OH, ILLEGAL LABEL
MVI A,1 ;SET UP STATEMENT NAME ID
LHLD TSCN ;GET LABEL ADDRESS
CALL GTNM ;GET THE SYMBOL NUMBER
PUSH B ;SAVE 'EM
MVI B,9 ;SET UP FOR ERROR 9
JC ERROR ;OH, OH, TRYING TO USE A VARIABLE FOR A STATEMENT!
POP B ;GET 'EM BACK
LHLD SLIN ;GET ADDRESS TO STORE CONVERTED CODE
MVI M,6 ;STORE IT ALL
INX H
MOV M,C
INX H
MOV M,B
INX H
MVI M,7
INX H
SHLD SLIN ;SAVE THE NEW ADDRESS
CALL USCN ;SCAN OFF A TOKEN
RC ;END OF THE LINE, INSTEAD
CALL POPR ;CHECK FOR AN OPERATOR FOLLOWING
JZ PLDS1 ;AH, HA, AN OPERATOR
PLDS2 ANA A ;CLEAR CARRY
RET ;DONE.
PLDS1 CPI 19H ;CHECK FOR A -
JZ PLDS3 ;YUP
CPI 1AH ;CHECK FOR A +
JNZ PLDS2 ;NOPE
PLDS3 CALL BSCN ;PUT IT ALL BACK
LHLD SLIN ;STORE THE EXPRESSION OPCODE
MVI M,8 ;DONE
INX H ;UPDATE INDEX
SHLD SLIN ;SAVE IT
JMP EVEX ;PROCESS THE EXPRESSION FOLLOWING
SPRAT MVI B,10H ;SYNTAX ERROR CODE
JMP ERROR
* RTN. D.11
* COMMA, COLON, REMARK, AND END OF LINE CHECKER FOR
* STATEMENTS USING LISTS
* OUT: CARRY SET IF END OF LINE
* ZERO SET IF COMMA
* JUMPS TO EXEC3 IF COLON
* JUMPS TO PREM IF REMARK
* JUMPS TO ERROR 10 (SYNTAX) IF ANYTHING ELSE
CCRC CALL USCN ;SCAN OFF A TOKEN
RC ;END OF LINE
LHLD TSCN ;GET THE CHARACTER
MOV A,M ;GOT IT
CPI ','+80H ;SEE IF IT'S A COMMA
RZ ;SURE WAS
CPI ':'+80H ;SEE IF IT'S A COLON
JZ CCRC1 ;YUP
CPI 0ACH ;SEE IF IT'S A SINGLE QUOTE
JZ PREM ;YES, SO PROCESS REMARK
MVI B,10H ;GET A 10 FOR ERROR TYPE
JMP ERROR ;GO GET IT
CCRC1 CALL USCN ;SCAN OFF THE FIRST TOKEN OF NEXT STATEMENT
JMP ENPR1 ;GO PROCESS IT
* RTN. D.12
* PROCESS LINE DESCRIPTOR LIST
* RETURNS WHEN END OF LINE IS REACHED
* IF COLON ENCOUNTERED, RETURNS TO EXEC3
PLDL CALL PLDS ;SCAN OFF A LINE DESCRIPTOR
RC ;END OF LINE
CALL BSCN ;GET BACK THE COMMA
CALL CCRC ;CHECK THE SEPARATOR
RC ;END OF LINE
JMP PLDL ;LOOP FOR ANOTHER LINE DESCRIPTOR
* RTN. D.13
* REMARKS PROCESSOR
* PROCESSES TEXT FOLLOWING EITHER "'" OR "REM"
PREM LHLD NSCN ;GET FIRST SIGNIFICANT TEXT ADDRESS
PUSH H ;SAVE IT
LDA ESCN ;CHECK FOR REM ALONE
PUSH PSW
CALL BSCN ;BACK OFF, JACK
MVI A,35H ;"'" OPCODE
CALL ICBY ;INSERT IT
POP PSW ;GET BACK FORMER ESCN
CPI 2 ;IS IT REM ALONE?
JNZ PREM2 ;NOPE
POP D ;STORE FAKEOUT SPACE
PUSH D
MVI A,0A0H
STAX D
PREM2 POP D ;FIRST CHARACTER INDEX TO DE
DCX D ;GET ONE LESS
LHLD SLIN ;GET CONVERTED CODE ADDRESS
MVI M,0 ;STORE ID BYTE FOR STRING
PREM1 INX H ;UPDATE INDEXES
INX D
LDAX D ;GET CHARACTER
MOV M,A ;STUFF IT IN MEMORY
ANA A ;SET FLAGS
JP PREM1 ;LOOP FOR MORE CHARACTERS
INX H ;GET NEXT CODE LOCATION
MVI M,1 ;MARK END OF STRING
INX H ;GET NEXT ONE
SHLD SLIN ;STUFF IT BACK
RET ;DONE.
* RTN. D.14
* EVALUATE INFIX EXPRESSION INTO REVERSE POLISH EXPRESSION
* OUT: RETURNS WHEN END OF EXPRESSION DETECTED
* ERROR EXIT (SYNTAX) OCCURS IF:
* 1. AN ILLEGAL SYMBOL OR LABEL IS ENCOUNTERED
* 2. A RIGHT PAREN WITHOUT A LEFT PAREN OCCURS
* 3. TWO BINARY OPERATORS IN A ROW OCCUR
* 4. THERE ARE MORE LEFT PARENS THAN RIGHT
* 5. TWO LABELS, LITERALS, OR CONSTANTS OCCUR IN A ROW
EVEX LHLD SLIN ;COMPUTE PLACE TO PUT STACK
LDA RURD ;CHECK IF RUN READY
ANA A
JNZ EVE00 ;YUP
XCHG
LHLD SDIR
CALL SUB16
MOV A,H ;RIGHT SHIFT HL INTO DE
ANA A ;CLEAR CARRY
RAR ;RIGHT SHIFT
MOV D,A
MOV A,L
RAR
MOV E,A
LHLD SLIN
DAD D ;GOT IT
SHLD FARY ;SAVE IT
EVE01 XCHG ;PUT IT IN DE
LHLD SLIN ;GET PLACE TO PUT POLISH STRING
LXI B,1 ;INITIALIZE THE COUNTERS
MVI M,9 ;STORE THE EXPRESSION OPCODE
INX H ;UPDATE SLIN
EVEX1 PUSH B ;SAVE ALL THIS JUNK
PUSH D
PUSH H
CALL USCN ;SCAN OFF A TOKEN
JC EVEX2 ;RAN INTO END OF LINE
CALL POPR ;CHECK FOR NORMAL OPERATOR
JZ EVEX3 ;SURE IS
CALL PFUN ;CHECK FOR INTRINSIC FUNCTION
JZ EVEX3 ;YUP
CALL SCCC ;CHECK FOR SEMICOLON OR COMMA
JZ COMM ;IT WAS
CALL PINT ;CHECK FOR AN INTERMEDIARY
JZ EVEX2 ;YUP, SO END OF EXPRESSION
LHLD TSCN ;GET THIS ADDRESS THEY'RE TALKIN' ABOUT
MOV A,M ;GET THE CHARACTER
CPI '"'+80H ;SEE IF IT'S A STRING LITERAL
JZ EVEX4 ;SURE IS
CALL LGNM ;IS IT A NUMBER?
JNC EVEX5 ;YUP
CALL LGLB ;IS IT A LABEL?
JNC EVEX6 ;'PEARS TO BE..
MVI B,11H ;SET UP ERROR 11
JMP ERROR ;ILLEGAL VARIABLE NAME
COMM CPI 0DH ;COMMA?
JNZ COMM1 ;NOPE
LDA OPFLG ;GET OPCODE
CPI 80H ;ON....GOTO?
MVI A,0DH ;GET COMMA BACK
JNZ COMM1 ;NOPE
CALL BSCN ;SCAN BACK ONE
JMP EVEX2 ;DONE
COMM1 POP H ;POP 'EM ALL
POP D
POP B
PUSH PSW ;SAVE THE CODE
COMM3 INR B ;STACK EMPTY?
DCR B
JZ COMM2 ;YUP
LDAX D ;GET TOP OF STACK
CPI 20H ;IS IT "("?
JZ COMM2 ;YUP
MOV M,A ;STORE IT
INX D ;BUMP UP INDEXES
INX H
DCR B
JMP COMM3 ;TRY FOR ANOTHER ONE
EVE00 LHLD FARY
JMP EVE01
COMM2 POP PSW ;GET CODE BACK
MOV M,A ;STUFF IT IN
INX H ;BUMP UP INDEX
MVI C,1 ;SET OPERATOR LAST
JMP EVEX1
EVEXQ POP H ;GET REGISTERS BACK
POP D
POP B
MVI A,36H ;FUNCTION OPERATOR OPCODE
DCX D ;PUSH ONTO STACK
INR B
STAX D
PUSH B ;SAVE 'EM
PUSH D
PUSH H
LHLD TSCN ;RESTORE INDEX
MVI A,4 ;FUNCTION ID BYTE
JMP EVEXY ;CONTINUE PROCESSING
EVEX6 POP H ;GET 'EM BACK
POP D
POP B
CALL EVEXG ;CHECK FOR TWO LABELS IN A ROW
PUSH B ;SAVE 'EM ALL AGAIN
PUSH D
PUSH H
LHLD TSCN ;GET ADDRESS OF THIS LABEL
MOV A,M ;GET A CHARACTER
CPI 'F' ;CHECK FOR AN F
JNZ EVEXX ;NOPE
INX H ;GET NEXT CHARACTER
MOV A,M ;GET IT
CPI 'N' ;CHECK FOR AN N
DCX H ;RESTORE INDEX
JZ EVEXQ ;YUP, WE'VE GOT AN FN(XXX)
EVEXX CALL USCN ;CHECK FOR "(" ON NEXT TOKEN
JC EVEXZ ;OOPS, RAN INTO THE END
CALL BSCN ;SCAN BACK
LHLD NSCN ;GET ADDRESS OF NEXT TOKEN
MOV A,M ;GET IT
CPI '('+80H ;CHECK IT
JNZ EVEXZ ;NOPE
LHLD TSCN ;TIME TO CHANGE THE FIRST CHARACTER
DCX H ;GET ONE BACK
MVI M,0 ;CLEAR IT
SHLD TSCN ;SAVE THE ADDRESS
MVI A,16 ;ARRAY CODE
JMP EVEXY ;SKIP
EVEXZ LHLD TSCN ;GET IT AGAIN
MVI A,2 ;VARIABLE ID BYTE
EVEXY CALL GTNM ;GET SYMBOL NUMBER
PUSH B ;SAVE BC
MVI B,17H ;ERROR TYPE
JC ERROR ;CAN'T USE A STATEMENT FOR A VARIABLE, DUMMY.
POP B ;RESTORE BC
POP H ;GET SLIN BACK
MVI M,2 ;STORE OPCODES AND SYMBOL NUMBER
INX H
MOV M,C
INX H
MOV M,B
INX H
MVI M,3
INX H
POP D ;GET EVERY THING ELSE BACK
POP B
EVEX7 MVI C,2 ;SET C TO "LABEL LAST"
JMP EVEX1 ;LOOP FOR ANOTHER TOKEN
EVEX5 POP H ;GET IT ALL BACK
POP D
POP B
CALL EVEXG ;CHECK FOR TWO LABELS IN A ROW
PUSH B ;STUFF IT ALL BACK
PUSH D
MVI M,4 ;STORE OPCODES AND NUMBER
LXI D,TMP10 ;LOCATION OF TRANSLATED NUMBER
XCHG ;GET IT TO THE RIGHT PLACE
INX D ;UPDATE SLIN
LXI B,6 ;NUMBER OF BYTES
CALL MOVE ;MOVE IT IN
XCHG ;GET SLIN BACK TO HL
DAD B ;ADD 6
MVI M,5 ;OPCODE
INX H ;UPDATE SLIN
JMP EVEX7-2 ;POP THE REST AND LOOP
EVEXG MOV A,B ;SAVE STACK COUNT
MVI B,15H ;ERROR
DCR C ;CHECK FOR C=2
DCR C
JZ ERROR ;TWO IN A ROW, STUPID
MOV B,A ;PUT STACK BACK
RET ;DONE
EVEX4 POP H ;GET 'EM ALL BACK
POP D
POP B
CALL EVEXG ;CHECK FOR C=2
PUSH B ;SAVE SOME
PUSH D
PUSH H
CALL BSCN ;SCAN BACK, JACK
LHLD NSCN ;GET QUOTE ADDRESS
PUSH H ;SAVE ADDRESS
CALL BSCN
POP H ;RESTORE ADDRESS
POP D ;GET SLIN BACK
XCHG ;PUT IN THE RIGHT PLACE
MVI M,0 ;STORE START STRING CODE
EVEXH INX H ;UPDATE
INX D
LDAX D ;GET A CHARACTER
ANI 7FH ;STRIP OFF UPPER BIT
CPI '"' ;IS IT A QUOTE?
JZ EVEXI ;YUP
LDAX D ;IS IT THE LAST ONE?
ANA A ;SET FLAGS
MOV M,A ;STUFF IT IN MEMORY
JP EVEXH ;IT'S OKAY, GET ANOTHER ONE
INX H ;CORRECTION FACTOR
EVEXI DCX H ;GET LAST CHARACTER
MOV A,M ;GOT IT
ANA A
JNZ EV00
INX H
MVI A,0H
EV00 ORI 80H ;SET UPPER BIT
MOV M,A ;SET IT BACK
INX H ;GET NEXT ADDRESS
MVI M,1 ;END OF STRING MARKER
INX H ;NEXT SLIN
XCHG ;GET QUOTE ADDRESS TO HL
SHLD NSCN ;SET NSCN
MOV A,M ;GET A BYTE
ANA A ;SET FLAGS
JP EVEXN ;WASN'T THE END
MVI A,1 ;SET ESCN IF THE END HAS STRUCK
STA ESCN
EVEXN MVI M,'"'+80H ;SET UPPER BIT
PUSH D ;SAVE IT
CALL USCN ;SCAN UP ONE TO PUT THINGS RIGHT
POP D
XCHG ;PUT THINGS RIGHT
JMP EVEX7-2 ;LOOP FOR MORE CHARACTERS
EVEX3 POP H ;GET 'EM ALL BACK
POP D
POP B
CPI 20H ;CHECK FOR "("
JZ EVEX8 ;IT WAS, INDEED
CPI 21H ;CHECK FOR ")"
JZ EVEX9 ;THERE YOU GO
DCR C ;CHECK FOR C=1
JNZ EVEXW ;IT WASN'T
CPI 12H ;IS IT "NOT"?
JNZ EVEXJ ;NOPE
INR C ;INDICATE IT
MVI A,1EH ;UNARY NOT
EVEXJ CPI 19H ;IS IT "-"?
JNZ EVEXK ;NOPE
INR C ;INDICATE IT
MVI A,1DH ;CONVERT TO UNARY MINUS
EVEXK CPI 40H ;SEE IF IT IS A FUNCTION
JM EVEXM ;NOPE
INR C ;INDICATE IT
EVEXM DCR C ;SEE IF C=0
JM EVEXB ;SURE WAS
EVEXW MOV C,A ;SAVE THE CHARACTER
EVEXA DCR B ;CHECK FOR STACK EMPTY
INR B
JZ EVEXC ;SURE WAS
LDAX D ;GET TOP OF STACK
CPI 20H ;SEE IF IT'S A "("
JZ EVEXC ;YUP
CPI 19H ;CHECK FOR A MINUS SIGN
JNZ QQQQ ;NOPE
INR A ;YES, SO CHANGE PRECEDENCE CODE
INR A
QQQQ DCR A
CMP C ;CHECK PRECEDENCE
JC EVEXC ;NEW ONE IS HIGHER
LDAX D ;GET TOP OF STACK
MOV M,A ;STORE THE CHARACTER
DCR B ;UPDATE STACK POINTERS
INX D
INX H ;UPDATE SLIN
JMP EVEXA ;LOOP TO TRY AGAIN
EVEXB CPI 1AH ;IS IT A '+'?
JZ EVEXE ;YUP, SO IGNORE IT
MVI B,14H ;UH, OH, ERROR
JMP ERROR
EVEXC MOV A,C ;CHARACTER TO A
DCX D ;UPDATE STACK POINTERS
INR B
STAX D ;PUSH ONTO STACK
EVEXE MVI C,1 ;SET OPERATOR LAST
JMP EVEX1 ;LOOP FOR ANOTHER TOKEN
EVEX8 DCR C ;CHECK FOR C=2
DCR C
JNZ EVEXD ;NOPE
LDAX D ;GET TOP OF STACK
CPI 36H ;IS IT FUNCTION OPERATOR?
JZ EVEXD ;YUP
MVI A,34H ;ARRAY OPERATOR
DCX D ;UPDATE STACK POINTERS
INR B ;ONE MORE ON STACK
STAX D ;STUFF IT ON
EVEXD MVI A,20H ;GET CODE FOR "("
DCX D ;UPDATE STACK POINTERS
INR B
STAX D ;STUFF IT ON THE STACK
JMP EVEXE ;LOOP FOR ANOTHER TOKEN
EVEX9 INR B ;CHECK FOR EMPTY STACK
DCR B
PUSH B ;SAVE 'EM
MVI B,12H ;ERROR TYPE
JZ ERROR ;WE SEEM TO HAVE NOT ENOUGH LEFT PARENS
POP B ;GET 'EM BACK
LDAX D ;GET OPERATOR ON TOP OF STACK
INX D ;UPDATE STACK POINTERS
DCR B
CPI 20H ;IS IT A "("
JZ EVEX7 ;YUP, SO LOOP FOR ANOTHER TOKEN
MOV M,A ;NOPE, SO STICK IT ON THE POLISH STRING
INX H ;UPDATE SLIN
JMP EVEX9 ;LOOP TO CHECK NEXT TOP OF STACK
EVEX2 POP H ;RESTORE ALL
POP D
POP B
EVEXU INR B ;CHECK FOR EMPTY STACK
DCR B
JZ EVEXF ;ALL DONE!!
LDAX D ;GET TOP OF STACK
INX D ;UPDATE POINTERS
DCR B
CPI 20H ;IS IT "("?
PUSH B ;SAVE 'EM
MVI B,13H ;ERROR TYPE
JZ ERROR ;TOO MANY LEFT PARENS
POP B ;GET 'EM BACK
MOV M,A ;STICK IT ON THE POLISH STRING
INX H ;UPDATE SLIN
JMP EVEXU ;TRY NEXT CHARACTER
EVEXF MVI M,9 ;STORE END OF EXPRESSION CHARACTER
DCX H ;CHECK FOR NO EXPRESSION
MOV A,M ;GET A BYTE
CPI 9 ;CHECK FOR BEGINNING OF EXPRESSION
SHLD SLIN ;SAVE SLIN
RZ ;DONE
INX H
INX H ;UPDATE SLIN
SHLD SLIN ;SAVE IT
RET ;DONE..
COJMP DW PCAD
DW CLER
DW PCLS
DW PCNT
DW PCSS
DW DLTE
DW ENTR
DW LIST
DW PNEW
DW PRUN
DW EDIT
DW PRSY
DW 0
CONS3 DB 2 ;ID BYTE FOR 65536
DB 0
DB 0
DB 06H
DB 55H
DB 36H
ETBLE DB 03 ;POWERS OF E (1)
DB 0
DB 27H
DB 18H
DB 28H
DB 18H
DB 3 ; (2)
DB 0
DB 73H
DB 89H
DB 05H
DB 61H
DB 3 ; (4)
DB 01H
DB 54H
DB 59H
DB 81H
DB 50H
DB 3 ; (8)
DB 03H
DB 29H
DB 80H
DB 95H
DB 80H
DB 3 ; (16)
DB 06H
DB 88H
DB 86H
DB 11H
DB 05H
DB 3 ; (32)
DB 13H
DB 78H
DB 96H
DB 29H
DB 60H
DB 3 ; (64)
DB 27H
DB 62H
DB 35H
DB 14H
DB 91H
DB 3 ; (128)
DB 55H
DB 38H
DB 87H
DB 70H
DB 84H
* RTN. B.49
* E RAISED TO THE X'TH POWER
* (HL) = X, (DE) IS WHERE ANSWER GOES
* ANY X SUCH THAT -K<X<K, WHERE
* K IS LN(9.9999999E 99)
ETOX PUSH D ;SAVE DESTINATION ADDRESS
LXI D,TMP1 ;SET UP TO MOVE INTO TMP1
PUSH D ;SAVE LOCATIONS
PUSH H
CALL ABSLT ;ABSOLUTE VALUE TO TMP1
POP H ;RESTORE LOCATIONS
POP D
MOV A,M ;GET STARTING ID BYTE
ANI 80H ;STRIP OFF MANTISSA SIGN BIT
STA SIGNF ;SAVE IT
XCHG ;GET TMP1 ADDRESS TO HL
CALL BCDB ;CONVERT TO BINARY
LXI D,231 ;CHECK SIZE OF EXPONENT
CALL CMP16 ;COMPARE
JNC ETOX1 ;OVERFLOW ERROR
PUSH H ;SAVE THE NUMBER
LXI H,ONE11 ;INITIALIZE TMP8 TO A 1
LXI D,TMP8
LXI B,6
CALL MVDN
POP B ;GET THE NUMBER BACK IN BC
MVI B,1 ;SET MASK
LXI H,ETBLE ;SET HL TO BEGINNING OF POWERS OF E
ETOX3 MOV A,B ;A=B AND C
ANA C
JZ ETOX2 ;SKIP IF BIT WAS A ZERO
PUSH B ;SAVE MASK AND NUMBER
PUSH H ;SAVE INDEX
LXI D,TMP8 ;TMP8=TMP8*E TO THE 2 TO THE N'TH
MOV B,D
MOV C,E
CALL MULER ;MULTIPLY
POP H ;RESTORE INDEX
POP B ;AND MASK, AND NUMBER
ETOX2 MVI A,6 ;HL=HL+6
CALL ADHL
MOV A,B ;LEFT SHIFT THE MASK
RLC
MOV B,A
JNC ETOX3 ;LOOP FOR MORE INTEGER PORTION
LXI H,TMP1 ;TMP1=TMP1-TMP9
LXI D,TMP9
MOV B,H
MOV C,L
PUSH H ;SAVE ADDRESSES
PUSH D
CALL SUBER ;SUBTRACT
POP D ;RESTORE ADDRESSES
POP H
LXI B,6 ;NUMBER OF BYTES
CALL MVDN ;TMP9=TMP1
LXI H,ONE11 ;TMP2=TMP3=TMP5=1
LXI D,TMP2
CALL MVDN
LXI D,TMP5
CALL MVDN
LXI D,TMP3
LXI H,CON99
CALL MVDN
ETOX4 LXI H,TMP1 ;TMP6=TMP1/TMP3
LXI D,TMP3
LXI B,TMP6
CALL DIVER ;DIVIDE
CALL TRMN1 ;CHECK FOR DONENESS
JC ETOX5 ;OK, WE'RE DONE
CALL FCTRL ;COMPUTE NEXT FACTORIAL TERM
LXI H,TMP9 ;TMP1=TMP1*TMP9
LXI D,TMP1
MOV B,D
MOV C,E
CALL MULER ;MULTIPLY
LXI H,TMP6 ;TMP5=TMP5+TMP6
LXI D,TMP5
MOV B,D
MOV C,E
CALL ADDER ;ADD
JMP ETOX4 ;LOOP FOR ANOTHER TERM
ETOX5 LXI H,TMP5 ;TMP5=TMP5*TMP8
LXI D,TMP8
MOV B,H
MOV C,L
CALL MULER ;MULTIPLY
LDA SIGNF ;CHECK FOR MINUS
ANA A ;SET FLAGS
POP B ;RESTORE DESTINATION
LXI H,ONE11 ;(BC)=1/TMP8 OR TMP8/1
LXI D,TMP5
JNZ ETOX6 ;SKIP IF IT WAS NEGATIVE
XCHG ;SWAP ADDRESSES
ETOX6 CALL DIVER ;DIVIDE
RET ;DONE..
ETOX1 MVI B,4 ;EXPONENT TOO LARGE ((((ERROR))))
JMP ERROR
* RTN. B.50
* LN(HL) TO (DE)
* NEGATIVE (HL) WILL PRODUCE AN ERROR
LOGX PUSH D ;SAVE DESTINATION
PUSH H ;SAVE SOURCE
LXI D,ZERO0 ;COMPARE WITH ZERO
CALL CMPR
POP H ;RESTORE SOURCE
MVI B,2 ;ERROR TYPE JUST IN CASE
JZ ERROR ;SURE WAS!!
LXI D,TMP1 ;TMP1=(HL)
LXI B,6
CALL MVDN
LDAX D ;GET ID BYTES
ANI 80H ;STRIP OFF MANTISSA SIGN BIT
JNZ LOGX3 ;OH, OH, WE'VE GOT AN ERROR
MVI B,80H ;SET UP MASK
MVI C,0 ;CLEAR INTEGER PORTION OF LOG
LXI D,ETBLE+42 ;SET UP INDEX
LOGX1 LXI H,TMP1 ;SET UP FOR COMPARE
PUSH H ;SAVE ALL THESE SILLY REGISTERS
PUSH B
PUSH D
CALL CMPR ;COMPARE
POP D ;RESTORE ALL VALUES
POP B
POP H
JC LOGX2 ;SKIP IF IT DON'T FIT
PUSH D ;SAVE 'EM AGAIN
PUSH B
MOV B,H
MOV C,L
CALL DIVER ;DIVIDE
POP B ;RESTORE THE REGISTERS, PLEASE
POP D
MOV A,C ;C=B OR C
ORA B
MOV C,A
LOGX2 XCHG ;HL=DE
LXI D,6 ;SET UP FOR
CALL SUB16 ;SUBTRACT
XCHG ;DE=HL
MOV A,B ;GET THE MASK
RRC ;RIGHT SHIFT IT
MOV B,A
JNC LOGX1 ;LOOP IF THERE ARE MORE BITS TO DO
MOV L,C ;CONVERT C TO A NUMBER
MVI H,0
LXI D,TMP7
CALL BBCD ;CONVERT
LXI H,ZERO0 ;TMP5=0
LXI D,TMP5
LXI B,6
CALL MVDN
LXI H,TMP1 ;TMP9=TMP1-1
LXI D,ONE11
LXI B,TMP9
PUSH H ;SAVE SOME
PUSH D
CALL SUBER ;SUBTRACT
POP D ;GET 'EM BACK
POP H
MOV B,H ;TMP1=TMP1+1
MOV C,L
PUSH H ;SAVE AGAIN
CALL ADDER ;ADD
POP H ;GET TMP1 ADDRESS
MOV B,H
MOV C,L
LXI D,TMP9 ;TMP1=TMP9/TMP1
XCHG ;GET ADDRESSES RIGHT PLACE
PUSH B ;SAVE TMP1 ADDRESS
CALL DIVER ;DIVIDE
POP H ;GET TMP1 ADDRESS
MOV D,H
MOV E,L
LXI B,TMP4 ;TMP4=TMP1*TMP1
CALL MULER ;MULTIPLY
LXI H,ONE11 ;TMP2=1
LXI D,TMP2
LXI B,6
CALL MVDN
LOGX4 LXI H,TMP1 ;TMP6=TMP1/TMP2
LXI D,TMP2
LXI B,TMP6
CALL DIVER ;DIVIDE
CALL TRMN1 ;CHECK FOR DONENESS
JC LOGX5 ;OK, WE'RE DONE
LXI H,TWO22 ;TMP2=TMP2+2
LXI D,TMP2
MOV B,D
MOV C,E
CALL ADDER ;ADD
LXI H,TMP1 ;TMP1=TMP1*TMP4
LXI D,TMP4
MOV B,H
MOV C,L
CALL MULER ;MULTIPLY
LXI H,TMP5 ;TMP5=TMP5+TMP6
LXI D,TMP6
MOV B,H
MOV C,L
CALL ADDER ;ADD
JMP LOGX4 ;LOOP FOR ANOTHER TERM
LOGX5 LXI H,TWO22 ;TMP5=TMP5*2
LXI D,TMP5
MOV B,D
MOV C,E
CALL MULER ;MULTIPLY
LXI H,TMP7 ;(BC)=TMP7+TMP5
LXI D,TMP5
POP B
CALL ADDER ;ADD
RET ;DONE,DONE,DONE
LOGX3 MVI B,6 ;ERROR TYPE 6
JMP ERROR ;GO GET IT
* RTN. B.51
* SQUARE ROOT FUNCTION
* (DE)=SQR(HL)
* RTN. B.52
* POWERS
* (BC) = (HL) TO THE (DE) POWER
* (HL) CANNOT BE NEGATIVE
PWRS PUSH B ;SAVE DESTINATION
PUSH D ;SAVE EXPONENT
PUSH H ;SAVE SOURCE
LXI D,ZERO0 ;CHECK FOR ZERO
CALL CMPR
POP H ;RESTORE SOURCE
JZ PWRSM ;IT'S A ZERO
XTHL ;GET EXPONENT TO HL
PUSH H ;SAVE SOURCE AGAIN
LXI D,HNDRD ;CHECK FOR LESS THAN A HUNDRED
CALL CMPR ;COMPARE
POP H ;RESTORE THE SOURCE
XTHL ;GET SOURCE BACK TO HL
JC PWRS1 ;LESS THAN ONE HUNDRED
PWRS2 LXI D,TMP10 ;TMP10=LN(HL)
CALL LOGX
POP D ;GET BACK EXPONENT
LXI H,TMP10 ;TMP10=TMP10*(DE)
MOV B,H
MOV C,L
CALL MULER ;MULTIPLY
POP D ;GET DESTINATION BACK
LXI H,TMP10 ;(DE)=ETOX(TMP10)
CALL ETOX
RET ;DONE....
* RTN. B.30
* MATCHER - CONVERTS (HL) AND (DE) TO THE SAME
* FORM, FLOATING POINT OR INTEGER, FOR LATER MATH
* FUNCTIONS. IF THEY ARE BOTH FLOATING POINT,
* CARRY IS SET ON EXIT.
MATCH LDAX D ;GET ONE ID BYTE
XRA M ;GET BITS DIFFERENT IN THE TWO
ANI 1 ;STRIP ALL BUT FLOATING/INTEGER BIT
MOV A,M ;GET AN ID BYTE
JNZ MTCH1 ;SKIP IF THEY ARE DIFFERENT
RRC ;SET CARRY ACCORDING TO FORM
RET ;NON-CONVERSION EXIT
MTCH1 ANI 1 ;WHAT IS (HL)'S FORM?
STC ;SET CARRY FOR LATER
PUSH PSW ;SAVE STATUS ON STACK
JZ MTCH2 ;SKIP IF (HL) IS ALREADY THE INTEGER
XCHG ;MAKE (HL) THE INTEGER
MTCH2 PUSH D ;SAVE REGISTERS
PUSH B
LXI D,TMP11 ;GET WORKING REGISTER ADDRESS
CALL INFL ;CONVERT INTEGER TO FLOATING POINT
POP B ;RESTORE REGISTERS
POP D
LXI H,TMP11
POP PSW ;GET STATUS BACK
RZ ;RETURN IF NO SWAP WAS MADE
XCHG ;PUT EVERYTHING BACK TO NORMAL
RET ;DONE
* RTN. B.31
* MATH ERROR PROCESSOR
* CHECK TO SEE IF MERR IS SET, IF NOT, RETURNS
* IF IT IS, JUMPS TO ERROR WITH THE APPROPRIATE
* ERROR NUMBER IN B
MCHK LDA MERR ;GET MERR TO A
ANI 07H ;CHECK FOR A BIT SET
RZ ;RETURN IF NONE
MVI B,1 ;PRESET COUNTER
MCHK1 RRC ;LSB TO CARRY
JC ERROR ;FOUND THE BIT
INR B ;UPDATE COUNTER
JMP MCHK1 ;LOOP FOR NEXT BIT
* RTN. B.32
* ERROR PROCESSOR
* ASSUMES ERROR TYPE NUMBER TO BE IN "B"
ERROR LXI H,EMSG ;GET ADDRESS OF ERROR MESSAGE
MOV A,B ;CHECK FOR CASSETTE LOAD ERROR
CPI 23H
JZ ERROR1 ;NOPE
LDA CSST ;CASSETTE MODE?
ANA A
JZ ERROR1 ;NOPE
LDA CMND ;ENTER MODE?
ANA A
JNZ ERROR1 ;NOPE
LHLD FRAV ;SET UP TO TURN IT INTO A REMARK
SHLD SLIN ;RESET CODED LINE
MVI A,86H ;STORE AS REMARK OPCODE
CALL ICBY
MVI A,35H ;SEND SINGLE QUOTE CODE
CALL ICBY ;SEND IT
ERROR2 LHLD NSCN ;BACK UP TO START
XCHG
LHLD CASER
CALL CMP16
JZ ERROR3
CALL BSCN
JMP ERROR2
ERROR3 CALL BSCN
LXI SP,STACK+100 ;RESET THE STACK
LXI H,EXEC3+3 ;SET RETURN ADDRES
PUSH H
XRA A ;CLEAR STFLAG
STA STFLG
LHLD CASER ;SET UP TO DECODE THIS MESS
XCHG
JMP PREM2+1 ;DO IT TO IT!!
ERROR1 XRA A ;CLEAR ANY CASSETTE MODE
STA BFLAG
STA CSST
STA CATV
STA EDITM ;CLEAR ANY EDIT MODE
LXI H,0 ;CLEAR ANY DUMP MEMORY MODE
SHLD DMPMM
MOV A,B ;CONVERT TO BINARY
CALL BCDBN
LXI H,ERMST ;START OF MESSAGE TABLE
DCR A ;CORRECT THE COUNT
ERROA ANA A ;CHECK FOR DONENESS
JZ ERROB ;SURE IS
CALL COUNT ;GET NEXT MESSAGE
DAD D
DCR A ;UPDATE COUNT
JMP ERROA
ERROB PUSH H
CALL CRLF
POP H
CALL MSGER ;SEND IT OUT
LXI H,EMSG ;SEND REST OF IT
CALL MSGER
CALL LNDSC ;SEND THE LINE DESCRIPTOR
XRA A ;CLEAR RUN MODE
STA RUNF
JMP EDI96 ;CHECK FOR POSSIBLE EDIT RE-ENTRY.
* RTN. B.33
* ADDER
* (BC) = (HL) + (DE)
ADDER CALL MATCH ;CHECK FORM
PUSH PSW ;SAVE CARRY
CC FPADD ;FLOATING POINT ADDITION
POP PSW ;RESTORE CARRY
CNC IADD ;INTEGER ADDITION
JMP MCHK ;LOOK FOR ERRORS
* RTN. B.34
* SUBTRACTER
* (BC) = (HL) - (DE)
SUBER CALL MATCH ;CHECK FORM
PUSH PSW ;SAVE CARRY
CC FPSUB ;FLOATING POINT SUBTRACTION
POP PSW ;RESTORE CARRY
CNC ISUB ;INTEGER SUBTRACTION
JMP MCHK ;LOOK FOR ERRORS
* RTN. B.35
* MULTIPLIER
* (BC) = (HL) TIMES (DE)
MULER CALL MATCH ;CHECK FORM
PUSH PSW ;SAVE CARRY
CC FLML ;FLOATING POINT MULTIPLICATION
POP PSW ;RESTORE CARRY
CNC IMUL ;INTEGER MULTIPLICATION
JMP MCHK ;LOOK FOR ERRORS
* RTN. B.36
* DIVIDER
* (BC) = (HL) DIVIDED BY (DE)
DIVER CALL MATCH ;CHECK FORM
PUSH PSW ;SAVE CARRY
CC DIV2A ;FLOATING POINT DIVISION
POP PSW ;RESTORE CARRY
CNC IDIV ;INTEGER DIVISION
JMP MCHK ;LOOK FOR ERRORS
EMSG DB ' ERROR IN',' '+80H
ERMST DB 'OVRFL','W'+80H
DB 'UNDRFL','W'+80H
DB '/','0'+80H
DB 'EX >','>'+80H
DB 'BIN CON >','>'+80H
DB '-LO','G'+80H
DB 'STATE N','M'+80H
DB 'COM','M'+80H
DB 'VRBL AS STAT','E'+80H
DB 'SYNTA','X'+80H
DB 'VRBL N','M'+80H
DB '>> ',')'+80H
DB '>> ','('+80H
DB '2 OPER','S'+80H
DB '2 OPAND','S'+80H
DB 'ILGL FUN','C'+80H
DB 'STATE AS VRB','L'+80H
DB 'NEW SYM','B'+80H
DB 'NO T','O'+80H
DB 'DUPL STAT','E'+80H
DB 'DUPL DE','F'+80H
DB 'CAN',27H,'T CON','T'+80H
DB 'TAP','E'+80H
DB 'STRIN','G'+80H
DB 'COMM','A'+80H
DB 'OPRN','D'+80H
DB '<*MEM*','>'+80H
DB 'UNDI','M'+80H
DB 'SUBSCPT >','>'+80H
DB 'SUBSCPT OVFL','W'+80H
DB 'ASSIG','N'+80H
DB 'STR AS NU','M'+80H
DB 'NUM AS ST','R'+80H
DB 'CNTRL STC','K'+80H
DB 'ON GOT','O'+80H
DB '<< DAT','A'+80H
DB 'RCV DAT','A'+80H
DB 8DH
DB '- SQ','R'+80H
DB 'LOGICA','L'+80H
PWRSM POP D ;GET RID OF EXPONENT
POP D ;GET THE DESTINATION
LXI B,6 ;SET UP TO MOVE IN THE ZERO
CALL MOVE ;DO IT TO IT
RET ;ALL DONE
PWRS1 POP B ;GET EXPONENT
POP D ;GET DESTINATION
PUSH H ;SWAP BC AND HL
PUSH B
POP H
POP B
PUSH B
PUSH D
PUSH H
LXI D,TMP11 ;PLACE TO PUT IT
CALL INTG ;GET THE INTEGER OF BASE
POP H ;GET THE NUMBERS AGAIN
LXI D,TMP11 ;WHERE IT'S AT
PUSH H
CALL CMPR ;SEE IF THEY ARE THE SAME
POP D
POP H
XTHL
PUSH D
JNZ PWRS2 ;NOT AN INTEGER, PROCESS WITH LOGS
PUSH H ;SAVE BASE
LXI H,ONEEE ;PRESET TMP1
LXI D,TMP1
LXI B,6
CALL MOVE ;MOVE IN A ONE (INTEGER FORM)
POP H ;PRESET TMP2 TO COUNT
XTHL
LXI D,TMP2
CALL MOVE
PWRS3 LXI H,TMP2 ;CHECK FOR DONENESS
LXI D,ZERO0
CALL CMPR
JZ PWRS5 ;SURE IS
POP D ;GET BASE
PUSH D ;SAVE IT
LXI H,TMP1 ;GET CURRENT RESULT
MOV B,H
MOV C,L
CALL MULER ;ANOTHER ITERATION
LXI H,TMP2 ;UPDATE THE COUNT
LXI D,ONEEE
MOV C,L
MOV B,H
CALL SUBER
JMP PWRS3 ;CHECK AGAIN FOR DONENESS
PWRS5 POP D ;CLEAN UP THE STACK
POP D ;GET THE DESTINATION
LXI H,TMP1 ;GET THE SOURCE
LXI B,6 ;THE NUMBER OF BYTES
JMP MOVE ;MOVE IT IN AND RETURN
SPRGSH PUSH D ;SAVE IT
LXI D,1 ;PRESET
SPRGSH1 MOV A,H ;CHECK FOR DONE
ORA L
JZ SPRGSH2 ;YUP
XCHG ;SWAP
DAD H
XCHG
DCX H
JMP SPRGSH1
SPRGSH2 XCHG
POP D
RET ;DONE
LINK3 LINK B:TBASICA4