1 'TBASIC - TinyBasic Interpreter (Rev. 2020.08.31) 2 'adapted from Tiny Basic Intermediate Language Interpreter -- 2004 July 19 3 'TinyBasic interpreter Copyright 1976 Itty Bitty Computers, used by permission. 4 ' 5 'default input/output file names, if defined (omit otherwise)... 7 defaultinputfile$="":defaultoutputfile$="" 10 'nbasic 11 print "TinyBasic Intermediate Language Interpreter -- 20.08.31" 12 cursor on 20 'constants 25 coretop=65536 'core size 30 userprog=32 'core address of front of basic program 31 userend=34 'core address of end of stack/user space 32 progend=36 'core address of end of basic program 33 gostktop=38 'core address of gosub stack top 34 linocore=40 'core address of "current basic line number" 35 ilpccore=42 'core address of "IL program counter" 36 bpcore=44 'core address of "basic pointer" 37 svptcore=46 'core addreess of "saved pointer" 38 inline=48 'core address of input line 39 expnstk=128 'core address of expression stack (empty) 40 addrtab=191 'core address of output line size, for tabs 41 watchpoint=255 'core address of debug watchpoint usr 42 coldgo=256 'core address of nominal restart usr 43 warmgo=259 'core address of nominal warm start usr 44 subinch=262 'core address of nominal char input usr 45 suboutch=265 'core address of nominal char output usr 46 subbreak=268 'core address of nominal break test usr 47 subdump=273 'core address of nominal core dump usr 48 subpeek=276 'core address of nominal byte peek usr 49 subpeek2=277 'core address of nominal 2-byte peek usr 50 subpoke=280 'core address of nominal byte poke usr 51 subtrlog=283 'core address of debug trace log usr 52 bscode=271 'core address of backspace code 53 cancode=272 'core address of line cancel code 54 ilfront=286 'core address of IL code address 60 badop=15 'illegal op, default IL code 70 'static/global data 72 dim core(coretop-1) 'everything goes in here 74 dim caps(128) 'capitalization table 76 lino=0:ilpc=0 'current line#, IL program counter 78 bp=0:svpt=0 'current, saved tb parse pointer 80 substk=0:expntop=0 'stack pointers 82 inlend=0:srcend=0 'current input line & tb source end 86 ilend=0:xqhere=0 'end of IL code, start of execute loop 88 needsecho=true 90 broken=false '=true to stop execution or listing 95 def fnbreaktest=broken 97 def fnstopit=fnbreaktest 'not implemented 100 '*************************** startup code *************************** 110 infile=0:ofile=0 120 if len(defaultinputfile$)>0 then open defaultinputfile$ for input as #1:infile=1 130 if len(defaultoutputfile$)>0 then open defaultoutputfile$ for output as #2:ofile=2 140 ploc=expnstk:pval=8191:gosub *poke2 'random number seed 150 core(bscode)=8 'backspace 160 core(cancode)=27 'escape 170 'fill caps table 180 for nx=32 to 126:caps(nx)=nx:next nx 190 for nx=65 to 90:caps(nx+32)=nx:next nx 200 caps(9)=32:caps(10)=13:caps(13)=13:caps(127)=0 210 ilcode$="" 220 *rdcd:read s$:if s$<>"" then ilcode$=ilcode$+s$:goto *rdcd 230 'convert & load tbil code 232 ilend=ilfront+2 234 ploc=ilfront:pval=ilend:gosub *poke2 'initialize pointers as promised in tbek 236 ploc=coldgo+1:pval=ilend:gosub *poke2 238 core(ilend)=badop 'illegal op, in case nothing loaded 240 for i=1 to len(ilcode$) step 2 'get the data 242 core(ilend)=val("&h"+mid$(ilcode$,i,2)):ilend=ilend+1 'insert this byte into code 244 next i 246 xqhere=0 'requires new xq to initialize 248 core(ilend)=0 250 gosub *coldstart 252 gosub *interp 'go do it 254 close 256 end 900 '************************ memory utilities.. ************************ 910 'poke2(ploc,pval) 912 'store integer as two bytes 914 *poke2:core(ploc)=pval\256 'nominally big-endian 916 core(ploc+1)=pval mod 256 918 return 920 'peek2(ploc)=rval 922 'fetch integer from two bytes 924 *peek2:rval=core(ploc)*256+core(ploc+1):return 1000 '*********************** utility functions.. *********************** 1100 'coldstart 1102 'initialize program to empty 1104 *coldstart:ploc=ilfront:gosub *peek2:if rval<>ilfront+2 then ploc=ilfront:gosub *peek2:ilend=rval+&h800 1106 ploc=userprog:pval=(ilend+255) and -256:gosub *poke2 'start basic shortly after il 1108 if coretop>65535 then ploc=userend:pval=65534:gosub *poke2:ploc=65534:pval=&hdead:gosub *poke2 else ploc=userend:pval=coretop:gosub *poke2 1110 gosub *warmstart 1112 ploc=userprog:gosub *peek2:srcend=rval 1114 ploc=srcend:pval=0:gosub *poke2:srcend=srcend+1 1116 ploc=progend:srcend=srcend+1:pval=srcend:gosub *poke2 1118 return 1200 'warmstart 1202 'initialize existing program 1204 *warmstart:ploc=userend:gosub *peek2:substk=rval 'empty subroutine, expression stack 1206 ploc=gostktop:pval=substk:gosub *poke2 1208 expntop=expnstk 1210 lino=0 'not in any line 1212 ilpc=0 'start IL at front 1214 svpt=inline 1216 bp=inline 1218 core(bp)=0 1220 core(addrtab)=0 1222 inlend=inline 1224 return 1300 'tberror 1302 'report interpreter error 1304 *tberror:if ilpc=0 return 'already reported it 1306 gosub *outln 1308 pmsg$="Tiny Basic error #":gosub *outstr 'il address is the error # 1310 ploc=ilfront:gosub *peek2:pnum=ilpc-rval:gosub *outint 1312 if lino>0 then pmsg$=" at line ":gosub *outstr:pnum=lino:gosub *outint 1314 gosub *outln 1316 lino=0 'restart interpreter at front 1318 expntop=expnstk 'with empty expression stack 1320 ilpc=0 'cheap error test; interp reloads it from ilfront 1322 bp=inline 1324 return 1400 'pushsub(psub) 1405 'push value onto gosub stack 1410 *pushsub:if substk<=srcend then gosub *tberror:return 'overflow: bumped into program end 1415 substk=substk-2:ploc=gostktop:pval=substk:gosub *poke2:ploc=substk:pval=psub:gosub *poke2 1420 return 1500 'popsub=rval 1505 'pop value off gosub stack 1510 *popsub:ploc=userend:gosub *peek2:if substk>=rval-1 then gosub *tberror:rval=-1:return 'underflow (nothing in stack).. 1515 substk=substk+2:ploc=gostktop:pval=substk:gosub *poke2:ploc=substk-2:gosub *peek2:return 1600 'pushexby(pval) 1605 'push byte onto expression stack 1610 *pushexby:if expntop<=inlend then gosub *tberror:return 'overflow: bumped into input line 1615 expntop=expntop-1:core(expntop)=pval and 255 1620 return 1700 'popexby=rval 1705 'pop byte off expression stack 1710 *popexby:if expntophere then gosub *tberror:return 'not there 2235 bp=bp+1 2240 return 'got it 2300 'listit(pfrm,ptoo) 2305 'list the stored program 2310 *listit:if pfrm=0 then ptoo=65535:pfrm=1 else if ptoo=0 then ptoo=pfrm '0,0 defaults to all; n,0 defaults to n,n 2315 pline=pfrm:gosub *findline:here=rval 'try ti find first line.. 2320 *listit2:ploc=here:gosub *peek2:here=here+1:pfrm=rval 'get this line's # to print it 2325 if pfrm>ptoo or pfrm=0 then return 2330 here=here+1 2335 pnum=pfrm:gosub *outint 2340 pch$=" ":gosub *ouch 2345 *listit3:pch$=chr$(core(here)):here=here+1 2350 gosub *ouch 2355 if pch$>chr$(13) then *listit3 2360 if not fnstopit then *listit2 2365 return 2400 'lineswap(phere) 2405 'swap svpt/bp if here is not in inline 2410 *lineswap:if phere=inlend then phere=svpt:svpt=bp:bp=phere else svpt=bp 2415 return 5000 '************************* i/o utilities.. ************************* 5100 'ouch(pch$) 5102 'output char to stdout 5104 *ouch:if ofile>0 then if pch$>=" " then print #ofile,pch$; else if pch$=chr$(13) then print #ofile,chr$(10); 'there is an output file.. 5106 if pch$=chr$(13) then core(addrtab)=0:print:goto *ouch2 'keep count of how long this line is 5108 if pch$>=" " then if pch$<="~" then core(addrtab)=core(addrtab)+1:print pch$; 'ignore non-print control chars 5110 *ouch2:return 5200 'inch=rval$ 5202 'read input character from stdin or file 5204 *inch:if infile=0 goto *stdin 5206 'there is a file to get input from 5208 if eof(infile) then close #infile:infile=0:goto *stdin 'switch over to console input at eof 5210 ch$=input$(1,infile):if ch$=chr$(10) then ch$=chr$(13) 5212 pch$=ch$:gosub *ouch: 'echo input to screen (but not output file) 5214 rval$=ch$:return 5216 *stdin:ch$=inkey$:if ch$="" then *stdin else ch$=right$(ch$,1) 'get input from stdin 5218 if needsecho then print ch$; 'alternative input may need this 5220 if ofile>0 then print #ofile,ch$; 'echo it to output file 5222 if ch$=chr$(13) then core(addrtab)=0 'reset tab counter 5224 rval$=ch$:return 5300 'outstr(pmsg$) 5302 'output a string to the console 5304 *outstr:for i=1 to len(pmsg$):pch$=mid$(pmsg$,i,1):gosub *ouch:next i:return 5400 'outln 5402 'terminate output line to the console 5404 *outln:pmsg$=chr$(13):gosub *outstr:return 5500 'outint(pnum) 5502 'output a number to the console 5504 *outint:pmsg$=str$(pnum):gosub *outstr:return 10000 '************************* main interpreter ************************ 10002 'interp 10004 *interp: 10006 broken=false 'initialize this for possible later test 10008 *iloop: 10010 if fnstopit then broken=false:gosub *outln:pmsg$="*** User Break ***":gosub *outstr:gosub *tberror 10012 if ilpc=0 then ploc=ilfront:gosub *peek2:ilpc=rval 10014 op=core(ilpc):ilpc=ilpc+1 10016 '01-07 10018 if op>=&h01 and op<=&h07 then *sx 10020 '08-2f 10022 on op-7 goto *no,*lb,*ln,*ds,*sp,*def,*def,*badop,*sb,*rb,*fv,*sv,*gs,*rs,*go,*ne,*ad,*su,*mp,*dv,*cp,*nx,*def,*ls,*pn,*pq,*pt,*nl,*pc,*def,*def,*gl,*def,*def,*il,*mt,*xq,*ws,*us,*rt 10024 '30-37 10026 if op>=&h30 and op<=&h37 then *js 10028 '38-3f 10030 if op>=&h38 and op<=&h3f then *j 10032 '40-ff 10034 on (op\32)-1 goto *br,*br,*bc,*bv,*bn,*be 10036 'default 10038 *def:goto *brk 10040 *badop:gosub *tberror:return 10100 'SX n 00-07 stack exchange. 10101 ' exchange the top byte of computational stack with 10102 'that "n" bytes into the stack. the top/left byte of the stack is 10103 'considered to be byte 0, so sx 0 does nothing. 10150 *sx:if expntop+op>=expnstk then gosub *tberror:return 'swap is below stack depth 10152 ix=core(expntop) 10154 core(expntop)=core(expntop+op) 10156 core(expntop+op)=ix 10158 goto *brk 10200 'NO 08 no operation. 10201 ' this may be used as a space filler (such as to 10202 'ignore a skip). 10250 *no:goto *brk 10300 'LB n 09nn push literal byte onto stack. 10301 ' this adds one byte to the expression stack, which 10302 'is the second byte of the instruction. an error stop will occur if 10303 'the stack overflows. 10350 *lb:pval=core(ilpc):ilpc=ilpc+1:gosub *pushexby 'push IL byte 10352 goto *brk 10400 'LN n 0Annnn push literal number. 10401 ' this adds the following two bytes to the 10402 ' computational stack, as a 16-bit number. Stack overflow results in 10403 ' an error stop. numbers are assumed to be big-endian. 10450 *ln:ploc=ilpc:gosub *peek2:ilpc=ilpc+1:pval=rval:gosub *pushexint 'get next 2 IL bytes 10452 ilpc=ilpc+1 10454 goto *brk 10500 'DS 0B duplicate top number (two bytes) on stack. 10501 ' an error stop will occur if there are less than 2 10502 ' bytes (1 int) on the expression stack or if the stack overflows. 10550 *ds:op=expntop 10552 gosub *popexint:ix=rval 10554 if ilpc=0 then *brk 'underflow 10556 expntop=op 10558 pval=ix:gosub *pushexint 10560 goto *brk 10600 'SP 0C stack pop. 10601 ' the top two bytes are removed from the expression 10602 ' stack and discarded. underflow results in an error stop. 10650 *sp:gosub *popexint:ix=rval 10652 goto *brk 10700 'SB 10 save BASIC pointer. 10701 ' if BASIC pointer is pointing into the input line 10702 ' buffer, it is copied to the saved pointer; otherwise the two 10703 ' pointers are exchanged. 10750 *sb:phere=bp:gosub *lineswap 10752 goto *brk 10800 'RB 11 restore BASIC pointer. 10801 ' if the saved pointer points into the input line 10802 'buffer, it is replaced by the value in the BASIC pointer; 10803 'otherwise the two pointers are exchanged. 10850 *rb:phere=svpt:gosub *lineswap 10852 goto *brk 10900 'FV 12 fetch variable. 10901 ' the top byte of the computational stack is used to 10902 'index into page 00. it is replaced by the two bytes fetched. error 10903 'stops occur with stack overflow or underflow. 10950 *fv:gosub *popexby:op=rval 10952 if ilpc<>0 then ploc=op:gosub *peek2:pval=rval:gosub *pushexint 10954 goto *brk 11000 'SV 13 store variable. 11001 ' the top two bytes of the computational stack are 11002 'stored into memory at the page 00 address specified by the third 11003 'byte on the stack. all three bytes are deleted from the stack. 11004 'underflow results in an error stop. 11050 *sv:gosub *popexint:ix=rval 11052 gosub *popexby:op=rval 11054 if ilpc=0 then *brk 11056 ploc=op:pval=ix:gosub *poke2 11058 goto *brk 11100 'GS 14 GOSUB save. 11101 ' the current BASIC line number is pushed 11102 'onto the BASIC region of the control stack. it is essential that 11103 'the IL stack be empty for this to work properly but no check is 11104 'made for that condition. an error stop occurs on stack overflow. 11150 *gs:psub=lino:gosub *pushsub 'push line # (possibly =0) 11152 goto *brk 11200 'RS 15 restore saved line. 11201 ' pop the top two bytes off the BASIC region of the 11202 'control stack, making them the current line number. set the BASIC 11203 'pointer at the beginning of that line. note that this is the line 11204 'containing the GOSUB which caused the line number to be saved. as 11205 'with the GS opcode, it is essential that the IL region of the 11206 'control stack be empty. if the line number popped off the stack 11207 'does not correspond to a line in the BASIC program an error stop 11208 'occurs. an error stop also results from stack underflow. 11250 *rs:gosub *popsub:lino=rval 'get line # (possibly =0) from pop 11252 if ilpc<>0 gosub *gotolino 'stops run if error 11254 goto *brk 11300 'GO 16 GOTO. 11301 ' make current the BASIC line whose line number is 11302 'equal to the value of the top two bytes in the expression stack. 11303 'that is, the top two bytes are popped off the computational stack, 11304 'and the BASIC program is searched until a matching line number is 11305 'found. the BASIC pointer is then positioned at the beginning of 11306 'that line and the RUN mode flag is turned on. stack underflow and 11307 'non-existent BASIC line result in error stops. 11350 *go:ilpc=xqhere 'the IL assumes an implied NX 11352 gosub *popexint:lino=rval 11354 if ilpc<>0 then gosub *gotolino 'stops run if error 11356 goto *brk 11400 'NE 17 negate (two's complement). 11401 ' the number in the top two bytes of the expression 11402 'stack is replaced with its negative. 11450 *ne:gosub *popexint:ix=rval 11452 if ilpc<>0 then pval=-ix:gosub *pushexint 11454 goto *brk 11500 'AD 18 add. 11501 ' add the two numbers represented by the top four 11502 'bytes of the expression stack, and replace them with the two-byte 11503 'sum. Stack underflow results in an error stop. 11550 *ad:gosub *popexint:ix=rval 11552 gosub *popexint:op=rval 11554 if ilpc<>0 then pval=op+ix:sn=pval and &h8000:pval=pval and &h7fff:if sn=0 then gosub *pushexint else pval=-(32768-pval):gosub *pushexint 11556 goto *brk 11600 'SU 19 subtract. 11601 ' subtract the two-byte number on the top of the 11602 'expression stack from the next two bytes and replace the 4 bytes 11603 'with the two-byte difference. 11650 *su:gosub *popexint:ix=rval 11652 gosub *popexint:op=rval 11654 if ilpc<>0 then pval=op-ix:sn=pval and &h8000:pval=pval and &h7fff:if sn=0 then gosub *pushexint else pval=-(32768-pval):gosub *pushexint 11656 goto *brk 11700 'MP 1A multiply. 11701 ' multiply the two numbers represented by the top 4 11702 'bytes of the computational stack, and replace them with the least 11703 'significant 16 bits of the product. stack underflow is possible. 11750 *mp:gosub *popexint:ix=rval 11752 gosub *popexint:op=rval 11754 if ilpc<>0 then pval=op*ix:sn=pval and &h8000:pval=pval and &h7fff:if sn=0 then gosub *pushexint else pval=-(32768-pval):gosub *pushexint 11756 goto *brk 11800 'DV 1B divide. 11801 ' divide the number represented by the top two bytes 11802 'of the computational stack into that represented by the next two. 11803 'replace the 4 bytes with the quotient and discard the remainder. 11804 'this is a signed (two's complement) integer divide, resulting in a 11805 'signed integer quotient. stack underflow or attempted division by 11806 'zero result in an error stop. 11850 *dv:gosub *popexint:ix=rval 11852 gosub *popexint:op=rval 11854 if ix=0 then gosub *tberror:goto *brk 'divide by 0.. 11856 if ilpc<>0 then pval=op\ix:gosub *pushexint 11858 goto *brk 11900 'CP 1C compare. 11901 ' the number in the top two bytes of the expression 11902 'stack is compared to (subtracted from) the number in the 4th and 11903 'fifth bytes of the stack, and the result is determined to be 11904 'greater, equal, or less. the low three bits of the third byte mask 11905 'a conditional skip in the IL program to test these conditions; if 11906 'the result corresponds to a one bit, the next byte of the IL code 11907 'is skipped and not executed. the three bits correspond to the 11908 'conditions as follows: 11909 ' bit 0 result is less 11910 ' bit 1 result is equal 11911 ' bit 2 result is greater 11912 'whether the skip is taken or not, all five bytes are deleted from 11913 'the stack. this is a signed (two's complement) comparison so that 11914 'any positive number is greater than any negative number. multiple 11915 'conditions, such as greater-than-or-equal or unequal (i.e.greater- 11916 'than-or-less-than), may be tested by forming the condition mask 11917 'byte of the sum of the respective bits. in particular, a mask byte 11918 'of 7 will force an unconditional skip and a mask byte of 0 will 11919 'force no skip. the other 5 bits of the control byte are ignored. 11920 'stack underflow results in an error stop. 11950 *cp:gosub *popexint:ix=rval 11952 gosub *popexby:op=rval 11954 gosub *popexint:ix=rval-ix:sn=ix and &h8000:ix=ix and &h7fff:if sn>0 then ix=-(32768-ix) '<0 or =0 or >0 11956 if ilpc=0 then *brk 'underflow 11958 if ix<0 then ix=1 else if ix>0 then ix=4 else ix=2 'choose the bit to test 11960 if (ix and op)>0 then ilpc=ilpc+1 'skip next IL op if bit =1 11962 goto *brk 12000 'NX 1D next BASIC statement. 12001 ' advance to next line in the BASIC program, if in 12002 'RUN mode, or restart the IL program if in the command mode. the 12003 'remainder of the current line is ignored. in the run mode if there 12004 'is another line it becomes current with the pointer positioned at 12005 'its beginning. at this time, if the Break condition returns true, 12006 'execution is aborted and the IL program is restarted after 12007 'printing an error message. otherwise IL execution proceeds from 12008 'the saved IL address (see the XQ instruction). if there are no 12009 'more BASIC statements in the program an error stop occurs. 12050 *nx:if lino=0 then ilpc=0:goto *nx1 12052 phere=bp:pfch=13:gosub *skipto:bp=rval 'skip to end of this line 12054 ploc=bp:gosub *peek2:bp=bp+1:lino=rval 'get line # 12056 if lino=0 then gosub *tberror:goto *nx1 'ran off the end 12058 bp=bp+1 12060 ilpc=xqhere 'restart at saved IL address (XQ) 12062 *nx1:goto *brk 12100 'LS 1F list the program. 12101 ' the expression stack is assumed to have two 2-byte 12102 'numbers. the top number is the line number of the last line to be 12103 'listed, and the next is the line number of the first line to be 12104 'listed. if the specified line numbers do not exist in the program, 12105 'the next available line (i.e. with the next higher line number) is 12106 'assumed instead in each case. if the last line to be listed comes 12107 'before the first, no lines are listed. if Break condition comes 12108 'true during a list operation, the remainder of the listing is 12109 'aborted. zero is not a valid line number, and an error stop occurs 12110 'if either line number specification is zero. the line number 12111 'specifications are deleted from the stack. 12150 *ls:op=0 12152 ix=0 'the IL seems to assume we can handle zero 12154 *ls1:if expntop0 then pnum=ix:gosub *outint 12254 goto *brk 12300 'PQ 21 print BASIC string. 12301 ' the ASCII characters beginning with the current 12302 'position of BASIC pointer are printed on the console. the string 12303 'to be printed is terminated by quotation mark ("), and the BASIC 12304 'pointer is left at the character following the terminal quote. an 12305 'error stop occurs if a carriage return is imbedded in the string. 12350 *pq:ch$=chr$(core(bp)):bp=bp+1 12352 if ch$=chr$(34) then *pq2 'done on final quote 12354 if ch$<" " then gosub *tberror:goto *pq2 'error if return or other control char 12356 pch$=ch$:gosub *ouch:goto *pq 12358 *pq2:goto *brk 12400 'PT 22 print tab. 12401 ' print one or more spaces on the console, ending at 12402 'the next multiple of eight character positions (from the left 12403 'margin). 12450 *pt:pch$=" ":gosub *ouch:if core(addrtab) mod 8>0 then *pt 12452 goto *brk 12500 'NL 23 new line. 12501 ' output a carriage-return-linefeed sequence to the 12502 'console. 12550 *nl:pch$=chr$(13):gosub *ouch 12552 goto *brk 12600 'PC "xxxx" 24xxxxxxXx print literal string. 12601 ' the ASCII string follows opcode and its 12602 'last byte has the most significant bit set to one. 12650 *pc:ix=core(ilpc):ilpc=ilpc+1 12652 pch$=chr$(ix and 127):gosub *ouch 'strip high bit for output 12654 if (ix and 128)=0 then *pc 12656 goto *brk 12700 'GL 27 get input line. 12701 ' ASCII characters are accepted from console input 12702 'to fill the line buffer. If the line length exceeds the available 12703 'space, the excess characters are ignored and bell characters are 12704 'output. The line is terminated by a carriage return. on completing 12705 'one line of input, the BASIC pointer is set to point to the first 12706 'character in the input line buffer, and a carriage-return-linefeed 12707 'sequence is [not] output. 12750 *gl:inlend=inline 12752 *gl1:gosub *inch:ch$=rval$ 'read input line characters... 12754 if ch$=chr$(13) then *gl2 'end of the line 12756 if ch$=chr$(9) then ch$=" ":goto *gl11 'convert tabs to space 12758 if ch$=chr$(core(bscode)) then if inlend>inline then pch$=chr$(8):gosub *ouch:inlend=inlend-1:goto *gl1 else pch$=chr$(13):gosub *ouch:goto *gl2 'backspace code, backup up over front of line: just kill it.. 12760 if ch$=chr$(core(cancode)) then inlend=inline:pch$=chr$(13):gosub *ouch:goto *gl2 'cancel this line, also start a new input line 12762 if ch$<" " or ch$>"~" then *gl1 'ignore non-ASCII & controls 12764 *gl11:if inlend>expntop-2 then *gl1 'discard overrun chars 12766 core(inlend)=asc(ch$):inlend=inlend+1 'insert this char in buffer 12768 goto *gl1 12770 *gl2:if inlend>inline and core(inlend-1)=32 then inlend=inlend-1:goto *gl2 'delete excess trailing spaces 12772 core(inlend)=13:inlend=inlend+1 'insert final return & null 12774 core(inlend)=0 12776 bp=inline 12778 goto *brk 12800 'IL 2A insert BASIC line. 12801 ' beginning with the current position of the BASIC 12802 'pointer and continuing to the [end of it], the line is inserted 12803 'into the BASIC program space; for a line number, the top two bytes 12804 'of the expression stack are used. if this number matches a line 12805 'already in the program it is deleted and the new one replaces it. 12806 'if the new line consists of only a carriage return, it is not 12807 'inserted, though any previous line with the same number will have 12808 'been deleted. the lines are maintained in the program space sorted 12809 'by line number. if the new line to be inserted is a different size 12810 'than the old line being replaced, the remainder of the program is 12811 'shifted over to make room or to close up the gap as necessary. if 12812 'there is insufficient memory to fit in the new line, the program 12813 'space is unchanged and an error stop occurs (with the IL address 12814 'decremented). a normal error stop occurs on expression stack 12815 'underflow or if the number is zero, which is not a valid line 12816 'number. after completing the insertion, the IL program is 12817 'restarted in the command mode. 12850 *il:gosub *popexint:lino=rval 'get line # 12852 if lino<=0 then if ilpc<>0 then gosub *tberror:goto *brk else *brk 12854 *il1:if core(bp)=32 then bp=bp+1:goto *il1 'skip leading spaces 12856 if core(bp)=13 then ix=0 else ix=inlend-bp+2 'nothing to add,the size of the insertion 12858 op=0 'this will be the number of bytes to delete 12860 pline=lino:gosub *findline:chpt=rval 'try to find this line 12862 ploc=chpt:gosub *peek2:if rval=lino then phere=chpt+2:pfch=13:gosub *skipto:op=rval-chpt 'there is a line to delete 12864 if ix=0 then if op=0 then lino=0:goto *brk 'nothing to add nor delete; done 12866 op=ix-op '= how many more bytes to add or (-)delete 12868 if srcend+op>=substk then gosub *tberror:goto *brk 'too big.. 12870 srcend=srcend+op 'new size 12872 if op>0 then for here=srcend-1 to chpt+ix step -1:core(here)=core(here-op):next 'shift backend over to right 12874 if op<0 then for here=chpt+ix to srcend-1:core(here)=core(here-op):next 'shift it left to close gap 12876 if ix>0 then ploc=chpt:pval=lino:gosub *poke2:chpt=chpt+1 'insert the new line # 12878 *il2:if ix>2 then chpt=chpt+1:core(chpt)=core(bp):bp=bp+1:ix=ix-1:goto *il2 12880 ploc=progend:pval=srcend:gosub *poke2 12882 ilpc=0 12884 lino=0 12886 goto *brk 12900 'MT 2B mark the BASIC program space empty. 12901 ' also clears the BASIC region of the control stack 12902 'and restart the IL program in the command mode. the memory bounds 12903 'and stack pointers are reset by this instruction to signify empty 12904 'program space, and the line number of the first line is set to 0, 12905 'which is the indication of the end of the program. 12950 *mt:gosub *coldstart 12952 goto *brk 13000 'XQ 2C execute. 13001 ' turns on RUN mode. this instruction also saves 13002 'the current value of the IL program counter for use of the NX 13003 'instruction, and sets the BASIC pointer to the beginning of the 13004 'BASIC program space. an error stop occurs if there is no BASIC 13005 'program. this instruction must be executed at least once before 13006 'the first execution of a NX instruction. 13050 *xq:xqhere=ilpc 13052 ploc=userprog:gosub *peek2:bp=rval 13054 ploc=bp:gosub *peek2:bp=bp+1:lino=rval 13056 bp=bp+1 13058 if lino=0 then gosub *tberror 13060 goto *brk 13100 'WS 2D stop. 13101 ' stop execution and restart the IL program in the 13102 'command mode. the entire control stack (including BASIC region) 13103 'is also vacated by this instruction. this instruction effectively 13104 'jumps to the warm start entry of the ML interpreter. 13150 *ws:gosub *warmstart 13152 goto *brk 13200 'US 2E machine language subroutine call. 13201 ' the top six bytes of the expression stack contain 13202 '3 numbers with the following interpretations: the top number is 13203 'loaded into the A (or A and B) register; the next number is loaded 13204 'into 16 bits of Index register; the third number is interpreted as 13205 'the address of a machine language subroutine to be called. these 13206 'six bytes on the expression stack are replaced with the 16-bit 13207 'result returned by the subroutine. stack underflow results in an 13208 'error stop. 13250 *us:ploc=linocore:pval=lino:gosub *poke2 'bring these memory locations up.. 13252 ploc=ilpccore:pval=ilpc:gosub *poke2 '..to date, in case user looks.. 13254 ploc=bpcore:pval=bp:gosub *poke2 13256 ploc=svptcore:pval=svpt:gosub *poke2 13258 gosub *popexint:ix=rval 'datum A 13260 gosub *popexint:here=rval 'datum X-OFF 13262 gosub *popexint:op=rval 'nominal machine address 13264 if op=-1 then return else if ilpc=0 then *us2 13266 ploc=ilfront:gosub *peek2:if op=ilend then *us1 13268 pval=here:gosub *pushexint 'call IL subroutine.. 13270 pval=ix:gosub *pushexint 13272 psub=ilpc:gosub *pushsub 'push return address 13274 ilpc=op:goto *us2 13276 *us1:if op=coldgo then gosub *coldstart:goto *brk 13278 if op=warmgo then gosub *warmstart:goto *brk 13280 if op=subinch then gosub *inch:pval=asc(rval$):gosub *pushexint:goto *brk 13282 if op=suboutch then pch$=chr$(ix and 127):gosub *ouch:pval=0:gosub *pushexint:goto *brk 13284 if op<>subbreak then *us1a 13286 if fnstopit then pval=1 else pval=0 13288 gosub *pushexint:goto *brk 13290 *us1a:if op=subpeek then pval=core(here):gosub *pushexint:goto *brk 13292 if op=subpeek2 then ploc=here:gosub *peek2:pval=rval:gosub *pushexint:goto *brk 13294 if op=subpoke then ix=ix and &hff:core(here)=ix:pval=ix:gosub *pushexint:ploc=linocore:gosub *peek2:lino=rval:ploc=ilpccore:gosub *peek2:ilpc=rval:ploc=bpcore:gosub *peek2:bp=rval:ploc=svptcore:gosub *peek2:svpt=rval:goto *brk 13296 gosub *tberror:goto *brk 13298 *us2:goto *brk 13400 'RT 2F IL subroutine return. 13401 ' the IL control stack is popped to give the address 13402 'of the next IL instruction. an error stop occurs if the entire 13403 'control stack (IL and BASIC) is empty. 13450 *rt:gosub *popsub:ix=rval 'get return from pop 13452 ploc=ilfront:gosub *peek2:if ix=ilend then gosub *tberror else ilpc=ix 13454 goto *brk 13500 'JS a 3000-37FF IL subroutine call. 13501 ' the least significant eleven bits of this 13502 '2-byte instruction are added to the base address of the IL program 13503 'to become address of the next instruction. the previous contents 13504 'of the IL program counter are pushed onto the IL region of the 13505 'control stack. stack overflow results in an error stop. 13550 *js:psub=ilpc+1:gosub *pushsub 'push return location there 13552 if ilpc=0 then *brk 13554 ploc=ilpc-1:gosub *peek2:ix=rval and &h7ff:ploc=ilfront:gosub *peek2:ilpc=ix+rval 13556 goto *brk 13600 'J a 3800-3FFF jump. 13601 ' the low eleven bits of this 2-byte 13602 'instruction are added to the IL program base address to determine 13603 'the address of the next IL instruction. the previous contents of 13604 'the IL program counter is lost. 13650 *j:ploc=ilpc-1:gosub *peek2:ix=rval and &h7ff:ploc=ilfront:gosub *peek2:ilpc=ix+rval 13652 goto *brk 13700 'BR a 40-7F relative branch. 13701 ' the low six bits of this instruction opcode are 13702 'added algebraically to the current value of the IL program counter 13703 'to give the address of the next IL instruction. Bit 5 of opcode is 13704 'the sign, with + signified by 1, - by 0. The range of this branch 13705 'is +/-31 bytes from address of the byte following the opcode. an 13706 'offset of zero (i.e. opcode 60) results in an error stop. the 13707 'branch operation is unconditional. 13750 *br:ilpc=ilpc+op-96 13752 goto *brk 13800 'BC a "xxx" 80xxxxXx-9FxxxxXx string match branch. 13801 ' the ASCII character string in IL 13802 'following this opcode is compared to the string beginning with the 13803 'current position of the BASIC pointer, ignoring blanks in BASIC 13804 'program. the comparison continues until either a mismatch, or an 13805 'IL byte is reached with the most significant bit set to one. this 13806 'is the last byte of the string in the IL, compared as a 7-bit 13807 'character; if equal, the BASIC pointer is positioned after the 13808 'last matching character in the BASIC program and the IL continues 13809 'with the next instruction in sequence. otherwise the BASIC pointer 13810 'is not altered and the low five bits of the Branch opcode are 13811 'added to the IL program counter to form the address of the next 13812 'IL instruction. if the strings do not match and the branch offset 13813 'is zero an error stop occurs. 13850 *bc:if op=128 then here=0 else here=ilpc+op-128 'to error if no match 13852 chpt=bp 13854 ix=0 13856 *bc1:if (ix and 128)<>0 then *bc2 13858 *bc1a:if core(bp)=32 then bp=bp+1:goto *bc1a 'skip over spaces 13860 ix=core(ilpc):ilpc=ilpc+1 13862 cm=(ix and 127)<>(caps(core(bp)) and 127):bp=bp+1:if not cm then *bc1 13864 bp=chpt 'back up to front of string in Basic 13866 if here=0 then gosub *tberror else ilpc=here 'jump forward in IL 13868 goto *bc2 13870 goto *bc1 13872 *bc2:goto *brk 13900 'BV a A0-BF branch if not variable. 13901 ' if the next non-blank character pointed to by the 13902 'BASIC pointer is a capital letter, its ASCII code is [doubled and] 13903 'pushed onto the expression stack and the IL program advances to 13904 'next instruction in sequence, leaving the BASIC pointer positioned 13905 'after the letter; if not a letter the branch is taken and BASIC 13906 'pointer is left pointing to that character. an error stop occurs 13907 'if the next character is not a letter and the offset of the branch 13908 'is zero, or on stack overflow. 13950 *bv:if core(bp)=32 then bp=bp+1:goto *bv 'skip over spaces 13952 ch=core(bp) 13954 if (ch>=65 and ch<=90) or (ch>=97 and ch<=122) then pval=(core(bp) and &h5f)*2:gosub *pushexby:bp=bp+1:goto *bv1 13956 if op=160 then gosub *tberror else ilpc=ilpc+op-160 13958 *bv1:goto *brk 14000 'BN a C0-DF branch if not a number. 14001 ' if the next non-blank character pointed to by the 14002 'BASIC pointer is not a decimal digit, the low five bits of the 14003 'opcode are added to the IL program counter, or if zero an error 14004 'stop occurs. if the next character is a digit, then it and all 14005 'decimal digits following it (ignoring blanks) are converted to a 14006 '16-bit binary number which is pushed onto the expression stack. in 14007 'either case the BASIC pointer is positioned at the next character 14008 'which is neither blank nor digit. stack overflow will result in an 14009 'error stop. 14050 *bn:if core(bp)=32 then bp=bp+1:goto *bn 'skip over spaces 14052 ch=core(bp) 14054 if ch<48 or ch>57 then *bn2: 14056 op=0 14058 *bn1:here=core(bp):bp=bp+1 14060 if here=32 then *bn1 'skip over spaces 14062 if here<48 or here>57 then *bn1a 'not a decimal digit 14064 op=op*10:sn=op and &h8000:op=op and &h7fff:if sn>0 then op=-(32768-op) 14066 op=op+(here-48) 'insert into value 14068 goto *bn1 14070 *bn1a:bp=bp-1 'back up over non digit 14072 pval=op:gosub *pushexint 14074 goto *bn3 14076 *bn2:if op=192 then gosub *tberror else ilpc=ilpc+op-192 'error if no digit 14078 *bn3:goto *brk 14100 'BE a E0-FF branch if not endline. 14101 ' if the next non-blank character pointed to by the 14102 'BASIC pointer is a carriage return, the IL program advances to the 14103 'next instruction in sequence; otherwise the low five bits of the 14104 'opcode (if not 0) are added to the IL program counter to form the 14105 'address of next IL instruction. in either case the BASIC pointer 14106 'is left pointing to the first non-blank character; this 14107 'instruction will not pass over the carriage return, which must 14108 'remain for testing by the NX instruction. as with the other 14109 'conditional branches, the branch may only advance the IL program 14110 'counter from 1 to 31 bytes; an offset of zero results in an error 14111 'stop. 14150 *be:if core(bp)=32 then bp=bp+1:goto *be 'skip over spaces 14152 if core(bp)=13 then else if op=224 then gosub *tberror else ilpc=ilpc+op-224 'error if no offset 14154 goto *brk 14999 *brk:goto *iloop 50000 '*************** intermediate interpreter condensed *************** 50000 data "243A912710E159C52A5610112C8B4C45D4A080BD30BCE0131D9447CF8854CF30" 50001 data "BCE0101116805355C230BCE014169050D283494ED4E57188BBE11D8FA221586F" 50002 data "83AC225583BA2493E0231D30BC20489149C630BC313430BC84544845CE1C1D38" 50003 data "0D9A494E5055D4A010E7243F209127E15981AC30BC131182AC4DE01D89524554" 50004 data "5552CEE0151D85454EC4E02D984C4953D4EC24000000000A801F2493231D30BC" 50005 data "E15080AC59855255CE380A86434C4541D22B845245CD1DA080BD381485AD30D3" 50006 data "176481AB30D385AB30D3185A85AD30D319542F30E285AA30E21A5A85AF30E21B" 50007 data "542F97524EC40A8080120A09291A0A1A8518130980120B313061730B02040203" 50008 data "05031B1A190B09060A00001C172F8F5553D280A830BC312A312A80A92E2FA212" 50009 data "2FC12F80A830BC80A92F83AC38BC0B2F80A8522F84BD09022F8EBC84BD09032F" 50010 data "84BE09052F09012F80BE84BD09062F84BC09052F09042F" 50011 data "" 60000 '*************** intermediate interpreter assembled *************** 60001 rem "0000 ; 1 . ORIGINAL TINY BASIC INTERMEDIATE INTERPRETER" 60002 rem "0000 ; 2 ." 60003 rem "0000 ; 3 . EXECUTIVE INITIALIZATION" 60004 rem "0000 ; 4 ." 60005 rem "0000 ; 5 :STRT PC "":Q^"" COLON, X-ON" 60006 rem "0000 243A91;" 60007 rem "0003 ; 6 GL" 60008 rem "0003 27; 7 SB" 60009 rem "0004 10; 8 BE L0 BRANCH IF NOT EMPTY" 60010 rem "0005 E1; 9 BR STRT TRY AGAIN IF NULL LINE" 60011 rem "0006 59; 10 :L0 BN STMT TEST FOR LINE NUMBER" 60012 rem "0007 C5; 11 IL IF SO, INSERT INTO PROGRAM" 60013 rem "0008 2A; 12 BR STRT GO GET NEXT" 60014 rem "0009 56; 13 :XEC SB SAVE POINTERS FOR RUN WITH" 60015 rem "000A 10; 14 RB CONCATENATED INPUT" 60016 rem "000B 11; 15 XQ" 60017 rem "000C 2C; 16 ." 60018 rem "000D ; 17 . STATEMENT EXECUTOR" 60019 rem "000D ; 18 ." 60020 rem "000D ; 19 :STMT BC GOTO ""LET""" 60021 rem "000D 8B4C45D4;" 60022 rem "0011 ; 20 BV * MUST BE A VARIABLE NAME" 60023 rem "0011 A0; 21 BC * ""=""" 60024 rem "0012 80BD; 22 :LET JS EXPR GO GET EXPRESSION" 60025 rem "0014 30BC; 23 BE * IF STATEMENT END," 60026 rem "0016 E0; 24 SV STORE RESULT" 60027 rem "0017 13; 25 NX" 60028 rem "0018 1D; 26 ." 60029 rem "0019 ; 27 :GOTO BC PRNT ""GO""" 60030 rem "0019 9447CF;" 60031 rem "001C ; 28 BC GOSB ""TO""" 60032 rem "001C 8854CF;" 60033 rem "001F ; 29 JS EXPR GET LINE NUMBER" 60034 rem "001F 30BC; 30 BE *" 60035 rem "0021 E0; 31 SB (DO THIS FOR STARTING)" 60036 rem "0022 10; 32 RB" 60037 rem "0023 11; 33 GO GO THERE" 60038 rem "0024 16; 34 ." 60039 rem "0025 ; 35 :GOSB BC * ""SUB"" NO OTHER WORD BEGINS ""GO...""" 60040 rem "0025 805355C2;" 60041 rem "0029 ; 36 JS EXPR" 60042 rem "0029 30BC; 37 BE *" 60043 rem "002B E0; 38 GS" 60044 rem "002C 14; 39 GO" 60045 rem "002D 16; 40 ." 60046 rem "002E ; 41 :PRNT BC SKIP ""PR""" 60047 rem "002E 9050D2;" 60048 rem "0031 ; 42 BC P0 ""INT"" OPTIONALLY OMIT ""INT""" 60049 rem "0031 83494ED4;" 60050 rem "0035 ; 43 :P0 BE P3" 60051 rem "0035 E5; 44 BR P6 IF DONE, GO TO END" 60052 rem "0036 71; 45 :P1 BC P4 "";""" 60053 rem "0037 88BB; 46 :P2 BE P3" 60054 rem "0039 E1; 47 NX NO CRLF IF ENDED BY ; OR ," 60055 rem "003A 1D; 48 :P3 BC P7 '""'" 60056 rem "003B 8FA2; 49 PQ QUOTE MARKS STRING" 60057 rem "003D 21; 50 BR P1 GO CHECK DELIMITER" 60058 rem "003E 58; 51 :SKIP BR IF (ON THE WAY THRU)" 60059 rem "003F 6F; 52 :P4 BC P5 "",""" 60060 rem "0040 83AC; 53 PT COMMA SPACING" 60061 rem "0042 22; 54 BR P2" 60062 rem "0043 55; 55 :P5 BC P6 "":""" 60063 rem "0044 83BA; 56 PC ""S^"" OUTPUT X-OFF" 60064 rem "0046 2493; 57 :P6 BE *" 60065 rem "0048 E0; 58 NL THEN CRLF" 60066 rem "0049 23; 59 NX" 60067 rem "004A 1D; 60 :P7 JS EXPR TRY FOR AN EXPRESSION" 60068 rem "004B 30BC; 61 PN" 60069 rem "004D 20; 62 BR P1" 60070 rem "004E 48; 63 ." 60071 rem "004F ; 64 :IF BC INPT ""IF""" 60072 rem "004F 9149C6;" 60073 rem "0052 ; 65 JS EXPR" 60074 rem "0052 30BC; 66 JS RELO" 60075 rem "0054 3134; 67 JS EXPR" 60076 rem "0056 30BC; 68 BC I1 ""THEN"" OPTIONAL NOISEWORD" 60077 rem "0058 84544845CE;" 60078 rem "005D ; 69 :I1 CP COMPARE SKIPS NEXT IF TRUE" 60079 rem "005D 1C; 70 NX FALSE." 60080 rem "005E 1D; 71 J STMT TRUE. GO PROCESS STATEMENT" 60081 rem "005F 380D; 72 ." 60082 rem "0061 ; 73 :INPT BC RETN ""INPUT""" 60083 rem "0061 9A494E5055D4;" 60084 rem "0067 ; 74 :I2 BV * GET VARIABLE" 60085 rem "0067 A0; 75 SB SWAP POINTERS" 60086 rem "0068 10; 76 BE I4" 60087 rem "0069 E7; 77 :I3 PC ""? Q^"" LINE IS EMPTY; TYPE PROMPT" 60088 rem "006A 243F2091;" 60089 rem "006E ; 78 GL READ INPUT LINE" 60090 rem "006E 27; 79 BE I4 DID ANYTHING COME?" 60091 rem "006F E1; 80 BR I3 NO, TRY AGAIN" 60092 rem "0070 59; 81 :I4 BC I5 "","" OPTIONAL COMMA" 60093 rem "0071 81AC; 82 :I5 JS EXPR READ A NUMBER" 60094 rem "0073 30BC; 83 SV STORE INTO VARIABLE" 60095 rem "0075 13; 84 RB SWAP BACK" 60096 rem "0076 11; 85 BC I6 "","" ANOTHER?" 60097 rem "0077 82AC; 86 BR I2 YES IF COMMA" 60098 rem "0079 4D; 87 :I6 BE * OTHERWISE QUIT" 60099 rem "007A E0; 88 NX" 60100 rem "007B 1D; 89 ." 60101 rem "007C ; 90 :RETN BC END ""RETURN""" 60102 rem "007C 895245545552CE;" 60103 rem "0083 ; 91 BE *" 60104 rem "0083 E0; 92 RS RECOVER SAVED LINE" 60105 rem "0084 15; 93 NX" 60106 rem "0085 1D; 94 ." 60107 rem "0086 ; 95 :END BC LIST ""END""" 60108 rem "0086 85454EC4;" 60109 rem "008A ; 96 BE *" 60110 rem "008A E0; 97 WS" 60111 rem "008B 2D; 98 ." 60112 rem "008C ; 99 :LIST BC RUN ""LIST""" 60113 rem "008C 984C4953D4;" 60114 rem "0091 ; 100 BE L2" 60115 rem "0091 EC; 101 :L1 PC ""@^@^@^@^J^@^"" PUNCH LEADER" 60116 rem "0092 24000000000A80;" 60117 rem "0099 ; 102 LS LIST" 60118 rem "0099 1F; 103 PC ""S^"" PUNCH X-OFF" 60119 rem "009A 2493; 104 NL" 60120 rem "009C 23; 105 NX" 60121 rem "009D 1D; 106 :L2 JS EXPR GET A LINE NUMBER" 60122 rem "009E 30BC; 107 BE L3" 60123 rem "00A0 E1; 108 BR L1" 60124 rem "00A1 50; 109 :L3 BC * "","" SEPARATED BY COMMAS" 60125 rem "00A2 80AC; 110 BR L2" 60126 rem "00A4 59; 111 ." 60127 rem "00A5 ; 112 :RUN BC CLER ""RUN""" 60128 rem "00A5 855255CE;" 60129 rem "00A9 ; 113 J XEC" 60130 rem "00A9 380A; 114 ." 60131 rem "00AB ; 115 :CLER BC REM ""CLEAR""" 60132 rem "00AB 86434C4541D2;" 60133 rem "00B1 ; 116 MT" 60134 rem "00B1 2B; 117 ." 60135 rem "00B2 ; 118 :REM BC DFLT ""REM""" 60136 rem "00B2 845245CD;" 60137 rem "00B6 ; 119 NX" 60138 rem "00B6 1D; 120 ." 60139 rem "00B7 ; 121 :DFLT BV * NO KEYWORD..." 60140 rem "00B7 A0; 122 BC * ""="" TRY FOR LET" 60141 rem "00B8 80BD; 123 J LET IT'S A GOOD BET." 60142 rem "00BA 3814; 124 ." 60143 rem "00BC ; 125 . SUBROUTINES" 60144 rem "00BC ; 126 ." 60145 rem "00BC ; 127 :EXPR BC E0 ""-"" TRY FOR UNARY MINUS" 60146 rem "00BC 85AD; 128 JS TERM AHA" 60147 rem "00BE 30D3; 129 NE" 60148 rem "00C0 17; 130 BR E1" 60149 rem "00C1 64; 131 :E0 BC E4 ""+"" IGNORE UNARY PLUS" 60150 rem "00C2 81AB; 132 :E4 JS TERM" 60151 rem "00C4 30D3; 133 :E1 BC E2 ""+"" TERMS SEPARATED BY PLUS" 60152 rem "00C6 85AB; 134 JS TERM" 60153 rem "00C8 30D3; 135 AD" 60154 rem "00CA 18; 136 BR E1" 60155 rem "00CB 5A; 137 :E2 BC E3 ""-"" TERMS SEPARATED BY MINUS" 60156 rem "00CC 85AD; 138 JS TERM" 60157 rem "00CE 30D3; 139 SU" 60158 rem "00D0 19; 140 BR E1" 60159 rem "00D1 54; 141 :E3 RT" 60160 rem "00D2 2F; 142 ." 60161 rem "00D3 ; 143 :TERM JS FACT" 60162 rem "00D3 30E2; 144 :T0 BC T1 ""*"" FACTORS SEPARATED BY TIMES" 60163 rem "00D5 85AA; 145 JS FACT" 60164 rem "00D7 30E2; 146 MP" 60165 rem "00D9 1A; 147 BR T0" 60166 rem "00DA 5A; 148 :T1 BC T2 ""/"" FACTORS SEPARATED BY DIVIDE" 60167 rem "00DB 85AF; 149 JS FACT" 60168 rem "00DD 30E2; 150 DV" 60169 rem "00DF 1B; 151 BR T0" 60170 rem "00E0 54; 152 :T2 RT" 60171 rem "00E1 2F; 153 ." 60172 rem "00E2 ; 154 :FACT BC F0 ""RND"" *RND FUNCTION*" 60173 rem "00E2 97524EC4;" 60174 rem "00E6 ; 155 LN 257*128 STACK POINTER FOR STORE" 60175 rem "00E6 0A;" 60176 rem "00E7 8080; 156 FV THEN GET RNDM" 60177 rem "00E9 12; 157 LN 2345 R:=R*2345+6789" 60178 rem "00EA 0A;" 60179 rem "00EB 0929; 158 MP" 60180 rem "00ED 1A; 159 LN 6789" 60181 rem "00EE 0A;" 60182 rem "00EF 1A85; 160 AD" 60183 rem "00F1 18; 161 SV" 60184 rem "00F2 13; 162 LB 128 GET IT AGAIN" 60185 rem "00F3 0980; 163 FV" 60186 rem "00F5 12; 164 DS" 60187 rem "00F6 0B; 165 JS FUNC GET ARGUMENT" 60188 rem "00F7 3130; 166 BR F1" 60189 rem "00F9 61; 167 :F0 BR F2 (SKIPPING)" 60190 rem "00FA 73; 168 :F1 DS" 60191 rem "00FB 0B; 169 SX 2 PUSH TOP INTO STACK" 60192 rem "00FC 02; 170 SX 4" 60193 rem "00FD 04; 171 SX 2" 60194 rem "00FE 02; 172 SX 3" 60195 rem "00FF 03; 173 SX 5" 60196 rem "0100 05; 174 SX 3" 60197 rem "0101 03; 175 DV PERFORM MOD FUNCTION" 60198 rem "0102 1B; 176 MP" 60199 rem "0103 1A; 177 SU" 60200 rem "0104 19; 178 DS PERFORM ABS FUNCTION" 60201 rem "0105 0B; 179 LB 6" 60202 rem "0106 0906; 180 LN 0" 60203 rem "0108 0A;" 60204 rem "0109 0000; 181 CP (SKIP IF + OR 0)" 60205 rem "010B 1C; 182 NE" 60206 rem "010C 17; 183 RT" 60207 rem "010D 2F; 184 :F2 BC F3 ""USR"" *USR FUNCTION*" 60208 rem "010E 8F5553D2;" 60209 rem "0112 ; 185 BC * ""("" 3 ARGUMENTS POSSIBLE" 60210 rem "0112 80A8; 186 JS EXPR ONE REQUIRED" 60211 rem "0114 30BC; 187 JS ARG" 60212 rem "0116 312A; 188 JS ARG" 60213 rem "0118 312A; 189 BC * "")""" 60214 rem "011A 80A9; 190 US GO DO IT" 60215 rem "011C 2E; 191 RT" 60216 rem "011D 2F; 192 :F3 BV F4 VARIABLE?" 60217 rem "011E A2; 193 FV YES. GET IT" 60218 rem "011F 12; 194 RT" 60219 rem "0120 2F; 195 :F4 BN F5 NUMBER?" 60220 rem "0121 C1; 196 RT GOT IT." 60221 rem "0122 2F; 197 :F5 BC * ""("" OTHERWISE MUST BE (EXPR)" 60222 rem "0123 80A8; 198 :F6 JS EXPR" 60223 rem "0125 30BC; 199 BC * "")""" 60224 rem "0127 80A9; 200 RT" 60225 rem "0129 2F; 201 ." 60226 rem "012A ; 202 :ARG BC A0 "","" COMMA?" 60227 rem "012A 83AC; 203 J EXPR YES, GET EXPRESSION" 60228 rem "012C 38BC; 204 :A0 DS NO, DUPLICATE STACK TOP" 60229 rem "012E 0B; 205 RT" 60230 rem "012F 2F; 206 ." 60231 rem "0130 ; 207 :FUNC BC * ""(""" 60232 rem "0130 80A8; 208 BR F6" 60233 rem "0132 52; 209 RT" 60234 rem "0133 2F; 210 ." 60235 rem "0134 ; 211 :RELO BC R0 ""="" CONVERT RELATION OPERATORS" 60236 rem "0134 84BD; 212 LB 2 TO CODE BYTE ON STACK" 60237 rem "0136 0902; 213 RT =" 60238 rem "0138 2F; 214 :R0 BC R4 ""<""" 60239 rem "0139 8EBC; 215 BC R1 ""=""" 60240 rem "013B 84BD; 216 LB 3 <=" 60241 rem "013D 0903; 217 RT" 60242 rem "013F 2F; 218 :R1 BC R3 "">""" 60243 rem "0140 84BE; 219 LB 5 <>" 60244 rem "0142 0905; 220 RT" 60245 rem "0144 2F; 221 :R3 LB 1 <" 60246 rem "0145 0901; 222 RT" 60247 rem "0147 2F; 223 :R4 BC * "">""" 60248 rem "0148 80BE; 224 BC R5 ""=""" 60249 rem "014A 84BD; 225 LB 6 >=" 60250 rem "014C 0906; 226 RT" 60251 rem "014E 2F; 227 :R5 BC R6 ""<""" 60252 rem "014F 84BC; 228 LB 5 ><" 60253 rem "0151 0905; 229 RT" 60254 rem "0153 2F; 230 :R6 LB 4 >" 60255 rem "0154 0904; 231 RT" 60256 rem "0156 2F; 232 ." 60257 rem "0157 ; 0000"