API tools faq
paste
Advertisement
Guest User

hello.z80

a guest
May 21st, 2019
271
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Z80 Assembler 166.31 KB | None | 0 0
raw download clone embed print report
  1. ;===============================================================================
  2. ; BASIC language interpreter
  3. ; (c) 1978 Microsoft
  4. ; Originally written for the NASCOM(c) Z80 computer
  5. ; Ported over for Space-Time Productions MCB Board 2004-2005
  6. ;
  7. ; BASIC4
  8. ; TRS-80 Model 3 keyboard hooked to p8279 Keyboard/Display driver
  9. ;   And Custom Build 80x24 video board
  10. ; 21 May 2019 J.Owens
  11. ;
  12. ;===============================================================================
  13. ;------------------------------------------------------------------------------
  14. ; Memory Map
  15. ;------------------------------------------------------------------------------
  16. RAM:
  17.     .EQU    $3800       ; STACK BOT
  18. STACK:
  19.     .EQU    RAM+$180        ; STACK TOP
  20. INBUFF:
  21.     .EQU    STACK       ; INPUT  BUFFER
  22. BUFFER:
  23.     .EQU    RAM+$1D0        ; CRUNCH BUFFER
  24. BASICV:
  25.     .EQU    RAM+$220        ; BASIC VAR SPACE  
  26. TEXT:
  27.     .EQU    $4000       ; BASIC PROGRAM  
  28. VIDBASE:
  29.     .EQU    $F800
  30. VIDLINES:
  31.     .EQU    24      ; 24 lines
  32. VWIDTH:
  33.     .EQU    80      ; 80 columns, 1920 total chars
  34. VIDEND:
  35.     .EQU    VIDBASE + (VIDLINES * VWIDTH) - 1
  36. VIDCHIP:
  37.     .EQU    $00
  38. ;------------------------------------------------------------------------------
  39. ;General Equates
  40. ;------------------------------------------------------------------------------
  41. BREAK:
  42.     .EQU    $03     ; Coco BREAK key
  43. CLR:
  44.     .EQU    $04     ; Coco CLEAR key to Kill Line
  45. CTRLG:
  46.     .EQU    $07     ; <CTRL-G>
  47. BKSP:
  48.     .EQU    $08     ; BACK SPACE
  49. LF:
  50.     .EQU    $0A     ; LINE FEED
  51. CS:
  52.     .EQU    $0C     ; FORM FEED
  53. CR:
  54.     .EQU    $0D     ; CARRIAGE RETURN
  55. CTRLQ:
  56.     .EQU    $11     ; Down arrow enables scroll during list
  57. CTRLS:
  58.     .EQU    $13     ; Up arrow disables scroll during list
  59. SPC:
  60.     .EQU    $20     ; Space
  61. ZERBYT:
  62.     .EQU    $-1     ; A zero byte (?)
  63. ;------------------------------------------------------------------------------
  64. ; BASIC ERROR CODE VALUES
  65. ;------------------------------------------------------------------------------
  66. NF:
  67.     .EQU    $01     ; NEXT without FOR
  68. SN:
  69.     .EQU    $02     ; Syntax error
  70. RG:
  71.     .EQU    $03     ; RETURN without GOSUB
  72. OD:
  73.     .EQU    $04     ; Out of DATA
  74. FC:
  75.     .EQU    $05     ; Function call error
  76. OV:
  77.     .EQU    $06     ; Overflow
  78. OM:
  79.     .EQU    $07     ; Out of memory
  80. UL:
  81.     .EQU    $08     ; Undefined line number
  82. BS:
  83.     .EQU    $09     ; Bad subscript
  84. DD:
  85.     .EQU    $0A     ; Re-DIMensioned array
  86. DZ:
  87.     .EQU    $0B     ; Division by zero (/0)
  88. ID:
  89.     .EQU    $0C     ; Illegal direct
  90. TM:
  91.     .EQU    $0D     ; Type miss-match
  92. OS:
  93.     .EQU    $0E     ; Out of string space
  94. LS:
  95.     .EQU    $0F     ; String too long
  96. ST:
  97.     .EQU    $10     ; String formula too complex
  98. CN:
  99.     .EQU    $11     ; Can't CONTinue
  100. UF:
  101.     .EQU    $12     ; UnDEFined FN function
  102. MO:
  103.     .EQU    $13     ; Missing operand
  104. SO:
  105.     .EQU    $14     ; Stack overflow
  106. HX:
  107.     .EQU    $15     ; Not valid HEX value
  108. ;------------------------------------------------------------------------------
  109. ; RESERVED WORD TOKEN VALUES
  110. ;   Tokens occupy from $80 thru $CF connected to each reserved word in the
  111. ;   "WORDS:" list; these are the only ones referenced by indexing routines
  112. ;------------------------------------------------------------------------------
  113. ZEND:
  114.     .EQU    080H        ; END
  115. ZFOR:
  116.     .EQU    081H        ; FOR
  117. ZDATA:
  118.     .EQU    083H        ; DATA
  119. ZGOTO:
  120.     .EQU    088H        ; GOTO
  121. ZGOSUB:
  122.     .EQU    08CH        ; GOSUB
  123. ZREM:
  124.     .EQU    08EH        ; REM
  125. ZPRINT:
  126.     .EQU    09EH        ; PRINT
  127. ZNEW:
  128.     .EQU    0A4H        ; NEW
  129. ZTAB:
  130.     .EQU    0A5H        ; TAB
  131. ZTO:
  132.     .EQU    0A6H        ; TO
  133. ZFN:
  134.     .EQU    0A7H        ; FN
  135. ZSPC:
  136.     .EQU    0A8H        ; SPC
  137. ZTHEN:
  138.     .EQU    0A9H        ; THEN
  139. ZNOT:
  140.     .EQU    0AAH        ; NOT
  141. ZSTEP:
  142.     .EQU    0ABH        ; STEP
  143. ZPLUS:
  144.     .EQU    0ACH        ; +
  145. ZMINUS:
  146.     .EQU    0ADH        ; -
  147. ZTIMES:
  148.     .EQU    0AEH        ; *
  149. ZDIV:
  150.     .EQU    0AFH        ; /
  151. ZOR:
  152.     .EQU    0B2H        ; OR
  153. ZGTR:
  154.     .EQU    0B3H        ; >
  155. ZEQUAL:
  156.     .EQU    0B4H        ; M
  157. ZLTH:
  158.     .EQU    0B5H        ; <
  159. ZSGN:
  160.     .EQU    0B6H        ; SGN
  161. ZPOINT:
  162.     .EQU    0C7H        ; POINT
  163. ZLEFT:
  164.     .EQU    0CDH        ; LEFT$
  165. ;------------------------------------------------------------------------------
  166. ; BASIC WORKSPACE LOCATIONS
  167. ;------------------------------------------------------------------------------
  168. WRKSPC:
  169.     .EQU    BASICV      ; $3120, can be relocated dynamically if needed
  170. USR:
  171.     .EQU    BASICV+$03  ; "USR(X)" JUMP, SET INITALLY TO FN ERROR
  172. OUTSUB:
  173.     .EQU    BASICV+$06  ; "OUT P,N"
  174. OTPORT:
  175.     .EQU    BASICV+$07  ; PORT (P)
  176. DIVSUP:
  177.     .EQU    BASICV+$09  ; DIVISION SUPPORT ROUTINE
  178. DIV1:
  179.     .EQU    BASICV+$0A  ; <- VALUES TO
  180. DIV2:
  181.     .EQU    BASICV+$0E  ; <- ADDED
  182. DIV3:
  183.     .EQU    BASICV+$12  ; <- DURING
  184. DIV4:
  185.     .EQU    BASICV+$15  ; <- DIVISION CALC
  186. SEED:
  187.     .EQU    BASICV+$17  ; RANDOM SEED NUMBER
  188. LSTRND:
  189.     .EQU    BASICV+$3A  ; LAST RANDOM NUMBER
  190. INPSUB:
  191.     .EQU    BASICV+$3E  ; "INP(X)" ROUTINE
  192. INPORT:
  193.     .EQU    BASICV+$3F  ; PORT(X)
  194. NULLS:
  195.     .EQU    BASICV+$41  ; NUMBER OF NULLS POS(X) NUMBER
  196. LWIDTH:
  197.     .EQU    BASICV+$42  ; TERMINAL WIDTH
  198. COMMAN:
  199.     .EQU    BASICV+$43  ; WIDTH FOR COMMAS
  200. NULFLG:
  201.     .EQU    BASICV+$44  ; NULL AFTER INPUT BYTE FLAG
  202. CTLOFG:
  203.     .EQU    BASICV+$45  ; CONTROL "O" FLAG OUTPUT ENABLE
  204. LINESC:
  205.     .EQU    BASICV+$46  ; LINES COUNTER
  206. LINESN:
  207.     .EQU    BASICV+$48  ; LINES NUMBER
  208. CHKSUM:
  209.     .EQU    BASICV+$4A  ; ARRAY LOAD/SAVE CHECK SUM
  210. NMIFLG:
  211.     .EQU    BASICV+$4C  ; FLAG FOR NMI BREAK ROUTINE
  212. BRKFLG:
  213.     .EQU    BASICV+$4D  ; BREAK FLAG
  214. CURPOS:
  215.     .EQU    BASICV+$4E  ; CHARACTER POSITION ON LINE
  216. LCRFLG:
  217.     .EQU    BASICV+$4F  ; LOCATE/CREATE FLAG
  218. TYPE:
  219.     .EQU    BASICV+$50  ; DATA TYPE FLAG
  220. DATFLG:
  221.     .EQU    BASICV+$51  ; LITERAL STATEMENT FLAG
  222. FORFLG:
  223.     .EQU    BASICV+$52  ; "FOR" LOOP FLAG
  224. LSTBIN:
  225.     .EQU    BASICV+$53  ; LAST BYTE ENTERED
  226. READFG:
  227.     .EQU    BASICV+$54  ; READ/INPUT FLAG
  228. LINEAT:
  229.     .EQU    BASICV+$55  ; Current line number
  230. MULVAL:
  231.     .EQU    BASICV+$57  ; Multiplier
  232. RAMTOP:
  233.     .EQU    BASICV+$60  ; Physical end of RAM
  234. PROGST:
  235.     .EQU    BASICV+$62  ; START OF BASIC TEXT AREA
  236. STLOOK:
  237.     .EQU    BASICV+$64  ; PROGRAM START + 100 BYTES
  238. FRERAM:
  239.     .EQU    BASICV+$66  ; Calculated ram for BASIC program text
  240. SYSRAM:
  241.     .EQU    BASICV+$68  ; Calculated ram for BASIC text+vars
  242. BASTXT:
  243.     .EQU    BASICV+$6A  ; Pointer to start of program
  244. STRSPC:
  245.     .EQU    BASICV+$6C  ; Bottom of string space in use
  246. PROGND:
  247.     .EQU    BASICV+$6E  ; END OF PROGRAM
  248. VAREND:
  249.     .EQU    BASICV+$70  ; END OF VARIABLES
  250. ARREND:
  251.     .EQU    BASICV+$72  ; END OF ARRAYS
  252. LSTRAM:
  253.     .EQU    BASICV+$74  ; LAST AVAILABLE RAM
  254.  
  255. TMSTPT:
  256.     .EQU    BASICV+$81  ; TEMPORARY STRING POINTER
  257. TMSTPL:
  258.     .EQU    BASICV+$83  ; TEMPORARY STRING POOL
  259. TMPSTR:
  260.     .EQU    BASICV+$8F  ; TEMPORARY STRING
  261. STRBOT:
  262.     .EQU    BASICV+$93  ; BOTTOM OF STRING SPACE
  263. CUROPR:
  264.     .EQU    BASICV+$95  ; CURRENT OPERATOR IN EVAL
  265. LOOPST:
  266.     .EQU    BASICV+$97  ; FIRST STATEMENT OF LOOP
  267. DATLIN:
  268.     .EQU    BASICV+$99  ; LINE OF CURRENT DATA ITEM
  269. BRKLIN:
  270.     .EQU    BASICV+$A6  ; LINE OF BREAK
  271. NXTOPR:
  272.     .EQU    BASICV+$A8  ; NEXT OPERATOR IN EVAL
  273. ERRLIN:
  274.     .EQU    BASICV+$AA  ; LINE OF ERROR
  275. CONTAD:
  276.     .EQU    BASICV+$AC  ; WHERE TO CONTINUE
  277. NXTDAT:
  278.     .EQU    BASICV+$AE  ; NEXT DATA ITEM
  279.  
  280. FNRGNM:
  281.     .EQU    BASICV+$B0  ; NAME OF "FN" ARGUMENT
  282. FNARG:
  283.     .EQU    BASICV+$B2  ; FN ARGUMENT VALUE
  284.  
  285. FPREG:
  286.     .EQU    BASICV+$B6  ; FLOATING POINT REGISTER $B6 $B7 $B8
  287. FPEXP:
  288.     .EQU    BASICV+$B9  ; FLOATING POINT EXPONENT
  289. SGNRES:
  290.     .EQU    BASICV+$BA  ; SIGN OF RESULT
  291. X1POS:
  292.     .EQU    BASICV+$BC  ; X position integer from GETXY
  293. Y1POS:
  294.     .EQU    BASICV+$BE  ; Y position integer from GETXY
  295. INTVECT:
  296.     .EQU    BASICV+$C0  ; Soft configurable INT JP ll hh
  297. NMIVECT:
  298.     .EQU    BASICV+$C3  ; Soft configurable NMI JP ll hh
  299. MACC:
  300.     .EQU    BASICV+$C6  ; For use with Am9511 Mathpak $C6-$C9
  301. SHIFT:
  302.     .EQU    BASICV+$CA  ; Flag to see if shift preceeded key p8279
  303. CURSOR:
  304.     .EQU    BASICV+$CB  ; Cursor location
  305. PBUFF:
  306.     .EQU    BASICV+$D0  ; Numeric Display Print Buff [$31F0-FF]
  307.  
  308.  
  309. BOOT:
  310.     .ORG    $0000  
  311. ;------------------------------------------------------------------------------
  312. ; TX a character over RS232 Channel A [Host], wait for TXDONE first.
  313. ;------------------------------------------------------------------------------
  314. RST00:
  315.     DI          ;Disable INTerrupts
  316.     IM  1       ;INT vectors over to $0038
  317.     JP  HWINIT      ;Initialize Hardware and go
  318.     NOP
  319.     NOP
  320. ;------------------------------------------------------------------------------
  321. ; Output character to video, expanding control codes, etc
  322. ;------------------------------------------------------------------------------
  323. RST08:
  324.     JP  V_CHAR 
  325.     NOP
  326.     NOP
  327.     NOP
  328.     NOP
  329.     NOP
  330. ;------------------------------------------------------------------------------
  331. ;
  332. ;------------------------------------------------------------------------------
  333. RST10:
  334.     .ORG    0010H
  335.     NOP
  336.     NOP
  337.     NOP
  338.     NOP
  339.     NOP
  340.     NOP
  341.     NOP
  342.     NOP
  343. ;------------------------------------------------------------------------------
  344. ;
  345. ;------------------------------------------------------------------------------
  346. RST18:
  347.     .ORG    0018H
  348.     NOP
  349.     NOP
  350.     NOP
  351.     NOP
  352.     NOP
  353.     NOP
  354.     NOP
  355.     NOP
  356. ;------------------------------------------------------------------------------
  357. ;
  358. ;------------------------------------------------------------------------------
  359. RST20:
  360.     .ORG    0020H
  361.     NOP
  362.     NOP
  363.     NOP
  364.     NOP
  365.     NOP
  366.     NOP
  367.     NOP
  368.     NOP
  369. ;------------------------------------------------------------------------------
  370. ; TX a character to the 8279 Display, check 8279 display ready prior to write.
  371. ;------------------------------------------------------------------------------
  372. RST28:
  373.     JP  TX8279      ; Transmit char in A out to 8279
  374.     NOP
  375.     NOP
  376.     NOP
  377.     NOP
  378.     NOP
  379. ;------------------------------------------------------------------------------
  380. ; RX a character from the 8279 Keyboard, hold here until key is in buffer.
  381. ;------------------------------------------------------------------------------
  382. RST30:
  383.     JP  RX8279      ; Wait for char from 8279 keyboard
  384.     NOP
  385.     NOP
  386.     NOP
  387.     NOP
  388.     NOP
  389. ;------------------------------------------------------------------------------
  390. ; RST 38 - INTERRUPT VECTOR [ for IM 1 ]
  391. ;------------------------------------------------------------------------------
  392. RST38:
  393.     JP  INTVECT     ; Software config JP, default WSTART
  394. ;------------------------------------------------------------------------------
  395. ; Print a string message terminated by $00
  396. ;------------------------------------------------------------------------------
  397. PRT:
  398.     LD  A,(HL)      ; Get character
  399.     OR  A       ; Test for zero
  400.     RET Z       ; Return if finished
  401.     RST 08H     ; Print the character in A
  402.     INC HL      ; Point to next character
  403.     JR  PRT     ;  and loop thru until finished
  404. ;------------------------------------------------------------------------------
  405. ; CLear Screen by printing a Form Feed character $0C
  406. ;------------------------------------------------------------------------------
  407. CLS:
  408.     LD  A,CS        ; Form feed
  409.     RST 08H     ; Print it
  410.     RET
  411. ;------------------------------------------------------------------------------
  412. ; Write character to 8279 Display, check for Display Available before write.
  413. ;------------------------------------------------------------------------------
  414. TX8279:
  415.     PUSH    AF      ; Save char and flags
  416.     IN  A,($79)     ; Get 8279 status word
  417.     BIT 7,A     ; D7=Display Unavailable flag
  418.     JR  NZ,TX8279+1 ; Loop here until Display Available
  419.     POP AF      ; Retrieve char and flags
  420.     OUT ($78),A     ; Write char to display
  421.     RET
  422. ;------------------------------------------------------------------------------
  423. ; Wait on 8279 for Keyboard character
  424. ;------------------------------------------------------------------------------
  425. RX8279:
  426.     IN  A,($79)     ; Get p8279 Status
  427.     AND $07     ; 0-7 keys in buffer?
  428.     JR  Z,RX8279        ; No, loop until key
  429.     IN  A,($78)     ; Get the key character and ret
  430.     RET
  431. ;------------------------------------------------------------------------------
  432. ; $0066 - Non-Maskable Interrupt Vector
  433. ;------------------------------------------------------------------------------
  434. NMI:
  435.     .ORG    $0066
  436.     JP  NMIVECT     ; Soft configurable JP default WSTART
  437. ;------------------------------------------------------------------------------
  438. ; B A S I C Cold    Start
  439. ;------------------------------------------------------------------------------
  440. ;------------------------------------------------------------------------------
  441. BASIC:
  442.     .ORG    $0070       ; Start after RST's and NMI vectors
  443. CSTART:
  444.     LD  HL,INITAB       ; Source=Init table
  445.     LD  DE,WRKSPC       ; Dest=Basic Var space in static RAM
  446.     LD  BC,INITX-INITAB ; Number of bytes to copy
  447.     LDIR            ;   Make the move
  448.     LD  HL,INTSRC       ; Get default INT and NMI defaults
  449.     LD  DE,INTVECT  ; Copy them to alterable ram
  450.     LD  BC,$0006        ; 2 JP commands
  451.     LDIR            ;   Make the move
  452. ;------------------------------------------------------------------------------
  453. RAMSTRT:
  454.     LD  HL,RAM+$A20 ;
  455.     LD  (PROGST),HL ; SAVE IT
  456.     LD  (BASTXT),HL ; SAVE IT FOR START OF PROGRAM TEXT
  457.  
  458. RAMTEST:
  459.     LD  HL,RAM+$800 ; Start with beginning of known ram
  460. RAMTEST1:
  461.     LD  A,(HL)
  462.     LD  B,A     ; Temp save it
  463.     CPL         ; Flip the bits
  464.     LD  (HL),A      ; Save it back
  465.     XOR (HL)        ; A XOR (HL)
  466.     LD  (HL),B      ; Save contents back
  467.     JR  NZ,SETTOP
  468.     INC H
  469.     LD  A,VIDBASE&$FF00>>8  ; Stop before video ram 1st page
  470.     CP  H
  471.     JR  NZ,RAMTEST1
  472.    
  473. SETTOP:
  474.     DEC H       ; Back to last known good ram page
  475.     LD  L,$FF       ; HL = $nnFF
  476.  
  477.  
  478.     LD  (RAMTOP),HL ; PHYSICAL TOP OF RAM (WHAT THE HARDWARE HAS)
  479.     LD  (LSTRAM),HL ; LOGICAL   TOP OF RAM (CAN BE CHANGED BY CLEAR)
  480.     LD  DE,$FF38        ; -200 bytes for string space initially
  481.     ADD HL,DE       ; Subtract it from RAMTOP
  482.     LD  (STRSPC),HL ; Save string space (STRSPC=LSTRAM-100)
  483.    
  484.     LD  DE,(PROGST) ; Start of program text space
  485.     DEC DE      ; Account for bottom byte
  486.     OR  A       ; Clear CY flag
  487.     SBC HL,DE       ; Calc area from PROGST to string spc
  488.     LD  (FRERAM),HL ; This is remaining ram for prog txt
  489.    
  490.     LD  HL,(RAM)        ; Start of physical ram
  491.     EX  DE,HL  
  492.     LD  HL,(RAMTOP) ; Get top of physical ram
  493.     DEC DE      ; Account for bottom byte
  494.     OR  A       ; Clear flags
  495.     SBC HL,DE       ; RAMTOP - (RAM+$800) = SYSRAM
  496.     LD  (SYSRAM),HL ; Save it for signon msg
  497. ;------------------------------------------------------------------------------
  498. ; Signon message, retrieve RAM parameters
  499. ;------------------------------------------------------------------------------
  500.     XOR A       ; Clear A   to zero
  501.     LD  (BUFFER),A  ; Mark end of buffer
  502.     LD  HL,(PROGST) ; Locate at start of BASTXT
  503.     LD  (HL),A      ; Initialize BASIC area
  504.     CALL    CLRPTR      ; CLEAR POINTERS AND SET UP PROGRAM AREA
  505.  
  506.     LD  HL,SIGNON       ; Get SIGNON message
  507.     CALL    PRT     ; Clear the screen and print it out
  508.     LD  HL,(SYSRAM) ; Physical memory detected
  509.     CALL    PRNTHL      ; Print number of bytes total
  510.     LD  HL,SRAM     ; " System Ram" message
  511.     CALL    PRT     ; Print the message
  512.     LD  HL,(FRERAM) ; GET BYTES FREE BACK
  513.     CALL    PRNTHL      ; OUTPUT AMOUNT OF FREE MEMORY
  514.     LD  HL,BFREE        ; " Bytes   Free" MESSAGE
  515.     CALL    PRT     ; Print the message
  516. ;------------------------------------------------------------------------------
  517. ;------------------------------------------------------------------------------
  518. ; B A S I C Warm    Start
  519. ;------------------------------------------------------------------------------
  520. ;------------------------------------------------------------------------------
  521. WSTART:
  522.     EI          ; Enable INTerrupts to system
  523. BRKRET:
  524.     CALL    CLREG       ; Clear registers and stack
  525.     JP  PRTRDY      ; Go to get command line
  526.  
  527. BAKSTK:
  528.     LD  HL,4        ; Look for "FOR" block with
  529.     ADD HL,SP       ; same index as specified
  530. LOKFOR:
  531.     LD  A,(HL)      ; Get block ID
  532.     INC HL      ; Point to index address
  533.     CP  ZFOR        ; Is it a "FOR" token
  534.     RET NZ      ; No - exit
  535.     LD  C,(HL)      ; BC = Address of "FOR" index
  536.     INC HL
  537.     LD  B,(HL)
  538.     INC HL      ; Point to sign of STEP
  539.     PUSH    HL      ; Save pointer to sign
  540.     LD  L,C     ; HL = address of "FOR" index
  541.     LD  H,B
  542.     LD  A,D     ; See if an index was specified
  543.     OR  E       ; DE = 0 if no index specified
  544.     EX  DE,HL       ; Specified index into HL
  545.     JR  Z,INDFND    ; Skip if no index given
  546.     EX  DE,HL       ; Index back into DE
  547.     CALL    CPHLDE      ; Compare index with one given
  548. INDFND:
  549.     LD  BC,16-3     ; Offset to next block
  550.     POP HL      ; Restore pointer to sign
  551.     RET Z       ; Return if block found
  552.     ADD HL,BC       ; Point to next block
  553.     JR  LOKFOR      ; Keep on looking
  554.  
  555. MOVUP:
  556.     CALL    ENFMEM      ; See if enough memory
  557. MOVSTR:
  558.     PUSH    BC      ; Save end of source
  559.     EX  (SP),HL     ; Swap source and dest" end
  560.     POP BC      ; Get end of destination
  561. MOVLP:
  562.     CALL    CPHLDE      ; See if list moved
  563.     LD  A,(HL)      ; Get byte
  564.     LD  (BC),A      ; Move it
  565.     RET Z       ; Exit if all done
  566.     DEC BC      ; Next byte to move to
  567.     DEC HL      ; Next byte to move
  568.     JR  MOVLP       ; Loop until all bytes moved
  569. ;------------------------------------------------------------------------------
  570. ; Check variable space "stack" to see if getting near end of available space
  571. ;------------------------------------------------------------------------------
  572. CHKSTK:
  573.     PUSH    HL      ; Save code string address
  574.     LD  HL,(ARREND) ; Lowest free memory
  575.     LD  B,0     ; BC = Number of levels to test
  576.     ADD HL,BC       ; 2 Bytes for each level
  577.     ADD HL,BC
  578.     .BYTE   $3E     ; Skip "PUSH HL"
  579. ;------------------------------------------------------------------------------
  580. ; ENFMEM had to be completely rebuilt to properly check for mem limits
  581. ;------------------------------------------------------------------------------
  582. ENFMEM:
  583.     PUSH    HL      ; Save code string address
  584.     PUSH    DE      ; Use to calc available space
  585.     LD  DE,48       ; 48 Bytes minimum RAM
  586.     ADD HL,DE       ; See if requested address rolls over $FFFF
  587.     JR  C,OMERR     ; Too high for CPU to physically address
  588.  
  589.     LD  DE,(LSTRAM) ; Get physical top of RAM
  590.     EX  DE,HL       ; Swap for subtraction
  591.     SBC HL,DE       ; Subtract RAMTOP-(code string address+50)
  592.     EX  DE,HL       ; Swap code string back to HL
  593.     JR  C,OMERR     ; Requested address is > RAMTOP
  594.  
  595.     LD  HL,$0000    ; Check if SP is about to overrun limits
  596.     ADD HL,SP       ; Move SP into HL
  597.     LD  DE,RAM+4        ; Nearing lowest available stack position
  598.     SBC HL,DE       ; Subtract current SP-RAM
  599.     JR  C,SOERR     ; SP has overrun into BASIC variable table
  600.     JR  Z,SOERR     ; SP is right at bottom of available space
  601.  
  602.     POP DE      ; If requested memory is o.k. then,
  603.     POP HL      ; Restore values and
  604.     RET         ; Return to the calling program
  605. ;------------------------------------------------------------------------------
  606. ;------------------------------------------------------------------------------
  607. ; Error Control
  608. ;------------------------------------------------------------------------------
  609. ;------------------------------------------------------------------------------
  610. DATSNR:
  611.     LD  HL,(DATLIN) ; Get line of current DATA item
  612.     LD  (LINEAT),HL ; Save as current line
  613. SNERR:
  614.     LD  E,SN        ; ?SyNtax Error
  615.     .BYTE   01H     ; Skip "LD E,DZ" using "LD BC,(nnnn)"
  616. DZERR:
  617.     LD  E,DZ        ; ?/0 Error Divide by Zero
  618.     .BYTE   01H     ; Skip "LD E,NF"
  619. NFERR:
  620.     LD  E,NF        ; ?Next without For Error
  621.     .BYTE   01H     ; Skip "LD E,DD"
  622. DDERR:
  623.     LD  E,DD        ; ?DD Error
  624.     .BYTE   01H     ; Skip "LD E,UF"
  625. UFERR:
  626.     LD  E,UF        ; ?Undefined Fn Error
  627.     .BYTE   01H     ; Skip "LD E,OV
  628. OVERR:
  629.     LD  E,OV        ; ?OV Error
  630.     .BYTE   01H     ; Skip "LD E,TM"
  631. TMERR:
  632.     LD  E,TM        ; ?TM Error
  633.     .BYTE   01H     ; Skip "LD E,SO"
  634. SOERR:
  635.     LD  E,SO        ; ?Stack Overflow
  636.     .BYTE   01H     ; Skip "LD E,OM"
  637. OMERR:
  638.     LD  E,OM        ; Error - Out of Memory
  639.     .BYTE   01H     ; Skip "LE E,HX"
  640. HXERR:
  641.     LD  E,HX        ; Error - Not valid HEX value
  642. ;------------------------------------------------------------------------------
  643. ERROR:
  644.     CALL    CLREG       ; Clear registers and stack
  645.     LD  (CTLOFG),A  ; Enable output (A is 0)
  646.     CALL    STTLIN      ; Start new line
  647.     LD  HL,ERRORS   ; Point to error codes
  648.     LD  D,A     ; D = 0 (A is 0)
  649.     LD  A,'?'
  650.     CALL    OUTC        ; Output "?"
  651.     LD  A,SPC       ; <SPACE>
  652.     CALL    OUTC        ; Output space
  653. ERROR0:
  654.     LD  A,(HL)      ; Get character in error table
  655.     CP  E       ; Arrived at correct msg?
  656.     INC HL      ; Next location
  657.     JR  NZ,ERROR0   ; Seek until correct msg found
  658.     CALL    PRS     ; Output message
  659.     LD  HL,ERRMSG   ; " Error" text
  660. ERRIN:
  661.     CALL    PRS     ; Output message
  662.     LD  HL,(LINEAT) ; Get line of error
  663.     LD  DE,-2       ; Cold start error if -2
  664.     CALL    CPHLDE      ; See if cold start error
  665.     JP  Z,CSTART    ; Cold start error - Restart
  666.     LD  A,H     ; Was it a direct error?
  667.     AND L       ; Line = -1 if direct error
  668.     INC A
  669.     CALL    NZ,LINEIN   ; No - output line of error
  670.     .BYTE   $3E     ; Skip "POP BC"
  671. POPNOK:
  672.     POP BC      ; Drop address in input buffer
  673. ;------------------------------------------------------------------------------
  674. ; READY
  675. ;------------------------------------------------------------------------------
  676. PRTRDY:
  677.     XOR A       ; Output "Ok" and get command
  678.     LD  (CTLOFG),A  ; Enable output
  679.     CALL    STTLIN      ; Start new line
  680.     LD  HL,RDYMSG   ; "Ready" message
  681.     CALL    PRS     ; Output "Ready"
  682. GETCMD:
  683.     LD  HL,-1       ; Flag direct mode
  684.     LD  (LINEAT),HL ; Save as current line
  685.     CALL    TTYLIN      ; Get an input line
  686.     JR  C,GETCMD    ; Get line again if break
  687.     CALL    GETCHR      ; Get first character
  688.     INC A       ; Test if end of line
  689.     DEC A       ; Without affecting Carry
  690.     JR  Z,GETCMD    ; Nothing entered - Get another
  691.     PUSH    AF      ; Save Carry status
  692.     CALL    ATOH        ; Get line number into DE
  693.     PUSH    DE      ; Save line number
  694.     CALL    CRUNCH      ; Tokenise rest of line
  695.     LD  B,A     ; Length of tokenised line
  696.     POP DE      ; Restore line number
  697.     POP AF      ; Restore Carry
  698.     JP  NC,EXCUTE   ; No line number - Direct mode
  699.     PUSH    DE      ; Save line number
  700.     PUSH    BC      ; Save length of tokenised line
  701.     XOR A
  702.     LD  (LSTBIN),A  ; Clear last byte input
  703.     CALL    GETCHR      ; Get next character
  704.     OR  A       ; Set flags
  705.     PUSH    AF      ; And save them
  706.     CALL    SRCHLN      ; Search for line number in DE
  707.     JR  C,LINFND    ; Jump if line found
  708.     POP AF      ; Get status
  709.     PUSH    AF      ; And re-save
  710.     JP  Z,ULERR     ; Nothing after number - Error
  711.     OR  A       ; Clear Carry
  712. LINFND:
  713.     PUSH    BC      ; Save address of line in prog
  714.     JR  NC,INEWLN   ; Line not found - Insert new
  715.     EX  DE,HL       ; Next line address in DE
  716.     LD  HL,(PROGND) ; End of program
  717. SFTPRG:
  718.     LD  A,(DE)      ; Shift rest of program down
  719.     LD  (BC),A
  720.     INC BC      ; Next destination
  721.     INC DE      ; Next source
  722.     CALL    CPHLDE      ; All done?
  723.     JR  NZ,SFTPRG   ; More to do
  724.     LD  H,B     ; HL - New end of program
  725.     LD  L,C
  726.     LD  (PROGND),HL ; Update end of program
  727. ;------------------------------------------------------------------------------
  728. ; Insert new line into BASIC program
  729. ;------------------------------------------------------------------------------
  730. INEWLN:
  731.     POP DE      ; Get address of line,
  732.     POP AF      ; Get status
  733.     JR  Z,SETPTR    ; No text - Set up pointers
  734.     LD  HL,(PROGND) ; Get end of program
  735.     EX  (SP),HL     ; Get length of input line
  736.     POP BC      ; End of program to BC
  737.     ADD HL,BC       ; Find new end
  738.     PUSH    HL      ; Save new end
  739.     CALL    MOVUP       ; Make space for line
  740.     POP HL      ; Restore new end
  741.     LD  (PROGND),HL ; Update end of program pointer
  742.     EX  DE,HL       ; Get line to move up in HL
  743.     LD  (HL),H      ; Save MSB
  744.     POP DE      ; Get new line number
  745.     INC HL      ; Skip pointer
  746.     INC HL
  747.     LD  (HL),E      ; Save LSB of line number
  748.     INC HL
  749.     LD  (HL),D      ; Save MSB of line number
  750.     INC HL      ; To first byte in line
  751.     LD  DE,BUFFER   ; Copy buffer to program
  752. MOVBUF:
  753.     LD  A,(DE)      ; Get source
  754.     LD  (HL),A      ; Save destinations
  755.     INC HL      ; Next source
  756.     INC DE      ; Next destination
  757.     OR  A       ; Done?
  758.     JR  NZ,MOVBUF   ; No - Repeat
  759. SETPTR:
  760.     CALL    RUNFST      ; Set line pointers
  761.     INC HL      ; To LSB of pointer
  762.     EX  DE,HL       ; Address to DE
  763. PTRLP:
  764.     LD  H,D     ; Address to HL
  765.     LD  L,E
  766.     LD  A,(HL)      ; Get LSB of pointer
  767.     INC HL      ; To MSB of pointer
  768.     OR  (HL)        ; Compare with MSB pointer
  769.     JP  Z,GETCMD    ; Get command line if end
  770.     INC HL      ; To LSB of line number
  771.     INC HL      ; Skip line number
  772.     INC HL      ; Point to first byte in line
  773.     XOR A       ; Looking for 00 byte
  774. FNDEND:
  775.     CP  (HL)        ; Found end of line?
  776.     INC HL      ; Move to next byte
  777.     JR  NZ,FNDEND   ; No - Keep looking
  778.     EX  DE,HL       ; Next line address to HL
  779.     LD  (HL),E      ; Save LSB of pointer
  780.     INC HL
  781.     LD  (HL),D      ; Save MSB of pointer
  782.     JR  PTRLP       ; Do next line
  783. ;------------------------------------------------------------------------------
  784. ; Search for a particular Line Number (DE) in BASIC program text
  785. ; Z =DE line number is found, or DE is at end of program, and DE > largest no.
  786. ; NC=DE line number not found and HL has found a line with number > DE
  787. ;------------------------------------------------------------------------------
  788. SRCHLN:
  789.     LD  HL,(BASTXT) ; Start of program text
  790. SRCHLP:
  791.     LD  B,H     ; BC = Address to look at
  792.     LD  C,L
  793.     LD  A,(HL)      ; Get address of next line
  794.     INC HL
  795.     OR  (HL)        ; Two "00"s, End of program found?
  796.     DEC HL
  797.     RET Z       ; Yes - Line not found
  798.     INC HL
  799.     INC HL
  800.     LD  A,(HL)      ; Get LSB of line number
  801.     INC HL
  802.     LD  H,(HL)      ; Get MSB of line number
  803.     LD  L,A
  804.     CALL    CPHLDE      ; Compare with line in DE
  805.     LD  H,B     ; HL = Start of this line
  806.     LD  L,C
  807.     LD  A,(HL)      ; Get LSB of next line address
  808.     INC HL
  809.     LD  H,(HL)      ; Get MSB of next line address
  810.     LD  L,A     ; Next line to HL
  811.     CCF
  812.     RET Z       ; Lines found - Exit
  813.     CCF
  814.     RET NC      ; Line not found, at line after line # in DE
  815.     JR  SRCHLP      ; Keep looking
  816. ;------------------------------------------------------------------------------
  817. ; NEW
  818. ;------------------------------------------------------------------------------
  819. NEW:
  820.     RET NZ      ; Return if any more on line
  821. CLRPTR:
  822.     LD  HL,(BASTXT) ; Point to start of program
  823.     XOR A       ; Set program area to empty
  824.     LD  (HL),A      ; Save LSB = 00
  825.     INC HL
  826.     LD  (HL),A      ; Save MSB = 00
  827.     INC HL
  828.     LD  (HL),A      ; Mark end of program
  829.     LD  (PROGND),HL ; Set program end in variables
  830.  
  831. RUNFST:
  832.     LD  HL,(BASTXT) ; Clear all variables
  833.     DEC HL
  834.  
  835. INTVAR:
  836.     LD  (BRKLIN),HL ; Initialise RUN variables
  837.     LD  HL,(LSTRAM) ; Get end of RAM
  838.     LD  (STRBOT),HL ; Clear string space
  839.     XOR A
  840.     CALL    RESTOR      ; Reset DATA pointers
  841.     LD  HL,(PROGND) ; Get end of program
  842.     LD  (VAREND),HL ; Clear variables
  843.     LD  (ARREND),HL ; Clear arrays
  844.  
  845. CLREG:
  846.     POP BC      ; Save return address
  847.     LD  SP,STACK    ; Set stack
  848.     LD  HL,TMSTPL   ; Temporary string pool
  849.     LD  (TMSTPT),HL ; Reset temporary string ptr
  850.     XOR A       ; A = 00
  851.     LD  L,A     ; HL = 0000
  852.     LD  H,A
  853.     LD  (CONTAD),HL ; No CONTinue
  854.     LD  (FORFLG),A  ; Clear FOR flag
  855.     LD  (FNRGNM),HL ; Clear FN argument
  856.     PUSH    HL      ; HL = 0000
  857.     PUSH    BC      ; Put back return
  858. DOAGN:
  859.     LD  HL,(BRKLIN) ; Get address of code to RUN
  860.     RET         ; Return to execution driver
  861. ;------------------------------------------------------------------------------
  862. ; Prompt for input
  863. ;------------------------------------------------------------------------------
  864. PROMPT:
  865.     LD  A,'?'       ; "?"
  866.     CALL    OUTC        ; Output character
  867.     LD  A,SPC       ; Space
  868.     CALL    OUTC        ; Output character
  869.     JP  TTYLIN      ; This was formerly RINPUT vector XRINPUT
  870. ;------------------------------------------------------------------------------
  871. ; CRUNCH converts and tokenizes the line of text at HL into the BUFFER at DE
  872. ; Called by GETCMD shortly after TTYLIN
  873. ;------------------------------------------------------------------------------
  874. CRUNCH:
  875.     XOR A       ; Tokenise line @ HL to BUFFER
  876.     LD  (DATFLG),A  ; Reset literal flag
  877.     LD  C,2+3       ; 2 byte number and 3 nulls
  878.     LD  DE,BUFFER   ; Start of input buffer
  879. CRNCLP:
  880.     LD  A,(HL)      ; Get byte
  881.     CP  SPC     ; Is it a space?
  882.     JR  Z,MOVDIR    ; Yes - Copy direct
  883.     LD  B,A     ; Save character
  884.     CP  $22     ; Is it a quote?
  885.     JP  Z,CPYLIT    ; Yes - Copy literal string
  886.     OR  A       ; Is it end of buffer?
  887.     JP  Z,EN.BYTEUF ; Yes - End buffer
  888.     LD  A,(DATFLG)  ; Get data type
  889.     OR  A       ; Literal?
  890.     LD  A,(HL)      ; Get byte to copy
  891.     JR  NZ,MOVDIR   ; Literal - Copy direct
  892.     CP  '?'     ; Is it "?" short for PRINT
  893.     LD  A,ZPRINT    ; "PRINT" token
  894.     JR  Z,MOVDIR    ; Yes - replace it
  895.     LD  A,(HL)      ; Get byte again
  896.     CP  '0'     ; Is it less than "0"
  897.     JR  C,FNDWRD    ; Yes - Look for reserved words
  898.     CP  $3C     ; Is it "0123456789:;" ?
  899.     JR  C,MOVDIR    ; Yes - copy it direct
  900. FNDWRD:
  901.     PUSH    DE      ; Look for reserved words
  902.     LD  DE,WORDS-1  ; Point to WORDS table
  903.     PUSH    BC      ; Save count
  904.     LD  BC,RETNAD   ; Where to return to
  905.     PUSH    BC      ; Save return address
  906.     LD  B,ZEND-1    ; First token value -1
  907.     LD  A,(HL)      ; Get byte
  908.     CP  'a'     ; Less than "a" ?
  909.     JR  C,SEARCH    ; Yes - search for words
  910.     CP  'z'+1       ; Greater than "z" ?
  911.     JR  NC,SEARCH   ; Yes - search for words
  912.     AND 01011111B   ; Force upper case
  913.     LD  (HL),A      ; Replace byte
  914. SEARCH:
  915.     LD  C,(HL)      ; Search for a word
  916.     EX  DE,HL
  917. GETNXT:
  918.     INC HL      ; Get next reserved word
  919.     OR  (HL)        ; Start of word?
  920.     JP  P,GETNXT    ; D7? No - move on
  921.     INC B       ; Increment token value
  922.     LD  A,(HL)      ; Get byte from table
  923.     AND 01111111B   ; Strip bit 7
  924.     RET Z       ; Return if end of list
  925.     CP  C       ; Same character as in buffer?
  926.     JR  NZ,GETNXT   ; No - get next word
  927.     EX  DE,HL
  928.     PUSH    HL      ; Save start of word
  929.  
  930. NXTBYT:
  931.     INC DE      ; Look through rest of word
  932.     LD  A,(DE)      ; Get byte from table
  933.     OR  A       ; End of word ?
  934.     JP  M,MATCH     ; Yes - Match found
  935.     LD  C,A     ; Save it
  936.     LD  A,B     ; Get token value
  937.     CP  ZGOTO       ; Is it "GOTO" token ?
  938.     JR  NZ,NOSPC    ; No - Don't allow spaces
  939.     CALL    GETCHR      ; Get next character
  940.     DEC HL      ; Cancel increment from GETCHR
  941. NOSPC:
  942.     INC HL      ; Next byte
  943.     LD  A,(HL)      ; Get byte
  944.     CP  'a'     ; Less than "a" ?
  945.     JR  C,NOCHNG    ; Yes - don't change
  946.     AND 01011111B   ; Make upper case
  947. NOCHNG:
  948.     CP  C       ; Same as in buffer ?
  949.     JR  Z,NXTBYT    ; Yes - keep testing
  950.     POP HL      ; Get back start of word
  951.     JR  SEARCH      ; Look at next word
  952.  
  953. MATCH:
  954.     LD  C,B     ; Word found - Save token value
  955.     POP AF      ; Throw away return
  956.     EX  DE,HL
  957.     RET         ; Return to "RETNAD"
  958. RETNAD:
  959.     EX  DE,HL       ; Get address in string
  960.     LD  A,C     ; Get token value
  961.     POP BC      ; Restore buffer length
  962.     POP DE      ; Get destination address
  963. MOVDIR:
  964.     INC HL      ; Next source in buffer
  965.     LD  (DE),A      ; Put byte in buffer
  966.     INC DE      ; Move up buffer
  967.     INC C       ; Increment length of buffer
  968.     SUB $3A     ; End of statement ":" ?
  969.     JR  Z,SETLIT    ; Jump if multi-statement line
  970.     CP  ZDATA-3AH   ; Is it DATA statement ?
  971.     JR  NZ,TSTREM   ; No - see if REM
  972. SETLIT:
  973.     LD  (DATFLG),A  ; Set literal flag
  974. TSTREM:
  975.     SUB ZREM-3AH    ; Is it REM?
  976.     JP  NZ,CRNCLP   ; No - Leave flag
  977.     LD  B,A     ; Copy rest of buffer
  978. NXTCHR:
  979.     LD  A,(HL)      ; Get byte
  980.     OR  A       ; End of line ?
  981.     JR  Z,EN.BYTEUF ; Yes - Terminate buffer
  982.     CP  B       ; End of statement ?
  983.     JR  Z,MOVDIR    ; Yes - Get next one
  984. CPYLIT:
  985.     INC HL      ; Move up source string
  986.     LD  (DE),A      ; Save in destination
  987.     INC C       ; Increment length
  988.     INC DE      ; Move up destination
  989.     JR  NXTCHR      ; Repeat
  990.  
  991. EN.BYTEUF:
  992.     LD  HL,BUFFER-1 ; Point to start of buffer
  993.     LD  (DE),A      ; Mark end of buffer (A = 00)
  994.     INC DE
  995.     LD  (DE),A      ; A = 00
  996.     INC DE
  997.     LD  (DE),A      ; A = 00
  998.     RET
  999.  
  1000. DODEL:
  1001.     DEC B       ; Decrement length
  1002.     JR  Z,TTYLIN        ; Get line again if empty
  1003.     .BYTE   $3E     ; Skip "DEC B"
  1004.    
  1005. ECHDEL:
  1006.     DEC B       ; Count bytes in buffer
  1007.     DEC HL      ; Back space buffer
  1008.     JR  Z,OTKLN     ; No buffer - Try again
  1009.     LD  A,(HL)      ; Get deleted byte
  1010.     CALL    OUTC        ; Echo it
  1011.     JR  MORINP      ; Get more input
  1012.  
  1013. DELCHR:
  1014.     DEC B       ; Count bytes in buffer
  1015.     DEC HL      ; Back space buffer
  1016.     CALL    OUTC        ; Output character in A
  1017.     JR  NZ,MORINP   ; Not end - Get more
  1018. OTKLN:
  1019.     CALL    OUTC        ; Output character in A
  1020. KILIN:
  1021.     CALL    PRNTCR      ; Output CRLF
  1022. ;------------------------------------------------------------------------------
  1023. ; Get a line from TTY into INBUFF, located in register HL
  1024. ;   This code was changed to stop overlapping in BUFFER during CRUNCH
  1025. ;------------------------------------------------------------------------------
  1026. TTYLIN:
  1027.     LD  HL,INBUFF   ; Get a line by character
  1028.     LD  B,1     ; Set buffer as empty
  1029.     LD  A,CR
  1030.     RST 08H
  1031.     LD  A,'>'
  1032.     RST 08H
  1033. MORINP:
  1034.     CALL    INKEY       ; Get character
  1035.     LD  C,A     ; Save character in C
  1036.     CP  BKSP        ; Delete character?
  1037.     JR  Z,DODEL     ; Yes - Process it
  1038. PROCES:
  1039.     LD  A,C     ; Get character
  1040.     CP  CTRLG       ; <CTRL-G> Bell?
  1041.     JR  Z,PUTCTL    ; Yes - Save it
  1042.     CP  BREAK       ; Is it <BREAK> ?
  1043.     CALL    Z,PRNTCR    ; Yes - Output CRLF
  1044.     SCF         ; Flag break
  1045.     RET Z       ; Return if <CTRL-C>
  1046.     CP  CR      ; Is it <Enter> key?
  1047.     JP  Z,TENDIN    ; Yes - Terminate input
  1048.     CP  CLR     ; Is it "CLEAR" <Kill line>?
  1049.     JR  Z,OTKLN     ; Yes - Kill line
  1050.     CP  BKSP        ; Is it <Backspace>?
  1051.     JR  Z,DELCHR    ; Yes - Delete character
  1052.     JR  PUTBUF      ; Regular character, put it in buffer
  1053.    
  1054. TENDIN:
  1055.     LD  (HL),0      ; Terminate buffer end
  1056.     LD  HL,INBUFF-1 ; Reset pointer
  1057.     JP  PRNTCR      ; Print CRLF and do nulls, RETurn  
  1058. ;------------------------------------------------------------------------------
  1059. ; BUFFER
  1060. ;------------------------------------------------------------------------------
  1061. PUTBUF:
  1062.     CP  SPC     ; Is it a control code?
  1063.     JR  C,MORINP    ; Yes - Ignore
  1064. PUTCTL:
  1065.     LD  A,B     ; Get number of bytes in buffer
  1066.     CP  81      ; Test for line overflow
  1067.     LD  A,CTRLG     ; Set a bell
  1068.     JR  NC,OUTNBS   ; Ring bell if buffer full
  1069.     LD  A,C     ; Get character
  1070.     LD  (HL),C      ; Save in buffer
  1071.     LD  (LSTBIN),A  ; Save last input byte
  1072.     INC HL      ; Move up buffer
  1073.     INC B       ; Increment length
  1074. OUTIT:
  1075.     CALL    OUTC        ; Output the character entered
  1076.     JR  MORINP      ; Get another character
  1077.  
  1078. OUTNBS:
  1079.     CALL    OUTC        ; Output bell and back over it
  1080.     LD  A,BKSP      ; Set back space
  1081.     JR  OUTIT       ; Output it and get more
  1082. ;------------------------------------------------------------------------------
  1083. CPHLDE:
  1084.     LD  A,H     ; Get H
  1085.     SUB D       ; Compare with D
  1086.     RET NZ      ; Different - Exit
  1087.     LD  A,L     ; Get L
  1088.     SUB E       ; Compare with E
  1089.     RET         ; Return status
  1090. ;------------------------------------------------------------------------------
  1091. CHKSYN:
  1092.     LD  A,(HL)      ; Check syntax of character
  1093.     EX  (SP),HL     ; Address of test byte
  1094.     CP  (HL)        ; Same as in code string?
  1095.     INC HL      ; Return address
  1096.     EX  (SP),HL     ; Put it back
  1097.     JP  Z,GETCHR        ; Yes - Get next character
  1098.     JP  SNERR       ; Different - ?SN Error
  1099. ;------------------------------------------------------------------------------
  1100. ; LIST Command
  1101. ;------------------------------------------------------------------------------
  1102. LIST:
  1103.     CALL    ATOH        ; ASCII number to DE
  1104.     RET NZ      ; Return if anything extra
  1105.     POP BC      ; Rubbish - Not needed
  1106.     CALL    SRCHLN      ; Search for line number in DE
  1107.     PUSH    BC      ; Save address of line
  1108.     CALL    SETLIN      ; Set up lines counter
  1109. LISTLP:
  1110.     POP HL      ; Restore address of line
  1111.     LD  C,(HL)      ; Get LSB of next line
  1112.     INC HL
  1113.     LD  B,(HL)      ; Get MSB of next line
  1114.     INC HL
  1115.     LD  A,B     ; BC = 0 (End of program)?
  1116.     OR  C
  1117.     JP  Z,PRTRDY    ; Yes - Go to command mode
  1118.     CALL    COUNT       ; Count lines <deleted TSTBRK from next line>
  1119.  
  1120.     IN  A,($79)     ; Check for key down
  1121.     AND $07
  1122.     JR  NZ,LISTB    ; No p8279 keydown
  1123.     CALL    INKEY       ; Find out what key it is
  1124.     JR  LISTB       ; Process it
  1125.  
  1126. LISTA:
  1127.     CP  BREAK       ; <BREAK>
  1128.     JR  Z,RSLNBK    ; Yes, break
  1129.     CP  CTRLS       ; Stop scrolling?  
  1130.     CALL    Z,STALL     ; Stall, or continue if no stall
  1131.  
  1132. LISTB:
  1133.     PUSH    BC      ; Save address of next line
  1134.     CALL    PRNTCR      ; Output CRLF
  1135.     LD  E,(HL)      ; Get LSB of line number
  1136.     INC HL
  1137.     LD  D,(HL)      ; Get MSB of line number
  1138.     INC HL
  1139.     PUSH    HL      ; Save address of line start
  1140.     EX  DE,HL       ; Line number to HL
  1141.     CALL    PRNTHL      ; Output line number in decimal
  1142.     LD  A,SPC       ; Space after line number
  1143.     POP HL      ; Restore start of line address
  1144. LSTLP2:
  1145.     CALL    OUTC        ; Output character in A
  1146. LSTLP3:
  1147.     LD  A,(HL)      ; Get next byte in line
  1148.     OR  A       ; End of line?
  1149.     INC HL      ; To next byte in line
  1150.     JR  Z,LISTLP    ; Yes - get next line
  1151.     JP  P,LSTLP2    ; No token - output it
  1152.     SUB ZEND-1      ; Find and output word
  1153.     LD  C,A     ; Token offset+1 to C
  1154.     LD  DE,WORDS    ; Reserved word list
  1155. FNDTOK:
  1156.     LD  A,(DE)      ; Get character in list
  1157.     INC DE      ; Move on to next
  1158.     OR  A       ; Is it start of word?
  1159.     JP  P,FNDTOK    ; No - Keep looking for word
  1160.     DEC C       ; Count words
  1161.     JR  NZ,FNDTOK   ; Not there - keep looking
  1162. OUTWRD:
  1163.     AND 01111111B   ; Strip bit 7
  1164.     CALL    OUTC        ; Output first character
  1165.     LD  A,(DE)      ; Get next character
  1166.     INC DE      ; Move on to next
  1167.     OR  A       ; Is it end of word?
  1168.     JP  P,OUTWRD    ; No - output the rest
  1169.     JR  LSTLP3      ; Next byte in line
  1170.  
  1171. SETLIN:
  1172.     PUSH    HL      ; Set up LINES counter
  1173.     LD  HL,(LINESN) ; Get LINES number
  1174.     LD  (LINESC),HL ; Save in LINES counter
  1175.     POP HL
  1176.     RET
  1177.  
  1178. COUNT:
  1179.     PUSH    HL      ; Save code string address
  1180.     PUSH    DE
  1181.     LD  HL,(LINESC) ; Get LINES counter
  1182.     LD  DE,-1
  1183.     ADC HL,DE       ; Decrement
  1184.     LD  (LINESC),HL ; Put it back
  1185.     POP DE
  1186.     POP HL      ; Restore code string address
  1187.     RET P       ; Return if more lines to go
  1188.    
  1189.     CALL    WAITCR      ; Wait for <ENTER> before continuing
  1190.    
  1191.     PUSH    HL      ; Save code string address
  1192.     LD  HL,(LINESN) ; Get LINES number
  1193.     LD  (LINESC),HL ; Reset LINES counter
  1194.     POP HL      ; Restore code string address
  1195.     JR  COUNT       ; Keep on counting
  1196.  
  1197. RSLNBK:
  1198.     LD  HL,(LINESN) ; Get LINES number
  1199.     LD  (LINESC),HL ; Reset LINES counter
  1200.     JP  BRKRET      ; Go and output "Break"
  1201. ;------------------------------------------------------------------------------
  1202. ; FOR
  1203. ;------------------------------------------------------------------------------
  1204. FOR:
  1205.     LD  A,64H       ; Flag "FOR" assignment
  1206.     LD  (FORFLG),A  ; Save "FOR" flag
  1207.     CALL    LET     ; Set up initial index
  1208.     POP BC      ; Drop RETurn address
  1209.     PUSH    HL      ; Save code string address
  1210.     CALL    DATA        ; Get next statement address
  1211.     LD  (LOOPST),HL ; Save it for start of lo6p
  1212.     LD  HL,2        ; Offset for "FOR" block
  1213.     ADD HL,SP       ; Point to it
  1214. FORSLP:
  1215.     CALL    LOKFOR      ; Look for existing "FOR" block
  1216.     POP DE      ; Get code string address
  1217.     JR  NZ,FORFND   ; No nesting found
  1218.     ADD HL,BC       ; Move into "FOR" block
  1219.     PUSH    DE      ; Save code string address
  1220.     DEC HL
  1221.     LD  D,(HL)      ; Get MSB of loop statement
  1222.     DEC HL
  1223.     LD  E,(HL)      ; Get LSB of loop statement
  1224.     INC HL
  1225.     INC HL
  1226.     PUSH    HL      ; Save block address
  1227.     LD  HL,(LOOPST) ; Get address of loop statement
  1228.     CALL    CPHLDE      ; Compare the FOR loops
  1229.     POP HL      ; Restore block address
  1230.     JR  NZ,FORSLP   ; Different FORs - Find another
  1231.     POP DE      ; Restore code string address
  1232.     LD  SP,HL       ; Remove all nested loops
  1233.  
  1234. FORFND:
  1235.     EX  DE,HL       ; Code string address to HL
  1236.     LD  C,8
  1237.     CALL    CHKSTK      ; Check for 8 levels of stack
  1238.     PUSH    HL      ; Save code string address
  1239.     LD  HL,(LOOPST) ; Get first statement of loop
  1240.     EX  (SP),HL     ; Save and restore code string
  1241.     PUSH    HL      ; Re-save code string address
  1242.     LD  HL,(LINEAT) ; Get current line number
  1243.     EX  (SP),HL     ; Save and restore code string
  1244.     CALL    TSTNUM      ; Make sure it's a number
  1245.     CALL    CHKSYN      ; Make sure "TO" is next
  1246.     .BYTE   ZTO     ; "TO" token
  1247.     CALL    GETNUM      ; Get "TO" expression value
  1248.     PUSH    HL      ; Save code string address
  1249.     CALL    BCDEFP      ; Move "TO" value to BCDE
  1250.     POP HL      ; Restore code string address
  1251.     PUSH    BC      ; Save "TO" value in block
  1252.     PUSH    DE
  1253.     LD  BC,8100H    ; BCDE - 1 (default STEP)
  1254.     LD  D,C     ; C=0
  1255.     LD  E,D     ; D=0
  1256.     LD  A,(HL)      ; Get next byte in code string
  1257.     CP  ZSTEP       ; See if "STEP" is stated
  1258.     LD  A,1     ; Sign of step = 1
  1259.     JR  NZ,SAVSTP       ; No STEP given - Default to 1
  1260.     CALL    GETCHR      ; Jump over "STEP" token
  1261.     CALL    GETNUM      ; Get step value
  1262.     PUSH    HL      ; Save code string address
  1263.     CALL    BCDEFP      ; Move STEP to BCDE
  1264.     CALL    TSTSGN      ; Test sign of FPREG
  1265.     POP HL      ; Restore code string address
  1266. SAVSTP:
  1267.     PUSH    BC      ; Save the STEP value in block
  1268.     PUSH    DE
  1269.     PUSH    AF      ; Save sign of STEP
  1270.     INC SP      ; Don't save flags
  1271.     PUSH    HL      ; Save code string address
  1272.     LD  HL,(BRKLIN) ; Get address of index variable
  1273.     EX  (SP),HL     ; Save and restore code string
  1274. PUTFID:
  1275.     LD  B,ZFOR      ; "FOR" block marker
  1276.     PUSH    BC      ; Save it
  1277.     INC SP      ; Don't save C
  1278. ;------------------------------------------------------------------------------
  1279. ; RUNCNT executes the line of BASIC program at (HL) until (HL)=$00
  1280. ;------------------------------------------------------------------------------
  1281. RUNCNT:
  1282.     CALL    TSTBRK      ; Execution driver - Test break
  1283.     LD  (BRKLIN),HL ; Save code address for break
  1284.     LD  A,(HL)      ; Get next byte in code string
  1285.     CP  $3A     ; Multi statement line ":" ?
  1286.     JR  Z,EXCUTE    ; Yes - Execute it
  1287.     OR  A       ; End of line?
  1288.     JP  NZ,SNERR    ; No - Syntax error
  1289.     INC HL      ; Point to address of next line
  1290.     LD  A,(HL)      ; Get LSB of line pointer
  1291.     INC HL
  1292.     OR  (HL)        ; Is it zero (End of prog)?
  1293.     JP  Z,ENDPRG    ; Yes - Terminate execution
  1294.     INC HL      ; Point to line number
  1295.     LD  E,(HL)      ; Get LSB of line number
  1296.     INC HL
  1297.     LD  D,(HL)      ; Get MSB of line number
  1298.     EX  DE,HL       ; Line number to HL
  1299.     LD  (LINEAT),HL ; Save as current line number
  1300.     EX  DE,HL       ; Line number back to DE
  1301. EXCUTE:
  1302.     CALL    GETCHR      ; Get key word
  1303.     LD  DE,RUNCNT   ; Where to RETurn to
  1304.     PUSH    DE      ; Save for RETurn
  1305. IFJMP:
  1306.     RET Z       ; Go to RUNCNT if end of STMT
  1307. ONJMP:
  1308.     SUB ZEND        ; Is it a token?
  1309.     JP  C,LET       ; No - try to assign it
  1310.     CP  ZNEW+1-ZEND ; END to NEW ?
  1311.     JP  NC,SNERR    ; Not a key word - ?SN Error
  1312.     RLCA            ; Double it
  1313.     LD  C,A     ; BC = Offset into table
  1314.     LD  B,0
  1315.     EX  DE,HL       ; Save code string address
  1316.     LD  HL,WORDTB   ; Keyword address table
  1317.     ADD HL,BC       ; Point to routine address
  1318.     LD  C,(HL)      ; Get LSB of routine address
  1319.     INC HL
  1320.     LD  B,(HL)      ; Get MSB of routine address
  1321.     PUSH    BC      ; Save routine address
  1322.     EX  DE,HL       ; Restore code string address
  1323. ;------------------------------------------------------------------------------
  1324. ; Gets a character from (HL) checks for ASCII numbers
  1325. ;   RETURNS:
  1326.     Char A
  1327. ;   NC if char is ;<=>?@ A-z
  1328. ;   CY is set if 0-9
  1329. ;------------------------------------------------------------------------------
  1330. GETCHR:
  1331.     INC HL      ; Point to next character
  1332.     LD  A,(HL)      ; Get next code string byte
  1333.     CP  $3A     ; Z if ":", RETurn if alpha
  1334.     RET NC      ; NC if > "9"
  1335.     CP  SPC     ; Is it a space
  1336.     JR  Z,GETCHR    ; Skip over and get next
  1337.     CP  $30     ; "0"
  1338.     CCF         ; NC if < "0" (i.e. "*", CY set if 0 thru 9
  1339.     INC A       ; Test for zero without disturbing CY
  1340.     DEC A       ; Z if Null character $00
  1341.     RET
  1342. ;------------------------------------------------------------------------------
  1343. ; Convert "$nnnn" to FPREG
  1344. ; Gets a character from (HL) checks for Hexadecimal ASCII numbers "$nnnn"
  1345. ; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9
  1346. ;------------------------------------------------------------------------------
  1347. HEXTFP  EX  DE,HL       ; Move code string pointer to DE
  1348.     LD  HL,$0000    ; Zero out the value
  1349.     CALL    GETHEX      ; Check the number for valid hex
  1350.     JP  C,HXERR     ; First value wasn't hex, HX error
  1351.     JR  HEXLP1      ; Convert first character
  1352. HEXLP   CALL    GETHEX      ; Get second and addtional characters
  1353.     JR  C,HEXIT     ; Exit if not a hex character
  1354. HEXLP1  ADD HL,HL       ; Rotate 4 bits to the left
  1355.     ADD HL,HL
  1356.     ADD HL,HL
  1357.     ADD HL,HL
  1358.     OR  L       ; Add in D0-D3 into L
  1359.     LD  L,A     ; Save new value
  1360.     JR  HEXLP       ; And continue until all hex characters are in
  1361.  
  1362. GETHEX  INC DE      ; Next location
  1363.     LD  A,(DE)      ; Load character at pointer
  1364.     SUB $30     ; Get absolute value
  1365.     RET C       ; < "0", error
  1366.     CP  $0A
  1367.     JR  C,NOSUB7    ; Is already in the range 0-9
  1368.     SUB $07     ; Reduce to A-F
  1369.     CP  $0A     ; Value should be $0A-$0F at this point
  1370.     RET C       ; CY set if was : ; < = > ? @
  1371. NOSUB7  CP  $10     ; > Greater than "F"?
  1372.     CCF
  1373.     RET         ; CY set if it wasn't valid hex
  1374.    
  1375. HEXIT   EX  DE,HL       ; Value into DE, Code string into HL
  1376.     LD  A,D     ; Load DE into AC
  1377.     LD  C,E     ; For prep to
  1378.     PUSH    HL
  1379.     CALL    ACPASS      ; ACPASS to set AC as integer into FPREG
  1380.     POP HL
  1381.     RET
  1382. ;------------------------------------------------------------------------------
  1383. ; RESTORE command
  1384. ;------------------------------------------------------------------------------
  1385. RESTOR:
  1386.     EX  DE,HL       ; Save code string address
  1387.     LD  HL,(BASTXT) ; Point to start of program
  1388.     JR  Z,RESTNL    ; Just RESTORE - reset pointer
  1389.     EX  DE,HL       ; Restore code string address
  1390.     CALL    ATOH        ; Get line number to DE
  1391.     PUSH    HL      ; Save code string address
  1392.     CALL    SRCHLN      ; Search for line number in DE
  1393.     LD  H,B     ; HL = Address of line
  1394.     LD  L,C
  1395.     POP DE      ; Restore code string address
  1396.     JP  NC,ULERR    ; ?UL Error if not found
  1397. RESTNL:
  1398.     DEC HL      ; Byte before DATA statement
  1399. UPDATA:
  1400.     LD  (NXTDAT),HL ; Update DATA pointer
  1401.     EX  DE,HL       ; Restore code string address
  1402.     RET
  1403. ;------------------------------------------------------------------------------
  1404. ; Check for BREAK during RUN or LIST, process Scroll Controls <Ctrl-S>,<Ctrl-Q>
  1405. ;------------------------------------------------------------------------------
  1406. TSTBRK:
  1407.     IN  A,($79)
  1408.     AND $07
  1409.     RET Z       ; No keyboard key, continue
  1410.     CALL    INKEY       ; Get the key
  1411.    
  1412.     CP  BREAK       ; <BREAK> key?
  1413.     JR  Z,BRK       ; Yes, break
  1414.     CP  CTRLS       ; Stop scrolling?  
  1415.     RET NZ      ; Other key, ignore
  1416.    
  1417. STALL:
  1418.     CALL    INKEY       ; Wait for key
  1419.     CP  CTRLQ       ; Resume scrolling?
  1420.     RET Z       ; Release the chokehold
  1421.     CP  BREAK       ; Second break?
  1422.     JR  Z,STOP      ; Break during hold exits prog
  1423.     JR  STALL       ; Loop until <down arrow> or <BREAK>
  1424.  
  1425. BRK:
  1426.     LD  A,$FF       ; Set BRKFLG
  1427.     LD  (BRKFLG),A  ; Store it
  1428. STOP:
  1429.     RET NZ      ; Exit if anything else
  1430.     .BYTE   $F6     ; Skip "Load (BRKLIN),HL
  1431. PEND:
  1432.     RET NZ      ; Exit if anything else
  1433.     LD  (BRKLIN),HL ; Current line for Break
  1434.     .BYTE   $21     ; Skip "OR $FF"
  1435. INPBRK:
  1436.     OR  $FF     ; Set flags for "Break" status
  1437.     POP BC      ; Lose the RETurn
  1438. ENDPRG:
  1439.     LD  HL,(LINEAT) ; Get current line number
  1440.     PUSH    AF      ; Save STOP / END status
  1441.     LD  A,L     ; Is it direct break?
  1442.     AND H       ; If HL=$FFFF break during direct mode
  1443.     INC A       ; Line number is -1 if direct break
  1444.     JR  Z,NOLIN     ; Yes - No line number
  1445.     LD  (ERRLIN),HL ; Save line of break
  1446.     LD  HL,(BRKLIN) ; Get point of break
  1447.     LD  (CONTAD),HL ; Save point to CONTinue
  1448. NOLIN:
  1449.     XOR A
  1450.     LD  (CTLOFG),A  ; Enable output
  1451.     CALL    STTLIN      ; Start a new line
  1452.     POP AF      ; Restore STOP / END status
  1453.     LD  HL,BRKMSG   ; "Break" message
  1454.     JP  NZ,ERRIN    ; "in line" wanted?
  1455.     JP  PRTRDY      ; Go to command mode
  1456. ;------------------------------------------------------------------------------
  1457. ; CONTinue
  1458. ;------------------------------------------------------------------------------
  1459. CONT:
  1460.     LD  HL,(CONTAD) ; Get CONTinue address
  1461.     LD  A,H     ; Is it zero?
  1462.     OR  L
  1463.     LD  E,CN        ; ?CN Error
  1464.     JP  Z,ERROR     ; Yes - output "?CN Error"
  1465.     EX  DE,HL       ; Save code string address
  1466.     LD  HL,(ERRLIN) ; Get line of last break
  1467.     LD  (LINEAT),HL ; Set up current line number
  1468.     EX  DE,HL       ; Restore code string address
  1469.     RET         ; CONTinue where left off
  1470. ;------------------------------------------------------------------------------
  1471. ; NULL sets number of nulls to generate after PRNTCR
  1472. ;------------------------------------------------------------------------------
  1473. NULL:
  1474.     CALL    GETINT      ; Get integer 0-255
  1475.     RET NZ      ; Return if bad value
  1476.     LD  (NULLS),A       ; Set nulls number
  1477.     RET
  1478. ;------------------------------------------------------------------------------
  1479. ; Gets Character at (HL) and verifies it is Alpha
  1480. ;------------------------------------------------------------------------------
  1481. CHKLTR:
  1482.     LD  A,(HL)      ; Get byte
  1483.     CP  'A'     ; < "A" ?
  1484.     RET C       ; Carry set if not letter
  1485.     CP  'Z'+1       ; > "Z" ?
  1486.     CCF
  1487.     RET         ; Carry set if not letter
  1488. ;------------------------------------------------------------------------------
  1489. ; Converts FPreg to INTeger
  1490. ;------------------------------------------------------------------------------
  1491. FPSINT:
  1492.     CALL    GETCHR      ; Get next character
  1493. POSINT:
  1494.     CALL    GETNUM      ; Get integer 0 to 32767
  1495. DEPINT:
  1496.     CALL    TSTSGN      ; Test sign of FPREG
  1497.     JP  M,FCERR     ; Negative - ?FC Error
  1498. DEINT:
  1499.     LD  A,(FPEXP)   ; Get integer value to DE
  1500.     CP  80H+16      ; Exponent in range (16 bits)?
  1501.     JP  C,FPINT     ; Yes - convert it
  1502.     LD  BC,9080H    ; BCDE = -32768, 16-bit integer
  1503.     LD  DE,0000
  1504.     PUSH    HL      ; Save code string address
  1505.     CALL    CMPNUM      ; Compare FPREG with BCDE
  1506.     POP HL      ; Restore code string address
  1507.     LD  D,C     ; MSB to D
  1508.     RET Z       ; Return if in range
  1509. FCERR:
  1510.     LD  E,FC        ; ?FC Error
  1511.     JP  ERROR       ; Output error-
  1512. ;------------------------------------------------------------------------------
  1513. ; Converts ASCII number to DE integer binary
  1514. ; Used to process Line Numbers from BASIC text
  1515. ;------------------------------------------------------------------------------
  1516. ATOH:
  1517.     DEC HL      ; ASCII number to DE binary
  1518. GETLN:
  1519.     LD  DE,0        ; Get number to DE
  1520. GTLNLP:
  1521.     CALL    GETCHR      ; Get next character
  1522.     RET NC      ; Exit if not a digit
  1523.     PUSH    HL      ; Save code string address
  1524.     PUSH    AF      ; Save digit
  1525.     LD  HL,65529/10 ; Largest number 65529
  1526.     CALL    CPHLDE      ; Number in range?
  1527.     JP  C,SNERR     ; No - ?SN Error
  1528.     LD  H,D     ; HL = Number
  1529.     LD  L,E
  1530.     ADD HL,DE       ; Times 2
  1531.     ADD HL,HL       ; Times 4
  1532.     ADD HL,DE       ; Times 5
  1533.     ADD HL,HL       ; Times 10
  1534.     POP AF      ; Restore digit
  1535.     SUB $30     ; Make it 0 to 9
  1536.     LD  E,A     ; DE = Value of digit
  1537.     LD  D,0
  1538.     ADD HL,DE       ; Add to number
  1539.     EX  DE,HL       ; Number to DE
  1540.     POP HL      ; Restore code string address
  1541.     JR  GTLNLP      ; Go to next character
  1542. ;------------------------------------------------------------------------------
  1543. ; CLEAR
  1544. ;------------------------------------------------------------------------------
  1545. CLEAR:
  1546.     JP  Z,INTVAR    ; Just "CLEAR" Keep parameters
  1547.     CALL    POSINT      ; Get integer 0 to 32767 to DE
  1548.     DEC HL      ; Cancel increment
  1549.     CALL    GETCHR      ; Get next character
  1550.     PUSH    HL      ; Save code string address
  1551.     LD  HL,(LSTRAM) ; Get end of RAM
  1552.     JR  Z,STORED    ; No value given - Use stored
  1553.     POP HL      ; Restore code string address
  1554.     CALL    CHKSYN      ; Check for comma
  1555.     .BYTE   ','
  1556.     PUSH    DE      ; Save number
  1557.     CALL    POSINT      ; Get integer 0 to 32767
  1558.     DEC HL      ; Cancel increment
  1559.     CALL    GETCHR      ; Get next character
  1560.     JP  NZ,SNERR    ; ?SN Error if more on line
  1561.     EX  (SP),HL     ; Save code string address
  1562.     EX  DE,HL       ; Number to DE
  1563. STORED:
  1564.     LD  A,L     ; Get LSB of new RAM top
  1565.     SUB E       ; Subtract LSB of string space
  1566.     LD  E,A     ; Save LSB
  1567.     LD  A,H     ; Get MSB of new RAM top
  1568.     SBC A,D     ; Subtract MSB of string space
  1569.     LD  D,A     ; Save MSB
  1570.     JP  C,OMERR     ; ?OM Error if not enough mem
  1571.     PUSH    HL      ; Save RAM top
  1572.     LD  HL,(PROGND) ; Get program end
  1573.     LD  BC,40       ; 40 Bytes minimum working RAM
  1574.     ADD HL,BC       ; Get lowest address
  1575.     CALL    CPHLDE      ; Enough memory?
  1576.     JP  NC,OMERR    ; No - ?OM Error
  1577.     EX  DE,HL       ; RAM top to HL
  1578.     LD  (STRSPC),HL ; Set new string space
  1579.     POP HL      ; End of memory to use
  1580.     LD  (LSTRAM),HL ; Set new top of RAM
  1581.     POP HL      ; Restore code string address
  1582.     JP  INTVAR      ; Initialise variables
  1583. ;------------------------------------------------------------------------------
  1584. ; Program RUN
  1585. ;------------------------------------------------------------------------------
  1586. RUN:
  1587.     JP  Z,RUNFST    ; RUN from start if just RUN
  1588.     CALL    INTVAR      ; Initialise variables
  1589.     LD  BC,RUNCNT   ; Execution driver loop
  1590.     JR  RUNLIN      ; RUN from line number
  1591. ;------------------------------------------------------------------------------
  1592. ; GOSUB
  1593. ;------------------------------------------------------------------------------
  1594. GOSUB:
  1595.     LD  C,3     ; 3 Levels of stack needed
  1596.     CALL    CHKSTK      ; Check for 3 levels of stack
  1597.     POP BC      ; Get return address
  1598.     PUSH    HL      ; Save code string for RETURN
  1599.     PUSH    HL      ; And for GOSUB routine
  1600.     LD  HL,(LINEAT) ; Get current line
  1601.     EX  (SP),HL     ; Into stack - Code string out
  1602.     LD  A,ZGOSUB    ; "GOSUB" token
  1603.     PUSH    AF      ; Save token
  1604.     INC SP      ; Don't save flags
  1605. ;------------------------------------------------------------------------------
  1606. ; RUN LINE NUMBER
  1607. ;------------------------------------------------------------------------------
  1608. RUNLIN:
  1609.     PUSH    BC      ; Save return address
  1610. ;------------------------------------------------------------------------------
  1611. ; GOTO
  1612. ;------------------------------------------------------------------------------
  1613. GOTO:
  1614.     CALL    ATOH        ; ASCII number to DE binary
  1615.     CALL    REM     ; Get end of line
  1616.     PUSH    HL      ; Save end of line
  1617.     LD  HL,(LINEAT) ; Get current line
  1618.     CALL    CPHLDE      ; Line after current?
  1619.     POP HL      ; Restore end of line
  1620.     INC HL      ; Start of next line
  1621.     CALL    C,SRCHLP    ; Line is after current line
  1622.     CALL    NC,SRCHLN   ; Line is before current line
  1623.     LD  H,B     ; Set up code string address
  1624.     LD  L,C
  1625.     DEC HL      ; Incremented after
  1626.     RET C       ; Line found
  1627. ULERR:
  1628.     LD  E,UL        ; ?UL Error - Undefined Line number
  1629.     JP  ERROR       ; Output error message
  1630. ;------------------------------------------------------------------------------
  1631. ; RETURN
  1632. ;------------------------------------------------------------------------------
  1633. RETURN:
  1634.     RET NZ      ; Return if not just RETURN
  1635.     LD  D,-1        ; Flag "GOSUB" search
  1636.     CALL    BAKSTK      ; Look "GOSUB" block
  1637.     LD  SP,HL       ; Kill all FORs in subroutine
  1638.     CP  ZGOSUB      ; Test for "GOSUB" token
  1639.     LD  E,RG        ; ?RG Error
  1640.     JP  NZ,ERROR    ; Error if no "GOSUB" found
  1641.     POP HL      ; Get RETURN line number
  1642.     LD  (LINEAT),HL ; Save as current
  1643.     INC HL      ; Was it from direct statement?
  1644.     LD  A,H
  1645.     OR  L       ; Return to line
  1646.     JP  NZ,RETLIN   ; No - Return to line
  1647.     LD  A,(LSTBIN)  ; Any INPUT in subroutine?
  1648.     OR  A       ; If so buffer is corrupted
  1649.     JP  NZ,POPNOK   ; Yes - Go to command mode
  1650. RETLIN:
  1651.     LD  HL,RUNCNT   ; Execution driver loop
  1652.     EX  (SP),HL     ; Into stack - Code string out
  1653.     .BYTE   3EH     ; Skip "POP HL"
  1654. NXTDTA:
  1655.     POP HL      ; Restore code string address
  1656. ;------------------------------------------------------------------------------
  1657. ; DATA/REM
  1658. ;------------------------------------------------------------------------------
  1659. DATA:
  1660.     .BYTE   $01,$3A     ; ":" End of statement
  1661. REM:
  1662.     LD  C,0     ; 00    End of statement
  1663.     LD  B,0
  1664. NXTSTL:
  1665.     LD  A,C     ; Statement and byte
  1666.     LD  C,B
  1667.     LD  B,A     ; Statement end byte
  1668. NXTSTT:
  1669.     LD  A,(HL)      ; Get byte
  1670.     OR  A       ; End of line?
  1671.     RET Z       ; Yes - Exit
  1672.     CP  B       ; End of statement?
  1673.     RET Z       ; Yes - Exit
  1674.     INC HL      ; Next byte
  1675.     CP  $22     ; Literal string?
  1676.     JR  Z,NXTSTL    ; Yes - Look for another '"'
  1677.     JR  NXTSTT      ; Keep looking
  1678. ;------------------------------------------------------------------------------
  1679. ; ASSIGN A VARIABLE
  1680. ;------------------------------------------------------------------------------
  1681. LET:
  1682.     CALL    GETVAR      ; Get variable name
  1683.     CALL    CHKSYN      ; Make sure "=" follows
  1684.     .BYTE   ZEQUAL      ; "=" token
  1685.     PUSH    DE      ; Save address of variable
  1686.     LD  A,(TYPE)    ; Get data type
  1687.     PUSH    AF      ; Save type
  1688.     CALL    EVAL        ; Evaluate expression
  1689.     POP AF      ; Restore type
  1690.     EX  (SP),HL     ; Save code - Get var addr
  1691.     LD  (BRKLIN),HL ; Save address of variable
  1692.     RRA         ; Adjust type
  1693.     CALL    CHKTYP      ; Check types are the same
  1694.     JR  Z,LETNUM    ; Numeric - Move value
  1695. LETSTR:
  1696.     PUSH    HL      ; Save address of string var
  1697.     LD  HL,(FPREG)  ; Pointer to string entry
  1698.     PUSH    HL      ; Save it on stack
  1699.     INC HL      ; Skip over length
  1700.     INC HL
  1701.     LD  E,(HL)      ; LSB of string address
  1702.     INC HL
  1703.     LD  D,(HL)      ; MSB of string address
  1704.     LD  HL,(BASTXT) ; Point to start of program
  1705.     CALL    CPHLDE      ; Is string before program?
  1706.     JR  NC,CRESTR   ; Yes - Create string entry
  1707.     LD  HL,(STRSPC) ; Point to string space
  1708.     CALL    CPHLDE      ; Is string literal in program?
  1709.     POP DE      ; Restore address of string
  1710.     JR  NC,MVSTPT   ; Yes - Set up pointer
  1711.     LD  HL,TMPSTR   ; Temporary string pool
  1712.     CALL    CPHLDE      ; Is string in temporary pool?
  1713.     JR  NC,MVSTPT   ; No - Set up pointer
  1714.     .BYTE   $3E     ; Skip "POP DE"
  1715. CRESTR:
  1716.     POP DE      ; Restore address of string
  1717.     CALL    BAKTMP      ; Back to last tmp-str entry
  1718.     EX  DE,HL       ; Address of string entry
  1719.     CALL    SAVSTR      ; Save string in string area
  1720. MVSTPT:
  1721.     CALL    BAKTMP      ; Back to last tmp-str entry
  1722.     POP HL      ; Get string pointer
  1723.     CALL    DETHL4      ; Move string pointer to var
  1724.     POP HL      ; Restore code string address
  1725.     RET
  1726.  
  1727. LETNUM:
  1728.     PUSH    HL      ; Save address of variable
  1729.     CALL    FPTHL       ; Move value to variable
  1730.     POP DE      ; Restore address of variable
  1731.     POP HL      ; Restore code string address
  1732.     RET
  1733. ;------------------------------------------------------------------------------
  1734. ; ON Gosub/Goto
  1735. ;------------------------------------------------------------------------------
  1736. ON:
  1737.     CALL    GETINT      ; Get integer 0-255
  1738.     LD  A,(HL)      ; Get "GOTO" or "GOSUB" token
  1739.     LD  B,A     ; Save in B
  1740.     CP  ZGOSUB      ; "GOSUB" token?
  1741.     JR  Z,ONGO      ; Yes - Find line number
  1742.     CALL    CHKSYN      ; Make sure it's "GOTO"
  1743.     .BYTE   ZGOTO       ; "GOTO" token
  1744.     DEC HL      ; Cancel increment
  1745. ONGO:
  1746.     LD  C,E     ; Integer of branch value
  1747. ONGOLP:
  1748.     DEC C       ; Count branches
  1749.     LD  A,B     ; Get "GOTO" or "GOSUB" token
  1750.     JP  Z,ONJMP     ; Go to that line if right one
  1751.     CALL    GETLN       ; Get line number to DE
  1752.     CP  ','     ; Another line number?
  1753.     RET NZ      ; No - Drop through
  1754.     JR  ONGOLP      ; Yes - loop
  1755. ;------------------------------------------------------------------------------
  1756. ; IF/THEN
  1757. ;------------------------------------------------------------------------------
  1758. IF:
  1759.     CALL    EVAL        ; Evaluate expression
  1760.     LD  A,(HL)      ; Get token
  1761.     CP  ZGOTO       ; "GOTO" token?
  1762.     JR  Z,IFGO      ; Yes - Get line
  1763.     CALL    CHKSYN      ; Make sure it's "THEN"
  1764.     .BYTE   ZTHEN       ; "THEN" token
  1765.     DEC HL      ; Cancel increment
  1766. IFGO:
  1767.     CALL    TSTNUM      ; Make sure it's numeric
  1768.     CALL    TSTSGN      ; Test state of expression
  1769.     JP  Z,REM       ; False - Drop through
  1770.     CALL    GETCHR      ; Get next character
  1771.     JP  C,GOTO      ; Number - GOTO that line
  1772.     JP  IFJMP       ; Otherwise do statement
  1773. ;------------------------------------------------------------------------------
  1774. ; PRINTing routines
  1775. ;------------------------------------------------------------------------------
  1776. MRPRNT:
  1777.     DEC HL      ; DEC 'cos GETCHR INCs
  1778.     CALL    GETCHR      ; Get next character
  1779. PRINT:
  1780.     JP  Z,PRNTCR    ; CRLF if just PRINT
  1781. PRNTLP:
  1782.     RET Z       ; End of list - Exit
  1783.     CP  ZTAB        ; "TAB(" token?
  1784.     JP  Z,DOTAB     ; Yes - Do TAB routine
  1785.     CP  ZSPC        ; "SPC(" token?
  1786.     JP  Z,DOTAB     ; Yes - Do SPC routine
  1787.     PUSH    HL      ; Save code string address
  1788.     CP  ','     ; Comma?
  1789.     JP  Z,DOCOM     ; Yes - Move to next zone
  1790.     CP  $3B     ; Semi-colon?
  1791.     JP  Z,NEXITM        ; Do semi-colon routine
  1792.     POP BC      ; Code string address to BC
  1793.     CALL    EVAL        ; Evaluate expression
  1794.     PUSH    HL      ; Save code string address
  1795.     LD  A,(TYPE)        ; Get variable type
  1796.     OR  A       ; Is it a string variable?
  1797.     JR  NZ,PRNTST       ; Yes - Output string contents
  1798.     CALL    NUMASC      ; Convert number to text
  1799.     CALL    CRTST       ; Create temporary string
  1800.     LD  (HL),SPC        ; Followed by a space
  1801.     LD  HL,(FPREG)  ; Get length of output
  1802.     INC (HL)        ; Plus 1 for the space
  1803.     LD  HL,(FPREG)  ; < Not needed >
  1804.     LD  A,(LWIDTH)  ; Get width of line
  1805.     LD  B,A     ; To B
  1806.     INC B       ; Width 255 (No limit)?
  1807.     JR  Z,PRNTNB        ; Yes - Output number string
  1808.     INC B       ; Adjust it
  1809.     LD  A,(CURPOS)  ; Get cursor position
  1810.     ADD A,(HL)      ; Add length of string
  1811.     DEC A       ; Adjust it
  1812.     CP  B       ; Will output fit on this line?
  1813.     CALL    NC,PRNTCR       ; No - CRLF first
  1814. PRNTNB:
  1815.     CALL    PRS1        ; Output string at (HL)
  1816.     XOR A       ; Skip CALL by setting "Z" flag
  1817. PRNTST:
  1818.     CALL    NZ,PRS1     ; Output string at (HL)
  1819.     POP HL      ; Restore code string address
  1820.     JP  MRPRNT      ; See if more to PRINT
  1821. ;------------------------------------------------------------------------------
  1822. ; PRINT A NEW LINE
  1823. ;------------------------------------------------------------------------------
  1824. STTLIN:
  1825.     LD  A,(CURPOS)  ; Make sure on new line
  1826.     OR  A       ; Already at start?
  1827.     RET Z       ; Yes - Do nothing
  1828.     JR  PRNTCR      ; Start a new line
  1829. ;------------------------------------------------------------------------------
  1830. ENDINP:
  1831.     LD  (HL),0      ; Mark end of buffer
  1832.     LD  HL,BUFFER-1 ; Point to buffer
  1833. PRNTCR:
  1834.     LD  A,CR        ; Load a CR
  1835.     CALL    OUTC        ; Output character
  1836.     LD  A,LF        ; Load a LF
  1837.     CALL    OUTC        ; Output character
  1838. DONULL:
  1839.     XOR A       ; Set to position 0
  1840.     LD  (CURPOS),A  ; Store it
  1841.     RET
  1842. ;------------------------------------------------------------------------------
  1843. ; PROCESS COMMA FOR SPACING
  1844. ;------------------------------------------------------------------------------
  1845. DOCOM:
  1846.     LD  A,(LWIDTH)  ; Get terminal width
  1847.     LD  B,A     ; Save in B
  1848.     LD  A,(CURPOS)  ; Get current position
  1849.     LD  C,A     ; Save in C
  1850.     LD  A,(COMMAN)  ; Get comma width
  1851.     ADD A,C     ; Add to current cursor location
  1852.     CP  B       ; Within the terminal width limit?
  1853.     CALL    NC,PRNTCR       ; Beyond limit - output CRLF
  1854.     JR  NC,NEXITM       ; Get next item
  1855. ZONELP:
  1856.     SUB 5       ; Next zone of 5 characters
  1857.     JR  NC,ZONELP       ; Repeat if more zones
  1858.     CPL         ; Number of spaces to output
  1859.     JR  ASPCS       ; Output them
  1860. ;------------------------------------------------------------------------------
  1861. ; PROCESS "TAB(X)" FOR SPACING
  1862. ;------------------------------------------------------------------------------
  1863. DOTAB:
  1864.     PUSH    AF      ; Save token
  1865.     CALL    FNDNUM      ; Evaluate expression
  1866.     CALL    CHKSYN      ; Make sure ")" follows
  1867.     .BYTE   ")"
  1868.     DEC HL      ; Back space on to ")"
  1869.     POP AF      ; Restore token
  1870.     SUB ZSPC        ; Was it "SPC(" ?
  1871.     PUSH    HL      ; Save code string address
  1872.     JR  Z,DOSPC     ; Yes - Do "E" spaces
  1873.     LD  A,(CURPOS)  ; Get current position
  1874. DOSPC:
  1875.     CPL         ; Number of spaces to print to
  1876.     ADD A,E     ; Total number to print
  1877.     JR  NC,NEXITM       ; TAB < Current POS(X)
  1878. ASPCS:
  1879.     INC A       ; Output A spaces
  1880.     LD  B,A     ; Save number to print
  1881.     LD  A,SPC       ; Space
  1882. SPCLP:
  1883.     CALL    OUTC        ; Output character in A
  1884.     DEC B       ; Count them
  1885.     JR  NZ,SPCLP        ; Repeat if more
  1886. NEXITM:
  1887.     POP HL      ; Restore code string address
  1888.     CALL    GETCHR      ; Get next character
  1889.     JP  PRNTLP      ; More to print
  1890. ;------------------------------------------------------------------------------
  1891. ; INPUT
  1892. ;------------------------------------------------------------------------------
  1893. INPUT:
  1894.     CALL    IDTEST      ; Test for illegal direct
  1895.     LD  A,(HL)      ; Get character after "INPUT"
  1896.     CP  $22     ; Is there a prompt string?
  1897.     LD  A,0     ; Clear A and leave flags
  1898.     LD  (CTLOFG),A  ; Enable output
  1899.     JR  NZ,NOPMPT       ; No prompt - get input
  1900.     CALL    QTSTR       ; Get string terminated by '"'
  1901.     CALL    CHKSYN      ; Check for ";" after prompt
  1902.     .BYTE   $3B     ; SEMI COLON
  1903.     PUSH    HL      ; Save code string address
  1904.     CALL    PRS1        ; Output prompt string
  1905.     .BYTE   $3E     ; Skip "PUSH HL"
  1906. NOPMPT:
  1907.     PUSH    HL      ; Save code string address
  1908.     CALL    PROMPT      ; Get input with "? " prompt
  1909.     POP BC      ; Restore code string address
  1910.     JP  C,INPBRK        ; Break pressed - Exit
  1911.     INC HL      ; Next byte
  1912.     LD  A,(HL)      ; Get it
  1913.     OR  A       ; End of line?
  1914.     DEC HL      ; Back again
  1915.     PUSH    BC      ; Re-save code string address
  1916.     JP  Z,NXTDTA        ; Yes - Find next DATA stmt
  1917.     LD  (HL),','        ; Store comma as separator
  1918.     JP  NXTITM      ; Get next item
  1919. ;------------------------------------------------------------------------------
  1920. ; READ data
  1921. ;------------------------------------------------------------------------------
  1922. READ:
  1923.     PUSH    HL      ; Save code string address
  1924.     LD  HL,(NXTDAT) ; Next DATA statement
  1925.     .BYTE   $F6     ; Flag "READ"
  1926. NXTITM:
  1927.     XOR A       ; Flag "INPUT"
  1928.     LD  (READFG),A  ; Save "READ"/"INPUT" flag
  1929.     EX  (SP),HL     ; Get code str' , Save pointer
  1930.     JR  GTVLUS      ; Get values
  1931.  
  1932. NEDMOR:
  1933.     CALL    CHKSYN      ; Check for comma between items
  1934.     .BYTE   ','
  1935. GTVLUS:
  1936.     CALL    GETVAR      ; Get variable name
  1937.     EX  (SP),HL     ; Save code str" , Get pointer
  1938.     PUSH    DE      ; Save variable address
  1939.     LD  A,(HL)      ; Get next "INPUT"/"DATA" byte
  1940.     CP  ','     ; Comma?
  1941.     JR  Z,ANTVLU        ; Yes - Get another value
  1942.     LD  A,(READFG)  ; Is it READ?
  1943.     OR  A
  1944.     JP  NZ,FDTLP        ; Yes - Find next DATA stmt
  1945.     LD  A,'?'       ; More INPUT needed
  1946.     CALL    OUTC        ; Output character
  1947.     CALL    PROMPT      ; Get INPUT with prompt
  1948.     POP DE      ; Variable address
  1949.     POP BC      ; Code string address
  1950.     JP  C,INPBRK        ; Break pressed
  1951.     INC HL      ; Point to next DATA byte
  1952.     LD  A,(HL)      ; Get byte
  1953.     OR  A       ; Is it zero (No input) ?
  1954.     DEC HL      ; Back space INPUT pointer
  1955.     PUSH    BC      ; Save code string address
  1956.     JP  Z,NXTDTA        ; Find end of buffer
  1957.     PUSH    DE      ; Save variable address
  1958. ANTVLU:
  1959.     LD  A,(TYPE)        ; Check data type
  1960.     OR  A       ; Is it numeric?
  1961.     JR  Z,INPBIN        ; Yes - Convert to binary
  1962.     CALL    GETCHR      ; Get next character
  1963.     LD  D,A     ; Save input character
  1964.     LD  B,A     ; Again
  1965.     CP  $22     ; Start of literal sting?
  1966.     JR  Z,STRENT        ; Yes - Create string entry
  1967.     LD  A,(READFG)  ; "READ" or "INPUT" ?
  1968.     OR  A
  1969.     LD  D,A     ; Save 00 if "INPUT"
  1970.     JR  Z,ITMSEP        ; "INPUT" - End with 00
  1971.     LD  D,$3A       ; "DATA" - End with 00 or ":"
  1972. ITMSEP:
  1973.     LD  B,','       ; Item separator
  1974.     DEC HL      ; Back space for DTSTR
  1975. STRENT:
  1976.     CALL    DTSTR       ; Get string terminated by D
  1977.     EX  DE,HL       ; String address to DE
  1978.     LD  HL,LTSTND       ; Where to go after LETSTR
  1979.     EX  (SP),HL     ; Save HL , get input pointer
  1980.     PUSH    DE      ; Save address of string
  1981.     JP  LETSTR      ; Assign string to variable
  1982.  
  1983. INPBIN:
  1984.     CALL    GETCHR      ; Get next character
  1985.     CALL    ASCTFP      ; Convert ASCII to FP number
  1986.     EX  (SP),HL     ; Save input ptr, Get var addr
  1987.     CALL    FPTHL       ; Move FPREG to variable
  1988.     POP HL      ; Restore input pointer
  1989. LTSTND:
  1990.     DEC HL      ; DEC 'cos GETCHR INCs
  1991.     CALL    GETCHR      ; Get next character
  1992.     JR  Z,MORDT     ; End of line - More needed?
  1993.     CP  ','     ; Another value?
  1994.     JP  NZ,BADINP       ; No - Bad input
  1995. MORDT:
  1996.     EX  (SP),HL     ; Get code string address
  1997.     DEC HL      ; DEC 'cos GETCHR INCs
  1998.     CALL    GETCHR      ; Get next character
  1999.     JR  NZ,NEDMOR       ; More needed - Get it
  2000.     POP DE      ; Restore DATA pointer
  2001.     LD  A,(READFG)  ; "READ" or "INPUT" ?
  2002.     OR  A
  2003.     EX  DE,HL       ; DATA pointer to HL
  2004.     JP  NZ,UPDATA       ; Update DATA pointer if "READ"
  2005.     PUSH    DE      ; Save code string address
  2006.     OR  (HL)        ; More input given?
  2007.     LD  HL,EXTIG        ; "?Extra ignored" message
  2008.     CALL    NZ,PRS      ; Output string if extra given
  2009.     POP HL      ; Restore code string address
  2010.     RET
  2011. FDTLP:
  2012.     CALL    DATA        ; Get next statement
  2013.     OR  A       ; End of line?
  2014.     JR  NZ,FANDT        ; No - See if DATA statement
  2015.     INC HL
  2016.     LD  A,(HL)      ; End of program?
  2017.     INC HL
  2018.     OR  (HL)        ; 00 00 Ends program
  2019.     LD  E,OD        ; ?OD Error
  2020.     JP  Z,ERROR     ; Yes - Out of DATA
  2021.     INC HL
  2022.     LD  E,(HL)      ; LSB of line number
  2023.     INC HL
  2024.     LD  D,(HL)      ; MSB of line number
  2025.     EX  DE,HL
  2026.     LD  (DATLIN),HL ; Set line of current DATA item
  2027.     EX  DE,HL
  2028. FANDT:
  2029.     CALL    GETCHR      ; Get next character
  2030.     CP  ZDATA       ; "DATA" token
  2031.     JR  NZ,FDTLP        ; No "DATA" - Keep looking
  2032.     JR  ANTVLU      ; Found - Convert input
  2033.  
  2034. BADINP:
  2035.     LD  A,(READFG)  ; READ or INPUT?
  2036.     OR  A
  2037.     JP  NZ,DATSNR       ; READ - ? Data Syntax Error
  2038.     POP BC      ; Throw away code string addr
  2039.     LD  HL,REDO     ; "Redo from start" message
  2040.     CALL    PRS     ; Output string
  2041.     JP  DOAGN       ; Do last INPUT again
  2042. ;------------------------------------------------------------------------------
  2043. ; NEXT
  2044. ;------------------------------------------------------------------------------
  2045. NEXT:
  2046.     LD  DE,0        ; In case no index given
  2047. NEXT1:
  2048.     CALL    NZ,GETVAR       ; Get index address
  2049.     LD  (BRKLIN),HL ; Save code string address
  2050.     CALL    BAKSTK      ; Look for "FOR" block
  2051.     JP  NZ,NFERR        ; No "FOR" - "Next without FOR" Error
  2052.     LD  SP,HL       ; Clear nested loops
  2053.     PUSH    DE      ; Save index address
  2054.     LD  A,(HL)      ; Get sign of STEP
  2055.     INC HL
  2056.     PUSH    AF      ; Save sign of STEP
  2057.     PUSH    DE      ; Save index address
  2058.     CALL    PHLTFP      ; Move index value to FPREG
  2059.     EX  (SP),HL     ; Save address of TO value
  2060.     PUSH    HL      ; Save address of index
  2061.     CALL    ADDPHL      ; Add STEP to index value
  2062.     POP HL      ; Restore address of index
  2063.     CALL    FPTHL       ; Move value to index variable
  2064.     POP HL      ; Restore address of TO value
  2065.     CALL    LOADFP      ; Move TO value to BCDE
  2066.     PUSH    HL      ; Save address of line of FOR
  2067.     CALL    CMPNUM      ; Compare index with TO value
  2068.     POP HL      ; Restore address of line num
  2069.     POP BC      ; Address of sign of STEP
  2070.     SUB B       ; Compare with expected sign
  2071.     CALL    LOADFP      ; BC = Loop stmt,DE = Line num
  2072.     JP  Z,KILFOR        ; Loop finished - Terminate it
  2073.     EX  DE,HL       ; Loop statement line number
  2074.     LD  (LINEAT),HL ; Set loop line number
  2075.     LD  L,C     ; Set code string to loop
  2076.     LD  H,B
  2077.     JP  PUTFID      ; Put back "FOR" and continue
  2078.  
  2079. KILFOR:
  2080.     LD  SP,HL       ; Remove "FOR" block
  2081.     LD  HL,(BRKLIN) ; Code string after "NEXT"
  2082.     LD  A,(HL)      ; Get next byte in code string
  2083.     CP  ','     ; More NEXTs ?
  2084.     JP  NZ,RUNCNT       ; No - Do next statement
  2085.     CALL    GETCHR      ; Position to index name
  2086.     JR  NEXT1       ; Re-enter NEXT routine
  2087. ;------------------------------------------------------------------------------
  2088. ; Evaluate and Process variable/math functions
  2089. ;------------------------------------------------------------------------------
  2090. GETNUM:
  2091.     CALL    EVAL        ; Get a numeric expression
  2092. TSTNUM:
  2093.     .BYTE   $F6     ; Clear carry (numeric)
  2094. TSTSTR:
  2095.     SCF         ; Set carry (string)
  2096. CHKTYP:
  2097.     LD  A,(TYPE)        ; Check types match
  2098.     ADC A,A     ; Expected + actual
  2099.     OR  A       ; Clear carry , set parity
  2100.     RET PE      ; Even parity - Types match
  2101.     JP  TMERR       ; Different types - Error
  2102.  
  2103. OPNPAR:
  2104.     CALL    CHKSYN      ; Make sure "(" follows
  2105.     .BYTE   '('
  2106. EVAL:
  2107.     DEC HL      ; Evaluate expression & save
  2108.     LD  D,0     ; Precedence value
  2109. EVAL1:
  2110.     PUSH    DE      ; Save precedence
  2111.     LD  C,1
  2112.     CALL    CHKSTK      ; Check for 1 level of stack
  2113.     CALL    OPRND       ; Get next expression value
  2114. EVAL2:
  2115.     LD  (NXTOPR),HL ; Save address of next operator
  2116. EVAL3:
  2117.     LD  HL,(NXTOPR) ; Restore address of next opr
  2118.     POP BC      ; Precedence value and operator
  2119.     LD  A,B     ; Get precedence value
  2120.     CP  $78     ; "AND" or "OR" ?
  2121.     CALL    NC,TSTNUM       ; No - Make sure it's a number
  2122.     LD  A,(HL)      ; Get next operator / function
  2123.     LD  D,0     ; Clear Last relation
  2124. RLTLP:
  2125.     SUB ZGTR        ; ">" Token
  2126.     JR  C,FOPRND        ; + - * / ^ AND OR - Test it
  2127.     CP  ZLTH+1-ZGTR ; < = >
  2128.     JR  NC,FOPRND       ; Function - Call it
  2129.     CP  ZEQUAL-ZGTR ; "="
  2130.     RLA         ; <- Test for legal
  2131.     XOR D       ; <- combinations of < = >
  2132.     CP  D       ; <- by combining last token
  2133.     LD  D,A     ; <- with current one
  2134.     JP  C,SNERR     ; Error if "<<" "==" or ">>"
  2135.     LD  (CUROPR),HL ; Save address of current token
  2136.     CALL    GETCHR      ; Get next character
  2137.     JR  RLTLP       ; Treat the two as one
  2138.  
  2139. FOPRND:
  2140.     LD  A,D     ; < = > found ?
  2141.     OR  A
  2142.     JP  NZ,TSTRED       ; Yes - Test for reduction
  2143.     LD  A,(HL)      ; Get operator token
  2144.     LD  (CUROPR),HL ; Save operator address
  2145.     SUB ZPLUS       ; Operator or function?
  2146.     RET C       ; Neither - Exit
  2147.     CP  ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ?
  2148.     RET NC      ; No - Exit
  2149.     LD  E,A     ; Coded operator
  2150.     LD  A,(TYPE)        ; Get data type
  2151.     DEC A       ; FF = numeric , 00 = string
  2152.     OR  E       ; Combine with coded operator
  2153.     LD  A,E     ; Get coded operator
  2154.     JP  Z,CONCAT        ; String concatenation
  2155.     RLCA            ; Times 2
  2156.     ADD A,E     ; Times 3
  2157.     LD  E,A     ; To DE (D is 0)
  2158.     LD  HL,PRITAB       ; Precedence table
  2159.     ADD HL,DE       ; To the operator concerned
  2160.     LD  A,B     ; Last operator precedence
  2161.     LD  D,(HL)      ; Get evaluation precedence
  2162.     CP  D       ; Compare with eval precedence
  2163.     RET NC      ; Exit if higher precedence
  2164.     INC HL      ; Point to routine address
  2165.     CALL    TSTNUM      ; Make sure it's a number
  2166.  
  2167. STKTHS:
  2168.     PUSH    BC      ; Save last precedence & token
  2169.     LD  BC,EVAL3        ; Where to go on prec' break
  2170.     PUSH    BC      ; Save on stack for return
  2171.     LD  B,E     ; Save operator
  2172.     LD  C,D     ; Save precedence
  2173.     CALL    STAKFP      ; Move value to stack
  2174.     LD  E,B     ; Restore operator
  2175.     LD  D,C     ; Restore precedence
  2176.     LD  C,(HL)      ; Get LSB of routine address
  2177.     INC HL
  2178.     LD  B,(HL)      ; Get MSB of routine address
  2179.     INC HL
  2180.     PUSH    BC      ; Save routine address
  2181.     LD  HL,(CUROPR) ; Address of current operator
  2182.     JP  EVAL1       ; Loop until prec' break
  2183. ;------------------------------------------------------------------------------
  2184. ; Process Operand
  2185. ;------------------------------------------------------------------------------
  2186. OPRND:
  2187.     XOR A       ; Get operand routine
  2188.     LD  (TYPE),A        ; Set numeric expected
  2189.     CALL    GETCHR      ; Get next character
  2190.     LD  E,MO        ; Error - Missing Operand
  2191.     JP  Z,ERROR     ; No operand - Error
  2192.     JP  C,ASCTFP        ; Number - Get value
  2193.     CALL    CHKLTR      ; See if a letter
  2194.     JP  NC,CONVAR       ; Letter - Find variable
  2195.        
  2196.     CP  '$'     ; Hex number indicated? [function added]
  2197.     JP  Z,HEXTFP        ; Convert Hex to FPREG
  2198.    
  2199.     CP  ZPLUS       ; "+" Token ?
  2200.     JR  Z,OPRND     ; Yes - Look for operand
  2201.     CP  '.'     ; "." ?
  2202.     JP  Z,ASCTFP        ; Yes - Create FP number
  2203.     CP  ZMINUS      ; "-" Token ?
  2204.     JP  Z,MINUS     ; Yes - Do minus
  2205.     CP  $22     ; Literal string ?
  2206.     JP  Z,QTSTR     ; Get string terminated by '"'
  2207.     CP  ZNOT        ; "NOT" Token ?
  2208.     JP  Z,EVNOT     ; Yes - Eval NOT expression
  2209.     CP  ZFN     ; "FN" Token ?
  2210.     JP  Z,DOFN      ; Yes - Do FN routine
  2211.     SUB ZSGN        ; Is it a function?
  2212.     JP  NC,FNOFST       ; Yes - Evaluate function
  2213. EVLPAR:
  2214.     CALL    OPNPAR      ; Evaluate expression in "()"
  2215.     CALL    CHKSYN      ; Make sure ")" follows
  2216.     .BYTE   ')'
  2217.     RET
  2218.  
  2219. MINUS:
  2220.     LD  D,7DH       ; "-" precedence
  2221.     CALL    EVAL1       ; Evaluate until prec' break
  2222.     LD  HL,(NXTOPR) ; Get next operator address
  2223.     PUSH    HL      ; Save next operator address
  2224.     CALL    INVSGN      ; Negate value
  2225. RETNUM:
  2226.     CALL    TSTNUM      ; Make sure it's a number
  2227.     POP HL      ; Restore next operator address
  2228.     RET
  2229. ;------------------------------------------------------------------------------
  2230. ; Loads a variable with name at (HL) into FPREG
  2231. ;------------------------------------------------------------------------------
  2232. CONVAR:
  2233.     CALL    GETVAR      ; Get variable address to DE
  2234. FRMEVL:
  2235.     PUSH    HL      ; Save code string address
  2236.     EX  DE,HL       ; Variable address to HL
  2237.     LD  (FPREG),HL  ; Save address of variable
  2238.     LD  A,(TYPE)        ; Get type
  2239.     OR  A       ; Numeric?
  2240.     CALL    Z,PHLTFP        ; Yes - Move contents to FPREG
  2241.     POP HL      ; Restore code string address
  2242.     RET
  2243.  
  2244. FNOFST:
  2245.     LD  B,0     ; Get address of function
  2246.     RLCA            ; Double function offset
  2247.     LD  C,A     ; BC = Offset in function table
  2248.     PUSH    BC      ; Save adjusted token value
  2249.     CALL    GETCHR      ; Get next character
  2250.     LD  A,C     ; Get adjusted token value
  2251.     CP  2*(ZPOINT-ZSGN)     ; Adjusted "POINT" token?
  2252.     JP  Z,POINT     ; Yes - Do "POINT"
  2253.     CP  2*(ZLEFT-ZSGN)-1    ; Adj' LEFT$,RIGHT$ or MID$ ?
  2254.     JR  C,FNVAL     ; No - Do function
  2255.     CALL    OPNPAR      ; Evaluate expression (X,...
  2256.     CALL    CHKSYN      ; Make sure "," follows
  2257.     .BYTE   ','
  2258.     CALL    TSTSTR      ; Make sure it's a string
  2259.     EX  DE,HL       ; Save code string address
  2260.     LD  HL,(FPREG)  ; Get address of string
  2261.     EX  (SP),HL     ; Save address of string
  2262.     PUSH    HL      ; Save adjusted token value
  2263.     EX  DE,HL       ; Restore code string address
  2264.     CALL    GETINT      ; Get integer 0-255
  2265.     EX  DE,HL       ; Save code string address
  2266.     EX  (SP),HL     ; Save integer,HL = adj' token
  2267.     JR  GOFUNC      ; Jump to string function
  2268.  
  2269. FNVAL:
  2270.     CALL    EVLPAR      ; Evaluate expression
  2271.     EX  (SP),HL     ; HL = Adjusted token value
  2272.     LD  DE,RETNUM       ; Return number from function
  2273.     PUSH    DE      ; Save on stack
  2274. GOFUNC:
  2275.     LD  BC,FNCTAB       ; Function routine addresses
  2276.     ADD HL,BC       ; Point to right address
  2277.     LD  C,(HL)      ; Get LSB of address
  2278.     INC HL      ;
  2279.     LD  H,(HL)      ; Get MSB of address
  2280.     LD  L,C     ; Address to HL
  2281.     JP  (HL)        ; Jump to function
  2282.  
  2283. SGNEXP:
  2284.     DEC D       ; Dee to flag negative exponent
  2285.     CP  ZMINUS      ; "-" token ?
  2286.     RET Z       ; Yes - Return
  2287.     CP  '-'     ; "-" ASCII ?
  2288.     RET Z       ; Yes - Return
  2289.     INC D       ; Inc to flag positive exponent
  2290.     CP  '+'     ; "+" ASCII ?
  2291.     RET Z       ; Yes - Return
  2292.     CP  ZPLUS       ; "+" token ?
  2293.     RET Z       ; Yes - Return
  2294.     DEC HL      ; DEC 'cos GETCHR INCs
  2295.     RET         ; Return "NZ"
  2296. ;------------------------------------------------------------------------------
  2297. ; AND / OR integer FPREG < FPREG (AND/OR) last
  2298. ;------------------------------------------------------------------------------
  2299. POR:
  2300.     .BYTE   $F6     ; Flag "OR"
  2301. PAND:
  2302.     XOR A       ; Flag "AND"
  2303.     PUSH    AF      ; Save "AND" / "OR" flag
  2304.     CALL    TSTNUM      ; Make sure it's a number
  2305.     CALL    DEINT       ; Get integer -32768 to 32767
  2306.     POP AF      ; Restore "AND" / "OR" flag
  2307.     EX  DE,HL       ; <- Get last
  2308.     POP BC      ; <-    value
  2309.     EX  (SP),HL     ; <-    from
  2310.     EX  DE,HL       ; <-    stack
  2311.     CALL    FPBCDE      ; Move last value to FPREG
  2312.     PUSH    AF      ; Save "AND" / "OR" flag
  2313.     CALL    DEINT       ; Get integer -32768 to 32767
  2314.     POP AF      ; Restore "AND" / "OR" flag
  2315.     POP BC      ; Get value
  2316.     LD  A,C     ; Get LSB
  2317.     LD  HL,ACPASS       ; Address of save AC as current
  2318.     JR  NZ,POR1     ; Jump if OR
  2319.     AND E       ; "AND" LSBs
  2320.     LD  C,A     ; Save LSB
  2321.     LD  A,B     ; Get MBS
  2322.     AND D       ; "AND" MSBs
  2323.     JP  (HL)        ; Save AC as current (ACPASS)
  2324.  
  2325. POR1:
  2326.     OR  E       ; "OR" LSBs
  2327.     LD  C,A     ; Save LSB
  2328.     LD  A,B     ; Get MSB
  2329.     OR  D       ; "OR" MSBs
  2330.     JP  (HL)        ; Save AC as current (ACPASS)
  2331. ;------------------------------------------------------------------------------
  2332. TSTRED:
  2333.     LD  HL,CMPLOG       ; Logical compare routine
  2334.     LD  A,(TYPE)        ; Get data type
  2335.     RRA         ; Carry set = string
  2336.     LD  A,D     ; Get last precedence value
  2337.     RLA         ; Times 2 plus carry
  2338.     LD  E,A     ; To E
  2339.     LD  D,64H       ; Relational precedence
  2340.     LD  A,B     ; Get current precedence
  2341.     CP  D       ; Compare with last
  2342.     RET NC      ; Eval if last was rel' or log'
  2343.     JP  STKTHS      ; Stack this one and get next
  2344.  
  2345. CMPLOG:
  2346.     .WORD   CMPLG1      ; Compare two values / strings
  2347. CMPLG1:
  2348.     LD  A,C     ; Get data type
  2349.     OR  A
  2350.     RRA
  2351.     POP BC      ; Get last expression to BCDE
  2352.     POP DE
  2353.     PUSH    AF      ; Save status
  2354.     CALL    CHKTYP      ; Check that types match
  2355.     LD  HL,CMPRES       ; Result to comparison
  2356.     PUSH    HL      ; Save for RETurn
  2357.     JP  Z,CMPNUM        ; Compare values if numeric
  2358.     XOR A       ; Compare two strings
  2359.     LD  (TYPE),A        ; Set type to numeric
  2360.     PUSH    DE      ; Save string name
  2361.     CALL    GSTRCU      ; Get current string
  2362.     LD  A,(HL)      ; Get length of string
  2363.     INC HL
  2364.     INC HL
  2365.     LD  C,(HL)      ; Get LSB of address
  2366.     INC HL
  2367.     LD  B,(HL)      ; Get MSB of address
  2368.     POP DE      ; Restore string name
  2369.     PUSH    BC      ; Save address of string
  2370.     PUSH    AF      ; Save length of string
  2371.     CALL    GSTRDE      ; Get second string
  2372.     CALL    LOADFP      ; Get address of second string
  2373.     POP AF      ; Restore length of string 1
  2374.     LD  D,A     ; Length to D
  2375.     POP HL      ; Restore address of string 1
  2376. CMPSTR:
  2377.     LD  A,E     ; Bytes of string 2 to do
  2378.     OR  D       ; Bytes of string 1 to do
  2379.     RET Z       ; Exit if all bytes compared
  2380.     LD  A,D     ; Get bytes of string 1 to do
  2381.     SUB 1
  2382.     RET C       ; Exit if end of string 1
  2383.     XOR A
  2384.     CP  E       ; Bytes of string 2 to do
  2385.     INC A
  2386.     RET NC      ; Exit if end of string 2
  2387.     DEC D       ; Count bytes in string 1
  2388.     DEC E       ; Count bytes in string 2
  2389.     LD  A,(BC)      ; Byte in string 2
  2390.     CP  (HL)        ; Compare to byte in string 1
  2391.     INC HL      ; Move up string 1
  2392.     INC BC      ; Move up string 2
  2393.     JR  Z,CMPSTR        ; Same - Try next bytes
  2394.     CCF         ; Flag difference (">" or "<")
  2395.     JP  FLGDIF      ; "<" gives -1 , ">" gives +1
  2396.  
  2397. CMPRES:
  2398.     INC A       ; Increment current value
  2399.     ADC A,A     ; Double plus carry
  2400.     POP BC      ; Get other value
  2401.     AND B       ; Combine them
  2402.     ADD A,-1        ; Carry set if different
  2403.     SBC A,A     ; 00 - Equal , FF - Different
  2404.     JP  FLGREL      ; Set current value & continue
  2405. ;------------------------------------------------------------------------------
  2406. ; NOT   FPREG = NOT(FPREG)
  2407. ;------------------------------------------------------------------------------
  2408. EVNOT:
  2409.     LD  D,5AH       ; Precedence value for "NOT"
  2410.     CALL    EVAL1       ; Eval until precedence break
  2411.     CALL    TSTNUM      ; Make sure it's a number
  2412.     CALL    DEINT       ; Get integer -32768 - 32767
  2413.     LD  A,E     ; Get LSB
  2414.     CPL         ; Invert LSB
  2415.     LD  C,A     ; Save "NOT" of LSB
  2416.     LD  A,D     ; Get MSB
  2417.     CPL         ; Invert MSB
  2418.     CALL    ACPASS      ; Save AC as current
  2419.     POP BC      ; Clean up stack
  2420.     JP  EVAL3       ; Continue evaluation
  2421. ;------------------------------------------------------------------------------
  2422. ; DIM
  2423. ;------------------------------------------------------------------------------
  2424. DIMRET:
  2425.     DEC HL      ; DEC 'cos GETCHR INCs
  2426.     CALL    GETCHR      ; Get next character
  2427.     RET Z       ; End of DIM statement
  2428.     CALL    CHKSYN      ; Make sure "," follows
  2429.     .BYTE   ','
  2430. DIM:
  2431.     LD  BC,DIMRET       ; Return to "DIMRET"
  2432.     PUSH    BC      ; Save on stack
  2433.     .BYTE   0F6H        ; Flag "Create" variable
  2434. GETVAR:
  2435.     XOR A       ; Find variable address,to DE
  2436.     LD  (LCRFLG),A      ; Set locate / create flag
  2437.     LD  B,(HL)      ; Get First byte of name
  2438. GTFNAM:
  2439.     CALL    CHKLTR      ; See if a letter
  2440.     JP  C,SNERR     ; ?SN Error if not a letter
  2441.     XOR A
  2442.     LD  C,A     ; Clear second byte of name
  2443.     LD  (TYPE),A        ; Set type to numeric
  2444.     CALL    GETCHR      ; Get next character
  2445.     JR  C,SVNAM2        ; Numeric - Save in name
  2446.     CALL    CHKLTR      ; See if a letter
  2447.     JR  C,CHARTY        ; Not a letter - Check type
  2448. SVNAM2:
  2449.     LD  C,A     ; Save second byte of name
  2450. ENDNAM:
  2451.     CALL    GETCHR      ; Get next character
  2452.     JR  C,ENDNAM        ; Numeric - Get another
  2453.     CALL    CHKLTR      ; See if a letter
  2454.     JR  NC,ENDNAM       ; Letter - Get another
  2455. CHARTY:
  2456.     SUB '$'     ; String variable?
  2457.     JR  NZ,NOTSTR       ; No - Numeric variable
  2458.     INC A       ; A = 1 (string type)
  2459.     LD  (TYPE),A        ; Set type to string
  2460.     RRCA            ; A = 80H , Flag for string
  2461.     ADD A,C     ; 2nd byte of name has bit 7 on
  2462.     LD  C,A     ; Resave second byte on name
  2463.     CALL    GETCHR      ; Get next character
  2464. NOTSTR:
  2465.     LD  A,(FORFLG)  ; Array name needed ?
  2466.     DEC A
  2467.     JP  Z,ARLDSV        ; Yes - Get array name
  2468.     JP  P,NSCFOR        ; No array with "FOR" or "FN"
  2469.     LD  A,(HL)      ; Get byte again
  2470.     SUB '('     ; Subscripted variable?
  2471.     JP  Z,SBSCPT        ; Yes - Sort out subscript
  2472.  
  2473. NSCFOR:
  2474.     XOR A       ; Simple variable
  2475.     LD  (FORFLG),A  ; Clear "FOR" flag
  2476.     PUSH    HL      ; Save code string address
  2477.     LD  D,B     ; DE = Variable name to find
  2478.     LD  E,C
  2479.     LD  HL,(FNRGNM) ; FN argument name
  2480.     CALL    CPHLDE      ; Is it the FN argument?
  2481.     LD  DE,FNARG        ; Point to argument value
  2482.     JP  Z,POPHRT        ; Yes - Return FN argument value
  2483.     LD  HL,(VAREND) ; End of variables
  2484.     EX  DE,HL       ; Address of end of search
  2485.     LD  HL,(PROGND) ; Start of variables address
  2486. FNDVAR:
  2487.     CALL    CPHLDE      ; End of variable list table?
  2488.     JR  Z,CFEVAL        ; Yes - Called from EVAL?
  2489.     LD  A,C     ; Get second byte of name
  2490.     SUB (HL)        ; Compare with name in list
  2491.     INC HL      ; Move on to first byte
  2492.     JR  NZ,FNTHR        ; Different - Find another
  2493.     LD  A,B     ; Get first byte of name
  2494.     SUB (HL)        ; Compare with name in list
  2495. FNTHR:
  2496.     INC HL      ; Move on to LSB of value
  2497.     JP  Z,RETADR        ; Found - Return address
  2498.     INC HL      ; <- Skip
  2499.     INC HL      ; <- over
  2500.     INC HL      ; <- F.P.
  2501.     INC HL      ; <- value
  2502.     JP  FNDVAR      ; Keep looking
  2503.  
  2504. CFEVAL:
  2505.     POP HL      ; Restore code string address
  2506.     EX  (SP),HL     ; Get return address
  2507.     PUSH    DE      ; Save address of variable
  2508.     LD  DE,FRMEVL       ; Return address in EVAL
  2509.     CALL    CPHLDE      ; Called from EVAL ?
  2510.     POP DE      ; Restore address of variable
  2511.     JP  Z,RETNUL        ; Yes - Return null variable
  2512.     EX  (SP),HL     ; Put back return
  2513.     PUSH    HL      ; Save code string address
  2514.     PUSH    BC      ; Save variable name
  2515.     LD  BC,6        ; 2 byte name plus 4 byte data
  2516.     LD  HL,(ARREND) ; End of arrays
  2517.     PUSH    HL      ; Save end of arrays
  2518.     ADD HL,BC       ; Move up 6 bytes
  2519.     POP BC      ; Source address in BC
  2520.     PUSH    HL      ; Save new end address
  2521.     CALL    MOVUP       ; Move arrays up
  2522.     POP HL      ; Restore new end address
  2523.     LD  (ARREND),HL ; Set new end address
  2524.     LD  H,B     ; End of variables to HL
  2525.     LD  L,C
  2526.     LD  (VAREND),HL ; Set new end address
  2527.  
  2528. ZEROLP:
  2529.     DEC HL      ; Back through to zero variable
  2530.     LD  (HL),0      ; Zero byte in variable
  2531.     CALL    CPHLDE      ; Done them all?
  2532.     JP  NZ,ZEROLP       ; No - Keep on going
  2533.     POP DE      ; Get variable name
  2534.     LD  (HL),E      ; Store second character
  2535.     INC HL
  2536.     LD  (HL),D      ; Store first character
  2537.     INC HL
  2538. RETADR:
  2539.     EX  DE,HL       ; Address of variable in DE
  2540.     POP HL      ; Restore code string address
  2541.     RET
  2542.  
  2543. RETNUL:
  2544.     LD  (FPEXP),A       ; Set result to zero
  2545.     LD  HL,ZERBYT       ; Also set a null string
  2546.     LD  (FPREG),HL  ; Save for EVAL
  2547.     POP HL      ; Restore code string address
  2548.     RET
  2549.  
  2550. SBSCPT:
  2551.     PUSH    HL      ; Save code string address
  2552.     LD  HL,(LCRFLG) ; Locate/Create and Type
  2553.     EX  (SP),HL     ; Save and get code string
  2554.     LD  D,A     ; Zero number of dimensions
  2555. SCPTLP:
  2556.     PUSH    DE      ; Save number of dimensions
  2557.     PUSH    BC      ; Save array name
  2558.     CALL    FPSINT      ; Get subscript (0-32767)
  2559.     POP BC      ; Restore array name
  2560.     POP AF      ; Get number of dimensions
  2561.     EX  DE,HL
  2562.     EX  (SP),HL     ; Save subscript value
  2563.     PUSH    HL      ; Save LCRFLG and TYPE
  2564.     EX  DE,HL
  2565.     INC A       ; Count dimensions
  2566.     LD  D,A     ; Save in D
  2567.     LD  A,(HL)      ; Get next byte in code string
  2568.     CP  ','     ; Comma (more to come)?
  2569.     JR  Z,SCPTLP        ; Yes - More subscripts
  2570.     CALL    CHKSYN      ; Make sure ")" follows
  2571.     .BYTE   ')'
  2572.     LD  (NXTOPR),HL ; Save code string address
  2573.     POP HL      ; Get LCRFLG and TYPE
  2574.     LD  (LCRFLG),HL ; Restore Locate/create & type
  2575.     LD  E,0     ; Flag not SAVE* or LOAD*
  2576.     PUSH    DE      ; Save number of dimensions (D)
  2577.     .BYTE   $11     ; Skip "PUSH HL" and "PUSH AF'
  2578.  
  2579. ARLDSV:
  2580.     PUSH    HL      ; Save code string address
  2581.     PUSH    AF      ; A = 00 , Flags set = Z,N
  2582.     LD  HL,(VAREND) ; Start of arrays
  2583.     .BYTE   $3E     ; Skip "ADD HL,DE"
  2584. FNDARY:
  2585.     ADD HL,DE       ; Move to next array start
  2586.     EX  DE,HL
  2587.     LD  HL,(ARREND) ; End of arrays
  2588.     EX  DE,HL       ; Current array pointer
  2589.     CALL    CPHLDE      ; End of arrays found?
  2590.     JR  Z,CREARY        ; Yes - Create array
  2591.     LD  A,(HL)      ; Get second byte of name
  2592.     CP  C       ; Compare with name given
  2593.     INC HL      ; Move on
  2594.     JR  NZ,NXTARY       ; Different - Find next array
  2595.     LD  A,(HL)      ; Get first byte of name
  2596.     CP  B       ; Compare with name given
  2597. NXTARY:
  2598.     INC HL      ; Move on
  2599.     LD  E,(HL)      ; Get LSB of next array address
  2600.     INC HL
  2601.     LD  D,(HL)      ; Get MSB of next array address
  2602.     INC HL
  2603.     JR  NZ,FNDARY       ; Not found - Keep looking
  2604.     LD  A,(LCRFLG)  ; Found Locate or Create it?
  2605.     OR  A
  2606.     JP  NZ,DDERR        ; Create - ?DD Error
  2607.     POP AF      ; Locate - Get number of dim'ns
  2608.     LD  B,H     ; BC Points to array dim'ns
  2609.     LD  C,L
  2610.     JP  Z,POPHRT        ; Jump if array load/save
  2611.     SUB (HL)        ; Same number of dimensions?
  2612.     JP  Z,FINDEL        ; Yes - Find element
  2613. BSERR:
  2614.     LD  E,BS        ; ?BS Error
  2615.     JP  ERROR       ; Output error
  2616. ;------------------------------------------------------------------------------
  2617. ; CREATE ARRAY IN MEMORY
  2618. ;------------------------------------------------------------------------------
  2619. CREARY:
  2620.     LD  DE,4        ; 4 Bytes per entry
  2621.     POP AF      ; Array to save or 0 dim'ns?
  2622.     JP  Z,FCERR     ; Yes - ?FC Error
  2623.     LD  (HL),C      ; Save second byte of name
  2624.     INC HL
  2625.     LD  (HL),B      ; Save first byte of name
  2626.     INC HL
  2627.     LD  C,A     ; Number of dimensions to C
  2628.     CALL    CHKSTK      ; Check if enough memory
  2629.     INC HL      ; Point to number of dimensions
  2630.     INC HL
  2631.     LD  (CUROPR),HL ; Save address of pointer
  2632.     LD  (HL),C      ; Set number of dimensions
  2633.     INC HL
  2634.     LD  A,(LCRFLG)  ; Locate of Create?
  2635.     RLA         ; Carry set = Create
  2636.     LD  A,C     ; Get number of dimensions
  2637. CRARLP:
  2638.     LD  BC,10+1     ; Default dimension size 10
  2639.     JR  NC,DEFSIZ       ; Locate - Set default size
  2640.     POP BC      ; Get specified dimension size
  2641.     INC BC      ; Include zero element
  2642. DEFSIZ:
  2643.     LD  (HL),C      ; Save LSB of dimension size
  2644.     INC HL
  2645.     LD  (HL),B      ; Save MSB of dimension size
  2646.     INC HL
  2647.     PUSH    AF      ; Save num' of dim'ns an status
  2648.     PUSH    HL      ; Save address of dim'n size
  2649.     CALL    MLDEBC      ; Multiply DE by BC to find
  2650.     EX  DE,HL       ; amount of mem needed (to DE)
  2651.     POP HL      ; Restore address of dimension
  2652.     POP AF      ; Restore number of dimensions
  2653.     DEC A       ; Count them
  2654.     JR  NZ,CRARLP       ; Do next dimension if more
  2655.     PUSH    AF      ; Save locate/create flag
  2656.     LD  B,D     ; MSB of memory needed
  2657.     LD  C,E     ; LSB of memory needed
  2658.     EX  DE,HL
  2659.     ADD HL,DE       ; Add bytes to array start
  2660.     JP  C,OMERR     ; Too big - Error
  2661.     CALL    ENFMEM      ; See if enough memory
  2662.     LD  (ARREND),HL ; Save new end of array
  2663.  
  2664. ZERARY:
  2665.     DEC HL      ; Back through array data
  2666.     LD  (HL),0      ; Set array element to zero
  2667.     CALL    CPHLDE      ; All elements zeroed?
  2668.     JR  NZ,ZERARY       ; No - Keep on going
  2669.     INC BC      ; Number of bytes + 1
  2670.     LD  D,A     ; A=0
  2671.     LD  HL,(CUROPR) ; Get address of array
  2672.     LD  E,(HL)      ; Number of dimensions
  2673.     EX  DE,HL       ; To HL
  2674.     ADD HL,HL       ; Two bytes per dimension size
  2675.     ADD HL,BC       ; Add number of bytes
  2676.     EX  DE,HL       ; Bytes needed to DE
  2677.     DEC HL
  2678.     DEC HL
  2679.     LD  (HL),E      ; Save LSB of bytes needed
  2680.     INC HL
  2681.     LD  (HL),D      ; Save MSB of bytes needed
  2682.     INC HL
  2683.     POP AF      ; Locate / Create?
  2684.     JR  C,ENDDIM        ; A is 0 , End if create
  2685. FINDEL:
  2686.     LD  B,A     ; Find array element
  2687.     LD  C,A
  2688.     LD  A,(HL)      ; Number of dimensions
  2689.     INC HL
  2690.     .BYTE   16H     ; Skip "POP HL"
  2691. FNDELP:
  2692.     POP HL      ; Address of next dim' size
  2693.     LD  E,(HL)      ; Get LSB of dim'n size
  2694.     INC HL
  2695.     LD  D,(HL)      ; Get MSB of dim'n size
  2696.     INC HL
  2697.     EX  (SP),HL     ; Save address - Get index
  2698.     PUSH    AF      ; Save number of dim'ns
  2699.     CALL    CPHLDE      ; Dimension too large?
  2700.     JP  NC,BSERR        ; Yes - ?BS Error
  2701.     PUSH    HL      ; Save index
  2702.     CALL    MLDEBC      ; Multiply previous by size
  2703.     POP DE      ; Index supplied to DE
  2704.     ADD HL,DE       ; Add index to pointer
  2705.     POP AF      ; Number of dimensions
  2706.     DEC A       ; Count them
  2707.     LD  B,H     ; MSB of pointer
  2708.     LD  C,L     ; LSB of pointer
  2709.     JR  NZ,FNDELP       ; More - Keep going
  2710.     ADD HL,HL       ; 4 Bytes per element
  2711.     ADD HL,HL
  2712.     POP BC      ; Start of array
  2713.     ADD HL,BC       ; Point to element
  2714.     EX  DE,HL       ; Address of element to DE
  2715. ENDDIM:
  2716.     LD  HL,(NXTOPR) ; Got code string address
  2717.     RET
  2718. ;------------------------------------------------------------------------------
  2719. ; FRE list amount of free memory remaining
  2720. ;------------------------------------------------------------------------------
  2721. FRE:
  2722.     LD  HL,(ARREND) ; Start of free memory
  2723.     EX  DE,HL       ; To DE
  2724.     LD  HL,(LSTRAM) ; Top of available (after CLEAR)
  2725.     LD  A,(TYPE)        ; Dummy argument type
  2726.     OR  A       ; If string, return free string memory
  2727.     JR  Z,FRENUM        ; Numeric - Free variable space
  2728.     CALL    GSTRCU      ; Current string to pool
  2729.     CALL    GARBGE      ; Garbage collection
  2730.     LD  HL,(STRSPC) ; Bottom of string space in use
  2731.     EX  DE,HL       ; To DE
  2732.     LD  HL,(STRBOT) ; Bottom of string space
  2733. FRENUM:
  2734.     LD  A,L     ; Get LSB of end
  2735.     SUB E       ; Subtract LSB of beginning
  2736.     LD  C,A     ; Save difference if C
  2737.     LD  A,H     ; Get MSB of end
  2738.     SBC A,D     ; Subtract MSB of beginning
  2739. ;------------------------------------------------------------------------------
  2740. ACPASS:
  2741.     LD  B,C     ; Return integer AC
  2742. ABPASS:
  2743.     LD  D,B     ; Return integer AB
  2744.     LD  E,0     ; Numeric type
  2745.     LD  HL,TYPE     ; Point to type
  2746.     LD  (HL),E      ; Set type to numeric
  2747.     LD  B,80H+16        ; 16 bit integer
  2748.     JP  RETINT      ; Return the integer
  2749. ;------------------------------------------------------------------------------
  2750. ; POS returns current cursor position
  2751. ;------------------------------------------------------------------------------
  2752. POS:
  2753.     LD  A,(CURPOS)  ; Get cursor position
  2754. PASSA:
  2755.     LD  B,A     ; Put A into AB
  2756.     XOR A       ; Zero A
  2757.     JR  ABPASS      ; Return integer AB
  2758. ;------------------------------------------------------------------------------
  2759. ; DEF FN define function
  2760. ;------------------------------------------------------------------------------
  2761. DEF:
  2762.     CALL    CHEKFN      ; Get "FN" and name
  2763.     CALL    IDTEST      ; Test for illegal direct
  2764.     LD  BC,DATA     ; To get next statement
  2765.     PUSH    BC      ; Save address for RETurn
  2766.     PUSH    DE      ; Save address of function ptr
  2767.     CALL    CHKSYN      ; Make sure "(" follows
  2768.     .BYTE   '('
  2769.     CALL    GETVAR      ; Get argument variable name
  2770.     PUSH    HL      ; Save code string address
  2771.     EX  DE,HL       ; Argument address to HL
  2772.     DEC HL
  2773.     LD  D,(HL)      ; Get first byte of arg name
  2774.     DEC HL
  2775.     LD  E,(HL)      ; Get second byte of arg name
  2776.     POP HL      ; Restore code string address
  2777.     CALL    TSTNUM      ; Make sure numeric argument
  2778.     CALL    CHKSYN      ; Make sure ")" follows
  2779.     .BYTE   ')'
  2780.     CALL    CHKSYN      ; Make sure "=" follows
  2781.     .BYTE   ZEQUAL      ; "=" token
  2782.     LD  B,H     ; Code string address to BC
  2783.     LD  C,L
  2784.     EX  (SP),HL     ; Save code str , Get FN ptr
  2785.     LD  (HL),C      ; Save LSB of FN code string
  2786.     INC HL
  2787.     LD  (HL),B      ; Save MSB of FN code string
  2788.     JP  SVSTAD      ; Save address and do function
  2789. ;------------------------------------------------------------------------------
  2790. ; Perform FN function
  2791. ;------------------------------------------------------------------------------
  2792. DOFN:
  2793.     CALL    CHEKFN      ; Make sure FN follows
  2794.     PUSH    DE      ; Save function pointer address
  2795.     CALL    EVLPAR      ; Evaluate expression in "()"
  2796.     CALL    TSTNUM      ; Make sure numeric result
  2797.     EX  (SP),HL     ; Save code str , Get FN ptr
  2798.     LD  E,(HL)      ; Get LSB of FN code string
  2799.     INC HL
  2800.     LD  D,(HL)      ; Get MSB of FN code string
  2801.     INC HL
  2802.     LD  A,D     ; And function DEFined?
  2803.     OR  E
  2804.     JP  Z,UFERR     ; No - ?UF Error
  2805.     LD  A,(HL)      ; Get LSB of argument address
  2806.     INC HL
  2807.     LD  H,(HL)      ; Get MSB of argument address
  2808.     LD  L,A     ; HL = Arg variable address
  2809.     PUSH    HL      ; Save it
  2810.     LD  HL,(FNRGNM) ; Get old argument name
  2811.     EX  (SP),HL     ; Save old , Get new
  2812.     LD  (FNRGNM),HL ; Set new argument name
  2813.     LD  HL,(FNARG+2)    ; Get LSB,NLSB of old arg value
  2814.     PUSH    HL      ; Save it
  2815.     LD  HL,(FNARG)  ; Get MSB,EXP of old arg value
  2816.     PUSH    HL      ; Save it
  2817.     LD  HL,FNARG        ; HL = Value of argument
  2818.     PUSH    DE      ; Save FN code string address
  2819.     CALL    FPTHL       ; Move FPREG to argument
  2820.     POP HL      ; Get FN code string address
  2821.     CALL    GETNUM      ; Get value from function
  2822.     DEC HL      ; DEC 'cos GETCHR INCs
  2823.     CALL    GETCHR      ; Get next character
  2824.     JP  NZ,SNERR        ; Bad character in FN - Error
  2825.     POP HL      ; Get MSB,EXP of old arg
  2826.     LD  (FNARG),HL  ; Restore it
  2827.     POP HL      ; Get LSB,NLSB of old arg
  2828.     LD  (FNARG+2),HL    ; Restore it
  2829.     POP HL      ; Get name of old arg
  2830.     LD  (FNRGNM),HL ; Restore it
  2831.     POP HL      ; Restore code string address
  2832.     RET
  2833. ;------------------------------------------------------------------------------
  2834. ; Determine if Immediate or if operating in program RUN
  2835. ;------------------------------------------------------------------------------
  2836. IDTEST:
  2837.     PUSH    HL      ; Save code string address
  2838.     LD  HL,(LINEAT) ; Get current line number
  2839.     INC HL      ; -1 means direct statement
  2840.     LD  A,H
  2841.     OR  L
  2842.     POP HL      ; Restore code string address
  2843.     RET NZ      ; Return if in program
  2844.     LD  E,ID        ; ?ID Error
  2845.     JP  ERROR
  2846.  
  2847. CHEKFN:
  2848.     CALL    CHKSYN      ; Make sure FN follows
  2849.     .BYTE   ZFN     ; "FN" token
  2850.     LD  A,80H
  2851.     LD  (FORFLG),A  ; Flag FN name to find
  2852.     OR  (HL)        ; FN name has bit 7 set
  2853.     LD  B,A     ; in first byte of name
  2854.     CALL    GTFNAM      ; Get FN name
  2855.     JP  TSTNUM      ; Make sure numeric function
  2856. ;------------------------------------------------------------------------------
  2857. ; STR function turns numeric into string value
  2858. ;------------------------------------------------------------------------------
  2859. STR:
  2860.     CALL    TSTNUM      ; Make sure it's a number
  2861.     CALL    NUMASC      ; Turn number into text
  2862. STR1:
  2863.     CALL    CRTST       ; Create string entry for it
  2864.     CALL    GSTRCU      ; Current string to pool
  2865.     LD  BC,TOPOOL       ; Save in string pool
  2866.     PUSH    BC      ; Save address on stack
  2867.  
  2868. SAVSTR:
  2869.     LD  A,(HL)      ; Get string length
  2870.     INC HL
  2871.     INC HL
  2872.     PUSH    HL      ; Save pointer to string
  2873.     CALL    TESTR       ; See if enough string space
  2874.     POP HL      ; Restore pointer to string
  2875.     LD  C,(HL)      ; Get LSB of address
  2876.     INC HL
  2877.     LD  B,(HL)      ; Get MSB of address
  2878.     CALL    CRTMST      ; Create string entry
  2879.     PUSH    HL      ; Save pointer to MSB of addr
  2880.     LD  L,A     ; Length of string
  2881.     CALL    TOSTRA      ; Move to string area
  2882.     POP DE      ; Restore pointer to MSB
  2883.     RET
  2884. ;------------------------------------------------------------------------------
  2885. MKTMST:
  2886.     CALL    TESTR       ; See if enough string space
  2887. CRTMST:
  2888.     LD  HL,TMPSTR       ; Temporary string
  2889.     PUSH    HL      ; Save it
  2890.     LD  (HL),A      ; Save length of string
  2891.     INC HL
  2892. SVSTAD:
  2893.     INC HL
  2894.     LD  (HL),E      ; Save LSB of address
  2895.     INC HL
  2896.     LD  (HL),D      ; Save MSB of address
  2897.     POP HL      ; Restore pointer
  2898.     RET
  2899. ;------------------------------------------------------------------------------
  2900. CRTST:
  2901.     DEC HL      ; DEC - INCed after
  2902. QTSTR:
  2903.     LD  B,$22       ; Terminating quote "
  2904.     LD  D,B     ; Quote to D
  2905. DTSTR:
  2906.     PUSH    HL      ; Save start
  2907.     LD  C,-1        ; Set counter to -1
  2908. QTSTLP:
  2909.     INC HL      ; Move on
  2910.     LD  A,(HL)      ; Get byte
  2911.     INC C       ; Count bytes
  2912.     OR  A       ; End of line?
  2913.     JR  Z,CRTSTE        ; Yes - Create string entry
  2914.     CP  D       ; Terminator D found?
  2915.     JR  Z,CRTSTE        ; Yes - Create string entry
  2916.     CP  B       ; Terminator B found?
  2917.     JR  NZ,QTSTLP       ; No - Keep looking
  2918. CRTSTE:
  2919.     CP  $22     ; End with '"'?
  2920.     CALL    Z,GETCHR        ; Yes - Get next character
  2921.     EX  (SP),HL     ; Starting quote
  2922.     INC HL      ; First byte of string
  2923.     EX  DE,HL       ; To DE
  2924.     LD  A,C     ; Get length
  2925.     CALL    CRTMST      ; Create string entry
  2926. TSTOPL:
  2927.     LD  DE,TMPSTR       ; Temporary string
  2928.     LD  HL,(TMSTPT) ; Temporary string pool pointer
  2929.     LD  (FPREG),HL  ; Save address of string ptr
  2930.     LD  A,1
  2931.     LD  (TYPE),A        ; Set type to string
  2932.     CALL    DETHL4      ; Move string to pool
  2933.     CALL    CPHLDE      ; Out of string pool?
  2934.     LD  (TMSTPT),HL ; Save new pointer
  2935.     POP HL      ; Restore code string address
  2936.     LD  A,(HL)      ; Get next code byte
  2937.     RET NZ      ; Return if pool OK
  2938.     LD  E,ST        ; ?ST Error
  2939.     JP  ERROR       ; String pool overflow
  2940. ;------------------------------------------------------------------------------
  2941. ; Print String routines
  2942. ;------------------------------------------------------------------------------
  2943. PRNUMS:
  2944.     INC HL      ; Skip leading space
  2945. PRS:
  2946.     CALL    CRTST       ; Create string entry for it
  2947. PRS1:
  2948.     CALL    GSTRCU      ; Current string to pool
  2949.     CALL    LOADFP      ; Move string block to BCDE
  2950.     INC E       ; Length + 1
  2951. PRSLP:
  2952.     DEC E       ; Count characters
  2953.     RET Z       ; End of string
  2954.     LD  A,(BC)      ; Get byte to output
  2955.     CALL    OUTC        ; Output character in A
  2956.     CP  CR      ; Return?
  2957.     CALL    Z,DONULL        ; Yes - Do nulls
  2958.     INC BC      ; Next byte in string
  2959.     JR  PRSLP       ; More characters to output
  2960. ;------------------------------------------------------------------------------
  2961. TESTR:
  2962.     OR  A       ; Test if enough room (string length=A)
  2963.     .BYTE   $0E     ; No garbage collection done
  2964. GRBDON:
  2965.     POP AF      ; Garbage collection done
  2966.     PUSH    AF      ; Save status
  2967.     LD  HL,(STRSPC) ; Bottom of string space in use
  2968.     EX  DE,HL       ; To DE
  2969.     LD  HL,(STRBOT) ; Bottom of string area
  2970.     CPL         ; Negate length (Top down)
  2971.     LD  C,A     ; -Length to BC
  2972.     LD  B,-1        ; BC = negeative length of string
  2973.     ADD HL,BC       ; Add to bottom of space in use
  2974.     INC HL      ; Plus one for 2's complement
  2975.     CALL    CPHLDE      ; Below string RAM area?
  2976.     JR  C,TESTOS        ; Tidy up if not done else err
  2977.     LD  (STRBOT),HL ; Save new bottom of area
  2978.     INC HL      ; Point to first byte of string
  2979.     EX  DE,HL       ; Address to DE
  2980. POPAF:
  2981.     POP AF      ; Throw away status push
  2982.     RET
  2983. TESTOS:
  2984.     POP AF      ; Garbage collect been done?
  2985.     LD  E,OS        ; ?OS Error
  2986.     JP  Z,ERROR     ; Yes - Not enough string apace
  2987.     CP  A       ; Flag garbage collect done
  2988.     PUSH    AF      ; Save status
  2989.     LD  BC,GRBDON       ; Garbage collection done
  2990.     PUSH    BC      ; Save for RETurn
  2991. GARBGE:
  2992.     LD  HL,(LSTRAM) ; Get end of RAM pointer
  2993. GARBLP:
  2994.     LD  (STRBOT),HL ; Reset string pointer
  2995.     LD  HL,0
  2996.     PUSH    HL      ; Flag no string found
  2997.     LD  HL,(STRSPC) ; Get bottom of string space
  2998.     PUSH    HL      ; Save bottom of string space
  2999.     LD  HL,TMSTPL       ; Temporary string pool
  3000. GRBLP:
  3001.     EX  DE,HL
  3002.     LD  HL,(TMSTPT) ; Temporary string pool pointer
  3003.     EX  DE,HL
  3004.     CALL    CPHLDE      ; Temporary string pool done?
  3005.     LD  BC,GRBLP        ; Loop until string pool done
  3006.     JP  NZ,STPOOL       ; No - See if in string area
  3007.     LD  HL,(PROGND) ; Start of simple variables
  3008. SMPVAR:
  3009.     EX  DE,HL
  3010.     LD  HL,(VAREND) ; End of simple variables
  3011.     EX  DE,HL
  3012.     CALL    CPHLDE      ; All simple strings done?
  3013.     JP  Z,ARRLP     ; Yes - Do string arrays
  3014.     LD  A,(HL)      ; Get type of variable
  3015.     INC HL
  3016.     INC HL
  3017.     OR  A       ; "S" flag set if string
  3018.     CALL    STRADD      ; See if string in string area
  3019.     JR  SMPVAR      ; Loop until simple ones done
  3020.  
  3021. GNXARY:
  3022.     POP BC      ; Scrap address of this array
  3023. ARRLP:
  3024.     EX  DE,HL
  3025.     LD  HL,(ARREND) ; End of string arrays
  3026.     EX  DE,HL
  3027.     CALL    CPHLDE      ; All string arrays done?
  3028.     JP  Z,SCNEND        ; Yes - Move string if found
  3029.     CALL    LOADFP      ; Get array name to BCDE
  3030.     LD  A,E     ; Get type of array
  3031.     PUSH    HL      ; Save address of num of dim'ns
  3032.     ADD HL,BC       ; Start of next array
  3033.     OR  A       ; Test type of array
  3034.     JP  P,GNXARY        ; Numeric array - Ignore it
  3035.     LD  (CUROPR),HL ; Save address of next array
  3036.     POP HL      ; Get address of num of dim'ns
  3037.     LD  C,(HL)      ; BC = Number of dimensions
  3038.     LD  B,0
  3039.     ADD HL,BC       ; Two bytes per dimension size
  3040.     ADD HL,BC
  3041.     INC HL      ; Plus one for number of dim'ns
  3042. GRBARY:
  3043.     EX  DE,HL
  3044.     LD  HL,(CUROPR) ; Get address of next array
  3045.     EX  DE,HL
  3046.     CALL    CPHLDE      ; Is this array finished?
  3047.     JR  Z,ARRLP     ; Yes - Get next one
  3048.     LD  BC,GRBARY       ; Loop until array all done
  3049. STPOOL:
  3050.     PUSH    BC      ; Save return address
  3051.     OR  80H     ; Flag string type
  3052. STRADD:
  3053.     LD  A,(HL)      ; Get string length
  3054.     INC HL
  3055.     INC HL
  3056.     LD  E,(HL)      ; Get LSB of string address
  3057.     INC HL
  3058.     LD  D,(HL)      ; Get MSB of string address
  3059.     INC HL
  3060.     RET P       ; Not a string - Return
  3061.     OR  A       ; Set flags on string length
  3062.     RET Z       ; Null string - Return
  3063.     LD  B,H     ; Save variable pointer
  3064.     LD  C,L
  3065.     LD  HL,(STRBOT) ; Bottom of new area
  3066.     CALL    CPHLDE      ; String been done?
  3067.     LD  H,B     ; Restore variable pointer
  3068.     LD  L,C
  3069.     RET C       ; String done - Ignore
  3070.     POP HL      ; Return address
  3071.     EX  (SP),HL     ; Lowest available string area
  3072.     CALL    CPHLDE      ; String within string area?
  3073.     EX  (SP),HL     ; Lowest available string area
  3074.     PUSH    HL      ; Re-save return address
  3075.     LD  H,B     ; Restore variable pointer
  3076.     LD  L,C
  3077.     RET NC      ; Outside string area - Ignore
  3078.     POP BC      ; Get return , Throw 2 away
  3079.     POP AF      ;
  3080.     POP AF      ;
  3081.     PUSH    HL      ; Save variable pointer
  3082.     PUSH    DE      ; Save address of current
  3083.     PUSH    BC      ; Put back return address
  3084.     RET         ; Go to it
  3085.  
  3086. SCNEND:
  3087.     POP DE      ; Addresses of strings
  3088.     POP HL      ;
  3089.     LD  A,L     ; HL = 0 if no more to do
  3090.     OR  H
  3091.     RET Z       ; No more to do - Return
  3092.     DEC HL
  3093.     LD  B,(HL)      ; MSB of address of string
  3094.     DEC HL
  3095.     LD  C,(HL)      ; LSB of address of string
  3096.     PUSH    HL      ; Save variable address
  3097.     DEC HL
  3098.     DEC HL
  3099.     LD  L,(HL)      ; HL = Length of string
  3100.     LD  H,0
  3101.     ADD HL,BC       ; Address of end of string+1
  3102.     LD  D,B     ; String address to DE
  3103.     LD  E,C
  3104.     DEC HL      ; Last byte in string
  3105.     LD  B,H     ; Address to BC
  3106.     LD  C,L
  3107.     LD  HL,(STRBOT) ; Current bottom of string area
  3108.     CALL    MOVSTR      ; Move string to new address
  3109.     POP HL      ; Restore variable address
  3110.     LD  (HL),C      ; Save new LSB of address
  3111.     INC HL
  3112.     LD  (HL),B      ; Save new MSB of address
  3113.     LD  L,C     ; Next string area+1 to HL
  3114.     LD  H,B
  3115.     DEC HL      ; Next string area address
  3116.     JP  GARBLP      ; Look for more strings
  3117.  
  3118. CONCAT:
  3119.     PUSH    BC      ; Save prec' opr & code string
  3120.     PUSH    HL      ;
  3121.     LD  HL,(FPREG)  ; Get first string
  3122.     EX  (SP),HL     ; Save first string
  3123.     CALL    OPRND       ; Get second string
  3124.     EX  (SP),HL     ; Restore first string
  3125.     CALL    TSTSTR      ; Make sure it's a string
  3126.     LD  A,(HL)      ; Get length of second string
  3127.     PUSH    HL      ; Save first string
  3128.     LD  HL,(FPREG)  ; Get second string
  3129.     PUSH    HL      ; Save second string
  3130.     ADD A,(HL)      ; Add length of second string
  3131.     LD  E,LS        ; ?LS Error
  3132.     JP  C,ERROR     ; String too long - Error
  3133.     CALL    MKTMST      ; Make temporary string
  3134.     POP DE      ; Get second string to DE
  3135.     CALL    GSTRDE      ; Move to string pool if needed
  3136.     EX  (SP),HL     ; Get first string
  3137.     CALL    GSTRHL      ; Move to string pool if needed
  3138.     PUSH    HL      ; Save first string
  3139.     LD  HL,(TMPSTR+2)   ; Temporary string address
  3140.     EX  DE,HL       ; To DE
  3141.     CALL    SSTSA       ; First string to string area
  3142.     CALL    SSTSA       ; Second string to string area
  3143.     LD  HL,EVAL2    ; Return to evaluation loop
  3144.     EX  (SP),HL     ; Save return,get code string
  3145.     PUSH    HL      ; Save code string address
  3146.     JP  TSTOPL      ; To temporary string to pool
  3147.  
  3148. SSTSA:
  3149.     POP HL      ; Return address
  3150.     EX  (SP),HL     ; Get string block,save return
  3151.     LD  A,(HL)      ; Get length of string
  3152.     INC HL
  3153.     INC HL
  3154.     LD  C,(HL)      ; Get LSB of string address
  3155.     INC HL
  3156.     LD  B,(HL)      ; Get MSB of string address
  3157.     LD  L,A     ; Length to L
  3158. TOSTRA:
  3159.     INC L       ; INC - DECed after
  3160. TSALP:
  3161.     DEC L       ; Count bytes moved
  3162.     RET Z       ; End of string - Return
  3163.     LD  A,(BC)      ; Get source
  3164.     LD  (DE),A      ; Save destination
  3165.     INC BC      ; Next source
  3166.     INC DE      ; Next destination
  3167.     JR  TSALP       ; Loop until string moved
  3168.  
  3169. GETSTR:
  3170.     CALL    TSTSTR      ; Make sure it's a string
  3171. GSTRCU:
  3172.     LD  HL,(FPREG)  ; Get current string
  3173. GSTRHL:
  3174.     EX  DE,HL       ; Save DE
  3175. GSTRDE:
  3176.     CALL    BAKTMP      ; Was it last tmp-str?
  3177.     EX  DE,HL       ; Restore DE
  3178.     RET NZ      ; No - Return
  3179.     PUSH    DE      ; Save string
  3180.     LD  D,B     ; String block address to DE
  3181.     LD  E,C
  3182.     DEC DE      ; Point to length
  3183.     LD  C,(HL)      ; Get string length
  3184.     LD  HL,(STRBOT) ; Current bottom of string area
  3185.     CALL    CPHLDE      ; Last one in string area?
  3186.     JR  NZ,POPHL        ; No - Return
  3187.     LD  B,A     ; Clear B (A=0)
  3188.     ADD HL,BC       ; Remove string from str' area
  3189.     LD  (STRBOT),HL ; Save new bottom of str' area
  3190. POPHL:
  3191.     POP HL      ; Restore string
  3192.     RET
  3193.  
  3194. BAKTMP:
  3195.     LD  HL,(TMSTPT) ; Get temporary string pool top
  3196.     DEC HL      ; Back
  3197.     LD  B,(HL)      ; Get MSB of address
  3198.     DEC HL      ; Back
  3199.     LD  C,(HL)      ; Get LSB of address
  3200.     DEC HL      ; Back
  3201.     DEC HL      ; Back
  3202.     CALL    CPHLDE      ; String last in string pool?
  3203.     RET NZ      ; Yes - Leave it
  3204.     LD  (TMSTPT),HL ; Save new string pool top
  3205.     RET
  3206. ;------------------------------------------------------------------------------
  3207. ; LEN string length
  3208. ;------------------------------------------------------------------------------
  3209. LEN:
  3210.     LD  BC,PASSA        ; To return integer A
  3211.     PUSH    BC      ; Save address
  3212. GETLEN:
  3213.     CALL    GETSTR      ; Get string and its length
  3214.     XOR A
  3215.     LD  D,A     ; Clear D
  3216.     LD  (TYPE),A        ; Set type to numeric
  3217.     LD  A,(HL)      ; Get length of string
  3218.     OR  A       ; Set status flags
  3219.     RET
  3220. ;------------------------------------------------------------------------------
  3221. ; ASC string value
  3222. ;------------------------------------------------------------------------------
  3223. ASC:
  3224.     LD  BC,PASSA        ; To return integer A
  3225.     PUSH    BC      ; Save address
  3226. GTFLNM:
  3227.     CALL    GETLEN      ; Get length of string
  3228.     JP  Z,FCERR     ; Null string - Error
  3229.     INC HL
  3230.     INC HL
  3231.     LD  E,(HL)      ; Get LSB of address
  3232.     INC HL
  3233.     LD  D,(HL)      ; Get MSB of address
  3234.     LD  A,(DE)      ; Get first byte of string
  3235.     RET
  3236. ;------------------------------------------------------------------------------
  3237. ; CHR
  3238. ;------------------------------------------------------------------------------
  3239. CHR:
  3240.     LD  A,1     ; One character string
  3241.     CALL    MKTMST      ; Make a temporary string
  3242.     CALL    MAKINT      ; Make it integer A
  3243.     LD  HL,(TMPSTR+2)   ; Get address of string
  3244.     LD  (HL),E      ; Save character
  3245. TOPOOL:
  3246.     POP BC      ; Clean up stack
  3247.     JP  TSTOPL      ; Temporary string to pool
  3248. ;------------------------------------------------------------------------------
  3249. ; LEFT$
  3250. ;------------------------------------------------------------------------------
  3251. LEFT:
  3252.     CALL    LFRGNM      ; Get number and ending ")"
  3253.     XOR A       ; Start at first byte in string
  3254. ;------------------------------------------------------------------------------
  3255. ; RIGHT$
  3256. ;------------------------------------------------------------------------------
  3257. RIGHT1:
  3258.     EX  (SP),HL     ; Save code string,Get string
  3259.     LD  C,A     ; Starting position in string
  3260. ;------------------------------------------------------------------------------
  3261. ; MID$
  3262. ;------------------------------------------------------------------------------
  3263. MID1:
  3264.     PUSH    HL      ; Save string block address
  3265.     LD  A,(HL)      ; Get length of string
  3266.     CP  B       ; Compare with number given
  3267.     JR  C,ALLFOL        ; All following bytes required
  3268.     LD  A,B     ; Get new length
  3269.     .BYTE   11H     ; Skip "LD C,0"
  3270. ALLFOL:
  3271.     LD  C,0     ; First byte of string
  3272.     PUSH    BC      ; Save position in string
  3273.     CALL    TESTR       ; See if enough string space
  3274.     POP BC      ; Get position in string
  3275.     POP HL      ; Restore string block address
  3276.     PUSH    HL      ; And re-save it
  3277.     INC HL
  3278.     INC HL
  3279.     LD  B,(HL)      ; Get LSB of address
  3280.     INC HL
  3281.     LD  H,(HL)      ; Get MSB of address
  3282.     LD  L,B     ; HL = address of string
  3283.     LD  B,0     ; BC = starting address
  3284.     ADD HL,BC       ; Point to that byte
  3285.     LD  B,H     ; BC = source string
  3286.     LD  C,L
  3287.     CALL    CRTMST      ; Create a string entry
  3288.     LD  L,A     ; Length of new string
  3289.     CALL    TOSTRA      ; Move string to string area
  3290.     POP DE      ; Clear stack
  3291.     CALL    GSTRDE      ; Move to string pool if needed
  3292.     JP  TSTOPL      ; Temporary string to pool
  3293.  
  3294. RIGHT:
  3295.     CALL    LFRGNM      ; Get number and ending ")"
  3296.     POP DE      ; Get string length
  3297.     PUSH    DE      ; And re-save
  3298.     LD  A,(DE)      ; Get length
  3299.     SUB B       ; Move back N bytes
  3300.     JR  RIGHT1      ; Go and get sub-string
  3301.  
  3302. MID:
  3303.     EX  DE,HL       ; Get code string address
  3304.     LD  A,(HL)      ; Get next byte "," or ")"
  3305.     CALL    MIDNUM      ; Get number supplied
  3306.     INC B       ; Is it character zero?
  3307.     DEC B
  3308.     JP  Z,FCERR     ; Yes - Error
  3309.     PUSH    BC      ; Save starting position
  3310.     LD  E,255       ; All of string
  3311.     CP  ')'     ; Any length given?
  3312.     JR  Z,RSTSTR        ; No - Rest of string
  3313.     CALL    CHKSYN      ; Make sure "," follows
  3314.     .BYTE   ','
  3315.     CALL    GETINT      ; Get integer 0-255
  3316. RSTSTR:
  3317.     CALL    CHKSYN      ; Make sure ")" follows
  3318.     .BYTE   ')'
  3319.     POP AF      ; Restore starting position
  3320.     EX  (SP),HL     ; Get string,8ave code string
  3321.     LD  BC,MID1     ; Continuation of MID$ routine
  3322.     PUSH    BC      ; Save for return
  3323.     DEC A       ; Starting position-1
  3324.     CP  (HL)        ; Compare with length
  3325.     LD  B,0     ; Zero bytes length
  3326.     RET NC      ; Null string if start past end
  3327.     LD  C,A     ; Save starting position-1
  3328.     LD  A,(HL)      ; Get length of string
  3329.     SUB C       ; Subtract start
  3330.     CP  E       ; Enough string for it?
  3331.     LD  B,A     ; Save maximum length available
  3332.     RET C       ; Truncate string if needed
  3333.     LD  B,E     ; Set specified length
  3334.     RET         ; Go and create string
  3335. ;------------------------------------------------------------------------------
  3336. ; VAL
  3337. ;------------------------------------------------------------------------------
  3338. VAL:
  3339.     CALL    GETLEN      ; Get length of string
  3340.     JP  Z,RESZER        ; Result zero
  3341.     LD  E,A     ; Save length
  3342.     INC HL
  3343.     INC HL
  3344.     LD  A,(HL)      ; Get LSB of address
  3345.     INC HL
  3346.     LD  H,(HL)      ; Get MSB of address
  3347.     LD  L,A     ; HL = String address
  3348.     PUSH    HL      ; Save string address
  3349.     ADD HL,DE
  3350.     LD  B,(HL)      ; Get end of string+1 byte
  3351.     LD  (HL),D      ; Zero it to terminate
  3352.     EX  (SP),HL     ; Save string end,get start
  3353.     PUSH    BC      ; Save end+1 byte
  3354.     LD  A,(HL)      ; Get starting byte
  3355.     CALL    ASCTFP      ; Convert ASCII string to FP
  3356.     POP BC      ; Restore end+1 byte
  3357.     POP HL      ; Restore end+1 address
  3358.     LD  (HL),B      ; Put back original byte
  3359.     RET
  3360.  
  3361. LFRGNM:
  3362.     EX  DE,HL       ; Code string address to HL
  3363.     CALL    CHKSYN      ; Make sure ")" follows
  3364.     .BYTE   ")"
  3365. MIDNUM:
  3366.     POP BC      ; Get return address
  3367.     POP DE      ; Get number supplied
  3368.     PUSH    BC      ; Re-save return address
  3369.     LD  B,E     ; Number to B
  3370.     RET
  3371. ;------------------------------------------------------------------------------
  3372. ; INPUT
  3373. ;------------------------------------------------------------------------------
  3374. INP:
  3375.     CALL    MAKINT      ; Make it integer A
  3376.     LD  (INPORT),A  ; Set input port
  3377.     CALL    INPSUB      ; Get input from port
  3378.     JP  PASSA       ; Return integer A
  3379. ;------------------------------------------------------------------------------
  3380. ; OUTPUT
  3381. ;------------------------------------------------------------------------------
  3382. POUT:
  3383.     CALL    SETIO       ; Set up port number
  3384.     JP  OUTSUB      ; Output data and return
  3385. ;------------------------------------------------------------------------------
  3386. ; WAIT
  3387. ;------------------------------------------------------------------------------
  3388. WAIT:
  3389.     CALL    SETIO       ; Set up port number
  3390.     PUSH    AF      ; Save AND mask
  3391.     LD  E,0     ; Assume zero if none given
  3392.     DEC HL      ; DEC 'cos GETCHR INCs
  3393.     CALL    GETCHR      ; Get next character
  3394.     JR  Z,NOXOR     ; No XOR byte given
  3395.     CALL    CHKSYN      ; Make sure "," follows
  3396.     .BYTE   ','
  3397.     CALL    GETINT      ; Get integer 0-255 to XOR with
  3398. NOXOR:
  3399.     POP BC      ; Restore AND mask
  3400. WAITLP:
  3401.     CALL    INPSUB      ; Get input
  3402.     XOR E       ; Flip selected bits
  3403.     AND B       ; Result non-zero?
  3404.     JR  Z,WAITLP        ; No = keep waiting
  3405.     RET
  3406. ;------------------------------------------------------------------------------
  3407. ; Process INP and OUT
  3408. ;------------------------------------------------------------------------------
  3409. SETIO:
  3410.     CALL    GETINT      ; Get integer 0-255
  3411.     LD  (INPORT),A  ; Set input port
  3412.     LD  (OTPORT),A  ; Set output port
  3413.     CALL    CHKSYN      ; Make sure "," follows
  3414.     .BYTE   ','
  3415.     JP  GETINT      ; Get integer 0-255 and return
  3416.  
  3417. FNDNUM:
  3418.     CALL    GETCHR      ; Get next character
  3419. GETINT:
  3420.     CALL    GETNUM      ; Get a number from 0 to 255
  3421. MAKINT:
  3422.     CALL    DEPINT      ; Make sure value 0 - 255
  3423.     LD  A,D     ; Get MSB of number
  3424.     OR  A       ; Zero?
  3425.     JP  NZ,FCERR        ; No - Error
  3426.     DEC HL      ; DEC 'cos GETCHR INCs
  3427.     CALL    GETCHR      ; Get next character
  3428.     LD  A,E     ; Get number to A
  3429.     RET
  3430. ;------------------------------------------------------------------------------
  3431. ; PEEK
  3432. ;------------------------------------------------------------------------------
  3433. PEEK:
  3434.     CALL    DEINT       ; Get memory address
  3435.     LD  A,(DE)      ; Get byte in memory
  3436.     JP  PASSA       ; Return integer A
  3437. ;------------------------------------------------------------------------------
  3438. ; POKE
  3439. ;------------------------------------------------------------------------------
  3440. POKE:
  3441.     CALL    GETNUM      ; Get memory address
  3442.     CALL    DEINT       ; Get integer -32768 to 3276
  3443.     PUSH    DE      ; Save memory address
  3444.     CALL    CHKSYN      ; Make sure "," follows
  3445.     .BYTE   ','
  3446.     CALL    GETINT      ; Get integer 0-255
  3447.     POP DE      ; Restore memory address
  3448.     LD  (DE),A      ; Load it into memory
  3449.     RET
  3450. ;------------------------------------------------------------------------------
  3451. ; HEX( [Replaces DEEK] Convert 16 bit number to Hexadecimal string
  3452. ;------------------------------------------------------------------------------
  3453. HEX:    CALL    TSTNUM      ; Verify it's a number
  3454.     CALL    DEINT       ; Get integer -32768 to 32767
  3455.     PUSH    BC      ; Save contents of BC
  3456.     LD  HL,PBUFF
  3457.     LD  (HL),'$'        ; Store "$" to start of conv buffer
  3458.     INC HL      ; Index next
  3459.     LD  A,D     ; Get high order into A
  3460.     CALL    BYT2ASC     ; Convert   D to ASCII
  3461.     LD  (HL),B      ; Store it to PBUFF+1
  3462.     INC HL      ; Next location
  3463.     LD  (HL),C      ; Store C   to PBUFF+2
  3464.     LD  A,E     ; Get lower byte
  3465.     CALL    BYT2ASC     ; Convert   E to ASCII
  3466.     INC HL      ; Save B
  3467.     LD  (HL),B      ; to PBUFF+3
  3468.     INC HL      ; Save C
  3469.     LD  (HL),C      ; to PBUFF+4
  3470.     LD  A,SPC       ; Create a <spc> after the number
  3471.     INC HL      ; Index next
  3472.     LD  (HL),A      ; PBUFF+5   to space
  3473.     XOR A       ; Terminating character
  3474.     INC HL      ; PBUFF+6   to zero
  3475.     LD  (HL),A      ; Store zero to terminate
  3476.     INC HL      ; Make sure PBUFF is terminated
  3477.     LD  (HL),A      ; Store the double zero there
  3478.     POP BC      ; Get BC back
  3479.     LD  HL,PBUFF        ; Reset to start of PBUFF
  3480.     JP  STR1        ; Convert the PBUFF to a string and return it
  3481. ;------------------------------------------------------------------------------
  3482. ; Convert byte in A to ASCII in BC, same as routine in Monitor at $0326
  3483. ;------------------------------------------------------------------------------
  3484. BYT2ASC:LD  B,A     ; Save original value
  3485.     AND $0F     ; Strip off upper nybble
  3486.     CP  $0A     ; 0-9?
  3487.     JR  C,ADD30     ; If A-F, add 7 more
  3488.     ADD A,$07       ; Bring value up to ASCII A-F
  3489. ADD30:
  3490.     ADD A,$30       ; And make ASCII
  3491.     LD  C,A     ; Save converted char to C
  3492.     LD  A,B     ; Retrieve original value
  3493.     RRCA            ; and Rotate it right
  3494.     RRCA
  3495.     RRCA
  3496.     RRCA
  3497.     AND $0F     ; Mask off upper nybble
  3498.     CP  $0A     ; 0-9? < A hex?
  3499.     JR  C,ADD301        ; Skip Add 7
  3500.     ADD A,$07       ; Bring it up to ASCII A-F
  3501. ADD301:
  3502.     ADD A,$30       ; And make it full ASCII
  3503.     LD  B,A     ; Store high order byte
  3504.     RET
  3505. ;------------------------------------------------------------------------------
  3506. ; VECTOR Set address for USR jump vector
  3507. ;------------------------------------------------------------------------------
  3508. VECTOR:
  3509.     CALL    GETNUM      ; Get a number
  3510.     CALL    DEINT       ; Get integer into DE
  3511.     LD  (USR+1),DE  ; Store vector at USR vector
  3512.     RET
  3513. ;------------------------------------------------------------------------------
  3514. ; SYSTEM sets address from vector value, then performs the jump
  3515. ;------------------------------------------------------------------------------
  3516. SYSTEM:
  3517.     CALL    VECTOR
  3518.     CALL    USR     ; Go there
  3519.     RET
  3520. ;------------------------------------------------------------------------------
  3521. ; WIDTH
  3522. ;------------------------------------------------------------------------------
  3523. WIDTH:
  3524.     CALL    GETINT      ; Get integer 0-255
  3525.     LD  A,E     ; Width to A
  3526.     LD  (LWIDTH),A  ; Set width
  3527.     RET
  3528. ;------------------------------------------------------------------------------
  3529. ; LINES
  3530. ;------------------------------------------------------------------------------
  3531. LINES:
  3532.     CALL    GETNUM      ; Get a number
  3533.     CALL    DEINT       ; Get integer -32768 to 32767
  3534.     LD  (LINESC),DE ; Set lines counter
  3535.     LD  (LINESN),DE ; Set lines number
  3536.     RET
  3537. ;------------------------------------------------------------------------------
  3538. ;------------------------------------------------------------------------------
  3539. ;
  3540. ; Start of  F L O A T I N G P O I N T   M A T H
  3541. ;
  3542. ;------------------------------------------------------------------------------
  3543. ;------------------------------------------------------------------------------
  3544. ROUND:
  3545.     LD  HL,HALF     ; Add 0.5 to FPREG
  3546. ADDPHL:
  3547.     CALL    LOADFP      ; Load FP at (HL) to BCDE
  3548.     JR  FPADD       ; Add BCDE to FPREG
  3549.  
  3550. SUBPHL:
  3551.     CALL    LOADFP      ; FPREG = -FPREG + number at HL
  3552.     .BYTE   21H     ; Skip "POP BC" and "POP DE"
  3553. PSUB:
  3554.     POP BC      ; Get FP number from stack
  3555.     POP DE
  3556. SUBCDE:
  3557.     CALL    INVSGN      ; Negate FPREG
  3558. FPADD:
  3559.     LD  A,B     ; Get FP exponent
  3560.     OR  A       ; Is number zero?
  3561.     RET Z       ; Yes - Nothing to add
  3562.     LD  A,(FPEXP)       ; Get FPREG exponent
  3563.     OR  A       ; Is this number zero?
  3564.     JP  Z,FPBCDE        ; Yes - Move BCDE to FPREG
  3565.     SUB B       ; BCDE number larger?
  3566.     JR  NC,NOSWAP       ; No - Don't swap them
  3567.     CPL         ; Two's complement
  3568.     INC A       ; FP exponent
  3569.     EX  DE,HL
  3570.     CALL    STAKFP      ; Put FPREG on stack
  3571.     EX  DE,HL
  3572.     CALL    FPBCDE      ; Move BCDE to FPREG
  3573.     POP BC      ; Restore number from stack
  3574.     POP DE
  3575. NOSWAP:
  3576.     CP  24+1        ; Second number insignificant?
  3577.     RET NC      ; Yes - First number is result
  3578.     PUSH    AF      ; Save number of bits to scale
  3579.     CALL    SIGNS       ; Set MSBs & sign of result
  3580.     LD  H,A     ; Save sign of result
  3581.     POP AF      ; Restore scaling factor
  3582.     CALL    SCALE       ; Scale BCDE to same exponent
  3583.     OR  H       ; Result to be positive?
  3584.     LD  HL,FPREG        ; Point to FPREG
  3585.     JP  P,MINCDE        ; No - Subtract FPREG from CDE
  3586.     CALL    PLUCDE      ; Add FPREG to CDE
  3587.     JP  NC,RONDUP       ; No overflow - Round it up
  3588.     INC HL      ; Point to exponent
  3589.     INC (HL)        ; Increment it
  3590.     JP  Z,OVERR     ; Number overflowed - Error
  3591.     LD  L,1     ; 1 bit to shift right
  3592.     CALL    SHRT1       ; Shift result right
  3593.     JP  RONDUP      ; Round it up
  3594.  
  3595. MINCDE:
  3596.     XOR A       ; Clear A and carry
  3597.     SUB B       ; Negate exponent
  3598.     LD  B,A     ; Re-save exponent
  3599.     LD  A,(HL)      ; Get LSB of FPREG
  3600.     SBC A, E        ; Subtract LSB of BCDE
  3601.     LD  E,A     ; Save LSB of BCDE
  3602.     INC HL
  3603.     LD  A,(HL)      ; Get NMSB of FPREG
  3604.     SBC A,D     ; Subtract NMSB of BCDE
  3605.     LD  D,A     ; Save NMSB of BCDE
  3606.     INC HL
  3607.     LD  A,(HL)      ; Get MSB of FPREG
  3608.     SBC A,C     ; Subtract MSB of BCDE
  3609.     LD  C,A     ; Save MSB of BCDE
  3610. CONPOS:
  3611.     CALL    C,COMPL     ; Overflow - Make it positive
  3612.  
  3613. BNORM:
  3614.     LD  L,B     ; L = Exponent
  3615.     LD  H,E     ; H = LSB
  3616.     XOR A
  3617. BNRMLP:
  3618.     LD  B,A     ; Save bit count
  3619.     LD  A,C     ; Get MSB
  3620.     OR  A       ; Is it zero?
  3621.     JR  NZ,PNORM        ; No - Do it bit at a time
  3622.     LD  C,D     ; MSB = NMSB
  3623.     LD  D,H     ; NMSB= LSB
  3624.     LD  H,L     ; LSB = VLSB
  3625.     LD  L,A     ; VLSB= 0
  3626.     LD  A,B     ; Get exponent
  3627.     SUB 8       ; Count 8 bits
  3628.     CP  -24-8       ; Was number zero?
  3629.     JR  NZ,BNRMLP       ; No - Keep normalising
  3630. RESZER:
  3631.     XOR A       ; Result is zero
  3632. SAVEXP:
  3633.     LD  (FPEXP),A       ; Save result as zero
  3634.     RET
  3635.  
  3636. NORMAL:
  3637.     DEC B       ; Count bits
  3638.     ADD HL,HL       ; Shift HL left
  3639.     LD  A,D     ; Get NMSB
  3640.     RLA         ; Shift left with last bit
  3641.     LD  D,A     ; Save NMSB
  3642.     LD  A,C     ; Get MSB
  3643.     ADC A,A     ; Shift left with last bit
  3644.     LD  C,A     ; Save MSB
  3645. PNORM:
  3646.     JP  P,NORMAL        ; Not done - Keep going
  3647.     LD  A,B     ; Number of bits shifted
  3648.     LD  E,H     ; Save HL in EB
  3649.     LD  B,L
  3650.     OR  A       ; Any shifting done?
  3651.     JP  Z,RONDUP        ; No - Round it up
  3652.     LD  HL,FPEXP        ; Point to exponent
  3653.     ADD A,(HL)      ; Add shifted bits
  3654.     LD  (HL),A      ; Re-save exponent
  3655.     JR  NC,RESZER       ; Underflow - Result is zero
  3656.     RET Z       ; Result is zero
  3657. RONDUP:
  3658.     LD  A,B     ; Get VLSB of number
  3659. RON.BYTE:
  3660.     LD  HL,FPEXP        ; Point to exponent
  3661.     OR  A       ; Any rounding?
  3662.     CALL    M,FPROND        ; Yes - Round number up
  3663.     LD  B,(HL)      ; B = Exponent
  3664.     INC HL
  3665.     LD  A,(HL)      ; Get sign of result
  3666.     AND 10000000B       ; Only bit 7 needed
  3667.     XOR C       ; Set correct sign
  3668.     LD  C,A     ; Save correct sign in number
  3669.     JP  FPBCDE      ; Move BCDE to FPREG
  3670.  
  3671. FPROND:
  3672.     INC E       ; Round LSB
  3673.     RET NZ      ; Return if ok
  3674.     INC D       ; Round NMSB
  3675.     RET NZ      ; Return if ok
  3676.     INC C       ; Round MSB
  3677.     RET NZ      ; Return if ok
  3678.     LD  C,80H       ; Set normal value
  3679.     INC (HL)        ; Increment exponent
  3680.     RET NZ      ; Return if ok
  3681.     JP  OVERR       ; Overflow error
  3682. ;------------------------------------------------------------------------------
  3683. ; ADD FPREG AT (HL) TO BCDE
  3684. ;------------------------------------------------------------------------------
  3685. PLUCDE:
  3686.     LD  A,(HL)      ; Get LSB of FPREG
  3687.     ADD A,E     ; Add LSB of BCDE
  3688.     LD  E,A     ; Save LSB of BCDE
  3689.     INC HL
  3690.     LD  A,(HL)      ; Get NMSB of FPREG
  3691.     ADC A,D     ; Add NMSB of BCDE
  3692.     LD  D,A     ; Save NMSB of BCDE
  3693.     INC HL
  3694.     LD  A,(HL)      ; Get MSB of FPREG
  3695.     ADC A,C     ; Add MSB of BCDE
  3696.     LD  C,A     ; Save MSB of BCDE
  3697.     RET
  3698. ;------------------------------------------------------------------------------
  3699. ; Compliment FP number in BCDE
  3700. ;------------------------------------------------------------------------------
  3701. COMPL:
  3702.     LD  HL,SGNRES       ; Sign of result
  3703.     LD  A,(HL)      ; Get sign of result
  3704.     CPL         ; Negate it
  3705.     LD  (HL),A      ; Put it back
  3706.     XOR A
  3707.     LD  L,A     ; Set L to zero
  3708.     SUB B       ; Negate exponent,set carry
  3709.     LD  B,A     ; Re-save exponent
  3710.     LD  A,L     ; Load zero
  3711.     SBC A,E     ; Negate LSB
  3712.     LD  E,A     ; Re-save LSB
  3713.     LD  A,L     ; Load zero
  3714.     SBC A,D     ; Negate NMSB
  3715.     LD  D,A     ; Re-save NMSB
  3716.     LD  A,L     ; Load zero
  3717.     SBC A,C     ; Negate MSB
  3718.     LD  C,A     ; Re-save MSB
  3719.     RET
  3720. ;------------------------------------------------------------------------------
  3721. ; Rescales BCDE
  3722. ;------------------------------------------------------------------------------
  3723. SCALE:
  3724.     LD  B,0     ; Clear underflow
  3725. SCALLP:
  3726.     SUB 8       ; 8 bits (a whole byte)?
  3727.     JR  C,SHRITE        ; No - Shift right A bits
  3728.     LD  B,E     ; <- Shift
  3729.     LD  E,D     ; <- right
  3730.     LD  D,C     ; <- eight
  3731.     LD  C,0     ; <- bits
  3732.     JR  SCALLP      ; More bits to shift
  3733.  
  3734. SHRITE:
  3735.     ADD A,8+1       ; Adjust count
  3736.     LD  L,A     ; Save bits to shift
  3737. SHRLP:
  3738.     XOR A       ; Flag for all done
  3739.     DEC L       ; All shifting done?
  3740.     RET Z       ; Yes - Return
  3741.     LD  A,C     ; Get MSB
  3742. SHRT1:
  3743.     RRA         ; Shift it right
  3744.     LD  C,A     ; Re-save
  3745.     LD  A,D     ; Get NMSB
  3746.     RRA         ; Shift right with last bit
  3747.     LD  D,A     ; Re-save it
  3748.     LD  A,E     ; Get LSB
  3749.     RRA         ; Shift right with last bit
  3750.     LD  E,A     ; Re-save it
  3751.     LD  A,B     ; Get underflow
  3752.     RRA         ; Shift right with last bit
  3753.     LD  B,A     ; Re-save underflow
  3754.     JR  SHRLP       ; More bits to do
  3755.  
  3756. UNITY:
  3757.     .BYTE   $00,$00,$00,$81     ; 1.00000
  3758.  
  3759. LOGTAB:
  3760.     .BYTE   3       ; TABLE USED BY LOG
  3761.     .BYTE   $AA,$56,$19,$80     ; 0.59898
  3762.     .BYTE   $F1,$22,$76,$80     ; 0.96147
  3763.     .BYTE   $45,$AA,$38,$82     ; 2.88539
  3764. ;------------------------------------------------------------------------------
  3765. ; LOG
  3766. ;------------------------------------------------------------------------------
  3767. LOG:
  3768.     CALL    TSTSGN      ; Test sign of value
  3769.     OR  A
  3770.     JP  PE,FCERR        ; ?FC Error if <= zero
  3771.     LD  HL,FPEXP        ; Point to exponent
  3772.     LD  A,(HL)      ; Get exponent
  3773.     LD  BC,8035H        ; BCDE = SQR(1/2)
  3774.     LD  DE,04F3H
  3775.     SUB B       ; Scale value to be < 1
  3776.     PUSH    AF      ; Save scale factor
  3777.     LD  (HL),B      ; Save new exponent
  3778.     PUSH    DE      ; Save SQR(1/2)
  3779.     PUSH    BC
  3780.     CALL    FPADD       ; Add SQR(1/2) to value
  3781.     POP BC      ; Restore SQR(1/2)
  3782.     POP DE
  3783.     INC B       ; Make it SQR(2)
  3784.     CALL    DVBCDE      ; Divide by SQR(2)
  3785.     LD  HL,UNITY        ; Point to 1.
  3786.     CALL    SUBPHL      ; Subtract FPREG from 1
  3787.     LD  HL,LOGTAB       ; Coefficient table
  3788.     CALL    SUMSER      ; Evaluate sum of series
  3789.     LD  BC,8080H        ; BCDE = -0.5
  3790.     LD  DE,0000H
  3791.     CALL    FPADD       ; Subtract 0.5 from FPREG
  3792.     POP AF      ; Restore scale factor
  3793.     CALL    RSCALE      ; Re-scale number
  3794. MULLN2:
  3795.     LD  BC,8031H        ; BCDE = Ln(2)
  3796.     LD  DE,7218H
  3797.     .BYTE   21H     ; Skip "POP BC" and "POP DE"
  3798. ;------------------------------------------------------------------------------
  3799. ; FLOATING POINT MULTIPLY
  3800. ;------------------------------------------------------------------------------
  3801. MULT:
  3802.     POP BC      ; Get number from stack
  3803.     POP DE
  3804. FPMULT:
  3805.     CALL    TSTSGN      ; Test sign of FPREG
  3806.     RET Z       ; Return zero if zero
  3807.     LD  L,0     ; Flag add exponents
  3808.     CALL    ADDEXP      ; Add exponents
  3809.     LD  A,C     ; Get MSB of multiplier
  3810.     LD  (MULVAL),A  ; Save MSB of multiplier
  3811.     EX  DE,HL
  3812.     LD  (MULVAL+1),HL   ; Save rest of multiplier
  3813.     LD  BC,0        ; Partial product (BCDE) = zero
  3814.     LD  D,B
  3815.     LD  E,B
  3816.     LD  HL,BNORM        ; Address of normalise
  3817.     PUSH    HL      ; Save for return
  3818.     LD  HL,MULT8        ; Address of 8 bit multiply
  3819.     PUSH    HL      ; Save for NMSB,MSB
  3820.     PUSH    HL      ;
  3821.     LD  HL,FPREG        ; Point to number
  3822. MULT8:
  3823.     LD  A,(HL)      ; Get LSB of number
  3824.     INC HL      ; Point to NMSB
  3825.     OR  A       ; Test LSB
  3826.     JP  Z,BYTSFT        ; Zero - shift to next byte
  3827.     PUSH    HL      ; Save address of number
  3828.     LD  L,8     ; 8 bits to multiply by
  3829. MUL8LP:
  3830.     RRA         ; Shift LSB right
  3831.     LD  H,A     ; Save LSB
  3832.     LD  A,C     ; Get MSB
  3833.     JR  NC,NOMADD       ; Bit was zero - Don't add
  3834.     PUSH    HL      ; Save LSB and count
  3835.     LD  HL,(MULVAL+1)   ; Get LSB and NMSB
  3836.     ADD HL,DE       ; Add NMSB and LSB
  3837.     EX  DE,HL       ; Leave sum in DE
  3838.     POP HL      ; Restore MSB and count
  3839.     LD  A,(MULVAL)  ; Get MSB of multiplier
  3840.     ADC A,C     ; Add MSB
  3841. NOMADD:
  3842.     RRA         ; Shift MSB right
  3843.     LD  C,A     ; Re-save MSB
  3844.     LD  A,D     ; Get NMSB
  3845.     RRA         ; Shift NMSB right
  3846.     LD  D,A     ; Re-save NMSB
  3847.     LD  A,E     ; Get LSB
  3848.     RRA         ; Shift LSB right
  3849.     LD  E,A     ; Re-save LSB
  3850.     LD  A,B     ; Get VLSB
  3851.     RRA         ; Shift VLSB right
  3852.     LD  B,A     ; Re-save VLSB
  3853.     DEC L       ; Count bits multiplied
  3854.     LD  A,H     ; Get LSB of multiplier
  3855.     JR  NZ,MUL8LP       ; More - Do it
  3856. POPHRT:
  3857.     POP HL      ; Restore address of number
  3858.     RET
  3859.  
  3860. BYTSFT:
  3861.     LD  B,E     ; Shift partial product left
  3862.     LD  E,D
  3863.     LD  D,C
  3864.     LD  C,A
  3865.     RET
  3866.  
  3867. DIV10:
  3868.     CALL    STAKFP      ; Save FPREG on stack
  3869.     LD  BC,8420H        ; BCDE = 10.
  3870.     LD  DE,0000H
  3871.     CALL    FPBCDE      ; Move 10 to FPREG
  3872. ;------------------------------------------------------------------------------
  3873. ; Division  FPREG = (last) / FPREG
  3874. ;------------------------------------------------------------------------------
  3875. DIV:
  3876.     POP BC      ; Get number from stack
  3877.     POP DE
  3878. DVBCDE:
  3879.     CALL    TSTSGN      ; Test sign of FPREG
  3880.     JP  Z,DZERR     ; Error if division by zero
  3881.     LD  L,-1        ; Flag subtract exponents
  3882.     CALL    ADDEXP      ; Subtract exponents
  3883.     INC (HL)        ; Add 2 to exponent to adjust
  3884.     INC (HL)
  3885.     DEC HL      ; Point to MSB
  3886.     LD  A,(HL)      ; Get MSB of dividend
  3887.     LD  (DIV3),A        ; Save for subtraction
  3888.     DEC HL
  3889.     LD  A,(HL)      ; Get NMSB of dividend
  3890.     LD  (DIV2),A        ; Save for subtraction
  3891.     DEC HL
  3892.     LD  A,(HL)      ; Get MSB of dividend
  3893.     LD  (DIV1),A        ; Save for subtraction
  3894.     LD  B,C     ; Get MSB
  3895.     EX  DE,HL       ; NMSB,LSB to HL
  3896.     XOR A
  3897.     LD  C,A     ; Clear MSB of quotient
  3898.     LD  D,A     ; Clear NMSB of quotient
  3899.     LD  E,A     ; Clear LSB of quotient
  3900.     LD  (DIV4),A        ; Clear overflow count
  3901. DIVLP:
  3902.     PUSH    HL      ; Save divisor
  3903.     PUSH    BC
  3904.     LD  A,L     ; Get LSB of number
  3905.     CALL    DIVSUP      ; Subt' divisor from dividend
  3906.     SBC A,0     ; Count for overflows
  3907.     CCF
  3908.     JR  NC,RESDIV       ; Restore divisor if borrow
  3909.     LD  (DIV4),A        ; Re-save overflow count
  3910.     POP AF      ; Scrap divisor
  3911.     POP AF
  3912.     SCF         ; Set carry to
  3913.     .BYTE   0D2H        ; Skip "POP BC" and "POP HL"
  3914.  
  3915. RESDIV:
  3916.     POP BC      ; Restore divisor
  3917.     POP HL
  3918.     LD  A,C     ; Get MSB of quotient
  3919.     INC A
  3920.     DEC A
  3921.     RRA         ; Bit 0 to bit 7
  3922.     JP  M,RON.BYTE      ; Done - Normalise result
  3923.     RLA         ; Restore carry
  3924.     LD  A,E     ; Get LSB of quotient
  3925.     RLA         ; Double it
  3926.     LD  E,A     ; Put it back
  3927.     LD  A,D     ; Get NMSB of quotient
  3928.     RLA         ; Double it
  3929.     LD  D,A     ; Put it back
  3930.     LD  A,C     ; Get MSB of quotient
  3931.     RLA         ; Double it
  3932.     LD  C,A     ; Put it back
  3933.     ADD HL,HL       ; Double NMSB,LSB of divisor
  3934.     LD  A,B     ; Get MSB of divisor
  3935.     RLA         ; Double it
  3936.     LD  B,A     ; Put it back
  3937.     LD  A,(DIV4)        ; Get VLSB of quotient
  3938.     RLA         ; Double it
  3939.     LD  (DIV4),A        ; Put it back
  3940.     LD  A,C     ; Get MSB of quotient
  3941.     OR  D       ; Merge NMSB
  3942.     OR  E       ; Merge LSB
  3943.     JP  NZ,DIVLP        ; Not done - Keep dividing
  3944.     PUSH    HL      ; Save divisor
  3945.     LD  HL,FPEXP        ; Point to exponent
  3946.     DEC (HL)        ; Divide by 2
  3947.     POP HL      ; Restore divisor
  3948.     JP  NZ,DIVLP        ; Ok - Keep going
  3949.     JP  OVERR       ; Overflow error
  3950.  
  3951. ADDEXP:
  3952.     LD  A,B     ; Get exponent of dividend
  3953.     OR  A       ; Test it
  3954.     JR  Z,OVTST3        ; Zero - Result zero
  3955.     LD  A,L     ; Get add/subtract flag
  3956.     LD  HL,FPEXP        ; Point to exponent
  3957.     XOR (HL)        ; Add or subtract it
  3958.     ADD A,B     ; Add the other exponent
  3959.     LD  B,A     ; Save new exponent
  3960.     RRA         ; Test exponent for overflow
  3961.     XOR B
  3962.     LD  A,B     ; Get exponent
  3963.     JP  P,OVTST2        ; Positive - Test for overflow
  3964.     ADD A,80H       ; Add excess 128
  3965.     LD  (HL),A      ; Save new exponent
  3966.     JP  Z,POPHRT        ; Zero - Result zero
  3967.     CALL    SIGNS       ; Set MSBs and sign of result
  3968.     LD  (HL),A      ; Save new exponent
  3969.     DEC HL      ; Point to MSB
  3970.     RET
  3971.  
  3972. OVTST1:
  3973.     CALL    TSTSGN      ; Test sign of FPREG
  3974.     CPL         ; Invert sign
  3975.     POP HL      ; Clean up stack
  3976. OVTST2:
  3977.     OR  A       ; Test if new exponent zero
  3978. OVTST3:
  3979.     POP HL      ; Clear off return address
  3980.     JP  P,RESZER        ; Result zero
  3981.     JP  OVERR       ; Overflow error
  3982.  
  3983. MLSP10:
  3984.     CALL    BCDEFP      ; Move FPREG to BCDE
  3985.     LD  A,B     ; Get exponent
  3986.     OR  A       ; Is it zero?
  3987.     RET Z       ; Yes - Result is zero
  3988.     ADD A,2     ; Multiply by 4
  3989.     JP  C,OVERR     ; Overflow - ?OV Error
  3990.     LD  B,A     ; Re-save exponent
  3991.     CALL    FPADD       ; Add BCDE to FPREG (Times 5)
  3992.     LD  HL,FPEXP        ; Point to exponent
  3993.     INC (HL)        ; Double number (Times 10)
  3994.     RET NZ      ; Ok - Return
  3995.     JP  OVERR       ; Overflow error
  3996.  
  3997. TSTSGN:
  3998.     LD  A,(FPEXP)       ; Get sign of FPREG
  3999.     OR  A
  4000.     RET Z       ; RETurn if number is zero
  4001.     LD  A,(FPREG+2)     ; Get MSB of FPREG
  4002.     .BYTE   0FEH        ; Test sign = CP next byte
  4003. RETREL:
  4004.     CPL         ; Invert sign, compiles as 02FH
  4005.     RLA         ; Sign bit to carry
  4006. FLGDIF:
  4007.     SBC A,A     ; Carry to all bits of A
  4008.     RET NZ      ; Return -1 if negative
  4009.     INC A       ; Bump to +1
  4010.     RET         ; Positive - Return +1
  4011. ;------------------------------------------------------------------------------
  4012. ; SGN
  4013. ;------------------------------------------------------------------------------
  4014. SGN:
  4015.     CALL    TSTSGN      ; Test sign of FPREG
  4016. FLGREL:
  4017.     LD  B,80H+8     ; 8 bit integer in exponent
  4018.     LD  DE,0        ; Zero NMSB and LSB
  4019. RETINT:
  4020.     LD  HL,FPEXP        ; Point to exponent
  4021.     LD  C,A     ; CDE = MSB,NMSB and LSB
  4022.     LD  (HL),B      ; Save exponent
  4023.     LD  B,0     ; CDE = integer to normalise
  4024.     INC HL      ; Point to sign of result
  4025.     LD  (HL),80H        ; Set sign of result
  4026.     RLA         ; Carry = sign of integer
  4027.     JP  CONPOS      ; Set sign of result
  4028. ;------------------------------------------------------------------------------
  4029. ; ABS
  4030. ;------------------------------------------------------------------------------
  4031. ABS:
  4032.     CALL    TSTSGN      ; Test sign of FPREG
  4033.     RET P       ; Return if positive
  4034. INVSGN:
  4035.     LD  HL,FPREG+2  ; Point to MSB
  4036.     LD  A,(HL)      ; Get sign of mantissa
  4037.     XOR 80H     ; Invert sign of mantissa
  4038.     LD  (HL),A      ; Re-save sign of mantissa
  4039.     RET
  4040. ;------------------------------------------------------------------------------
  4041. ; Saves FPREG to stack
  4042. ;------------------------------------------------------------------------------
  4043. STAKFP:
  4044.     EX  DE,HL       ; Save code string address
  4045.     LD  HL,(FPREG)  ; LSB,NLSB of FPREG
  4046.     EX  (SP),HL     ; Stack them,get return
  4047.     PUSH    HL      ; Re-save return
  4048.     LD  HL,(FPREG+2)    ; MSB and exponent of FPREG
  4049.     EX  (SP),HL     ; Stack them,get return
  4050.     PUSH    HL      ; Re-save return
  4051.     EX  DE,HL       ; Restore code string address
  4052.     RET
  4053. ;------------------------------------------------------------------------------
  4054. ; Loads BCDE to FPREG
  4055. ;------------------------------------------------------------------------------
  4056. PHLTFP:
  4057.     CALL    LOADFP      ; Number at HL to BCDE
  4058. FPBCDE:
  4059.     EX  DE,HL       ; Save code string address
  4060.     LD  (FPREG),HL  ; Save LSB,NLSB of number
  4061.     LD  H,B     ; Exponent of number
  4062.     LD  L,C     ; MSB of number
  4063.     LD  (FPREG+2),HL    ; Save MSB and exponent
  4064.     EX  DE,HL       ; Restore code string address
  4065.     RET
  4066. ;------------------------------------------------------------------------------
  4067. ; Loads BCDE from FPREG
  4068. ;------------------------------------------------------------------------------
  4069. BCDEFP:
  4070.     LD  HL,FPREG        ; Point to FPREG
  4071. LOADFP:
  4072.     LD  E,(HL)      ; Get LSB of number
  4073.     INC HL
  4074.     LD  D,(HL)      ; Get NMSB of number
  4075.     INC HL
  4076.     LD  C,(HL)      ; Get MSB of number
  4077.     INC HL
  4078.     LD  B,(HL)      ; Get exponent of number
  4079. INCHL:
  4080.     INC HL      ; Used for conditional "INC HL"
  4081.     RET
  4082. ;------------------------------------------------------------------------------
  4083. ; Moves FPREG to (HL)
  4084. ;------------------------------------------------------------------------------
  4085. FPTHL:
  4086.     LD  DE,FPREG        ; Point to FPREG
  4087. DETHL4:
  4088.     LD  B,4     ; 4 bytes to move
  4089. DETHLB:
  4090.     LD  A,(DE)      ; Get source
  4091.     LD  (HL),A      ; Save destination
  4092.     INC DE      ; Next source
  4093.     INC HL      ; Next destination
  4094.     DEC B       ; Count bytes
  4095.     JR  NZ,DETHLB       ; Loop if more
  4096.     RET
  4097. ;------------------------------------------------------------------------------
  4098. SIGNS:
  4099.     LD  HL,FPREG+2  ; Point to MSB of FPREG
  4100.     LD  A,(HL)      ; Get MSB
  4101.     RLCA            ; Old sign to carry
  4102.     SCF         ; Set MSBit
  4103.     RRA         ; Set MSBit of MSB
  4104.     LD  (HL),A      ; Save new MSB
  4105.     CCF         ; Complement sign
  4106.     RRA         ; Old sign to carry
  4107.     INC HL
  4108.     INC HL
  4109.     LD  (HL),A      ; Set sign of result
  4110.     LD  A,C     ; Get MSB
  4111.     RLCA            ; Old sign to carry
  4112.     SCF         ; Set MSBit
  4113.     RRA         ; Set MSBit of MSB
  4114.     LD  C,A     ; Save MSB
  4115.     RRA
  4116.     XOR (HL)        ; New sign of result
  4117.     RET
  4118. ;------------------------------------------------------------------------------
  4119. ; Compare two FP numbers BCDE and FPREG with exponents
  4120. ;------------------------------------------------------------------------------
  4121. CMPNUM:
  4122.     LD  A,B     ; Get exponent of number
  4123.     OR  A
  4124.     JP  Z,TSTSGN        ; Zero - Test sign of FPREG
  4125.     LD  HL,RETREL       ; Return relation routine
  4126.     PUSH    HL      ; Save for return
  4127.     CALL    TSTSGN      ; Test sign of FPREG
  4128.     LD  A,C     ; Get MSB of number
  4129.     RET Z       ; FPREG zero - Number's MSB
  4130.     LD  HL,FPREG+2      ; MSB of FPREG
  4131.     XOR (HL)        ; Combine signs
  4132.     LD  A,C     ; Get MSB of number
  4133.     RET M       ; Exit if signs different
  4134.     CALL    CMPFP       ; Compare FP numbers
  4135.     RRA         ; Get carry to sign
  4136.     XOR C       ; Combine with MSB of number
  4137.     RET
  4138. ;------------------------------------------------------------------------------
  4139. ; Compare BCDE - FPREG, setting Z flag if =
  4140. ;------------------------------------------------------------------------------
  4141. CMPFP:
  4142.     INC HL      ; Point to exponent
  4143.     LD  A,B     ; Get exponent
  4144.     CP  (HL)        ; Compare exponents
  4145.     RET NZ      ; Different
  4146.     DEC HL      ; Point to MBS
  4147.     LD  A,C     ; Get MSB
  4148.     CP  (HL)        ; Compare MSBs
  4149.     RET NZ      ; Different
  4150.     DEC HL      ; Point to NMSB
  4151.     LD  A,D     ; Get NMSB
  4152.     CP  (HL)        ; Compare NMSBs
  4153.     RET NZ      ; Different
  4154.     DEC HL      ; Point to LSB
  4155.     LD  A,E     ; Get LSB
  4156.     SUB (HL)        ; Compare LSBs
  4157.     RET NZ      ; Different
  4158.     POP HL      ; Drop RETurn
  4159.     POP HL      ; Drop another RETurn
  4160.     RET
  4161. ;------------------------------------------------------------------------------
  4162. ; Convert FPREG to FPREG 24 Bit Integer format
  4163. ;------------------------------------------------------------------------------
  4164. FPINT:
  4165.     LD  B,A     ; <- Move
  4166.     LD  C,A     ; <- exponent
  4167.     LD  D,A     ; <- to all
  4168.     LD  E,A     ; <- bits
  4169.     OR  A       ; Test exponent
  4170.     RET Z       ; Zero - Return zero
  4171.     PUSH    HL      ; Save pointer to number
  4172.     CALL    BCDEFP      ; Move FPREG to BCDE
  4173.     CALL    SIGNS       ; Set MSBs & sign of result
  4174.     XOR (HL)        ; Combine with sign of FPREG
  4175.     LD  H,A     ; Save combined signs
  4176.     CALL    M,DCBCDE        ; Negative - Decrement BCDE
  4177.     LD  A,80H+24        ; 24 bits
  4178.     SUB B       ; Bits to shift
  4179.     CALL    SCALE       ; Shift BCDE
  4180.     LD  A,H     ; Get combined sign
  4181.     RLA         ; Sign to carry
  4182.     CALL    C,FPROND        ; Negative - Round number up
  4183.     LD  B,0     ; Zero exponent
  4184.     CALL    C,COMPL     ; If negative make positive
  4185.     POP HL      ; Restore pointer to number
  4186.     RET
  4187. ;------------------------------------------------------------------------------
  4188. ; Decrement BCDE number
  4189. ;------------------------------------------------------------------------------
  4190. DCBCDE:
  4191.     DEC DE      ; Decrement BCDE
  4192.     LD  A,D     ; Test LSBs
  4193.     AND E
  4194.     INC A
  4195.     RET NZ      ; Exit if LSBs not FFFF
  4196.     DEC BC      ; Decrement MSBs
  4197.     RET
  4198. ;------------------------------------------------------------------------------
  4199. ; INT
  4200. ;------------------------------------------------------------------------------
  4201. INT:
  4202.     LD  HL,FPEXP        ; Point to exponent
  4203.     LD  A,(HL)      ; Get exponent
  4204.     CP  80H+24      ; Integer accuracy only?
  4205.     LD  A,(FPREG)       ; Get LSB
  4206.     RET NC      ; Yes - Already integer
  4207.     LD  A,(HL)      ; Get exponent
  4208.     CALL    FPINT       ; F.P to integer
  4209.     LD  (HL),80H+24     ; Save 24 bit integer
  4210.     LD  A,E     ; Get LSB of number
  4211.     PUSH    AF      ; Save LSB
  4212.     LD  A,C     ; Get MSB of number
  4213.     RLA         ; Sign to carry
  4214.     CALL    CONPOS      ; Set sign of result
  4215.     POP AF      ; Restore LSB of number
  4216.     RET
  4217.  
  4218. MLDEBC:
  4219.     LD  HL,0        ; Clear partial product
  4220.     LD  A,B     ; Test multiplier
  4221.     OR  C
  4222.     RET Z       ; Return zero if zero
  4223.     LD  A,16        ; 16 bits
  4224. ML.BYTELP:
  4225.     ADD HL,HL       ; Shift P.P left
  4226.     JP  C,BSERR     ; ?BS Error if overflow
  4227.     EX  DE,HL
  4228.     ADD HL,HL       ; Shift multiplier left
  4229.     EX  DE,HL
  4230.     JR  NC,NOMLAD       ; Bit was zero - No add
  4231.     ADD HL,BC       ; Add multiplicand
  4232.     JP  C,BSERR     ; ?BS Error if overflow
  4233. NOMLAD:
  4234.     DEC A       ; Count bits
  4235.     JR  NZ,ML.BYTELP        ; More
  4236.     RET
  4237. ;------------------------------------------------------------------------------
  4238. ; Converts ASCII number to FP for computations
  4239. ;------------------------------------------------------------------------------
  4240. ASCTFP:
  4241.     CP  '-'     ; Negative?
  4242.     PUSH    AF      ; Save it and flags
  4243.     JP  Z,CNVNUM        ; Yes - Convert number
  4244.     CP  '+'     ; Positive?
  4245.     JR  Z,CNVNUM        ; Yes - Convert number
  4246.     DEC HL      ; DEC 'cos GETCHR INCs
  4247. CNVNUM:
  4248.     CALL    RESZER      ; Set result to zero
  4249.     LD  B,A     ; Digits after point counter
  4250.     LD  D,A     ; Sign of exponent
  4251.     LD  E,A     ; Exponent of ten
  4252.     CPL
  4253.     LD  C,A     ; Before or after point flag
  4254. MANLP:
  4255.     CALL    GETCHR      ; Get next character
  4256.     JR  C,ADDIG     ; Digit - Add to number
  4257.     CP  '.'
  4258.     JR  Z,DPOINT        ; "." - Flag point
  4259.     CP  'E'
  4260.     JR  NZ,CONEXP       ; Not "E" - Scale number
  4261.     CALL    GETCHR      ; Get next character
  4262.     CALL    SGNEXP      ; Get sign of exponent
  4263. EXPLP:
  4264.     CALL    GETCHR      ; Get next character
  4265.     JR  C,EDIGIT        ; Digit - Add to exponent
  4266.     INC D       ; Is sign negative?
  4267.     JR  NZ,CONEXP       ; No - Scale number
  4268.     XOR A
  4269.     SUB E       ; Negate exponent
  4270.     LD  E,A     ; And re-save it
  4271.     INC C       ; Flag end of number
  4272. DPOINT:
  4273.     INC C       ; Flag point passed
  4274.     JR  Z,MANLP     ; Zero - Get another digit
  4275. CONEXP:
  4276.     PUSH    HL      ; Save code string address
  4277.     LD  A,E     ; Get exponent
  4278.     SUB B       ; Subtract digits after point
  4279. SCALMI:
  4280.     CALL    P,SCALPL        ; Positive - Multiply number
  4281.     JP  P,ENDCON        ; Positive - All done
  4282.     PUSH    AF      ; Save number of times to /10
  4283.     CALL    DIV10       ; Divide by 10
  4284.     POP AF      ; Restore count
  4285.     INC A       ; Count divides
  4286.  
  4287. ENDCON:
  4288.     JR  NZ,SCALMI       ; More to do
  4289.     POP DE      ; Restore code string address
  4290.     POP AF      ; Restore sign of number
  4291.     CALL    Z,INVSGN        ; Negative - Negate number
  4292.     EX  DE,HL       ; Code string address to HL
  4293.     RET
  4294.  
  4295. SCALPL:
  4296.     RET Z       ; Exit if no scaling needed
  4297. MULTEN:
  4298.     PUSH    AF      ; Save count
  4299.     CALL    MLSP10      ; Multiply number by 10
  4300.     POP AF      ; Restore count
  4301.     DEC A       ; Count multiplies
  4302.     RET
  4303.  
  4304. ADDIG:
  4305.     PUSH    DE      ; Save sign of exponent
  4306.     LD  D,A     ; Save digit
  4307.     LD  A,B     ; Get digits after point
  4308.     ADC A,C     ; Add one if after point
  4309.     LD  B,A     ; Re-save counter
  4310.     PUSH    BC      ; Save point flags
  4311.     PUSH    HL      ; Save code string address
  4312.     PUSH    DE      ; Save digit
  4313.     CALL    MLSP10      ; Multiply number by 10
  4314.     POP AF      ; Restore digit
  4315.     SUB $30     ; Make it absolute
  4316.     CALL    RSCALE      ; Re-scale number
  4317.     POP HL      ; Restore code string address
  4318.     POP BC      ; Restore point flags
  4319.     POP DE      ; Restore sign of exponent
  4320.     JR  MANLP       ; Get another digit
  4321.  
  4322. RSCALE:
  4323.     CALL    STAKFP      ; Put number on stack
  4324.     CALL    FLGREL      ; Digit to add to FPREG
  4325. ;------------------------------------------------------------------------------
  4326. ; FP Addition
  4327. ;------------------------------------------------------------------------------
  4328. PADD:
  4329.     POP BC      ; Restore number
  4330.     POP DE
  4331.     JP  FPADD       ; Add BCDE to FPREG and return
  4332.  
  4333. EDIGIT:
  4334.     LD  A,E     ; Get digit
  4335.     RLCA            ; Times 2
  4336.     RLCA            ; Times 4
  4337.     ADD A,E     ; Times 5
  4338.     RLCA            ; Times 10
  4339.     ADD A,(HL)      ; Add next digit
  4340.     SUB $30     ; Make it absolute
  4341.     LD  E,A     ; Save new digit
  4342.     JP  EXPLP       ; Look for another digit
  4343. ;------------------------------------------------------------------------------
  4344. ; Prints " in " + Line number in HL for Error Handling
  4345. ;------------------------------------------------------------------------------
  4346. LINEIN:
  4347.     PUSH    HL      ; Save code string address
  4348.     LD  HL,INMSG        ; Output " in "
  4349.     CALL    PRS     ; Output string at HL
  4350.     POP HL      ; Restore code string address
  4351. ;------------------------------------------------------------------------------
  4352. ; Convert HL to ASCII and Print
  4353. ;------------------------------------------------------------------------------
  4354. PRNTHL:
  4355.     EX  DE,HL       ; Code string address to DE
  4356.     XOR A
  4357.     LD  B,80H+24        ; 24 bits
  4358.     CALL    RETINT      ; Return the integer
  4359.     LD  HL,PRNUMS       ; Print number string
  4360.     PUSH    HL      ; Save for return
  4361. ;------------------------------------------------------------------------------
  4362. ; Convert FPREG to ASCII in PBUFF
  4363. ;------------------------------------------------------------------------------
  4364. NUMASC:
  4365.     LD  HL,PBUFF        ; Convert number to ASCII
  4366.     PUSH    HL      ; Save for return
  4367.     CALL    TSTSGN      ; Test sign of FPREG
  4368.     LD  (HL),SPC        ; Space at start
  4369.     JP  P,SPCFST        ; Positive - Space to start
  4370.     LD  (HL),'-'        ; "-" sign at start
  4371. SPCFST:
  4372.     INC HL      ; First byte of number
  4373.     LD  (HL),'0'        ; "0" if zero
  4374.     JP  Z,JSTZER        ; Return "0" if zero
  4375.     PUSH    HL      ; Save buffer address
  4376.     CALL    M,INVSGN        ; Negate FPREG if negative
  4377.     XOR A       ; Zero A
  4378.     PUSH    AF      ; Save it
  4379.     CALL    RNGTST      ; Test number is in range
  4380. SIXDIG:
  4381.     LD  BC,9143H        ; BCDE - 99999.9
  4382.     LD  DE,4FF8H
  4383.     CALL    CMPNUM      ; Compare numbers
  4384.     OR  A
  4385.     JP  PO,INRNG        ; > 99999.9 - Sort it out
  4386.     POP AF      ; Restore count
  4387.     CALL    MULTEN      ; Multiply by ten
  4388.     PUSH    AF      ; Re-save count
  4389.     JR  SIXDIG      ; Test it again
  4390.  
  4391. GTSIXD:
  4392.     CALL    DIV10       ; Divide by 10
  4393.     POP AF      ; Get count
  4394.     INC A       ; Count divides
  4395.     PUSH    AF      ; Re-save count
  4396.     CALL    RNGTST      ; Test number is in range
  4397. INRNG:
  4398.     CALL    ROUND       ; Add 0.5 to FPREG
  4399.     INC A
  4400.     CALL    FPINT       ; F.P to integer
  4401.     CALL    FPBCDE      ; Move BCDE to FPREG
  4402.     LD  BC,0306H        ; 1E+06 to 1E-03 range
  4403.     POP AF      ; Restore count
  4404.     ADD A,C     ; 6 digits before point
  4405.     INC A       ; Add one
  4406.     JP  M,MAKNUM        ; Do it in "E" form if < 1E-02
  4407.     CP  6+1+1       ; More than 999999 ?
  4408.     JP  NC,MAKNUM       ; Yes - Do it in "E" form
  4409.     INC A       ; Adjust for exponent
  4410.     LD  B,A     ; Exponent of number
  4411.     LD  A,2     ; Make it zero after
  4412.  
  4413. MAKNUM:
  4414.     DEC A       ; Adjust for digits to do
  4415.     DEC A
  4416.     POP HL      ; Restore buffer address
  4417.     PUSH    AF      ; Save count
  4418.     LD  DE,POWERS       ; Powers of ten
  4419.     DEC B       ; Count digits before point
  4420.     JR  NZ,DIGTXT       ; Not zero - Do number
  4421.     LD  (HL),'.'        ; Save point
  4422.     INC HL      ; Move on
  4423.     LD  (HL),'0'        ; Save zero
  4424.     INC HL      ; Move on
  4425. DIGTXT:
  4426.     DEC B       ; Count digits before point
  4427.     LD  (HL),'.'        ; Save point in case
  4428.     CALL    Z,INCHL     ; Last digit - move on
  4429.     PUSH    BC      ; Save digits before point
  4430.     PUSH    HL      ; Save buffer address
  4431.     PUSH    DE      ; Save powers of ten
  4432.     CALL    BCDEFP      ; Move FPREG to BCDE
  4433.     POP HL      ; Powers of ten table
  4434.     LD  B,'0'-1     ; ASCII "0" - 1
  4435. TRYAGN:
  4436.     INC B       ; Count subtractions
  4437.     LD  A,E     ; Get LSB
  4438.     SUB (HL)        ; Subtract LSB
  4439.     LD  E,A     ; Save LSB
  4440.     INC HL
  4441.     LD  A,D     ; Get NMSB
  4442.     SBC A,(HL)      ; Subtract NMSB
  4443.     LD  D,A     ; Save NMSB
  4444.     INC HL
  4445.     LD  A,C     ; Get MSB
  4446.     SBC A,(HL)      ; Subtract MSB
  4447.     LD  C,A     ; Save MSB
  4448.     DEC HL      ; Point back to start
  4449.     DEC HL
  4450.     JR  NC,TRYAGN       ; No overflow - Try again
  4451.     CALL    PLUCDE      ; Restore number
  4452.     INC HL      ; Start of next number
  4453.     CALL    FPBCDE      ; Move BCDE to FPREG
  4454.     EX  DE,HL       ; Save point in table
  4455.     POP HL      ; Restore buffer address
  4456.     LD  (HL),B      ; Save digit in buffer
  4457.     INC HL      ; And move on
  4458.     POP BC      ; Restore digit count
  4459.     DEC C       ; Count digits
  4460.     JR  NZ,DIGTXT       ; More - Do them
  4461.     DEC B       ; Any decimal part?
  4462.     JR  Z,DOEBIT        ; No - Do "E" bit
  4463. SUPTLZ:
  4464.     DEC HL      ; Move back through buffer
  4465.     LD  A,(HL)      ; Get character
  4466.     CP  $30     ; "0" character?
  4467.     JR  Z,SUPTLZ        ; Yes - Look back for more
  4468.     CP  '.'     ; A decimal point?
  4469.     CALL    NZ,INCHL        ; Move back over digit
  4470.  
  4471. DOEBIT:
  4472.     POP AF      ; Get "E" flag
  4473.     JR  Z,NOENED        ; No "E" needed - End buffer
  4474.     LD  (HL),'E'        ; Put "E" in buffer
  4475.     INC HL      ; And move on
  4476.     LD  (HL),'+'        ; Put '+' in buffer
  4477.     JP  P,OUTEXP        ; Positive - Output exponent
  4478.     LD  (HL),'-'        ; Put "-" in buffer
  4479.     CPL         ; Negate exponent
  4480.     INC A
  4481. OUTEXP:
  4482.     LD  B,$2F       ; ASCII "0" - 1
  4483. EXPTEN:
  4484.     INC B       ; Count subtractions
  4485.     SUB 10      ; Tens digit
  4486.     JR  NC,EXPTEN       ; More to do
  4487.     ADD A,$30+10        ; Restore and make ASCII
  4488.     INC HL      ; Move on
  4489.     LD  (HL),B      ; Save MSB of exponent
  4490. JSTZER:
  4491.     INC HL      ;
  4492.     LD  (HL),A      ; Save LSB of exponent
  4493.     INC HL
  4494. NOENED:
  4495.     LD  (HL),C      ; Mark end of buffer
  4496.     POP HL      ; Restore code string address
  4497.     RET
  4498.  
  4499. RNGTST:
  4500.     LD  BC,9474H        ; BCDE = 999999.
  4501.     LD  DE,23F7H
  4502.     CALL    CMPNUM      ; Compare numbers
  4503.     OR  A
  4504.     POP HL      ; Return address to HL
  4505.     JP  PO,GTSIXD       ; Too big - Divide by ten
  4506.     JP  (HL)        ; Otherwise return to caller
  4507. ;------------------------------------------------------------------------------
  4508. ;   FP REGISTERS E,D,C,B
  4509. HALF    .BYTE   $00,$00,$00,$80     ;0.5
  4510. ;------------------------------------------------------------------------------
  4511. POWERS  .BYTE   $A0,$86,$01 ; 100000
  4512.     .BYTE   $10,$27,$00 ; 10000
  4513.     .BYTE   $E8,$03,$00 ; 1000
  4514.     .BYTE   $64,$00,$00 ; 100
  4515.     .BYTE   $0A,$00,$00 ; 10
  4516.     .BYTE   $01,$00,$00 ; 1
  4517. ;------------------------------------------------------------------------------
  4518. NEGAFT:
  4519.     LD  HL,INVSGN       ; Negate result
  4520.     EX  (SP),HL     ; To be done after caller
  4521.     JP  (HL)        ; Return to caller
  4522. ;------------------------------------------------------------------------------
  4523. ; SQR
  4524. ;------------------------------------------------------------------------------
  4525. SQR:
  4526.     CALL    STAKFP      ; Put value on stack
  4527.     LD  HL,HALF     ; Set power to 1/2
  4528.     CALL    PHLTFP      ; Move 1/2 to FPREG
  4529. ;------------------------------------------------------------------------------
  4530. ; FPREG = (last) ^ FPREG
  4531. ;------------------------------------------------------------------------------
  4532. POWER:
  4533.     POP BC      ; Get base
  4534.     POP DE
  4535.     CALL    TSTSGN      ; Test sign of power
  4536.     LD  A,B     ; Get exponent of base
  4537.     JR  Z,EXP       ; Make result 1 if zero
  4538.     JP  P,POWER1        ; Positive base - Ok
  4539.     OR  A       ; Zero to negative power?
  4540.     JP  Z,DZERR     ; Yes - ?/0 Error
  4541. POWER1:
  4542.     OR  A       ; Base zero?
  4543.     JP  Z,SAVEXP        ; Yes - Return zero
  4544.     PUSH    DE      ; Save base
  4545.     PUSH    BC
  4546.     LD  A,C     ; Get MSB of base
  4547.     OR  01111111B       ; Get sign status
  4548.     CALL    BCDEFP      ; Move power to BCDE
  4549.     JP  P,POWER2        ; Positive base - Ok
  4550.     PUSH    DE      ; Save power
  4551.     PUSH    BC
  4552.     CALL    INT     ; Get integer of power
  4553.     POP BC      ; Restore power
  4554.     POP DE
  4555.     PUSH    AF      ; MSB of base
  4556.     CALL    CMPNUM      ; Power an integer?
  4557.     POP HL      ; Restore MSB of base
  4558.     LD  A,H     ; but don't affect flags
  4559.     RRA         ; Exponent odd or even?
  4560. POWER2:
  4561.     POP HL      ; Restore MSB and exponent
  4562.     LD  (FPREG+2),HL    ; Save base in FPREG
  4563.     POP HL      ; LSBs of base
  4564.     LD  (FPREG),HL  ; Save in FPREG
  4565.     CALL    C,NEGAFT        ; Odd power - Negate result
  4566.     CALL    Z,INVSGN        ; Negative base - Negate it
  4567.     PUSH    DE      ; Save power
  4568.     PUSH    BC
  4569.     CALL    LOG     ; Get LOG of base
  4570.     POP BC      ; Restore power
  4571.     POP DE
  4572.     CALL    FPMULT      ; Multiply LOG by power
  4573. ;------------------------------------------------------------------------------
  4574. ; EXP
  4575. ;------------------------------------------------------------------------------
  4576. EXP:
  4577.     CALL    STAKFP      ; Put value on stack
  4578.     LD  BC,$8138        ; BCDE = 1/Ln(2)
  4579.     LD  DE,$AA3B
  4580.     CALL    FPMULT      ; Multiply value by 1/LN(2)
  4581.     LD  A,(FPEXP)       ; Get exponent
  4582.     CP  80H+8       ; Is it in range?
  4583.     JP  NC,OVTST1       ; No - Test for overflow
  4584.     CALL    INT     ; Get INT of FPREG
  4585.     ADD A,80H       ; For excess 128
  4586.     ADD A,2     ; Exponent > 126?
  4587.     JP  C,OVTST1        ; Yes - Test for overflow
  4588.     PUSH    AF      ; Save scaling factor
  4589.     LD  HL,UNITY        ; Point to 1.
  4590.     CALL    ADDPHL      ; Add 1 to FPREG
  4591.     CALL    MULLN2      ; Multiply by LN(2)
  4592.     POP AF      ; Restore scaling factor
  4593.     POP BC      ; Restore exponent
  4594.     POP DE
  4595.     PUSH    AF      ; Save scaling factor
  4596.     CALL    SUBCDE      ; Subtract exponent from FPREG
  4597.     CALL    INVSGN      ; Negate result
  4598.     LD  HL,EXPTAB       ; Coefficient table
  4599.     CALL    SMSER1      ; Sum the series
  4600.     LD  DE,0        ; Zero LSBs
  4601.     POP BC      ; Scaling factor
  4602.     LD  C,D     ; Zero MSB
  4603.     JP  FPMULT      ; Scale result to correct value
  4604.  
  4605. EXPTAB:
  4606.     .BYTE   8       ; Table used by EXP
  4607.     .BYTE   $40,$2E,$94,$74 ; -1/7! (-1/5040)
  4608.     .BYTE   $70,$4F,$2E,$77 ; 1/6! ( 1/720)
  4609.     .BYTE   $6E,$02,$88,$7A ; -1/5! (-1/120)
  4610.     .BYTE   $E6,$A0,$2A,$7C ; 1/4! ( 1/24)
  4611.     .BYTE   $50,$AA,$AA,$7E ; -1/3! (-1/6)
  4612.     .BYTE   $FF,$FF,$7F,$7F ; 1/2! ( 1/2)
  4613.     .BYTE   $00,$00,$80,$81 ; -1/1! (-1/1)
  4614.     .BYTE   $00,$00,$00,$81 ; 1/0! ( 1/1)
  4615.  
  4616. SUMSER:
  4617.     CALL    STAKFP      ; Put FPREG on stack
  4618.     LD  DE,MULT     ; Multiply by "X"
  4619.     PUSH    DE      ; To be done after
  4620.     PUSH    HL      ; Save address of table
  4621.     CALL    BCDEFP      ; Move FPREG to BCDE
  4622.     CALL    FPMULT      ; Square the value
  4623.     POP HL      ; Restore address of table
  4624. SMSER1:
  4625.     CALL    STAKFP      ; Put value on stack
  4626.     LD  A,(HL)      ; Get number of coefficients
  4627.     INC HL      ; Point to start of table
  4628.     CALL    PHLTFP      ; Move coefficient to FPREG
  4629.     .BYTE   06H     ; Skip "POP AF"
  4630. SUMLP:
  4631.     POP AF      ; Restore count
  4632.     POP BC      ; Restore number
  4633.     POP DE
  4634.     DEC A       ; Cont coefficients
  4635.     RET Z       ; All done
  4636.     PUSH    DE      ; Save number
  4637.     PUSH    BC
  4638.     PUSH    AF      ; Save count
  4639.     PUSH    HL      ; Save address in table
  4640.     CALL    FPMULT      ; Multiply FPREG by BCDE
  4641.     POP HL      ; Restore address in table
  4642.     CALL    LOADFP      ; Number at HL to BCDE
  4643.     PUSH    HL      ; Save address in table
  4644.     CALL    FPADD       ; Add coefficient to FPREG
  4645.     POP HL      ; Restore address in table
  4646.     JR  SUMLP       ; More coefficients
  4647. ;------------------------------------------------------------------------------
  4648. ; Random number generator
  4649. ;------------------------------------------------------------------------------
  4650. RND:
  4651.     CALL    TSTSGN      ; Test sign of FPREG
  4652.     LD  HL,SEED+2       ; Random number seed
  4653.     JP  M,RESEED        ; Negative - Re-seed
  4654.     LD  HL,LSTRND       ; Last random number
  4655.     CALL    PHLTFP      ; Move last RND to FPREG
  4656.     LD  HL,SEED+2       ; Random number seed
  4657.     RET Z       ; Return if RND(0)
  4658.     ADD A,(HL)      ; Add (SEED)+2)
  4659.     AND 00000111B       ; 0 to 7
  4660.     LD  B,0
  4661.     LD  (HL),A      ; Re-save seed
  4662.     INC HL      ; Move to coefficient table
  4663.     ADD A,A     ; 4 bytes
  4664.     ADD A,A     ; per entry
  4665.     LD  C,A     ; BC = Offset into table
  4666.     ADD HL,BC       ; Point to coefficient
  4667.     CALL    LOADFP      ; Coefficient to BCDE
  4668.     CALL    FPMULT      ; Multiply FPREG by coefficient
  4669.     LD  A,(SEED+1)  ; Get (SEED+1)
  4670.     INC A       ; Add 1
  4671.     AND 00000011B       ; 0 to 3
  4672.     LD  B,0
  4673.     CP  1       ; Is it zero?
  4674.     ADC A,B     ; Yes - Make it 1
  4675.     LD  (SEED+1),A  ; Re-save seed
  4676.     LD  HL,RNDTAB-4 ; Addition table
  4677.     ADD A,A     ; 4 bytes
  4678.     ADD A,A     ; per entry
  4679.     LD  C,A     ; BC = Offset into table
  4680.     ADD HL,BC       ; Point to value
  4681.     CALL    ADDPHL      ; Add value to FPREG
  4682. RND1:
  4683.     CALL    BCDEFP      ; Move FPREG to BCDE
  4684.     LD  A,E     ; Get LSB
  4685.     LD  E,C     ; LSB = MSB
  4686.     XOR 01001111B       ; Fiddle around
  4687.     LD  C,A     ; New MSB
  4688.     LD  (HL),80H        ; Set exponent
  4689.     DEC HL      ; Point to MSB
  4690.     LD  B,(HL)      ; Get MSB
  4691.     LD  (HL),80H        ; Make value -0.5
  4692.     LD  HL,SEED     ; Random number seed
  4693.     INC (HL)        ; Count seed
  4694.     LD  A,(HL)      ; Get seed
  4695.     SUB 171     ; Do it modulo 171
  4696.     JR  NZ,RND2     ; Non-zero - Ok
  4697.     LD  (HL),A      ; Zero seed
  4698.     INC C       ; Fillde about
  4699.     DEC D       ; with the
  4700.     INC E       ; number
  4701. RND2:
  4702.     CALL    BNORM       ; Normalise number
  4703.     LD  HL,LSTRND       ; Save random number
  4704.     JP  FPTHL       ; Move FPREG to last and return
  4705.  
  4706. RESEED:
  4707.     LD  (HL),A      ; Re-seed random numbers
  4708.     DEC HL
  4709.     LD  (HL),A
  4710.     DEC HL
  4711.     LD  (HL),A
  4712.     JR  RND1        ; Return RND seed
  4713.  
  4714. RNDTAB:
  4715.     .BYTE   068H,0B1H,046H,068H ; Table used by RND
  4716.     .BYTE   099H,0E9H,092H,069H
  4717.     .BYTE   010H,0D1H,075H,068H
  4718. ;------------------------------------------------------------------------------
  4719. ; COS, SIN
  4720. ;------------------------------------------------------------------------------
  4721. COS:
  4722.     LD  HL,HALFPI       ; Point to PI/2
  4723.     CALL    ADDPHL      ; Add it to PPREG
  4724. SIN:
  4725.     CALL    STAKFP      ; Put angle on stack
  4726.     LD  BC,8349H        ; BCDE = 2 PI
  4727.     LD  DE,0FDBH
  4728.     CALL    FPBCDE      ; Move 2 PI to FPREG
  4729.     POP BC      ; Restore angle
  4730.     POP DE
  4731.     CALL    DVBCDE      ; Divide angle by 2 PI
  4732.     CALL    STAKFP      ; Put it on stack
  4733.     CALL    INT     ; Get INT of result
  4734.     POP BC      ; Restore number
  4735.     POP DE
  4736.     CALL    SUBCDE      ; Make it 0 <= value < 1
  4737.     LD  HL,QUARTR       ; Point to 0.25
  4738.     CALL    SUBPHL      ; Subtract value from 0.25
  4739.     CALL    TSTSGN      ; Test sign of value
  4740.     SCF         ; Flag positive
  4741.     JP  P,SIN1      ; Positive - Ok
  4742.     CALL    ROUND       ; Add 0.5 to value
  4743.     CALL    TSTSGN      ; Test sign of value
  4744.     OR  A       ; Flag negative
  4745. SIN1:
  4746.     PUSH    AF      ; Save sign
  4747.     CALL    P,INVSGN        ; Negate value if positive
  4748.     LD  HL,QUARTR       ; Point to 0.25
  4749.     CALL    ADDPHL      ; Add 0.25 to value
  4750.     POP AF      ; Restore sign
  4751.     CALL    NC,INVSGN       ; Negative - Make positive
  4752.     LD  HL,SINTAB       ; Coefficient table
  4753.     JP  SUMSER      ; Evaluate sum of series
  4754.  
  4755. HALFPI:
  4756.     .BYTE   0DBH,00FH,049H,081H ; 1.5708 (PI/2)
  4757.  
  4758. QUARTR:
  4759.     .BYTE   000H,000H,000H,07FH ; 0.25
  4760.  
  4761. SINTAB:
  4762.     .BYTE   5       ; Table used by SIN
  4763.     .BYTE   0BAH,0D7H,01EH,086H ; 39.711
  4764.     .BYTE   064H,026H,099H,087H ; -76.575
  4765.     .BYTE   058H,034H,023H,087H ; 81.602
  4766.     .BYTE   0E0H,05DH,0A5H,086H ; -41.342
  4767.     .BYTE   0DAH,00FH,049H,083H ; 6.2832
  4768. ;------------------------------------------------------------------------------
  4769. ; TANgent
  4770. ;------------------------------------------------------------------------------
  4771. TAN:
  4772.     CALL    STAKFP      ; Put angle on stack
  4773.     CALL    SIN     ; Get SIN of angle
  4774.     POP BC      ; Restore angle
  4775.     POP HL
  4776.     CALL    STAKFP      ; Save SIN of angle
  4777.     EX  DE,HL       ; BCDE = Angle
  4778.     CALL    FPBCDE      ; Angle to FPREG
  4779.     CALL    COS     ; Get COS of angle
  4780.     JP  DIV     ; TAN = SIN / COS
  4781. ;------------------------------------------------------------------------------
  4782. ; Arctangent
  4783. ;------------------------------------------------------------------------------
  4784. ATN:
  4785.     CALL    TSTSGN      ; Test sign of value
  4786.     CALL    M,NEGAFT        ; Negate result after if -ve
  4787.     CALL    M,INVSGN        ; Negate value if -ve
  4788.     LD  A,(FPEXP)       ; Get exponent
  4789.     CP  81H     ; Number less than 1?
  4790.     JP  C,ATN1      ; Yes - Get arc tangnt
  4791.     LD  BC,8100H        ; BCDE = 1
  4792.     LD  D,C
  4793.     LD  E,C
  4794.     CALL    DVBCDE      ; Get reciprocal of number
  4795.     LD  HL,SUBPHL       ; Sub angle from PI/2
  4796.     PUSH    HL      ; Save for angle > 1
  4797. ATN1:
  4798.     LD  HL,ATNTAB       ; Coefficient table
  4799.     CALL    SUMSER      ; Evaluate sum of series
  4800.     LD  HL,HALFPI       ; PI/2 - angle in case > 1
  4801.     RET         ; Number > 1 - Sub from PI/2
  4802.  
  4803. ATNTAB:
  4804.     .BYTE   9       ; Table used by ATN
  4805.     .BYTE   04AH,0D7H,03BH,078H ; 1/17
  4806.     .BYTE   002H,06EH,084H,07BH ; -1/15
  4807.     .BYTE   0FEH,0C1H,02FH,07CH ; 1/13
  4808.     .BYTE   074H,031H,09AH,07DH ; -1/11
  4809.     .BYTE   084H,03DH,05AH,07DH ; 1/9
  4810.     .BYTE   0C8H,07FH,091H,07EH ; -1/7
  4811.     .BYTE   0E4H,0BBH,04CH,07EH ; 1/5
  4812.     .BYTE   06CH,0AAH,0AAH,07FH ; -1/3
  4813.     .BYTE   000H,000H,000H,081H ; 1/1
  4814. ;------------------------------------------------------------------------------
  4815. ;   End of F L O A T I N G  P O I N T   M A T H
  4816. ;------------------------------------------------------------------------------
  4817.  
  4818. ;------------------------------------------------------------------------------
  4819. ; HARDWARE SPECIFIC ROUTINES
  4820. ;------------------------------------------------------------------------------
  4821. WAITCR:
  4822.     CALL    INKEY       ; Get a character in
  4823.     CP  BREAK       ; Is it <Break>?
  4824.     JP  Z,PRTRDY    ; Go to prompt
  4825.     CP  CR      ; Is it <Enter>?
  4826.     JR  NZ,WAITCR   ; No, keep looking
  4827.     RET         ; Yes, return to calling routine
  4828. ;------------------------------------------------------------------------------
  4829. ; OUTPUT CHARACTER ROUTINE
  4830. ;------------------------------------------------------------------------------
  4831. OUTC:
  4832.     PUSH    AF      ; Save character
  4833.     LD  A,(CTLOFG)  ; Get control "O" flag
  4834.     OR  A       ; Is it set?
  4835.     JP  NZ,POPAF    ; Yes - don't output
  4836.     POP AF      ; Restore character
  4837.     PUSH    BC      ; Save buffer length
  4838.     PUSH    AF      ; Save character
  4839.     CP  SPC     ; Is it a control code?
  4840.     JR  C,DINPOS    ; Yes - Don't INC POS(X)
  4841.     LD  A,(LWIDTH)  ; Get line width
  4842.     LD  B,A     ; To B
  4843.     LD  A,(CURPOS)  ; Get cursor position
  4844.     INC B       ; Width 255?
  4845.     JR  Z,INCLEN    ; Yes - No width limit
  4846.     DEC B       ; Restore width
  4847.     CP  B       ; At end of line?
  4848.     CALL    Z,PRNTCR    ; Yes - output CRLF
  4849. INCLEN:
  4850.     INC A       ; Move on one character
  4851.     LD  (CURPOS),A  ; Save new position
  4852. DINPOS:
  4853.     POP AF      ; Restore character
  4854.     POP BC      ; Restore buffer length
  4855.     PUSH    AF      ; Save character
  4856.     PUSH    BC      ; Save buffer length
  4857.     LD  C,A     ; Character to C
  4858.  
  4859.     RST 08H     ; Send it
  4860.  
  4861.     POP BC      ; Restore buffer length
  4862.     POP AF      ; Restore character
  4863.     RET
  4864. ;------------------------------------------------------------------------------
  4865. ; SCREEN Sets the cursor at screen location (x,y)
  4866. ;------------------------------------------------------------------------------
  4867. SCREEN:
  4868.     CALL    GETINT      ; Get integer 0 to 255
  4869.     PUSH    AF      ; Save column
  4870.     CALL    CHKSYN      ; Make sure "," follows
  4871.     .BYTE   ','
  4872.     CALL    GETINT      ; Get integer 0 to 255
  4873.     POP BC      ; Column to B
  4874.     PUSH    HL      ; Save code string address
  4875.     PUSH    BC      ; Save column
  4876.     CALL    SCRADR      ; Calculate screen address
  4877.     CALL    SETCSR      ; Set new cursor position
  4878.     POP HL      ; Rstore code string address
  4879.     RET
  4880. ;------------------------------------------------------------------------------
  4881. ; Set a pixel at X,Y
  4882. ;------------------------------------------------------------------------------
  4883. PSET:
  4884.     CALL    GETXY       ; GET (X,Y)
  4885.     PUSH    AF  ; Save bit mask
  4886.     LD  A,(HL)  ; Get character from screen
  4887.     CP  11000000B   ; Is it a block graphic?
  4888.     JP  NC,SETOR    ; Yes - OR new bit
  4889.     POP AF  ; Restore bit mask
  4890. PUTBIT:
  4891.     LD  (HL),A  ; Put character on screen
  4892. RESCSA:
  4893.     PUSH    IY  ; Restore code string address
  4894.     POP HL  ; From IY
  4895.     RET
  4896.  
  4897. SETOR:
  4898.     POP BC  ; Restore bit mask
  4899.     OR  B   ; Merge the bits
  4900.     JP  PUTBIT  ; Save on screen
  4901. ;------------------------------------------------------------------------------
  4902. ; Clear a pixel at X,Y
  4903. ;------------------------------------------------------------------------------
  4904. RESET:
  4905.     CALL    GETXY       ; GET (X,Y)
  4906.     PUSH    AF  ; Save bit mask
  4907.     LD  A,(HL)  ; Get byte from screen
  4908.     CP  11000000B   ; Is it a block graphic?
  4909.     JP  C,NORES ; No - Leave it
  4910.     LD  B,00111111B ; Six bits per block
  4911.     AND B   ; Clear bits 7 & 6
  4912.     POP BC  ; Get bit mask
  4913.     AND B   ; Test for common bit
  4914.     JP  Z,RESCSA    ; None - Leave it
  4915.     LD  A,(HL)  ; Get byte from screen
  4916.     AND 00111111B   ; Isolate bit
  4917.     XOR B   ; Clear that bit
  4918.     CP  11000000B   ; Is it a graphic blank?
  4919.     JP  NZ,PUTBIT   ; No - Save character
  4920.     LD  A,' '   ; Put a space there
  4921.     JP  PUTBIT  ; Save the space
  4922.    
  4923. NORES:
  4924.     POP BC  ; Drop bit mask
  4925.     JP  RESCSA  ; Restore code string address  
  4926. ;------------------------------------------------------------------------------
  4927. ; Check if pixel is set at X,Y
  4928. ;------------------------------------------------------------------------------
  4929. POINT:
  4930.     CALL    GETXY   ; GET (X,Y)
  4931.     LD  B,(HL)  ; Get character from screen
  4932.     PUSH    AF  ; Test bit
  4933.     AND B   ; Get common bits
  4934.     POP BC  ; Restore bit mask
  4935.     CP  B
  4936.     JP  NZ,POINT0 ; Different - Return zero
  4937.     LD  A,0
  4938.     LD  B,1 ; Integer AB = 1
  4939. POINTX:
  4940.     POP HL  ; Drop return
  4941.     PUSH    IY  ; PUSH code string address
  4942.     LD  DE,RETNUM ; To return a number
  4943.     PUSH    DE  ; Save for return
  4944.     JP  ABPASS  ; Return integer AB
  4945.  
  4946. POINT0:
  4947.     LD  B,0 ; Set zero
  4948.     JP  POINTX  ; Return value
  4949.    
  4950. GETXYA:
  4951.     POP BC  ; Get return address
  4952.     POP HL  ; Get column
  4953.     PUSH    HL  ; And re-save
  4954.     PUSH    BC  ; Put back return address
  4955.     LD  A,L ; Get column
  4956.     LD  B,01H   ; 2 bits per character
  4957.     AND B   ; Odd or even bit
  4958.     PUSH    AF  ; Save it
  4959.     PUSH    DE  ; Get row
  4960.     POP HL  ; to HL
  4961.     LD  DE,0    ; Zero line count
  4962.     LD  BC,3    ; 3 blocks per line
  4963.     INC HL
  4964. DIV3LP:     SBC HL,BC   ; Subtract 3
  4965.     INC DE  ; Count the subtractions
  4966.     JP  Z,DIV3EX    ; Exactly - Exit
  4967.     JP  P,DIV3LP    ; More to do
  4968.  
  4969. DIV3EX:     ADD HL,BC   ; Restore number
  4970.     POP AF  ; Restore column and odd/even
  4971.     OR  A   ; Set flags (NZ or Z)
  4972.     LD  A,L ; Get remainder from /3
  4973.     JP  Z,NOREMD    ; No remainder
  4974.     ADD A,3 ; Adjust remainder
  4975. NOREMD:
  4976.     LD  B,A ; Bit number+1 to B
  4977.     LD  A,00000001B ; Bit to rotate
  4978. SHFTBT:
  4979.     RLCA        ; Shift bit left
  4980.     DJNZ    SHFTBT  ; Count shifts
  4981.     RRA     ; Restore correct place
  4982.     RET
  4983.  
  4984. ADJCOL: POP BC  ; Restore return address
  4985.     POP AF  ; Get bit mask
  4986.     POP HL  ; Get column
  4987.     PUSH    AF  ; Re-save but mask
  4988.     LD  A,L ; Get column
  4989.     RRA     ; Divide by 2
  4990.     ADD A,1 ; Start at column 1
  4991.     AND 00111111B   ; 0 to 63
  4992.     LD  H,A ; Save column in H
  4993.     PUSH    HL  ; Re-save column
  4994.     PUSH    BC  ; Put back return
  4995.     LD  A,E ; Get row
  4996.     RET
  4997. ;------------------------------------------------------------------------------
  4998. GETXY:  CALL    CHKSYN  ; Make sure "(" follows
  4999.     .BYTE   "("
  5000.     CALL    GETNUM  ; Get a number
  5001.     CALL    DEINT   ; Get integer -32768 to 32767
  5002.     PUSH    DE  ; Save "X"
  5003.     CALL    CHKSYN  ; Make sure "," follows
  5004.     .BYTE   ","
  5005.     CALL    GETNUM  ; Get a number
  5006.     CALL    CHKSYN  ; Make sure ")" follows
  5007.     .BYTE   ")"
  5008.     CALL    DEINT   ; Get integer -32768 to 32767
  5009.     PUSH    HL  ; Save code string address
  5010.     POP IY  ; In IY
  5011.     CALL    GETXYA  ; Address and bit mask
  5012.     PUSH    AF  ; Save mask
  5013.     CALL    ADJCOL  ; Adjust column
  5014.     CALL    SCRADR  ; Get Video Ram address
  5015.     POP AF  ; Restore bit mask
  5016.     LD  B,0C0H  ; Block graphics base
  5017.     OR  B   ; Set bits 7 & 6
  5018.     RET
  5019. ;------------------------------------------------------------------------------
  5020. SCRADR:
  5021.     LD  HL,VIDBASE
  5022.     LD  B,0
  5023.     LD  C,A ; Line to BC
  5024.     OR  A
  5025.     JP  Z,FCERR
  5026.     CP  24
  5027.     JP  P,FCERR ; > 24 lines
  5028.     POP DE  ; RETurn address
  5029.     POP AF  ; Get column
  5030.     PUSH    DE  ; Resave Return
  5031.     LD  D,0
  5032.     LD  E,A ; Column to DE
  5033.     OR  A
  5034.     JP  Z,FCERR
  5035.     CP  80+1    ; 80 columns
  5036.     JP  P,FCERR
  5037.     ADD HL,DE   ; Add column to address
  5038.     LD  D,0
  5039.     LD  E,C ; Line to DE
  5040.     LD  B,80    ; 80 times
  5041. ADD80X:
  5042.     ADD HL,DE
  5043.     DJNZ    ADD80X
  5044.     RET
  5045. ;------------------------------------------------------------------------------
  5046.  
  5047. ;------------------------------------------------------------------------------
  5048. LOAD:
  5049.     RET     ; No loads for now
  5050. SAVE:
  5051.     RET     ; No saves for now, either.
  5052. ;------------------------------------------------------------------------------
  5053. ;------------------------------------------------------------------------------
  5054. ; FUNCTION ADDRESS TABLE
  5055. ;------------------------------------------------------------------------------
  5056. ;------------------------------------------------------------------------------
  5057. FNCTAB:
  5058.     .WORD   SGN
  5059.     .WORD   INT
  5060.     .WORD   ABS
  5061.     .WORD   USR
  5062.     .WORD   FRE
  5063.     .WORD   INP
  5064.     .WORD   POS
  5065.     .WORD   SQR
  5066.     .WORD   RND
  5067.     .WORD   LOG
  5068.     .WORD   EXP
  5069.     .WORD   COS
  5070.     .WORD   SIN
  5071.     .WORD   TAN
  5072.     .WORD   ATN
  5073.     .WORD   PEEK
  5074.     .WORD   HEX
  5075.     .WORD   POINT
  5076.     .WORD   LEN
  5077.     .WORD   STR
  5078.     .WORD   VAL
  5079.     .WORD   ASC
  5080.     .WORD   CHR
  5081.     .WORD   LEFT
  5082.     .WORD   RIGHT
  5083.     .WORD   MID
  5084. ;------------------------------------------------------------------------------
  5085. ; RESERVED WORD LIST
  5086. ;------------------------------------------------------------------------------
  5087. WORDS:
  5088.     .BYTE   'E'+ $80,"ND"
  5089.     .BYTE   'F'+80H,"OR"
  5090.     .BYTE   'N'+80H,"EXT"
  5091.     .BYTE   'D'+80H,"ATA"
  5092.     .BYTE   'I'+80H,"NPUT"
  5093.     .BYTE   'D'+80H,"IM"
  5094.     .BYTE   'R'+80H,"EAD"
  5095.     .BYTE   'L'+80H,"ET"
  5096.     .BYTE   'G'+80H,"OTO"
  5097.     .BYTE   'R'+80H,"UN"
  5098.     .BYTE   'I'+80H,"F"
  5099.     .BYTE   'R'+80H,"ESTORE"
  5100.     .BYTE   'G'+80H,"OSUB"
  5101.     .BYTE   'R'+80H,"ETURN"
  5102.     .BYTE   'R'+80H,"EM"
  5103.     .BYTE   'S'+80H,"TOP"
  5104.     .BYTE   'O'+80H,"UT"
  5105.     .BYTE   'O'+80H,"N"
  5106.     .BYTE   'N'+80H,"ULL"
  5107.     .BYTE   'W'+80H,"AIT"
  5108.     .BYTE   'D'+80H,"EF"
  5109.     .BYTE   'P'+80H,"OKE"
  5110.     .BYTE   'V'+80H,"ECTOR"
  5111.     .BYTE   'S'+80H,"CREEN"
  5112.     .BYTE   'L'+80H,"INES"
  5113.     .BYTE   'C'+80H,"LS"
  5114.     .BYTE   'W'+80H,"IDTH"
  5115.     .BYTE   'S'+80H,"YSTEM"
  5116.     .BYTE   'S'+80H,"ET"
  5117.     .BYTE   'R'+80H,"ESET"
  5118.     .BYTE   'P'+80H,"RINT"
  5119.     .BYTE   'C'+80H,"ONT"
  5120.     .BYTE   'L'+80H,"IST"
  5121.     .BYTE   'C'+80H,"LEAR"
  5122.     .BYTE   'L'+80H,"OAD"
  5123.     .BYTE   'S'+80H,"AVE"
  5124.     .BYTE   'N'+80H,"EW"
  5125.     .BYTE   'T'+80H,"AB("
  5126.     .BYTE   'T'+80H,"O"
  5127.     .BYTE   'F'+80H,"N"
  5128.     .BYTE   'S'+80H,"PC("
  5129.     .BYTE   'T'+80H,"HEN"
  5130.     .BYTE   'N'+80H,"OT"
  5131.     .BYTE   'S'+80H,"TEP"
  5132. ;------------------------------------------------------------------------------
  5133.     .BYTE   '+'+80H
  5134.     .BYTE   '-'+80H
  5135.     .BYTE   '*'+80H
  5136.     .BYTE   '/'+80H
  5137.     .BYTE   '^'+80H
  5138.     .BYTE   'A'+80H,"ND"
  5139.     .BYTE   'O'+80H,"R"
  5140.     .BYTE   '>'+80H
  5141.     .BYTE   '='+80H
  5142.     .BYTE   '<'+80H
  5143. ;------------------------------------------------------------------------------
  5144.     .BYTE   'S'+80H,"GN"
  5145.     .BYTE   'I'+80H,"NT"
  5146.     .BYTE   'A'+80H,"BS"
  5147.     .BYTE   'U'+80H,"SR"
  5148.     .BYTE   'F'+80H,"RE"
  5149.     .BYTE   'I'+80H,"NP"
  5150.     .BYTE   'P'+80H,"OS"
  5151.     .BYTE   'S'+80H,"QR"
  5152.     .BYTE   'R'+80H,"ND"
  5153.     .BYTE   'L'+80H,"OG"
  5154.     .BYTE   'E'+80H,"XP"
  5155.     .BYTE   'C'+80H,"OS"
  5156.     .BYTE   'S'+80H,"IN"
  5157.     .BYTE   'T'+80H,"AN"
  5158.     .BYTE   'A'+80H,"TN"
  5159.     .BYTE   'P'+80H,"EEK"
  5160.     .BYTE   'H'+80H,"EX"
  5161.     .BYTE   'P'+80H,"OINT"
  5162.     .BYTE   'L'+80H,"EN"
  5163.     .BYTE   'S'+80H,"TR$"
  5164.     .BYTE   'V'+80H,"AL"
  5165.     .BYTE   'A'+80H,"SC"
  5166.     .BYTE   'C'+80H,"HR$"
  5167.     .BYTE   'L'+80H,"EFT$"
  5168.     .BYTE   'R'+80H,"IGHT$"
  5169.     .BYTE   'M'+80H,"ID$"
  5170.     .BYTE   80H         ; End of list marker
  5171. ;------------------------------------------------------------------------------
  5172. ; KEYWORD ADDRESS TABLE
  5173. ;------------------------------------------------------------------------------
  5174. WORDTB:
  5175.     .WORD   PEND
  5176.     .WORD   FOR
  5177.     .WORD   NEXT
  5178.     .WORD   DATA
  5179.     .WORD   INPUT
  5180.     .WORD   DIM
  5181.     .WORD   READ
  5182.     .WORD   LET
  5183.     .WORD   GOTO
  5184.     .WORD   RUN
  5185.     .WORD   IF
  5186.     .WORD   RESTOR
  5187.     .WORD   GOSUB
  5188.     .WORD   RETURN
  5189.     .WORD   REM
  5190.     .WORD   STOP
  5191.     .WORD   POUT
  5192.     .WORD   ON
  5193.     .WORD   NULL
  5194.     .WORD   WAIT
  5195.     .WORD   DEF
  5196.     .WORD   POKE
  5197.     .WORD   VECTOR
  5198.     .WORD   SCREEN
  5199.     .WORD   LINES
  5200.     .WORD   CLS
  5201.     .WORD   WIDTH
  5202.     .WORD   SYSTEM
  5203.     .WORD   PSET
  5204.     .WORD   RESET
  5205.     .WORD   PRINT
  5206.     .WORD   CONT
  5207.     .WORD   LIST
  5208.     .WORD   CLEAR
  5209.     .WORD   LOAD
  5210.     .WORD   SAVE
  5211.     .WORD   NEW
  5212. ;------------------------------------------------------------------------------
  5213. ; ARITHMETIC PRECEDENCE TABLE
  5214. ;------------------------------------------------------------------------------
  5215. PRITAB:
  5216.     .BYTE   $79     ; Precedence value
  5217.     .WORD   PADD        ; FPREG = <last> + FPREG
  5218.  
  5219.     .BYTE   $79     ; Precedence value
  5220.     .WORD   PSUB        ; FPREG = <last> - FPREG
  5221.  
  5222.     .BYTE   $7C     ; Precedence value
  5223.     .WORD   MULT        ; PPREG = <last> * FPREG
  5224.  
  5225.     .BYTE   $7C     ; Precedence value
  5226.     .WORD   DIV     ; FPREG = <last> / FPREG
  5227.  
  5228.     .BYTE   $7F     ; Precedence value
  5229.     .WORD   POWER       ; FPREG = <last> ^ FPREG
  5230.  
  5231.     .BYTE   $50     ; Precedence value
  5232.     .WORD   PAND        ; FPREG = <last> AND FPREG
  5233.  
  5234.     .BYTE   $46     ; Precedence value
  5235.     .WORD   POR     ; FPREG = <last> OR FPREG
  5236. ;------------------------------------------------------------------------------
  5237. ; BASIC VARIABLES INITIALIZATION TABLE
  5238. ;   This "parametric data" is copied into the BASICV block on Cold Start
  5239. ;------------------------------------------------------------------------------
  5240. INITAB:
  5241.     JP  WSTART      ; Warm start jump, located at BASICV    $00-$02
  5242.     JP  FCERR       ; "USR (X)" jump (Set to Error) $03-$05
  5243.  
  5244.     OUT (0),A       ; "OUT p,n" skeleton    $06-$07
  5245.     RET         ; $08
  5246.  
  5247.     SUB 0       ; Division support routine  $09-16
  5248.     LD  L,A
  5249.     LD  A,H
  5250.     SBC A,0
  5251.     LD  H,A
  5252.     LD  A,B
  5253.     SBC A,0
  5254.     LD  B,A
  5255.     LD  A,0
  5256.     RET
  5257.  
  5258.     .BYTE   $00,$00,$00     ; Random number seed $17-19
  5259.  
  5260.         ; Table used by RND
  5261.     .BYTE   $35,$4A,$CA,$99     ; -2.65145E+07 $1A-3D
  5262.     .BYTE   $39,$1C,$76,$98     ;  1.61291E+07
  5263.     .BYTE   $22,$95,$B3,$98     ; -1.17691E+07
  5264.     .BYTE   $0A,$DD,$47,$98     ;  1.30983E+07
  5265.     .BYTE   $53,$D1,$99,$99     ; -2-01612E+07
  5266.     .BYTE   $0A,$1A,$9F,$98     ; -1.04269E+07
  5267.     .BYTE   $65,$BC,$CD,$98     ; -1.34831E+07
  5268.     .BYTE   $D6,$77,$3E,$98     ;  1.24825E+07
  5269.     .BYTE   $52,$C7,$4F,$80     ; Last random number
  5270.  
  5271.     IN  A,(0)       ; INP (x) skeleton $3E-3F
  5272.     RET         ; $40
  5273.  
  5274.     .BYTE   $01     ; Number of NULLs       $41
  5275.     .BYTE   79      ; Terminal width (79)   $42
  5276.     .BYTE   5       ; Width for commas (16 columns)$43
  5277.     .BYTE   $00     ; Null after input byte flag    $44
  5278.     .BYTE   $00     ; Output enabled (CTRLOFG)  $45
  5279.     .WORD   $0016       ; Initial lines counter(22) $46-47
  5280.     .WORD   $0016       ; Initial lines number (22) $48-49
  5281.     .WORD   $0000       ; Array load/save check sum $4A-$4B
  5282.     .BYTE   $00     ; Break not by NMI      $4C
  5283.     .BYTE   $00     ; Break flag        $4D
  5284.     .BYTE   $00     ; CURPOS            $4E
  5285.     .BYTE   $00     ; LCRFLG Locate/Create Flag $4F
  5286.     .BYTE   $00     ; TYPE Data type flag   $50
  5287.     .BYTE   $00     ; DATFLG literal statement flag $51
  5288.     .BYTE   $00     ; FORFLG "FOR" loop flag    $52
  5289.     .BYTE   $00     ; Last byte entered     $53
  5290.     .BYTE   $00     ; READ/INPUT flag       $54
  5291.     .WORD   -2      ; Current LINE NUMBER   $55-$56
  5292. INITX   .BYTE   $00     ; END OF INITIALISATION TABLE
  5293. ;------------------------------------------------------------------------------
  5294. ; BASIC ERROR CODE LIST
  5295. ;------------------------------------------------------------------------------
  5296. ERRORS:
  5297.     .BYTE   $01,"NEXT without FOR"
  5298.     .BYTE   $00,$02,"Syntax"
  5299.     .BYTE   $00,$03,"RETURN without GOSUB"
  5300.     .BYTE   $00,$04,"Out of DATA"
  5301.     .BYTE   $00,$05,"Illegal function call"
  5302.     .BYTE   $00,$06,"Overflow"
  5303.     .BYTE   $00,$07,"Out of Memory"
  5304.     .BYTE   $00,$08,"Undefined Line"
  5305.     .BYTE   $00,$09,"Bad Subscript"
  5306.     .BYTE   $00,$0A,"Re-DIM'd array"
  5307.     .BYTE   $00,$0B,"Division by zero"
  5308.     .BYTE   $00,$0C,"Illegal direct"
  5309.     .BYTE   $00,$0D,"Type Mismatch"
  5310.     .BYTE   $00,$0E,"Out of string space"
  5311.     .BYTE   $00,$0F,"String too long"
  5312.     .BYTE   $00,$10,"String too complex"
  5313.     .BYTE   $00,$11,"Can't CONTinue"
  5314.     .BYTE   $00,$12,"Undefined Function"
  5315.     .BYTE   $00,$13,"Missing Operand"
  5316.     .BYTE   $00,$14,"Stack Overflow"
  5317.     .BYTE   $00,$15,"Not valid HEX"
  5318.     .BYTE   $00
  5319. ;------------------------------------------------------------------------------
  5320. ; TEXT MESSAGES
  5321. ;------------------------------------------------------------------------------
  5322. SIGNON:
  5323.     .BYTE   CS
  5324.     .BYTE   "Microsoft BASIC V4.7 "
  5325.     .BYTE   "(c)1978"
  5326.     .BYTE   CR,LF,0,0
  5327.    
  5328. SRAM:
  5329.     .BYTE   " Bytes System Ram"
  5330.     .BYTE   CR,LF,0,0
  5331. BFREE:
  5332.     .BYTE   " Bytes BASIC Available"
  5333.     .BYTE   CR,LF,0,0
  5334. RDYMSG:
  5335.     .BYTE   "Ready",CR,LF,0,0
  5336. ERRMSG:
  5337.     .BYTE   " error",0
  5338. BRKMSG:
  5339.     .BYTE   "Break",0
  5340. INMSG:
  5341.     .BYTE   " in ",0
  5342. REDO:
  5343.     .BYTE   "? Redo from start",CR,LF,0
  5344. EXTIG:
  5345.     .BYTE   "? Extra ignored",CR,LF,0
  5346. ;------------------------------------------------------------------------------
  5347. ; INKEY - Look for a User Input from the p8279
  5348. ;   (which requires XY Keymatrix-to-ASCII conversion)
  5349. ;   Replaces RST 10H from BASIC1 and BASIC2
  5350. ;------------------------------------------------------------------------------
  5351. INKEY:
  5352.     IN  A,($79)
  5353.     AND $07
  5354.     JR  Z,INKEY
  5355.    
  5356.     IN  A,($78)
  5357.     CP  $3E     ; SHIFT key?
  5358.     JR  NZ,INKEY1   ; No, regular key
  5359.    
  5360.     LD  A,$40
  5361.     LD  (SHIFT),A   ; Save shift add in
  5362.     JR  INKEY       ; Get next key
  5363.    
  5364. INKEY1:
  5365.     LD  HL,KEYTBL   ; Look up the ASCII value of the key
  5366.     ADD A,L     ; Add the value in A to HL
  5367.     LD  L,A
  5368.     LD  A,$00
  5369.     ADC A,H
  5370.     LD  H,A
  5371.    
  5372.     LD  A,(SHIFT)   ; Get the $00 or $60 for shifted character set
  5373.     ADD A,L     ; Add the SHIFT value in A to HL
  5374.     LD  L,A
  5375.     LD  A,$00
  5376.     ADC A,H
  5377.     LD  H,A     ; At this point HL should point to the character
  5378.    
  5379.     LD  A,(HL)      ; Get the ASCII interpretation of the key
  5380.    
  5381.     RST 08H     ; And output it
  5382.    
  5383.     XOR A       ; Clear A and flags
  5384.     LD  (SHIFT),A   ; Reset shifted key status
  5385.    
  5386.     JR  INKEY
  5387. ;------------------------------------------------------------------------------
  5388. ; INITIALIZE HARDWARE
  5389. ;------------------------------------------------------------------------------
  5390. HWINIT:
  5391.     LD  SP,STACK
  5392. ;------------------------------------------------------------------------------
  5393. ; Set the p8279 for CoCo keyboard connection
  5394. ;------------------------------------------------------------------------------
  5395. P8279:
  5396.     LD  A,$02       ; ENCODED SCAN, N-KEY ROLLOVER
  5397.     OUT ($79),A
  5398.     LD  A,$34       ; Set prescaler for scan
  5399.     OUT ($79),A
  5400.     LD  A,$C1       ; Clear everything
  5401.     OUT ($79),A
  5402.  
  5403. ; Initialize the I/O Driver chips
  5404. P8255:
  5405.     LD  A,$89       ; PORTS A,B=OUT C=INPUT
  5406.     OUT ($63),A     ; 8255 # 1
  5407.     OUT ($67),A     ; 8255 # 2
  5408.     OUT ($6B),A     ; 8255 # 3 
  5409.  
  5410. ; Initialize the video
  5411. V_INIT:
  5412.     LD  C,$00       ; Port $00
  5413.     LD  B,$0F       ; Params from $0F to $00 decr
  5414.     LD  HL,V_PARAM  ; Locate the parameter table
  5415. V_INIT1:
  5416.     LD  A,(HL)      ; Get the parameter
  5417.     OUT (C),B       ; Output the register number to 00
  5418.     OUT ($01),A     ; Output the data to the register
  5419.     INC HL      ; Increment the pointer
  5420.     DEC B       ; Decrement the counter
  5421.     JP  P,V_INIT1       ; Loop until $F-$0 are done
  5422.     LD  HL,VIDBASE  ; Set the location of the Video Ram
  5423.     LD  (CURSOR),HL ; Save it
  5424.     LD  A,CS        ; Clear the screen
  5425.     CALL    V_CHAR      ; Clear the screen
  5426.     CALL    V_HOME      ; Home the cursor
  5427.    
  5428.  
  5429.  
  5430.     JP  CSTART      ; Jump to BASIC Coldstart
  5431. ;------------------------------------------------------------------------------
  5432. ; Video Routines
  5433. ; The (CURSOR) variable contains $F800-$FF7F, the video PCB ram locations
  5434. ; The cursor location in the MC6845 is based from $0000-$077F
  5435. ; Subtract the $F800 offset from cursor location before assigning it in the
  5436. ;  Video Controller chip
  5437. ;------------------------------------------------------------------------------
  5438. ; Read the character in video ram under the cursor
  5439. V_READ:
  5440.     PUSH    HL      ; Save the HL
  5441.     LD  HL,(CURSOR) ; Load the cursor location
  5442.     LD  A,(HL)      ; Retrieve the code
  5443.     POP HL      ; Get HL back
  5444.     RET
  5445. ;-------------------------------------------------------------------------------
  5446. ; Call here with an ASCII character in A
  5447. V_CHAR:
  5448.     PUSH    AF      ; Save everything
  5449.     PUSH    BC
  5450.     PUSH    DE
  5451.     PUSH    HL
  5452.    
  5453.     LD  HL,(CURSOR) ; Get the current cursor location
  5454.     CP  SPC         ; < $20 ?
  5455.     JR  NC,V_PRINT  ; It's from $20-$FF Print it
  5456.    
  5457.     CP  BKSP        ; Backspace Cursor Left
  5458.     JP  Z,V_BKSPC
  5459.    
  5460.     CP  LF      ; Line Feed
  5461.     JP  Z,V_LF
  5462.    
  5463.     CP  CS      ; Clear Screen
  5464.     JP  Z,V_CLS
  5465.    
  5466.     CP  CR      ; Carriage Return
  5467.     JP  Z,V_CR
  5468.    
  5469.     JP  V_EXIT      ; It's weird, forget it
  5470. ;-------------------------------------------------------------------------------
  5471. V_PRINT:
  5472.     LD  (HL),A      ; Write the character
  5473.     INC HL      ; Next position
  5474.     CALL    SETCSR      ; Set the cursor data
  5475. ;-------------------------------------------------------------------------------   
  5476. V_EXIT:
  5477.     POP HL
  5478.     POP DE
  5479.     POP BC
  5480.     POP AF
  5481.     RET
  5482. ;-------------------------------------------------------------------------------
  5483. ; CLS using LDIR should take tiny fraction over 0.01 Seconds at 4MHz clock
  5484. V_CLS:
  5485.     XOR A       ; Write $00 to all screen locations
  5486.     LD  HL,VIDBASE  ; Starting at the Vidbase in memory
  5487.     LD  DE,VIDBASE+1
  5488.     LD  BC,2000     ; 1920 plus a blank line of 80 chars
  5489.     LD  (HL),A      ; Byte to copy forward
  5490.     LDIR
  5491.     LD  HL,VIDBASE  ; Reset the cursor location
  5492.     LD  (CURSOR),HL
  5493.     JR  V_EXIT
  5494. ;-------------------------------------------------------------------------------   
  5495. V_HOME:
  5496.     PUSH    HL
  5497.     LD  HL,VIDBASE  ; Set cursor to home position
  5498.     LD  (CURSOR),HL ; Store in Ram also
  5499.     LD  A,15        ; Select R15 Cursor Addr Low
  5500.     OUT ($00),A
  5501.     LD  A,$00       ; Set the low address as $00
  5502.     OUT ($01),A
  5503.     LD  A,14        ; Select R14 Cursor Addr High
  5504.     OUT ($00),A
  5505.     LD  A,$00       ; Set the high address as $00
  5506.     OUT ($01),A
  5507.     POP HL
  5508.     RET
  5509. ;-------------------------------------------------------------------------------   
  5510. V_LF:
  5511.     LD  HL,(CURSOR)
  5512.     LD  DE,VWIDTH
  5513.     ADD HL,DE       ; Add a line to our current loc
  5514.     CALL    V_OFFSCR        ; Are we off the screen now?
  5515.     JR  C,V_LF1     ; Jump iff off
  5516.     CALL    SETCSR
  5517.     JR  V_EXIT      ; Restore registers and return
  5518.  
  5519. V_LF1:
  5520.     LD  HL,(CURSOR) ; Get original cursor location back
  5521.     CALL    V_SCROLL        ; Scroll the display up one line
  5522.     JR  V_EXIT
  5523. ;-------------------------------------------------------------------------------
  5524. ; Carriage Return  
  5525. V_CR:
  5526.     CALL    V_SOL       ; Get cursor to start of line in DE
  5527.     CALL    SETCSR      ; Set the cursor
  5528.     JR  V_EXIT
  5529. ;-------------------------------------------------------------------------------
  5530. V_BKSPC:
  5531.     LD  HL,(CURSOR) ; Get current cursor loc
  5532.     LD  (HL),' '        ; Blank out that character
  5533.     DEC HL      ; Back up one spot
  5534.     CALL    SETCSR      ; Set the cursor
  5535.     JR  V_EXIT
  5536. ;-------------------------------------------------------------------------------
  5537. V_SCROLL:
  5538.     LD  DE,VIDBASE  ; Destination
  5539.     LD  HL,VIDBASE+VWIDTH   ; Source
  5540.     LD  BC,23*VWIDTH    ; Number of bytes to move
  5541.     LDIR            ; Move it
  5542.     LD  HL,VIDEND-VWIDTH+1  ; Last Line
  5543.     XOR A       ; Blank out bottom line
  5544.     LD  B,VWIDTH        ; Line width
  5545. V_SCRL1:
  5546.     LD  (HL),A
  5547.     INC HL
  5548.     DJNZ    V_SCRL1
  5549.     LD  HL,VIDEND-VWIDTH+1  ; Last Line, continue into SetCsr
  5550. ;-------------------------------------------------------------------------------               
  5551. ; Write cursor location to ram storage 
  5552. SETCSR:
  5553.     LD  (CURSOR),HL ; Save adjusted cursor location
  5554.     LD  DE,VIDBASE  ; Remove the hardware loc of video
  5555.     OR  A       ; Clear the CY flag
  5556.     SBC HL,DE      
  5557.     LD  A,15        ; Select R15
  5558.     OUT ($00),A
  5559.     LD  A,L     ; Store L address there
  5560.     OUT ($01),A
  5561.     LD  A,14        ; Select R14
  5562.     OUT ($00),A
  5563.     LD  A,H     ; Store H address there
  5564.     OUT ($01),A
  5565.     RET
  5566. ;-------------------------------------------------------------------------------
  5567. ; Start of Line
  5568. V_SOL:
  5569.     LD  HL,VIDBASE
  5570.     LD  BC,VWIDTH
  5571. V_SOL1:
  5572.     LD  D,H
  5573.     LD  E,L
  5574.     ADD HL,BC
  5575.     LD  A,(CURSOR+1)    ; High byte
  5576.     CP  H
  5577.     JR  C,V_SOL2        ; HL > Current location, use last SOL DE
  5578.     JR  NZ,V_SOL1       ; Try next line
  5579.     LD  A,(CURSOR)  ; Low byte
  5580.     CP  L       ; Low byte - L
  5581.     RET Z       ; Cursor at start of line
  5582.     JR  NC,V_SOL1       ; Try next line
  5583. V_SOL2:
  5584.     EX  DE,HL       ;
  5585.     LD  (CURSOR),HL ; Last SOL to HL from DE
  5586.     RET
  5587.  
  5588. ;-------------------------------------------------------------------------------   
  5589. ; See if HL is pointing past the end of displayed ram, Carry set if past EOV
  5590. V_OFFSCR:
  5591.     LD  A,VIDEND&$FF00>>8   ; Get high byte of last video page
  5592.     CP  H       ; Is current loc past end of video?
  5593.     RET C       ; Yes, problem
  5594.     JR  Z,VOFFSC1       ; If =, test the low byte
  5595.     RET
  5596.    
  5597. VOFFSC1:
  5598.     LD  A,VIDEND%$FF    ; Just the low byte
  5599.     CP  L
  5600.     RET
  5601. ;------------------------------------------------------------------------------
  5602. V_PARAM:
  5603.    
  5604.     .BYTE   $00 ; R15: Cursor Address Low
  5605.     .BYTE   $00 ; R14: Cursor Addrress High
  5606.     .BYTE   $00 ; R13: Start Address Low
  5607.     .BYTE   $00 ; R12: Start Address High
  5608.     .BYTE   $08 ; R11: Cursor end scan line
  5609.     .BYTE   $60 ; R10: Cursor start scan line, D6=Blink En, D5=1/16,1/32   
  5610.     .BYTE   $08 ; R9: Max scan line address
  5611.     .BYTE   $00 ; R8: Interlace mode
  5612.     .BYTE   $1A ; R7: Vertical Sync position   
  5613.     .BYTE   $18 ; R6: Vertical displayed (24 lines)
  5614.     .BYTE   $03 ; R5: Vertical total adjust
  5615.     .BYTE   $1C ; R4: Vertical total (28 lines)
  5616.     .BYTE   $0A     ; R3: Horizontal sync width
  5617.     .BYTE   $63 ; R2: Horizontal sync position
  5618.     .BYTE   $50 ; R1: Horizontal displayed (80 char)
  5619.     .BYTE   $7E ; R0: Horizontal total (130)
  5620. ;------------------------------------------------------------------------------
  5621.  
  5622.  
  5623. ;------------------------------------------------------------------------------
  5624. ; This key translation matrix is for the TRS-80 'CoCo' keyboard as connected
  5625. ;  to the S-T MCB p8279 port at $78/$79
  5626. ; The RL0-RL6 inputs of the p8279 are connected to 1-2,4-5-6-7,8 respectively
  5627. ; The SL0-SL2 outputs of the p8279 are connected to ABC inputs of 74LS138
  5628. ;  The outputs of this chip 0-7 are connected to 9,10,11,12,13,14,15,16 likewise
  5629. ; The p8279 is programmed in Encoded output, n-Key Rollover format
  5630. ;------------------------------------------------------------------------------
  5631. KEYTBL:
  5632.     .BYTE   '@'
  5633.     .BYTE   'h'
  5634.     .BYTE   'p'
  5635.     .BYTE   'x'
  5636.     .BYTE   '0'
  5637.     .BYTE   '8'
  5638.     .byte   CR  ; Enter
  5639.     .BYTE   $00 ; Vacant A7 line
  5640.    
  5641.     .BYTE   'a'
  5642.     .byte   'i'
  5643.     .byte   'q'
  5644.     .byte   'y'
  5645.     .byte   '1'
  5646.     .byte   '9'
  5647.     .byte   $0E ; Clear
  5648.     .BYTE   $00 ; Vacant A7 line
  5649.        
  5650.     .byte   'b'
  5651.     .byte   'j'
  5652.     .byte   'r'
  5653.     .byte   'z'
  5654.     .byte   '2'
  5655.     .byte   ':'
  5656.     .byte   $03 ; Break
  5657.     .BYTE   $00 ; Vacant A7 line
  5658.        
  5659.     .byte   'c'
  5660.     .byte   'k'
  5661.     .byte   's'
  5662.     .byte   $00 ; No key here
  5663.     .byte   '3'
  5664.     .byte   ';'
  5665.     .byte   CTRLS   ; up arrow, use as hold during list
  5666.     .BYTE   $00 ; Vacant A7 line
  5667.        
  5668.     .byte   'd'
  5669.     .byte   'l'
  5670.     .byte   't'
  5671.     .byte   $00 ; No key here
  5672.     .byte   '4'
  5673.     .byte   ','
  5674.     .byte   CTRLQ   ; down arrow, use as release during list
  5675.     .BYTE   $00 ; Vacant A7 line
  5676.        
  5677.     .byte   'e'
  5678.     .byte   'm'
  5679.     .byte   'u'
  5680.     .byte   $00 ; No key here
  5681.     .byte   '5'
  5682.     .byte   '-'
  5683.     .byte   $08 ; Backspace
  5684.     .BYTE   $00 ; Vacant A7 line
  5685.        
  5686.     .byte   'f'
  5687.     .byte   'n'
  5688.     .byte   'v'
  5689.     .byte   $00 ; No key here
  5690.     .byte   '6'
  5691.     .byte   '.'
  5692.     .byte   $02 ; Cursor forward
  5693.     .BYTE   $00 ; Vacant A7 line
  5694.        
  5695.     .byte   'g'
  5696.     .byte   'o'
  5697.     .byte   'w'
  5698.     .byte   $00 ; No key here
  5699.     .byte   '7'
  5700.     .byte   '/'
  5701.     .byte   SPC ; Space Bar
  5702.     .BYTE   $00 ; Vacant A7 line
  5703.        
  5704. SH_KEY:
  5705.     .byte   '@'
  5706.     .BYTE   'H'
  5707.     .BYTE   'P'
  5708.     .BYTE   'X'
  5709.     .BYTE   '0'
  5710.     .BYTE   '('
  5711.     .BYTE   CR  ; ENTER
  5712.     .BYTE   $00 ; Vacant A7 line
  5713.        
  5714.     .BYTE   'A'
  5715.     .BYTE   'I'
  5716.     .BYTE   'Q'
  5717.     .BYTE   'Y'
  5718.     .BYTE   '!'
  5719.     .BYTE   ')'
  5720.     .BYTE   CLR ; Clear key, use for Kill Line
  5721.     .BYTE   $00 ; Vacant A7 line
  5722.        
  5723.     .BYTE   'B'
  5724.     .BYTE   'J'
  5725.     .BYTE   'R'
  5726.     .BYTE   'Z'
  5727.     .BYTE   $22 ; Quote marks
  5728.     .BYTE   '*'
  5729.     .BYTE   $03 ; BREAK
  5730.     .BYTE   $00 ; Vacant A7 line
  5731.        
  5732.     .BYTE   'C'
  5733.     .BYTE   'K'
  5734.     .BYTE   'S'
  5735.     .BYTE   $00 ; No key here
  5736.     .BYTE   '#'
  5737.     .BYTE   '+'
  5738.     .BYTE   CTRLS   ; Up arrow
  5739.     .BYTE   $00 ; Vacant A7 line
  5740.        
  5741.     .BYTE   'D'
  5742.     .BYTE   'L'
  5743.     .BYTE   'T'
  5744.     .BYTE   $00 ; No key
  5745.     .BYTE   '$'
  5746.     .BYTE   '<'
  5747.     .BYTE   CTRLQ   ; Down Arrow, Release scrolling for list
  5748.     .BYTE   $00 ; Vacant A7 line
  5749.        
  5750.     .BYTE   'E'
  5751.     .BYTE   'M'
  5752.     .BYTE   'U'
  5753.     .BYTE   $00 ; No key
  5754.     .BYTE   '%'
  5755.     .BYTE   '='
  5756.     .BYTE   BKSP    ; Left Arrow = Backspace
  5757.     .BYTE   $00 ; Vacant A7 line
  5758.        
  5759.     .BYTE   'F'
  5760.     .BYTE   'N'
  5761.     .BYTE   'V'
  5762.     .BYTE   $00 ; No key
  5763.     .BYTE   '&'
  5764.     .BYTE   '>'
  5765.     .BYTE   $02 ; Cursor forward
  5766.     .BYTE   $00 ; Vacant A7 line
  5767.        
  5768.     .BYTE   'G'
  5769.     .BYTE   'O'
  5770.     .BYTE   'W'
  5771.     .BYTE   $00 ; No key
  5772.     .BYTE   $27 ; tick mark '
  5773.     .BYTE   $20     ; Space
  5774.     .BYTE   $00 ; Vacant A7 line
  5775.    
  5776. ;------------------------------------------------------------------------------
  5777. ; These are the default jump vectors for Z80 \INT and \NMI
  5778. ;  They are copied to $3214 JP, $3215 L, $3216 H for INT
  5779. ;           $3217 JP, $3218 L, $3219 H for NMI
  5780. ; The user can change these after bootup to alter the destination of INT, NMI
  5781. ;  for own purposes. Beware of vectoring off to the weeds.
  5782. ;------------------------------------------------------------------------------
  5783. VECTORS:
  5784.     .ORG    $1FE0       ; Soft configurable NMI and INT
  5785. INTSRC:
  5786.     JP  WSTART      ; BASIC Warmstart until user changes
  5787. NMISRC:
  5788.     JP  WSTART      ; Basic Warmstart until user changes
  5789. ;------------------------------------------------------------------------------
  5790. ; The following vectors are positioned at the top of BASIC's Rom so that
  5791. ;  users of USR(x) can easily locate DEINT and PASSA and ABPASS, regardless
  5792. ;  of updates to BASIC.ASM which would shift their position inside code.
  5793. ; DEINT takes the value x from USR(x) -32768 to 32767 from FPREG into regs DE
  5794. ; ABPASS returns value from user's code 16-bit signed int and returns it to
  5795. ;   Basic, so Z=USR(X), Z will contain result of user's program
  5796. ; PASSA returns unsigned 8 bit integer 0 to 255 in reg A back to Basic.
  5797. ;------------------------------------------------------------------------------
  5798. ; Notes on using Machine Code with BASIC:
  5799. ;------------------------------------------------------------------------------
  5800. ; CLEAR 100,14235 causes basic to create a 100 byte string space,
  5801. ; leaving 100 bytes for your machine code program which won't be overwritten
  5802. ; by BASIC text.
  5803. ; Be sure to set the location of your machine code program with VECTOR(x)
  5804. ;   because the default USR vector will return a Function Call Error.
  5805. ; Then Z=USR(X) is the format for passing variables to/from your program.
  5806. ;   X is the signed 16-bit value you pass to your program, Z is the value ret'd.
  5807. ;   Your program should first CALL DEINT to get the value into registers DE.
  5808. ;   Then, if you are returning a signed 16-bit value, CALL this
  5809. ;   vector for JP ABPASS, then finish your program with a RET command.
  5810. ;   If you are returning only an unsigned 8-bit value 0-255, call this
  5811. ;   vector for JP PASSA,  then finish your program with a RET commmand.
  5812. ;------------------------------------------------------------------------------    
  5813.     .ORG    $1FF0   ; Standardized location of User Vectors
  5814.     JP  CSTART  ; BASIC Cold Start (clears ram, resets all)
  5815.     JP  WSTART  ; BASIC Warm Start (returns to OK prompt)
  5816.    
  5817.     JP  DEINT   ; Pass Integer variable to user program in DE
  5818.     JP  ABPASS  ; Pass 16-bit int from user back to BASIC
  5819.     JP  PASSA   ; PASS INT 0-255 IN A   (var back to bas)
  5820. ;------------------------------------------------------------------------------
  5821.    
  5822. ;------------------------------------------------------------------------------
  5823. FINIS   .END            ;END OF ASSEMBLY
  5824. ;------------------------------------------------------------------------------
  5825. ;------------------------------------------------------------------------------
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!