4342 lines
197 KiB
NASM
4342 lines
197 KiB
NASM
;==================================================================================
|
|
; The updates to the original BASIC within this file are copyright Grant Searle
|
|
;
|
|
; You have permission to use this for NON COMMERCIAL USE ONLY
|
|
; If you wish to use it elsewhere, please include an acknowledgement to myself.
|
|
;
|
|
; http://searle.hostei.com/grant/index.html
|
|
;
|
|
; eMail: home.micros01@btinternet.com
|
|
;
|
|
; If the above don't work, please perform an Internet search to see if I have
|
|
; updated the web page hosting service.
|
|
;
|
|
;==================================================================================
|
|
|
|
; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft
|
|
; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3
|
|
; (May-June 1983) to Vol 3, Issue 3 (May-June 1984)
|
|
; Adapted for the freeware Zilog Macro Assembler 2.10 to produce
|
|
; the original ROM code (checksum A934H). PA
|
|
|
|
; GENERAL EQUATES
|
|
|
|
CTRLC .EQU 03H ; Control "C"
|
|
CTRLG .EQU 07H ; Control "G"
|
|
BKSP .EQU 08H ; Back space
|
|
LF .EQU 0AH ; Line feed
|
|
CS .EQU 0CH ; Clear screen
|
|
CR .EQU 0DH ; Carriage return
|
|
CTRLO .EQU 0FH ; Control "O"
|
|
CTRLQ .EQU 11H ; Control "Q"
|
|
CTRLR .EQU 12H ; Control "R"
|
|
CTRLS .EQU 13H ; Control "S"
|
|
CTRLU .EQU 15H ; Control "U"
|
|
ESC .EQU 1BH ; Escape
|
|
DEL .EQU 7FH ; Delete
|
|
|
|
; BASIC WORK SPACE LOCATIONS
|
|
|
|
WRKSPC .EQU 2045H ; BASIC Work space
|
|
USR .EQU WRKSPC+3H ; "USR (x)" jump
|
|
OUTSUB .EQU WRKSPC+6H ; "OUT p,n"
|
|
OTPORT .EQU WRKSPC+7H ; Port (p)
|
|
DIVSUP .EQU WRKSPC+9H ; Division support routine
|
|
DIV1 .EQU WRKSPC+0AH ; <- Values
|
|
DIV2 .EQU WRKSPC+0EH ; <- to
|
|
DIV3 .EQU WRKSPC+12H ; <- be
|
|
DIV4 .EQU WRKSPC+15H ; <-inserted
|
|
SEED .EQU WRKSPC+17H ; Random number seed
|
|
LSTRND .EQU WRKSPC+3AH ; Last random number
|
|
INPSUB .EQU WRKSPC+3EH ; #INP (x)" Routine
|
|
INPORT .EQU WRKSPC+3FH ; PORT (x)
|
|
NULLS .EQU WRKSPC+41H ; Number of nulls
|
|
LWIDTH .EQU WRKSPC+42H ; Terminal width
|
|
COMMAN .EQU WRKSPC+43H ; Width for commas
|
|
NULFLG .EQU WRKSPC+44H ; Null after input byte flag
|
|
CTLOFG .EQU WRKSPC+45H ; Control "O" flag
|
|
LINESC .EQU WRKSPC+46H ; Lines counter
|
|
LINESN .EQU WRKSPC+48H ; Lines number
|
|
CHKSUM .EQU WRKSPC+4AH ; Array load/save check sum
|
|
NMIFLG .EQU WRKSPC+4CH ; Flag for NMI break routine
|
|
BRKFLG .EQU WRKSPC+4DH ; Break flag
|
|
RINPUT .EQU WRKSPC+4EH ; Input reflection
|
|
POINT .EQU WRKSPC+51H ; "POINT" reflection (unused)
|
|
PSET .EQU WRKSPC+54H ; "SET" reflection
|
|
RESET .EQU WRKSPC+57H ; "RESET" reflection
|
|
STRSPC .EQU WRKSPC+5AH ; Bottom of string space
|
|
LINEAT .EQU WRKSPC+5CH ; Current line number
|
|
BASTXT .EQU WRKSPC+5EH ; Pointer to start of program
|
|
BUFFER .EQU WRKSPC+61H ; Input buffer
|
|
STACK .EQU WRKSPC+66H ; Initial stack
|
|
CURPOS .EQU WRKSPC+0ABH ; Character position on line
|
|
LCRFLG .EQU WRKSPC+0ACH ; Locate/Create flag
|
|
TYPE .EQU WRKSPC+0ADH ; Data type flag
|
|
DATFLG .EQU WRKSPC+0AEH ; Literal statement flag
|
|
LSTRAM .EQU WRKSPC+0AFH ; Last available RAM
|
|
TMSTPT .EQU WRKSPC+0B1H ; Temporary string pointer
|
|
TMSTPL .EQU WRKSPC+0B3H ; Temporary string pool
|
|
TMPSTR .EQU WRKSPC+0BFH ; Temporary string
|
|
STRBOT .EQU WRKSPC+0C3H ; Bottom of string space
|
|
CUROPR .EQU WRKSPC+0C5H ; Current operator in EVAL
|
|
LOOPST .EQU WRKSPC+0C7H ; First statement of loop
|
|
DATLIN .EQU WRKSPC+0C9H ; Line of current DATA item
|
|
FORFLG .EQU WRKSPC+0CBH ; "FOR" loop flag
|
|
LSTBIN .EQU WRKSPC+0CCH ; Last byte entered
|
|
READFG .EQU WRKSPC+0CDH ; Read/Input flag
|
|
BRKLIN .EQU WRKSPC+0CEH ; Line of break
|
|
NXTOPR .EQU WRKSPC+0D0H ; Next operator in EVAL
|
|
ERRLIN .EQU WRKSPC+0D2H ; Line of error
|
|
CONTAD .EQU WRKSPC+0D4H ; Where to CONTinue
|
|
PROGND .EQU WRKSPC+0D6H ; End of program
|
|
VAREND .EQU WRKSPC+0D8H ; End of variables
|
|
ARREND .EQU WRKSPC+0DAH ; End of arrays
|
|
NXTDAT .EQU WRKSPC+0DCH ; Next data item
|
|
FNRGNM .EQU WRKSPC+0DEH ; Name of FN argument
|
|
FNARG .EQU WRKSPC+0E0H ; FN argument value
|
|
FPREG .EQU WRKSPC+0E4H ; Floating point register
|
|
FPEXP .EQU FPREG+3 ; Floating point exponent
|
|
SGNRES .EQU WRKSPC+0E8H ; Sign of result
|
|
PBUFF .EQU WRKSPC+0E9H ; Number print buffer
|
|
MULVAL .EQU WRKSPC+0F6H ; Multiplier
|
|
PROGST .EQU WRKSPC+0F9H ; Start of program text area
|
|
STLOOK .EQU WRKSPC+15DH ; Start of memory test
|
|
|
|
; BASIC ERROR CODE VALUES
|
|
|
|
NF .EQU 00H ; NEXT without FOR
|
|
SN .EQU 02H ; Syntax error
|
|
RG .EQU 04H ; RETURN without GOSUB
|
|
OD .EQU 06H ; Out of DATA
|
|
FC .EQU 08H ; Function call error
|
|
OV .EQU 0AH ; Overflow
|
|
OM .EQU 0CH ; Out of memory
|
|
UL .EQU 0EH ; Undefined line number
|
|
BS .EQU 10H ; Bad subscript
|
|
DD .EQU 12H ; Re-DIMensioned array
|
|
DZ .EQU 14H ; Division by zero (/0)
|
|
ID .EQU 16H ; Illegal direct
|
|
TM .EQU 18H ; Type miss-match
|
|
OS .EQU 1AH ; Out of string space
|
|
LS .EQU 1CH ; String too long
|
|
ST .EQU 1EH ; String formula too complex
|
|
CN .EQU 20H ; Can't CONTinue
|
|
UF .EQU 22H ; UnDEFined FN function
|
|
MO .EQU 24H ; Missing operand
|
|
HX .EQU 26H ; HEX error
|
|
BN .EQU 28H ; BIN error
|
|
|
|
.ORG 00150H
|
|
|
|
COLD: JP STARTB ; Jump for cold start
|
|
WARM: JP WARMST ; Jump for warm start
|
|
STARTB:
|
|
LD IX,0 ; Flag cold start
|
|
JP CSTART ; Jump to initialise
|
|
|
|
.WORD DEINT ; Get integer -32768 to 32767
|
|
.WORD ABPASS ; Return integer in AB
|
|
|
|
|
|
CSTART: LD HL,WRKSPC ; Start of workspace RAM
|
|
LD SP,HL ; Set up a temporary stack
|
|
JP INITST ; Go to initialise
|
|
|
|
INIT: LD DE,INITAB ; Initialise workspace
|
|
LD B,INITBE-INITAB+3; Bytes to copy
|
|
LD HL,WRKSPC ; Into workspace RAM
|
|
COPY: LD A,(DE) ; Get source
|
|
LD (HL),A ; To destination
|
|
INC HL ; Next destination
|
|
INC DE ; Next source
|
|
DEC B ; Count bytes
|
|
JP NZ,COPY ; More to move
|
|
LD SP,HL ; Temporary stack
|
|
CALL CLREG ; Clear registers and stack
|
|
CALL PRNTCRLF ; Output CRLF
|
|
LD (BUFFER+72+1),A ; Mark end of buffer
|
|
LD (PROGST),A ; Initialise program area
|
|
MSIZE: LD HL,MEMMSG ; Point to message
|
|
CALL PRS ; Output "Memory size"
|
|
CALL PROMPT ; Get input with '?'
|
|
CALL GETCHR ; Get next character
|
|
OR A ; Set flags
|
|
JP NZ,TSTMEM ; If number - Test if RAM there
|
|
LD HL,STLOOK ; Point to start of RAM
|
|
MLOOP: INC HL ; Next byte
|
|
LD A,H ; Above address FFFF ?
|
|
OR L
|
|
JP Z,SETTOP ; Yes - 64K RAM
|
|
LD A,(HL) ; Get contents
|
|
LD B,A ; Save it
|
|
CPL ; Flip all bits
|
|
LD (HL),A ; Put it back
|
|
CP (HL) ; RAM there if same
|
|
LD (HL),B ; Restore old contents
|
|
JP Z,MLOOP ; If RAM - test next byte
|
|
JP SETTOP ; Top of RAM found
|
|
|
|
TSTMEM: CALL ATOH ; Get high memory into DE
|
|
OR A ; Set flags on last byte
|
|
JP NZ,SNERR ; ?SN Error if bad character
|
|
EX DE,HL ; Address into HL
|
|
DEC HL ; Back one byte
|
|
LD A,11011001B ; Test byte
|
|
LD B,(HL) ; Get old contents
|
|
LD (HL),A ; Load test byte
|
|
CP (HL) ; RAM there if same
|
|
LD (HL),B ; Restore old contents
|
|
JP NZ,MSIZE ; Ask again if no RAM
|
|
|
|
SETTOP: DEC HL ; Back one byte
|
|
LD DE,STLOOK-1 ; See if enough RAM
|
|
CALL CPDEHL ; Compare DE with HL
|
|
JP C,MSIZE ; Ask again if not enough RAM
|
|
LD DE,0-50 ; 50 Bytes string space
|
|
LD (LSTRAM),HL ; Save last available RAM
|
|
ADD HL,DE ; Allocate string space
|
|
LD (STRSPC),HL ; Save string space
|
|
CALL CLRPTR ; Clear program area
|
|
LD HL,(STRSPC) ; Get end of memory
|
|
LD DE,0-17 ; Offset for free bytes
|
|
ADD HL,DE ; Adjust HL
|
|
LD DE,PROGST ; Start of program text
|
|
LD A,L ; Get LSB
|
|
SUB E ; Adjust it
|
|
LD L,A ; Re-save
|
|
LD A,H ; Get MSB
|
|
SBC A,D ; Adjust it
|
|
LD H,A ; Re-save
|
|
PUSH HL ; Save bytes free
|
|
LD HL,SIGNON ; Sign-on message
|
|
CALL PRS ; Output string
|
|
POP HL ; Get bytes free back
|
|
CALL PRNTHL ; Output amount of free memory
|
|
LD HL,BFREE ; " Bytes free" message
|
|
CALL PRS ; Output string
|
|
|
|
WARMST: LD SP,STACK ; Temporary stack
|
|
BRKRET: CALL CLREG ; Clear registers and stack
|
|
JP PRNTOK ; Go to get command line
|
|
|
|
BFREE: .BYTE " Bytes free",CR,LF,0,0
|
|
|
|
SIGNON: .BYTE "Z80 BASIC Ver 4.7b",CR,LF
|
|
.BYTE "Copyright ",40,"C",41
|
|
.BYTE " 1978 by Microsoft",CR,LF,0,0
|
|
|
|
MEMMSG: .BYTE "Memory top",0
|
|
|
|
; FUNCTION ADDRESS TABLE
|
|
|
|
FNCTAB: .WORD SGN
|
|
.WORD INT
|
|
.WORD ABS
|
|
.WORD USR
|
|
.WORD FRE
|
|
.WORD INP
|
|
.WORD POS
|
|
.WORD SQR
|
|
.WORD RND
|
|
.WORD LOG
|
|
.WORD EXP
|
|
.WORD COS
|
|
.WORD SIN
|
|
.WORD TAN
|
|
.WORD ATN
|
|
.WORD PEEK
|
|
.WORD DEEK
|
|
.WORD POINT
|
|
.WORD LEN
|
|
.WORD STR
|
|
.WORD VAL
|
|
.WORD ASC
|
|
.WORD CHR
|
|
.WORD HEX
|
|
.WORD BIN
|
|
.WORD LEFT
|
|
.WORD RIGHT
|
|
.WORD MID
|
|
|
|
; RESERVED WORD LIST
|
|
|
|
WORDS: .BYTE 'E'+80H,"ND"
|
|
.BYTE 'F'+80H,"OR"
|
|
.BYTE 'N'+80H,"EXT"
|
|
.BYTE 'D'+80H,"ATA"
|
|
.BYTE 'I'+80H,"NPUT"
|
|
.BYTE 'D'+80H,"IM"
|
|
.BYTE 'R'+80H,"EAD"
|
|
.BYTE 'L'+80H,"ET"
|
|
.BYTE 'G'+80H,"OTO"
|
|
.BYTE 'R'+80H,"UN"
|
|
.BYTE 'I'+80H,"F"
|
|
.BYTE 'R'+80H,"ESTORE"
|
|
.BYTE 'G'+80H,"OSUB"
|
|
.BYTE 'R'+80H,"ETURN"
|
|
.BYTE 'R'+80H,"EM"
|
|
.BYTE 'S'+80H,"TOP"
|
|
.BYTE 'O'+80H,"UT"
|
|
.BYTE 'O'+80H,"N"
|
|
.BYTE 'N'+80H,"ULL"
|
|
.BYTE 'W'+80H,"AIT"
|
|
.BYTE 'D'+80H,"EF"
|
|
.BYTE 'P'+80H,"OKE"
|
|
.BYTE 'D'+80H,"OKE"
|
|
.BYTE 'S'+80H,"CREEN"
|
|
.BYTE 'L'+80H,"INES"
|
|
.BYTE 'C'+80H,"LS"
|
|
.BYTE 'W'+80H,"IDTH"
|
|
.BYTE 'M'+80H,"ONITOR"
|
|
.BYTE 'S'+80H,"ET"
|
|
.BYTE 'R'+80H,"ESET"
|
|
.BYTE 'P'+80H,"RINT"
|
|
.BYTE 'C'+80H,"ONT"
|
|
.BYTE 'L'+80H,"IST"
|
|
.BYTE 'C'+80H,"LEAR"
|
|
.BYTE 'C'+80H,"LOAD"
|
|
.BYTE 'C'+80H,"SAVE"
|
|
.BYTE 'N'+80H,"EW"
|
|
|
|
.BYTE 'T'+80H,"AB("
|
|
.BYTE 'T'+80H,"O"
|
|
.BYTE 'F'+80H,"N"
|
|
.BYTE 'S'+80H,"PC("
|
|
.BYTE 'T'+80H,"HEN"
|
|
.BYTE 'N'+80H,"OT"
|
|
.BYTE 'S'+80H,"TEP"
|
|
|
|
.BYTE '+'+80H
|
|
.BYTE '-'+80H
|
|
.BYTE '*'+80H
|
|
.BYTE '/'+80H
|
|
.BYTE '^'+80H
|
|
.BYTE 'A'+80H,"ND"
|
|
.BYTE 'O'+80H,"R"
|
|
.BYTE '>'+80H
|
|
.BYTE '='+80H
|
|
.BYTE '<'+80H
|
|
|
|
.BYTE 'S'+80H,"GN"
|
|
.BYTE 'I'+80H,"NT"
|
|
.BYTE 'A'+80H,"BS"
|
|
.BYTE 'U'+80H,"SR"
|
|
.BYTE 'F'+80H,"RE"
|
|
.BYTE 'I'+80H,"NP"
|
|
.BYTE 'P'+80H,"OS"
|
|
.BYTE 'S'+80H,"QR"
|
|
.BYTE 'R'+80H,"ND"
|
|
.BYTE 'L'+80H,"OG"
|
|
.BYTE 'E'+80H,"XP"
|
|
.BYTE 'C'+80H,"OS"
|
|
.BYTE 'S'+80H,"IN"
|
|
.BYTE 'T'+80H,"AN"
|
|
.BYTE 'A'+80H,"TN"
|
|
.BYTE 'P'+80H,"EEK"
|
|
.BYTE 'D'+80H,"EEK"
|
|
.BYTE 'P'+80H,"OINT"
|
|
.BYTE 'L'+80H,"EN"
|
|
.BYTE 'S'+80H,"TR$"
|
|
.BYTE 'V'+80H,"AL"
|
|
.BYTE 'A'+80H,"SC"
|
|
.BYTE 'C'+80H,"HR$"
|
|
.BYTE 'H'+80H,"EX$"
|
|
.BYTE 'B'+80H,"IN$"
|
|
.BYTE 'L'+80H,"EFT$"
|
|
.BYTE 'R'+80H,"IGHT$"
|
|
.BYTE 'M'+80H,"ID$"
|
|
.BYTE 80H ; End of list marker
|
|
|
|
; KEYWORD ADDRESS TABLE
|
|
|
|
WORDTB: .WORD PEND
|
|
.WORD FOR
|
|
.WORD NEXT
|
|
.WORD DATA
|
|
.WORD INPUT
|
|
.WORD DIM
|
|
.WORD READ
|
|
.WORD LET
|
|
.WORD GOTO
|
|
.WORD RUN
|
|
.WORD IF
|
|
.WORD RESTOR
|
|
.WORD GOSUB
|
|
.WORD RETURN
|
|
.WORD REM
|
|
.WORD STOP
|
|
.WORD POUT
|
|
.WORD ON
|
|
.WORD NULL
|
|
.WORD WAIT
|
|
.WORD DEF
|
|
.WORD POKE
|
|
.WORD DOKE
|
|
.WORD REM
|
|
.WORD LINES
|
|
.WORD CLS
|
|
.WORD WIDTH
|
|
.WORD MONITR
|
|
.WORD PSET
|
|
.WORD RESET
|
|
.WORD PRINT
|
|
.WORD CONT
|
|
.WORD LIST
|
|
.WORD CLEAR
|
|
.WORD REM
|
|
.WORD REM
|
|
.WORD NEW
|
|
|
|
; RESERVED WORD TOKEN VALUES
|
|
|
|
ZEND .EQU 080H ; END
|
|
ZFOR .EQU 081H ; FOR
|
|
ZDATA .EQU 083H ; DATA
|
|
ZGOTO .EQU 088H ; GOTO
|
|
ZGOSUB .EQU 08CH ; GOSUB
|
|
ZREM .EQU 08EH ; REM
|
|
ZPRINT .EQU 09EH ; PRINT
|
|
ZNEW .EQU 0A4H ; NEW
|
|
|
|
ZTAB .EQU 0A5H ; TAB
|
|
ZTO .EQU 0A6H ; TO
|
|
ZFN .EQU 0A7H ; FN
|
|
ZSPC .EQU 0A8H ; SPC
|
|
ZTHEN .EQU 0A9H ; THEN
|
|
ZNOT .EQU 0AAH ; NOT
|
|
ZSTEP .EQU 0ABH ; STEP
|
|
|
|
ZPLUS .EQU 0ACH ; +
|
|
ZMINUS .EQU 0ADH ; -
|
|
ZTIMES .EQU 0AEH ; *
|
|
ZDIV .EQU 0AFH ; /
|
|
ZOR .EQU 0B2H ; OR
|
|
ZGTR .EQU 0B3H ; >
|
|
ZEQUAL .EQU 0B4H ; M
|
|
ZLTH .EQU 0B5H ; <
|
|
ZSGN .EQU 0B6H ; SGN
|
|
ZPOINT .EQU 0C7H ; POINT
|
|
ZLEFT .EQU 0CDH +2 ; LEFT$
|
|
|
|
; ARITHMETIC PRECEDENCE TABLE
|
|
|
|
PRITAB: .BYTE 79H ; Precedence value
|
|
.WORD PADD ; FPREG = <last> + FPREG
|
|
|
|
.BYTE 79H ; Precedence value
|
|
.WORD PSUB ; FPREG = <last> - FPREG
|
|
|
|
.BYTE 7CH ; Precedence value
|
|
.WORD MULT ; PPREG = <last> * FPREG
|
|
|
|
.BYTE 7CH ; Precedence value
|
|
.WORD DIV ; FPREG = <last> / FPREG
|
|
|
|
.BYTE 7FH ; Precedence value
|
|
.WORD POWER ; FPREG = <last> ^ FPREG
|
|
|
|
.BYTE 50H ; Precedence value
|
|
.WORD PAND ; FPREG = <last> AND FPREG
|
|
|
|
.BYTE 46H ; Precedence value
|
|
.WORD POR ; FPREG = <last> OR FPREG
|
|
|
|
; BASIC ERROR CODE LIST
|
|
|
|
ERRORS: .BYTE "NF" ; NEXT without FOR
|
|
.BYTE "SN" ; Syntax error
|
|
.BYTE "RG" ; RETURN without GOSUB
|
|
.BYTE "OD" ; Out of DATA
|
|
.BYTE "FC" ; Illegal function call
|
|
.BYTE "OV" ; Overflow error
|
|
.BYTE "OM" ; Out of memory
|
|
.BYTE "UL" ; Undefined line
|
|
.BYTE "BS" ; Bad subscript
|
|
.BYTE "DD" ; Re-DIMensioned array
|
|
.BYTE "/0" ; Division by zero
|
|
.BYTE "ID" ; Illegal direct
|
|
.BYTE "TM" ; Type mis-match
|
|
.BYTE "OS" ; Out of string space
|
|
.BYTE "LS" ; String too long
|
|
.BYTE "ST" ; String formula too complex
|
|
.BYTE "CN" ; Can't CONTinue
|
|
.BYTE "UF" ; Undefined FN function
|
|
.BYTE "MO" ; Missing operand
|
|
.BYTE "HX" ; HEX error
|
|
.BYTE "BN" ; BIN error
|
|
|
|
; INITIALISATION TABLE -------------------------------------------------------
|
|
|
|
INITAB: JP WARMST ; Warm start jump
|
|
JP FCERR ; "USR (X)" jump (Set to Error)
|
|
OUT (0),A ; "OUT p,n" skeleton
|
|
RET
|
|
SUB 0 ; Division support routine
|
|
LD L,A
|
|
LD A,H
|
|
SBC A,0
|
|
LD H,A
|
|
LD A,B
|
|
SBC A,0
|
|
LD B,A
|
|
LD A,0
|
|
RET
|
|
.BYTE 0,0,0 ; Random number seed table used by RND
|
|
.BYTE 035H,04AH,0CAH,099H ;-2.65145E+07
|
|
.BYTE 039H,01CH,076H,098H ; 1.61291E+07
|
|
.BYTE 022H,095H,0B3H,098H ;-1.17691E+07
|
|
.BYTE 00AH,0DDH,047H,098H ; 1.30983E+07
|
|
.BYTE 053H,0D1H,099H,099H ;-2-01612E+07
|
|
.BYTE 00AH,01AH,09FH,098H ;-1.04269E+07
|
|
.BYTE 065H,0BCH,0CDH,098H ;-1.34831E+07
|
|
.BYTE 0D6H,077H,03EH,098H ; 1.24825E+07
|
|
.BYTE 052H,0C7H,04FH,080H ; Last random number
|
|
IN A,(0) ; INP (x) skeleton
|
|
RET
|
|
.BYTE 1 ; POS (x) number (1)
|
|
.BYTE 255 ; Terminal width (255 = no auto CRLF)
|
|
.BYTE 28 ; Width for commas (3 columns)
|
|
.BYTE 0 ; No nulls after input bytes
|
|
.BYTE 0 ; Output enabled (^O off)
|
|
.WORD 20 ; Initial lines counter
|
|
.WORD 20 ; Initial lines number
|
|
.WORD 0 ; Array load/save check sum
|
|
.BYTE 0 ; Break not by NMI
|
|
.BYTE 0 ; Break flag
|
|
JP TTYLIN ; Input reflection (set to TTY)
|
|
JP $0000 ; POINT reflection unused
|
|
JP $0000 ; SET reflection
|
|
JP $0000 ; RESET reflection
|
|
.WORD STLOOK ; Temp string space
|
|
.WORD -2 ; Current line number (cold)
|
|
.WORD PROGST+1 ; Start of program text
|
|
INITBE:
|
|
|
|
; END OF INITIALISATION TABLE ---------------------------------------------------
|
|
|
|
ERRMSG: .BYTE " Error",0
|
|
INMSG: .BYTE " in ",0
|
|
ZERBYT .EQU $-1 ; A zero byte
|
|
OKMSG: .BYTE "Ok",CR,LF,0,0
|
|
BRKMSG: .BYTE "Break",0
|
|
|
|
BAKSTK: LD HL,4 ; Look for "FOR" block with
|
|
ADD HL,SP ; same index as specified
|
|
LOKFOR: LD A,(HL) ; Get block ID
|
|
INC HL ; Point to index address
|
|
CP ZFOR ; Is it a "FOR" token
|
|
RET NZ ; No - exit
|
|
LD C,(HL) ; BC = Address of "FOR" index
|
|
INC HL
|
|
LD B,(HL)
|
|
INC HL ; Point to sign of STEP
|
|
PUSH HL ; Save pointer to sign
|
|
LD L,C ; HL = address of "FOR" index
|
|
LD H,B
|
|
LD A,D ; See if an index was specified
|
|
OR E ; DE = 0 if no index specified
|
|
EX DE,HL ; Specified index into HL
|
|
JP Z,INDFND ; Skip if no index given
|
|
EX DE,HL ; Index back into DE
|
|
CALL CPDEHL ; Compare index with one given
|
|
INDFND: LD BC,16-3 ; Offset to next block
|
|
POP HL ; Restore pointer to sign
|
|
RET Z ; Return if block found
|
|
ADD HL,BC ; Point to next block
|
|
JP LOKFOR ; Keep on looking
|
|
|
|
MOVUP: CALL ENFMEM ; See if enough memory
|
|
MOVSTR: PUSH BC ; Save end of source
|
|
EX (SP),HL ; Swap source and dest" end
|
|
POP BC ; Get end of destination
|
|
MOVLP: CALL CPDEHL ; See if list moved
|
|
LD A,(HL) ; Get byte
|
|
LD (BC),A ; Move it
|
|
RET Z ; Exit if all done
|
|
DEC BC ; Next byte to move to
|
|
DEC HL ; Next byte to move
|
|
JP MOVLP ; Loop until all bytes moved
|
|
|
|
CHKSTK: PUSH HL ; Save code string address
|
|
LD HL,(ARREND) ; Lowest free memory
|
|
LD B,0 ; BC = Number of levels to test
|
|
ADD HL,BC ; 2 Bytes for each level
|
|
ADD HL,BC
|
|
.BYTE 3EH ; Skip "PUSH HL"
|
|
ENFMEM: PUSH HL ; Save code string address
|
|
LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM
|
|
SUB L
|
|
LD L,A
|
|
LD A,0FFH; HIGH (-48) ; 48 Bytes minimum RAM
|
|
SBC A,H
|
|
JP C,OMERR ; Not enough - ?OM Error
|
|
LD H,A
|
|
ADD HL,SP ; Test if stack is overflowed
|
|
POP HL ; Restore code string address
|
|
RET C ; Return if enough mmory
|
|
OMERR: LD E,OM ; ?OM Error
|
|
JP ERROR
|
|
|
|
DATSNR: LD HL,(DATLIN) ; Get line of current DATA item
|
|
LD (LINEAT),HL ; Save as current line
|
|
SNERR: LD E,SN ; ?SN Error
|
|
.BYTE 01H ; Skip "LD E,DZ"
|
|
DZERR: LD E,DZ ; ?/0 Error
|
|
.BYTE 01H ; Skip "LD E,NF"
|
|
NFERR: LD E,NF ; ?NF Error
|
|
.BYTE 01H ; Skip "LD E,DD"
|
|
DDERR: LD E,DD ; ?DD Error
|
|
.BYTE 01H ; Skip "LD E,UF"
|
|
UFERR: LD E,UF ; ?UF Error
|
|
.BYTE 01H ; Skip "LD E,OV
|
|
OVERR: LD E,OV ; ?OV Error
|
|
.BYTE 01H ; Skip "LD E,TM"
|
|
TMERR: LD E,TM ; ?TM Error
|
|
|
|
ERROR: CALL CLREG ; Clear registers and stack
|
|
LD (CTLOFG),A ; Enable output (A is 0)
|
|
CALL STTLIN ; Start new line
|
|
LD HL,ERRORS ; Point to error codes
|
|
LD D,A ; D = 0 (A is 0)
|
|
LD A,'?'
|
|
CALL OUTC ; Output '?'
|
|
ADD HL,DE ; Offset to correct error code
|
|
LD A,(HL) ; First character
|
|
CALL OUTC ; Output it
|
|
CALL GETCHR ; Get next character
|
|
CALL OUTC ; Output it
|
|
LD HL,ERRMSG ; "Error" message
|
|
ERRIN: CALL PRS ; Output message
|
|
LD HL,(LINEAT) ; Get line of error
|
|
LD DE,-2 ; Cold start error if -2
|
|
CALL CPDEHL ; See if cold start error
|
|
JP Z,CSTART ; Cold start error - Restart
|
|
LD A,H ; Was it a direct error?
|
|
AND L ; Line = -1 if direct error
|
|
INC A
|
|
CALL NZ,LINEIN ; No - output line of error
|
|
.BYTE 3EH ; Skip "POP BC"
|
|
POPNOK: POP BC ; Drop address in input buffer
|
|
|
|
PRNTOK: XOR A ; Output "Ok" and get command
|
|
LD (CTLOFG),A ; Enable output
|
|
CALL STTLIN ; Start new line
|
|
LD HL,OKMSG ; "Ok" message
|
|
CALL PRS ; Output "Ok"
|
|
GETCMD: LD HL,-1 ; Flag direct mode
|
|
LD (LINEAT),HL ; Save as current line
|
|
CALL GETLIN ; Get an input line
|
|
JP C,GETCMD ; Get line again if break
|
|
CALL GETCHR ; Get first character
|
|
INC A ; Test if end of line
|
|
DEC A ; Without affecting Carry
|
|
JP Z,GETCMD ; Nothing entered - Get another
|
|
PUSH AF ; Save Carry status
|
|
CALL ATOH ; Get line number into DE
|
|
PUSH DE ; Save line number
|
|
CALL CRUNCH ; Tokenise rest of line
|
|
LD B,A ; Length of tokenised line
|
|
POP DE ; Restore line number
|
|
POP AF ; Restore Carry
|
|
JP NC,EXCUTE ; No line number - Direct mode
|
|
PUSH DE ; Save line number
|
|
PUSH BC ; Save length of tokenised line
|
|
XOR A
|
|
LD (LSTBIN),A ; Clear last byte input
|
|
CALL GETCHR ; Get next character
|
|
OR A ; Set flags
|
|
PUSH AF ; And save them
|
|
CALL SRCHLN ; Search for line number in DE
|
|
JP C,LINFND ; Jump if line found
|
|
POP AF ; Get status
|
|
PUSH AF ; And re-save
|
|
JP Z,ULERR ; Nothing after number - Error
|
|
OR A ; Clear Carry
|
|
LINFND: PUSH BC ; Save address of line in prog
|
|
JP NC,INEWLN ; Line not found - Insert new
|
|
EX DE,HL ; Next line address in DE
|
|
LD HL,(PROGND) ; End of program
|
|
SFTPRG: LD A,(DE) ; Shift rest of program down
|
|
LD (BC),A
|
|
INC BC ; Next destination
|
|
INC DE ; Next source
|
|
CALL CPDEHL ; All done?
|
|
JP NZ,SFTPRG ; More to do
|
|
LD H,B ; HL - New end of program
|
|
LD L,C
|
|
LD (PROGND),HL ; Update end of program
|
|
|
|
INEWLN: POP DE ; Get address of line,
|
|
POP AF ; Get status
|
|
JP Z,SETPTR ; No text - Set up pointers
|
|
LD HL,(PROGND) ; Get end of program
|
|
EX (SP),HL ; Get length of input line
|
|
POP BC ; End of program to BC
|
|
ADD HL,BC ; Find new end
|
|
PUSH HL ; Save new end
|
|
CALL MOVUP ; Make space for line
|
|
POP HL ; Restore new end
|
|
LD (PROGND),HL ; Update end of program pointer
|
|
EX DE,HL ; Get line to move up in HL
|
|
LD (HL),H ; Save MSB
|
|
POP DE ; Get new line number
|
|
INC HL ; Skip pointer
|
|
INC HL
|
|
LD (HL),E ; Save LSB of line number
|
|
INC HL
|
|
LD (HL),D ; Save MSB of line number
|
|
INC HL ; To first byte in line
|
|
LD DE,BUFFER ; Copy buffer to program
|
|
MOVBUF: LD A,(DE) ; Get source
|
|
LD (HL),A ; Save destinations
|
|
INC HL ; Next source
|
|
INC DE ; Next destination
|
|
OR A ; Done?
|
|
JP NZ,MOVBUF ; No - Repeat
|
|
SETPTR: CALL RUNFST ; Set line pointers
|
|
INC HL ; To LSB of pointer
|
|
EX DE,HL ; Address to DE
|
|
PTRLP: LD H,D ; Address to HL
|
|
LD L,E
|
|
LD A,(HL) ; Get LSB of pointer
|
|
INC HL ; To MSB of pointer
|
|
OR (HL) ; Compare with MSB pointer
|
|
JP Z,GETCMD ; Get command line if end
|
|
INC HL ; To LSB of line number
|
|
INC HL ; Skip line number
|
|
INC HL ; Point to first byte in line
|
|
XOR A ; Looking for 00 byte
|
|
FNDEND: CP (HL) ; Found end of line?
|
|
INC HL ; Move to next byte
|
|
JP NZ,FNDEND ; No - Keep looking
|
|
EX DE,HL ; Next line address to HL
|
|
LD (HL),E ; Save LSB of pointer
|
|
INC HL
|
|
LD (HL),D ; Save MSB of pointer
|
|
JP PTRLP ; Do next line
|
|
|
|
SRCHLN: LD HL,(BASTXT) ; Start of program text
|
|
SRCHLP: LD B,H ; BC = Address to look at
|
|
LD C,L
|
|
LD A,(HL) ; Get address of next line
|
|
INC HL
|
|
OR (HL) ; End of program found?
|
|
DEC HL
|
|
RET Z ; Yes - Line not found
|
|
INC HL
|
|
INC HL
|
|
LD A,(HL) ; Get LSB of line number
|
|
INC HL
|
|
LD H,(HL) ; Get MSB of line number
|
|
LD L,A
|
|
CALL CPDEHL ; Compare with line in DE
|
|
LD H,B ; HL = Start of this line
|
|
LD L,C
|
|
LD A,(HL) ; Get LSB of next line address
|
|
INC HL
|
|
LD H,(HL) ; Get MSB of next line address
|
|
LD L,A ; Next line to HL
|
|
CCF
|
|
RET Z ; Lines found - Exit
|
|
CCF
|
|
RET NC ; Line not found,at line after
|
|
JP SRCHLP ; Keep looking
|
|
|
|
NEW: RET NZ ; Return if any more on line
|
|
CLRPTR: LD HL,(BASTXT) ; Point to start of program
|
|
XOR A ; Set program area to empty
|
|
LD (HL),A ; Save LSB = 00
|
|
INC HL
|
|
LD (HL),A ; Save MSB = 00
|
|
INC HL
|
|
LD (PROGND),HL ; Set program end
|
|
|
|
RUNFST: LD HL,(BASTXT) ; Clear all variables
|
|
DEC HL
|
|
|
|
INTVAR: LD (BRKLIN),HL ; Initialise RUN variables
|
|
LD HL,(LSTRAM) ; Get end of RAM
|
|
LD (STRBOT),HL ; Clear string space
|
|
XOR A
|
|
CALL RESTOR ; Reset DATA pointers
|
|
LD HL,(PROGND) ; Get end of program
|
|
LD (VAREND),HL ; Clear variables
|
|
LD (ARREND),HL ; Clear arrays
|
|
|
|
CLREG: POP BC ; Save return address
|
|
LD HL,(STRSPC) ; Get end of working RAN
|
|
LD SP,HL ; Set stack
|
|
LD HL,TMSTPL ; Temporary string pool
|
|
LD (TMSTPT),HL ; Reset temporary string ptr
|
|
XOR A ; A = 00
|
|
LD L,A ; HL = 0000
|
|
LD H,A
|
|
LD (CONTAD),HL ; No CONTinue
|
|
LD (FORFLG),A ; Clear FOR flag
|
|
LD (FNRGNM),HL ; Clear FN argument
|
|
PUSH HL ; HL = 0000
|
|
PUSH BC ; Put back return
|
|
DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN
|
|
RET ; Return to execution driver
|
|
|
|
PROMPT: LD A,'?' ; '?'
|
|
CALL OUTC ; Output character
|
|
LD A,' ' ; Space
|
|
CALL OUTC ; Output character
|
|
JP RINPUT ; Get input line
|
|
|
|
CRUNCH: XOR A ; Tokenise line @ HL to BUFFER
|
|
LD (DATFLG),A ; Reset literal flag
|
|
LD C,2+3 ; 2 byte number and 3 nulls
|
|
LD DE,BUFFER ; Start of input buffer
|
|
CRNCLP: LD A,(HL) ; Get byte
|
|
CP ' ' ; Is it a space?
|
|
JP Z,MOVDIR ; Yes - Copy direct
|
|
LD B,A ; Save character
|
|
CP '"' ; Is it a quote?
|
|
JP Z,CPYLIT ; Yes - Copy literal string
|
|
OR A ; Is it end of buffer?
|
|
JP Z,ENDBUF ; Yes - End buffer
|
|
LD A,(DATFLG) ; Get data type
|
|
OR A ; Literal?
|
|
LD A,(HL) ; Get byte to copy
|
|
JP NZ,MOVDIR ; Literal - Copy direct
|
|
CP '?' ; Is it '?' short for PRINT
|
|
LD A,ZPRINT ; "PRINT" token
|
|
JP Z,MOVDIR ; Yes - replace it
|
|
LD A,(HL) ; Get byte again
|
|
CP '0' ; Is it less than '0'
|
|
JP C,FNDWRD ; Yes - Look for reserved words
|
|
CP 60; ";"+1 ; Is it "0123456789:;" ?
|
|
JP C,MOVDIR ; Yes - copy it direct
|
|
FNDWRD: PUSH DE ; Look for reserved words
|
|
LD DE,WORDS-1 ; Point to table
|
|
PUSH BC ; Save count
|
|
LD BC,RETNAD ; Where to return to
|
|
PUSH BC ; Save return address
|
|
LD B,ZEND-1 ; First token value -1
|
|
LD A,(HL) ; Get byte
|
|
CP 'a' ; Less than 'a' ?
|
|
JP C,SEARCH ; Yes - search for words
|
|
CP 'z'+1 ; Greater than 'z' ?
|
|
JP NC,SEARCH ; Yes - search for words
|
|
AND 01011111B ; Force upper case
|
|
LD (HL),A ; Replace byte
|
|
SEARCH: LD C,(HL) ; Search for a word
|
|
EX DE,HL
|
|
GETNXT: INC HL ; Get next reserved word
|
|
OR (HL) ; Start of word?
|
|
JP P,GETNXT ; No - move on
|
|
INC B ; Increment token value
|
|
LD A, (HL) ; Get byte from table
|
|
AND 01111111B ; Strip bit 7
|
|
RET Z ; Return if end of list
|
|
CP C ; Same character as in buffer?
|
|
JP NZ,GETNXT ; No - get next word
|
|
EX DE,HL
|
|
PUSH HL ; Save start of word
|
|
|
|
NXTBYT: INC DE ; Look through rest of word
|
|
LD A,(DE) ; Get byte from table
|
|
OR A ; End of word ?
|
|
JP M,MATCH ; Yes - Match found
|
|
LD C,A ; Save it
|
|
LD A,B ; Get token value
|
|
CP ZGOTO ; Is it "GOTO" token ?
|
|
JP NZ,NOSPC ; No - Don't allow spaces
|
|
CALL GETCHR ; Get next character
|
|
DEC HL ; Cancel increment from GETCHR
|
|
NOSPC: INC HL ; Next byte
|
|
LD A,(HL) ; Get byte
|
|
CP 'a' ; Less than 'a' ?
|
|
JP C,NOCHNG ; Yes - don't change
|
|
AND 01011111B ; Make upper case
|
|
NOCHNG: CP C ; Same as in buffer ?
|
|
JP Z,NXTBYT ; Yes - keep testing
|
|
POP HL ; Get back start of word
|
|
JP SEARCH ; Look at next word
|
|
|
|
MATCH: LD C,B ; Word found - Save token value
|
|
POP AF ; Throw away return
|
|
EX DE,HL
|
|
RET ; Return to "RETNAD"
|
|
RETNAD: EX DE,HL ; Get address in string
|
|
LD A,C ; Get token value
|
|
POP BC ; Restore buffer length
|
|
POP DE ; Get destination address
|
|
MOVDIR: INC HL ; Next source in buffer
|
|
LD (DE),A ; Put byte in buffer
|
|
INC DE ; Move up buffer
|
|
INC C ; Increment length of buffer
|
|
SUB ':' ; End of statement?
|
|
JP Z,SETLIT ; Jump if multi-statement line
|
|
CP ZDATA-3AH ; Is it DATA statement ?
|
|
JP NZ,TSTREM ; No - see if REM
|
|
SETLIT: LD (DATFLG),A ; Set literal flag
|
|
TSTREM: SUB ZREM-3AH ; Is it REM?
|
|
JP NZ,CRNCLP ; No - Leave flag
|
|
LD B,A ; Copy rest of buffer
|
|
NXTCHR: LD A,(HL) ; Get byte
|
|
OR A ; End of line ?
|
|
JP Z,ENDBUF ; Yes - Terminate buffer
|
|
CP B ; End of statement ?
|
|
JP Z,MOVDIR ; Yes - Get next one
|
|
CPYLIT: INC HL ; Move up source string
|
|
LD (DE),A ; Save in destination
|
|
INC C ; Increment length
|
|
INC DE ; Move up destination
|
|
JP NXTCHR ; Repeat
|
|
|
|
ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer
|
|
LD (DE),A ; Mark end of buffer (A = 00)
|
|
INC DE
|
|
LD (DE),A ; A = 00
|
|
INC DE
|
|
LD (DE),A ; A = 00
|
|
RET
|
|
|
|
DODEL: LD A,(NULFLG) ; Get null flag status
|
|
OR A ; Is it zero?
|
|
LD A,0 ; Zero A - Leave flags
|
|
LD (NULFLG),A ; Zero null flag
|
|
JP NZ,ECHDEL ; Set - Echo it
|
|
DEC B ; Decrement length
|
|
JP Z,GETLIN ; Get line again if empty
|
|
CALL OUTC ; Output null character
|
|
.BYTE 3EH ; Skip "DEC B"
|
|
ECHDEL: DEC B ; Count bytes in buffer
|
|
DEC HL ; Back space buffer
|
|
JP Z,OTKLN ; No buffer - Try again
|
|
LD A,(HL) ; Get deleted byte
|
|
CALL OUTC ; Echo it
|
|
JP MORINP ; Get more input
|
|
|
|
DELCHR: DEC B ; Count bytes in buffer
|
|
DEC HL ; Back space buffer
|
|
CALL OUTC ; Output character in A
|
|
JP NZ,MORINP ; Not end - Get more
|
|
OTKLN: CALL OUTC ; Output character in A
|
|
KILIN: CALL PRNTCRLF ; Output CRLF
|
|
JP TTYLIN ; Get line again
|
|
|
|
GETLIN:
|
|
TTYLIN: LD HL,BUFFER ; Get a line by character
|
|
LD B,1 ; Set buffer as empty
|
|
XOR A
|
|
LD (NULFLG),A ; Clear null flag
|
|
MORINP: CALL CLOTST ; Get character and test ^O
|
|
LD C,A ; Save character in C
|
|
CP DEL ; Delete character?
|
|
JP Z,DODEL ; Yes - Process it
|
|
LD A,(NULFLG) ; Get null flag
|
|
OR A ; Test null flag status
|
|
JP Z,PROCES ; Reset - Process character
|
|
LD A,0 ; Set a null
|
|
CALL OUTC ; Output null
|
|
XOR A ; Clear A
|
|
LD (NULFLG),A ; Reset null flag
|
|
PROCES: LD A,C ; Get character
|
|
CP CTRLG ; Bell?
|
|
JP Z,PUTCTL ; Yes - Save it
|
|
CP CTRLC ; Is it control "C"?
|
|
CALL Z,PRNTCRLF ; Yes - Output CRLF
|
|
SCF ; Flag break
|
|
RET Z ; Return if control "C"
|
|
CP CR ; Is it enter?
|
|
JP Z,ENDINP ; Yes - Terminate input
|
|
CP CTRLU ; Is it control "U"?
|
|
JP Z,KILIN ; Yes - Get another line
|
|
CP '@' ; Is it "kill line"?
|
|
JP Z,OTKLN ; Yes - Kill line
|
|
CP '_' ; Is it delete?
|
|
JP Z,DELCHR ; Yes - Delete character
|
|
CP BKSP ; Is it backspace?
|
|
JP Z,DELCHR ; Yes - Delete character
|
|
CP CTRLR ; Is it control "R"?
|
|
JP NZ,PUTBUF ; No - Put in buffer
|
|
PUSH BC ; Save buffer length
|
|
PUSH DE ; Save DE
|
|
PUSH HL ; Save buffer address
|
|
LD (HL),0 ; Mark end of buffer
|
|
CALL OUTNCR ; Output and do CRLF
|
|
LD HL,BUFFER ; Point to buffer start
|
|
CALL PRS ; Output buffer
|
|
POP HL ; Restore buffer address
|
|
POP DE ; Restore DE
|
|
POP BC ; Restore buffer length
|
|
JP MORINP ; Get another character
|
|
|
|
PUTBUF: CP ' ' ; Is it a control code?
|
|
JP C,MORINP ; Yes - Ignore
|
|
PUTCTL: LD A,B ; Get number of bytes in buffer
|
|
CP 72+1 ; Test for line overflow
|
|
LD A,CTRLG ; Set a bell
|
|
JP NC,OUTNBS ; Ring bell if buffer full
|
|
LD A,C ; Get character
|
|
LD (HL),C ; Save in buffer
|
|
LD (LSTBIN),A ; Save last input byte
|
|
INC HL ; Move up buffer
|
|
INC B ; Increment length
|
|
OUTIT: CALL OUTC ; Output the character entered
|
|
JP MORINP ; Get another character
|
|
|
|
OUTNBS: CALL OUTC ; Output bell and back over it
|
|
LD A,BKSP ; Set back space
|
|
JP OUTIT ; Output it and get more
|
|
|
|
CPDEHL: LD A,H ; Get H
|
|
SUB D ; Compare with D
|
|
RET NZ ; Different - Exit
|
|
LD A,L ; Get L
|
|
SUB E ; Compare with E
|
|
RET ; Return status
|
|
|
|
CHKSYN: LD A,(HL) ; Check syntax of character
|
|
EX (SP),HL ; Address of test byte
|
|
CP (HL) ; Same as in code string?
|
|
INC HL ; Return address
|
|
EX (SP),HL ; Put it back
|
|
JP Z,GETCHR ; Yes - Get next character
|
|
JP SNERR ; Different - ?SN Error
|
|
|
|
OUTC: PUSH AF ; Save character
|
|
LD A,(CTLOFG) ; Get control "O" flag
|
|
OR A ; Is it set?
|
|
JP NZ,POPAF ; Yes - don't output
|
|
POP AF ; Restore character
|
|
PUSH BC ; Save buffer length
|
|
PUSH AF ; Save character
|
|
CP ' ' ; Is it a control code?
|
|
JP C,DINPOS ; Yes - Don't INC POS(X)
|
|
LD A,(LWIDTH) ; Get line width
|
|
LD B,A ; To B
|
|
LD A,(CURPOS) ; Get cursor position
|
|
INC B ; Width 255?
|
|
JP Z,INCLEN ; Yes - No width limit
|
|
DEC B ; Restore width
|
|
CP B ; At end of line?
|
|
CALL Z,PRNTCRLF ; Yes - output CRLF
|
|
INCLEN: INC A ; Move on one character
|
|
LD (CURPOS),A ; Save new position
|
|
DINPOS: POP AF ; Restore character
|
|
POP BC ; Restore buffer length
|
|
CALL MONOUT ; Send it
|
|
RET
|
|
|
|
CLOTST: CALL GETINP ; Get input character
|
|
AND 01111111B ; Strip bit 7
|
|
CP CTRLO ; Is it control "O"?
|
|
RET NZ ; No don't flip flag
|
|
LD A,(CTLOFG) ; Get flag
|
|
CPL ; Flip it
|
|
LD (CTLOFG),A ; Put it back
|
|
XOR A ; Null character
|
|
RET
|
|
|
|
LIST: CALL ATOH ; ASCII number to DE
|
|
RET NZ ; Return if anything extra
|
|
POP BC ; Rubbish - Not needed
|
|
CALL SRCHLN ; Search for line number in DE
|
|
PUSH BC ; Save address of line
|
|
CALL SETLIN ; Set up lines counter
|
|
LISTLP: POP HL ; Restore address of line
|
|
LD C,(HL) ; Get LSB of next line
|
|
INC HL
|
|
LD B,(HL) ; Get MSB of next line
|
|
INC HL
|
|
LD A,B ; BC = 0 (End of program)?
|
|
OR C
|
|
JP Z,PRNTOK ; Yes - Go to command mode
|
|
CALL COUNT ; Count lines
|
|
CALL TSTBRK ; Test for break key
|
|
PUSH BC ; Save address of next line
|
|
CALL PRNTCRLF ; Output CRLF
|
|
LD E,(HL) ; Get LSB of line number
|
|
INC HL
|
|
LD D,(HL) ; Get MSB of line number
|
|
INC HL
|
|
PUSH HL ; Save address of line start
|
|
EX DE,HL ; Line number to HL
|
|
CALL PRNTHL ; Output line number in decimal
|
|
LD A,' ' ; Space after line number
|
|
POP HL ; Restore start of line address
|
|
LSTLP2: CALL OUTC ; Output character in A
|
|
LSTLP3: LD A,(HL) ; Get next byte in line
|
|
OR A ; End of line?
|
|
INC HL ; To next byte in line
|
|
JP Z,LISTLP ; Yes - get next line
|
|
JP P,LSTLP2 ; No token - output it
|
|
SUB ZEND-1 ; Find and output word
|
|
LD C,A ; Token offset+1 to C
|
|
LD DE,WORDS ; Reserved word list
|
|
FNDTOK: LD A,(DE) ; Get character in list
|
|
INC DE ; Move on to next
|
|
OR A ; Is it start of word?
|
|
JP P,FNDTOK ; No - Keep looking for word
|
|
DEC C ; Count words
|
|
JP NZ,FNDTOK ; Not there - keep looking
|
|
OUTWRD: AND 01111111B ; Strip bit 7
|
|
CALL OUTC ; Output first character
|
|
LD A,(DE) ; Get next character
|
|
INC DE ; Move on to next
|
|
OR A ; Is it end of word?
|
|
JP P,OUTWRD ; No - output the rest
|
|
JP LSTLP3 ; Next byte in line
|
|
|
|
SETLIN: PUSH HL ; Set up LINES counter
|
|
LD HL,(LINESN) ; Get LINES number
|
|
LD (LINESC),HL ; Save in LINES counter
|
|
POP HL
|
|
RET
|
|
|
|
COUNT: PUSH HL ; Save code string address
|
|
PUSH DE
|
|
LD HL,(LINESC) ; Get LINES counter
|
|
LD DE,-1
|
|
ADC HL,DE ; Decrement
|
|
LD (LINESC),HL ; Put it back
|
|
POP DE
|
|
POP HL ; Restore code string address
|
|
RET P ; Return if more lines to go
|
|
PUSH HL ; Save code string address
|
|
LD HL,(LINESN) ; Get LINES number
|
|
LD (LINESC),HL ; Reset LINES counter
|
|
CALL GETINP ; Get input character
|
|
CP CTRLC ; Is it control "C"?
|
|
JP Z,RSLNBK ; Yes - Reset LINES and break
|
|
POP HL ; Restore code string address
|
|
JP COUNT ; Keep on counting
|
|
|
|
RSLNBK: LD HL,(LINESN) ; Get LINES number
|
|
LD (LINESC),HL ; Reset LINES counter
|
|
JP BRKRET ; Go and output "Break"
|
|
|
|
FOR: LD A,64H ; Flag "FOR" assignment
|
|
LD (FORFLG),A ; Save "FOR" flag
|
|
CALL LET ; Set up initial index
|
|
POP BC ; Drop RETurn address
|
|
PUSH HL ; Save code string address
|
|
CALL DATA ; Get next statement address
|
|
LD (LOOPST),HL ; Save it for start of loop
|
|
LD HL,2 ; Offset for "FOR" block
|
|
ADD HL,SP ; Point to it
|
|
FORSLP: CALL LOKFOR ; Look for existing "FOR" block
|
|
POP DE ; Get code string address
|
|
JP NZ,FORFND ; No nesting found
|
|
ADD HL,BC ; Move into "FOR" block
|
|
PUSH DE ; Save code string address
|
|
DEC HL
|
|
LD D,(HL) ; Get MSB of loop statement
|
|
DEC HL
|
|
LD E,(HL) ; Get LSB of loop statement
|
|
INC HL
|
|
INC HL
|
|
PUSH HL ; Save block address
|
|
LD HL,(LOOPST) ; Get address of loop statement
|
|
CALL CPDEHL ; Compare the FOR loops
|
|
POP HL ; Restore block address
|
|
JP NZ,FORSLP ; Different FORs - Find another
|
|
POP DE ; Restore code string address
|
|
LD SP,HL ; Remove all nested loops
|
|
|
|
FORFND: EX DE,HL ; Code string address to HL
|
|
LD C,8
|
|
CALL CHKSTK ; Check for 8 levels of stack
|
|
PUSH HL ; Save code string address
|
|
LD HL,(LOOPST) ; Get first statement of loop
|
|
EX (SP),HL ; Save and restore code string
|
|
PUSH HL ; Re-save code string address
|
|
LD HL,(LINEAT) ; Get current line number
|
|
EX (SP),HL ; Save and restore code string
|
|
CALL TSTNUM ; Make sure it's a number
|
|
CALL CHKSYN ; Make sure "TO" is next
|
|
.BYTE ZTO ; "TO" token
|
|
CALL GETNUM ; Get "TO" expression value
|
|
PUSH HL ; Save code string address
|
|
CALL BCDEFP ; Move "TO" value to BCDE
|
|
POP HL ; Restore code string address
|
|
PUSH BC ; Save "TO" value in block
|
|
PUSH DE
|
|
LD BC,8100H ; BCDE - 1 (default STEP)
|
|
LD D,C ; C=0
|
|
LD E,D ; D=0
|
|
LD A,(HL) ; Get next byte in code string
|
|
CP ZSTEP ; See if "STEP" is stated
|
|
LD A,1 ; Sign of step = 1
|
|
JP NZ,SAVSTP ; No STEP given - Default to 1
|
|
CALL GETCHR ; Jump over "STEP" token
|
|
CALL GETNUM ; Get step value
|
|
PUSH HL ; Save code string address
|
|
CALL BCDEFP ; Move STEP to BCDE
|
|
CALL TSTSGN ; Test sign of FPREG
|
|
POP HL ; Restore code string address
|
|
SAVSTP: PUSH BC ; Save the STEP value in block
|
|
PUSH DE
|
|
PUSH AF ; Save sign of STEP
|
|
INC SP ; Don't save flags
|
|
PUSH HL ; Save code string address
|
|
LD HL,(BRKLIN) ; Get address of index variable
|
|
EX (SP),HL ; Save and restore code string
|
|
PUTFID: LD B,ZFOR ; "FOR" block marker
|
|
PUSH BC ; Save it
|
|
INC SP ; Don't save C
|
|
|
|
RUNCNT: CALL TSTBRK ; Execution driver - Test break
|
|
LD (BRKLIN),HL ; Save code address for break
|
|
LD A,(HL) ; Get next byte in code string
|
|
CP ':' ; Multi statement line?
|
|
JP Z,EXCUTE ; Yes - Execute it
|
|
OR A ; End of line?
|
|
JP NZ,SNERR ; No - Syntax error
|
|
INC HL ; Point to address of next line
|
|
LD A,(HL) ; Get LSB of line pointer
|
|
INC HL
|
|
OR (HL) ; Is it zero (End of prog)?
|
|
JP Z,ENDPRG ; Yes - Terminate execution
|
|
INC HL ; Point to line number
|
|
LD E,(HL) ; Get LSB of line number
|
|
INC HL
|
|
LD D,(HL) ; Get MSB of line number
|
|
EX DE,HL ; Line number to HL
|
|
LD (LINEAT),HL ; Save as current line number
|
|
EX DE,HL ; Line number back to DE
|
|
EXCUTE: CALL GETCHR ; Get key word
|
|
LD DE,RUNCNT ; Where to RETurn to
|
|
PUSH DE ; Save for RETurn
|
|
IFJMP: RET Z ; Go to RUNCNT if end of STMT
|
|
ONJMP: SUB ZEND ; Is it a token?
|
|
JP C,LET ; No - try to assign it
|
|
CP ZNEW+1-ZEND ; END to NEW ?
|
|
JP NC,SNERR ; Not a key word - ?SN Error
|
|
RLCA ; Double it
|
|
LD C,A ; BC = Offset into table
|
|
LD B,0
|
|
EX DE,HL ; Save code string address
|
|
LD HL,WORDTB ; Keyword address table
|
|
ADD HL,BC ; Point to routine address
|
|
LD C,(HL) ; Get LSB of routine address
|
|
INC HL
|
|
LD B,(HL) ; Get MSB of routine address
|
|
PUSH BC ; Save routine address
|
|
EX DE,HL ; Restore code string address
|
|
|
|
GETCHR: INC HL ; Point to next character
|
|
LD A,(HL) ; Get next code string byte
|
|
CP ':' ; Z if ':'
|
|
RET NC ; NC if > "9"
|
|
CP ' '
|
|
JP Z,GETCHR ; Skip over spaces
|
|
CP '0'
|
|
CCF ; NC if < '0'
|
|
INC A ; Test for zero - Leave carry
|
|
DEC A ; Z if Null
|
|
RET
|
|
|
|
RESTOR: EX DE,HL ; Save code string address
|
|
LD HL,(BASTXT) ; Point to start of program
|
|
JP Z,RESTNL ; Just RESTORE - reset pointer
|
|
EX DE,HL ; Restore code string address
|
|
CALL ATOH ; Get line number to DE
|
|
PUSH HL ; Save code string address
|
|
CALL SRCHLN ; Search for line number in DE
|
|
LD H,B ; HL = Address of line
|
|
LD L,C
|
|
POP DE ; Restore code string address
|
|
JP NC,ULERR ; ?UL Error if not found
|
|
RESTNL: DEC HL ; Byte before DATA statement
|
|
UPDATA: LD (NXTDAT),HL ; Update DATA pointer
|
|
EX DE,HL ; Restore code string address
|
|
RET
|
|
|
|
|
|
TSTBRK: RST 18H ; Check input status
|
|
RET Z ; No key, go back
|
|
RST 10H ; Get the key into A
|
|
CP ESC ; Escape key?
|
|
JR Z,BRK ; Yes, break
|
|
CP CTRLC ; <Ctrl-C>
|
|
JR Z,BRK ; Yes, break
|
|
CP CTRLS ; Stop scrolling?
|
|
RET NZ ; Other key, ignore
|
|
|
|
|
|
STALL: RST 10H ; Wait for key
|
|
CP CTRLQ ; Resume scrolling?
|
|
RET Z ; Release the chokehold
|
|
CP CTRLC ; Second break?
|
|
JR Z,STOP ; Break during hold exits prog
|
|
JR STALL ; Loop until <Ctrl-Q> or <brk>
|
|
|
|
BRK LD A,$FF ; Set BRKFLG
|
|
LD (BRKFLG),A ; Store it
|
|
|
|
|
|
STOP: RET NZ ; Exit if anything else
|
|
.BYTE 0F6H ; Flag "STOP"
|
|
PEND: RET NZ ; Exit if anything else
|
|
LD (BRKLIN),HL ; Save point of break
|
|
.BYTE 21H ; Skip "OR 11111111B"
|
|
INPBRK: OR 11111111B ; Flag "Break" wanted
|
|
POP BC ; Return not needed and more
|
|
ENDPRG: LD HL,(LINEAT) ; Get current line number
|
|
PUSH AF ; Save STOP / END status
|
|
LD A,L ; Is it direct break?
|
|
AND H
|
|
INC A ; Line is -1 if direct break
|
|
JP Z,NOLIN ; Yes - No line number
|
|
LD (ERRLIN),HL ; Save line of break
|
|
LD HL,(BRKLIN) ; Get point of break
|
|
LD (CONTAD),HL ; Save point to CONTinue
|
|
NOLIN: XOR A
|
|
LD (CTLOFG),A ; Enable output
|
|
CALL STTLIN ; Start a new line
|
|
POP AF ; Restore STOP / END status
|
|
LD HL,BRKMSG ; "Break" message
|
|
JP NZ,ERRIN ; "in line" wanted?
|
|
JP PRNTOK ; Go to command mode
|
|
|
|
CONT: LD HL,(CONTAD) ; Get CONTinue address
|
|
LD A,H ; Is it zero?
|
|
OR L
|
|
LD E,CN ; ?CN Error
|
|
JP Z,ERROR ; Yes - output "?CN Error"
|
|
EX DE,HL ; Save code string address
|
|
LD HL,(ERRLIN) ; Get line of last break
|
|
LD (LINEAT),HL ; Set up current line number
|
|
EX DE,HL ; Restore code string address
|
|
RET ; CONTinue where left off
|
|
|
|
NULL: CALL GETINT ; Get integer 0-255
|
|
RET NZ ; Return if bad value
|
|
LD (NULLS),A ; Set nulls number
|
|
RET
|
|
|
|
|
|
ACCSUM: PUSH HL ; Save address in array
|
|
LD HL,(CHKSUM) ; Get check sum
|
|
LD B,0 ; BC - Value of byte
|
|
LD C,A
|
|
ADD HL,BC ; Add byte to check sum
|
|
LD (CHKSUM),HL ; Re-save check sum
|
|
POP HL ; Restore address in array
|
|
RET
|
|
|
|
CHKLTR: LD A,(HL) ; Get byte
|
|
CP 'A' ; < 'a' ?
|
|
RET C ; Carry set if not letter
|
|
CP 'Z'+1 ; > 'z' ?
|
|
CCF
|
|
RET ; Carry set if not letter
|
|
|
|
FPSINT: CALL GETCHR ; Get next character
|
|
POSINT: CALL GETNUM ; Get integer 0 to 32767
|
|
DEPINT: CALL TSTSGN ; Test sign of FPREG
|
|
JP M,FCERR ; Negative - ?FC Error
|
|
DEINT: LD A,(FPEXP) ; Get integer value to DE
|
|
CP 80H+16 ; Exponent in range (16 bits)?
|
|
JP C,FPINT ; Yes - convert it
|
|
LD BC,9080H ; BCDE = -32768
|
|
LD DE,0000
|
|
PUSH HL ; Save code string address
|
|
CALL CMPNUM ; Compare FPREG with BCDE
|
|
POP HL ; Restore code string address
|
|
LD D,C ; MSB to D
|
|
RET Z ; Return if in range
|
|
FCERR: LD E,FC ; ?FC Error
|
|
JP ERROR ; Output error-
|
|
|
|
ATOH: DEC HL ; ASCII number to DE binary
|
|
GETLN: LD DE,0 ; Get number to DE
|
|
GTLNLP: CALL GETCHR ; Get next character
|
|
RET NC ; Exit if not a digit
|
|
PUSH HL ; Save code string address
|
|
PUSH AF ; Save digit
|
|
LD HL,65529/10 ; Largest number 65529
|
|
CALL CPDEHL ; Number in range?
|
|
JP C,SNERR ; No - ?SN Error
|
|
LD H,D ; HL = Number
|
|
LD L,E
|
|
ADD HL,DE ; Times 2
|
|
ADD HL,HL ; Times 4
|
|
ADD HL,DE ; Times 5
|
|
ADD HL,HL ; Times 10
|
|
POP AF ; Restore digit
|
|
SUB '0' ; Make it 0 to 9
|
|
LD E,A ; DE = Value of digit
|
|
LD D,0
|
|
ADD HL,DE ; Add to number
|
|
EX DE,HL ; Number to DE
|
|
POP HL ; Restore code string address
|
|
JP GTLNLP ; Go to next character
|
|
|
|
CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters
|
|
CALL POSINT ; Get integer 0 to 32767 to DE
|
|
DEC HL ; Cancel increment
|
|
CALL GETCHR ; Get next character
|
|
PUSH HL ; Save code string address
|
|
LD HL,(LSTRAM) ; Get end of RAM
|
|
JP Z,STORED ; No value given - Use stored
|
|
POP HL ; Restore code string address
|
|
CALL CHKSYN ; Check for comma
|
|
.BYTE ','
|
|
PUSH DE ; Save number
|
|
CALL POSINT ; Get integer 0 to 32767
|
|
DEC HL ; Cancel increment
|
|
CALL GETCHR ; Get next character
|
|
JP NZ,SNERR ; ?SN Error if more on line
|
|
EX (SP),HL ; Save code string address
|
|
EX DE,HL ; Number to DE
|
|
STORED: LD A,L ; Get LSB of new RAM top
|
|
SUB E ; Subtract LSB of string space
|
|
LD E,A ; Save LSB
|
|
LD A,H ; Get MSB of new RAM top
|
|
SBC A,D ; Subtract MSB of string space
|
|
LD D,A ; Save MSB
|
|
JP C,OMERR ; ?OM Error if not enough mem
|
|
PUSH HL ; Save RAM top
|
|
LD HL,(PROGND) ; Get program end
|
|
LD BC,40 ; 40 Bytes minimum working RAM
|
|
ADD HL,BC ; Get lowest address
|
|
CALL CPDEHL ; Enough memory?
|
|
JP NC,OMERR ; No - ?OM Error
|
|
EX DE,HL ; RAM top to HL
|
|
LD (STRSPC),HL ; Set new string space
|
|
POP HL ; End of memory to use
|
|
LD (LSTRAM),HL ; Set new top of RAM
|
|
POP HL ; Restore code string address
|
|
JP INTVAR ; Initialise variables
|
|
|
|
RUN: JP Z,RUNFST ; RUN from start if just RUN
|
|
CALL INTVAR ; Initialise variables
|
|
LD BC,RUNCNT ; Execution driver loop
|
|
JP RUNLIN ; RUN from line number
|
|
|
|
GOSUB: LD C,3 ; 3 Levels of stack needed
|
|
CALL CHKSTK ; Check for 3 levels of stack
|
|
POP BC ; Get return address
|
|
PUSH HL ; Save code string for RETURN
|
|
PUSH HL ; And for GOSUB routine
|
|
LD HL,(LINEAT) ; Get current line
|
|
EX (SP),HL ; Into stack - Code string out
|
|
LD A,ZGOSUB ; "GOSUB" token
|
|
PUSH AF ; Save token
|
|
INC SP ; Don't save flags
|
|
|
|
RUNLIN: PUSH BC ; Save return address
|
|
GOTO: CALL ATOH ; ASCII number to DE binary
|
|
CALL REM ; Get end of line
|
|
PUSH HL ; Save end of line
|
|
LD HL,(LINEAT) ; Get current line
|
|
CALL CPDEHL ; Line after current?
|
|
POP HL ; Restore end of line
|
|
INC HL ; Start of next line
|
|
CALL C,SRCHLP ; Line is after current line
|
|
CALL NC,SRCHLN ; Line is before current line
|
|
LD H,B ; Set up code string address
|
|
LD L,C
|
|
DEC HL ; Incremented after
|
|
RET C ; Line found
|
|
ULERR: LD E,UL ; ?UL Error
|
|
JP ERROR ; Output error message
|
|
|
|
RETURN: RET NZ ; Return if not just RETURN
|
|
LD D,-1 ; Flag "GOSUB" search
|
|
CALL BAKSTK ; Look "GOSUB" block
|
|
LD SP,HL ; Kill all FORs in subroutine
|
|
CP ZGOSUB ; Test for "GOSUB" token
|
|
LD E,RG ; ?RG Error
|
|
JP NZ,ERROR ; Error if no "GOSUB" found
|
|
POP HL ; Get RETURN line number
|
|
LD (LINEAT),HL ; Save as current
|
|
INC HL ; Was it from direct statement?
|
|
LD A,H
|
|
OR L ; Return to line
|
|
JP NZ,RETLIN ; No - Return to line
|
|
LD A,(LSTBIN) ; Any INPUT in subroutine?
|
|
OR A ; If so buffer is corrupted
|
|
JP NZ,POPNOK ; Yes - Go to command mode
|
|
RETLIN: LD HL,RUNCNT ; Execution driver loop
|
|
EX (SP),HL ; Into stack - Code string out
|
|
.BYTE 3EH ; Skip "POP HL"
|
|
NXTDTA: POP HL ; Restore code string address
|
|
|
|
DATA: .BYTE 01H,3AH ; ':' End of statement
|
|
REM: LD C,0 ; 00 End of statement
|
|
LD B,0
|
|
NXTSTL: LD A,C ; Statement and byte
|
|
LD C,B
|
|
LD B,A ; Statement end byte
|
|
NXTSTT: LD A,(HL) ; Get byte
|
|
OR A ; End of line?
|
|
RET Z ; Yes - Exit
|
|
CP B ; End of statement?
|
|
RET Z ; Yes - Exit
|
|
INC HL ; Next byte
|
|
CP '"' ; Literal string?
|
|
JP Z,NXTSTL ; Yes - Look for another '"'
|
|
JP NXTSTT ; Keep looking
|
|
|
|
LET: CALL GETVAR ; Get variable name
|
|
CALL CHKSYN ; Make sure "=" follows
|
|
.BYTE ZEQUAL ; "=" token
|
|
PUSH DE ; Save address of variable
|
|
LD A,(TYPE) ; Get data type
|
|
PUSH AF ; Save type
|
|
CALL EVAL ; Evaluate expression
|
|
POP AF ; Restore type
|
|
EX (SP),HL ; Save code - Get var addr
|
|
LD (BRKLIN),HL ; Save address of variable
|
|
RRA ; Adjust type
|
|
CALL CHKTYP ; Check types are the same
|
|
JP Z,LETNUM ; Numeric - Move value
|
|
LETSTR: PUSH HL ; Save address of string var
|
|
LD HL,(FPREG) ; Pointer to string entry
|
|
PUSH HL ; Save it on stack
|
|
INC HL ; Skip over length
|
|
INC HL
|
|
LD E,(HL) ; LSB of string address
|
|
INC HL
|
|
LD D,(HL) ; MSB of string address
|
|
LD HL,(BASTXT) ; Point to start of program
|
|
CALL CPDEHL ; Is string before program?
|
|
JP NC,CRESTR ; Yes - Create string entry
|
|
LD HL,(STRSPC) ; Point to string space
|
|
CALL CPDEHL ; Is string literal in program?
|
|
POP DE ; Restore address of string
|
|
JP NC,MVSTPT ; Yes - Set up pointer
|
|
LD HL,TMPSTR ; Temporary string pool
|
|
CALL CPDEHL ; Is string in temporary pool?
|
|
JP NC,MVSTPT ; No - Set up pointer
|
|
.BYTE 3EH ; Skip "POP DE"
|
|
CRESTR: POP DE ; Restore address of string
|
|
CALL BAKTMP ; Back to last tmp-str entry
|
|
EX DE,HL ; Address of string entry
|
|
CALL SAVSTR ; Save string in string area
|
|
MVSTPT: CALL BAKTMP ; Back to last tmp-str entry
|
|
POP HL ; Get string pointer
|
|
CALL DETHL4 ; Move string pointer to var
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
LETNUM: PUSH HL ; Save address of variable
|
|
CALL FPTHL ; Move value to variable
|
|
POP DE ; Restore address of variable
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
ON: CALL GETINT ; Get integer 0-255
|
|
LD A,(HL) ; Get "GOTO" or "GOSUB" token
|
|
LD B,A ; Save in B
|
|
CP ZGOSUB ; "GOSUB" token?
|
|
JP Z,ONGO ; Yes - Find line number
|
|
CALL CHKSYN ; Make sure it's "GOTO"
|
|
.BYTE ZGOTO ; "GOTO" token
|
|
DEC HL ; Cancel increment
|
|
ONGO: LD C,E ; Integer of branch value
|
|
ONGOLP: DEC C ; Count branches
|
|
LD A,B ; Get "GOTO" or "GOSUB" token
|
|
JP Z,ONJMP ; Go to that line if right one
|
|
CALL GETLN ; Get line number to DE
|
|
CP ',' ; Another line number?
|
|
RET NZ ; No - Drop through
|
|
JP ONGOLP ; Yes - loop
|
|
|
|
IF: CALL EVAL ; Evaluate expression
|
|
LD A,(HL) ; Get token
|
|
CP ZGOTO ; "GOTO" token?
|
|
JP Z,IFGO ; Yes - Get line
|
|
CALL CHKSYN ; Make sure it's "THEN"
|
|
.BYTE ZTHEN ; "THEN" token
|
|
DEC HL ; Cancel increment
|
|
IFGO: CALL TSTNUM ; Make sure it's numeric
|
|
CALL TSTSGN ; Test state of expression
|
|
JP Z,REM ; False - Drop through
|
|
CALL GETCHR ; Get next character
|
|
JP C,GOTO ; Number - GOTO that line
|
|
JP IFJMP ; Otherwise do statement
|
|
|
|
MRPRNT: DEC HL ; DEC 'cos GETCHR INCs
|
|
CALL GETCHR ; Get next character
|
|
PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT
|
|
PRNTLP: RET Z ; End of list - Exit
|
|
CP ZTAB ; "TAB(" token?
|
|
JP Z,DOTAB ; Yes - Do TAB routine
|
|
CP ZSPC ; "SPC(" token?
|
|
JP Z,DOTAB ; Yes - Do SPC routine
|
|
PUSH HL ; Save code string address
|
|
CP ',' ; Comma?
|
|
JP Z,DOCOM ; Yes - Move to next zone
|
|
CP 59 ;";" ; Semi-colon?
|
|
JP Z,NEXITM ; Do semi-colon routine
|
|
POP BC ; Code string address to BC
|
|
CALL EVAL ; Evaluate expression
|
|
PUSH HL ; Save code string address
|
|
LD A,(TYPE) ; Get variable type
|
|
OR A ; Is it a string variable?
|
|
JP NZ,PRNTST ; Yes - Output string contents
|
|
CALL NUMASC ; Convert number to text
|
|
CALL CRTST ; Create temporary string
|
|
LD (HL),' ' ; Followed by a space
|
|
LD HL,(FPREG) ; Get length of output
|
|
INC (HL) ; Plus 1 for the space
|
|
LD HL,(FPREG) ; < Not needed >
|
|
LD A,(LWIDTH) ; Get width of line
|
|
LD B,A ; To B
|
|
INC B ; Width 255 (No limit)?
|
|
JP Z,PRNTNB ; Yes - Output number string
|
|
INC B ; Adjust it
|
|
LD A,(CURPOS) ; Get cursor position
|
|
ADD A,(HL) ; Add length of string
|
|
DEC A ; Adjust it
|
|
CP B ; Will output fit on this line?
|
|
CALL NC,PRNTCRLF ; No - CRLF first
|
|
PRNTNB: CALL PRS1 ; Output string at (HL)
|
|
XOR A ; Skip CALL by setting 'z' flag
|
|
PRNTST: CALL NZ,PRS1 ; Output string at (HL)
|
|
POP HL ; Restore code string address
|
|
JP MRPRNT ; See if more to PRINT
|
|
|
|
STTLIN: LD A,(CURPOS) ; Make sure on new line
|
|
OR A ; Already at start?
|
|
RET Z ; Yes - Do nothing
|
|
JP PRNTCRLF ; Start a new line
|
|
|
|
ENDINP: LD (HL),0 ; Mark end of buffer
|
|
LD HL,BUFFER-1 ; Point to buffer
|
|
PRNTCRLF: LD A,CR ; Load a CR
|
|
CALL OUTC ; Output character
|
|
LD A,LF ; Load a LF
|
|
CALL OUTC ; Output character
|
|
DONULL: XOR A ; Set to position 0
|
|
LD (CURPOS),A ; Store it
|
|
LD A,(NULLS) ; Get number of nulls
|
|
NULLP: DEC A ; Count them
|
|
RET Z ; Return if done
|
|
PUSH AF ; Save count
|
|
XOR A ; Load a null
|
|
CALL OUTC ; Output it
|
|
POP AF ; Restore count
|
|
JP NULLP ; Keep counting
|
|
|
|
DOCOM: LD A,(COMMAN) ; Get comma width
|
|
LD B,A ; Save in B
|
|
LD A,(CURPOS) ; Get current position
|
|
CP B ; Within the limit?
|
|
CALL NC,PRNTCRLF ; No - output CRLF
|
|
JP NC,NEXITM ; Get next item
|
|
ZONELP: SUB 14 ; Next zone of 14 characters
|
|
JP NC,ZONELP ; Repeat if more zones
|
|
CPL ; Number of spaces to output
|
|
JP ASPCS ; Output them
|
|
|
|
DOTAB: PUSH AF ; Save token
|
|
CALL FNDNUM ; Evaluate expression
|
|
CALL CHKSYN ; Make sure ")" follows
|
|
.BYTE ")"
|
|
DEC HL ; Back space on to ")"
|
|
POP AF ; Restore token
|
|
SUB ZSPC ; Was it "SPC(" ?
|
|
PUSH HL ; Save code string address
|
|
JP Z,DOSPC ; Yes - Do 'E' spaces
|
|
LD A,(CURPOS) ; Get current position
|
|
DOSPC: CPL ; Number of spaces to print to
|
|
ADD A,E ; Total number to print
|
|
JP NC,NEXITM ; TAB < Current POS(X)
|
|
ASPCS: INC A ; Output A spaces
|
|
LD B,A ; Save number to print
|
|
LD A,' ' ; Space
|
|
SPCLP: CALL OUTC ; Output character in A
|
|
DEC B ; Count them
|
|
JP NZ,SPCLP ; Repeat if more
|
|
NEXITM: POP HL ; Restore code string address
|
|
CALL GETCHR ; Get next character
|
|
JP PRNTLP ; More to print
|
|
|
|
REDO: .BYTE "?Redo from start",CR,LF,0
|
|
|
|
BADINP: LD A,(READFG) ; READ or INPUT?
|
|
OR A
|
|
JP NZ,DATSNR ; READ - ?SN Error
|
|
POP BC ; Throw away code string addr
|
|
LD HL,REDO ; "Redo from start" message
|
|
CALL PRS ; Output string
|
|
JP DOAGN ; Do last INPUT again
|
|
|
|
INPUT: CALL IDTEST ; Test for illegal direct
|
|
LD A,(HL) ; Get character after "INPUT"
|
|
CP '"' ; Is there a prompt string?
|
|
LD A,0 ; Clear A and leave flags
|
|
LD (CTLOFG),A ; Enable output
|
|
JP NZ,NOPMPT ; No prompt - get input
|
|
CALL QTSTR ; Get string terminated by '"'
|
|
CALL CHKSYN ; Check for ';' after prompt
|
|
.BYTE ';'
|
|
PUSH HL ; Save code string address
|
|
CALL PRS1 ; Output prompt string
|
|
.BYTE 3EH ; Skip "PUSH HL"
|
|
NOPMPT: PUSH HL ; Save code string address
|
|
CALL PROMPT ; Get input with "? " prompt
|
|
POP BC ; Restore code string address
|
|
JP C,INPBRK ; Break pressed - Exit
|
|
INC HL ; Next byte
|
|
LD A,(HL) ; Get it
|
|
OR A ; End of line?
|
|
DEC HL ; Back again
|
|
PUSH BC ; Re-save code string address
|
|
JP Z,NXTDTA ; Yes - Find next DATA stmt
|
|
LD (HL),',' ; Store comma as separator
|
|
JP NXTITM ; Get next item
|
|
|
|
READ: PUSH HL ; Save code string address
|
|
LD HL,(NXTDAT) ; Next DATA statement
|
|
.BYTE 0F6H ; Flag "READ"
|
|
NXTITM: XOR A ; Flag "INPUT"
|
|
LD (READFG),A ; Save "READ"/"INPUT" flag
|
|
EX (SP),HL ; Get code str' , Save pointer
|
|
JP GTVLUS ; Get values
|
|
|
|
NEDMOR: CALL CHKSYN ; Check for comma between items
|
|
.BYTE ','
|
|
GTVLUS: CALL GETVAR ; Get variable name
|
|
EX (SP),HL ; Save code str" , Get pointer
|
|
PUSH DE ; Save variable address
|
|
LD A,(HL) ; Get next "INPUT"/"DATA" byte
|
|
CP ',' ; Comma?
|
|
JP Z,ANTVLU ; Yes - Get another value
|
|
LD A,(READFG) ; Is it READ?
|
|
OR A
|
|
JP NZ,FDTLP ; Yes - Find next DATA stmt
|
|
LD A,'?' ; More INPUT needed
|
|
CALL OUTC ; Output character
|
|
CALL PROMPT ; Get INPUT with prompt
|
|
POP DE ; Variable address
|
|
POP BC ; Code string address
|
|
JP C,INPBRK ; Break pressed
|
|
INC HL ; Point to next DATA byte
|
|
LD A,(HL) ; Get byte
|
|
OR A ; Is it zero (No input) ?
|
|
DEC HL ; Back space INPUT pointer
|
|
PUSH BC ; Save code string address
|
|
JP Z,NXTDTA ; Find end of buffer
|
|
PUSH DE ; Save variable address
|
|
ANTVLU: LD A,(TYPE) ; Check data type
|
|
OR A ; Is it numeric?
|
|
JP Z,INPBIN ; Yes - Convert to binary
|
|
CALL GETCHR ; Get next character
|
|
LD D,A ; Save input character
|
|
LD B,A ; Again
|
|
CP '"' ; Start of literal sting?
|
|
JP Z,STRENT ; Yes - Create string entry
|
|
LD A,(READFG) ; "READ" or "INPUT" ?
|
|
OR A
|
|
LD D,A ; Save 00 if "INPUT"
|
|
JP Z,ITMSEP ; "INPUT" - End with 00
|
|
LD D,':' ; "DATA" - End with 00 or ':'
|
|
ITMSEP: LD B,',' ; Item separator
|
|
DEC HL ; Back space for DTSTR
|
|
STRENT: CALL DTSTR ; Get string terminated by D
|
|
EX DE,HL ; String address to DE
|
|
LD HL,LTSTND ; Where to go after LETSTR
|
|
EX (SP),HL ; Save HL , get input pointer
|
|
PUSH DE ; Save address of string
|
|
JP LETSTR ; Assign string to variable
|
|
|
|
INPBIN: CALL GETCHR ; Get next character
|
|
CALL ASCTFP ; Convert ASCII to FP number
|
|
EX (SP),HL ; Save input ptr, Get var addr
|
|
CALL FPTHL ; Move FPREG to variable
|
|
POP HL ; Restore input pointer
|
|
LTSTND: DEC HL ; DEC 'cos GETCHR INCs
|
|
CALL GETCHR ; Get next character
|
|
JP Z,MORDT ; End of line - More needed?
|
|
CP ',' ; Another value?
|
|
JP NZ,BADINP ; No - Bad input
|
|
MORDT: EX (SP),HL ; Get code string address
|
|
DEC HL ; DEC 'cos GETCHR INCs
|
|
CALL GETCHR ; Get next character
|
|
JP NZ,NEDMOR ; More needed - Get it
|
|
POP DE ; Restore DATA pointer
|
|
LD A,(READFG) ; "READ" or "INPUT" ?
|
|
OR A
|
|
EX DE,HL ; DATA pointer to HL
|
|
JP NZ,UPDATA ; Update DATA pointer if "READ"
|
|
PUSH DE ; Save code string address
|
|
OR (HL) ; More input given?
|
|
LD HL,EXTIG ; "?Extra ignored" message
|
|
CALL NZ,PRS ; Output string if extra given
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
EXTIG: .BYTE "?Extra ignored",CR,LF,0
|
|
|
|
FDTLP: CALL DATA ; Get next statement
|
|
OR A ; End of line?
|
|
JP NZ,FANDT ; No - See if DATA statement
|
|
INC HL
|
|
LD A,(HL) ; End of program?
|
|
INC HL
|
|
OR (HL) ; 00 00 Ends program
|
|
LD E,OD ; ?OD Error
|
|
JP Z,ERROR ; Yes - Out of DATA
|
|
INC HL
|
|
LD E,(HL) ; LSB of line number
|
|
INC HL
|
|
LD D,(HL) ; MSB of line number
|
|
EX DE,HL
|
|
LD (DATLIN),HL ; Set line of current DATA item
|
|
EX DE,HL
|
|
FANDT: CALL GETCHR ; Get next character
|
|
CP ZDATA ; "DATA" token
|
|
JP NZ,FDTLP ; No "DATA" - Keep looking
|
|
JP ANTVLU ; Found - Convert input
|
|
|
|
NEXT: LD DE,0 ; In case no index given
|
|
NEXT1: CALL NZ,GETVAR ; Get index address
|
|
LD (BRKLIN),HL ; Save code string address
|
|
CALL BAKSTK ; Look for "FOR" block
|
|
JP NZ,NFERR ; No "FOR" - ?NF Error
|
|
LD SP,HL ; Clear nested loops
|
|
PUSH DE ; Save index address
|
|
LD A,(HL) ; Get sign of STEP
|
|
INC HL
|
|
PUSH AF ; Save sign of STEP
|
|
PUSH DE ; Save index address
|
|
CALL PHLTFP ; Move index value to FPREG
|
|
EX (SP),HL ; Save address of TO value
|
|
PUSH HL ; Save address of index
|
|
CALL ADDPHL ; Add STEP to index value
|
|
POP HL ; Restore address of index
|
|
CALL FPTHL ; Move value to index variable
|
|
POP HL ; Restore address of TO value
|
|
CALL LOADFP ; Move TO value to BCDE
|
|
PUSH HL ; Save address of line of FOR
|
|
CALL CMPNUM ; Compare index with TO value
|
|
POP HL ; Restore address of line num
|
|
POP BC ; Address of sign of STEP
|
|
SUB B ; Compare with expected sign
|
|
CALL LOADFP ; BC = Loop stmt,DE = Line num
|
|
JP Z,KILFOR ; Loop finished - Terminate it
|
|
EX DE,HL ; Loop statement line number
|
|
LD (LINEAT),HL ; Set loop line number
|
|
LD L,C ; Set code string to loop
|
|
LD H,B
|
|
JP PUTFID ; Put back "FOR" and continue
|
|
|
|
KILFOR: LD SP,HL ; Remove "FOR" block
|
|
LD HL,(BRKLIN) ; Code string after "NEXT"
|
|
LD A,(HL) ; Get next byte in code string
|
|
CP ',' ; More NEXTs ?
|
|
JP NZ,RUNCNT ; No - Do next statement
|
|
CALL GETCHR ; Position to index name
|
|
CALL NEXT1 ; Re-enter NEXT routine
|
|
; < will not RETurn to here , Exit to RUNCNT or Loop >
|
|
|
|
GETNUM: CALL EVAL ; Get a numeric expression
|
|
TSTNUM: .BYTE 0F6H ; Clear carry (numeric)
|
|
TSTSTR: SCF ; Set carry (string)
|
|
CHKTYP: LD A,(TYPE) ; Check types match
|
|
ADC A,A ; Expected + actual
|
|
OR A ; Clear carry , set parity
|
|
RET PE ; Even parity - Types match
|
|
JP TMERR ; Different types - Error
|
|
|
|
OPNPAR: CALL CHKSYN ; Make sure "(" follows
|
|
.BYTE "("
|
|
EVAL: DEC HL ; Evaluate expression & save
|
|
LD D,0 ; Precedence value
|
|
EVAL1: PUSH DE ; Save precedence
|
|
LD C,1
|
|
CALL CHKSTK ; Check for 1 level of stack
|
|
CALL OPRND ; Get next expression value
|
|
EVAL2: LD (NXTOPR),HL ; Save address of next operator
|
|
EVAL3: LD HL,(NXTOPR) ; Restore address of next opr
|
|
POP BC ; Precedence value and operator
|
|
LD A,B ; Get precedence value
|
|
CP 78H ; "AND" or "OR" ?
|
|
CALL NC,TSTNUM ; No - Make sure it's a number
|
|
LD A,(HL) ; Get next operator / function
|
|
LD D,0 ; Clear Last relation
|
|
RLTLP: SUB ZGTR ; ">" Token
|
|
JP C,FOPRND ; + - * / ^ AND OR - Test it
|
|
CP ZLTH+1-ZGTR ; < = >
|
|
JP NC,FOPRND ; Function - Call it
|
|
CP ZEQUAL-ZGTR ; "="
|
|
RLA ; <- Test for legal
|
|
XOR D ; <- combinations of < = >
|
|
CP D ; <- by combining last token
|
|
LD D,A ; <- with current one
|
|
JP C,SNERR ; Error if "<<' '==" or ">>"
|
|
LD (CUROPR),HL ; Save address of current token
|
|
CALL GETCHR ; Get next character
|
|
JP RLTLP ; Treat the two as one
|
|
|
|
FOPRND: LD A,D ; < = > found ?
|
|
OR A
|
|
JP NZ,TSTRED ; Yes - Test for reduction
|
|
LD A,(HL) ; Get operator token
|
|
LD (CUROPR),HL ; Save operator address
|
|
SUB ZPLUS ; Operator or function?
|
|
RET C ; Neither - Exit
|
|
CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ?
|
|
RET NC ; No - Exit
|
|
LD E,A ; Coded operator
|
|
LD A,(TYPE) ; Get data type
|
|
DEC A ; FF = numeric , 00 = string
|
|
OR E ; Combine with coded operator
|
|
LD A,E ; Get coded operator
|
|
JP Z,CONCAT ; String concatenation
|
|
RLCA ; Times 2
|
|
ADD A,E ; Times 3
|
|
LD E,A ; To DE (D is 0)
|
|
LD HL,PRITAB ; Precedence table
|
|
ADD HL,DE ; To the operator concerned
|
|
LD A,B ; Last operator precedence
|
|
LD D,(HL) ; Get evaluation precedence
|
|
CP D ; Compare with eval precedence
|
|
RET NC ; Exit if higher precedence
|
|
INC HL ; Point to routine address
|
|
CALL TSTNUM ; Make sure it's a number
|
|
|
|
STKTHS: PUSH BC ; Save last precedence & token
|
|
LD BC,EVAL3 ; Where to go on prec' break
|
|
PUSH BC ; Save on stack for return
|
|
LD B,E ; Save operator
|
|
LD C,D ; Save precedence
|
|
CALL STAKFP ; Move value to stack
|
|
LD E,B ; Restore operator
|
|
LD D,C ; Restore precedence
|
|
LD C,(HL) ; Get LSB of routine address
|
|
INC HL
|
|
LD B,(HL) ; Get MSB of routine address
|
|
INC HL
|
|
PUSH BC ; Save routine address
|
|
LD HL,(CUROPR) ; Address of current operator
|
|
JP EVAL1 ; Loop until prec' break
|
|
|
|
OPRND: XOR A ; Get operand routine
|
|
LD (TYPE),A ; Set numeric expected
|
|
CALL GETCHR ; Get next character
|
|
LD E,MO ; ?MO Error
|
|
JP Z,ERROR ; No operand - Error
|
|
JP C,ASCTFP ; Number - Get value
|
|
CALL CHKLTR ; See if a letter
|
|
JP NC,CONVAR ; Letter - Find variable
|
|
CP '&' ; &H = HEX, &B = BINARY
|
|
JR NZ, NOTAMP
|
|
CALL GETCHR ; Get next character
|
|
CP 'H' ; Hex number indicated? [function added]
|
|
JP Z,HEXTFP ; Convert Hex to FPREG
|
|
CP 'B' ; Binary number indicated? [function added]
|
|
JP Z,BINTFP ; Convert Bin to FPREG
|
|
LD E,SN ; If neither then a ?SN Error
|
|
JP Z,ERROR ;
|
|
NOTAMP: CP ZPLUS ; '+' Token ?
|
|
JP Z,OPRND ; Yes - Look for operand
|
|
CP '.' ; '.' ?
|
|
JP Z,ASCTFP ; Yes - Create FP number
|
|
CP ZMINUS ; '-' Token ?
|
|
JP Z,MINUS ; Yes - Do minus
|
|
CP '"' ; Literal string ?
|
|
JP Z,QTSTR ; Get string terminated by '"'
|
|
CP ZNOT ; "NOT" Token ?
|
|
JP Z,EVNOT ; Yes - Eval NOT expression
|
|
CP ZFN ; "FN" Token ?
|
|
JP Z,DOFN ; Yes - Do FN routine
|
|
SUB ZSGN ; Is it a function?
|
|
JP NC,FNOFST ; Yes - Evaluate function
|
|
EVLPAR: CALL OPNPAR ; Evaluate expression in "()"
|
|
CALL CHKSYN ; Make sure ")" follows
|
|
.BYTE ")"
|
|
RET
|
|
|
|
MINUS: LD D,7DH ; '-' precedence
|
|
CALL EVAL1 ; Evaluate until prec' break
|
|
LD HL,(NXTOPR) ; Get next operator address
|
|
PUSH HL ; Save next operator address
|
|
CALL INVSGN ; Negate value
|
|
RETNUM: CALL TSTNUM ; Make sure it's a number
|
|
POP HL ; Restore next operator address
|
|
RET
|
|
|
|
CONVAR: CALL GETVAR ; Get variable address to DE
|
|
FRMEVL: PUSH HL ; Save code string address
|
|
EX DE,HL ; Variable address to HL
|
|
LD (FPREG),HL ; Save address of variable
|
|
LD A,(TYPE) ; Get type
|
|
OR A ; Numeric?
|
|
CALL Z,PHLTFP ; Yes - Move contents to FPREG
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
FNOFST: LD B,0 ; Get address of function
|
|
RLCA ; Double function offset
|
|
LD C,A ; BC = Offset in function table
|
|
PUSH BC ; Save adjusted token value
|
|
CALL GETCHR ; Get next character
|
|
LD A,C ; Get adjusted token value
|
|
CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ?
|
|
JP C,FNVAL ; No - Do function
|
|
CALL OPNPAR ; Evaluate expression (X,...
|
|
CALL CHKSYN ; Make sure ',' follows
|
|
.BYTE ','
|
|
CALL TSTSTR ; Make sure it's a string
|
|
EX DE,HL ; Save code string address
|
|
LD HL,(FPREG) ; Get address of string
|
|
EX (SP),HL ; Save address of string
|
|
PUSH HL ; Save adjusted token value
|
|
EX DE,HL ; Restore code string address
|
|
CALL GETINT ; Get integer 0-255
|
|
EX DE,HL ; Save code string address
|
|
EX (SP),HL ; Save integer,HL = adj' token
|
|
JP GOFUNC ; Jump to string function
|
|
|
|
FNVAL: CALL EVLPAR ; Evaluate expression
|
|
EX (SP),HL ; HL = Adjusted token value
|
|
LD DE,RETNUM ; Return number from function
|
|
PUSH DE ; Save on stack
|
|
GOFUNC: LD BC,FNCTAB ; Function routine addresses
|
|
ADD HL,BC ; Point to right address
|
|
LD C,(HL) ; Get LSB of address
|
|
INC HL ;
|
|
LD H,(HL) ; Get MSB of address
|
|
LD L,C ; Address to HL
|
|
JP (HL) ; Jump to function
|
|
|
|
SGNEXP: DEC D ; Dee to flag negative exponent
|
|
CP ZMINUS ; '-' token ?
|
|
RET Z ; Yes - Return
|
|
CP '-' ; '-' ASCII ?
|
|
RET Z ; Yes - Return
|
|
INC D ; Inc to flag positive exponent
|
|
CP '+' ; '+' ASCII ?
|
|
RET Z ; Yes - Return
|
|
CP ZPLUS ; '+' token ?
|
|
RET Z ; Yes - Return
|
|
DEC HL ; DEC 'cos GETCHR INCs
|
|
RET ; Return "NZ"
|
|
|
|
POR: .BYTE 0F6H ; Flag "OR"
|
|
PAND: XOR A ; Flag "AND"
|
|
PUSH AF ; Save "AND" / "OR" flag
|
|
CALL TSTNUM ; Make sure it's a number
|
|
CALL DEINT ; Get integer -32768 to 32767
|
|
POP AF ; Restore "AND" / "OR" flag
|
|
EX DE,HL ; <- Get last
|
|
POP BC ; <- value
|
|
EX (SP),HL ; <- from
|
|
EX DE,HL ; <- stack
|
|
CALL FPBCDE ; Move last value to FPREG
|
|
PUSH AF ; Save "AND" / "OR" flag
|
|
CALL DEINT ; Get integer -32768 to 32767
|
|
POP AF ; Restore "AND" / "OR" flag
|
|
POP BC ; Get value
|
|
LD A,C ; Get LSB
|
|
LD HL,ACPASS ; Address of save AC as current
|
|
JP NZ,POR1 ; Jump if OR
|
|
AND E ; "AND" LSBs
|
|
LD C,A ; Save LSB
|
|
LD A,B ; Get MBS
|
|
AND D ; "AND" MSBs
|
|
JP (HL) ; Save AC as current (ACPASS)
|
|
|
|
POR1: OR E ; "OR" LSBs
|
|
LD C,A ; Save LSB
|
|
LD A,B ; Get MSB
|
|
OR D ; "OR" MSBs
|
|
JP (HL) ; Save AC as current (ACPASS)
|
|
|
|
TSTRED: LD HL,CMPLOG ; Logical compare routine
|
|
LD A,(TYPE) ; Get data type
|
|
RRA ; Carry set = string
|
|
LD A,D ; Get last precedence value
|
|
RLA ; Times 2 plus carry
|
|
LD E,A ; To E
|
|
LD D,64H ; Relational precedence
|
|
LD A,B ; Get current precedence
|
|
CP D ; Compare with last
|
|
RET NC ; Eval if last was rel' or log'
|
|
JP STKTHS ; Stack this one and get next
|
|
|
|
CMPLOG: .WORD CMPLG1 ; Compare two values / strings
|
|
CMPLG1: LD A,C ; Get data type
|
|
OR A
|
|
RRA
|
|
POP BC ; Get last expression to BCDE
|
|
POP DE
|
|
PUSH AF ; Save status
|
|
CALL CHKTYP ; Check that types match
|
|
LD HL,CMPRES ; Result to comparison
|
|
PUSH HL ; Save for RETurn
|
|
JP Z,CMPNUM ; Compare values if numeric
|
|
XOR A ; Compare two strings
|
|
LD (TYPE),A ; Set type to numeric
|
|
PUSH DE ; Save string name
|
|
CALL GSTRCU ; Get current string
|
|
LD A,(HL) ; Get length of string
|
|
INC HL
|
|
INC HL
|
|
LD C,(HL) ; Get LSB of address
|
|
INC HL
|
|
LD B,(HL) ; Get MSB of address
|
|
POP DE ; Restore string name
|
|
PUSH BC ; Save address of string
|
|
PUSH AF ; Save length of string
|
|
CALL GSTRDE ; Get second string
|
|
CALL LOADFP ; Get address of second string
|
|
POP AF ; Restore length of string 1
|
|
LD D,A ; Length to D
|
|
POP HL ; Restore address of string 1
|
|
CMPSTR: LD A,E ; Bytes of string 2 to do
|
|
OR D ; Bytes of string 1 to do
|
|
RET Z ; Exit if all bytes compared
|
|
LD A,D ; Get bytes of string 1 to do
|
|
SUB 1
|
|
RET C ; Exit if end of string 1
|
|
XOR A
|
|
CP E ; Bytes of string 2 to do
|
|
INC A
|
|
RET NC ; Exit if end of string 2
|
|
DEC D ; Count bytes in string 1
|
|
DEC E ; Count bytes in string 2
|
|
LD A,(BC) ; Byte in string 2
|
|
CP (HL) ; Compare to byte in string 1
|
|
INC HL ; Move up string 1
|
|
INC BC ; Move up string 2
|
|
JP Z,CMPSTR ; Same - Try next bytes
|
|
CCF ; Flag difference (">" or "<")
|
|
JP FLGDIF ; "<" gives -1 , ">" gives +1
|
|
|
|
CMPRES: INC A ; Increment current value
|
|
ADC A,A ; Double plus carry
|
|
POP BC ; Get other value
|
|
AND B ; Combine them
|
|
ADD A,-1 ; Carry set if different
|
|
SBC A,A ; 00 - Equal , FF - Different
|
|
JP FLGREL ; Set current value & continue
|
|
|
|
EVNOT: LD D,5AH ; Precedence value for "NOT"
|
|
CALL EVAL1 ; Eval until precedence break
|
|
CALL TSTNUM ; Make sure it's a number
|
|
CALL DEINT ; Get integer -32768 - 32767
|
|
LD A,E ; Get LSB
|
|
CPL ; Invert LSB
|
|
LD C,A ; Save "NOT" of LSB
|
|
LD A,D ; Get MSB
|
|
CPL ; Invert MSB
|
|
CALL ACPASS ; Save AC as current
|
|
POP BC ; Clean up stack
|
|
JP EVAL3 ; Continue evaluation
|
|
|
|
DIMRET: DEC HL ; DEC 'cos GETCHR INCs
|
|
CALL GETCHR ; Get next character
|
|
RET Z ; End of DIM statement
|
|
CALL CHKSYN ; Make sure ',' follows
|
|
.BYTE ','
|
|
DIM: LD BC,DIMRET ; Return to "DIMRET"
|
|
PUSH BC ; Save on stack
|
|
.BYTE 0F6H ; Flag "Create" variable
|
|
GETVAR: XOR A ; Find variable address,to DE
|
|
LD (LCRFLG),A ; Set locate / create flag
|
|
LD B,(HL) ; Get First byte of name
|
|
GTFNAM: CALL CHKLTR ; See if a letter
|
|
JP C,SNERR ; ?SN Error if not a letter
|
|
XOR A
|
|
LD C,A ; Clear second byte of name
|
|
LD (TYPE),A ; Set type to numeric
|
|
CALL GETCHR ; Get next character
|
|
JP C,SVNAM2 ; Numeric - Save in name
|
|
CALL CHKLTR ; See if a letter
|
|
JP C,CHARTY ; Not a letter - Check type
|
|
SVNAM2: LD C,A ; Save second byte of name
|
|
ENDNAM: CALL GETCHR ; Get next character
|
|
JP C,ENDNAM ; Numeric - Get another
|
|
CALL CHKLTR ; See if a letter
|
|
JP NC,ENDNAM ; Letter - Get another
|
|
CHARTY: SUB '$' ; String variable?
|
|
JP NZ,NOTSTR ; No - Numeric variable
|
|
INC A ; A = 1 (string type)
|
|
LD (TYPE),A ; Set type to string
|
|
RRCA ; A = 80H , Flag for string
|
|
ADD A,C ; 2nd byte of name has bit 7 on
|
|
LD C,A ; Resave second byte on name
|
|
CALL GETCHR ; Get next character
|
|
NOTSTR: LD A,(FORFLG) ; Array name needed ?
|
|
DEC A
|
|
JP Z,ARLDSV ; Yes - Get array name
|
|
JP P,NSCFOR ; No array with "FOR" or "FN"
|
|
LD A,(HL) ; Get byte again
|
|
SUB '(' ; Subscripted variable?
|
|
JP Z,SBSCPT ; Yes - Sort out subscript
|
|
|
|
NSCFOR: XOR A ; Simple variable
|
|
LD (FORFLG),A ; Clear "FOR" flag
|
|
PUSH HL ; Save code string address
|
|
LD D,B ; DE = Variable name to find
|
|
LD E,C
|
|
LD HL,(FNRGNM) ; FN argument name
|
|
CALL CPDEHL ; Is it the FN argument?
|
|
LD DE,FNARG ; Point to argument value
|
|
JP Z,POPHRT ; Yes - Return FN argument value
|
|
LD HL,(VAREND) ; End of variables
|
|
EX DE,HL ; Address of end of search
|
|
LD HL,(PROGND) ; Start of variables address
|
|
FNDVAR: CALL CPDEHL ; End of variable list table?
|
|
JP Z,CFEVAL ; Yes - Called from EVAL?
|
|
LD A,C ; Get second byte of name
|
|
SUB (HL) ; Compare with name in list
|
|
INC HL ; Move on to first byte
|
|
JP NZ,FNTHR ; Different - Find another
|
|
LD A,B ; Get first byte of name
|
|
SUB (HL) ; Compare with name in list
|
|
FNTHR: INC HL ; Move on to LSB of value
|
|
JP Z,RETADR ; Found - Return address
|
|
INC HL ; <- Skip
|
|
INC HL ; <- over
|
|
INC HL ; <- F.P.
|
|
INC HL ; <- value
|
|
JP FNDVAR ; Keep looking
|
|
|
|
CFEVAL: POP HL ; Restore code string address
|
|
EX (SP),HL ; Get return address
|
|
PUSH DE ; Save address of variable
|
|
LD DE,FRMEVL ; Return address in EVAL
|
|
CALL CPDEHL ; Called from EVAL ?
|
|
POP DE ; Restore address of variable
|
|
JP Z,RETNUL ; Yes - Return null variable
|
|
EX (SP),HL ; Put back return
|
|
PUSH HL ; Save code string address
|
|
PUSH BC ; Save variable name
|
|
LD BC,6 ; 2 byte name plus 4 byte data
|
|
LD HL,(ARREND) ; End of arrays
|
|
PUSH HL ; Save end of arrays
|
|
ADD HL,BC ; Move up 6 bytes
|
|
POP BC ; Source address in BC
|
|
PUSH HL ; Save new end address
|
|
CALL MOVUP ; Move arrays up
|
|
POP HL ; Restore new end address
|
|
LD (ARREND),HL ; Set new end address
|
|
LD H,B ; End of variables to HL
|
|
LD L,C
|
|
LD (VAREND),HL ; Set new end address
|
|
|
|
ZEROLP: DEC HL ; Back through to zero variable
|
|
LD (HL),0 ; Zero byte in variable
|
|
CALL CPDEHL ; Done them all?
|
|
JP NZ,ZEROLP ; No - Keep on going
|
|
POP DE ; Get variable name
|
|
LD (HL),E ; Store second character
|
|
INC HL
|
|
LD (HL),D ; Store first character
|
|
INC HL
|
|
RETADR: EX DE,HL ; Address of variable in DE
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
RETNUL: LD (FPEXP),A ; Set result to zero
|
|
LD HL,ZERBYT ; Also set a null string
|
|
LD (FPREG),HL ; Save for EVAL
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
SBSCPT: PUSH HL ; Save code string address
|
|
LD HL,(LCRFLG) ; Locate/Create and Type
|
|
EX (SP),HL ; Save and get code string
|
|
LD D,A ; Zero number of dimensions
|
|
SCPTLP: PUSH DE ; Save number of dimensions
|
|
PUSH BC ; Save array name
|
|
CALL FPSINT ; Get subscript (0-32767)
|
|
POP BC ; Restore array name
|
|
POP AF ; Get number of dimensions
|
|
EX DE,HL
|
|
EX (SP),HL ; Save subscript value
|
|
PUSH HL ; Save LCRFLG and TYPE
|
|
EX DE,HL
|
|
INC A ; Count dimensions
|
|
LD D,A ; Save in D
|
|
LD A,(HL) ; Get next byte in code string
|
|
CP ',' ; Comma (more to come)?
|
|
JP Z,SCPTLP ; Yes - More subscripts
|
|
CALL CHKSYN ; Make sure ")" follows
|
|
.BYTE ")"
|
|
LD (NXTOPR),HL ; Save code string address
|
|
POP HL ; Get LCRFLG and TYPE
|
|
LD (LCRFLG),HL ; Restore Locate/create & type
|
|
LD E,0 ; Flag not CSAVE* or CLOAD*
|
|
PUSH DE ; Save number of dimensions (D)
|
|
.BYTE 11H ; Skip "PUSH HL" and "PUSH AF'
|
|
|
|
ARLDSV: PUSH HL ; Save code string address
|
|
PUSH AF ; A = 00 , Flags set = Z,N
|
|
LD HL,(VAREND) ; Start of arrays
|
|
.BYTE 3EH ; Skip "ADD HL,DE"
|
|
FNDARY: ADD HL,DE ; Move to next array start
|
|
EX DE,HL
|
|
LD HL,(ARREND) ; End of arrays
|
|
EX DE,HL ; Current array pointer
|
|
CALL CPDEHL ; End of arrays found?
|
|
JP Z,CREARY ; Yes - Create array
|
|
LD A,(HL) ; Get second byte of name
|
|
CP C ; Compare with name given
|
|
INC HL ; Move on
|
|
JP NZ,NXTARY ; Different - Find next array
|
|
LD A,(HL) ; Get first byte of name
|
|
CP B ; Compare with name given
|
|
NXTARY: INC HL ; Move on
|
|
LD E,(HL) ; Get LSB of next array address
|
|
INC HL
|
|
LD D,(HL) ; Get MSB of next array address
|
|
INC HL
|
|
JP NZ,FNDARY ; Not found - Keep looking
|
|
LD A,(LCRFLG) ; Found Locate or Create it?
|
|
OR A
|
|
JP NZ,DDERR ; Create - ?DD Error
|
|
POP AF ; Locate - Get number of dim'ns
|
|
LD B,H ; BC Points to array dim'ns
|
|
LD C,L
|
|
JP Z,POPHRT ; Jump if array load/save
|
|
SUB (HL) ; Same number of dimensions?
|
|
JP Z,FINDEL ; Yes - Find element
|
|
BSERR: LD E,BS ; ?BS Error
|
|
JP ERROR ; Output error
|
|
|
|
CREARY: LD DE,4 ; 4 Bytes per entry
|
|
POP AF ; Array to save or 0 dim'ns?
|
|
JP Z,FCERR ; Yes - ?FC Error
|
|
LD (HL),C ; Save second byte of name
|
|
INC HL
|
|
LD (HL),B ; Save first byte of name
|
|
INC HL
|
|
LD C,A ; Number of dimensions to C
|
|
CALL CHKSTK ; Check if enough memory
|
|
INC HL ; Point to number of dimensions
|
|
INC HL
|
|
LD (CUROPR),HL ; Save address of pointer
|
|
LD (HL),C ; Set number of dimensions
|
|
INC HL
|
|
LD A,(LCRFLG) ; Locate of Create?
|
|
RLA ; Carry set = Create
|
|
LD A,C ; Get number of dimensions
|
|
CRARLP: LD BC,10+1 ; Default dimension size 10
|
|
JP NC,DEFSIZ ; Locate - Set default size
|
|
POP BC ; Get specified dimension size
|
|
INC BC ; Include zero element
|
|
DEFSIZ: LD (HL),C ; Save LSB of dimension size
|
|
INC HL
|
|
LD (HL),B ; Save MSB of dimension size
|
|
INC HL
|
|
PUSH AF ; Save num' of dim'ns an status
|
|
PUSH HL ; Save address of dim'n size
|
|
CALL MLDEBC ; Multiply DE by BC to find
|
|
EX DE,HL ; amount of mem needed (to DE)
|
|
POP HL ; Restore address of dimension
|
|
POP AF ; Restore number of dimensions
|
|
DEC A ; Count them
|
|
JP NZ,CRARLP ; Do next dimension if more
|
|
PUSH AF ; Save locate/create flag
|
|
LD B,D ; MSB of memory needed
|
|
LD C,E ; LSB of memory needed
|
|
EX DE,HL
|
|
ADD HL,DE ; Add bytes to array start
|
|
JP C,OMERR ; Too big - Error
|
|
CALL ENFMEM ; See if enough memory
|
|
LD (ARREND),HL ; Save new end of array
|
|
|
|
ZERARY: DEC HL ; Back through array data
|
|
LD (HL),0 ; Set array element to zero
|
|
CALL CPDEHL ; All elements zeroed?
|
|
JP NZ,ZERARY ; No - Keep on going
|
|
INC BC ; Number of bytes + 1
|
|
LD D,A ; A=0
|
|
LD HL,(CUROPR) ; Get address of array
|
|
LD E,(HL) ; Number of dimensions
|
|
EX DE,HL ; To HL
|
|
ADD HL,HL ; Two bytes per dimension size
|
|
ADD HL,BC ; Add number of bytes
|
|
EX DE,HL ; Bytes needed to DE
|
|
DEC HL
|
|
DEC HL
|
|
LD (HL),E ; Save LSB of bytes needed
|
|
INC HL
|
|
LD (HL),D ; Save MSB of bytes needed
|
|
INC HL
|
|
POP AF ; Locate / Create?
|
|
JP C,ENDDIM ; A is 0 , End if create
|
|
FINDEL: LD B,A ; Find array element
|
|
LD C,A
|
|
LD A,(HL) ; Number of dimensions
|
|
INC HL
|
|
.BYTE 16H ; Skip "POP HL"
|
|
FNDELP: POP HL ; Address of next dim' size
|
|
LD E,(HL) ; Get LSB of dim'n size
|
|
INC HL
|
|
LD D,(HL) ; Get MSB of dim'n size
|
|
INC HL
|
|
EX (SP),HL ; Save address - Get index
|
|
PUSH AF ; Save number of dim'ns
|
|
CALL CPDEHL ; Dimension too large?
|
|
JP NC,BSERR ; Yes - ?BS Error
|
|
PUSH HL ; Save index
|
|
CALL MLDEBC ; Multiply previous by size
|
|
POP DE ; Index supplied to DE
|
|
ADD HL,DE ; Add index to pointer
|
|
POP AF ; Number of dimensions
|
|
DEC A ; Count them
|
|
LD B,H ; MSB of pointer
|
|
LD C,L ; LSB of pointer
|
|
JP NZ,FNDELP ; More - Keep going
|
|
ADD HL,HL ; 4 Bytes per element
|
|
ADD HL,HL
|
|
POP BC ; Start of array
|
|
ADD HL,BC ; Point to element
|
|
EX DE,HL ; Address of element to DE
|
|
ENDDIM: LD HL,(NXTOPR) ; Got code string address
|
|
RET
|
|
|
|
FRE: LD HL,(ARREND) ; Start of free memory
|
|
EX DE,HL ; To DE
|
|
LD HL,0 ; End of free memory
|
|
ADD HL,SP ; Current stack value
|
|
LD A,(TYPE) ; Dummy argument type
|
|
OR A
|
|
JP Z,FRENUM ; Numeric - Free variable space
|
|
CALL GSTRCU ; Current string to pool
|
|
CALL GARBGE ; Garbage collection
|
|
LD HL,(STRSPC) ; Bottom of string space in use
|
|
EX DE,HL ; To DE
|
|
LD HL,(STRBOT) ; Bottom of string space
|
|
FRENUM: LD A,L ; Get LSB of end
|
|
SUB E ; Subtract LSB of beginning
|
|
LD C,A ; Save difference if C
|
|
LD A,H ; Get MSB of end
|
|
SBC A,D ; Subtract MSB of beginning
|
|
ACPASS: LD B,C ; Return integer AC
|
|
ABPASS: LD D,B ; Return integer AB
|
|
LD E,0
|
|
LD HL,TYPE ; Point to type
|
|
LD (HL),E ; Set type to numeric
|
|
LD B,80H+16 ; 16 bit integer
|
|
JP RETINT ; Return the integr
|
|
|
|
POS: LD A,(CURPOS) ; Get cursor position
|
|
PASSA: LD B,A ; Put A into AB
|
|
XOR A ; Zero A
|
|
JP ABPASS ; Return integer AB
|
|
|
|
DEF: CALL CHEKFN ; Get "FN" and name
|
|
CALL IDTEST ; Test for illegal direct
|
|
LD BC,DATA ; To get next statement
|
|
PUSH BC ; Save address for RETurn
|
|
PUSH DE ; Save address of function ptr
|
|
CALL CHKSYN ; Make sure "(" follows
|
|
.BYTE "("
|
|
CALL GETVAR ; Get argument variable name
|
|
PUSH HL ; Save code string address
|
|
EX DE,HL ; Argument address to HL
|
|
DEC HL
|
|
LD D,(HL) ; Get first byte of arg name
|
|
DEC HL
|
|
LD E,(HL) ; Get second byte of arg name
|
|
POP HL ; Restore code string address
|
|
CALL TSTNUM ; Make sure numeric argument
|
|
CALL CHKSYN ; Make sure ")" follows
|
|
.BYTE ")"
|
|
CALL CHKSYN ; Make sure "=" follows
|
|
.BYTE ZEQUAL ; "=" token
|
|
LD B,H ; Code string address to BC
|
|
LD C,L
|
|
EX (SP),HL ; Save code str , Get FN ptr
|
|
LD (HL),C ; Save LSB of FN code string
|
|
INC HL
|
|
LD (HL),B ; Save MSB of FN code string
|
|
JP SVSTAD ; Save address and do function
|
|
|
|
DOFN: CALL CHEKFN ; Make sure FN follows
|
|
PUSH DE ; Save function pointer address
|
|
CALL EVLPAR ; Evaluate expression in "()"
|
|
CALL TSTNUM ; Make sure numeric result
|
|
EX (SP),HL ; Save code str , Get FN ptr
|
|
LD E,(HL) ; Get LSB of FN code string
|
|
INC HL
|
|
LD D,(HL) ; Get MSB of FN code string
|
|
INC HL
|
|
LD A,D ; And function DEFined?
|
|
OR E
|
|
JP Z,UFERR ; No - ?UF Error
|
|
LD A,(HL) ; Get LSB of argument address
|
|
INC HL
|
|
LD H,(HL) ; Get MSB of argument address
|
|
LD L,A ; HL = Arg variable address
|
|
PUSH HL ; Save it
|
|
LD HL,(FNRGNM) ; Get old argument name
|
|
EX (SP),HL ; ; Save old , Get new
|
|
LD (FNRGNM),HL ; Set new argument name
|
|
LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value
|
|
PUSH HL ; Save it
|
|
LD HL,(FNARG) ; Get MSB,EXP of old arg value
|
|
PUSH HL ; Save it
|
|
LD HL,FNARG ; HL = Value of argument
|
|
PUSH DE ; Save FN code string address
|
|
CALL FPTHL ; Move FPREG to argument
|
|
POP HL ; Get FN code string address
|
|
CALL GETNUM ; Get value from function
|
|
DEC HL ; DEC 'cos GETCHR INCs
|
|
CALL GETCHR ; Get next character
|
|
JP NZ,SNERR ; Bad character in FN - Error
|
|
POP HL ; Get MSB,EXP of old arg
|
|
LD (FNARG),HL ; Restore it
|
|
POP HL ; Get LSB,NLSB of old arg
|
|
LD (FNARG+2),HL ; Restore it
|
|
POP HL ; Get name of old arg
|
|
LD (FNRGNM),HL ; Restore it
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
IDTEST: PUSH HL ; Save code string address
|
|
LD HL,(LINEAT) ; Get current line number
|
|
INC HL ; -1 means direct statement
|
|
LD A,H
|
|
OR L
|
|
POP HL ; Restore code string address
|
|
RET NZ ; Return if in program
|
|
LD E,ID ; ?ID Error
|
|
JP ERROR
|
|
|
|
CHEKFN: CALL CHKSYN ; Make sure FN follows
|
|
.BYTE ZFN ; "FN" token
|
|
LD A,80H
|
|
LD (FORFLG),A ; Flag FN name to find
|
|
OR (HL) ; FN name has bit 7 set
|
|
LD B,A ; in first byte of name
|
|
CALL GTFNAM ; Get FN name
|
|
JP TSTNUM ; Make sure numeric function
|
|
|
|
STR: CALL TSTNUM ; Make sure it's a number
|
|
CALL NUMASC ; Turn number into text
|
|
STR1: CALL CRTST ; Create string entry for it
|
|
CALL GSTRCU ; Current string to pool
|
|
LD BC,TOPOOL ; Save in string pool
|
|
PUSH BC ; Save address on stack
|
|
|
|
SAVSTR: LD A,(HL) ; Get string length
|
|
INC HL
|
|
INC HL
|
|
PUSH HL ; Save pointer to string
|
|
CALL TESTR ; See if enough string space
|
|
POP HL ; Restore pointer to string
|
|
LD C,(HL) ; Get LSB of address
|
|
INC HL
|
|
LD B,(HL) ; Get MSB of address
|
|
CALL CRTMST ; Create string entry
|
|
PUSH HL ; Save pointer to MSB of addr
|
|
LD L,A ; Length of string
|
|
CALL TOSTRA ; Move to string area
|
|
POP DE ; Restore pointer to MSB
|
|
RET
|
|
|
|
MKTMST: CALL TESTR ; See if enough string space
|
|
CRTMST: LD HL,TMPSTR ; Temporary string
|
|
PUSH HL ; Save it
|
|
LD (HL),A ; Save length of string
|
|
INC HL
|
|
SVSTAD: INC HL
|
|
LD (HL),E ; Save LSB of address
|
|
INC HL
|
|
LD (HL),D ; Save MSB of address
|
|
POP HL ; Restore pointer
|
|
RET
|
|
|
|
CRTST: DEC HL ; DEC - INCed after
|
|
QTSTR: LD B,'"' ; Terminating quote
|
|
LD D,B ; Quote to D
|
|
DTSTR: PUSH HL ; Save start
|
|
LD C,-1 ; Set counter to -1
|
|
QTSTLP: INC HL ; Move on
|
|
LD A,(HL) ; Get byte
|
|
INC C ; Count bytes
|
|
OR A ; End of line?
|
|
JP Z,CRTSTE ; Yes - Create string entry
|
|
CP D ; Terminator D found?
|
|
JP Z,CRTSTE ; Yes - Create string entry
|
|
CP B ; Terminator B found?
|
|
JP NZ,QTSTLP ; No - Keep looking
|
|
CRTSTE: CP '"' ; End with '"'?
|
|
CALL Z,GETCHR ; Yes - Get next character
|
|
EX (SP),HL ; Starting quote
|
|
INC HL ; First byte of string
|
|
EX DE,HL ; To DE
|
|
LD A,C ; Get length
|
|
CALL CRTMST ; Create string entry
|
|
TSTOPL: LD DE,TMPSTR ; Temporary string
|
|
LD HL,(TMSTPT) ; Temporary string pool pointer
|
|
LD (FPREG),HL ; Save address of string ptr
|
|
LD A,1
|
|
LD (TYPE),A ; Set type to string
|
|
CALL DETHL4 ; Move string to pool
|
|
CALL CPDEHL ; Out of string pool?
|
|
LD (TMSTPT),HL ; Save new pointer
|
|
POP HL ; Restore code string address
|
|
LD A,(HL) ; Get next code byte
|
|
RET NZ ; Return if pool OK
|
|
LD E,ST ; ?ST Error
|
|
JP ERROR ; String pool overflow
|
|
|
|
PRNUMS: INC HL ; Skip leading space
|
|
PRS: CALL CRTST ; Create string entry for it
|
|
PRS1: CALL GSTRCU ; Current string to pool
|
|
CALL LOADFP ; Move string block to BCDE
|
|
INC E ; Length + 1
|
|
PRSLP: DEC E ; Count characters
|
|
RET Z ; End of string
|
|
LD A,(BC) ; Get byte to output
|
|
CALL OUTC ; Output character in A
|
|
CP CR ; Return?
|
|
CALL Z,DONULL ; Yes - Do nulls
|
|
INC BC ; Next byte in string
|
|
JP PRSLP ; More characters to output
|
|
|
|
TESTR: OR A ; Test if enough room
|
|
.BYTE 0EH ; No garbage collection done
|
|
GRBDON: POP AF ; Garbage collection done
|
|
PUSH AF ; Save status
|
|
LD HL,(STRSPC) ; Bottom of string space in use
|
|
EX DE,HL ; To DE
|
|
LD HL,(STRBOT) ; Bottom of string area
|
|
CPL ; Negate length (Top down)
|
|
LD C,A ; -Length to BC
|
|
LD B,-1 ; BC = -ve length of string
|
|
ADD HL,BC ; Add to bottom of space in use
|
|
INC HL ; Plus one for 2's complement
|
|
CALL CPDEHL ; Below string RAM area?
|
|
JP C,TESTOS ; Tidy up if not done else err
|
|
LD (STRBOT),HL ; Save new bottom of area
|
|
INC HL ; Point to first byte of string
|
|
EX DE,HL ; Address to DE
|
|
POPAF: POP AF ; Throw away status push
|
|
RET
|
|
|
|
TESTOS: POP AF ; Garbage collect been done?
|
|
LD E,OS ; ?OS Error
|
|
JP Z,ERROR ; Yes - Not enough string apace
|
|
CP A ; Flag garbage collect done
|
|
PUSH AF ; Save status
|
|
LD BC,GRBDON ; Garbage collection done
|
|
PUSH BC ; Save for RETurn
|
|
GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer
|
|
GARBLP: LD (STRBOT),HL ; Reset string pointer
|
|
LD HL,0
|
|
PUSH HL ; Flag no string found
|
|
LD HL,(STRSPC) ; Get bottom of string space
|
|
PUSH HL ; Save bottom of string space
|
|
LD HL,TMSTPL ; Temporary string pool
|
|
GRBLP: EX DE,HL
|
|
LD HL,(TMSTPT) ; Temporary string pool pointer
|
|
EX DE,HL
|
|
CALL CPDEHL ; Temporary string pool done?
|
|
LD BC,GRBLP ; Loop until string pool done
|
|
JP NZ,STPOOL ; No - See if in string area
|
|
LD HL,(PROGND) ; Start of simple variables
|
|
SMPVAR: EX DE,HL
|
|
LD HL,(VAREND) ; End of simple variables
|
|
EX DE,HL
|
|
CALL CPDEHL ; All simple strings done?
|
|
JP Z,ARRLP ; Yes - Do string arrays
|
|
LD A,(HL) ; Get type of variable
|
|
INC HL
|
|
INC HL
|
|
OR A ; "S" flag set if string
|
|
CALL STRADD ; See if string in string area
|
|
JP SMPVAR ; Loop until simple ones done
|
|
|
|
GNXARY: POP BC ; Scrap address of this array
|
|
ARRLP: EX DE,HL
|
|
LD HL,(ARREND) ; End of string arrays
|
|
EX DE,HL
|
|
CALL CPDEHL ; All string arrays done?
|
|
JP Z,SCNEND ; Yes - Move string if found
|
|
CALL LOADFP ; Get array name to BCDE
|
|
LD A,E ; Get type of array
|
|
PUSH HL ; Save address of num of dim'ns
|
|
ADD HL,BC ; Start of next array
|
|
OR A ; Test type of array
|
|
JP P,GNXARY ; Numeric array - Ignore it
|
|
LD (CUROPR),HL ; Save address of next array
|
|
POP HL ; Get address of num of dim'ns
|
|
LD C,(HL) ; BC = Number of dimensions
|
|
LD B,0
|
|
ADD HL,BC ; Two bytes per dimension size
|
|
ADD HL,BC
|
|
INC HL ; Plus one for number of dim'ns
|
|
GRBARY: EX DE,HL
|
|
LD HL,(CUROPR) ; Get address of next array
|
|
EX DE,HL
|
|
CALL CPDEHL ; Is this array finished?
|
|
JP Z,ARRLP ; Yes - Get next one
|
|
LD BC,GRBARY ; Loop until array all done
|
|
STPOOL: PUSH BC ; Save return address
|
|
OR 80H ; Flag string type
|
|
STRADD: LD A,(HL) ; Get string length
|
|
INC HL
|
|
INC HL
|
|
LD E,(HL) ; Get LSB of string address
|
|
INC HL
|
|
LD D,(HL) ; Get MSB of string address
|
|
INC HL
|
|
RET P ; Not a string - Return
|
|
OR A ; Set flags on string length
|
|
RET Z ; Null string - Return
|
|
LD B,H ; Save variable pointer
|
|
LD C,L
|
|
LD HL,(STRBOT) ; Bottom of new area
|
|
CALL CPDEHL ; String been done?
|
|
LD H,B ; Restore variable pointer
|
|
LD L,C
|
|
RET C ; String done - Ignore
|
|
POP HL ; Return address
|
|
EX (SP),HL ; Lowest available string area
|
|
CALL CPDEHL ; String within string area?
|
|
EX (SP),HL ; Lowest available string area
|
|
PUSH HL ; Re-save return address
|
|
LD H,B ; Restore variable pointer
|
|
LD L,C
|
|
RET NC ; Outside string area - Ignore
|
|
POP BC ; Get return , Throw 2 away
|
|
POP AF ;
|
|
POP AF ;
|
|
PUSH HL ; Save variable pointer
|
|
PUSH DE ; Save address of current
|
|
PUSH BC ; Put back return address
|
|
RET ; Go to it
|
|
|
|
SCNEND: POP DE ; Addresses of strings
|
|
POP HL ;
|
|
LD A,L ; HL = 0 if no more to do
|
|
OR H
|
|
RET Z ; No more to do - Return
|
|
DEC HL
|
|
LD B,(HL) ; MSB of address of string
|
|
DEC HL
|
|
LD C,(HL) ; LSB of address of string
|
|
PUSH HL ; Save variable address
|
|
DEC HL
|
|
DEC HL
|
|
LD L,(HL) ; HL = Length of string
|
|
LD H,0
|
|
ADD HL,BC ; Address of end of string+1
|
|
LD D,B ; String address to DE
|
|
LD E,C
|
|
DEC HL ; Last byte in string
|
|
LD B,H ; Address to BC
|
|
LD C,L
|
|
LD HL,(STRBOT) ; Current bottom of string area
|
|
CALL MOVSTR ; Move string to new address
|
|
POP HL ; Restore variable address
|
|
LD (HL),C ; Save new LSB of address
|
|
INC HL
|
|
LD (HL),B ; Save new MSB of address
|
|
LD L,C ; Next string area+1 to HL
|
|
LD H,B
|
|
DEC HL ; Next string area address
|
|
JP GARBLP ; Look for more strings
|
|
|
|
CONCAT: PUSH BC ; Save prec' opr & code string
|
|
PUSH HL ;
|
|
LD HL,(FPREG) ; Get first string
|
|
EX (SP),HL ; Save first string
|
|
CALL OPRND ; Get second string
|
|
EX (SP),HL ; Restore first string
|
|
CALL TSTSTR ; Make sure it's a string
|
|
LD A,(HL) ; Get length of second string
|
|
PUSH HL ; Save first string
|
|
LD HL,(FPREG) ; Get second string
|
|
PUSH HL ; Save second string
|
|
ADD A,(HL) ; Add length of second string
|
|
LD E,LS ; ?LS Error
|
|
JP C,ERROR ; String too long - Error
|
|
CALL MKTMST ; Make temporary string
|
|
POP DE ; Get second string to DE
|
|
CALL GSTRDE ; Move to string pool if needed
|
|
EX (SP),HL ; Get first string
|
|
CALL GSTRHL ; Move to string pool if needed
|
|
PUSH HL ; Save first string
|
|
LD HL,(TMPSTR+2) ; Temporary string address
|
|
EX DE,HL ; To DE
|
|
CALL SSTSA ; First string to string area
|
|
CALL SSTSA ; Second string to string area
|
|
LD HL,EVAL2 ; Return to evaluation loop
|
|
EX (SP),HL ; Save return,get code string
|
|
PUSH HL ; Save code string address
|
|
JP TSTOPL ; To temporary string to pool
|
|
|
|
SSTSA: POP HL ; Return address
|
|
EX (SP),HL ; Get string block,save return
|
|
LD A,(HL) ; Get length of string
|
|
INC HL
|
|
INC HL
|
|
LD C,(HL) ; Get LSB of string address
|
|
INC HL
|
|
LD B,(HL) ; Get MSB of string address
|
|
LD L,A ; Length to L
|
|
TOSTRA: INC L ; INC - DECed after
|
|
TSALP: DEC L ; Count bytes moved
|
|
RET Z ; End of string - Return
|
|
LD A,(BC) ; Get source
|
|
LD (DE),A ; Save destination
|
|
INC BC ; Next source
|
|
INC DE ; Next destination
|
|
JP TSALP ; Loop until string moved
|
|
|
|
GETSTR: CALL TSTSTR ; Make sure it's a string
|
|
GSTRCU: LD HL,(FPREG) ; Get current string
|
|
GSTRHL: EX DE,HL ; Save DE
|
|
GSTRDE: CALL BAKTMP ; Was it last tmp-str?
|
|
EX DE,HL ; Restore DE
|
|
RET NZ ; No - Return
|
|
PUSH DE ; Save string
|
|
LD D,B ; String block address to DE
|
|
LD E,C
|
|
DEC DE ; Point to length
|
|
LD C,(HL) ; Get string length
|
|
LD HL,(STRBOT) ; Current bottom of string area
|
|
CALL CPDEHL ; Last one in string area?
|
|
JP NZ,POPHL ; No - Return
|
|
LD B,A ; Clear B (A=0)
|
|
ADD HL,BC ; Remove string from str' area
|
|
LD (STRBOT),HL ; Save new bottom of str' area
|
|
POPHL: POP HL ; Restore string
|
|
RET
|
|
|
|
BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top
|
|
DEC HL ; Back
|
|
LD B,(HL) ; Get MSB of address
|
|
DEC HL ; Back
|
|
LD C,(HL) ; Get LSB of address
|
|
DEC HL ; Back
|
|
DEC HL ; Back
|
|
CALL CPDEHL ; String last in string pool?
|
|
RET NZ ; Yes - Leave it
|
|
LD (TMSTPT),HL ; Save new string pool top
|
|
RET
|
|
|
|
LEN: LD BC,PASSA ; To return integer A
|
|
PUSH BC ; Save address
|
|
GETLEN: CALL GETSTR ; Get string and its length
|
|
XOR A
|
|
LD D,A ; Clear D
|
|
LD (TYPE),A ; Set type to numeric
|
|
LD A,(HL) ; Get length of string
|
|
OR A ; Set status flags
|
|
RET
|
|
|
|
ASC: LD BC,PASSA ; To return integer A
|
|
PUSH BC ; Save address
|
|
GTFLNM: CALL GETLEN ; Get length of string
|
|
JP Z,FCERR ; Null string - Error
|
|
INC HL
|
|
INC HL
|
|
LD E,(HL) ; Get LSB of address
|
|
INC HL
|
|
LD D,(HL) ; Get MSB of address
|
|
LD A,(DE) ; Get first byte of string
|
|
RET
|
|
|
|
CHR: LD A,1 ; One character string
|
|
CALL MKTMST ; Make a temporary string
|
|
CALL MAKINT ; Make it integer A
|
|
LD HL,(TMPSTR+2) ; Get address of string
|
|
LD (HL),E ; Save character
|
|
TOPOOL: POP BC ; Clean up stack
|
|
JP TSTOPL ; Temporary string to pool
|
|
|
|
LEFT: CALL LFRGNM ; Get number and ending ")"
|
|
XOR A ; Start at first byte in string
|
|
RIGHT1: EX (SP),HL ; Save code string,Get string
|
|
LD C,A ; Starting position in string
|
|
MID1: PUSH HL ; Save string block address
|
|
LD A,(HL) ; Get length of string
|
|
CP B ; Compare with number given
|
|
JP C,ALLFOL ; All following bytes required
|
|
LD A,B ; Get new length
|
|
.BYTE 11H ; Skip "LD C,0"
|
|
ALLFOL: LD C,0 ; First byte of string
|
|
PUSH BC ; Save position in string
|
|
CALL TESTR ; See if enough string space
|
|
POP BC ; Get position in string
|
|
POP HL ; Restore string block address
|
|
PUSH HL ; And re-save it
|
|
INC HL
|
|
INC HL
|
|
LD B,(HL) ; Get LSB of address
|
|
INC HL
|
|
LD H,(HL) ; Get MSB of address
|
|
LD L,B ; HL = address of string
|
|
LD B,0 ; BC = starting address
|
|
ADD HL,BC ; Point to that byte
|
|
LD B,H ; BC = source string
|
|
LD C,L
|
|
CALL CRTMST ; Create a string entry
|
|
LD L,A ; Length of new string
|
|
CALL TOSTRA ; Move string to string area
|
|
POP DE ; Clear stack
|
|
CALL GSTRDE ; Move to string pool if needed
|
|
JP TSTOPL ; Temporary string to pool
|
|
|
|
RIGHT: CALL LFRGNM ; Get number and ending ")"
|
|
POP DE ; Get string length
|
|
PUSH DE ; And re-save
|
|
LD A,(DE) ; Get length
|
|
SUB B ; Move back N bytes
|
|
JP RIGHT1 ; Go and get sub-string
|
|
|
|
MID: EX DE,HL ; Get code string address
|
|
LD A,(HL) ; Get next byte ',' or ")"
|
|
CALL MIDNUM ; Get number supplied
|
|
INC B ; Is it character zero?
|
|
DEC B
|
|
JP Z,FCERR ; Yes - Error
|
|
PUSH BC ; Save starting position
|
|
LD E,255 ; All of string
|
|
CP ')' ; Any length given?
|
|
JP Z,RSTSTR ; No - Rest of string
|
|
CALL CHKSYN ; Make sure ',' follows
|
|
.BYTE ','
|
|
CALL GETINT ; Get integer 0-255
|
|
RSTSTR: CALL CHKSYN ; Make sure ")" follows
|
|
.BYTE ")"
|
|
POP AF ; Restore starting position
|
|
EX (SP),HL ; Get string,8ave code string
|
|
LD BC,MID1 ; Continuation of MID$ routine
|
|
PUSH BC ; Save for return
|
|
DEC A ; Starting position-1
|
|
CP (HL) ; Compare with length
|
|
LD B,0 ; Zero bytes length
|
|
RET NC ; Null string if start past end
|
|
LD C,A ; Save starting position-1
|
|
LD A,(HL) ; Get length of string
|
|
SUB C ; Subtract start
|
|
CP E ; Enough string for it?
|
|
LD B,A ; Save maximum length available
|
|
RET C ; Truncate string if needed
|
|
LD B,E ; Set specified length
|
|
RET ; Go and create string
|
|
|
|
VAL: CALL GETLEN ; Get length of string
|
|
JP Z,RESZER ; Result zero
|
|
LD E,A ; Save length
|
|
INC HL
|
|
INC HL
|
|
LD A,(HL) ; Get LSB of address
|
|
INC HL
|
|
LD H,(HL) ; Get MSB of address
|
|
LD L,A ; HL = String address
|
|
PUSH HL ; Save string address
|
|
ADD HL,DE
|
|
LD B,(HL) ; Get end of string+1 byte
|
|
LD (HL),D ; Zero it to terminate
|
|
EX (SP),HL ; Save string end,get start
|
|
PUSH BC ; Save end+1 byte
|
|
LD A,(HL) ; Get starting byte
|
|
CP '$' ; Hex number indicated? [function added]
|
|
JP NZ,VAL1
|
|
CALL HEXTFP ; Convert Hex to FPREG
|
|
JR VAL3
|
|
VAL1: CP '%' ; Binary number indicated? [function added]
|
|
JP NZ,VAL2
|
|
CALL BINTFP ; Convert Bin to FPREG
|
|
JR VAL3
|
|
VAL2: CALL ASCTFP ; Convert ASCII string to FP
|
|
VAL3: POP BC ; Restore end+1 byte
|
|
POP HL ; Restore end+1 address
|
|
LD (HL),B ; Put back original byte
|
|
RET
|
|
|
|
LFRGNM: EX DE,HL ; Code string address to HL
|
|
CALL CHKSYN ; Make sure ")" follows
|
|
.BYTE ")"
|
|
MIDNUM: POP BC ; Get return address
|
|
POP DE ; Get number supplied
|
|
PUSH BC ; Re-save return address
|
|
LD B,E ; Number to B
|
|
RET
|
|
|
|
INP: CALL MAKINT ; Make it integer A
|
|
LD (INPORT),A ; Set input port
|
|
CALL INPSUB ; Get input from port
|
|
JP PASSA ; Return integer A
|
|
|
|
POUT: CALL SETIO ; Set up port number
|
|
JP OUTSUB ; Output data and return
|
|
|
|
WAIT: CALL SETIO ; Set up port number
|
|
PUSH AF ; Save AND mask
|
|
LD E,0 ; Assume zero if none given
|
|
DEC HL ; DEC 'cos GETCHR INCs
|
|
CALL GETCHR ; Get next character
|
|
JP Z,NOXOR ; No XOR byte given
|
|
CALL CHKSYN ; Make sure ',' follows
|
|
.BYTE ','
|
|
CALL GETINT ; Get integer 0-255 to XOR with
|
|
NOXOR: POP BC ; Restore AND mask
|
|
WAITLP: CALL INPSUB ; Get input
|
|
XOR E ; Flip selected bits
|
|
AND B ; Result non-zero?
|
|
JP Z,WAITLP ; No = keep waiting
|
|
RET
|
|
|
|
SETIO: CALL GETINT ; Get integer 0-255
|
|
LD (INPORT),A ; Set input port
|
|
LD (OTPORT),A ; Set output port
|
|
CALL CHKSYN ; Make sure ',' follows
|
|
.BYTE ','
|
|
JP GETINT ; Get integer 0-255 and return
|
|
|
|
FNDNUM: CALL GETCHR ; Get next character
|
|
GETINT: CALL GETNUM ; Get a number from 0 to 255
|
|
MAKINT: CALL DEPINT ; Make sure value 0 - 255
|
|
LD A,D ; Get MSB of number
|
|
OR A ; Zero?
|
|
JP NZ,FCERR ; No - Error
|
|
DEC HL ; DEC 'cos GETCHR INCs
|
|
CALL GETCHR ; Get next character
|
|
LD A,E ; Get number to A
|
|
RET
|
|
|
|
PEEK: CALL DEINT ; Get memory address
|
|
LD A,(DE) ; Get byte in memory
|
|
JP PASSA ; Return integer A
|
|
|
|
POKE: CALL GETNUM ; Get memory address
|
|
CALL DEINT ; Get integer -32768 to 3276
|
|
PUSH DE ; Save memory address
|
|
CALL CHKSYN ; Make sure ',' follows
|
|
.BYTE ','
|
|
CALL GETINT ; Get integer 0-255
|
|
POP DE ; Restore memory address
|
|
LD (DE),A ; Load it into memory
|
|
RET
|
|
|
|
ROUND: LD HL,HALF ; Add 0.5 to FPREG
|
|
ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE
|
|
JP FPADD ; Add BCDE to FPREG
|
|
|
|
SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL
|
|
.BYTE 21H ; Skip "POP BC" and "POP DE"
|
|
PSUB: POP BC ; Get FP number from stack
|
|
POP DE
|
|
SUBCDE: CALL INVSGN ; Negate FPREG
|
|
FPADD: LD A,B ; Get FP exponent
|
|
OR A ; Is number zero?
|
|
RET Z ; Yes - Nothing to add
|
|
LD A,(FPEXP) ; Get FPREG exponent
|
|
OR A ; Is this number zero?
|
|
JP Z,FPBCDE ; Yes - Move BCDE to FPREG
|
|
SUB B ; BCDE number larger?
|
|
JP NC,NOSWAP ; No - Don't swap them
|
|
CPL ; Two's complement
|
|
INC A ; FP exponent
|
|
EX DE,HL
|
|
CALL STAKFP ; Put FPREG on stack
|
|
EX DE,HL
|
|
CALL FPBCDE ; Move BCDE to FPREG
|
|
POP BC ; Restore number from stack
|
|
POP DE
|
|
NOSWAP: CP 24+1 ; Second number insignificant?
|
|
RET NC ; Yes - First number is result
|
|
PUSH AF ; Save number of bits to scale
|
|
CALL SIGNS ; Set MSBs & sign of result
|
|
LD H,A ; Save sign of result
|
|
POP AF ; Restore scaling factor
|
|
CALL SCALE ; Scale BCDE to same exponent
|
|
OR H ; Result to be positive?
|
|
LD HL,FPREG ; Point to FPREG
|
|
JP P,MINCDE ; No - Subtract FPREG from CDE
|
|
CALL PLUCDE ; Add FPREG to CDE
|
|
JP NC,RONDUP ; No overflow - Round it up
|
|
INC HL ; Point to exponent
|
|
INC (HL) ; Increment it
|
|
JP Z,OVERR ; Number overflowed - Error
|
|
LD L,1 ; 1 bit to shift right
|
|
CALL SHRT1 ; Shift result right
|
|
JP RONDUP ; Round it up
|
|
|
|
MINCDE: XOR A ; Clear A and carry
|
|
SUB B ; Negate exponent
|
|
LD B,A ; Re-save exponent
|
|
LD A,(HL) ; Get LSB of FPREG
|
|
SBC A, E ; Subtract LSB of BCDE
|
|
LD E,A ; Save LSB of BCDE
|
|
INC HL
|
|
LD A,(HL) ; Get NMSB of FPREG
|
|
SBC A,D ; Subtract NMSB of BCDE
|
|
LD D,A ; Save NMSB of BCDE
|
|
INC HL
|
|
LD A,(HL) ; Get MSB of FPREG
|
|
SBC A,C ; Subtract MSB of BCDE
|
|
LD C,A ; Save MSB of BCDE
|
|
CONPOS: CALL C,COMPL ; Overflow - Make it positive
|
|
|
|
BNORM: LD L,B ; L = Exponent
|
|
LD H,E ; H = LSB
|
|
XOR A
|
|
BNRMLP: LD B,A ; Save bit count
|
|
LD A,C ; Get MSB
|
|
OR A ; Is it zero?
|
|
JP NZ,PNORM ; No - Do it bit at a time
|
|
LD C,D ; MSB = NMSB
|
|
LD D,H ; NMSB= LSB
|
|
LD H,L ; LSB = VLSB
|
|
LD L,A ; VLSB= 0
|
|
LD A,B ; Get exponent
|
|
SUB 8 ; Count 8 bits
|
|
CP -24-8 ; Was number zero?
|
|
JP NZ,BNRMLP ; No - Keep normalising
|
|
RESZER: XOR A ; Result is zero
|
|
SAVEXP: LD (FPEXP),A ; Save result as zero
|
|
RET
|
|
|
|
NORMAL: DEC B ; Count bits
|
|
ADD HL,HL ; Shift HL left
|
|
LD A,D ; Get NMSB
|
|
RLA ; Shift left with last bit
|
|
LD D,A ; Save NMSB
|
|
LD A,C ; Get MSB
|
|
ADC A,A ; Shift left with last bit
|
|
LD C,A ; Save MSB
|
|
PNORM: JP P,NORMAL ; Not done - Keep going
|
|
LD A,B ; Number of bits shifted
|
|
LD E,H ; Save HL in EB
|
|
LD B,L
|
|
OR A ; Any shifting done?
|
|
JP Z,RONDUP ; No - Round it up
|
|
LD HL,FPEXP ; Point to exponent
|
|
ADD A,(HL) ; Add shifted bits
|
|
LD (HL),A ; Re-save exponent
|
|
JP NC,RESZER ; Underflow - Result is zero
|
|
RET Z ; Result is zero
|
|
RONDUP: LD A,B ; Get VLSB of number
|
|
RONDB: LD HL,FPEXP ; Point to exponent
|
|
OR A ; Any rounding?
|
|
CALL M,FPROND ; Yes - Round number up
|
|
LD B,(HL) ; B = Exponent
|
|
INC HL
|
|
LD A,(HL) ; Get sign of result
|
|
AND 10000000B ; Only bit 7 needed
|
|
XOR C ; Set correct sign
|
|
LD C,A ; Save correct sign in number
|
|
JP FPBCDE ; Move BCDE to FPREG
|
|
|
|
FPROND: INC E ; Round LSB
|
|
RET NZ ; Return if ok
|
|
INC D ; Round NMSB
|
|
RET NZ ; Return if ok
|
|
INC C ; Round MSB
|
|
RET NZ ; Return if ok
|
|
LD C,80H ; Set normal value
|
|
INC (HL) ; Increment exponent
|
|
RET NZ ; Return if ok
|
|
JP OVERR ; Overflow error
|
|
|
|
PLUCDE: LD A,(HL) ; Get LSB of FPREG
|
|
ADD A,E ; Add LSB of BCDE
|
|
LD E,A ; Save LSB of BCDE
|
|
INC HL
|
|
LD A,(HL) ; Get NMSB of FPREG
|
|
ADC A,D ; Add NMSB of BCDE
|
|
LD D,A ; Save NMSB of BCDE
|
|
INC HL
|
|
LD A,(HL) ; Get MSB of FPREG
|
|
ADC A,C ; Add MSB of BCDE
|
|
LD C,A ; Save MSB of BCDE
|
|
RET
|
|
|
|
COMPL: LD HL,SGNRES ; Sign of result
|
|
LD A,(HL) ; Get sign of result
|
|
CPL ; Negate it
|
|
LD (HL),A ; Put it back
|
|
XOR A
|
|
LD L,A ; Set L to zero
|
|
SUB B ; Negate exponent,set carry
|
|
LD B,A ; Re-save exponent
|
|
LD A,L ; Load zero
|
|
SBC A,E ; Negate LSB
|
|
LD E,A ; Re-save LSB
|
|
LD A,L ; Load zero
|
|
SBC A,D ; Negate NMSB
|
|
LD D,A ; Re-save NMSB
|
|
LD A,L ; Load zero
|
|
SBC A,C ; Negate MSB
|
|
LD C,A ; Re-save MSB
|
|
RET
|
|
|
|
SCALE: LD B,0 ; Clear underflow
|
|
SCALLP: SUB 8 ; 8 bits (a whole byte)?
|
|
JP C,SHRITE ; No - Shift right A bits
|
|
LD B,E ; <- Shift
|
|
LD E,D ; <- right
|
|
LD D,C ; <- eight
|
|
LD C,0 ; <- bits
|
|
JP SCALLP ; More bits to shift
|
|
|
|
SHRITE: ADD A,8+1 ; Adjust count
|
|
LD L,A ; Save bits to shift
|
|
SHRLP: XOR A ; Flag for all done
|
|
DEC L ; All shifting done?
|
|
RET Z ; Yes - Return
|
|
LD A,C ; Get MSB
|
|
SHRT1: RRA ; Shift it right
|
|
LD C,A ; Re-save
|
|
LD A,D ; Get NMSB
|
|
RRA ; Shift right with last bit
|
|
LD D,A ; Re-save it
|
|
LD A,E ; Get LSB
|
|
RRA ; Shift right with last bit
|
|
LD E,A ; Re-save it
|
|
LD A,B ; Get underflow
|
|
RRA ; Shift right with last bit
|
|
LD B,A ; Re-save underflow
|
|
JP SHRLP ; More bits to do
|
|
|
|
UNITY: .BYTE 000H,000H,000H,081H ; 1.00000
|
|
|
|
LOGTAB: .BYTE 3 ; Table used by LOG
|
|
.BYTE 0AAH,056H,019H,080H ; 0.59898
|
|
.BYTE 0F1H,022H,076H,080H ; 0.96147
|
|
.BYTE 045H,0AAH,038H,082H ; 2.88539
|
|
|
|
LOG: CALL TSTSGN ; Test sign of value
|
|
OR A
|
|
JP PE,FCERR ; ?FC Error if <= zero
|
|
LD HL,FPEXP ; Point to exponent
|
|
LD A,(HL) ; Get exponent
|
|
LD BC,8035H ; BCDE = SQR(1/2)
|
|
LD DE,04F3H
|
|
SUB B ; Scale value to be < 1
|
|
PUSH AF ; Save scale factor
|
|
LD (HL),B ; Save new exponent
|
|
PUSH DE ; Save SQR(1/2)
|
|
PUSH BC
|
|
CALL FPADD ; Add SQR(1/2) to value
|
|
POP BC ; Restore SQR(1/2)
|
|
POP DE
|
|
INC B ; Make it SQR(2)
|
|
CALL DVBCDE ; Divide by SQR(2)
|
|
LD HL,UNITY ; Point to 1.
|
|
CALL SUBPHL ; Subtract FPREG from 1
|
|
LD HL,LOGTAB ; Coefficient table
|
|
CALL SUMSER ; Evaluate sum of series
|
|
LD BC,8080H ; BCDE = -0.5
|
|
LD DE,0000H
|
|
CALL FPADD ; Subtract 0.5 from FPREG
|
|
POP AF ; Restore scale factor
|
|
CALL RSCALE ; Re-scale number
|
|
MULLN2: LD BC,8031H ; BCDE = Ln(2)
|
|
LD DE,7218H
|
|
.BYTE 21H ; Skip "POP BC" and "POP DE"
|
|
|
|
MULT: POP BC ; Get number from stack
|
|
POP DE
|
|
FPMULT: CALL TSTSGN ; Test sign of FPREG
|
|
RET Z ; Return zero if zero
|
|
LD L,0 ; Flag add exponents
|
|
CALL ADDEXP ; Add exponents
|
|
LD A,C ; Get MSB of multiplier
|
|
LD (MULVAL),A ; Save MSB of multiplier
|
|
EX DE,HL
|
|
LD (MULVAL+1),HL ; Save rest of multiplier
|
|
LD BC,0 ; Partial product (BCDE) = zero
|
|
LD D,B
|
|
LD E,B
|
|
LD HL,BNORM ; Address of normalise
|
|
PUSH HL ; Save for return
|
|
LD HL,MULT8 ; Address of 8 bit multiply
|
|
PUSH HL ; Save for NMSB,MSB
|
|
PUSH HL ;
|
|
LD HL,FPREG ; Point to number
|
|
MULT8: LD A,(HL) ; Get LSB of number
|
|
INC HL ; Point to NMSB
|
|
OR A ; Test LSB
|
|
JP Z,BYTSFT ; Zero - shift to next byte
|
|
PUSH HL ; Save address of number
|
|
LD L,8 ; 8 bits to multiply by
|
|
MUL8LP: RRA ; Shift LSB right
|
|
LD H,A ; Save LSB
|
|
LD A,C ; Get MSB
|
|
JP NC,NOMADD ; Bit was zero - Don't add
|
|
PUSH HL ; Save LSB and count
|
|
LD HL,(MULVAL+1) ; Get LSB and NMSB
|
|
ADD HL,DE ; Add NMSB and LSB
|
|
EX DE,HL ; Leave sum in DE
|
|
POP HL ; Restore MSB and count
|
|
LD A,(MULVAL) ; Get MSB of multiplier
|
|
ADC A,C ; Add MSB
|
|
NOMADD: RRA ; Shift MSB right
|
|
LD C,A ; Re-save MSB
|
|
LD A,D ; Get NMSB
|
|
RRA ; Shift NMSB right
|
|
LD D,A ; Re-save NMSB
|
|
LD A,E ; Get LSB
|
|
RRA ; Shift LSB right
|
|
LD E,A ; Re-save LSB
|
|
LD A,B ; Get VLSB
|
|
RRA ; Shift VLSB right
|
|
LD B,A ; Re-save VLSB
|
|
DEC L ; Count bits multiplied
|
|
LD A,H ; Get LSB of multiplier
|
|
JP NZ,MUL8LP ; More - Do it
|
|
POPHRT: POP HL ; Restore address of number
|
|
RET
|
|
|
|
BYTSFT: LD B,E ; Shift partial product left
|
|
LD E,D
|
|
LD D,C
|
|
LD C,A
|
|
RET
|
|
|
|
DIV10: CALL STAKFP ; Save FPREG on stack
|
|
LD BC,8420H ; BCDE = 10.
|
|
LD DE,0000H
|
|
CALL FPBCDE ; Move 10 to FPREG
|
|
|
|
DIV: POP BC ; Get number from stack
|
|
POP DE
|
|
DVBCDE: CALL TSTSGN ; Test sign of FPREG
|
|
JP Z,DZERR ; Error if division by zero
|
|
LD L,-1 ; Flag subtract exponents
|
|
CALL ADDEXP ; Subtract exponents
|
|
INC (HL) ; Add 2 to exponent to adjust
|
|
INC (HL)
|
|
DEC HL ; Point to MSB
|
|
LD A,(HL) ; Get MSB of dividend
|
|
LD (DIV3),A ; Save for subtraction
|
|
DEC HL
|
|
LD A,(HL) ; Get NMSB of dividend
|
|
LD (DIV2),A ; Save for subtraction
|
|
DEC HL
|
|
LD A,(HL) ; Get MSB of dividend
|
|
LD (DIV1),A ; Save for subtraction
|
|
LD B,C ; Get MSB
|
|
EX DE,HL ; NMSB,LSB to HL
|
|
XOR A
|
|
LD C,A ; Clear MSB of quotient
|
|
LD D,A ; Clear NMSB of quotient
|
|
LD E,A ; Clear LSB of quotient
|
|
LD (DIV4),A ; Clear overflow count
|
|
DIVLP: PUSH HL ; Save divisor
|
|
PUSH BC
|
|
LD A,L ; Get LSB of number
|
|
CALL DIVSUP ; Subt' divisor from dividend
|
|
SBC A,0 ; Count for overflows
|
|
CCF
|
|
JP NC,RESDIV ; Restore divisor if borrow
|
|
LD (DIV4),A ; Re-save overflow count
|
|
POP AF ; Scrap divisor
|
|
POP AF
|
|
SCF ; Set carry to
|
|
.BYTE 0D2H ; Skip "POP BC" and "POP HL"
|
|
|
|
RESDIV: POP BC ; Restore divisor
|
|
POP HL
|
|
LD A,C ; Get MSB of quotient
|
|
INC A
|
|
DEC A
|
|
RRA ; Bit 0 to bit 7
|
|
JP M,RONDB ; Done - Normalise result
|
|
RLA ; Restore carry
|
|
LD A,E ; Get LSB of quotient
|
|
RLA ; Double it
|
|
LD E,A ; Put it back
|
|
LD A,D ; Get NMSB of quotient
|
|
RLA ; Double it
|
|
LD D,A ; Put it back
|
|
LD A,C ; Get MSB of quotient
|
|
RLA ; Double it
|
|
LD C,A ; Put it back
|
|
ADD HL,HL ; Double NMSB,LSB of divisor
|
|
LD A,B ; Get MSB of divisor
|
|
RLA ; Double it
|
|
LD B,A ; Put it back
|
|
LD A,(DIV4) ; Get VLSB of quotient
|
|
RLA ; Double it
|
|
LD (DIV4),A ; Put it back
|
|
LD A,C ; Get MSB of quotient
|
|
OR D ; Merge NMSB
|
|
OR E ; Merge LSB
|
|
JP NZ,DIVLP ; Not done - Keep dividing
|
|
PUSH HL ; Save divisor
|
|
LD HL,FPEXP ; Point to exponent
|
|
DEC (HL) ; Divide by 2
|
|
POP HL ; Restore divisor
|
|
JP NZ,DIVLP ; Ok - Keep going
|
|
JP OVERR ; Overflow error
|
|
|
|
ADDEXP: LD A,B ; Get exponent of dividend
|
|
OR A ; Test it
|
|
JP Z,OVTST3 ; Zero - Result zero
|
|
LD A,L ; Get add/subtract flag
|
|
LD HL,FPEXP ; Point to exponent
|
|
XOR (HL) ; Add or subtract it
|
|
ADD A,B ; Add the other exponent
|
|
LD B,A ; Save new exponent
|
|
RRA ; Test exponent for overflow
|
|
XOR B
|
|
LD A,B ; Get exponent
|
|
JP P,OVTST2 ; Positive - Test for overflow
|
|
ADD A,80H ; Add excess 128
|
|
LD (HL),A ; Save new exponent
|
|
JP Z,POPHRT ; Zero - Result zero
|
|
CALL SIGNS ; Set MSBs and sign of result
|
|
LD (HL),A ; Save new exponent
|
|
DEC HL ; Point to MSB
|
|
RET
|
|
|
|
OVTST1: CALL TSTSGN ; Test sign of FPREG
|
|
CPL ; Invert sign
|
|
POP HL ; Clean up stack
|
|
OVTST2: OR A ; Test if new exponent zero
|
|
OVTST3: POP HL ; Clear off return address
|
|
JP P,RESZER ; Result zero
|
|
JP OVERR ; Overflow error
|
|
|
|
MLSP10: CALL BCDEFP ; Move FPREG to BCDE
|
|
LD A,B ; Get exponent
|
|
OR A ; Is it zero?
|
|
RET Z ; Yes - Result is zero
|
|
ADD A,2 ; Multiply by 4
|
|
JP C,OVERR ; Overflow - ?OV Error
|
|
LD B,A ; Re-save exponent
|
|
CALL FPADD ; Add BCDE to FPREG (Times 5)
|
|
LD HL,FPEXP ; Point to exponent
|
|
INC (HL) ; Double number (Times 10)
|
|
RET NZ ; Ok - Return
|
|
JP OVERR ; Overflow error
|
|
|
|
TSTSGN: LD A,(FPEXP) ; Get sign of FPREG
|
|
OR A
|
|
RET Z ; RETurn if number is zero
|
|
LD A,(FPREG+2) ; Get MSB of FPREG
|
|
.BYTE 0FEH ; Test sign
|
|
RETREL: CPL ; Invert sign
|
|
RLA ; Sign bit to carry
|
|
FLGDIF: SBC A,A ; Carry to all bits of A
|
|
RET NZ ; Return -1 if negative
|
|
INC A ; Bump to +1
|
|
RET ; Positive - Return +1
|
|
|
|
SGN: CALL TSTSGN ; Test sign of FPREG
|
|
FLGREL: LD B,80H+8 ; 8 bit integer in exponent
|
|
LD DE,0 ; Zero NMSB and LSB
|
|
RETINT: LD HL,FPEXP ; Point to exponent
|
|
LD C,A ; CDE = MSB,NMSB and LSB
|
|
LD (HL),B ; Save exponent
|
|
LD B,0 ; CDE = integer to normalise
|
|
INC HL ; Point to sign of result
|
|
LD (HL),80H ; Set sign of result
|
|
RLA ; Carry = sign of integer
|
|
JP CONPOS ; Set sign of result
|
|
|
|
ABS: CALL TSTSGN ; Test sign of FPREG
|
|
RET P ; Return if positive
|
|
INVSGN: LD HL,FPREG+2 ; Point to MSB
|
|
LD A,(HL) ; Get sign of mantissa
|
|
XOR 80H ; Invert sign of mantissa
|
|
LD (HL),A ; Re-save sign of mantissa
|
|
RET
|
|
|
|
STAKFP: EX DE,HL ; Save code string address
|
|
LD HL,(FPREG) ; LSB,NLSB of FPREG
|
|
EX (SP),HL ; Stack them,get return
|
|
PUSH HL ; Re-save return
|
|
LD HL,(FPREG+2) ; MSB and exponent of FPREG
|
|
EX (SP),HL ; Stack them,get return
|
|
PUSH HL ; Re-save return
|
|
EX DE,HL ; Restore code string address
|
|
RET
|
|
|
|
PHLTFP: CALL LOADFP ; Number at HL to BCDE
|
|
FPBCDE: EX DE,HL ; Save code string address
|
|
LD (FPREG),HL ; Save LSB,NLSB of number
|
|
LD H,B ; Exponent of number
|
|
LD L,C ; MSB of number
|
|
LD (FPREG+2),HL ; Save MSB and exponent
|
|
EX DE,HL ; Restore code string address
|
|
RET
|
|
|
|
BCDEFP: LD HL,FPREG ; Point to FPREG
|
|
LOADFP: LD E,(HL) ; Get LSB of number
|
|
INC HL
|
|
LD D,(HL) ; Get NMSB of number
|
|
INC HL
|
|
LD C,(HL) ; Get MSB of number
|
|
INC HL
|
|
LD B,(HL) ; Get exponent of number
|
|
INCHL: INC HL ; Used for conditional "INC HL"
|
|
RET
|
|
|
|
FPTHL: LD DE,FPREG ; Point to FPREG
|
|
DETHL4: LD B,4 ; 4 bytes to move
|
|
DETHLB: LD A,(DE) ; Get source
|
|
LD (HL),A ; Save destination
|
|
INC DE ; Next source
|
|
INC HL ; Next destination
|
|
DEC B ; Count bytes
|
|
JP NZ,DETHLB ; Loop if more
|
|
RET
|
|
|
|
SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG
|
|
LD A,(HL) ; Get MSB
|
|
RLCA ; Old sign to carry
|
|
SCF ; Set MSBit
|
|
RRA ; Set MSBit of MSB
|
|
LD (HL),A ; Save new MSB
|
|
CCF ; Complement sign
|
|
RRA ; Old sign to carry
|
|
INC HL
|
|
INC HL
|
|
LD (HL),A ; Set sign of result
|
|
LD A,C ; Get MSB
|
|
RLCA ; Old sign to carry
|
|
SCF ; Set MSBit
|
|
RRA ; Set MSBit of MSB
|
|
LD C,A ; Save MSB
|
|
RRA
|
|
XOR (HL) ; New sign of result
|
|
RET
|
|
|
|
CMPNUM: LD A,B ; Get exponent of number
|
|
OR A
|
|
JP Z,TSTSGN ; Zero - Test sign of FPREG
|
|
LD HL,RETREL ; Return relation routine
|
|
PUSH HL ; Save for return
|
|
CALL TSTSGN ; Test sign of FPREG
|
|
LD A,C ; Get MSB of number
|
|
RET Z ; FPREG zero - Number's MSB
|
|
LD HL,FPREG+2 ; MSB of FPREG
|
|
XOR (HL) ; Combine signs
|
|
LD A,C ; Get MSB of number
|
|
RET M ; Exit if signs different
|
|
CALL CMPFP ; Compare FP numbers
|
|
RRA ; Get carry to sign
|
|
XOR C ; Combine with MSB of number
|
|
RET
|
|
|
|
CMPFP: INC HL ; Point to exponent
|
|
LD A,B ; Get exponent
|
|
CP (HL) ; Compare exponents
|
|
RET NZ ; Different
|
|
DEC HL ; Point to MBS
|
|
LD A,C ; Get MSB
|
|
CP (HL) ; Compare MSBs
|
|
RET NZ ; Different
|
|
DEC HL ; Point to NMSB
|
|
LD A,D ; Get NMSB
|
|
CP (HL) ; Compare NMSBs
|
|
RET NZ ; Different
|
|
DEC HL ; Point to LSB
|
|
LD A,E ; Get LSB
|
|
SUB (HL) ; Compare LSBs
|
|
RET NZ ; Different
|
|
POP HL ; Drop RETurn
|
|
POP HL ; Drop another RETurn
|
|
RET
|
|
|
|
FPINT: LD B,A ; <- Move
|
|
LD C,A ; <- exponent
|
|
LD D,A ; <- to all
|
|
LD E,A ; <- bits
|
|
OR A ; Test exponent
|
|
RET Z ; Zero - Return zero
|
|
PUSH HL ; Save pointer to number
|
|
CALL BCDEFP ; Move FPREG to BCDE
|
|
CALL SIGNS ; Set MSBs & sign of result
|
|
XOR (HL) ; Combine with sign of FPREG
|
|
LD H,A ; Save combined signs
|
|
CALL M,DCBCDE ; Negative - Decrement BCDE
|
|
LD A,80H+24 ; 24 bits
|
|
SUB B ; Bits to shift
|
|
CALL SCALE ; Shift BCDE
|
|
LD A,H ; Get combined sign
|
|
RLA ; Sign to carry
|
|
CALL C,FPROND ; Negative - Round number up
|
|
LD B,0 ; Zero exponent
|
|
CALL C,COMPL ; If negative make positive
|
|
POP HL ; Restore pointer to number
|
|
RET
|
|
|
|
DCBCDE: DEC DE ; Decrement BCDE
|
|
LD A,D ; Test LSBs
|
|
AND E
|
|
INC A
|
|
RET NZ ; Exit if LSBs not FFFF
|
|
DEC BC ; Decrement MSBs
|
|
RET
|
|
|
|
INT: LD HL,FPEXP ; Point to exponent
|
|
LD A,(HL) ; Get exponent
|
|
CP 80H+24 ; Integer accuracy only?
|
|
LD A,(FPREG) ; Get LSB
|
|
RET NC ; Yes - Already integer
|
|
LD A,(HL) ; Get exponent
|
|
CALL FPINT ; F.P to integer
|
|
LD (HL),80H+24 ; Save 24 bit integer
|
|
LD A,E ; Get LSB of number
|
|
PUSH AF ; Save LSB
|
|
LD A,C ; Get MSB of number
|
|
RLA ; Sign to carry
|
|
CALL CONPOS ; Set sign of result
|
|
POP AF ; Restore LSB of number
|
|
RET
|
|
|
|
MLDEBC: LD HL,0 ; Clear partial product
|
|
LD A,B ; Test multiplier
|
|
OR C
|
|
RET Z ; Return zero if zero
|
|
LD A,16 ; 16 bits
|
|
MLDBLP: ADD HL,HL ; Shift P.P left
|
|
JP C,BSERR ; ?BS Error if overflow
|
|
EX DE,HL
|
|
ADD HL,HL ; Shift multiplier left
|
|
EX DE,HL
|
|
JP NC,NOMLAD ; Bit was zero - No add
|
|
ADD HL,BC ; Add multiplicand
|
|
JP C,BSERR ; ?BS Error if overflow
|
|
NOMLAD: DEC A ; Count bits
|
|
JP NZ,MLDBLP ; More
|
|
RET
|
|
|
|
ASCTFP: CP '-' ; Negative?
|
|
PUSH AF ; Save it and flags
|
|
JP Z,CNVNUM ; Yes - Convert number
|
|
CP '+' ; Positive?
|
|
JP Z,CNVNUM ; Yes - Convert number
|
|
DEC HL ; DEC 'cos GETCHR INCs
|
|
CNVNUM: CALL RESZER ; Set result to zero
|
|
LD B,A ; Digits after point counter
|
|
LD D,A ; Sign of exponent
|
|
LD E,A ; Exponent of ten
|
|
CPL
|
|
LD C,A ; Before or after point flag
|
|
MANLP: CALL GETCHR ; Get next character
|
|
JP C,ADDIG ; Digit - Add to number
|
|
CP '.'
|
|
JP Z,DPOINT ; '.' - Flag point
|
|
CP 'E'
|
|
JP NZ,CONEXP ; Not 'E' - Scale number
|
|
CALL GETCHR ; Get next character
|
|
CALL SGNEXP ; Get sign of exponent
|
|
EXPLP: CALL GETCHR ; Get next character
|
|
JP C,EDIGIT ; Digit - Add to exponent
|
|
INC D ; Is sign negative?
|
|
JP NZ,CONEXP ; No - Scale number
|
|
XOR A
|
|
SUB E ; Negate exponent
|
|
LD E,A ; And re-save it
|
|
INC C ; Flag end of number
|
|
DPOINT: INC C ; Flag point passed
|
|
JP Z,MANLP ; Zero - Get another digit
|
|
CONEXP: PUSH HL ; Save code string address
|
|
LD A,E ; Get exponent
|
|
SUB B ; Subtract digits after point
|
|
SCALMI: CALL P,SCALPL ; Positive - Multiply number
|
|
JP P,ENDCON ; Positive - All done
|
|
PUSH AF ; Save number of times to /10
|
|
CALL DIV10 ; Divide by 10
|
|
POP AF ; Restore count
|
|
INC A ; Count divides
|
|
|
|
ENDCON: JP NZ,SCALMI ; More to do
|
|
POP DE ; Restore code string address
|
|
POP AF ; Restore sign of number
|
|
CALL Z,INVSGN ; Negative - Negate number
|
|
EX DE,HL ; Code string address to HL
|
|
RET
|
|
|
|
SCALPL: RET Z ; Exit if no scaling needed
|
|
MULTEN: PUSH AF ; Save count
|
|
CALL MLSP10 ; Multiply number by 10
|
|
POP AF ; Restore count
|
|
DEC A ; Count multiplies
|
|
RET
|
|
|
|
ADDIG: PUSH DE ; Save sign of exponent
|
|
LD D,A ; Save digit
|
|
LD A,B ; Get digits after point
|
|
ADC A,C ; Add one if after point
|
|
LD B,A ; Re-save counter
|
|
PUSH BC ; Save point flags
|
|
PUSH HL ; Save code string address
|
|
PUSH DE ; Save digit
|
|
CALL MLSP10 ; Multiply number by 10
|
|
POP AF ; Restore digit
|
|
SUB '0' ; Make it absolute
|
|
CALL RSCALE ; Re-scale number
|
|
POP HL ; Restore code string address
|
|
POP BC ; Restore point flags
|
|
POP DE ; Restore sign of exponent
|
|
JP MANLP ; Get another digit
|
|
|
|
RSCALE: CALL STAKFP ; Put number on stack
|
|
CALL FLGREL ; Digit to add to FPREG
|
|
PADD: POP BC ; Restore number
|
|
POP DE
|
|
JP FPADD ; Add BCDE to FPREG and return
|
|
|
|
EDIGIT: LD A,E ; Get digit
|
|
RLCA ; Times 2
|
|
RLCA ; Times 4
|
|
ADD A,E ; Times 5
|
|
RLCA ; Times 10
|
|
ADD A,(HL) ; Add next digit
|
|
SUB '0' ; Make it absolute
|
|
LD E,A ; Save new digit
|
|
JP EXPLP ; Look for another digit
|
|
|
|
LINEIN: PUSH HL ; Save code string address
|
|
LD HL,INMSG ; Output " in "
|
|
CALL PRS ; Output string at HL
|
|
POP HL ; Restore code string address
|
|
PRNTHL: EX DE,HL ; Code string address to DE
|
|
XOR A
|
|
LD B,80H+24 ; 24 bits
|
|
CALL RETINT ; Return the integer
|
|
LD HL,PRNUMS ; Print number string
|
|
PUSH HL ; Save for return
|
|
NUMASC: LD HL,PBUFF ; Convert number to ASCII
|
|
PUSH HL ; Save for return
|
|
CALL TSTSGN ; Test sign of FPREG
|
|
LD (HL),' ' ; Space at start
|
|
JP P,SPCFST ; Positive - Space to start
|
|
LD (HL),'-' ; '-' sign at start
|
|
SPCFST: INC HL ; First byte of number
|
|
LD (HL),'0' ; '0' if zero
|
|
JP Z,JSTZER ; Return '0' if zero
|
|
PUSH HL ; Save buffer address
|
|
CALL M,INVSGN ; Negate FPREG if negative
|
|
XOR A ; Zero A
|
|
PUSH AF ; Save it
|
|
CALL RNGTST ; Test number is in range
|
|
SIXDIG: LD BC,9143H ; BCDE - 99999.9
|
|
LD DE,4FF8H
|
|
CALL CMPNUM ; Compare numbers
|
|
OR A
|
|
JP PO,INRNG ; > 99999.9 - Sort it out
|
|
POP AF ; Restore count
|
|
CALL MULTEN ; Multiply by ten
|
|
PUSH AF ; Re-save count
|
|
JP SIXDIG ; Test it again
|
|
|
|
GTSIXD: CALL DIV10 ; Divide by 10
|
|
POP AF ; Get count
|
|
INC A ; Count divides
|
|
PUSH AF ; Re-save count
|
|
CALL RNGTST ; Test number is in range
|
|
INRNG: CALL ROUND ; Add 0.5 to FPREG
|
|
INC A
|
|
CALL FPINT ; F.P to integer
|
|
CALL FPBCDE ; Move BCDE to FPREG
|
|
LD BC,0306H ; 1E+06 to 1E-03 range
|
|
POP AF ; Restore count
|
|
ADD A,C ; 6 digits before point
|
|
INC A ; Add one
|
|
JP M,MAKNUM ; Do it in 'E' form if < 1E-02
|
|
CP 6+1+1 ; More than 999999 ?
|
|
JP NC,MAKNUM ; Yes - Do it in 'E' form
|
|
INC A ; Adjust for exponent
|
|
LD B,A ; Exponent of number
|
|
LD A,2 ; Make it zero after
|
|
|
|
MAKNUM: DEC A ; Adjust for digits to do
|
|
DEC A
|
|
POP HL ; Restore buffer address
|
|
PUSH AF ; Save count
|
|
LD DE,POWERS ; Powers of ten
|
|
DEC B ; Count digits before point
|
|
JP NZ,DIGTXT ; Not zero - Do number
|
|
LD (HL),'.' ; Save point
|
|
INC HL ; Move on
|
|
LD (HL),'0' ; Save zero
|
|
INC HL ; Move on
|
|
DIGTXT: DEC B ; Count digits before point
|
|
LD (HL),'.' ; Save point in case
|
|
CALL Z,INCHL ; Last digit - move on
|
|
PUSH BC ; Save digits before point
|
|
PUSH HL ; Save buffer address
|
|
PUSH DE ; Save powers of ten
|
|
CALL BCDEFP ; Move FPREG to BCDE
|
|
POP HL ; Powers of ten table
|
|
LD B, '0'-1 ; ASCII '0' - 1
|
|
TRYAGN: INC B ; Count subtractions
|
|
LD A,E ; Get LSB
|
|
SUB (HL) ; Subtract LSB
|
|
LD E,A ; Save LSB
|
|
INC HL
|
|
LD A,D ; Get NMSB
|
|
SBC A,(HL) ; Subtract NMSB
|
|
LD D,A ; Save NMSB
|
|
INC HL
|
|
LD A,C ; Get MSB
|
|
SBC A,(HL) ; Subtract MSB
|
|
LD C,A ; Save MSB
|
|
DEC HL ; Point back to start
|
|
DEC HL
|
|
JP NC,TRYAGN ; No overflow - Try again
|
|
CALL PLUCDE ; Restore number
|
|
INC HL ; Start of next number
|
|
CALL FPBCDE ; Move BCDE to FPREG
|
|
EX DE,HL ; Save point in table
|
|
POP HL ; Restore buffer address
|
|
LD (HL),B ; Save digit in buffer
|
|
INC HL ; And move on
|
|
POP BC ; Restore digit count
|
|
DEC C ; Count digits
|
|
JP NZ,DIGTXT ; More - Do them
|
|
DEC B ; Any decimal part?
|
|
JP Z,DOEBIT ; No - Do 'E' bit
|
|
SUPTLZ: DEC HL ; Move back through buffer
|
|
LD A,(HL) ; Get character
|
|
CP '0' ; '0' character?
|
|
JP Z,SUPTLZ ; Yes - Look back for more
|
|
CP '.' ; A decimal point?
|
|
CALL NZ,INCHL ; Move back over digit
|
|
|
|
DOEBIT: POP AF ; Get 'E' flag
|
|
JP Z,NOENED ; No 'E' needed - End buffer
|
|
LD (HL),'E' ; Put 'E' in buffer
|
|
INC HL ; And move on
|
|
LD (HL),'+' ; Put '+' in buffer
|
|
JP P,OUTEXP ; Positive - Output exponent
|
|
LD (HL),'-' ; Put '-' in buffer
|
|
CPL ; Negate exponent
|
|
INC A
|
|
OUTEXP: LD B,'0'-1 ; ASCII '0' - 1
|
|
EXPTEN: INC B ; Count subtractions
|
|
SUB 10 ; Tens digit
|
|
JP NC,EXPTEN ; More to do
|
|
ADD A,'0'+10 ; Restore and make ASCII
|
|
INC HL ; Move on
|
|
LD (HL),B ; Save MSB of exponent
|
|
JSTZER: INC HL ;
|
|
LD (HL),A ; Save LSB of exponent
|
|
INC HL
|
|
NOENED: LD (HL),C ; Mark end of buffer
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
RNGTST: LD BC,9474H ; BCDE = 999999.
|
|
LD DE,23F7H
|
|
CALL CMPNUM ; Compare numbers
|
|
OR A
|
|
POP HL ; Return address to HL
|
|
JP PO,GTSIXD ; Too big - Divide by ten
|
|
JP (HL) ; Otherwise return to caller
|
|
|
|
HALF: .BYTE 00H,00H,00H,80H ; 0.5
|
|
|
|
POWERS: .BYTE 0A0H,086H,001H ; 100000
|
|
.BYTE 010H,027H,000H ; 10000
|
|
.BYTE 0E8H,003H,000H ; 1000
|
|
.BYTE 064H,000H,000H ; 100
|
|
.BYTE 00AH,000H,000H ; 10
|
|
.BYTE 001H,000H,000H ; 1
|
|
|
|
NEGAFT: LD HL,INVSGN ; Negate result
|
|
EX (SP),HL ; To be done after caller
|
|
JP (HL) ; Return to caller
|
|
|
|
SQR: CALL STAKFP ; Put value on stack
|
|
LD HL,HALF ; Set power to 1/2
|
|
CALL PHLTFP ; Move 1/2 to FPREG
|
|
|
|
POWER: POP BC ; Get base
|
|
POP DE
|
|
CALL TSTSGN ; Test sign of power
|
|
LD A,B ; Get exponent of base
|
|
JP Z,EXP ; Make result 1 if zero
|
|
JP P,POWER1 ; Positive base - Ok
|
|
OR A ; Zero to negative power?
|
|
JP Z,DZERR ; Yes - ?/0 Error
|
|
POWER1: OR A ; Base zero?
|
|
JP Z,SAVEXP ; Yes - Return zero
|
|
PUSH DE ; Save base
|
|
PUSH BC
|
|
LD A,C ; Get MSB of base
|
|
OR 01111111B ; Get sign status
|
|
CALL BCDEFP ; Move power to BCDE
|
|
JP P,POWER2 ; Positive base - Ok
|
|
PUSH DE ; Save power
|
|
PUSH BC
|
|
CALL INT ; Get integer of power
|
|
POP BC ; Restore power
|
|
POP DE
|
|
PUSH AF ; MSB of base
|
|
CALL CMPNUM ; Power an integer?
|
|
POP HL ; Restore MSB of base
|
|
LD A,H ; but don't affect flags
|
|
RRA ; Exponent odd or even?
|
|
POWER2: POP HL ; Restore MSB and exponent
|
|
LD (FPREG+2),HL ; Save base in FPREG
|
|
POP HL ; LSBs of base
|
|
LD (FPREG),HL ; Save in FPREG
|
|
CALL C,NEGAFT ; Odd power - Negate result
|
|
CALL Z,INVSGN ; Negative base - Negate it
|
|
PUSH DE ; Save power
|
|
PUSH BC
|
|
CALL LOG ; Get LOG of base
|
|
POP BC ; Restore power
|
|
POP DE
|
|
CALL FPMULT ; Multiply LOG by power
|
|
|
|
EXP: CALL STAKFP ; Put value on stack
|
|
LD BC,08138H ; BCDE = 1/Ln(2)
|
|
LD DE,0AA3BH
|
|
CALL FPMULT ; Multiply value by 1/LN(2)
|
|
LD A,(FPEXP) ; Get exponent
|
|
CP 80H+8 ; Is it in range?
|
|
JP NC,OVTST1 ; No - Test for overflow
|
|
CALL INT ; Get INT of FPREG
|
|
ADD A,80H ; For excess 128
|
|
ADD A,2 ; Exponent > 126?
|
|
JP C,OVTST1 ; Yes - Test for overflow
|
|
PUSH AF ; Save scaling factor
|
|
LD HL,UNITY ; Point to 1.
|
|
CALL ADDPHL ; Add 1 to FPREG
|
|
CALL MULLN2 ; Multiply by LN(2)
|
|
POP AF ; Restore scaling factor
|
|
POP BC ; Restore exponent
|
|
POP DE
|
|
PUSH AF ; Save scaling factor
|
|
CALL SUBCDE ; Subtract exponent from FPREG
|
|
CALL INVSGN ; Negate result
|
|
LD HL,EXPTAB ; Coefficient table
|
|
CALL SMSER1 ; Sum the series
|
|
LD DE,0 ; Zero LSBs
|
|
POP BC ; Scaling factor
|
|
LD C,D ; Zero MSB
|
|
JP FPMULT ; Scale result to correct value
|
|
|
|
EXPTAB: .BYTE 8 ; Table used by EXP
|
|
.BYTE 040H,02EH,094H,074H ; -1/7! (-1/5040)
|
|
.BYTE 070H,04FH,02EH,077H ; 1/6! ( 1/720)
|
|
.BYTE 06EH,002H,088H,07AH ; -1/5! (-1/120)
|
|
.BYTE 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24)
|
|
.BYTE 050H,0AAH,0AAH,07EH ; -1/3! (-1/6)
|
|
.BYTE 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2)
|
|
.BYTE 000H,000H,080H,081H ; -1/1! (-1/1)
|
|
.BYTE 000H,000H,000H,081H ; 1/0! ( 1/1)
|
|
|
|
SUMSER: CALL STAKFP ; Put FPREG on stack
|
|
LD DE,MULT ; Multiply by "X"
|
|
PUSH DE ; To be done after
|
|
PUSH HL ; Save address of table
|
|
CALL BCDEFP ; Move FPREG to BCDE
|
|
CALL FPMULT ; Square the value
|
|
POP HL ; Restore address of table
|
|
SMSER1: CALL STAKFP ; Put value on stack
|
|
LD A,(HL) ; Get number of coefficients
|
|
INC HL ; Point to start of table
|
|
CALL PHLTFP ; Move coefficient to FPREG
|
|
.BYTE 06H ; Skip "POP AF"
|
|
SUMLP: POP AF ; Restore count
|
|
POP BC ; Restore number
|
|
POP DE
|
|
DEC A ; Cont coefficients
|
|
RET Z ; All done
|
|
PUSH DE ; Save number
|
|
PUSH BC
|
|
PUSH AF ; Save count
|
|
PUSH HL ; Save address in table
|
|
CALL FPMULT ; Multiply FPREG by BCDE
|
|
POP HL ; Restore address in table
|
|
CALL LOADFP ; Number at HL to BCDE
|
|
PUSH HL ; Save address in table
|
|
CALL FPADD ; Add coefficient to FPREG
|
|
POP HL ; Restore address in table
|
|
JP SUMLP ; More coefficients
|
|
|
|
RND: CALL TSTSGN ; Test sign of FPREG
|
|
LD HL,SEED+2 ; Random number seed
|
|
JP M,RESEED ; Negative - Re-seed
|
|
LD HL,LSTRND ; Last random number
|
|
CALL PHLTFP ; Move last RND to FPREG
|
|
LD HL,SEED+2 ; Random number seed
|
|
RET Z ; Return if RND(0)
|
|
ADD A,(HL) ; Add (SEED)+2)
|
|
AND 00000111B ; 0 to 7
|
|
LD B,0
|
|
LD (HL),A ; Re-save seed
|
|
INC HL ; Move to coefficient table
|
|
ADD A,A ; 4 bytes
|
|
ADD A,A ; per entry
|
|
LD C,A ; BC = Offset into table
|
|
ADD HL,BC ; Point to coefficient
|
|
CALL LOADFP ; Coefficient to BCDE
|
|
CALL FPMULT ; ; Multiply FPREG by coefficient
|
|
LD A,(SEED+1) ; Get (SEED+1)
|
|
INC A ; Add 1
|
|
AND 00000011B ; 0 to 3
|
|
LD B,0
|
|
CP 1 ; Is it zero?
|
|
ADC A,B ; Yes - Make it 1
|
|
LD (SEED+1),A ; Re-save seed
|
|
LD HL,RNDTAB-4 ; Addition table
|
|
ADD A,A ; 4 bytes
|
|
ADD A,A ; per entry
|
|
LD C,A ; BC = Offset into table
|
|
ADD HL,BC ; Point to value
|
|
CALL ADDPHL ; Add value to FPREG
|
|
RND1: CALL BCDEFP ; Move FPREG to BCDE
|
|
LD A,E ; Get LSB
|
|
LD E,C ; LSB = MSB
|
|
XOR 01001111B ; Fiddle around
|
|
LD C,A ; New MSB
|
|
LD (HL),80H ; Set exponent
|
|
DEC HL ; Point to MSB
|
|
LD B,(HL) ; Get MSB
|
|
LD (HL),80H ; Make value -0.5
|
|
LD HL,SEED ; Random number seed
|
|
INC (HL) ; Count seed
|
|
LD A,(HL) ; Get seed
|
|
SUB 171 ; Do it modulo 171
|
|
JP NZ,RND2 ; Non-zero - Ok
|
|
LD (HL),A ; Zero seed
|
|
INC C ; Fillde about
|
|
DEC D ; with the
|
|
INC E ; number
|
|
RND2: CALL BNORM ; Normalise number
|
|
LD HL,LSTRND ; Save random number
|
|
JP FPTHL ; Move FPREG to last and return
|
|
|
|
RESEED: LD (HL),A ; Re-seed random numbers
|
|
DEC HL
|
|
LD (HL),A
|
|
DEC HL
|
|
LD (HL),A
|
|
JP RND1 ; Return RND seed
|
|
|
|
RNDTAB: .BYTE 068H,0B1H,046H,068H ; Table used by RND
|
|
.BYTE 099H,0E9H,092H,069H
|
|
.BYTE 010H,0D1H,075H,068H
|
|
|
|
COS: LD HL,HALFPI ; Point to PI/2
|
|
CALL ADDPHL ; Add it to PPREG
|
|
SIN: CALL STAKFP ; Put angle on stack
|
|
LD BC,8349H ; BCDE = 2 PI
|
|
LD DE,0FDBH
|
|
CALL FPBCDE ; Move 2 PI to FPREG
|
|
POP BC ; Restore angle
|
|
POP DE
|
|
CALL DVBCDE ; Divide angle by 2 PI
|
|
CALL STAKFP ; Put it on stack
|
|
CALL INT ; Get INT of result
|
|
POP BC ; Restore number
|
|
POP DE
|
|
CALL SUBCDE ; Make it 0 <= value < 1
|
|
LD HL,QUARTR ; Point to 0.25
|
|
CALL SUBPHL ; Subtract value from 0.25
|
|
CALL TSTSGN ; Test sign of value
|
|
SCF ; Flag positive
|
|
JP P,SIN1 ; Positive - Ok
|
|
CALL ROUND ; Add 0.5 to value
|
|
CALL TSTSGN ; Test sign of value
|
|
OR A ; Flag negative
|
|
SIN1: PUSH AF ; Save sign
|
|
CALL P,INVSGN ; Negate value if positive
|
|
LD HL,QUARTR ; Point to 0.25
|
|
CALL ADDPHL ; Add 0.25 to value
|
|
POP AF ; Restore sign
|
|
CALL NC,INVSGN ; Negative - Make positive
|
|
LD HL,SINTAB ; Coefficient table
|
|
JP SUMSER ; Evaluate sum of series
|
|
|
|
HALFPI: .BYTE 0DBH,00FH,049H,081H ; 1.5708 (PI/2)
|
|
|
|
QUARTR: .BYTE 000H,000H,000H,07FH ; 0.25
|
|
|
|
SINTAB: .BYTE 5 ; Table used by SIN
|
|
.BYTE 0BAH,0D7H,01EH,086H ; 39.711
|
|
.BYTE 064H,026H,099H,087H ;-76.575
|
|
.BYTE 058H,034H,023H,087H ; 81.602
|
|
.BYTE 0E0H,05DH,0A5H,086H ;-41.342
|
|
.BYTE 0DAH,00FH,049H,083H ; 6.2832
|
|
|
|
TAN: CALL STAKFP ; Put angle on stack
|
|
CALL SIN ; Get SIN of angle
|
|
POP BC ; Restore angle
|
|
POP HL
|
|
CALL STAKFP ; Save SIN of angle
|
|
EX DE,HL ; BCDE = Angle
|
|
CALL FPBCDE ; Angle to FPREG
|
|
CALL COS ; Get COS of angle
|
|
JP DIV ; TAN = SIN / COS
|
|
|
|
ATN: CALL TSTSGN ; Test sign of value
|
|
CALL M,NEGAFT ; Negate result after if -ve
|
|
CALL M,INVSGN ; Negate value if -ve
|
|
LD A,(FPEXP) ; Get exponent
|
|
CP 81H ; Number less than 1?
|
|
JP C,ATN1 ; Yes - Get arc tangnt
|
|
LD BC,8100H ; BCDE = 1
|
|
LD D,C
|
|
LD E,C
|
|
CALL DVBCDE ; Get reciprocal of number
|
|
LD HL,SUBPHL ; Sub angle from PI/2
|
|
PUSH HL ; Save for angle > 1
|
|
ATN1: LD HL,ATNTAB ; Coefficient table
|
|
CALL SUMSER ; Evaluate sum of series
|
|
LD HL,HALFPI ; PI/2 - angle in case > 1
|
|
RET ; Number > 1 - Sub from PI/2
|
|
|
|
ATNTAB: .BYTE 9 ; Table used by ATN
|
|
.BYTE 04AH,0D7H,03BH,078H ; 1/17
|
|
.BYTE 002H,06EH,084H,07BH ;-1/15
|
|
.BYTE 0FEH,0C1H,02FH,07CH ; 1/13
|
|
.BYTE 074H,031H,09AH,07DH ;-1/11
|
|
.BYTE 084H,03DH,05AH,07DH ; 1/9
|
|
.BYTE 0C8H,07FH,091H,07EH ;-1/7
|
|
.BYTE 0E4H,0BBH,04CH,07EH ; 1/5
|
|
.BYTE 06CH,0AAH,0AAH,07FH ;-1/3
|
|
.BYTE 000H,000H,000H,081H ; 1/1
|
|
|
|
|
|
ARET: RET ; A RETurn instruction
|
|
|
|
GETINP: RST 10H ;input a character
|
|
RET
|
|
|
|
CLS:
|
|
LD A,CS ; ASCII Clear screen
|
|
JP MONOUT ; Output character
|
|
|
|
WIDTH: CALL GETINT ; Get integer 0-255
|
|
LD A,E ; Width to A
|
|
LD (LWIDTH),A ; Set width
|
|
RET
|
|
|
|
LINES: CALL GETNUM ; Get a number
|
|
CALL DEINT ; Get integer -32768 to 32767
|
|
LD (LINESC),DE ; Set lines counter
|
|
LD (LINESN),DE ; Set lines number
|
|
RET
|
|
|
|
DEEK: CALL DEINT ; Get integer -32768 to 32767
|
|
PUSH DE ; Save number
|
|
POP HL ; Number to HL
|
|
LD B,(HL) ; Get LSB of contents
|
|
INC HL
|
|
LD A,(HL) ; Get MSB of contents
|
|
JP ABPASS ; Return integer AB
|
|
|
|
DOKE: CALL GETNUM ; Get a number
|
|
CALL DEINT ; Get integer -32768 to 32767
|
|
PUSH DE ; Save address
|
|
CALL CHKSYN ; Make sure ',' follows
|
|
.BYTE ','
|
|
CALL GETNUM ; Get a number
|
|
CALL DEINT ; Get integer -32768 to 32767
|
|
EX (SP),HL ; Save value,get address
|
|
LD (HL),E ; Save LSB of value
|
|
INC HL
|
|
LD (HL),D ; Save MSB of value
|
|
POP HL ; Restore code string address
|
|
RET
|
|
|
|
|
|
; HEX$(nn) Convert 16 bit number to Hexadecimal string
|
|
|
|
HEX: CALL TSTNUM ; Verify it's a number
|
|
CALL DEINT ; Get integer -32768 to 32767
|
|
PUSH BC ; Save contents of BC
|
|
LD HL,PBUFF
|
|
LD A,D ; Get high order into A
|
|
CP $0
|
|
JR Z,HEX2 ; Skip output if both high digits are zero
|
|
CALL BYT2ASC ; Convert D to ASCII
|
|
LD A,B
|
|
CP '0'
|
|
JR Z,HEX1 ; Don't store high digit if zero
|
|
LD (HL),B ; Store it to PBUFF
|
|
INC HL ; Next location
|
|
HEX1: LD (HL),C ; Store C to PBUFF+1
|
|
INC HL ; Next location
|
|
HEX2: LD A,E ; Get lower byte
|
|
CALL BYT2ASC ; Convert E to ASCII
|
|
LD A,D
|
|
CP $0
|
|
JR NZ,HEX3 ; If upper byte was not zero then always print lower byte
|
|
LD A,B
|
|
CP '0' ; If high digit of lower byte is zero then don't print
|
|
JR Z,HEX4
|
|
HEX3: LD (HL),B ; to PBUFF+2
|
|
INC HL ; Next location
|
|
HEX4: LD (HL),C ; to PBUFF+3
|
|
INC HL ; PBUFF+4 to zero
|
|
XOR A ; Terminating character
|
|
LD (HL),A ; Store zero to terminate
|
|
INC HL ; Make sure PBUFF is terminated
|
|
LD (HL),A ; Store the double zero there
|
|
POP BC ; Get BC back
|
|
LD HL,PBUFF ; Reset to start of PBUFF
|
|
JP STR1 ; Convert the PBUFF to a string and return it
|
|
|
|
BYT2ASC LD B,A ; Save original value
|
|
AND $0F ; Strip off upper nybble
|
|
CP $0A ; 0-9?
|
|
JR C,ADD30 ; If A-F, add 7 more
|
|
ADD A,$07 ; Bring value up to ASCII A-F
|
|
ADD30 ADD A,$30 ; And make ASCII
|
|
LD C,A ; Save converted char to C
|
|
LD A,B ; Retrieve original value
|
|
RRCA ; and Rotate it right
|
|
RRCA
|
|
RRCA
|
|
RRCA
|
|
AND $0F ; Mask off upper nybble
|
|
CP $0A ; 0-9? < A hex?
|
|
JR C,ADD301 ; Skip Add 7
|
|
ADD A,$07 ; Bring it up to ASCII A-F
|
|
ADD301 ADD A,$30 ; And make it full ASCII
|
|
LD B,A ; Store high order byte
|
|
RET
|
|
|
|
; Convert "&Hnnnn" to FPREG
|
|
; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn"
|
|
; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9
|
|
HEXTFP EX DE,HL ; Move code string pointer to DE
|
|
LD HL,$0000 ; Zero out the value
|
|
CALL GETHEX ; Check the number for valid hex
|
|
JP C,HXERR ; First value wasn't hex, HX error
|
|
JR HEXLP1 ; Convert first character
|
|
HEXLP CALL GETHEX ; Get second and addtional characters
|
|
JR C,HEXIT ; Exit if not a hex character
|
|
HEXLP1 ADD HL,HL ; Rotate 4 bits to the left
|
|
ADD HL,HL
|
|
ADD HL,HL
|
|
ADD HL,HL
|
|
OR L ; Add in D0-D3 into L
|
|
LD L,A ; Save new value
|
|
JR HEXLP ; And continue until all hex characters are in
|
|
|
|
GETHEX INC DE ; Next location
|
|
LD A,(DE) ; Load character at pointer
|
|
CP ' '
|
|
JP Z,GETHEX ; Skip spaces
|
|
SUB $30 ; Get absolute value
|
|
RET C ; < "0", error
|
|
CP $0A
|
|
JR C,NOSUB7 ; Is already in the range 0-9
|
|
SUB $07 ; Reduce to A-F
|
|
CP $0A ; Value should be $0A-$0F at this point
|
|
RET C ; CY set if was : ; < = > ? @
|
|
NOSUB7 CP $10 ; > Greater than "F"?
|
|
CCF
|
|
RET ; CY set if it wasn't valid hex
|
|
|
|
HEXIT EX DE,HL ; Value into DE, Code string into HL
|
|
LD A,D ; Load DE into AC
|
|
LD C,E ; For prep to
|
|
PUSH HL
|
|
CALL ACPASS ; ACPASS to set AC as integer into FPREG
|
|
POP HL
|
|
RET
|
|
|
|
HXERR: LD E,HX ; ?HEX Error
|
|
JP ERROR
|
|
|
|
; BIN$(NN) Convert integer to a 1-16 char binary string
|
|
BIN: CALL TSTNUM ; Verify it's a number
|
|
CALL DEINT ; Get integer -32768 to 32767
|
|
BIN2: PUSH BC ; Save contents of BC
|
|
LD HL,PBUFF
|
|
LD B,17 ; One higher than max char count
|
|
ZEROSUP: ; Suppress leading zeros
|
|
DEC B ; Max 16 chars
|
|
LD A,B
|
|
CP $01
|
|
JR Z,BITOUT ; Always output at least one character
|
|
RL E
|
|
RL D
|
|
JR NC,ZEROSUP
|
|
JR BITOUT2
|
|
BITOUT:
|
|
RL E
|
|
RL D ; Top bit now in carry
|
|
BITOUT2:
|
|
LD A,'0' ; Char for '0'
|
|
ADC A,0 ; If carry set then '0' --> '1'
|
|
LD (HL),A
|
|
INC HL
|
|
DEC B
|
|
JR NZ,BITOUT
|
|
XOR A ; Terminating character
|
|
LD (HL),A ; Store zero to terminate
|
|
INC HL ; Make sure PBUFF is terminated
|
|
LD (HL),A ; Store the double zero there
|
|
POP BC
|
|
LD HL,PBUFF
|
|
JP STR1
|
|
|
|
; Convert "&Bnnnn" to FPREG
|
|
; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn"
|
|
BINTFP: EX DE,HL ; Move code string pointer to DE
|
|
LD HL,$0000 ; Zero out the value
|
|
CALL CHKBIN ; Check the number for valid bin
|
|
JP C,BINERR ; First value wasn't bin, HX error
|
|
BINIT: SUB '0'
|
|
ADD HL,HL ; Rotate HL left
|
|
OR L
|
|
LD L,A
|
|
CALL CHKBIN ; Get second and addtional characters
|
|
JR NC,BINIT ; Process if a bin character
|
|
EX DE,HL ; Value into DE, Code string into HL
|
|
LD A,D ; Load DE into AC
|
|
LD C,E ; For prep to
|
|
PUSH HL
|
|
CALL ACPASS ; ACPASS to set AC as integer into FPREG
|
|
POP HL
|
|
RET
|
|
|
|
; Char is in A, NC if char is 0 or 1
|
|
CHKBIN: INC DE
|
|
LD A,(DE)
|
|
CP ' '
|
|
JP Z,CHKBIN ; Skip spaces
|
|
CP '0' ; Set C if < '0'
|
|
RET C
|
|
CP '2'
|
|
CCF ; Set C if > '1'
|
|
RET
|
|
|
|
BINERR: LD E,BN ; ?BIN Error
|
|
JP ERROR
|
|
|
|
|
|
JJUMP1:
|
|
LD IX,-1 ; Flag cold start
|
|
JP CSTART ; Go and initialise
|
|
|
|
MONOUT:
|
|
JP $0008 ; output a char
|
|
|
|
|
|
MONITR:
|
|
JP $0000 ; Restart (Normally Monitor Start)
|
|
|
|
|
|
INITST: LD A,0 ; Clear break flag
|
|
LD (BRKFLG),A
|
|
JP INIT
|
|
|
|
ARETN: RETN ; Return from NMI
|
|
|
|
|
|
TSTBIT: PUSH AF ; Save bit mask
|
|
AND B ; Get common bits
|
|
POP BC ; Restore bit mask
|
|
CP B ; Same bit set?
|
|
LD A,0 ; Return 0 in A
|
|
RET
|
|
|
|
OUTNCR: CALL OUTC ; Output character in A
|
|
JP PRNTCRLF ; Output CRLF
|
|
|
|
.end
|
|
|