From a589592f27b4f310caf01f50cc5a68e6cc191cd2 Mon Sep 17 00:00:00 2001 From: Philip Smart Date: Thu, 18 Jun 2020 00:45:08 +0100 Subject: [PATCH] Added Microsoft BASIC converted for Sharp and tranZPUter --- software/MZF/BASIC.MZF | Bin 12160 -> 12434 bytes software/asm/BASIC.asm | 9527 ++++++++++---------- software/asm/include/BASIC_Definitions.asm | 4 +- software/asm/tzfs.asm | 2 +- 4 files changed, 4785 insertions(+), 4748 deletions(-) diff --git a/software/MZF/BASIC.MZF b/software/MZF/BASIC.MZF index eb98bdcd22727cfc783569df0dff112c0f46ee28..4f6a091684a7e6e6f5a6e238773a20d6f70a461c 100644 GIT binary patch literal 12434 zcmd6N3s@7^*60j*5#Av{5>Uuw5Msh(GFrqGqR2~p5CoK3PerXSY!wwPAP}(DN8k2g zt8H)Fzo+N4wf|{qAI84?NygaBz_fru`*Th`rZk?mDJ?-`Tb1Fi9c)i~?tj1Uzu$Mi z``y6o*^jl?T6^ua)?Rz>!I$2iPZenw6xCD|Ygd?ZsOa^%SbTL6_W$U|NHL}y|AN3U zrUBa`zZf_9-}?c3|2@DE6hL1dU155`WQjPp#)8q`nTYCK{B@DNZYLSpazgtvzjlTN zBd|U`VTMITV4tJ6nEs9e*!dKJQMw{ZSBy$!lm(|RQ5FmRHD&3dFQa7g@BH?3{?T;H zB<-iZAR4qdhAA*Whw%gH76~o7Xo)(vhIqk*ul*zyYnq~XUGacOdM8vSH$5H{Jp<3V z;_A}U%HE2~(i&z-&1V%QwF`M`Wd$HPS6U0$N^AS7D=KRlYh`V3MNKWUq_n7-Sz;|J zVQPw2l=edA9K6p~moEFHv<_(fU->^@v_OB}dbaXhRk8m3!qUo5thMKAORHZ0%W?Y! zXJyH!)u%uD@LYK%TUqN|P%~Il4dg)}eb$!e3kO!G%n?%6j#bR z?Pb$dQ&?np=`K{Bpq|TYXF;%bKAZb0MZv8N!{aRxCs-(`>G*yi;W!qvZ%W5jC z%dI74#nu(prOTHrs3|GQrC=VGT5Fcn)YKMNE-zbZU3lAqN-#sFQ+^I(hp@)>3)rTX z3s|`YW5IN8S;QTiJMEsMx+8BNjrgMcXifjIV-d+O9Nq9Ce{`tXa~4O*ByMr%uV?rhwNX&bg_G3#B?5g4{$=Z3X+VT2f)Ya@ld-IZh+ z>1$ZC=WRbXP3-3h86J&!J#t1W=I4psBTlHXg?S>4j8W_}w9-;cF1PqBeMcHClg|xT ziZ{*mex4e|Y!w?e)4J=X)G$0X0Z+y7)Ob8qho?s1scJA0`YRJ(6G^NQ)mi58v`k}z zgg+4uDe76xV>Y|Eb{2F}1~MzuD<30w5+Q0XzS^bohiAIu;aiC&WSi zKKUU3uB5y_Fz{ITpxaL0MMIk-$d^inzZD09+>8i^djOaC4ZG>&Fp(1QyT-+98g#qq z{s5?WalCT!|l` zm~4q*!c?*pnv5Qjw2>Pd0sWc=l$qz5*T*cBbOV6BnQSHjIb@Bxt+b(%)~%!MyfYkV z>zZj@EA0d?^D|LR>#Asb<0f4bO>d!f9kkDF*h;e@X<4)&CuY=SrgL5xNc^~eU`_c*20%iz+50YB?+ zb@r3-%BUeTw^%AvxGJT<)KIPKw4~gISUCms$@nNGQ!6DVP4PZ6l}25$;4dvr-&1e`RvGX2l2GLFm0g zX7-xO&5LL;S1psA0yYZhMRdT)_snGZmKm2ih1hQBkP9koXF*N7ouHF$o{@QxxwV|& zUKaDcGX8JjZW!@uas}!0!=hr*dV#*pL2|9K@nf=~POIV&o~(3?zb=b*y)L`d39YF3 zu8et3<}>`mr1P1)tZ&fZGbtt~M{kE>zjy3r1F#{8xF2L*rdKuv$}GYy>p{EtjS)^C zZ;jAxq=_(WE-w}LyY%7mLE{SJYLfIBHqxNUURP9j|IhxIa6S+0ej`2N0~;OT_0fE$ z%*oG)_VG0;uX_;3_Aa~KCY-h4uJz%_qNiGT8EOp9@_`bMNcXyD!B9c{ZGxG5EZpH* zDF%Z%$wkOX7`q<~+Yen8JHiJ&LtVogBLw}xO0mo;#r(weFgZxf?FVHv_kr4<2p6b% z1%<3142l~H_k(PGAlfwz{R1;1jJh`3&+=PmI6P?dDSD+K(#HzQZd6iupdeFUfpFnF zQ}@+wV28Lm>4Z@QJ6?h zav-6bzGz~7hHp$#%qrJ?12bV0iar-s&10wJ05Z7NDK{UWg~P*k72b6if)gKqugbg3 zlNt^V(+FjN?DGYQqZ*L-@JjKzyEHR3GXq0ZeG;bedznLWZnuPAD>nk14}1sLEBAu@ zvj%V0fgnfx9Z%G^KT`*;*atoZ*JE-s@Sy^{N!~L+5WDp zBEozZ?Qs23Oza3Bv3PNF3?{`|7lIG)obr(1n3hK{w?*(NvB2%8gXSf4ke?GB7y+55 z@rG#bJs`J__K|4%VImR3uSS3$giQayn-Ronq=AsJ^z-#fKYvsKFE77N1%`+#GIYe^*k?`r--MV=OzoedANc`>&zQVfQF zpzzfBHIY0XZ$E>_dl?}D>Kq5+P&<>>lvm?^{Wyo`& z?gJ+yhhhdEh|FbPj|}qr5`f>C#=sEcRWxluEoc{ zDsc|W#9i`&=iZn2IPcsxv9EplG1Au6ps$gElfa$d{@{eEeGpUPPT=p$eIy^DyMN#AxJy z8rCpd!+!?zhatOmgdEuyQJ@G{=fD6Tb$rd-B?hVJjY-&G3=a0gzY(o#qz#RuJUuZKszYM5*a8=HVDMzd}Bc7$an8 zjRD$edsOvF>s#LMW1fya9@FYbbM^wbIame3_z?<`yOynrRe@ zLYaFiw)H8}^#Jcbn~m_&VV20sGtrR@df0EXM)Chb&Kg# zY*66~0xuSgAJC(apUaQ4y+^u|<7}spO_45XoOv;Lly%}j$x>kaDekGb)HqlT6k;sE zb;@^;+es^!0ZD>R?;rtI)rv=A1FPbkBGeZ2@t0M8Z=lds6Bk^t*sp=r33d}Of}6~@ z#);}cw^#dT%Kb(o8b@IG{kU?gjZE?)21bIw)xfMcgr{E`u5y0!h8qN-GkSVA{R4>PGMaHQpS=3*S*tN^cwTO-_q z$d*IejzS(U(g+X_JfD^<9RdEClL`PH1igl)5ya1)x48{s6x#b>K1U!tH|(W-hECc? zbb>Y_r!pg?MzA1zb)6vQz3_B|CM2|Adb?ATKzu;L1t%9<=#%BVHkJXp@E=-ZU<~+k zN;hb=k5|Q`D3O0t;cMh)EBjfffECf#9NL|DS))`}<%^jlZBY(xK=D32r(BFe(Dj}O zA0hp%&`+_NHdN7|5O8P$o@1Q~gbCXVudO>Z6}TW_O+zwUp_(?`gVrb^x_3*YhzXB( z!~}vj<(O-gPRdE>IDAVyY*|QufDNQ3gNON#Ag+mbPi5ie3QwGq zd5h9s2lHWbOci%2!IDD5OJ*%NFu~uS0OXsTK$M@GU>~viY^R3bP_`&yFgNIc(+dGp z8M$#YNUCHhOmj#(fbl8#{=wwK%*#r@jkhF-C4kzUIw{QLE-OLlvcOd%6%UNye^$B+ zPfM{rtL?E5%0Dk=d0-(i9&9C6!(beBGXubQTg7G}8U1ipKkS_Esi)4QGZ zBQ(x_H*~x|fxckkzc4XB#PLlD%%4n<22-)n;@*JBA*xOQc>P6gO9Ben0G|G{3AHf5 zPiV8iub0E(*cpm&+gMl@k`cNYXt6+6ics{&v&4Q4Xba;^fRu3d!-Cb~@IYkk;1;S5 z5BxPDx4;i;CR$mX{eq@1$Zu6`3h)OK-y!zV<9H&!F>#!a53ti+Z- zlsdTbMB)H_pm`uO(bEDs$BmVVWu)y=*K1a0p=w%pLU&YmOxNsgX0zC~4=6kU6z;dO z#6jAY+iY(RZyv znWKqtsIymee1)bfpu4B5^mzWg5X(Bg?UVy$8-7cd;B&@{9E^7-wbDmuzwRj-&P}UsBjOW%L~4@H z2O_hP4sKDBFDE>0Q|mx}lF#rI4Z9KZ5&Hh$@Rr@~%1rXIz`T_O;p5u-5G^zVDBAvm zIA;<_%${wu(I-rh`~@YinTq^&Yh6A4j>+fl;9oUez~&7cNrGY^FlWH&Z7nEFyS6Y< z)uyUPGFMq=wy4U@@0e5o(fZcgu6vVwFz#EtkOA?wIJj?;I-uf>uJW{3TgJamI@{F@ zs};__1b3(APXC0LaA!?qLThCCGt+gQauS}IO% zR+19edKG9dZIjJOYo3=zlFhAnR zmeUP|R>JwbjfDNx7`*0tPU?)D9$(hvoT=ymopIyI;auK{HNqi&PQ_Q?*wrkBZA z`-lKK?(_QX(xZH;ikMLNh(i#f%2avU@%Pnv*<>EYZP)m2P$~#2@6q7Jk12k#!mir! z!D{-kPu(#lvNF#&~h%~UL3M(x11{L>fB(4NaUJhU- zC3!i$cc>7jaIzuI6}LTAPwsiXj%bAUKZc=q~b>sG3)*Eg8CaU?XDLO z;BlGQ*CK2^hQZk^m?A-`M!o^*AfHz{Wlb&I_nPtdG!C#T2d7UQbhlpZ1SZFaG+_9{ z024&V3hilLP(&|i;fHxiL~=I>S9dK~iTJmS#6ND}lr+XV(Ok`zQP zlvS0{rhI2SQD62s@`Jh^MTHK%!7*r7d_UNp2<9Y1cHob2p` z0qjK%3J55!B@TuZ^hTl=iZ&9Mmjc2<&!8K^K~#(OUCsnAvnd&-lQ?C%b}^awPZPjF z-gDrROo}y=2M=210EifMm`ux1pQRpHpKq>Qfw*h-X1Gr@ zU!#ODy@da6x>`Mle=*GmXJ4a>ADoc?a!cSgV9Uu^t}^6>(GQn#21qeSE|;$ zcLKeLvlF`O6l;-%suQNF6SS=P-iZR#M;xjrr|L;9%l~mYgyTjdx`lXf0zW$;_ra+r zrARaR9HR@o`O*CO>Cn*ru6{9~w#Ab|v>xV3FH)*6*n|izP69b1&18>(#--Gz{$o#?OECUvRIkJEW(I%^SuxWphXDUJ@+Ksx`GV31VA`shLal~n$g zG@ecES4-y11M$Fi_E#Z*e(4^Z@LD9H!NpDuE*1v&Me6?|2#YiXq?rPO*OXwun~l~y zIKjH7mKNA|A`$W-Ks9vtPmHdrr2V7SFmy|}I(~E&=u6H06EK}qb@CvbW*?l=H7Wykdxs_h zXzcnh^>m~y9&^`(5Ux*BYlz!&U|9_?4~vPra@1Fd&K&g*#N#>YZ;4lOV9|XqM}3jt zbJTw&F6O9*h|4+ZenOI~?uBz^L~zdsTCrt5OlA?nu1($Zfj-f)Ae4_c+&_Wt!)NCL zewLV@tNxKt<*FaIgq>T%ypTQGG(nltOhLGXK_3ASvWt0LKI7^Y1dfeX`@MN@8uKK1 znBfYg(Osdac*9kS)Lo_8-_^vw+>~1y-XqG#XUF~Qbm)8QGs0U6FU87aGHct6Sn5XmUMr&`T4cjN z5CCg)Xy@6{w+v%YsJD?Tnjfd|*=@p@KAA41%=0N>9u-#rpFS9hsHUurOY<7x0|@jH z1Ke5#M%yN+>#VtqDgaL!VJ@YFE^4G+%>q7{wy!DkC1?Ro?C_n0Bd=H=F5r0aZsjZ(`WnHqkV5zOJZH>V=ZuzM_a5=gIyPQAgmf5r^NEzm4=V7z3EZWq( zV{Iq4XZ9>O^=)doGw+txU7I%Evo3#5!|pAcw`r-l+Z*q`D{JfO>{av4x8~;j_=oW; z(RX0;XcN%y#BQHGYl?o}EmQRK=Sq)@~@6X^(5=YauV&ctoC4Ys?|BRoXo}b9ykzST9|mDB^o6FU;7lOfJ7P z262JNrj{sMF2yzzp7i~VmFDj#I7{1;PGA@F#$eOCR~t5mHHTk}&A*0H>RQ~moi+SG z0oJHNKOw%@w9|t3tEHCNwCtjt4!_9mjhk>)-XEj=nJTPP`iM_gnQFZck}<6$DPG(0L! ztp)et2hZX5BA)?XW*4{?g#>HbY0SGd4}^|c7&;&OLN^y!NGA$p+(x|YjSXv+2P{D306sd^i z6s|1PjO!l!F`1Bv|Se^&oQ0Xr{Ye zqnWRwD_7zby&UPqH?4f9-U=;aa81^#Rq^r+fq@HEH^c_KUL>6Dw$tBI5N~FhzXiwh zVt&}ri|SFxJ3JO%-OsZbq5M!p{uS*t*77m*S9kEYWvE*&^N(jBuYUSEdzpVFlohVC za0?1`_vqz4C&8zKgKrL?t8Mq_Vh^RL!iYCN)kwzQ$$+!3p67G{%0~MrC#=a9?d4yV z7_`0w05_P-(-6KqA#~~w!QywH+gi?(87)qrg?#ChA8qI5nH_4J4WdYvPss!o2*3*h z>wku|Eb$L;*}2Vni8sF6$ zviBtSq`)_A8r^xy+YgEk0_Iohw*y>-RcYhjFyJLmj*@ z*_h+S3Ie@4a{5eftj_Jaqp94?gtpBaa?_?C~d_Jo41jM~^-8 zVb}aWb*V{VUwGT`!GHX5|I2^+^OFY;J$LWX`yM~M@3FnlJpIIx z`~S`U;DM)Jdj0qVkG%PphhKU1wMQR%;%YNMtn+v_bFaaCU$%ogXlR97?c)Z4%9jY{;ckO4kGt0(%pYE7 z08=q^Wt+D^&#=5n(jqjQ!2&zav}f4q{n-|lek_}~JG)gV;=VS(1*6C)6muCyp@f@n zgiFU&MqwjL7I8<6!d9+3OIXaMWeH8(ifmywSD(!v%z)myu53GfUpBoZ8?f1dFSQId zog!pyA?uxl##Z{SY(bB>T7{Blxt9#gI)h~uRKxqXEQYXcL1X)+HmY@qYK9m%RB1a{ zcktl7d!Ys(Y=Yn+S^i5yxiF~>lj2~sr}9OIK?O0Ir2w%RsIGE>7=8=VC1{4VMvHn1 z6KuPkzI)ei;b%5(P)yr;H*ZXH=Bcq1# z;)q!X$3sVyOriwmCX7NDFbReXVCI9_4%b;DzbA`-A`AN1=|dqAA=BpGH2N&+Cjro* zmz9J0Y2qgQUQ5-H#tck@jMn*UHz@ep{{;{ML6vg~F=7_utXaSXBmzosZev!673iIV zm;rQn6*dJAbwCLW8tQ%hza_L(iv0pT1&X{wd&yF8QVzXzip_pG@(!1g|JFU5U3-Ue zwD^f^d-Ld;8#Zm;rPUYD)SBkb$=9xH z)h=zgb7x~y<3{vt2v$>qm6a4@6}eVz)y~E{H#9Xh?$mBv+i>@W_1ayH+PfRquGcOo zvDRd1*RE^axvOE@CIY%4@ahds+Z(qvZJ7FqG)udyVe1BMY3c83%K+)N zwE(oWp{Xf^2>Z2aS0kc@kON1#i}PleX)CPS4e0Y!s6t>NR-o7KE1TBdv*GtOcfuE} zyZ*KA?ndDAci5VDHvB78# literal 12160 zcmd6Ndt4J&_V|QHcvMtCNC*%z83-Za5uyf&FqjMvpM(NRYqx42KIjW8w!9xlG35IkxI}|t1|q~4Yu3e{r>*@eSV)` zVD8Ml_uO;NJ@>rsoe`~GSFAHB%%=L~lwxgRzAkQaK9&G~|BrsOID!5q;R_tY==g-F z)NbX)@wJ67n@LQ6-i&WvDtbQL*0`Oxq3y8ZNA9SB#BgkYyW2oYaO^C)N9fO+0CuSf z$4p9-NlBqvm5CJT$4n%t|JFqI=r5vT=AYcj#oX9paz^hreSy0RMHm*30XmG!F_4k^ z@DcoFv&i?c9BY}Sb~QdbNqh%1%36uUNar6CIJJbEPSY=^^am)sXFC4V8D$NXqWsa! zg-bL)n&U6bq{JVfx}R?DI<$qyuaevggpVUN_<8gMQ-bldDft6+YYwCSgZUQaNYLyYAQ}x>OQT! zso}V(!NkFeDz?ZsiMEK;iRR(GPtIOsT!=TZ?M!=p0w1jF%MQYtf{LRtXzG% z!BTr_O~a|0PuHwk^_gjT!|}?h0n5tD<8Ym(>MAR1`j^*K*3+x%KU-eWu#B_REC(c~ zD;oe?Wy3(-@|p(PQq$1CyuN{6RcWfDS6NIIbiHY9Wj{QehWn?LjX>xB*8drkS$)QG zqULlhr9QK)vgT7u!|8^~+PB|%%l4(Crs7oHvA_NGbaf3=)8H`Id+X~?)K!8!1}ycb zZ>$@vspz*0Dlu*0ld0dQ z{!Vs2>(;a{Ws_M?Dwn8sR z(|)t6>-p@i%h@}tw6${-RW~SVs_JX%sx1{&lx3}D^_o@Y`ihDI9W26XOZ}?)`Ua|I zP1S14vYX5`U?X%|>S>G_!kW9j#J043iB*#r14g=d1$(e0?ZE@eXFoU)`$hGEde6aw zv9gyBZ2BvAV5pTmPfN5pph)+PDxX&P;fOeDDk~XU`3j%=6GQSNU`w=U9XoOH)u$Q z?fRgn5dc0j1K7DG(&3t97+6}y)+7fxJk`t9Nvb`8!F-w5Wz*kHL7zRyeU&`CH#rbw zovC)$;7iGV%>$GyEIbkLJD*72*ra@b@&s5{GBl4mVtCG(sn*sgCCiGD5E+3%z z=lWf6-kY&DZAA3{^EF()L#A7dOf+rfE{nw@fKB)dckvmqn3tX_(=fUb~6YT@pzK<(g% zL4|RQ5{qmwfcsHu5q7e%QiOuNRZ3z2gF4!UDE9YKA-sP&t;j9Jv6s_?BzCb>SPEES zfJQ1rqawliqSWQ(4H)-nJ|IPo+v5O=f?~Kr+9oU~qXv&i+wTXxAtGjZfs%}--;;Jd z)!Y3vV;wz4jIuQ{dMYVs{Mu}H4iEuX5Jq2=8hz$!;|eN*y&#P|3T%|>S5N^5CtbpD zrwn5|g?YU&pa4|Z#(8els=7gN=@IE;)Bx>foGmo|{nnTwW2j>&A6f;RGpiie$*5 zXM4EUP-k!<4@x{L-sM^dQw8<63Pv_xW_L~{fx#SM|0E+|?tUQpZ5+%I^dBS;f?^G|agHO#kU{=BI*Gk!sWyB`wvshZ6P=ugVei?1!v`=Q479H@fA~;4rmN2gm_Fh#yD+i4RXD-F|mUPD)N- zNVg#wOY!^YtW-8Z!U-}h!13Ta*rrq;$UoP6y$u98>hFGfL)W23aK$|M6p0bGOr zBtIlDK1gJIbb^GPE8!9(qPa5qjnui}u%Zq=w4CJQ!G$gmA@_YMs-tBm{=p}oK?2pD zmCpq(dy{9lmy>=J9+yWrW0QR_d7|qh=UA%oZp!XlnvBntjgmf*aV{pt+LwV3a36IO z;Fu;;>0l~%Q~}(c@)}oBLGFw^FbXoy;7-cfwQ0O&H^mcZ`C%au!2d^s@Ih~iO%96>j-B6+e=oU7$-CH#1*eAG+J z(*T5fJ7*Nu&xh2R&6W$f&U@2GQN{Ujx(5yPJ9o&uM{u+JICyHNys~Y__S+OqTkdP# zzUfYwCHO46^By_!9da>P~_}6>9KS$s^do$plG1A&TC0OdaXpz%YCID zYHvvfx@M^lcGP9 z+w`jtB6%jvdHC%d?xJk){R}~+NI>&m#*XI+X7<*6c^GsHC)t%5LO%O;j^Jj0p8-p< zju2ez(+a`K9#al^2I&lL0QvA7Cb^sYOb%1vIZh3m9q&>)^A)dJ+Wv6v154Zc=kQ7e(9YQ`DhU=2+@oeCHQMNPaaU!IfFIVV zv=JF`CyrJeG}fnFNy#y9JRbyJ$P_=IM=3w+#jSrKoOaxL6xkHvd=)pY1dlS46sTAY zj6cUNRLbW=G>DJD0&H69{lqrH0%kxEpwssg04r%1-GB{V#vS3PFUWKIbNs$QnR5aU znpgT$AUeTr0%mZX`DA5yBk1;ee@={Ft3~q&3^yvPEmk7ghZq`4sS5YnE{q!elaHQ2X zx?9ODAiyh%&ZoM($d*Iej#3^U(g+X_T&F5lj{^U6JpsU8&}--#Mf`Mpz=kEG)Sid+ z994Exnq3sH*-7#EPS8f=RGc9-f`IH(?gTOKf~z~UAfbTi>y;;i_<)2Hjx6q?j#P7h zQ_w&c{zEYa<{&D`a)DO!+=m3p61mj`-^_V3Jq$EJMC4mTyAvOy6)S7`xif@yj-72L zK8EY4b0fsu{uezrzPMyX4D`|*k1Uoy>dBlK|oAHGP|fwOLwCf zCB*edrH9k66ZW}*;B`3`Sj00i1PmM=Bw))z_ybHpE&~tq_n_zqIHu4>1{Q$_cpkPd zexMlIJzgN3R3>P-A89+%tz=}YcCIRu#xfm0Yur7EekUJepG?XGCGypvjV0j+rMNyw zv^di>)dNG3{3q=0iq){XfNx{dS>Gt!NBNCS1CBs|_qrI5ulqx{wn|&WYqj^Ou$bDL zwX@)^Bpy#>d<@6}aii4&pS>V? zM)bJS#eJS>YlQW%+GnfrSzt+_>B$&U1Wa%$6_9Un08wrz%QkA^tw)DfX0^r7#ay5R z4j&{;RmA44AgPMgu*@Ot0LEwGJzm*<+LYzDa-U~KL;`A;d`8G&_h*69<$|k5DjpaW zQCY6CV`6N;Vtw+H>a!HX0UO6v8)kQ~d`i{!QI}Q7bh@&*@jPjqkmWp;#od}O4Tsq6 z@NHxK2#v$zf`KZP{!26Wg_(X_$<0^MubZI^%CS&z7b9|rssjMteua%vp_C2a^?x*@ z9vb)wZ5B9DDg?*0R5YrSfv_M$=$t56AS*>EJP8c0)PlCq>s3(V4i5yZHoF@#Ydg!U z_YbzI3QGMDGf`x5c!ZRJAQzjnCBPBcAL6^I$(K}Ic=q7eDq;~EnVc`;O0wy%Rkr=r z))zJq)nS_hA-+->k=zc!_+BCKOQZ(3+xoz}accTVrzo<+TMWU_TPQ1~@ac+|q+ zdns!{tF3u|b@vM!x(_vWAGAPx9f}^-XH)BLoQu&}*(YL}ZF%nY3`<8wV`s*Owv1|e zaW)+4>jlFGlPSZUcwEUghvaa96VN>TGU} z3SXJco!5$bde9zYy(++EXhelQ@zU)`datS7`51S*x?TS)n zJc!In*x7Hg`TXdNE$xHeY+mym1-lXBv(%%%;4QDqc|6<40P_|GgfCJ&jA)@1K-u<> zN%=ECV$mY4Re#tF#XG2Y(`@qFER7rVADVerH}{75ORRiQuZC(MP&DZ9wU?G>hPDG`!nWo$*H78Gs{j->tDrF_!iFQ0t3e(xCbU3Eh1|wRD4{^|a&IXbBHjnHfNsk+ zF-91AB=nzE&^m!XLRr7>X@zYk%6v4Bp!A0UWkl%`1m#Cy+X-?*o(iRHO#E(293g8> zBqE)n90m=JD#~ar&mf4_c6hR6yvqRduc`5OAQgR0-R=gEciS&>B{>;yGDO?4UTr&E z9dLC%*X#2!)gUvw8*RB^Ztrfnwk?M|upjihOY)B?l^6r{^)aa(ua@@SzyR-7;ec^B zHDKjd7DnZy1)hwt2f3DZnY z=J5D$(Q%*8ZxbKjK2hU`2p-=DDe7x#gJQB#W5^>6IyO$rU*pt}R3>Ug)RXa-EwHP$ zfAz2?z=d|u`9pv-Anzg1j_A%|`TCE+d%Fen}URV3nPGEAfMGJ=C z3hp?FjupBxe4vOv(8zxjYhekX@1|_9#)H|&Jd1b5FL?`|(Rswa!5%e?JJACM(W4F` zmtj$H`?CWG(=94+uXvx9yNV7d94qL9+0je$pV_g^lHYn?*uIXjS2SI*t^#f1AvH8ySa2MT#N~#eR{hY-<2Ec0zN0yoi~4Pu^4)^RfZn?h7~lFme2!x!^m2xuVIFxu84nWDi~fX+XP06*vP=qq+2X?dS8BqiOGq{P;8Zo;y_s z_ujOK*gJCT>wAXhE#HmsJ)i49LO=nDdoq{4oDG<+6>C9hk@$BFYx2;!+0DpZuK~Ba zC=Z-9u*bx#_-sjA*nJOo3XX!V9fgOwA1+(h?cVvM_3KYoS?_u4Ef6@iiy@O~WibTC zPQA~}%*M*`dfq%<{|!_jZu%e`p?vojQ8e^83VAl{@_pTFouzFa{Qgz1W>7lLiSvh5`O-+Z7iZ+a z@1thv#Y7n#+KKarbZ233)13i+^TG91pZb>gc}2z69MR zX#~2Hx=%qdA{7^Z!Ayu=NB;0WzzlS_j(pwJ&p1OgJMsmfsV`^bYM}51ygz`~kRY_+ zPl*Zd;{KEmuGJ2yk|3K*OO5mdyp~YyMySP&Q*IM8UKxDFaTMOiK$Z+=JETY&MuzFH zn5;uDv3$NwR6qn#=0alZZwukLfKy}z?9QSB{P)wwI!cHiJWyDT!od71wpMtVXuM() z!qk!6qXklF5m#2o!`avP%EzW-etJvblVW)2bqDQAw&@?523q^3$#Cw_BD?dGLgTJ! zbi+?fE3cXuGAh)3c((a)A!B@Kx)hCx2(|alw)Yk?+|mL_$F*7|yoGpdT6AJMhKEy6 zQ+$S*w~w2B#c|yI1<=v;k$NSdwk8lloEp|i9iAxt(kjF%L+f5dRM_~+ z2PjtzVD$LW<}I`n{rR=Yr2_hy0&ZggLxzL6B0yYX5js=@>HJTEK~jlO$9cI59XF`s zHtRgn$f9x(4{T?D76Ry(^08?j85x?~pJylcXP8`v?!N>GaX*>!~U2RO2`>&RH%JATV!(;$eH)YbgA@n zJa?&d2w%EX>cQ)mO8e=r$?=wHQ(=ZV2=7tws1ZXCuU)?u7h&UdexKnzts&BYX)c*k zl$T7p1kIF*P)?b;K2k(!F2mzx6MoUuXH};e!$vIcMn&lo`;N3nMHzXMF0yaR_^nA3 zFtytBE|d65BRQeRMlhpj#4gdLWMt^X8M^3lX%@M(NUDH|xlH8zB5CrNSRFS8CPXTV zq%q0+qXP;&oY#V;dEUj(7XEY*&Z%U5WG&ZGcgjP|UXq;l&XKtnXv9bfE#0 z@<3!m!5>?A++}i!qx-^(MT_SD=&-B%H>jf9%EsnJMMYUUv*zipb?vgy-TJnu;i`oI zYqcwu*w7~k6HwV;CDyh+r4udc6eiR%eWl5`)FhPa=9j`33mTKDCAWL5ycxb*fcH&- z@y=<}RmNClDg_@HYpgU0J-Tl;NIAeI{U`pd$v6f*z=aJyZLk|Cb+jNdkm@kQ1zNli zcp1)K7&ZLlLKW83E)?suZBf-Qz}}_~my~BnB)aJMI~Ju_>Cg2Ux_Qtch~l-2)ZfQn zTqr#k|Mo)Z*HKZ$U!aH25#g(>c%kjzKB~A%f2&vGjW?R6uyvV4U1df6O_VC@=7#F3 zwPtnp@--`#)hIUP)LK@pEM09a>)fc(PLh|q0vF@Dv5Un;ix=q&gE~z~o&j5kq-#)+|~a%Zel_bFPgw)6B7xM5sA|9iHVd2 zQR3vViHVq`*yyUB znSy3G^;{eP1!6!;WyjPpa7Z}+a#5m#A-v#k{9Sf+jPZL@nL0d2dPRA`gnw@`glRpA zvg)x3i0I)~X=GyC*t}Le!|+IRjq$t*PQg5jacsme0o&DGim)Qa7(Ftt_zEg@SLRRJ z7|jI}V4dUj;}Ih*+ewi}Dkc}{qeg7{=n-bu{Aq{9#spns^Qy_{{qTK`Bfxm$565xA zMIMG~jjH&QxNOf@mwFuMw5$0fc9fnbJqAIGzl?NiLmPJ;77-1@mFn@yDMPcC) z;^;Z^r3!Eze()MDAMzLAVRnF9iI2ouwrdSb3?Oujr1izv7s?Wh0j~nFYs%yYm&3^H z?nF*mEd9YI!lJ!DeM{tFL@hHhqH{Ab#nas<=IO*jbaD6;Mr0I=unb+;6qYf7wnDHE z3gs9PF*;FVnPQTO@dK&x6|j#BA2Iye5M_ukh!`+xyE>elVQdT^dQQ0rw=!hol*t;L zHFC-nxGIefbzhPGQ;1W9Npayal;?#Xpd1sXpd1l`iYQX2$4t@);i>|IJZx|AyumBQ z`B+BLq?ZHlkO@b^xoL{8pN45wCoFDe5jtDZMG zAexeji`PR7U-OGQi&WuDyDVp#Y9 z+#nJDR~pLT-++@YXjMlV7mP^5jY%Uk2#Ylt8Pg-pR-!NYNS}P3Uju0!gffrGHs0L0 zete6qPu7IIdJEXHP8=mJZvN zfSG7qq|pW=!wfS7DYP2F?sgtOU1Za{q42y=){YtYq&g6I$38NZ|qYHInAzK`;e{`a@J6zb#LR| zy$|hz7J#q{f}3Etg3@YXMiC|!fzci<4&M(di0K&}3#n=}S7f=YO5V0T3vI3*? z5i@{JREy2RLmN;6gNAnA^Giaj#n?~Kv!KX3bXBYdCuLWQXW8_`An$NdIYKtvnmA6K zC2g(a?~SiKOKL{Qcq}>vT8(`qv|U9a0(Ou{i%1YB6r%psq!8BsD^iH)?LNis^`M+TUn4H^My-^tmkD+Gla_Cf=20{~}20H=O} zKOL%m_EXgxs{S)nh3PBb39ZCCmnI;dLw*osW7+i z*wg}_WNg}mzOaN3uYdaPdee5rqWq%U<6^1iZSC8ewrt&@P*XXI!jht5#qI5i)lGM7 zZ*FPcjK1N(>MO9S3JP0ZU{Ta=Z@yzwOH1>1#pc_Z?%8ywVn?&$p61)`RG2F)^|^}M zZg1Ycqv^gaI1EGJb(>nYHQ(2=Y4&5!T*Z#2dp9YXAJ~D%g}OtZfc{%+6(GIuHUPS} zsig%Wf=T_{wxbyln{BMGC|GG&RHayMQEWmVlKuo3;syr(M{CP%4{rL8raRzs(;ffS icuzBM`|lWAw>SM4T=TX~_x%SLpu6*5O*8-B{{A;PWBQ-~ diff --git a/software/asm/BASIC.asm b/software/asm/BASIC.asm index da5be50..cf5c6fc 100644 --- a/software/asm/BASIC.asm +++ b/software/asm/BASIC.asm @@ -1,5 +1,5 @@ ;----------------------------------------------------------------------------------------------- - ; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft +; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft ; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 ; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) ; Adapted for the freeware Zilog Macro Assembler 2.10 to produce @@ -27,4860 +27,4894 @@ ;----------------------------------------------------------------------------------------------- - ; Bring in additional resources. - INCLUDE "BASIC_Definitions.asm" - INCLUDE "Macros.asm" + ; Bring in additional resources. + INCLUDE "BASIC_Definitions.asm" + INCLUDE "Macros.asm" - ; Sharp MZ-80A Tape Format Header - used by all software including RFS/TZFS - ; in processing/loading of this file. - ; - ORG 10F0h + ; Sharp MZ-80A Tape Format Header - used by all software including RFS/TZFS + ; in processing/loading of this file. + ; + ORG 10F0h - DB 01h ; Code Type, 01 = Machine Code. - DB "MZ80A BASIC V1.0", 0Dh ; Title/Name (17 bytes). -HEADER1:IF BUILD_MZ80A = 1 - DW CODEEND - CODESTART ; Size of program. - DW CODESTART ; Load address of program. - DW CODESTART ; Exec address of program. - ENDIF -HEADER2:IF BUILD_TZFS = 1 - DW (CODEEND - CODESTART) + (RELOCEND - RELOC) ; Size of program. - DW 01200H ; Load address of program. - DW RELOC ; Exec address of program. - ENDIF - DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h ; Comment (104 bytes). - DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h - DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h - DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h - DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h - DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h - DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h + DB 01h ; Code Type, 01 = Machine Code. + DB "MZ80A BASIC V1.0", 0Dh ; Title/Name (17 bytes). +HEADER1: IF BUILD_MZ80A = 1 + DW CODEEND - CODESTART ; Size of program. + DW CODESTART ; Load address of program. + DW CODESTART ; Exec address of program. + ENDIF +HEADER2: IF BUILD_TZFS = 1 + DW (CODEEND - CODESTART) + (RELOCEND - RELOC) ; Size of program. + DW 01200H ; Load address of program. + DW RELOC ; Exec address of program. + ENDIF + DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h ; Comment (104 bytes). + DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h + DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h + DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h + DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h + DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h + DB 00h, 00h, 00h, 00h, 00h, 00h, 00h, 00h - ; Load address of this program when first loaded. - ; -BUILD1: IF BUILD_MZ80A = 1 - ORG 1200H - ENDIF + ; Load address of this program when first loaded. + ; +BUILD1: IF BUILD_MZ80A = 1 + ORG 1200H + ENDIF -BUILD2: IF BUILD_TZFS = 1 - ORG 0000H - ENDIF +BUILD2: IF BUILD_TZFS = 1 + ORG 0000H + ENDIF CODESTART: -COLD: JP STARTB ; Jump for cold start -WARM: JP WARMST ; Jump for warm start -STARTB: - LD IX,0 ; Flag cold start - JP CSTART ; Jump to initialise +COLD: JP STARTB ; Jump for cold start +WARM: JP WARMST ; Jump for warm start +STARTB: + LD IX,0 ; Flag cold start + JP CSTART ; Jump to initialise - DW DEINT ; Get integer -32768 to 32767 - DW ABPASS ; Return integer in AB + DW DEINT ; Get integer -32768 to 32767 + DW ABPASS ; Return integer in AB -VECTORS:IF BUILD_TZFS = 1 - ALIGN 0038H - ORG 0038H -INTVEC: DS 3 ; Space for the Interrupt vector. +VECTORS: IF BUILD_TZFS = 1 + ALIGN 0038H + ORG 0038H +INTVEC: DS 3 ; Space for the Interrupt vector. - ALIGN 0066H - ORG 0066H -NMIVEC: DS 3 ; Space for the NMI vector. - ENDIF + ALIGN 0066H + ORG 0066H +NMIVEC: DS 3 ; Space for the NMI vector. + ENDIF -CSTART: DI ; Disable Interrupts and sat mode. NB. Interrupts are physically disabled by 8255 Port C2 set to low. - IM 1 - LD SP,STACK ; Start of workspace RAM +CSTART: DI ; Disable Interrupts and sat mode. NB. Interrupts are physically disabled by 8255 Port C2 set to low. + IM 1 + LD SP,STACK ; Start of workspace RAM -MEMSW0: IF BUILD_TZFS = 1 - LD A,TZMM_MZ700_0 ; Ensure the top part of RAM is set to use the mainboard as we need to configure hardware. - OUT (MMCFG),A - ENDIF +MEMSW0: IF BUILD_TZFS = 1 + LD A,TZMM_MZ700_0 ; Ensure the top part of RAM is set to use the mainboard as we need to configure hardware. + OUT (MMCFG),A + ENDIF -INITST: LD A,0 ; Clear break flag - LD (BRKFLG),A +INITST: LD A,0 ; Clear break flag + LD (BRKFLG),A - LD HL,GVARSTART ; Start of global variable area - LD BC,GVAREND-GVARSTART ; Size of global variable area. - XOR A - LD D,A -INIT1: LD (HL),D ; Clear variable memory including stack space. - INC HL - DEC BC - LD A,B - OR C - JR NZ,INIT1 - ; - CALL MODE ; Configure 8255 port C, set Motor Off, VGATE to 1 (off) and INTMSK to 0 (interrupts disabled). - LD A,000H ; Clear the screen buffer. - LD HL,SCRN - CALL CLR8 - LD A,017H ; Blue background, white characters in colour mode. Bit 7 is set as a write to bit 7 @ DFFFH selects 80Char mode. - LD HL,ARAM - CALL CLR8 - LD A,004H - LD (TEMPW),A ; Setup the tempo for sound output. + LD HL,GVARSTART ; Start of global variable area + LD BC,GVAREND-GVARSTART ; Size of global variable area. + XOR A + LD D,A +INIT1: LD (HL),D ; Clear variable memory including stack space. + INC HL + DEC BC + LD A,B + OR C + JR NZ,INIT1 + ; + CALL MODE ; Configure 8255 port C, set Motor Off, VGATE to 1 (off) and INTMSK to 0 (interrupts disabled). + LD A,000H ; Clear the screen buffer. + LD HL,SCRN + CALL CLR8 + LD A,017H ; Blue background, white characters in colour mode. Bit 7 is set as a write to bit 7 @ DFFFH selects 80Char mode. + LD HL,ARAM + CALL CLR8 + LD A,004H + LD (TEMPW),A ; Setup the tempo for sound output. -INIT3: ; Setup keyboard buffer control. - LD A,0 - LD (KEYCOUNT),A ; Set keyboard buffer to empty. - LD HL,KEYBUF - LD (KEYWRITE),HL ; Set write pointer to beginning of keyboard buffer. - LD (KEYREAD),HL ; Set read pointer to beginning of keyboard buffer. +INIT3: ; Setup keyboard buffer control. + LD A,0 + LD (KEYCOUNT),A ; Set keyboard buffer to empty. + LD HL,KEYBUF + LD (KEYWRITE),HL ; Set write pointer to beginning of keyboard buffer. + LD (KEYREAD),HL ; Set read pointer to beginning of keyboard buffer. - ; Setup keyboard rate control and set to CAPSLOCK mode. - ; (0 = Off, 1 = CAPSLOCK, 2 = SHIFTLOCK). - LD A,000H ; Initialise key repeater. - LD (KEYRPT),A - LD A,001H - LD (SFTLK),A ; Setup shift lock, default = off. + ; Setup keyboard rate control and set to CAPSLOCK mode. + ; (0 = Off, 1 = CAPSLOCK, 2 = SHIFTLOCK). + LD A,000H ; Initialise key repeater. + LD (KEYRPT),A + LD A,001H + LD (SFTLK),A ; Setup shift lock, default = off. - ; Setup the initial cursor, for CAPSLOCK this is a double underscore. - LD A,03EH - LD (FLSDT),A - LD A,080H ; Cursor on (Bit D7=1). - LD (FLASHCTL),A + ; Setup the initial cursor, for CAPSLOCK this is a double underscore. + LD A,03EH + LD (FLSDT),A + LD A,080H ; Cursor on (Bit D7=1). + LD (FLASHCTL),A - ; Change to 80 character mode. - LD A, 128 ; 80 char mode. - LD (DSPCTL), A - CALL MLDSP - CALL BEL ; Beep to indicate startup - for cases where screen is slow to startup. - LD A,0FFH - LD (SWRK),A + ; Change to 80 character mode. + LD A, 128 ; 80 char mode. + LD (DSPCTL), A + CALL MLDSP + CALL BEL ; Beep to indicate startup - for cases where screen is slow to startup. + LD A,0FFH + LD (SWRK),A - ; Setup timer interrupts - LD IX,TIMIN ; Pass the interrupt service handler vector. - LD BC,00000H ; Time starts at 00:00:00 01/01/1980 on initialisation. - LD DE,00000H - LD HL,00000H - CALL TIMESET - ; - LD A,05H ; Enable interrupts at hardware level, this must be done before switching memory mode. - LD (KEYPF),A - ; -MEMSW1: IF BUILD_TZFS = 1 - LD A,TZMM_MZ700_2 ; Enable the full 64K memory range before starting BASIC initialisation. - OUT (MMCFG),A - ENDIF + ; Setup timer interrupts + LD IX,TIMIN ; Pass the interrupt service handler vector. + LD BC,00000H ; Time starts at 00:00:00 01/01/1980 on initialisation. + LD DE,00000H + LD HL,00000H + CALL TIMESET + ; + LD A,05H ; Enable interrupts at hardware level, this must be done before switching memory mode. + LD (KEYPF),A + ; +MEMSW1: IF BUILD_TZFS = 1 + LD A,TZMM_MZ700_2 ; Enable the full 64K memory range before starting BASIC initialisation. + OUT (MMCFG),A + ENDIF - ; Clear memory - LD HL,WRKSPC -MEMSZ1: IF BUILD_MZ80A = 1 - LD BC,MAXMEM - WRKSPC ; Clear to top of physical RAM. - ENDIF -MEMSZ2: IF BUILD_TZFS = 1 - LD BC,10000H - WRKSPC ; Clear to top of physical RAM. - ENDIF - LD E,00H -INIT4: LD (HL),E - INC HL - DEC BC - LD A,B - OR C - JR NZ,INIT4 - ; - EI - ; -INIT: LD DE,INITAB ; Initialise workspace - LD B,INITBE-INITAB+3 ; Bytes to copy - LD HL,WRKSPC ; Into workspace RAM -COPY: LD A,(DE) ; Get source - LD (HL),A ; To destination - INC HL ; Next destination - INC DE ; Next source - DEC B ; Count bytes - JP NZ,COPY ; More to move - ;LD SP,HL ; Temporary stack - CALL CLREG ; Clear registers and stack - CALL PRNTCRLF ; Output CRLF - LD (BUFFER+72+1),A ; Mark end of buffer - LD (PROGST),A ; Initialise program area + ; Clear memory + LD HL,WRKSPC +MEMSZ1: IF BUILD_MZ80A = 1 + LD BC,MAXMEM - WRKSPC ; Clear to top of physical RAM. + ENDIF +MEMSZ2: IF BUILD_TZFS = 1 + LD BC,10000H - WRKSPC ; Clear to top of physical RAM. + ENDIF + LD E,00H +INIT4: LD (HL),E + INC HL + DEC BC + LD A,B + OR C + JR NZ,INIT4 + ; + EI + ; +INIT: LD DE,INITAB ; Initialise workspace + LD B,INITBE-INITAB+3 ; Bytes to copy + LD HL,WRKSPC ; Into workspace RAM +COPY: LD A,(DE) ; Get source + LD (HL),A ; To destination + INC HL ; Next destination + INC DE ; Next source + DEC B ; Count bytes + JP NZ,COPY ; More to move + ; LD SP,HL ; Temporary stack + CALL CLREG ; Clear registers and stack + CALL PRNTCRLF ; Output CRLF + LD (BUFFER+72+1),A ; Mark end of buffer + LD (PROGST),A ; Initialise program area - LD HL,MAXMEM - LD DE,0-50 ; 50 Bytes string space - LD (LSTRAM),HL ; Save last available RAM - ADD HL,DE ; Allocate string space - LD (STRSPC),HL ; Save string space - CALL CLRPTR ; Clear program area - LD HL,(STRSPC) ; Get end of memory - LD DE,0-17 ; Offset for free bytes - ADD HL,DE ; Adjust HL - LD DE,PROGST ; Start of program text - LD A,L ; Get LSB - SUB E ; Adjust it - LD L,A ; Re-save - LD A,H ; Get MSB - SBC A,D ; Adjust it - LD H,A ; Re-save - PUSH HL ; Save bytes free - LD HL,SIGNON ; Sign-on message - CALL PRS ; Output string - POP HL ; Get bytes free back - CALL PRNTHL ; Output amount of free memory - LD HL,BFREE ; " Bytes free" message - CALL PRS ; Output string + LD HL,MAXMEM + LD DE,0-50 ; 50 Bytes string space + LD (LSTRAM),HL ; Save last available RAM + ADD HL,DE ; Allocate string space + LD (STRSPC),HL ; Save string space + CALL CLRPTR ; Clear program area + LD HL,(STRSPC) ; Get end of memory + LD DE,0-17 ; Offset for free bytes + ADD HL,DE ; Adjust HL + LD DE,PROGST ; Start of program text + LD A,L ; Get LSB + SUB E ; Adjust it + LD L,A ; Re-save + LD A,H ; Get MSB + SBC A,D ; Adjust it + LD H,A ; Re-save + PUSH HL ; Save bytes free + LD HL,SIGNON ; Sign-on message + CALL PRS ; Output string + POP HL ; Get bytes free back + CALL PRNTHL ; Output amount of free memory + LD HL,BFREE ; " Bytes free" message + CALL PRS ; Output string -WARMST: LD SP,STACK ; Temporary stack -BRKRET: CALL CLREG ; Clear registers and stack - JP PRNTOK ; Go to get command line +WARMST: LD SP,STACK ; Temporary stack +BRKRET: CALL CLREG ; Clear registers and stack + JP PRNTOK ; Go to get command line -; FUNCTION ADDRESS TABLE + ; FUNCTION ADDRESS TABLE -FNCTAB: DW SGN - DW INT - DW ABS - DW USR - DW FRE - DW INP - DW POS - DW SQR - DW RND - DW LOG - DW EXP - DW COS - DW SIN - DW TAN - DW ATN - DW PEEK - DW DEEK - DW POINT - DW LEN - DW STR - DW VAL - DW ASC - DW CHR - DW HEX - DW BIN - DW LEFT - DW RIGHT - DW MID +FNCTAB: DW SGN + DW INT + DW ABS + DW USR + DW FRE + DW INP + DW POS + DW SQR + DW RND + DW LOG + DW EXP + DW COS + DW SIN + DW TAN + DW ATN + DW PEEK + DW DEEK + DW POINT + DW LEN + DW STR + DW VAL + DW ASC + DW CHR + DW HEX + DW BIN + DW LEFT + DW RIGHT + DW MID -; RESERVED WORD LIST + ; RESERVED WORD LIST -WORDS: DB 'E'+80H,"ND" ; 0x80 - DB 'F'+80H,"OR" ; 0x81 - DB 'N'+80H,"EXT" ; 0x82 - DB 'D'+80H,"ATA" ; 0x83 - DB 'I'+80H,"NPUT" ; 0x84 - DB 'D'+80H,"IM" ; 0x85 - DB 'R'+80H,"EAD" ; 0x86 - DB 'L'+80H,"ET" ; 0x87 - DB 'G'+80H,"OTO" ; 0x88 - DB 'R'+80H,"UN" ; 0x89 - DB 'I'+80H,"F" ; 0x8a - DB 'R'+80H,"ESTORE" ; 0x8b - DB 'G'+80H,"OSUB" ; 0x8c - DB 'R'+80H,"ETURN" ; 0x8d - DB 'R'+80H,"EM" ; 0x8e - DB 'S'+80H,"TOP" ; 0x8f - DB 'O'+80H,"UT" ; 0x90 - DB 'O'+80H,"N" ; 0x91 - DB 'N'+80H,"ULL" ; 0x92 - DB 'W'+80H,"AIT" ; 0x93 - DB 'D'+80H,"EF" ; 0x94 - DB 'P'+80H,"OKE" ; 0x95 - DB 'D'+80H,"OKE" ; 0x96 - DB 'S'+80H,"CREEN" ; 0x97 - DB 'L'+80H,"INES" ; 0x98 - DB 'C'+80H,"LS" ; 0x99 - DB 'W'+80H,"IDTH" ; 0x9a - DB 'M'+80H,"ONITOR" ; 0x9b - DB 'S'+80H,"ET" ; 0x9c - DB 'R'+80H,"ESET" ; 0x9d - DB 'P'+80H,"RINT" ; 0x9e - DB 'C'+80H,"ONT" ; 0x9f - DB 'L'+80H,"IST" ; 0xa0 - DB 'C'+80H,"LEAR" ; 0xa1 - DB 'C'+80H,"LOAD" ; 0xa2 - DB 'C'+80H,"SAVE" ; 0xa3 - DB 'L'+80H,"OAD" ; 0xa4 - DB 'S'+80H,"AVE" ; 0xa5 - DB 'N'+80H,"EW" ; 0xa6 <- Command list terminator word, move to lowest command. Update the ZNEW variable below as well. - ; <- Reserved space for new commands. - DB 'R'+80H,"EM" ; 0xa7 - DB 'R'+80H,"EM" ; 0xa8 - DB 'R'+80H,"EM" ; 0xa9 - DB 'R'+80H,"EM" ; 0xaa - DB 'R'+80H,"EM" ; 0xab - DB 'R'+80H,"EM" ; 0xac - DB 'R'+80H,"EM" ; 0xad - DB 'R'+80H,"EM" ; 0xae - DB 'R'+80H,"EM" ; 0xaf - DB 'R'+80H,"EM" ; 0xb0 - DB 'R'+80H,"EM" ; 0xb1 - DB 'R'+80H,"EM" ; 0xb2 - DB 'R'+80H,"EM" ; 0xb3 - DB 'R'+80H,"EM" ; 0xb4 - DB 'R'+80H,"EM" ; 0xb5 - DB 'R'+80H,"EM" ; 0xb6 - DB 'R'+80H,"EM" ; 0xb7 - DB 'R'+80H,"EM" ; 0xb8 - DB 'R'+80H,"EM" ; 0xb9 - DB 'R'+80H,"EM" ; 0xba - DB 'R'+80H,"EM" ; 0xbb - DB 'R'+80H,"EM" ; 0xbc - DB 'R'+80H,"EM" ; 0xbd - DB 'R'+80H,"EM" ; 0xbe - DB 'R'+80H,"EM" ; 0xbf +WORDS: DB 'E'+80H,"ND" ; 0x80 + DB 'F'+80H,"OR" ; 0x81 + DB 'N'+80H,"EXT" ; 0x82 + DB 'D'+80H,"ATA" ; 0x83 + DB 'I'+80H,"NPUT" ; 0x84 + DB 'D'+80H,"IM" ; 0x85 + DB 'R'+80H,"EAD" ; 0x86 + DB 'L'+80H,"ET" ; 0x87 + DB 'G'+80H,"OTO" ; 0x88 + DB 'R'+80H,"UN" ; 0x89 + DB 'I'+80H,"F" ; 0x8a + DB 'R'+80H,"ESTORE" ; 0x8b + DB 'G'+80H,"OSUB" ; 0x8c + DB 'R'+80H,"ETURN" ; 0x8d + DB 'R'+80H,"EM" ; 0x8e + DB 'S'+80H,"TOP" ; 0x8f + DB 'O'+80H,"UT" ; 0x90 + DB 'O'+80H,"N" ; 0x91 + DB 'N'+80H,"ULL" ; 0x92 + DB 'W'+80H,"AIT" ; 0x93 + DB 'D'+80H,"EF" ; 0x94 + DB 'P'+80H,"OKE" ; 0x95 + DB 'D'+80H,"OKE" ; 0x96 + DB 'S'+80H,"CREEN" ; 0x97 + DB 'L'+80H,"INES" ; 0x98 + DB 'C'+80H,"LS" ; 0x99 + DB 'W'+80H,"IDTH" ; 0x9a + DB 'M'+80H,"ONITOR" ; 0x9b + DB 'S'+80H,"ET" ; 0x9c + DB 'R'+80H,"ESET" ; 0x9d + DB 'P'+80H,"RINT" ; 0x9e + DB 'C'+80H,"ONT" ; 0x9f + DB 'L'+80H,"IST" ; 0xa0 + DB 'C'+80H,"LEAR" ; 0xa1 + DB 'C'+80H,"LOAD" ; 0xa2 + DB 'C'+80H,"SAVE" ; 0xa3 + DB 'L'+80H,"OAD" ; 0xa4 + DB 'S'+80H,"AVE" ; 0xa5 + DB 'F'+80H,"REQ" ; 0xa6 + DB 'N'+80H,"EW" ; 0xa7 <- Command list terminator word, move to lowest command. Update the ZNEW variable below as well. + ; <- Reserved space for new commands. + DB 'R'+80H,"EM" ; 0xa8 + DB 'R'+80H,"EM" ; 0xa9 + DB 'R'+80H,"EM" ; 0xaa + DB 'R'+80H,"EM" ; 0xab + DB 'R'+80H,"EM" ; 0xac + DB 'R'+80H,"EM" ; 0xad + DB 'R'+80H,"EM" ; 0xae + DB 'R'+80H,"EM" ; 0xaf + DB 'R'+80H,"EM" ; 0xb0 + DB 'R'+80H,"EM" ; 0xb1 + DB 'R'+80H,"EM" ; 0xb2 + DB 'R'+80H,"EM" ; 0xb3 + DB 'R'+80H,"EM" ; 0xb4 + DB 'R'+80H,"EM" ; 0xb5 + DB 'R'+80H,"EM" ; 0xb6 + DB 'R'+80H,"EM" ; 0xb7 + DB 'R'+80H,"EM" ; 0xb8 + DB 'R'+80H,"EM" ; 0xb9 + DB 'R'+80H,"EM" ; 0xba + DB 'R'+80H,"EM" ; 0xbb + DB 'R'+80H,"EM" ; 0xbc + DB 'R'+80H,"EM" ; 0xbd + DB 'R'+80H,"EM" ; 0xbe + DB 'R'+80H,"EM" ; 0xbf - DB 'T'+80H,"AB(" ; 0xc0 <- 0xa5 - DB 'T'+80H,"O" ; 0xc1 <- 0xa6 - DB 'F'+80H,"N" ; 0xc2 <- 0xa7 - DB 'S'+80H,"PC(" ; 0xc3 <- 0xa8 - DB 'T'+80H,"HEN" ; 0xc4 <- 0xa9 - DB 'N'+80H,"OT" ; 0xc5 <- 0xaa - DB 'S'+80H,"TEP" ; 0xc6 <- 0xab + DB 'T'+80H,"AB(" ; 0xc0 <- 0xa5 + DB 'T'+80H,"O" ; 0xc1 <- 0xa6 + DB 'F'+80H,"N" ; 0xc2 <- 0xa7 + DB 'S'+80H,"PC(" ; 0xc3 <- 0xa8 + DB 'T'+80H,"HEN" ; 0xc4 <- 0xa9 + DB 'N'+80H,"OT" ; 0xc5 <- 0xaa + DB 'S'+80H,"TEP" ; 0xc6 <- 0xab - DB '+'+80H ; 0xc7 <- 0xac - DB '-'+80H ; 0xc8 <- 0xad - DB '*'+80H ; 0xc9 <- 0xae - DB '/'+80H ; 0xca <- 0xaf - DB '^'+80H ; 0xcb <- 0xb0 - DB 'A'+80H,"ND" ; 0xcc <- 0xb1 - DB 'O'+80H,"R" ; 0xcd <- 0xb2 - DB '>'+80H ; 0xce <- 0xb3 - DB '='+80H ; 0xcf <- 0xb4 - DB '<'+80H ; 0xd0 <- 0xb5 + DB '+'+80H ; 0xc7 <- 0xac + DB '-'+80H ; 0xc8 <- 0xad + DB '*'+80H ; 0xc9 <- 0xae + DB '/'+80H ; 0xca <- 0xaf + DB '^'+80H ; 0xcb <- 0xb0 + DB 'A'+80H,"ND" ; 0xcc <- 0xb1 + DB 'O'+80H,"R" ; 0xcd <- 0xb2 + DB '>'+80H ; 0xce <- 0xb3 + DB '='+80H ; 0xcf <- 0xb4 + DB '<'+80H ; 0xd0 <- 0xb5 - DB 'S'+80H,"GN" ; 0xd1 <- 0xb6 - DB 'I'+80H,"NT" ; 0xd2 <- 0xb7 - DB 'A'+80H,"BS" ; 0xd3 <- 0xb8 - DB 'U'+80H,"SR" ; 0xd4 <- 0xb9 - DB 'F'+80H,"RE" ; 0xd5 <- 0xba - DB 'I'+80H,"NP" ; 0xd6 <- 0xbb - DB 'P'+80H,"OS" ; 0xd7 <- 0xbc - DB 'S'+80H,"QR" ; 0xd8 <- 0xbd - DB 'R'+80H,"ND" ; 0xd9 <- 0xbe - DB 'L'+80H,"OG" ; 0xda <- 0xbf - DB 'E'+80H,"XP" ; 0xdb <- 0xc0 - DB 'C'+80H,"OS" ; 0xdc <- 0xc1 - DB 'S'+80H,"IN" ; 0xdd <- 0xc2 - DB 'T'+80H,"AN" ; 0xde <- 0xc3 - DB 'A'+80H,"TN" ; 0xdf <- 0xc4 - DB 'P'+80H,"EEK" ; 0xe0 <- 0xc5 - DB 'D'+80H,"EEK" ; 0xe1 <- 0xc6 - DB 'P'+80H,"OINT" ; 0xe2 <- 0xc7 - DB 'L'+80H,"EN" ; 0xe3 <- 0xc8 - DB 'S'+80H,"TR$" ; 0xe4 <- 0xc9 - DB 'V'+80H,"AL" ; 0xe5 <- 0xca - DB 'A'+80H,"SC" ; 0xe6 <- 0xcb - DB 'C'+80H,"HR$" ; 0xe7 <- 0xcc - DB 'H'+80H,"EX$" ; 0xe8 <- 0xcd - DB 'B'+80H,"IN$" ; 0xe9 <- 0xce - DB 'L'+80H,"EFT$" ; 0xea <- 0xcf - DB 'R'+80H,"IGHT$" ; 0xeb <- 0xd0 - DB 'M'+80H,"ID$" ; 0xec <- 0xd1 - DB 80H ; End of list marker + DB 'S'+80H,"GN" ; 0xd1 <- 0xb6 + DB 'I'+80H,"NT" ; 0xd2 <- 0xb7 + DB 'A'+80H,"BS" ; 0xd3 <- 0xb8 + DB 'U'+80H,"SR" ; 0xd4 <- 0xb9 + DB 'F'+80H,"RE" ; 0xd5 <- 0xba + DB 'I'+80H,"NP" ; 0xd6 <- 0xbb + DB 'P'+80H,"OS" ; 0xd7 <- 0xbc + DB 'S'+80H,"QR" ; 0xd8 <- 0xbd + DB 'R'+80H,"ND" ; 0xd9 <- 0xbe + DB 'L'+80H,"OG" ; 0xda <- 0xbf + DB 'E'+80H,"XP" ; 0xdb <- 0xc0 + DB 'C'+80H,"OS" ; 0xdc <- 0xc1 + DB 'S'+80H,"IN" ; 0xdd <- 0xc2 + DB 'T'+80H,"AN" ; 0xde <- 0xc3 + DB 'A'+80H,"TN" ; 0xdf <- 0xc4 + DB 'P'+80H,"EEK" ; 0xe0 <- 0xc5 + DB 'D'+80H,"EEK" ; 0xe1 <- 0xc6 + DB 'P'+80H,"OINT" ; 0xe2 <- 0xc7 + DB 'L'+80H,"EN" ; 0xe3 <- 0xc8 + DB 'S'+80H,"TR$" ; 0xe4 <- 0xc9 + DB 'V'+80H,"AL" ; 0xe5 <- 0xca + DB 'A'+80H,"SC" ; 0xe6 <- 0xcb + DB 'C'+80H,"HR$" ; 0xe7 <- 0xcc + DB 'H'+80H,"EX$" ; 0xe8 <- 0xcd + DB 'B'+80H,"IN$" ; 0xe9 <- 0xce + DB 'L'+80H,"EFT$" ; 0xea <- 0xcf + DB 'R'+80H,"IGHT$" ; 0xeb <- 0xd0 + DB 'M'+80H,"ID$" ; 0xec <- 0xd1 + DB 80H ; End of list marker -; KEYWORD ADDRESS TABLE + ; KEYWORD ADDRESS TABLE -WORDTB: DW PEND - DW FOR - DW NEXT - DW DATA - DW INPUT - DW DIM - DW READ - DW LET - DW GOTO - DW RUN - DW IF - DW RESTOR - DW GOSUB - DW RETURN - DW REM - DW STOP - DW POUT - DW ON - DW NULL - DW WAIT - DW DEF - DW POKE - DW DOKE - DW SCREEN - DW LINES - DW CLS - DW WIDTH - DW MONITR - DW PSET - DW RESET - DW PRINT - DW CONT - DW LIST - DW CLEAR - DW CLOAD - DW CSAVE - DW LOAD - DW SAVE - DW NEW +WORDTB: DW PEND + DW FOR + DW NEXT + DW DATA + DW INPUT + DW DIM + DW READ + DW LET + DW GOTO + DW RUN + DW IF + DW RESTOR + DW GOSUB + DW RETURN + DW REM + DW STOP + DW POUT + DW ON + DW NULL + DW WAIT + DW DEF + DW POKE + DW DOKE + DW SCREEN + DW LINES + DW CLS + DW WIDTH + DW MONITR + DW PSET + DW RESET + DW PRINT + DW CONT + DW LIST + DW CLEAR + DW CLOAD ; Load tokenised BASIC program. + DW CSAVE ; Save tokenised BASIC program. + DW LOAD ; Load ASCII text BASIC program. + DW SAVE ; Save BASIC as ASCII text. + DW SETFREQ ; Set the CPU Frequency. + DW NEW -; RESERVED WORD TOKEN VALUES + ; RESERVED WORD TOKEN VALUES -ZEND EQU 080H ; END - ZEND marks the start of the table. -ZFOR EQU 081H ; FOR -ZDATA EQU 083H ; DATA -ZGOTO EQU 088H ; GOTO -ZGOSUB EQU 08CH ; GOSUB -ZREM EQU 08EH ; REM -ZPRINT EQU 09EH ; PRINT -ZNEW EQU 0A6H ; NEW - ZNEW marks the end of the table - ; A5..BF are reserved for future commands. +ZEND EQU 080H ; END - ZEND marks the start of the table. +ZFOR EQU 081H ; FOR +ZDATA EQU 083H ; DATA +ZGOTO EQU 088H ; GOTO +ZGOSUB EQU 08CH ; GOSUB +ZREM EQU 08EH ; REM +ZPRINT EQU 09EH ; PRINT +ZNEW EQU 0A7H ; NEW - ZNEW marks the end of the table + ; A8..BF are reserved for future commands. -; Space for expansion, a block of tokens for commands has been created from 0xA5 to 0xBF. + ; Space for expansion, a block of tokens for commands has been created from 0xA5 to 0xBF. -FUNCSTRT EQU 0C0H ; Function start. -ZTAB EQU FUNCSTRT + 00H ; 0A5H ; TAB -ZTO EQU FUNCSTRT + 01H ; 0A6H ; TO -ZFN EQU FUNCSTRT + 02H ; 0A7H ; FN -ZSPC EQU FUNCSTRT + 03H ; 0A8H ; SPC -ZTHEN EQU FUNCSTRT + 04H ; 0A9H ; THEN -ZNOT EQU FUNCSTRT + 05H ; 0AAH ; NOT -ZSTEP EQU FUNCSTRT + 06H ; 0ABH ; STEP +FUNCSTRT EQU 0C0H ; Function start. +ZTAB EQU FUNCSTRT + 00H ; 0A5H ; TAB +ZTO EQU FUNCSTRT + 01H ; 0A6H ; TO +ZFN EQU FUNCSTRT + 02H ; 0A7H ; FN +ZSPC EQU FUNCSTRT + 03H ; 0A8H ; SPC +ZTHEN EQU FUNCSTRT + 04H ; 0A9H ; THEN +ZNOT EQU FUNCSTRT + 05H ; 0AAH ; NOT +ZSTEP EQU FUNCSTRT + 06H ; 0ABH ; STEP -ZPLUS EQU FUNCSTRT + 07H ; 0ACH ; + -ZMINUS EQU FUNCSTRT + 08H ; 0ADH ; - -ZTIMES EQU FUNCSTRT + 09H ; 0AEH ; * -ZDIV EQU FUNCSTRT + 0AH ; 0AFH ; / - ; 0B0H - ; 0B1H -ZOR EQU FUNCSTRT + 0dH ; 0B2H ; OR -ZGTR EQU FUNCSTRT + 0eH ; 0B3H ; > -ZEQUAL EQU FUNCSTRT + 0fH ; 0B4H ; M -ZLTH EQU FUNCSTRT + 10H ; 0B5H ; < -ZSGN EQU FUNCSTRT + 11H ; 0B6H ; SGN - ; 0B7H - ; 0B8H - ; 0B9H - ; 0BAH - ; 0BBH - ; 0BCH - ; 0BDH - ; 0BEH - ; 0BFH - ; 0C0H - ; 0C1H - ; 0C2H - ; 0C3H - ; 0C4H - ; 0C5H - ; 0C6H -ZPOINT EQU FUNCSTRT + 22H ; 0C7H ; POINT - ; 0C8H - ; 0C9H - ; 0CAH - ; 0CBH - ; 0CCH -ZLEFT EQU FUNCSTRT + 2aH ; 0CFH ; LEFT$ +ZPLUS EQU FUNCSTRT + 07H ; 0ACH ; + +ZMINUS EQU FUNCSTRT + 08H ; 0ADH ; - +ZTIMES EQU FUNCSTRT + 09H ; 0AEH ; * +ZDIV EQU FUNCSTRT + 0AH ; 0AFH ; / + ; 0B0H + ; 0B1H +ZOR EQU FUNCSTRT + 0dH ; 0B2H ; OR +ZGTR EQU FUNCSTRT + 0eH ; 0B3H ; > +ZEQUAL EQU FUNCSTRT + 0fH ; 0B4H ; M +ZLTH EQU FUNCSTRT + 10H ; 0B5H ; < +ZSGN EQU FUNCSTRT + 11H ; 0B6H ; SGN + ; 0B7H + ; 0B8H + ; 0B9H + ; 0BAH + ; 0BBH + ; 0BCH + ; 0BDH + ; 0BEH + ; 0BFH + ; 0C0H + ; 0C1H + ; 0C2H + ; 0C3H + ; 0C4H + ; 0C5H + ; 0C6H +ZPOINT EQU FUNCSTRT + 22H ; 0C7H ; POINT + ; 0C8H + ; 0C9H + ; 0CAH + ; 0CBH + ; 0CCH +ZLEFT EQU FUNCSTRT + 2aH ; 0CFH ; LEFT$ -; Space for expansion, reserve a block of tokens for functions. + ; Space for expansion, reserve a block of tokens for functions. -; ARITHMETIC PRECEDENCE TABLE + ; ARITHMETIC PRECEDENCE TABLE -PRITAB: DB 79H ; Precedence value - DW PADD ; FPREG = + FPREG +PRITAB: DB 79H ; Precedence value + DW PADD ; FPREG = + FPREG - DB 79H ; Precedence value - DW PSUB ; FPREG = - FPREG + DB 79H ; Precedence value + DW PSUB ; FPREG = - FPREG - DB 7CH ; Precedence value - DW MULT ; PPREG = * FPREG + DB 7CH ; Precedence value + DW MULT ; PPREG = * FPREG - DB 7CH ; Precedence value - DW DIV ; FPREG = / FPREG + DB 7CH ; Precedence value + DW DIV ; FPREG = / FPREG - DB 7FH ; Precedence value - DW POWER ; FPREG = ^ FPREG + DB 7FH ; Precedence value + DW POWER ; FPREG = ^ FPREG - DB 50H ; Precedence value - DW PAND ; FPREG = AND FPREG + DB 50H ; Precedence value + DW PAND ; FPREG = AND FPREG - DB 46H ; Precedence value - DW POR ; FPREG = OR FPREG + DB 46H ; Precedence value + DW POR ; FPREG = OR FPREG -; BASIC ERROR CODE LIST + ; BASIC ERROR CODE LIST -ERRORS: DB "NF" ; NEXT without FOR - DB "SN" ; Syntax error - DB "RG" ; RETURN without GOSUB - DB "OD" ; Out of DATA - DB "FC" ; Illegal function call - DB "OV" ; Overflow error - DB "OM" ; Out of memory - DB "UL" ; Undefined line - DB "BS" ; Bad subscript - DB "DD" ; Re-DIMensioned array - DB "/0" ; Division by zero - DB "ID" ; Illegal direct - DB "TM" ; Type mis-match - DB "OS" ; Out of string space - DB "LS" ; String too long - DB "ST" ; String formula too complex - DB "CN" ; Can't CONTinue - DB "UF" ; Undefined FN function - DB "MO" ; Missing operand - DB "HX" ; HEX error - DB "BN" ; BIN error +ERRORS: DB "NF" ; NEXT without FOR + DB "SN" ; Syntax error + DB "RG" ; RETURN without GOSUB + DB "OD" ; Out of DATA + DB "FC" ; Illegal function call + DB "OV" ; Overflow error + DB "OM" ; Out of memory + DB "UL" ; Undefined line + DB "BS" ; Bad subscript + DB "DD" ; Re-DIMensioned array + DB "/0" ; Division by zero + DB "ID" ; Illegal direct + DB "TM" ; Type mis-match + DB "OS" ; Out of string space + DB "LS" ; String too long + DB "ST" ; String formula too complex + DB "CN" ; Can't CONTinue + DB "UF" ; Undefined FN function + DB "MO" ; Missing operand + DB "HX" ; HEX error + DB "BN" ; BIN error -; INITIALISATION TABLE ------------------------------------------------------- + ; INITIALISATION TABLE ------------------------------------------------------- -INITAB: JP WARMST ; Warm start jump - JP FCERR ; "USR (X)" jump (Set to Error) +INITAB: JP WARMST ; Warm start jump + JP FCERR ; "USR (X)" jump (Set to Error) - OUT (0),A ; "OUT p,n" skeleton - RET + OUT (0),A ; "OUT p,n" skeleton + RET - SUB 0 ; Division support routine - LD L,A - LD A,H - SBC A,0 - LD H,A - LD A,B - SBC A,0 - LD B,A - LD A,0 - RET + SUB 0 ; Division support routine + LD L,A + LD A,H + SBC A,0 + LD H,A + LD A,B + SBC A,0 + LD B,A + LD A,0 + RET - DB 0,0,0 ; Random number seed - ; Table used by RND - DB 035H,04AH,0CAH,099H ;-2.65145E+07 - DB 039H,01CH,076H,098H ; 1.61291E+07 - DB 022H,095H,0B3H,098H ;-1.17691E+07 - DB 00AH,0DDH,047H,098H ; 1.30983E+07 - DB 053H,0D1H,099H,099H ;-2-01612E+07 - DB 00AH,01AH,09FH,098H ;-1.04269E+07 - DB 065H,0BCH,0CDH,098H ;-1.34831E+07 - DB 0D6H,077H,03EH,098H ; 1.24825E+07 - DB 052H,0C7H,04FH,080H ; Last random number + DB 0,0,0 ; Random number seed + ; Table used by RND + DB 035H,04AH,0CAH,099H ;-2.65145E+07 + DB 039H,01CH,076H,098H ; 1.61291E+07 + DB 022H,095H,0B3H,098H ;-1.17691E+07 + DB 00AH,0DDH,047H,098H ; 1.30983E+07 + DB 053H,0D1H,099H,099H ;-2-01612E+07 + DB 00AH,01AH,09FH,098H ;-1.04269E+07 + DB 065H,0BCH,0CDH,098H ;-1.34831E+07 + DB 0D6H,077H,03EH,098H ; 1.24825E+07 + DB 052H,0C7H,04FH,080H ; Last random number - IN A,(0) ; INP (x) skeleton - RET + IN A,(0) ; INP (x) skeleton + RET - DB 1 ; POS (x) number (1) - DB 80 ; Terminal width (47) - DB 28 ; Width for commas (3 columns) - DB 0 ; No nulls after input bytes - DB 0 ; Output enabled (^O off) + DB 1 ; POS (x) number (1) + DB 80 ; Terminal width (47) + DB 28 ; Width for commas (3 columns) + DB 0 ; No nulls after input bytes + DB 0 ; Output enabled (^O off) - DW 20 ; Initial lines counter - DW 20 ; Initial lines number - DW 0 ; Array load/save check sum + DW 20 ; Initial lines counter + DW 20 ; Initial lines number + DW 0 ; Array load/save check sum - DB 0 ; Break not by NMI - DB 0 ; Break flag + DB 0 ; Break not by NMI + DB 0 ; Break flag - JP TTYLIN ; Input reflection (set to TTY) - JP 0000H ; POINT reflection unused - JP 0000H ; SET reflection - JP 0000H ; RESET reflection - ;JP POINTB ; POINT reflection unused - ;JP SETB ; SET reflection - ;JP RESETB ; RESET reflection + JP TTYLIN ; Input reflection (set to TTY) + JP 0000H ; POINT reflection unused + JP 0000H ; SET reflection + JP 0000H ; RESET reflection + ;JP POINTB ; POINT reflection unused + ;JP SETB ; SET reflection + ;JP RESETB ; RESET reflection - DW STLOOK ; Temp string space - DW -2 ; Current line number (cold) - DW PROGST+1 ; Start of program text + DW STLOOK ; Temp string space + DW -2 ; Current line number (cold) + DW PROGST+1 ; Start of program text INITBE: ; END OF INITIALISATION TABLE -; END OF INITIALISATION TABLE --------------------------------------------------- + ; END OF INITIALISATION TABLE --------------------------------------------------- -ERRMSG: DB " Error",0 -INMSG: DB " in ",0 -ZERBYT EQU $-1 ; A zero byte -OKMSG: DB "Ok",CR,LF,0,0 -BRKMSG: DB "Break",0 +ERRMSG: DB " Error",0 +INMSG: DB " in ",0 +ZERBYT EQU $-1 ; A zero byte +OKMSG: DB "Ok",CR,LF,0,0 +BRKMSG: DB "Break",0 -BAKSTK: LD HL,4 ; Look for "FOR" block with - ADD HL,SP ; same index as specified -LOKFOR: LD A,(HL) ; Get block ID - INC HL ; Point to index address - CP ZFOR ; Is it a "FOR" token - RET NZ ; No - exit - LD C,(HL) ; BC = Address of "FOR" index - INC HL - LD B,(HL) - INC HL ; Point to sign of STEP - PUSH HL ; Save pointer to sign - LD L,C ; HL = address of "FOR" index - LD H,B - LD A,D ; See if an index was specified - OR E ; DE = 0 if no index specified - EX DE,HL ; Specified index into HL - JP Z,INDFND ; Skip if no index given - EX DE,HL ; Index back into DE - CALL CPDEHL ; Compare index with one given -INDFND: LD BC,16-3 ; Offset to next block - POP HL ; Restore pointer to sign - RET Z ; Return if block found - ADD HL,BC ; Point to next block - JP LOKFOR ; Keep on looking +BAKSTK: LD HL,4 ; Look for "FOR" block with + ADD HL,SP ; same index as specified +LOKFOR: LD A,(HL) ; Get block ID + INC HL ; Point to index address + CP ZFOR ; Is it a "FOR" token + RET NZ ; No - exit + LD C,(HL) ; BC = Address of "FOR" index + INC HL + LD B,(HL) + INC HL ; Point to sign of STEP + PUSH HL ; Save pointer to sign + LD L,C ; HL = address of "FOR" index + LD H,B + LD A,D ; See if an index was specified + OR E ; DE = 0 if no index specified + EX DE,HL ; Specified index into HL + JP Z,INDFND ; Skip if no index given + EX DE,HL ; Index back into DE + CALL CPDEHL ; Compare index with one given +INDFND: LD BC,16-3 ; Offset to next block + POP HL ; Restore pointer to sign + RET Z ; Return if block found + ADD HL,BC ; Point to next block + JP LOKFOR ; Keep on looking -MOVUP: CALL ENFMEM ; See if enough memory -MOVSTR: PUSH BC ; Save end of source - EX (SP),HL ; Swap source and dest" end - POP BC ; Get end of destination -MOVLP: CALL CPDEHL ; See if list moved - LD A,(HL) ; Get byte - LD (BC),A ; Move it - RET Z ; Exit if all done - DEC BC ; Next byte to move to - DEC HL ; Next byte to move - JP MOVLP ; Loop until all bytes moved +MOVUP: CALL ENFMEM ; See if enough memory +MOVSTR: PUSH BC ; Save end of source + EX (SP),HL ; Swap source and dest" end + POP BC ; Get end of destination +MOVLP: CALL CPDEHL ; See if list moved + LD A,(HL) ; Get byte + LD (BC),A ; Move it + RET Z ; Exit if all done + DEC BC ; Next byte to move to + DEC HL ; Next byte to move + JP MOVLP ; Loop until all bytes moved -CHKSTK: PUSH HL ; Save code string address - LD HL,(ARREND) ; Lowest free memory - LD B,0 ; BC = Number of levels to test - ADD HL,BC ; 2 Bytes for each level - ADD HL,BC - DB 3EH ; Skip "PUSH HL" -ENFMEM: PUSH HL ; Save code string address - LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM - SUB L - LD L,A - LD A,0FFH ; HIGH (-48) ; 48 Bytes minimum RAM - SBC A,H - JP C,OMERR ; Not enough - ?OM Error - LD H,A - ADD HL,SP ; Test if stack is overflowed - POP HL ; Restore code string address - RET C ; Return if enough mmory -OMERR: LD E,OM ; ?OM Error - JP BERROR +CHKSTK: PUSH HL ; Save code string address + LD HL,(ARREND) ; Lowest free memory + LD B,0 ; BC = Number of levels to test + ADD HL,BC ; 2 Bytes for each level + ADD HL,BC + DB 3EH ; Skip "PUSH HL" +ENFMEM: PUSH HL ; Save code string address + LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM + SUB L + LD L,A + LD A,0FFH ; HIGH (-48) ; 48 Bytes minimum RAM + SBC A,H + JP C,OMERR ; Not enough - ?OM Error + LD H,A + ADD HL,SP ; Test if stack is overflowed + POP HL ; Restore code string address + RET C ; Return if enough mmory +OMERR: LD E,OM ; ?OM Error + JP BERROR -DATSNR: LD HL,(DATLIN) ; Get line of current DATA item - LD (LINEAT),HL ; Save as current line -SNERR: LD E,SN ; ?SN Error - DB 01H ; Skip "LD E,DZ" -DZERR: LD E,DZ ; ?/0 Error - DB 01H ; Skip "LD E,NF" -NFERR: LD E,NF ; ?NF Error - DB 01H ; Skip "LD E,DD" -DDERR: LD E,DDA ; ?DD Error - DB 01H ; Skip "LD E,UF" -UFERR: LD E,UF ; ?UF Error - DB 01H ; Skip "LD E,OV -OVERR: LD E,OV ; ?OV Error - DB 01H ; Skip "LD E,TM" -TMERR: LD E,TM ; ?TM Error +DATSNR: LD HL,(DATLIN) ; Get line of current DATA item + LD (LINEAT),HL ; Save as current line +SNERR: LD E,SN ; ?SN Error + DB 01H ; Skip "LD E,DZ" +DZERR: LD E,DZ ; ?/0 Error + DB 01H ; Skip "LD E,NF" +NFERR: LD E,NF ; ?NF Error + DB 01H ; Skip "LD E,DD" +DDERR: LD E,DDA ; ?DD Error + DB 01H ; Skip "LD E,UF" +UFERR: LD E,UF ; ?UF Error + DB 01H ; Skip "LD E,OV +OVERR: LD E,OV ; ?OV Error + DB 01H ; Skip "LD E,TM" +TMERR: LD E,TM ; ?TM Error -BERROR: CALL CLREG ; Clear registers and stack - LD (CTLOFG),A ; Enable output (A is 0) - CALL STTLIN ; Start new line - LD HL,ERRORS ; Point to error codes - LD D,A ; D = 0 (A is 0) - LD A,'?' - CALL OUTC ; Output '?' - ADD HL,DE ; Offset to correct error code - LD A,(HL) ; First character - CALL OUTC ; Output it - CALL GETCHR ; Get next character - CALL OUTC ; Output it - LD HL,ERRMSG ; "Error" message -ERRIN: CALL PRS ; Output message - LD HL,(LINEAT) ; Get line of error - LD DE,-2 ; Cold start error if -2 - CALL CPDEHL ; See if cold start error - JP Z,CSTART ; Cold start error - Restart - LD A,H ; Was it a direct error? - AND L ; Line = -1 if direct error - INC A - CALL NZ,LINEIN ; No - output line of error - DB 3EH ; Skip "POP BC" -POPNOK: POP BC ; Drop address in input buffer +BERROR: CALL CLREG ; Clear registers and stack + LD (CTLOFG),A ; Enable output (A is 0) + CALL STTLIN ; Start new line + LD HL,ERRORS ; Point to error codes + LD D,A ; D = 0 (A is 0) + LD A,'?' + CALL OUTC ; Output '?' + ADD HL,DE ; Offset to correct error code + LD A,(HL) ; First character + CALL OUTC ; Output it + CALL GETCHR ; Get next character + CALL OUTC ; Output it + LD HL,ERRMSG ; "Error" message +ERRIN: CALL PRS ; Output message + LD HL,(LINEAT) ; Get line of error + LD DE,-2 ; Cold start error if -2 + CALL CPDEHL ; See if cold start error + JP Z,CSTART ; Cold start error - Restart + LD A,H ; Was it a direct error? + AND L ; Line = -1 if direct error + INC A + CALL NZ,LINEIN ; No - output line of error + DB 3EH ; Skip "POP BC" +POPNOK: POP BC ; Drop address in input buffer -PRNTOK: XOR A ; Output "Ok" and get command - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start new line - LD HL,OKMSG ; "Ok" message - CALL PRS ; Output "Ok" -GETCMD: LD HL,-1 ; Flag direct mode - LD (LINEAT),HL ; Save as current line - CALL GETLIN ; Get an input line - JP C,GETCMD ; Get line again if break - CALL GETCHR ; Get first character - INC A ; Test if end of line - DEC A ; Without affecting Carry - JP Z,GETCMD ; Nothing entered - Get another - PUSH AF ; Save Carry status - CALL ATOH ; Get line number into DE - PUSH DE ; Save line number - CALL CRUNCH ; Tokenise rest of line - LD B,A ; Length of tokenised line -> length is in C, B is zeroed. - POP DE ; Restore line number - POP AF ; Restore Carry - JP NC,EXCUTE ; No line number - Direct mode - PUSH DE ; Save line number - PUSH BC ; Save length of tokenised line - XOR A - LD (LSTBIN),A ; Clear last byte input - CALL GETCHR ; Get next character - OR A ; Set flags - PUSH AF ; And save them - CALL SRCHLN ; Search for line number in DE - JP C,LINFND ; Jump if line found - POP AF ; Get status - PUSH AF ; And re-save - JP Z,ULERR ; Nothing after number - Error - OR A ; Clear Carry -LINFND: PUSH BC ; Save address of line in prog - JP NC,INEWLN ; Line not found - Insert new - EX DE,HL ; Next line address in DE - LD HL,(PROGND) ; End of program -SFTPRG: LD A,(DE) ; Shift rest of program down - LD (BC),A - INC BC ; Next destination - INC DE ; Next source - CALL CPDEHL ; All done? - JP NZ,SFTPRG ; More to do - LD H,B ; HL - New end of program - LD L,C - LD (PROGND),HL ; Update end of program +PRNTOK: XOR A ; Output "Ok" and get command + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start new line + LD HL,OKMSG ; "Ok" message + CALL PRS ; Output "Ok" +GETCMD: LD HL,-1 ; Flag direct mode + LD (LINEAT),HL ; Save as current line + CALL GETLIN ; Get an input line + JP C,GETCMD ; Get line again if break + CALL GETCHR ; Get first character + INC A ; Test if end of line + DEC A ; Without affecting Carry + JP Z,GETCMD ; Nothing entered - Get another + PUSH AF ; Save Carry status + CALL ATOH ; Get line number into DE + PUSH DE ; Save line number + CALL CRUNCH ; Tokenise rest of line + LD B,A ; Length of tokenised line -> length is in C, B is zeroed. + POP DE ; Restore line number + POP AF ; Restore Carry + JP NC,EXCUTE ; No line number - Direct mode + PUSH DE ; Save line number + PUSH BC ; Save length of tokenised line + XOR A + LD (LSTBIN),A ; Clear last byte input + CALL GETCHR ; Get next character + OR A ; Set flags + PUSH AF ; And save them + CALL SRCHLN ; Search for line number in DE + JP C,LINFND ; Jump if line found + POP AF ; Get status + PUSH AF ; And re-save + JP Z,ULERR ; Nothing after number - Error + OR A ; Clear Carry +LINFND: PUSH BC ; Save address of line in prog + JP NC,INEWLN ; Line not found - Insert new + EX DE,HL ; Next line address in DE + LD HL,(PROGND) ; End of program +SFTPRG: LD A,(DE) ; Shift rest of program down + LD (BC),A + INC BC ; Next destination + INC DE ; Next source + CALL CPDEHL ; All done? + JP NZ,SFTPRG ; More to do + LD H,B ; HL - New end of program + LD L,C + LD (PROGND),HL ; Update end of program -INEWLN: POP DE ; Get address of line, - POP AF ; Get status - JP Z,SETPTR ; No text - Set up pointers - LD HL,(PROGND) ; Get end of program - EX (SP),HL ; Get length of input line - POP BC ; End of program to BC - ADD HL,BC ; Find new end - PUSH HL ; Save new end - CALL MOVUP ; Make space for line - POP HL ; Restore new end - LD (PROGND),HL ; Update end of program pointer - EX DE,HL ; Get line to move up in HL - LD (HL),H ; Save MSB - POP DE ; Get new line number - INC HL ; Skip pointer - INC HL - LD (HL),E ; Save LSB of line number - INC HL - LD (HL),D ; Save MSB of line number - INC HL ; To first byte in line - LD DE,BUFFER ; Copy buffer to program -MOVBUF: LD A,(DE) ; Get source - LD (HL),A ; Save destinations - INC HL ; Next source - INC DE ; Next destination - OR A ; Done? - JP NZ,MOVBUF ; No - Repeat -SETPTR: CALL RUNFST ; Set line pointers - INC HL ; To LSB of pointer - EX DE,HL ; Address to DE -PTRLP: LD H,D ; Address to HL - LD L,E - LD A,(HL) ; Get LSB of pointer - INC HL ; To MSB of pointer - OR (HL) ; Compare with MSB pointer - JP Z,GETCMD ; Get command line if end - INC HL ; To LSB of line number - INC HL ; Skip line number - INC HL ; Point to first byte in line - XOR A ; Looking for 00 byte -FNDEND: CP (HL) ; Found end of line? - INC HL ; Move to next byte - JP NZ,FNDEND ; No - Keep looking - EX DE,HL ; Next line address to HL - LD (HL),E ; Save LSB of pointer - INC HL - LD (HL),D ; Save MSB of pointer - JP PTRLP ; Do next line +INEWLN: POP DE ; Get address of line, + POP AF ; Get status + JP Z,SETPTR ; No text - Set up pointers + LD HL,(PROGND) ; Get end of program + EX (SP),HL ; Get length of input line + POP BC ; End of program to BC + ADD HL,BC ; Find new end + PUSH HL ; Save new end + CALL MOVUP ; Make space for line + POP HL ; Restore new end + LD (PROGND),HL ; Update end of program pointer + EX DE,HL ; Get line to move up in HL + LD (HL),H ; Save MSB + POP DE ; Get new line number + INC HL ; Skip pointer + INC HL + LD (HL),E ; Save LSB of line number + INC HL + LD (HL),D ; Save MSB of line number + INC HL ; To first byte in line + LD DE,BUFFER ; Copy buffer to program +MOVBUF: LD A,(DE) ; Get source + LD (HL),A ; Save destinations + INC HL ; Next source + INC DE ; Next destination + OR A ; Done? + JP NZ,MOVBUF ; No - Repeat +SETPTR: CALL RUNFST ; Set line pointers + INC HL ; To LSB of pointer + EX DE,HL ; Address to DE +PTRLP: LD H,D ; Address to HL + LD L,E + LD A,(HL) ; Get LSB of pointer + INC HL ; To MSB of pointer + OR (HL) ; Compare with MSB pointer + JP Z,GETCMD ; Get command line if end + INC HL ; To LSB of line number + INC HL ; Skip line number + INC HL ; Point to first byte in line + XOR A ; Looking for 00 byte +FNDEND: CP (HL) ; Found end of line? + INC HL ; Move to next byte + JP NZ,FNDEND ; No - Keep looking + EX DE,HL ; Next line address to HL + LD (HL),E ; Save LSB of pointer + INC HL + LD (HL),D ; Save MSB of pointer + JP PTRLP ; Do next line -SRCHLN: LD HL,(BASTXT) ; Start of program text -SRCHLP: LD B,H ; BC = Address to look at - LD C,L - LD A,(HL) ; Get address of next line - INC HL - OR (HL) ; End of program found? - DEC HL - RET Z ; Yes - Line not found - INC HL - INC HL - LD A,(HL) ; Get LSB of line number - INC HL - LD H,(HL) ; Get MSB of line number - LD L,A - CALL CPDEHL ; Compare with line in DE - LD H,B ; HL = Start of this line - LD L,C - LD A,(HL) ; Get LSB of next line address - INC HL - LD H,(HL) ; Get MSB of next line address - LD L,A ; Next line to HL - CCF - RET Z ; Lines found - Exit - CCF - RET NC ; Line not found,at line after - JP SRCHLP ; Keep looking +SRCHLN: LD HL,(BASTXT) ; Start of program text +SRCHLP: LD B,H ; BC = Address to look at + LD C,L + LD A,(HL) ; Get address of next line + INC HL + OR (HL) ; End of program found? + DEC HL + RET Z ; Yes - Line not found + INC HL + INC HL + LD A,(HL) ; Get LSB of line number + INC HL + LD H,(HL) ; Get MSB of line number + LD L,A + CALL CPDEHL ; Compare with line in DE + LD H,B ; HL = Start of this line + LD L,C + LD A,(HL) ; Get LSB of next line address + INC HL + LD H,(HL) ; Get MSB of next line address + LD L,A ; Next line to HL + CCF + RET Z ; Lines found - Exit + CCF + RET NC ; Line not found,at line after + JP SRCHLP ; Keep looking -NEW: RET NZ ; Return if any more on line -CLRPTR: LD HL,(BASTXT) ; Point to start of program - XOR A ; Set program area to empty - LD (HL),A ; Save LSB = 00 - INC HL - LD (HL),A ; Save MSB = 00 - INC HL - LD (PROGND),HL ; Set program end +NEW: RET NZ ; Return if any more on line +CLRPTR: LD HL,(BASTXT) ; Point to start of program + XOR A ; Set program area to empty + LD (HL),A ; Save LSB = 00 + INC HL + LD (HL),A ; Save MSB = 00 + INC HL + LD (PROGND),HL ; Set program end -RUNFST: LD HL,(BASTXT) ; Clear all variables - DEC HL +RUNFST: LD HL,(BASTXT) ; Clear all variables + DEC HL -INTVAR: LD (BRKLIN),HL ; Initialise RUN variables - LD HL,(LSTRAM) ; Get end of RAM - LD (STRBOT),HL ; Clear string space - XOR A - CALL RESTOR ; Reset DATA pointers - LD HL,(PROGND) ; Get end of program - LD (VAREND),HL ; Clear variables - LD (ARREND),HL ; Clear arrays +INTVAR: LD (BRKLIN),HL ; Initialise RUN variables + LD HL,(LSTRAM) ; Get end of RAM + LD (STRBOT),HL ; Clear string space + XOR A + CALL RESTOR ; Reset DATA pointers + LD HL,(PROGND) ; Get end of program + LD (VAREND),HL ; Clear variables + LD (ARREND),HL ; Clear arrays -CLREG: POP BC ; Save return address - LD HL,(STRSPC) ; Get end of working RAN - LD SP,HL ; Set stack - LD HL,TMSTPL ; Temporary string pool - LD (TMSTPT),HL ; Reset temporary string ptr - XOR A ; A = 00 - LD L,A ; HL = 0000 - LD H,A - LD (CONTAD),HL ; No CONTinue - LD (FORFLG),A ; Clear FOR flag - LD (FNRGNM),HL ; Clear FN argument - PUSH HL ; HL = 0000 - PUSH BC ; Put back return -DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN - RET ; Return to execution driver +CLREG: POP BC ; Save return address + LD HL,(STRSPC) ; Get end of working RAN + LD SP,HL ; Set stack + LD HL,TMSTPL ; Temporary string pool + LD (TMSTPT),HL ; Reset temporary string ptr + XOR A ; A = 00 + LD L,A ; HL = 0000 + LD H,A + LD (CONTAD),HL ; No CONTinue + LD (FORFLG),A ; Clear FOR flag + LD (FNRGNM),HL ; Clear FN argument + PUSH HL ; HL = 0000 + PUSH BC ; Put back return +DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN + RET ; Return to execution driver -PROMPT: LD A,'?' ; '?' - CALL OUTC ; Output character - LD A,' ' ; Space - CALL OUTC ; Output character - JP RINPUT ; Get input line +PROMPT: LD A,'?' ; '?' + CALL OUTC ; Output character + LD A,' ' ; Space + CALL OUTC ; Output character + JP RINPUT ; Get input line -CRUNCH: XOR A ; Tokenise line @ HL to BUFFER - LD (DATFLG),A ; Reset literal flag - LD C,2+3 ; 2 byte number and 3 nulls - LD DE,BUFFER ; Start of input buffer -CRNCLP: LD A,(HL) ; Get byte - CP ' ' ; Is it a space? - JP Z,MOVDIR ; Yes - Copy direct - LD B,A ; Save character - CP '"' ; Is it a quote? - JP Z,CPYLIT ; Yes - Copy literal string - OR A ; Is it end of buffer? - JP Z,ENDBUF ; Yes - End buffer - LD A,(DATFLG) ; Get data type - OR A ; Literal? - LD A,(HL) ; Get byte to copy - JP NZ,MOVDIR ; Literal - Copy direct - CP '?' ; Is it '?' short for PRINT - LD A,ZPRINT ; "PRINT" token - JP Z,MOVDIR ; Yes - replace it - LD A,(HL) ; Get byte again - CP '0' ; Is it less than '0' - JP C,FNDWRD ; Yes - Look for reserved words - CP 60; ";"+1 ; Is it "0123456789:;" ? - JP C,MOVDIR ; Yes - copy it direct -FNDWRD: PUSH DE ; Look for reserved words - LD DE,WORDS-1 ; Point to table - PUSH BC ; Save count - LD BC,RETNAD ; Where to return to - PUSH BC ; Save return address - LD B,ZEND-1 ; First token value -1 - LD A,(HL) ; Get byte - CP 'a' ; Less than 'a' ? - JP C,SEARCH ; Yes - search for words - CP 'z'+1 ; Greater than 'z' ? - JP NC,SEARCH ; Yes - search for words - AND 01011111B ; Force upper case - LD (HL),A ; Replace byte -SEARCH: LD C,(HL) ; Search for a word - EX DE,HL -GETNXT: INC HL ; Get next reserved word - OR (HL) ; Start of word? - JP P,GETNXT ; No - move on - INC B ; Increment token value - LD A, (HL) ; Get byte from table - AND 01111111B ; Strip bit 7 - RET Z ; Return if end of list - CP C ; Same character as in buffer? - JP NZ,GETNXT ; No - get next word - EX DE,HL - PUSH HL ; Save start of word +CRUNCH: XOR A ; Tokenise line @ HL to BUFFER + LD (DATFLG),A ; Reset literal flag + LD C,2+3 ; 2 byte number and 3 nulls + LD DE,BUFFER ; Start of input buffer +CRNCLP: LD A,(HL) ; Get byte + CP ' ' ; Is it a space? + JP Z,MOVDIR ; Yes - Copy direct + LD B,A ; Save character + CP '"' ; Is it a quote? + JP Z,CPYLIT ; Yes - Copy literal string + OR A ; Is it end of buffer? + JP Z,ENDBUF ; Yes - End buffer + LD A,(DATFLG) ; Get data type + OR A ; Literal? + LD A,(HL) ; Get byte to copy + JP NZ,MOVDIR ; Literal - Copy direct + CP '?' ; Is it '?' short for PRINT + LD A,ZPRINT ; "PRINT" token + JP Z,MOVDIR ; Yes - replace it + LD A,(HL) ; Get byte again + CP '0' ; Is it less than '0' + JP C,FNDWRD ; Yes - Look for reserved words + CP 60; ";"+1 ; Is it "0123456789:;" ? + JP C,MOVDIR ; Yes - copy it direct +FNDWRD: PUSH DE ; Look for reserved words + LD DE,WORDS-1 ; Point to table + PUSH BC ; Save count + LD BC,RETNAD ; Where to return to + PUSH BC ; Save return address + LD B,ZEND-1 ; First token value -1 + LD A,(HL) ; Get byte + CP 'a' ; Less than 'a' ? + JP C,SEARCH ; Yes - search for words + CP 'z'+1 ; Greater than 'z' ? + JP NC,SEARCH ; Yes - search for words + AND 01011111B ; Force upper case + LD (HL),A ; Replace byte +SEARCH: LD C,(HL) ; Search for a word + EX DE,HL +GETNXT: INC HL ; Get next reserved word + OR (HL) ; Start of word? + JP P,GETNXT ; No - move on + INC B ; Increment token value + LD A, (HL) ; Get byte from table + AND 01111111B ; Strip bit 7 + RET Z ; Return if end of list + CP C ; Same character as in buffer? + JP NZ,GETNXT ; No - get next word + EX DE,HL + PUSH HL ; Save start of word -NXTBYT: INC DE ; Look through rest of word - LD A,(DE) ; Get byte from table - OR A ; End of word ? - JP M,MATCH ; Yes - Match found - LD C,A ; Save it - LD A,B ; Get token value - CP ZGOTO ; Is it "GOTO" token ? - JP NZ,NOSPC ; No - Don't allow spaces - CALL GETCHR ; Get next character - DEC HL ; Cancel increment from GETCHR -NOSPC: INC HL ; Next byte - LD A,(HL) ; Get byte - CP 'a' ; Less than 'a' ? - JP C,NOCHNG ; Yes - don't change - AND 01011111B ; Make upper case -NOCHNG: CP C ; Same as in buffer ? - JP Z,NXTBYT ; Yes - keep testing - POP HL ; Get back start of word - JP SEARCH ; Look at next word +NXTBYT: INC DE ; Look through rest of word + LD A,(DE) ; Get byte from table + OR A ; End of word ? + JP M,MATCH ; Yes - Match found + LD C,A ; Save it + LD A,B ; Get token value + CP ZGOTO ; Is it "GOTO" token ? + JP NZ,NOSPC ; No - Don't allow spaces + CALL GETCHR ; Get next character + DEC HL ; Cancel increment from GETCHR +NOSPC: INC HL ; Next byte + LD A,(HL) ; Get byte + CP 'a' ; Less than 'a' ? + JP C,NOCHNG ; Yes - don't change + AND 01011111B ; Make upper case +NOCHNG: CP C ; Same as in buffer ? + JP Z,NXTBYT ; Yes - keep testing + POP HL ; Get back start of word + JP SEARCH ; Look at next word -MATCH: LD C,B ; Word found - Save token value - POP AF ; Throw away return - EX DE,HL - RET ; Return to "RETNAD" -RETNAD: EX DE,HL ; Get address in string - LD A,C ; Get token value - POP BC ; Restore buffer length - POP DE ; Get destination address -MOVDIR: INC HL ; Next source in buffer - LD (DE),A ; Put byte in buffer - INC DE ; Move up buffer - INC C ; Increment length of buffer - SUB ':' ; End of statement? - JP Z,SETLIT ; Jump if multi-statement line - CP ZDATA-3AH ; Is it DATA statement ? - JP NZ,TSTREM ; No - see if REM -SETLIT: LD (DATFLG),A ; Set literal flag -TSTREM: SUB ZREM-3AH ; Is it REM? - JP NZ,CRNCLP ; No - Leave flag - LD B,A ; Copy rest of buffer -NXTCHR: LD A,(HL) ; Get byte - OR A ; End of line ? - JP Z,ENDBUF ; Yes - Terminate buffer - CP B ; End of statement ? - JP Z,MOVDIR ; Yes - Get next one -CPYLIT: INC HL ; Move up source string - LD (DE),A ; Save in destination - INC C ; Increment length - INC DE ; Move up destination - JP NXTCHR ; Repeat +MATCH: LD C,B ; Word found - Save token value + POP AF ; Throw away return + EX DE,HL + RET ; Return to "RETNAD" +RETNAD: EX DE,HL ; Get address in string + LD A,C ; Get token value + POP BC ; Restore buffer length + POP DE ; Get destination address +MOVDIR: INC HL ; Next source in buffer + LD (DE),A ; Put byte in buffer + INC DE ; Move up buffer + INC C ; Increment length of buffer + SUB ':' ; End of statement? + JP Z,SETLIT ; Jump if multi-statement line + CP ZDATA-3AH ; Is it DATA statement ? + JP NZ,TSTREM ; No - see if REM +SETLIT: LD (DATFLG),A ; Set literal flag +TSTREM: SUB ZREM-3AH ; Is it REM? + JP NZ,CRNCLP ; No - Leave flag + LD B,A ; Copy rest of buffer +NXTCHR: LD A,(HL) ; Get byte + OR A ; End of line ? + JP Z,ENDBUF ; Yes - Terminate buffer + CP B ; End of statement ? + JP Z,MOVDIR ; Yes - Get next one +CPYLIT: INC HL ; Move up source string + LD (DE),A ; Save in destination + INC C ; Increment length + INC DE ; Move up destination + JP NXTCHR ; Repeat -ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer - LD (DE),A ; Mark end of buffer (A = 00) - INC DE - LD (DE),A ; A = 00 - INC DE - LD (DE),A ; A = 00 - RET +ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer + LD (DE),A ; Mark end of buffer (A = 00) + INC DE + LD (DE),A ; A = 00 + INC DE + LD (DE),A ; A = 00 + RET -DODEL: LD A,(NULFLG) ; Get null flag status - OR A ; Is it zero? - LD A,0 ; Zero A - Leave flags - LD (NULFLG),A ; Zero null flag - JP NZ,ECHDEL ; Set - Echo it - DEC B ; Decrement length - JP Z,GETLIN ; Get line again if empty - CALL OUTC ; Output null character - DB 3EH ; Skip "DEC B" -ECHDEL: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - JP Z,OTKLN ; No buffer - Try again - LD A,(HL) ; Get deleted byte - CALL OUTC ; Echo it - JP MORINP ; Get more input +DODEL: LD A,(NULFLG) ; Get null flag status + OR A ; Is it zero? + LD A,0 ; Zero A - Leave flags + LD (NULFLG),A ; Zero null flag + JP NZ,ECHDEL ; Set - Echo it + DEC B ; Decrement length + JP Z,GETLIN ; Get line again if empty + CALL OUTC ; Output null character + DB 3EH ; Skip "DEC B" +ECHDEL: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + JP Z,OTKLN ; No buffer - Try again + LD A,(HL) ; Get deleted byte + CALL OUTC ; Echo it + JP MORINP ; Get more input -DELCHR: DEC B ; Count bytes in buffer - DEC HL ; Back space buffer - CALL OUTC ; Output character in A - JP NZ,MORINP ; Not end - Get more -OTKLN: CALL OUTC ; Output character in A -KILIN: CALL PRNTCRLF ; Output CRLF - JP TTYLIN ; Get line again +DELCHR: DEC B ; Count bytes in buffer + DEC HL ; Back space buffer + CALL OUTC ; Output character in A + JP NZ,MORINP ; Not end - Get more +OTKLN: CALL OUTC ; Output character in A +KILIN: CALL PRNTCRLF ; Output CRLF + JP TTYLIN ; Get line again GETLIN: -TTYLIN: LD HL,BUFFER ; Get a line by character - LD B,1 ; Set buffer as empty - XOR A - LD (NULFLG),A ; Clear null flag -MORINP: CALL CLOTST ; Get character and test ^O - LD C,A ; Save character in C - CP DELETE ; Delete character? - JP Z,DODEL ; Yes - Process it - LD A,(NULFLG) ; Get null flag - OR A ; Test null flag status - JP Z,PROCES ; Reset - Process character - LD A,0 ; Set a null - CALL OUTC ; Output null - XOR A ; Clear A - LD (NULFLG),A ; Reset null flag -PROCES: LD A,C ; Get character - CP CTRL_G ; Bell? - JP Z,PUTCTL ; Yes - Save it - CP CTRL_C ; Is it control "C"? - CALL Z,PRNTCRLF ; Yes - Output CRLF - SCF ; Flag break - RET Z ; Return if control "C" - CP CR ; Is it enter? - JP Z,ENDINP ; Yes - Terminate input - CP CTRL_U ; Is it control "U"? - JP Z,KILIN ; Yes - Get another line - CP '@' ; Is it "kill line"? - JP Z,OTKLN ; Yes - Kill line - CP DELETE ; Is it delete? - JP Z,DELCHR ; Yes - Delete character - CP BACKS ; Is it backspace? - JP Z,DELCHR ; Yes - Delete character - CP CTRL_R ; Is it control "R"? - JP NZ,PUTBUF ; No - Put in buffer - PUSH BC ; Save buffer length - PUSH DE ; Save DE - PUSH HL ; Save buffer address - LD (HL),0 ; Mark end of buffer - CALL OUTNCR ; Output and do CRLF - LD HL,BUFFER ; Point to buffer start - CALL PRS ; Output buffer - POP HL ; Restore buffer address - POP DE ; Restore DE - POP BC ; Restore buffer length - JP MORINP ; Get another character - -PUTBUF: CP ' ' ; Is it a control code? - JP C,MORINP ; Yes - Ignore -PUTCTL: LD A,B ; Get number of bytes in buffer - CP 72+1 ; Test for line overflow - LD A,CTRL_G ; Set a bell - JP NC,OUTNBS ; Ring bell if buffer full - LD A,C ; Get character - LD (HL),C ; Save in buffer - LD (LSTBIN),A ; Save last input byte - INC HL ; Move up buffer - INC B ; Increment length -OUTIT: CALL OUTC ; Output the character entered - JP MORINP ; Get another character - -OUTNBS: CALL OUTC ; Output bell and back over it - LD A,BACKS ; Set back space - JP OUTIT ; Output it and get more - -CPDEHL: LD A,H ; Get H - SUB D ; Compare with D - RET NZ ; Different - Exit - LD A,L ; Get L - SUB E ; Compare with E - RET ; Return status - -CHKSYN: LD A,(HL) ; Check syntax of character - EX (SP),HL ; Address of test byte - CP (HL) ; Same as in code string? - INC HL ; Return address - EX (SP),HL ; Put it back - JP Z,GETCHR ; Yes - Get next character - JP SNERR ; Different - ?SN Error - -OUTC: PUSH AF ; Save character - LD A,(CTLOFG) ; Get control "O" flag - OR A ; Is it set? - JP NZ,POPAF ; Yes - don't output - POP AF ; Restore character - PUSH BC ; Save buffer length - PUSH AF ; Save character - CP ' ' ; Is it a control code? - JP C,DINPOS ; Yes - Don't INC POS(X) - LD A,(LWIDTH) ; Get line width - LD B,A ; To B - LD A,(CURPOS) ; Get cursor position - INC B ; Width 255? - JP Z,INCLEN ; Yes - No width limit - DEC B ; Restore width - CP B ; At end of line? - CALL Z,PRNTCRLF ; Yes - output CRLF -INCLEN: INC A ; Move on one character - LD (CURPOS),A ; Save new position -DINPOS: POP AF ; Restore character - POP BC ; Restore buffer length -ANSIINC:IF INCLUDE_ANSITERM = 1 - CALL ANSITERM ; Send it via the Ansi processor. - ELSE - CALL PRNT ; Send it . - ENDIF - RET - -CLOTST: CALL GETKY ; Get input character - AND 01111111B ; Strip bit 7 - CP CTRL_O ; Is it control "O"? - RET NZ ; No don't flip flag - LD A,(CTLOFG) ; Get flag - CPL ; Flip it - LD (CTLOFG),A ; Put it back - XOR A ; Null character - RET - -LIST: CALL ATOH ; ASCII number to DE - RET NZ ; Return if anything extra - POP BC ; Rubbish - Not needed - CALL SRCHLN ; Search for line number in DE - PUSH BC ; Save address of line - CALL SETLIN ; Set up lines counter -LISTLP: POP HL ; Restore address of line - LD C,(HL) ; Get LSB of next line - INC HL - LD B,(HL) ; Get MSB of next line - INC HL - LD A,B ; BC = 0 (End of program)? - OR C - JP Z,PRNTOK ; Yes - Go to command mode - CALL COUNT ; Count lines - CALL TSTBRK ; Test for break key - PUSH BC ; Save address of next line - CALL PRNTCRLF ; Output CRLF - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - INC HL - PUSH HL ; Save address of line start - EX DE,HL ; Line number to HL - CALL PRNTHL ; Output line number in decimal - LD A,' ' ; Space after line number - POP HL ; Restore start of line address -LSTLP2: CALL OUTC ; Output character in A -LSTLP3: LD A,(HL) ; Get next byte in line - OR A ; End of line? - INC HL ; To next byte in line - JP Z,LISTLP ; Yes - get next line - JP P,LSTLP2 ; No token - output it - SUB ZEND-1 ; Find and output word - LD C,A ; Token offset+1 to C - LD DE,WORDS ; Reserved word list -FNDTOK: LD A,(DE) ; Get character in list - INC DE ; Move on to next - OR A ; Is it start of word? - JP P,FNDTOK ; No - Keep looking for word - DEC C ; Count words - JP NZ,FNDTOK ; Not there - keep looking -OUTWRD: AND 01111111B ; Strip bit 7 - CALL OUTC ; Output first character - LD A,(DE) ; Get next character - INC DE ; Move on to next - OR A ; Is it end of word? - JP P,OUTWRD ; No - output the rest - JP LSTLP3 ; Next byte in line - -SETLIN: PUSH HL ; Set up LINES counter - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Save in LINES counter - POP HL - RET - -COUNT: PUSH HL ; Save code string address - PUSH DE - LD HL,(LINESC) ; Get LINES counter - LD DE,-1 - ADC HL,DE ; Decrement - LD (LINESC),HL ; Put it back - POP DE - POP HL ; Restore code string address - RET P ; Return if more lines to go - PUSH HL ; Save code string address - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - CALL GETKY ; Get input character - CP CTRL_C ; Is it control "C"? - JP Z,RSLNBK ; Yes - Reset LINES and break - POP HL ; Restore code string address - JP COUNT ; Keep on counting - -RSLNBK: LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - JP BRKRET ; Go and output "Break" - -FOR: LD A,64H ; Flag "FOR" assignment - LD (FORFLG),A ; Save "FOR" flag - CALL LET ; Set up initial index - POP BC ; Drop RETurn address - PUSH HL ; Save code string address - CALL DATA ; Get next statement address - LD (LOOPST),HL ; Save it for start of loop - LD HL,2 ; Offset for "FOR" block - ADD HL,SP ; Point to it -FORSLP: CALL LOKFOR ; Look for existing "FOR" block - POP DE ; Get code string address - JP NZ,FORFND ; No nesting found - ADD HL,BC ; Move into "FOR" block - PUSH DE ; Save code string address - DEC HL - LD D,(HL) ; Get MSB of loop statement - DEC HL - LD E,(HL) ; Get LSB of loop statement - INC HL - INC HL - PUSH HL ; Save block address - LD HL,(LOOPST) ; Get address of loop statement - CALL CPDEHL ; Compare the FOR loops - POP HL ; Restore block address - JP NZ,FORSLP ; Different FORs - Find another - POP DE ; Restore code string address - LD SP,HL ; Remove all nested loops - -FORFND: EX DE,HL ; Code string address to HL - LD C,8 - CALL CHKSTK ; Check for 8 levels of stack - PUSH HL ; Save code string address - LD HL,(LOOPST) ; Get first statement of loop - EX (SP),HL ; Save and restore code string - PUSH HL ; Re-save code string address - LD HL,(LINEAT) ; Get current line number - EX (SP),HL ; Save and restore code string - CALL TSTNUM ; Make sure it's a number - CALL CHKSYN ; Make sure "TO" is next - DB ZTO ; "TO" token - CALL GETNUM ; Get "TO" expression value - PUSH HL ; Save code string address - CALL BCDEFP ; Move "TO" value to BCDE - POP HL ; Restore code string address - PUSH BC ; Save "TO" value in block - PUSH DE - LD BC,8100H ; BCDE - 1 (default STEP) - LD D,C ; C=0 - LD E,D ; D=0 - LD A,(HL) ; Get next byte in code string - CP ZSTEP ; See if "STEP" is stated - LD A,1 ; Sign of step = 1 - JP NZ,SAVSTP ; No STEP given - Default to 1 - CALL GETCHR ; Jump over "STEP" token - CALL GETNUM ; Get step value - PUSH HL ; Save code string address - CALL BCDEFP ; Move STEP to BCDE - CALL TSTSGN ; Test sign of FPREG - POP HL ; Restore code string address -SAVSTP: PUSH BC ; Save the STEP value in block - PUSH DE - PUSH AF ; Save sign of STEP - INC SP ; Don't save flags - PUSH HL ; Save code string address - LD HL,(BRKLIN) ; Get address of index variable - EX (SP),HL ; Save and restore code string -PUTFID: LD B,ZFOR ; "FOR" block marker - PUSH BC ; Save it - INC SP ; Don't save C - -RUNCNT: CALL TSTBRK ; Execution driver - Test break - LD (BRKLIN),HL ; Save code address for break - LD A,(HL) ; Get next byte in code string - CP ':' ; Multi statement line? - JP Z,EXCUTE ; Yes - Execute it - OR A ; End of line? - JP NZ,SNERR ; No - Syntax error - INC HL ; Point to address of next line - LD A,(HL) ; Get LSB of line pointer - INC HL - OR (HL) ; Is it zero (End of prog)? - JP Z,ENDPRG ; Yes - Terminate execution - INC HL ; Point to line number - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - EX DE,HL ; Line number to HL - LD (LINEAT),HL ; Save as current line number - EX DE,HL ; Line number back to DE -EXCUTE: CALL GETCHR ; Get key word - LD DE,RUNCNT ; Where to RETurn to - PUSH DE ; Save for RETurn -IFJMP: RET Z ; Go to RUNCNT if end of STMT -ONJMP: SUB ZEND ; Is it a token? - JP C,LET ; No - try to assign it - CP ZNEW+1-ZEND ; END to NEW ? - JP NC,SNERR ; Not a key word - ?SN Error - RLCA ; Double it - LD C,A ; BC = Offset into table - LD B,0 - EX DE,HL ; Save code string address - LD HL,WORDTB ; Keyword address table - ADD HL,BC ; Point to routine address - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - PUSH BC ; Save routine address - EX DE,HL ; Restore code string address - -GETCHR: INC HL ; Point to next character - LD A,(HL) ; Get next code string byte - CP ':' ; Z if ':' - RET NC ; NC if > "9" - CP ' ' - JP Z,GETCHR ; Skip over spaces - CP '0' - CCF ; NC if < '0' - INC A ; Test for zero - Leave carry - DEC A ; Z if Null - RET - -RESTOR: EX DE,HL ; Save code string address - LD HL,(BASTXT) ; Point to start of program - JP Z,RESTNL ; Just RESTORE - reset pointer - EX DE,HL ; Restore code string address - CALL ATOH ; Get line number to DE - PUSH HL ; Save code string address - CALL SRCHLN ; Search for line number in DE - LD H,B ; HL = Address of line - LD L,C - POP DE ; Restore code string address - JP NC,ULERR ; ?UL Error if not found -RESTNL: DEC HL ; Byte before DATA statement -UPDATA: LD (NXTDAT),HL ; Update DATA pointer - EX DE,HL ; Restore code string address - RET - -TSTBRK: CALL CHKKY ; Check input status - OR A - RET Z ; No key, go back - CALL GETKY ; Get the key into A - CP ESC ; Escape key? - JR Z,BRK ; Yes, break - CP CTRL_C ; - JR Z,BRK ; Yes, break - CP CTRL_S ; Stop scrolling? - RET NZ ; Other key, ignore - - -STALL: CALL GETKY ; Wait for key - CP CTRL_Q ; Resume scrolling? - RET Z ; Release the chokehold - CP CTRL_C ; Second break? - JR Z,STOP ; Break during hold exits prog - JR STALL ; Loop until or - -BRK LD A,0FFH ; Set BRKFLG - LD (BRKFLG),A ; Store it - - -STOP: RET NZ ; Exit if anything else - DB 0F6H ; Flag "STOP" -PEND: RET NZ ; Exit if anything else - LD (BRKLIN),HL ; Save point of break - DB 21H ; Skip "OR 11111111B" -INPBRK: OR 11111111B ; Flag "Break" wanted - POP BC ; Return not needed and more -ENDPRG: LD HL,(LINEAT) ; Get current line number - PUSH AF ; Save STOP / END status - LD A,L ; Is it direct break? - AND H - INC A ; Line is -1 if direct break - JP Z,NOLIN ; Yes - No line number - LD (ERRLIN),HL ; Save line of break - LD HL,(BRKLIN) ; Get point of break - LD (CONTAD),HL ; Save point to CONTinue -NOLIN: XOR A - LD (CTLOFG),A ; Enable output - CALL STTLIN ; Start a new line - POP AF ; Restore STOP / END status - LD HL,BRKMSG ; "Break" message - JP NZ,ERRIN ; "in line" wanted? - JP PRNTOK ; Go to command mode - -CONT: LD HL,(CONTAD) ; Get CONTinue address - LD A,H ; Is it zero? - OR L - LD E,CN ; ?CN Error - JP Z,BERROR ; Yes - output "?CN Error" - EX DE,HL ; Save code string address - LD HL,(ERRLIN) ; Get line of last break - LD (LINEAT),HL ; Set up current line number - EX DE,HL ; Restore code string address - RET ; CONTinue where left off - -NULL: CALL GETINT ; Get integer 0-255 - RET NZ ; Return if bad value - LD (NULLS),A ; Set nulls number - RET - - -ACCSUM: PUSH HL ; Save address in array - LD HL,(CHKSUM) ; Get check sum - LD B,0 ; BC - Value of byte - LD C,A - ADD HL,BC ; Add byte to check sum - LD (CHKSUM),HL ; Re-save check sum - POP HL ; Restore address in array - RET - -CHKLTR: LD A,(HL) ; Get byte - CP 'A' ; < 'a' ? - RET C ; Carry set if not letter - CP 'Z'+1 ; > 'z' ? - CCF - RET ; Carry set if not letter - -FPSINT: CALL GETCHR ; Get next character -POSINT: CALL GETNUM ; Get integer 0 to 32767 -DEPINT: CALL TSTSGN ; Test sign of FPREG - JP M,FCERR ; Negative - ?FC Error -DEINT: LD A,(FPEXP) ; Get integer value to DE - CP 80H+16 ; Exponent in range (16 bits)? - JP C,FPINT ; Yes - convert it - LD BC,9080H ; BCDE = -32768 - LD DE,0000 - PUSH HL ; Save code string address - CALL CMPNUM ; Compare FPREG with BCDE - POP HL ; Restore code string address - LD D,C ; MSB to D - RET Z ; Return if in range -FCERR: LD E,FC ; ?FC Error - JP BERROR ; Output error- - -ATOH: DEC HL ; ASCII number to DE binary -GETLN: LD DE,0 ; Get number to DE -GTLNLP: CALL GETCHR ; Get next character - RET NC ; Exit if not a digit - PUSH HL ; Save code string address - PUSH AF ; Save digit - LD HL,65529/10 ; Largest number 65529 - CALL CPDEHL ; Number in range? - JP C,SNERR ; No - ?SN Error - LD H,D ; HL = Number - LD L,E - ADD HL,DE ; Times 2 - ADD HL,HL ; Times 4 - ADD HL,DE ; Times 5 - ADD HL,HL ; Times 10 - POP AF ; Restore digit - SUB '0' ; Make it 0 to 9 - LD E,A ; DE = Value of digit - LD D,0 - ADD HL,DE ; Add to number - EX DE,HL ; Number to DE - POP HL ; Restore code string address - JP GTLNLP ; Go to next character - -CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters - CALL POSINT ; Get integer 0 to 32767 to DE - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - PUSH HL ; Save code string address - LD HL,(LSTRAM) ; Get end of RAM - JP Z,STORED ; No value given - Use stored - POP HL ; Restore code string address - CALL CHKSYN ; Check for comma - DB ',' - PUSH DE ; Save number - CALL POSINT ; Get integer 0 to 32767 - DEC HL ; Cancel increment - CALL GETCHR ; Get next character - JP NZ,SNERR ; ?SN Error if more on line - EX (SP),HL ; Save code string address - EX DE,HL ; Number to DE -STORED: LD A,L ; Get LSB of new RAM top - SUB E ; Subtract LSB of string space - LD E,A ; Save LSB - LD A,H ; Get MSB of new RAM top - SBC A,D ; Subtract MSB of string space - LD D,A ; Save MSB - JP C,OMERR ; ?OM Error if not enough mem - PUSH HL ; Save RAM top - LD HL,(PROGND) ; Get program end - LD BC,40 ; 40 Bytes minimum working RAM - ADD HL,BC ; Get lowest address - CALL CPDEHL ; Enough memory? - JP NC,OMERR ; No - ?OM Error - EX DE,HL ; RAM top to HL - LD (STRSPC),HL ; Set new string space - POP HL ; End of memory to use - LD (LSTRAM),HL ; Set new top of RAM - POP HL ; Restore code string address - JP INTVAR ; Initialise variables - -RUN: JP Z,RUNFST ; RUN from start if just RUN - CALL INTVAR ; Initialise variables - LD BC,RUNCNT ; Execution driver loop - JP RUNLIN ; RUN from line number - -GOSUB: LD C,3 ; 3 Levels of stack needed - CALL CHKSTK ; Check for 3 levels of stack - POP BC ; Get return address - PUSH HL ; Save code string for RETURN - PUSH HL ; And for GOSUB routine - LD HL,(LINEAT) ; Get current line - EX (SP),HL ; Into stack - Code string out - LD A,ZGOSUB ; "GOSUB" token - PUSH AF ; Save token - INC SP ; Don't save flags - -RUNLIN: PUSH BC ; Save return address -GOTO: CALL ATOH ; ASCII number to DE binary - CALL REM ; Get end of line - PUSH HL ; Save end of line - LD HL,(LINEAT) ; Get current line - CALL CPDEHL ; Line after current? - POP HL ; Restore end of line - INC HL ; Start of next line - CALL C,SRCHLP ; Line is after current line - CALL NC,SRCHLN ; Line is before current line - LD H,B ; Set up code string address - LD L,C - DEC HL ; Incremented after - RET C ; Line found -ULERR: LD E,UL ; ?UL Error - JP BERROR ; Output error message - -RETURN: RET NZ ; Return if not just RETURN - LD D,-1 ; Flag "GOSUB" search - CALL BAKSTK ; Look "GOSUB" block - LD SP,HL ; Kill all FORs in subroutine - CP ZGOSUB ; Test for "GOSUB" token - LD E,RG ; ?RG Error - JP NZ,BERROR ; Error if no "GOSUB" found - POP HL ; Get RETURN line number - LD (LINEAT),HL ; Save as current - INC HL ; Was it from direct statement? - LD A,H - OR L ; Return to line - JP NZ,RETLIN ; No - Return to line - LD A,(LSTBIN) ; Any INPUT in subroutine? - OR A ; If so buffer is corrupted - JP NZ,POPNOK ; Yes - Go to command mode -RETLIN: LD HL,RUNCNT ; Execution driver loop - EX (SP),HL ; Into stack - Code string out - DB 3EH ; Skip "POP HL" -NXTDTA: POP HL ; Restore code string address - -DATA: DB 01H,3AH ; ':' End of statement -REM: LD C,0 ; 00 End of statement - LD B,0 -NXTSTL: LD A,C ; Statement and byte - LD C,B - LD B,A ; Statement end byte -NXTSTT: LD A,(HL) ; Get byte - OR A ; End of line? - RET Z ; Yes - Exit - CP B ; End of statement? - RET Z ; Yes - Exit - INC HL ; Next byte - CP '"' ; Literal string? - JP Z,NXTSTL ; Yes - Look for another '"' - JP NXTSTT ; Keep looking - -LET: CALL GETVAR ; Get variable name - CALL CHKSYN ; Make sure "=" follows - DB ZEQUAL ; "=" token - PUSH DE ; Save address of variable - LD A,(TYPE) ; Get data type - PUSH AF ; Save type - CALL EVAL ; Evaluate expression - POP AF ; Restore type - EX (SP),HL ; Save code - Get var addr - LD (BRKLIN),HL ; Save address of variable - RRA ; Adjust type - CALL CHKTYP ; Check types are the same - JP Z,LETNUM ; Numeric - Move value -LETSTR: PUSH HL ; Save address of string var - LD HL,(FPREG) ; Pointer to string entry - PUSH HL ; Save it on stack - INC HL ; Skip over length - INC HL - LD E,(HL) ; LSB of string address - INC HL - LD D,(HL) ; MSB of string address - LD HL,(BASTXT) ; Point to start of program - CALL CPDEHL ; Is string before program? - JP NC,CRESTR ; Yes - Create string entry - LD HL,(STRSPC) ; Point to string space - CALL CPDEHL ; Is string literal in program? - POP DE ; Restore address of string - JP NC,MVSTPT ; Yes - Set up pointer - LD HL,TMPSTR ; Temporary string pool - CALL CPDEHL ; Is string in temporary pool? - JP NC,MVSTPT ; No - Set up pointer - DB 3EH ; Skip "POP DE" -CRESTR: POP DE ; Restore address of string - CALL BAKTMP ; Back to last tmp-str entry - EX DE,HL ; Address of string entry - CALL SAVSTR ; Save string in string area -MVSTPT: CALL BAKTMP ; Back to last tmp-str entry - POP HL ; Get string pointer - CALL DETHL4 ; Move string pointer to var - POP HL ; Restore code string address - RET - -LETNUM: PUSH HL ; Save address of variable - CALL FPTHL ; Move value to variable - POP DE ; Restore address of variable - POP HL ; Restore code string address - RET - -ON: CALL GETINT ; Get integer 0-255 - LD A,(HL) ; Get "GOTO" or "GOSUB" token - LD B,A ; Save in B - CP ZGOSUB ; "GOSUB" token? - JP Z,ONGO ; Yes - Find line number - CALL CHKSYN ; Make sure it's "GOTO" - DB ZGOTO ; "GOTO" token - DEC HL ; Cancel increment -ONGO: LD C,E ; Integer of branch value -ONGOLP: DEC C ; Count branches - LD A,B ; Get "GOTO" or "GOSUB" token - JP Z,ONJMP ; Go to that line if right one - CALL GETLN ; Get line number to DE - CP ',' ; Another line number? - RET NZ ; No - Drop through - JP ONGOLP ; Yes - loop - -IF: CALL EVAL ; Evaluate expression - LD A,(HL) ; Get token - CP ZGOTO ; "GOTO" token? - JP Z,IFGO ; Yes - Get line - CALL CHKSYN ; Make sure it's "THEN" - DB ZTHEN ; "THEN" token - DEC HL ; Cancel increment -IFGO: CALL TSTNUM ; Make sure it's numeric - CALL TSTSGN ; Test state of expression - JP Z,REM ; False - Drop through - CALL GETCHR ; Get next character - JP C,GOTO ; Number - GOTO that line - JP IFJMP ; Otherwise do statement - -MRPRNT: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character -PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT -PRNTLP: RET Z ; End of list - Exit - CP ZTAB ; "TAB(" token? - JP Z,DOTAB ; Yes - Do TAB routine - CP ZSPC ; "SPC(" token? - JP Z,DOTAB ; Yes - Do SPC routine - PUSH HL ; Save code string address - CP ',' ; Comma? - JP Z,DOCOM ; Yes - Move to next zone - CP 59 ;";" ; Semi-colon? - JP Z,NEXITM ; Do semi-colon routine - POP BC ; Code string address to BC - CALL EVAL ; Evaluate expression - PUSH HL ; Save code string address - LD A,(TYPE) ; Get variable type - OR A ; Is it a string variable? - JP NZ,PRNTST ; Yes - Output string contents - CALL NUMASC ; Convert number to text - CALL CRTST ; Create temporary string - LD (HL),' ' ; Followed by a space - LD HL,(FPREG) ; Get length of output - INC (HL) ; Plus 1 for the space - LD HL,(FPREG) ; < Not needed > - LD A,(LWIDTH) ; Get width of line - LD B,A ; To B - INC B ; Width 255 (No limit)? - JP Z,PRNTNB ; Yes - Output number string - INC B ; Adjust it - LD A,(CURPOS) ; Get cursor position - ADD A,(HL) ; Add length of string - DEC A ; Adjust it - CP B ; Will output fit on this line? - CALL NC,PRNTCRLF ; No - CRLF first -PRNTNB: CALL PRS1 ; Output string at (HL) - XOR A ; Skip CALL by setting 'z' flag -PRNTST: CALL NZ,PRS1 ; Output string at (HL) - POP HL ; Restore code string address - JP MRPRNT ; See if more to PRINT - -STTLIN: LD A,(CURPOS) ; Make sure on new line - OR A ; Already at start? - RET Z ; Yes - Do nothing - JP PRNTCRLF ; Start a new line - -ENDINP: LD (HL),0 ; Mark end of buffer - LD HL,BUFFER-1 ; Point to buffer -PRNTCRLF:LD A,CR ; Load a CR - CALL OUTC ; Output character - LD A,LF ; Load a LF - CALL OUTC ; Output character -DONULL: XOR A ; Set to position 0 - LD (CURPOS),A ; Store it - LD A,(NULLS) ; Get number of nulls -NULLP: DEC A ; Count them - RET Z ; Return if done - PUSH AF ; Save count - XOR A ; Load a null - CALL OUTC ; Output it - POP AF ; Restore count - JP NULLP ; Keep counting - -DOCOM: LD A,(COMMAN) ; Get comma width - LD B,A ; Save in B - LD A,(CURPOS) ; Get current position - CP B ; Within the limit? - CALL NC,PRNTCRLF ; No - output CRLF - JP NC,NEXITM ; Get next item -ZONELP: SUB 14 ; Next zone of 14 characters - JP NC,ZONELP ; Repeat if more zones - CPL ; Number of spaces to output - JP ASPCS ; Output them - -DOTAB: PUSH AF ; Save token - CALL FNDNUM ; Evaluate expression - CALL CHKSYN ; Make sure ")" follows - DB ")" - DEC HL ; Back space on to ")" - POP AF ; Restore token - SUB ZSPC ; Was it "SPC(" ? - PUSH HL ; Save code string address - JP Z,DOSPC ; Yes - Do 'E' spaces - LD A,(CURPOS) ; Get current position -DOSPC: CPL ; Number of spaces to print to - ADD A,E ; Total number to print - JP NC,NEXITM ; TAB < Current POS(X) -ASPCS: INC A ; Output A spaces - LD B,A ; Save number to print - LD A,' ' ; Space -SPCLP: CALL OUTC ; Output character in A - DEC B ; Count them - JP NZ,SPCLP ; Repeat if more -NEXITM: POP HL ; Restore code string address - CALL GETCHR ; Get next character - JP PRNTLP ; More to print - -REDO: DB "?Redo from start",CR,LF,0 - -BADINP: LD A,(READFG) ; READ or INPUT? - OR A - JP NZ,DATSNR ; READ - ?SN Error - POP BC ; Throw away code string addr - LD HL,REDO ; "Redo from start" message - CALL PRS ; Output string - JP DOAGN ; Do last INPUT again - -INPUT: CALL IDTEST ; Test for illegal direct - LD A,(HL) ; Get character after "INPUT" - CP '"' ; Is there a prompt string? - LD A,0 ; Clear A and leave flags - LD (CTLOFG),A ; Enable output - JP NZ,NOPMPT ; No prompt - get input - CALL QTSTR ; Get string terminated by '"' - CALL CHKSYN ; Check for ';' after prompt - DB ';' - PUSH HL ; Save code string address - CALL PRS1 ; Output prompt string - DB 3EH ; Skip "PUSH HL" -NOPMPT: PUSH HL ; Save code string address - CALL PROMPT ; Get input with "? " prompt - POP BC ; Restore code string address - JP C,INPBRK ; Break pressed - Exit - INC HL ; Next byte - LD A,(HL) ; Get it - OR A ; End of line? - DEC HL ; Back again - PUSH BC ; Re-save code string address - JP Z,NXTDTA ; Yes - Find next DATA stmt - LD (HL),',' ; Store comma as separator - JP NXTITM ; Get next item - -READ: PUSH HL ; Save code string address - LD HL,(NXTDAT) ; Next DATA statement - DB 0F6H ; Flag "READ" -NXTITM: XOR A ; Flag "INPUT" - LD (READFG),A ; Save "READ"/"INPUT" flag - EX (SP),HL ; Get code str' , Save pointer - JP GTVLUS ; Get values - -NEDMOR: CALL CHKSYN ; Check for comma between items - DB ',' -GTVLUS: CALL GETVAR ; Get variable name - EX (SP),HL ; Save code str" , Get pointer - PUSH DE ; Save variable address - LD A,(HL) ; Get next "INPUT"/"DATA" byte - CP ',' ; Comma? - JP Z,ANTVLU ; Yes - Get another value - LD A,(READFG) ; Is it READ? - OR A - JP NZ,FDTLP ; Yes - Find next DATA stmt - LD A,'?' ; More INPUT needed - CALL OUTC ; Output character - CALL PROMPT ; Get INPUT with prompt - POP DE ; Variable address - POP BC ; Code string address - JP C,INPBRK ; Break pressed - INC HL ; Point to next DATA byte - LD A,(HL) ; Get byte - OR A ; Is it zero (No input) ? - DEC HL ; Back space INPUT pointer - PUSH BC ; Save code string address - JP Z,NXTDTA ; Find end of buffer - PUSH DE ; Save variable address -ANTVLU: LD A,(TYPE) ; Check data type - OR A ; Is it numeric? - JP Z,INPBIN ; Yes - Convert to binary - CALL GETCHR ; Get next character - LD D,A ; Save input character - LD B,A ; Again - CP '"' ; Start of literal sting? - JP Z,STRENT ; Yes - Create string entry - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - LD D,A ; Save 00 if "INPUT" - JP Z,ITMSEP ; "INPUT" - End with 00 - LD D,':' ; "DATA" - End with 00 or ':' -ITMSEP: LD B,',' ; Item separator - DEC HL ; Back space for DTSTR -STRENT: CALL DTSTR ; Get string terminated by D - EX DE,HL ; String address to DE - LD HL,LTSTND ; Where to go after LETSTR - EX (SP),HL ; Save HL , get input pointer - PUSH DE ; Save address of string - JP LETSTR ; Assign string to variable - -INPBIN: CALL GETCHR ; Get next character - CALL ASCTFP ; Convert ASCII to FP number - EX (SP),HL ; Save input ptr, Get var addr - CALL FPTHL ; Move FPREG to variable - POP HL ; Restore input pointer -LTSTND: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,MORDT ; End of line - More needed? - CP ',' ; Another value? - JP NZ,BADINP ; No - Bad input -MORDT: EX (SP),HL ; Get code string address - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,NEDMOR ; More needed - Get it - POP DE ; Restore DATA pointer - LD A,(READFG) ; "READ" or "INPUT" ? - OR A - EX DE,HL ; DATA pointer to HL - JP NZ,UPDATA ; Update DATA pointer if "READ" - PUSH DE ; Save code string address - OR (HL) ; More input given? - LD HL,EXTIG ; "?Extra ignored" message - CALL NZ,PRS ; Output string if extra given - POP HL ; Restore code string address - RET - -EXTIG: DB "?Extra ignored",CR,LF,0 - -FDTLP: CALL DATA ; Get next statement - OR A ; End of line? - JP NZ,FANDT ; No - See if DATA statement - INC HL - LD A,(HL) ; End of program? - INC HL - OR (HL) ; 00 00 Ends program - LD E,OD ; ?OD Error - JP Z,BERROR ; Yes - Out of DATA - INC HL - LD E,(HL) ; LSB of line number - INC HL - LD D,(HL) ; MSB of line number - EX DE,HL - LD (DATLIN),HL ; Set line of current DATA item - EX DE,HL -FANDT: CALL GETCHR ; Get next character - CP ZDATA ; "DATA" token - JP NZ,FDTLP ; No "DATA" - Keep looking - JP ANTVLU ; Found - Convert input - -NEXT: LD DE,0 ; In case no index given -NEXT1: CALL NZ,GETVAR ; Get index address - LD (BRKLIN),HL ; Save code string address - CALL BAKSTK ; Look for "FOR" block - JP NZ,NFERR ; No "FOR" - ?NF Error - LD SP,HL ; Clear nested loops - PUSH DE ; Save index address - LD A,(HL) ; Get sign of STEP - INC HL - PUSH AF ; Save sign of STEP - PUSH DE ; Save index address - CALL PHLTFP ; Move index value to FPREG - EX (SP),HL ; Save address of TO value - PUSH HL ; Save address of index - CALL ADDPHL ; Add STEP to index value - POP HL ; Restore address of index - CALL FPTHL ; Move value to index variable - POP HL ; Restore address of TO value - CALL LOADFP ; Move TO value to BCDE - PUSH HL ; Save address of line of FOR - CALL CMPNUM ; Compare index with TO value - POP HL ; Restore address of line num - POP BC ; Address of sign of STEP - SUB B ; Compare with expected sign - CALL LOADFP ; BC = Loop stmt,DE = Line num - JP Z,KILFOR ; Loop finished - Terminate it - EX DE,HL ; Loop statement line number - LD (LINEAT),HL ; Set loop line number - LD L,C ; Set code string to loop - LD H,B - JP PUTFID ; Put back "FOR" and continue - -KILFOR: LD SP,HL ; Remove "FOR" block - LD HL,(BRKLIN) ; Code string after "NEXT" - LD A,(HL) ; Get next byte in code string - CP ',' ; More NEXTs ? - JP NZ,RUNCNT ; No - Do next statement - CALL GETCHR ; Position to index name - CALL NEXT1 ; Re-enter NEXT routine -; < will not RETurn to here , Exit to RUNCNT or Loop > - -GETNUM: CALL EVAL ; Get a numeric expression -TSTNUM: DB 0F6H ; Clear carry (numeric) -TSTSTR: SCF ; Set carry (string) -CHKTYP: LD A,(TYPE) ; Check types match - ADC A,A ; Expected + actual - OR A ; Clear carry , set parity - RET PE ; Even parity - Types match - JP TMERR ; Different types - Error - -OPNPAR: CALL CHKSYN ; Make sure "(" follows - DB "(" -EVAL: DEC HL ; Evaluate expression & save - LD D,0 ; Precedence value -EVAL1: PUSH DE ; Save precedence - LD C,1 - CALL CHKSTK ; Check for 1 level of stack - CALL OPRND ; Get next expression value -EVAL2: LD (NXTOPR),HL ; Save address of next operator -EVAL3: LD HL,(NXTOPR) ; Restore address of next opr - POP BC ; Precedence value and operator - LD A,B ; Get precedence value - CP 78H ; "AND" or "OR" ? - CALL NC,TSTNUM ; No - Make sure it's a number - LD A,(HL) ; Get next operator / function - LD D,0 ; Clear Last relation -RLTLP: SUB ZGTR ; ">" Token - JP C,FOPRND ; + - * / ^ AND OR - Test it - CP ZLTH+1-ZGTR ; < = > - JP NC,FOPRND ; Function - Call it - CP ZEQUAL-ZGTR ; "=" - RLA ; <- Test for legal - XOR D ; <- combinations of < = > - CP D ; <- by combining last token - LD D,A ; <- with current one - JP C,SNERR ; Error if "<<' '==" or ">>" - LD (CUROPR),HL ; Save address of current token - CALL GETCHR ; Get next character - JP RLTLP ; Treat the two as one - -FOPRND: LD A,D ; < = > found ? - OR A - JP NZ,TSTRED ; Yes - Test for reduction - LD A,(HL) ; Get operator token - LD (CUROPR),HL ; Save operator address - SUB ZPLUS ; Operator or function? - RET C ; Neither - Exit - CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? - RET NC ; No - Exit - LD E,A ; Coded operator - LD A,(TYPE) ; Get data type - DEC A ; FF = numeric , 00 = string - OR E ; Combine with coded operator - LD A,E ; Get coded operator - JP Z,CONCAT ; String concatenation - RLCA ; Times 2 - ADD A,E ; Times 3 - LD E,A ; To DE (D is 0) - LD HL,PRITAB ; Precedence table - ADD HL,DE ; To the operator concerned - LD A,B ; Last operator precedence - LD D,(HL) ; Get evaluation precedence - CP D ; Compare with eval precedence - RET NC ; Exit if higher precedence - INC HL ; Point to routine address - CALL TSTNUM ; Make sure it's a number - -STKTHS: PUSH BC ; Save last precedence & token - LD BC,EVAL3 ; Where to go on prec' break - PUSH BC ; Save on stack for return - LD B,E ; Save operator - LD C,D ; Save precedence - CALL STAKFP ; Move value to stack - LD E,B ; Restore operator - LD D,C ; Restore precedence - LD C,(HL) ; Get LSB of routine address - INC HL - LD B,(HL) ; Get MSB of routine address - INC HL - PUSH BC ; Save routine address - LD HL,(CUROPR) ; Address of current operator - JP EVAL1 ; Loop until prec' break - -OPRND: XOR A ; Get operand routine - LD (TYPE),A ; Set numeric expected - CALL GETCHR ; Get next character - LD E,MO ; ?MO Error - JP Z,BERROR ; No operand - Error - JP C,ASCTFP ; Number - Get value - CALL CHKLTR ; See if a letter - JP NC,CONVAR ; Letter - Find variable - CP '&' ; &H = HEX, &B = BINARY [G. Searle] - JR NZ, NOTAMP - CALL GETCHR ; Get next character - CP 'H' ; Hex number indicated? [function added] - JP Z,HEXTFP ; Convert Hex to FPREG - CP 'B' ; Binary number indicated? [function added] - JP Z,BINTFP ; Convert Bin to FPREG - LD E,SN ; If neither then a ?SN Error - JP Z,BERROR ; -NOTAMP: CP ZPLUS ; '+' Token ? - JP Z,OPRND ; Yes - Look for operand - CP '.' ; '.' ? - JP Z,ASCTFP ; Yes - Create FP number - CP ZMINUS ; '-' Token ? - JP Z,MINUS ; Yes - Do minus - CP '"' ; Literal string ? - JP Z,QTSTR ; Get string terminated by '"' - CP ZNOT ; "NOT" Token ? - JP Z,EVNOT ; Yes - Eval NOT expression - CP ZFN ; "FN" Token ? - JP Z,DOFN ; Yes - Do FN routine - SUB ZSGN ; Is it a function? - JP NC,FNOFST ; Yes - Evaluate function -EVLPAR: CALL OPNPAR ; Evaluate expression in "()" - CALL CHKSYN ; Make sure ")" follows - DB ")" - RET - -MINUS: LD D,7DH ; '-' precedence - CALL EVAL1 ; Evaluate until prec' break - LD HL,(NXTOPR) ; Get next operator address - PUSH HL ; Save next operator address - CALL INVSGN ; Negate value -RETNUM: CALL TSTNUM ; Make sure it's a number - POP HL ; Restore next operator address - RET - -CONVAR: CALL GETVAR ; Get variable address to DE -FRMEVL: PUSH HL ; Save code string address - EX DE,HL ; Variable address to HL - LD (FPREG),HL ; Save address of variable - LD A,(TYPE) ; Get type - OR A ; Numeric? - CALL Z,PHLTFP ; Yes - Move contents to FPREG - POP HL ; Restore code string address - RET - -FNOFST: LD B,0 ; Get address of function - RLCA ; Double function offset - LD C,A ; BC = Offset in function table - PUSH BC ; Save adjusted token value - CALL GETCHR ; Get next character - LD A,C ; Get adjusted token value - CP 2*(ZLEFT-ZSGN)-1 ; Adj' LEFT$,RIGHT$ or MID$ ? - JP C,FNVAL ; No - Do function - CALL OPNPAR ; Evaluate expression (X,... - CALL CHKSYN ; Make sure ',' follows - DB ',' - CALL TSTSTR ; Make sure it's a string - EX DE,HL ; Save code string address - LD HL,(FPREG) ; Get address of string - EX (SP),HL ; Save address of string - PUSH HL ; Save adjusted token value - EX DE,HL ; Restore code string address - CALL GETINT ; Get integer 0-255 - EX DE,HL ; Save code string address - EX (SP),HL ; Save integer,HL = adj' token - JP GOFUNC ; Jump to string function - -FNVAL: CALL EVLPAR ; Evaluate expression - EX (SP),HL ; HL = Adjusted token value - LD DE,RETNUM ; Return number from function - PUSH DE ; Save on stack -GOFUNC: LD BC,FNCTAB ; Function routine addresses - ADD HL,BC ; Point to right address - LD C,(HL) ; Get LSB of address - INC HL ; - LD H,(HL) ; Get MSB of address - LD L,C ; Address to HL - JP (HL) ; Jump to function - -SGNEXP: DEC D ; Dee to flag negative exponent - CP ZMINUS ; '-' token ? - RET Z ; Yes - Return - CP '-' ; '-' ASCII ? - RET Z ; Yes - Return - INC D ; Inc to flag positive exponent - CP '+' ; '+' ASCII ? - RET Z ; Yes - Return - CP ZPLUS ; '+' token ? - RET Z ; Yes - Return - DEC HL ; DEC 'cos GETCHR INCs - RET ; Return "NZ" - -POR: DB 0F6H ; Flag "OR" -PAND: XOR A ; Flag "AND" - PUSH AF ; Save "AND" / "OR" flag - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - EX DE,HL ; <- Get last - POP BC ; <- value - EX (SP),HL ; <- from - EX DE,HL ; <- stack - CALL FPBCDE ; Move last value to FPREG - PUSH AF ; Save "AND" / "OR" flag - CALL DEINT ; Get integer -32768 to 32767 - POP AF ; Restore "AND" / "OR" flag - POP BC ; Get value - LD A,C ; Get LSB - LD HL,ACPASS ; Address of save AC as current - JP NZ,POR1 ; Jump if OR - AND E ; "AND" LSBs - LD C,A ; Save LSB - LD A,B ; Get MBS - AND D ; "AND" MSBs - JP (HL) ; Save AC as current (ACPASS) - -POR1: OR E ; "OR" LSBs - LD C,A ; Save LSB - LD A,B ; Get MSB - OR D ; "OR" MSBs - JP (HL) ; Save AC as current (ACPASS) - -TSTRED: LD HL,CMPLOG ; Logical compare routine - LD A,(TYPE) ; Get data type - RRA ; Carry set = string - LD A,D ; Get last precedence value - RLA ; Times 2 plus carry - LD E,A ; To E - LD D,64H ; Relational precedence - LD A,B ; Get current precedence - CP D ; Compare with last - RET NC ; Eval if last was rel' or log' - JP STKTHS ; Stack this one and get next - -CMPLOG: DW CMPLG1 ; Compare two values / strings -CMPLG1: LD A,C ; Get data type - OR A - RRA - POP BC ; Get last expression to BCDE - POP DE - PUSH AF ; Save status - CALL CHKTYP ; Check that types match - LD HL,CMPRES ; Result to comparison - PUSH HL ; Save for RETurn - JP Z,CMPNUM ; Compare values if numeric - XOR A ; Compare two strings - LD (TYPE),A ; Set type to numeric - PUSH DE ; Save string name - CALL GSTRCU ; Get current string - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - POP DE ; Restore string name - PUSH BC ; Save address of string - PUSH AF ; Save length of string - CALL GSTRDE ; Get second string - CALL LOADFP ; Get address of second string - POP AF ; Restore length of string 1 - LD D,A ; Length to D - POP HL ; Restore address of string 1 -CMPSTR: LD A,E ; Bytes of string 2 to do - OR D ; Bytes of string 1 to do - RET Z ; Exit if all bytes compared - LD A,D ; Get bytes of string 1 to do - SUB 1 - RET C ; Exit if end of string 1 - XOR A - CP E ; Bytes of string 2 to do - INC A - RET NC ; Exit if end of string 2 - DEC D ; Count bytes in string 1 - DEC E ; Count bytes in string 2 - LD A,(BC) ; Byte in string 2 - CP (HL) ; Compare to byte in string 1 - INC HL ; Move up string 1 - INC BC ; Move up string 2 - JP Z,CMPSTR ; Same - Try next bytes - CCF ; Flag difference (">" or "<") - JP FLGDIF ; "<" gives -1 , ">" gives +1 - -CMPRES: INC A ; Increment current value - ADC A,A ; Double plus carry - POP BC ; Get other value - AND B ; Combine them - ADD A,-1 ; Carry set if different - SBC A,A ; 00 - Equal , FF - Different - JP FLGREL ; Set current value & continue - -EVNOT: LD D,5AH ; Precedence value for "NOT" - CALL EVAL1 ; Eval until precedence break - CALL TSTNUM ; Make sure it's a number - CALL DEINT ; Get integer -32768 - 32767 - LD A,E ; Get LSB - CPL ; Invert LSB - LD C,A ; Save "NOT" of LSB - LD A,D ; Get MSB - CPL ; Invert MSB - CALL ACPASS ; Save AC as current - POP BC ; Clean up stack - JP EVAL3 ; Continue evaluation - -DIMRET: DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - RET Z ; End of DIM statement - CALL CHKSYN ; Make sure ',' follows - DB ',' -DIM: LD BC,DIMRET ; Return to "DIMRET" - PUSH BC ; Save on stack - DB 0F6H ; Flag "Create" variable -GETVAR: XOR A ; Find variable address,to DE - LD (LCRFLG),A ; Set locate / create flag - LD B,(HL) ; Get First byte of name -GTFNAM: CALL CHKLTR ; See if a letter - JP C,SNERR ; ?SN Error if not a letter - XOR A - LD C,A ; Clear second byte of name - LD (TYPE),A ; Set type to numeric - CALL GETCHR ; Get next character - JP C,SVNAM2 ; Numeric - Save in name - CALL CHKLTR ; See if a letter - JP C,CHARTY ; Not a letter - Check type -SVNAM2: LD C,A ; Save second byte of name -ENDNAM: CALL GETCHR ; Get next character - JP C,ENDNAM ; Numeric - Get another - CALL CHKLTR ; See if a letter - JP NC,ENDNAM ; Letter - Get another -CHARTY: SUB '$' ; String variable? - JP NZ,NOTSTR ; No - Numeric variable - INC A ; A = 1 (string type) - LD (TYPE),A ; Set type to string - RRCA ; A = 80H , Flag for string - ADD A,C ; 2nd byte of name has bit 7 on - LD C,A ; Resave second byte on name - CALL GETCHR ; Get next character -NOTSTR: LD A,(FORFLG) ; Array name needed ? - DEC A - JP Z,ARLDSV ; Yes - Get array name - JP P,NSCFOR ; No array with "FOR" or "FN" - LD A,(HL) ; Get byte again - SUB '(' ; Subscripted variable? - JP Z,SBSCPT ; Yes - Sort out subscript - -NSCFOR: XOR A ; Simple variable - LD (FORFLG),A ; Clear "FOR" flag - PUSH HL ; Save code string address - LD D,B ; DE = Variable name to find - LD E,C - LD HL,(FNRGNM) ; FN argument name - CALL CPDEHL ; Is it the FN argument? - LD DE,FNARG ; Point to argument value - JP Z,POPHRT ; Yes - Return FN argument value - LD HL,(VAREND) ; End of variables - EX DE,HL ; Address of end of search - LD HL,(PROGND) ; Start of variables address -FNDVAR: CALL CPDEHL ; End of variable list table? - JP Z,CFEVAL ; Yes - Called from EVAL? - LD A,C ; Get second byte of name - SUB (HL) ; Compare with name in list - INC HL ; Move on to first byte - JP NZ,FNTHR ; Different - Find another - LD A,B ; Get first byte of name - SUB (HL) ; Compare with name in list -FNTHR: INC HL ; Move on to LSB of value - JP Z,RETADR ; Found - Return address - INC HL ; <- Skip - INC HL ; <- over - INC HL ; <- F.P. - INC HL ; <- value - JP FNDVAR ; Keep looking - -CFEVAL: POP HL ; Restore code string address - EX (SP),HL ; Get return address - PUSH DE ; Save address of variable - LD DE,FRMEVL ; Return address in EVAL - CALL CPDEHL ; Called from EVAL ? - POP DE ; Restore address of variable - JP Z,RETNUL ; Yes - Return null variable - EX (SP),HL ; Put back return - PUSH HL ; Save code string address - PUSH BC ; Save variable name - LD BC,6 ; 2 byte name plus 4 byte data - LD HL,(ARREND) ; End of arrays - PUSH HL ; Save end of arrays - ADD HL,BC ; Move up 6 bytes - POP BC ; Source address in BC - PUSH HL ; Save new end address - CALL MOVUP ; Move arrays up - POP HL ; Restore new end address - LD (ARREND),HL ; Set new end address - LD H,B ; End of variables to HL - LD L,C - LD (VAREND),HL ; Set new end address - -ZEROLP: DEC HL ; Back through to zero variable - LD (HL),0 ; Zero byte in variable - CALL CPDEHL ; Done them all? - JP NZ,ZEROLP ; No - Keep on going - POP DE ; Get variable name - LD (HL),E ; Store second character - INC HL - LD (HL),D ; Store first character - INC HL -RETADR: EX DE,HL ; Address of variable in DE - POP HL ; Restore code string address - RET - -RETNUL: LD (FPEXP),A ; Set result to zero - LD HL,ZERBYT ; Also set a null string - LD (FPREG),HL ; Save for EVAL - POP HL ; Restore code string address - RET - -SBSCPT: PUSH HL ; Save code string address - LD HL,(LCRFLG) ; Locate/Create and Type - EX (SP),HL ; Save and get code string - LD D,A ; Zero number of dimensions -SCPTLP: PUSH DE ; Save number of dimensions - PUSH BC ; Save array name - CALL FPSINT ; Get subscript (0-32767) - POP BC ; Restore array name - POP AF ; Get number of dimensions - EX DE,HL - EX (SP),HL ; Save subscript value - PUSH HL ; Save LCRFLG and TYPE - EX DE,HL - INC A ; Count dimensions - LD D,A ; Save in D - LD A,(HL) ; Get next byte in code string - CP ',' ; Comma (more to come)? - JP Z,SCPTLP ; Yes - More subscripts - CALL CHKSYN ; Make sure ")" follows - DB ")" - LD (NXTOPR),HL ; Save code string address - POP HL ; Get LCRFLG and TYPE - LD (LCRFLG),HL ; Restore Locate/create & type - LD E,0 ; Flag not CSAVE* or CLOAD* - PUSH DE ; Save number of dimensions (D) - DB 11H ; Skip "PUSH HL" and "PUSH AF' - -ARLDSV: PUSH HL ; Save code string address - PUSH AF ; A = 00 , Flags set = Z,N - LD HL,(VAREND) ; Start of arrays - DB 3EH ; Skip "ADD HL,DE" -FNDARY: ADD HL,DE ; Move to next array start - EX DE,HL - LD HL,(ARREND) ; End of arrays - EX DE,HL ; Current array pointer - CALL CPDEHL ; End of arrays found? - JP Z,CREARY ; Yes - Create array - LD A,(HL) ; Get second byte of name - CP C ; Compare with name given - INC HL ; Move on - JP NZ,NXTARY ; Different - Find next array - LD A,(HL) ; Get first byte of name - CP B ; Compare with name given -NXTARY: INC HL ; Move on - LD E,(HL) ; Get LSB of next array address - INC HL - LD D,(HL) ; Get MSB of next array address - INC HL - JP NZ,FNDARY ; Not found - Keep looking - LD A,(LCRFLG) ; Found Locate or Create it? - OR A - JP NZ,DDERR ; Create - ?DD Error - POP AF ; Locate - Get number of dim'ns - LD B,H ; BC Points to array dim'ns - LD C,L - JP Z,POPHRT ; Jump if array load/save - SUB (HL) ; Same number of dimensions? - JP Z,FINDEL ; Yes - Find element -BSERR: LD E,BS ; ?BS Error - JP BERROR ; Output error - -CREARY: LD DE,4 ; 4 Bytes per entry - POP AF ; Array to save or 0 dim'ns? - JP Z,FCERR ; Yes - ?FC Error - LD (HL),C ; Save second byte of name - INC HL - LD (HL),B ; Save first byte of name - INC HL - LD C,A ; Number of dimensions to C - CALL CHKSTK ; Check if enough memory - INC HL ; Point to number of dimensions - INC HL - LD (CUROPR),HL ; Save address of pointer - LD (HL),C ; Set number of dimensions - INC HL - LD A,(LCRFLG) ; Locate of Create? - RLA ; Carry set = Create - LD A,C ; Get number of dimensions -CRARLP: LD BC,10+1 ; Default dimension size 10 - JP NC,DEFSIZ ; Locate - Set default size - POP BC ; Get specified dimension size - INC BC ; Include zero element -DEFSIZ: LD (HL),C ; Save LSB of dimension size - INC HL - LD (HL),B ; Save MSB of dimension size - INC HL - PUSH AF ; Save num' of dim'ns an status - PUSH HL ; Save address of dim'n size - CALL MLDEBC ; Multiply DE by BC to find - EX DE,HL ; amount of mem needed (to DE) - POP HL ; Restore address of dimension - POP AF ; Restore number of dimensions - DEC A ; Count them - JP NZ,CRARLP ; Do next dimension if more - PUSH AF ; Save locate/create flag - LD B,D ; MSB of memory needed - LD C,E ; LSB of memory needed - EX DE,HL - ADD HL,DE ; Add bytes to array start - JP C,OMERR ; Too big - Error - CALL ENFMEM ; See if enough memory - LD (ARREND),HL ; Save new end of array - -ZERARY: DEC HL ; Back through array data - LD (HL),0 ; Set array element to zero - CALL CPDEHL ; All elements zeroed? - JP NZ,ZERARY ; No - Keep on going - INC BC ; Number of bytes + 1 - LD D,A ; A=0 - LD HL,(CUROPR) ; Get address of array - LD E,(HL) ; Number of dimensions - EX DE,HL ; To HL - ADD HL,HL ; Two bytes per dimension size - ADD HL,BC ; Add number of bytes - EX DE,HL ; Bytes needed to DE - DEC HL - DEC HL - LD (HL),E ; Save LSB of bytes needed - INC HL - LD (HL),D ; Save MSB of bytes needed - INC HL - POP AF ; Locate / Create? - JP C,ENDDIM ; A is 0 , End if create -FINDEL: LD B,A ; Find array element - LD C,A - LD A,(HL) ; Number of dimensions - INC HL - DB 16H ; Skip "POP HL" -FNDELP: POP HL ; Address of next dim' size - LD E,(HL) ; Get LSB of dim'n size - INC HL - LD D,(HL) ; Get MSB of dim'n size - INC HL - EX (SP),HL ; Save address - Get index - PUSH AF ; Save number of dim'ns - CALL CPDEHL ; Dimension too large? - JP NC,BSERR ; Yes - ?BS Error - PUSH HL ; Save index - CALL MLDEBC ; Multiply previous by size - POP DE ; Index supplied to DE - ADD HL,DE ; Add index to pointer - POP AF ; Number of dimensions - DEC A ; Count them - LD B,H ; MSB of pointer - LD C,L ; LSB of pointer - JP NZ,FNDELP ; More - Keep going - ADD HL,HL ; 4 Bytes per element - ADD HL,HL - POP BC ; Start of array - ADD HL,BC ; Point to element - EX DE,HL ; Address of element to DE -ENDDIM: LD HL,(NXTOPR) ; Got code string address - RET - -FRE: LD HL,(ARREND) ; Start of free memory - EX DE,HL ; To DE - LD HL,0 ; End of free memory - ADD HL,SP ; Current stack value - LD A,(TYPE) ; Dummy argument type - OR A - JP Z,FRENUM ; Numeric - Free variable space - CALL GSTRCU ; Current string to pool - CALL GARBGE ; Garbage collection - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string space -FRENUM: LD A,L ; Get LSB of end - SUB E ; Subtract LSB of beginning - LD C,A ; Save difference if C - LD A,H ; Get MSB of end - SBC A,D ; Subtract MSB of beginning -ACPASS: LD B,C ; Return integer AC -ABPASS: LD D,B ; Return integer AB - LD E,0 - LD HL,TYPE ; Point to type - LD (HL),E ; Set type to numeric - LD B,80H+16 ; 16 bit integer - JP RETINT ; Return the integr - -POS: LD A,(CURPOS) ; Get cursor position -PASSA: LD B,A ; Put A into AB - XOR A ; Zero A - JP ABPASS ; Return integer AB - -DEF: CALL CHEKFN ; Get "FN" and name - CALL IDTEST ; Test for illegal direct - LD BC,DATA ; To get next statement - PUSH BC ; Save address for RETurn - PUSH DE ; Save address of function ptr - CALL CHKSYN ; Make sure "(" follows - DB "(" - CALL GETVAR ; Get argument variable name - PUSH HL ; Save code string address - EX DE,HL ; Argument address to HL - DEC HL - LD D,(HL) ; Get first byte of arg name - DEC HL - LD E,(HL) ; Get second byte of arg name - POP HL ; Restore code string address - CALL TSTNUM ; Make sure numeric argument - CALL CHKSYN ; Make sure ")" follows - DB ")" - CALL CHKSYN ; Make sure "=" follows - DB ZEQUAL ; "=" token - LD B,H ; Code string address to BC - LD C,L - EX (SP),HL ; Save code str , Get FN ptr - LD (HL),C ; Save LSB of FN code string - INC HL - LD (HL),B ; Save MSB of FN code string - JP SVSTAD ; Save address and do function - -DOFN: CALL CHEKFN ; Make sure FN follows - PUSH DE ; Save function pointer address - CALL EVLPAR ; Evaluate expression in "()" - CALL TSTNUM ; Make sure numeric result - EX (SP),HL ; Save code str , Get FN ptr - LD E,(HL) ; Get LSB of FN code string - INC HL - LD D,(HL) ; Get MSB of FN code string - INC HL - LD A,D ; And function DEFined? - OR E - JP Z,UFERR ; No - ?UF Error - LD A,(HL) ; Get LSB of argument address - INC HL - LD H,(HL) ; Get MSB of argument address - LD L,A ; HL = Arg variable address - PUSH HL ; Save it - LD HL,(FNRGNM) ; Get old argument name - EX (SP),HL ; ; Save old , Get new - LD (FNRGNM),HL ; Set new argument name - LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value - PUSH HL ; Save it - LD HL,(FNARG) ; Get MSB,EXP of old arg value - PUSH HL ; Save it - LD HL,FNARG ; HL = Value of argument - PUSH DE ; Save FN code string address - CALL FPTHL ; Move FPREG to argument - POP HL ; Get FN code string address - CALL GETNUM ; Get value from function - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP NZ,SNERR ; Bad character in FN - Error - POP HL ; Get MSB,EXP of old arg - LD (FNARG),HL ; Restore it - POP HL ; Get LSB,NLSB of old arg - LD (FNARG+2),HL ; Restore it - POP HL ; Get name of old arg - LD (FNRGNM),HL ; Restore it - POP HL ; Restore code string address - RET - -IDTEST: PUSH HL ; Save code string address - LD HL,(LINEAT) ; Get current line number - INC HL ; -1 means direct statement - LD A,H - OR L - POP HL ; Restore code string address - RET NZ ; Return if in program - LD E,ID ; ?ID Error - JP BERROR - -CHEKFN: CALL CHKSYN ; Make sure FN follows - DB ZFN ; "FN" token - LD A,80H - LD (FORFLG),A ; Flag FN name to find - OR (HL) ; FN name has bit 7 set - LD B,A ; in first byte of name - CALL GTFNAM ; Get FN name - JP TSTNUM ; Make sure numeric function - -STR: CALL TSTNUM ; Make sure it's a number - CALL NUMASC ; Turn number into text -STR1: CALL CRTST ; Create string entry for it - CALL GSTRCU ; Current string to pool - LD BC,TOPOOL ; Save in string pool - PUSH BC ; Save address on stack - -SAVSTR: LD A,(HL) ; Get string length - INC HL - INC HL - PUSH HL ; Save pointer to string - CALL TESTR ; See if enough string space - POP HL ; Restore pointer to string - LD C,(HL) ; Get LSB of address - INC HL - LD B,(HL) ; Get MSB of address - CALL CRTMST ; Create string entry - PUSH HL ; Save pointer to MSB of addr - LD L,A ; Length of string - CALL TOSTRA ; Move to string area - POP DE ; Restore pointer to MSB - RET - -MKTMST: CALL TESTR ; See if enough string space -CRTMST: LD HL,TMPSTR ; Temporary string - PUSH HL ; Save it - LD (HL),A ; Save length of string - INC HL -SVSTAD: INC HL - LD (HL),E ; Save LSB of address - INC HL - LD (HL),D ; Save MSB of address - POP HL ; Restore pointer - RET - -CRTST: DEC HL ; DEC - INCed after -QTSTR: LD B,'"' ; Terminating quote - LD D,B ; Quote to D -DTSTR: PUSH HL ; Save start - LD C,-1 ; Set counter to -1 -QTSTLP: INC HL ; Move on - LD A,(HL) ; Get byte - INC C ; Count bytes - OR A ; End of line? - JP Z,CRTSTE ; Yes - Create string entry - CP D ; Terminator D found? - JP Z,CRTSTE ; Yes - Create string entry - CP B ; Terminator B found? - JP NZ,QTSTLP ; No - Keep looking -CRTSTE: CP '"' ; End with '"'? - CALL Z,GETCHR ; Yes - Get next character - EX (SP),HL ; Starting quote - INC HL ; First byte of string - EX DE,HL ; To DE - LD A,C ; Get length - CALL CRTMST ; Create string entry -TSTOPL: LD DE,TMPSTR ; Temporary string - LD HL,(TMSTPT) ; Temporary string pool pointer - LD (FPREG),HL ; Save address of string ptr - LD A,1 - LD (TYPE),A ; Set type to string - CALL DETHL4 ; Move string to pool - CALL CPDEHL ; Out of string pool? - LD (TMSTPT),HL ; Save new pointer - POP HL ; Restore code string address - LD A,(HL) ; Get next code byte - RET NZ ; Return if pool OK - LD E,ST ; ?ST Error - JP BERROR ; String pool overflow - -PRNUMS: INC HL ; Skip leading space -PRS: CALL CRTST ; Create string entry for it -PRS1: CALL GSTRCU ; Current string to pool - CALL LOADFP ; Move string block to BCDE - INC E ; Length + 1 -PRSLP: DEC E ; Count characters - RET Z ; End of string - LD A,(BC) ; Get byte to output - CALL OUTC ; Output character in A - CP CR ; Return? - CALL Z,DONULL ; Yes - Do nulls - INC BC ; Next byte in string - JP PRSLP ; More characters to output - -TESTR: OR A ; Test if enough room - DB 0EH ; No garbage collection done -GRBDON: POP AF ; Garbage collection done - PUSH AF ; Save status - LD HL,(STRSPC) ; Bottom of string space in use - EX DE,HL ; To DE - LD HL,(STRBOT) ; Bottom of string area - CPL ; Negate length (Top down) - LD C,A ; -Length to BC - LD B,-1 ; BC = -ve length of string - ADD HL,BC ; Add to bottom of space in use - INC HL ; Plus one for 2's complement - CALL CPDEHL ; Below string RAM area? - JP C,TESTOS ; Tidy up if not done else err - LD (STRBOT),HL ; Save new bottom of area - INC HL ; Point to first byte of string - EX DE,HL ; Address to DE -POPAF: POP AF ; Throw away status push - RET - -TESTOS: POP AF ; Garbage collect been done? - LD E,OS ; ?OS Error - JP Z,BERROR ; Yes - Not enough string apace - CP A ; Flag garbage collect done - PUSH AF ; Save status - LD BC,GRBDON ; Garbage collection done - PUSH BC ; Save for RETurn -GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer -GARBLP: LD (STRBOT),HL ; Reset string pointer - LD HL,0 - PUSH HL ; Flag no string found - LD HL,(STRSPC) ; Get bottom of string space - PUSH HL ; Save bottom of string space - LD HL,TMSTPL ; Temporary string pool -GRBLP: EX DE,HL - LD HL,(TMSTPT) ; Temporary string pool pointer - EX DE,HL - CALL CPDEHL ; Temporary string pool done? - LD BC,GRBLP ; Loop until string pool done - JP NZ,STPOOL ; No - See if in string area - LD HL,(PROGND) ; Start of simple variables -SMPVAR: EX DE,HL - LD HL,(VAREND) ; End of simple variables - EX DE,HL - CALL CPDEHL ; All simple strings done? - JP Z,ARRLP ; Yes - Do string arrays - LD A,(HL) ; Get type of variable - INC HL - INC HL - OR A ; "S" flag set if string - CALL STRADD ; See if string in string area - JP SMPVAR ; Loop until simple ones done - -GNXARY: POP BC ; Scrap address of this array -ARRLP: EX DE,HL - LD HL,(ARREND) ; End of string arrays - EX DE,HL - CALL CPDEHL ; All string arrays done? - JP Z,SCNEND ; Yes - Move string if found - CALL LOADFP ; Get array name to BCDE - LD A,E ; Get type of array - PUSH HL ; Save address of num of dim'ns - ADD HL,BC ; Start of next array - OR A ; Test type of array - JP P,GNXARY ; Numeric array - Ignore it - LD (CUROPR),HL ; Save address of next array - POP HL ; Get address of num of dim'ns - LD C,(HL) ; BC = Number of dimensions - LD B,0 - ADD HL,BC ; Two bytes per dimension size - ADD HL,BC - INC HL ; Plus one for number of dim'ns -GRBARY: EX DE,HL - LD HL,(CUROPR) ; Get address of next array - EX DE,HL - CALL CPDEHL ; Is this array finished? - JP Z,ARRLP ; Yes - Get next one - LD BC,GRBARY ; Loop until array all done -STPOOL: PUSH BC ; Save return address - OR 80H ; Flag string type -STRADD: LD A,(HL) ; Get string length - INC HL - INC HL - LD E,(HL) ; Get LSB of string address - INC HL - LD D,(HL) ; Get MSB of string address - INC HL - RET P ; Not a string - Return - OR A ; Set flags on string length - RET Z ; Null string - Return - LD B,H ; Save variable pointer - LD C,L - LD HL,(STRBOT) ; Bottom of new area - CALL CPDEHL ; String been done? - LD H,B ; Restore variable pointer - LD L,C - RET C ; String done - Ignore - POP HL ; Return address - EX (SP),HL ; Lowest available string area - CALL CPDEHL ; String within string area? - EX (SP),HL ; Lowest available string area - PUSH HL ; Re-save return address - LD H,B ; Restore variable pointer - LD L,C - RET NC ; Outside string area - Ignore - POP BC ; Get return , Throw 2 away - POP AF ; - POP AF ; - PUSH HL ; Save variable pointer - PUSH DE ; Save address of current - PUSH BC ; Put back return address - RET ; Go to it - -SCNEND: POP DE ; Addresses of strings - POP HL ; - LD A,L ; HL = 0 if no more to do - OR H - RET Z ; No more to do - Return - DEC HL - LD B,(HL) ; MSB of address of string - DEC HL - LD C,(HL) ; LSB of address of string - PUSH HL ; Save variable address - DEC HL - DEC HL - LD L,(HL) ; HL = Length of string - LD H,0 - ADD HL,BC ; Address of end of string+1 - LD D,B ; String address to DE - LD E,C - DEC HL ; Last byte in string - LD B,H ; Address to BC - LD C,L - LD HL,(STRBOT) ; Current bottom of string area - CALL MOVSTR ; Move string to new address - POP HL ; Restore variable address - LD (HL),C ; Save new LSB of address - INC HL - LD (HL),B ; Save new MSB of address - LD L,C ; Next string area+1 to HL - LD H,B - DEC HL ; Next string area address - JP GARBLP ; Look for more strings - -CONCAT: PUSH BC ; Save prec' opr & code string - PUSH HL ; - LD HL,(FPREG) ; Get first string - EX (SP),HL ; Save first string - CALL OPRND ; Get second string - EX (SP),HL ; Restore first string - CALL TSTSTR ; Make sure it's a string - LD A,(HL) ; Get length of second string - PUSH HL ; Save first string - LD HL,(FPREG) ; Get second string - PUSH HL ; Save second string - ADD A,(HL) ; Add length of second string - LD E,LS ; ?LS Error - JP C,BERROR ; String too long - Error - CALL MKTMST ; Make temporary string - POP DE ; Get second string to DE - CALL GSTRDE ; Move to string pool if needed - EX (SP),HL ; Get first string - CALL GSTRHL ; Move to string pool if needed - PUSH HL ; Save first string - LD HL,(TMPSTR+2) ; Temporary string address - EX DE,HL ; To DE - CALL SSTSA ; First string to string area - CALL SSTSA ; Second string to string area - LD HL,EVAL2 ; Return to evaluation loop - EX (SP),HL ; Save return,get code string - PUSH HL ; Save code string address - JP TSTOPL ; To temporary string to pool - -SSTSA: POP HL ; Return address - EX (SP),HL ; Get string block,save return - LD A,(HL) ; Get length of string - INC HL - INC HL - LD C,(HL) ; Get LSB of string address - INC HL - LD B,(HL) ; Get MSB of string address - LD L,A ; Length to L -TOSTRA: INC L ; INC - DECed after -TSALP: DEC L ; Count bytes moved - RET Z ; End of string - Return - LD A,(BC) ; Get source - LD (DE),A ; Save destination - INC BC ; Next source - INC DE ; Next destination - JP TSALP ; Loop until string moved - -GETSTR: CALL TSTSTR ; Make sure it's a string -GSTRCU: LD HL,(FPREG) ; Get current string -GSTRHL: EX DE,HL ; Save DE -GSTRDE: CALL BAKTMP ; Was it last tmp-str? - EX DE,HL ; Restore DE - RET NZ ; No - Return - PUSH DE ; Save string - LD D,B ; String block address to DE - LD E,C - DEC DE ; Point to length - LD C,(HL) ; Get string length - LD HL,(STRBOT) ; Current bottom of string area - CALL CPDEHL ; Last one in string area? - JP NZ,POPHL ; No - Return - LD B,A ; Clear B (A=0) - ADD HL,BC ; Remove string from str' area - LD (STRBOT),HL ; Save new bottom of str' area -POPHL: POP HL ; Restore string - RET - -BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top - DEC HL ; Back - LD B,(HL) ; Get MSB of address - DEC HL ; Back - LD C,(HL) ; Get LSB of address - DEC HL ; Back - DEC HL ; Back - CALL CPDEHL ; String last in string pool? - RET NZ ; Yes - Leave it - LD (TMSTPT),HL ; Save new string pool top - RET - -LEN: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GETLEN: CALL GETSTR ; Get string and its length - XOR A - LD D,A ; Clear D - LD (TYPE),A ; Set type to numeric - LD A,(HL) ; Get length of string - OR A ; Set status flags - RET - -ASC: LD BC,PASSA ; To return integer A - PUSH BC ; Save address -GTFLNM: CALL GETLEN ; Get length of string - JP Z,FCERR ; Null string - Error - INC HL - INC HL - LD E,(HL) ; Get LSB of address - INC HL - LD D,(HL) ; Get MSB of address - LD A,(DE) ; Get first byte of string - RET - -CHR: LD A,1 ; One character string - CALL MKTMST ; Make a temporary string - CALL MAKINT ; Make it integer A - LD HL,(TMPSTR+2) ; Get address of string - LD (HL),E ; Save character -TOPOOL: POP BC ; Clean up stack - JP TSTOPL ; Temporary string to pool - -LEFT: CALL LFRGNM ; Get number and ending ")" - XOR A ; Start at first byte in string -RIGHT1: EX (SP),HL ; Save code string,Get string - LD C,A ; Starting position in string -MID1: PUSH HL ; Save string block address - LD A,(HL) ; Get length of string - CP B ; Compare with number given - JP C,ALLFOL ; All following bytes required - LD A,B ; Get new length - DB 11H ; Skip "LD C,0" -ALLFOL: LD C,0 ; First byte of string - PUSH BC ; Save position in string - CALL TESTR ; See if enough string space - POP BC ; Get position in string - POP HL ; Restore string block address - PUSH HL ; And re-save it - INC HL - INC HL - LD B,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,B ; HL = address of string - LD B,0 ; BC = starting address - ADD HL,BC ; Point to that byte - LD B,H ; BC = source string - LD C,L - CALL CRTMST ; Create a string entry - LD L,A ; Length of new string - CALL TOSTRA ; Move string to string area - POP DE ; Clear stack - CALL GSTRDE ; Move to string pool if needed - JP TSTOPL ; Temporary string to pool - -RIGHT: CALL LFRGNM ; Get number and ending ")" - POP DE ; Get string length - PUSH DE ; And re-save - LD A,(DE) ; Get length - SUB B ; Move back N bytes - JP RIGHT1 ; Go and get sub-string - -MID: EX DE,HL ; Get code string address - LD A,(HL) ; Get next byte ',' or ")" - CALL MIDNUM ; Get number supplied - INC B ; Is it character zero? - DEC B - JP Z,FCERR ; Yes - Error - PUSH BC ; Save starting position - LD E,255 ; All of string - CP ')' ; Any length given? - JP Z,RSTSTR ; No - Rest of string - CALL CHKSYN ; Make sure ',' follows - DB ',' - CALL GETINT ; Get integer 0-255 -RSTSTR: CALL CHKSYN ; Make sure ")" follows - DB ")" - POP AF ; Restore starting position - EX (SP),HL ; Get string,8ave code string - LD BC,MID1 ; Continuation of MID$ routine - PUSH BC ; Save for return - DEC A ; Starting position-1 - CP (HL) ; Compare with length - LD B,0 ; Zero bytes length - RET NC ; Null string if start past end - LD C,A ; Save starting position-1 - LD A,(HL) ; Get length of string - SUB C ; Subtract start - CP E ; Enough string for it? - LD B,A ; Save maximum length available - RET C ; Truncate string if needed - LD B,E ; Set specified length - RET ; Go and create string - -VAL: CALL GETLEN ; Get length of string - JP Z,RESZER ; Result zero - LD E,A ; Save length - INC HL - INC HL - LD A,(HL) ; Get LSB of address - INC HL - LD H,(HL) ; Get MSB of address - LD L,A ; HL = String address - PUSH HL ; Save string address - ADD HL,DE - LD B,(HL) ; Get end of string+1 byte - LD (HL),D ; Zero it to terminate - EX (SP),HL ; Save string end,get start - PUSH BC ; Save end+1 byte - LD A,(HL) ; Get starting byte - CP '$' ; Hex number indicated? [function added G. Searle] - JP NZ,VAL1 - CALL HEXTFP ; Convert Hex to FPREG - JR VAL3 -VAL1: CP '%' ; Binary number indicated? [function added] - JP NZ,VAL2 - CALL BINTFP ; Convert Bin to FPREG - JR VAL3 -VAL2: CALL ASCTFP ; Convert ASCII string to FP -VAL3: POP BC ; Restore end+1 byte - POP HL ; Restore end+1 address - LD (HL),B ; Put back original byte - RET - -LFRGNM: EX DE,HL ; Code string address to HL - CALL CHKSYN ; Make sure ")" follows - DB ")" -MIDNUM: POP BC ; Get return address - POP DE ; Get number supplied - PUSH BC ; Re-save return address - LD B,E ; Number to B - RET - -INP: CALL MAKINT ; Make it integer A - LD (INPORT),A ; Set input port - CALL INPSUB ; Get input from port - JP PASSA ; Return integer A - -POUT: CALL SETIO ; Set up port number - JP OUTSUB ; Output data and return - -WAIT: CALL SETIO ; Set up port number - PUSH AF ; Save AND mask - LD E,0 ; Assume zero if none given - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - JP Z,NOXOR ; No XOR byte given - CALL CHKSYN ; Make sure ',' follows - DB ',' - CALL GETINT ; Get integer 0-255 to XOR with -NOXOR: POP BC ; Restore AND mask -WAITLP: CALL INPSUB ; Get input - XOR E ; Flip selected bits - AND B ; Result non-zero? - JP Z,WAITLP ; No = keep waiting - RET - -SETIO: CALL GETINT ; Get integer 0-255 - LD (INPORT),A ; Set input port - LD (OTPORT),A ; Set output port - CALL CHKSYN ; Make sure ',' follows - DB ',' - JP GETINT ; Get integer 0-255 and return - -FNDNUM: CALL GETCHR ; Get next character -GETINT: CALL GETNUM ; Get a number from 0 to 255 -MAKINT: CALL DEPINT ; Make sure value 0 - 255 - LD A,D ; Get MSB of number - OR A ; Zero? - JP NZ,FCERR ; No - Error - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - LD A,E ; Get number to A - RET - -PEEK: CALL DEINT ; Get memory address - LD A,(DE) ; Get byte in memory - JP PASSA ; Return integer A - -POKE: CALL GETNUM ; Get memory address - CALL DEINT ; Get integer -32768 to 3276 - PUSH DE ; Save memory address - CALL CHKSYN ; Make sure ',' follows - DB ',' - CALL GETINT ; Get integer 0-255 - POP DE ; Restore memory address - LD (DE),A ; Load it into memory - RET - -ROUND: LD HL,HALF ; Add 0.5 to FPREG -ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE - JP FPADD ; Add BCDE to FPREG - -SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL - DB 21H ; Skip "POP BC" and "POP DE" -PSUB: POP BC ; Get FP number from stack - POP DE -SUBCDE: CALL INVSGN ; Negate FPREG -FPADD: LD A,B ; Get FP exponent - OR A ; Is number zero? - RET Z ; Yes - Nothing to add - LD A,(FPEXP) ; Get FPREG exponent - OR A ; Is this number zero? - JP Z,FPBCDE ; Yes - Move BCDE to FPREG - SUB B ; BCDE number larger? - JP NC,NOSWAP ; No - Don't swap them - CPL ; Two's complement - INC A ; FP exponent - EX DE,HL - CALL STAKFP ; Put FPREG on stack - EX DE,HL - CALL FPBCDE ; Move BCDE to FPREG - POP BC ; Restore number from stack - POP DE -NOSWAP: CP 24+1 ; Second number insignificant? - RET NC ; Yes - First number is result - PUSH AF ; Save number of bits to scale - CALL SIGNS ; Set MSBs & sign of result - LD H,A ; Save sign of result - POP AF ; Restore scaling factor - CALL SCALE ; Scale BCDE to same exponent - OR H ; Result to be positive? - LD HL,FPREG ; Point to FPREG - JP P,MINCDE ; No - Subtract FPREG from CDE - CALL PLUCDE ; Add FPREG to CDE - JP NC,RONDUP ; No overflow - Round it up - INC HL ; Point to exponent - INC (HL) ; Increment it - JP Z,OVERR ; Number overflowed - Error - LD L,1 ; 1 bit to shift right - CALL SHRT1 ; Shift result right - JP RONDUP ; Round it up - -MINCDE: XOR A ; Clear A and carry - SUB B ; Negate exponent - LD B,A ; Re-save exponent - LD A,(HL) ; Get LSB of FPREG - SBC A, E ; Subtract LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - SBC A,D ; Subtract NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - SBC A,C ; Subtract MSB of BCDE - LD C,A ; Save MSB of BCDE -CONPOS: CALL C,COMPL ; Overflow - Make it positive - -BNORM: LD L,B ; L = Exponent - LD H,E ; H = LSB - XOR A -BNRMLP: LD B,A ; Save bit count - LD A,C ; Get MSB - OR A ; Is it zero? - JP NZ,PNORM ; No - Do it bit at a time - LD C,D ; MSB = NMSB - LD D,H ; NMSB= LSB - LD H,L ; LSB = VLSB - LD L,A ; VLSB= 0 - LD A,B ; Get exponent - SUB 8 ; Count 8 bits - CP -24-8 ; Was number zero? - JP NZ,BNRMLP ; No - Keep normalising -RESZER: XOR A ; Result is zero -SAVEXP: LD (FPEXP),A ; Save result as zero - RET - -NORMAL: DEC B ; Count bits - ADD HL,HL ; Shift HL left - LD A,D ; Get NMSB - RLA ; Shift left with last bit - LD D,A ; Save NMSB - LD A,C ; Get MSB - ADC A,A ; Shift left with last bit - LD C,A ; Save MSB -PNORM: JP P,NORMAL ; Not done - Keep going - LD A,B ; Number of bits shifted - LD E,H ; Save HL in EB - LD B,L - OR A ; Any shifting done? - JP Z,RONDUP ; No - Round it up - LD HL,FPEXP ; Point to exponent - ADD A,(HL) ; Add shifted bits - LD (HL),A ; Re-save exponent - JP NC,RESZER ; Underflow - Result is zero - RET Z ; Result is zero -RONDUP: LD A,B ; Get VLSB of number -RONDB: LD HL,FPEXP ; Point to exponent - OR A ; Any rounding? - CALL M,FPROND ; Yes - Round number up - LD B,(HL) ; B = Exponent - INC HL - LD A,(HL) ; Get sign of result - AND 10000000B ; Only bit 7 needed - XOR C ; Set correct sign - LD C,A ; Save correct sign in number - JP FPBCDE ; Move BCDE to FPREG - -FPROND: INC E ; Round LSB - RET NZ ; Return if ok - INC D ; Round NMSB - RET NZ ; Return if ok - INC C ; Round MSB - RET NZ ; Return if ok - LD C,80H ; Set normal value - INC (HL) ; Increment exponent - RET NZ ; Return if ok - JP OVERR ; Overflow error - -PLUCDE: LD A,(HL) ; Get LSB of FPREG - ADD A,E ; Add LSB of BCDE - LD E,A ; Save LSB of BCDE - INC HL - LD A,(HL) ; Get NMSB of FPREG - ADC A,D ; Add NMSB of BCDE - LD D,A ; Save NMSB of BCDE - INC HL - LD A,(HL) ; Get MSB of FPREG - ADC A,C ; Add MSB of BCDE - LD C,A ; Save MSB of BCDE - RET - -COMPL: LD HL,SGNRES ; Sign of result - LD A,(HL) ; Get sign of result - CPL ; Negate it - LD (HL),A ; Put it back - XOR A - LD L,A ; Set L to zero - SUB B ; Negate exponent,set carry - LD B,A ; Re-save exponent - LD A,L ; Load zero - SBC A,E ; Negate LSB - LD E,A ; Re-save LSB - LD A,L ; Load zero - SBC A,D ; Negate NMSB - LD D,A ; Re-save NMSB - LD A,L ; Load zero - SBC A,C ; Negate MSB - LD C,A ; Re-save MSB - RET - -SCALE: LD B,0 ; Clear underflow -SCALLP: SUB 8 ; 8 bits (a whole byte)? - JP C,SHRITE ; No - Shift right A bits - LD B,E ; <- Shift - LD E,D ; <- right - LD D,C ; <- eight - LD C,0 ; <- bits - JP SCALLP ; More bits to shift - -SHRITE: ADD A,8+1 ; Adjust count - LD L,A ; Save bits to shift -SHRLP: XOR A ; Flag for all done - DEC L ; All shifting done? - RET Z ; Yes - Return - LD A,C ; Get MSB -SHRT1: RRA ; Shift it right - LD C,A ; Re-save - LD A,D ; Get NMSB - RRA ; Shift right with last bit - LD D,A ; Re-save it - LD A,E ; Get LSB - RRA ; Shift right with last bit - LD E,A ; Re-save it - LD A,B ; Get underflow - RRA ; Shift right with last bit - LD B,A ; Re-save underflow - JP SHRLP ; More bits to do - -UNITY: DB 000H,000H,000H,081H ; 1.00000 - -LOGTAB: DB 3 ; Table used by LOG - DB 0AAH,056H,019H,080H ; 0.59898 - DB 0F1H,022H,076H,080H ; 0.96147 - DB 045H,0AAH,038H,082H ; 2.88539 - -LOG: CALL TSTSGN ; Test sign of value - OR A - JP PE,FCERR ; ?FC Error if <= zero - LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - LD BC,8035H ; BCDE = SQR(1/2) - LD DE,04F3H - SUB B ; Scale value to be < 1 - PUSH AF ; Save scale factor - LD (HL),B ; Save new exponent - PUSH DE ; Save SQR(1/2) - PUSH BC - CALL FPADD ; Add SQR(1/2) to value - POP BC ; Restore SQR(1/2) - POP DE - INC B ; Make it SQR(2) - CALL DVBCDE ; Divide by SQR(2) - LD HL,UNITY ; Point to 1. - CALL SUBPHL ; Subtract FPREG from 1 - LD HL,LOGTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD BC,8080H ; BCDE = -0.5 - LD DE,0000H - CALL FPADD ; Subtract 0.5 from FPREG - POP AF ; Restore scale factor - CALL RSCALE ; Re-scale number -MULLN2: LD BC,8031H ; BCDE = Ln(2) - LD DE,7218H - DB 21H ; Skip "POP BC" and "POP DE" - -MULT: POP BC ; Get number from stack - POP DE -FPMULT: CALL TSTSGN ; Test sign of FPREG - RET Z ; Return zero if zero - LD L,0 ; Flag add exponents - CALL ADDEXP ; Add exponents - LD A,C ; Get MSB of multiplier - LD (MULVAL),A ; Save MSB of multiplier - EX DE,HL - LD (MULVAL+1),HL ; Save rest of multiplier - LD BC,0 ; Partial product (BCDE) = zero - LD D,B - LD E,B - LD HL,BNORM ; Address of normalise - PUSH HL ; Save for return - LD HL,MULT8 ; Address of 8 bit multiply - PUSH HL ; Save for NMSB,MSB - PUSH HL ; - LD HL,FPREG ; Point to number -MULT8: LD A,(HL) ; Get LSB of number - INC HL ; Point to NMSB - OR A ; Test LSB - JP Z,BYTSFT ; Zero - shift to next byte - PUSH HL ; Save address of number - LD L,8 ; 8 bits to multiply by -MUL8LP: RRA ; Shift LSB right - LD H,A ; Save LSB - LD A,C ; Get MSB - JP NC,NOMADD ; Bit was zero - Don't add - PUSH HL ; Save LSB and count - LD HL,(MULVAL+1) ; Get LSB and NMSB - ADD HL,DE ; Add NMSB and LSB - EX DE,HL ; Leave sum in DE - POP HL ; Restore MSB and count - LD A,(MULVAL) ; Get MSB of multiplier - ADC A,C ; Add MSB -NOMADD: RRA ; Shift MSB right - LD C,A ; Re-save MSB - LD A,D ; Get NMSB - RRA ; Shift NMSB right - LD D,A ; Re-save NMSB - LD A,E ; Get LSB - RRA ; Shift LSB right - LD E,A ; Re-save LSB - LD A,B ; Get VLSB - RRA ; Shift VLSB right - LD B,A ; Re-save VLSB - DEC L ; Count bits multiplied - LD A,H ; Get LSB of multiplier - JP NZ,MUL8LP ; More - Do it -POPHRT: POP HL ; Restore address of number - RET - -BYTSFT: LD B,E ; Shift partial product left - LD E,D - LD D,C - LD C,A - RET - -DIV10: CALL STAKFP ; Save FPREG on stack - LD BC,8420H ; BCDE = 10. - LD DE,0000H - CALL FPBCDE ; Move 10 to FPREG - -DIV: POP BC ; Get number from stack - POP DE -DVBCDE: CALL TSTSGN ; Test sign of FPREG - JP Z,DZERR ; Error if division by zero - LD L,-1 ; Flag subtract exponents - CALL ADDEXP ; Subtract exponents - INC (HL) ; Add 2 to exponent to adjust - INC (HL) - DEC HL ; Point to MSB - LD A,(HL) ; Get MSB of dividend - LD (DIV3),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get NMSB of dividend - LD (DIV2),A ; Save for subtraction - DEC HL - LD A,(HL) ; Get MSB of dividend - LD (DIV1),A ; Save for subtraction - LD B,C ; Get MSB - EX DE,HL ; NMSB,LSB to HL - XOR A - LD C,A ; Clear MSB of quotient - LD D,A ; Clear NMSB of quotient - LD E,A ; Clear LSB of quotient - LD (DIV4),A ; Clear overflow count -DIVLP: PUSH HL ; Save divisor - PUSH BC - LD A,L ; Get LSB of number - CALL DIVSUP ; Subt' divisor from dividend - SBC A,0 ; Count for overflows - CCF - JP NC,RESDIV ; Restore divisor if borrow - LD (DIV4),A ; Re-save overflow count - POP AF ; Scrap divisor - POP AF - SCF ; Set carry to - DB 0D2H ; Skip "POP BC" and "POP HL" - -RESDIV: POP BC ; Restore divisor - POP HL - LD A,C ; Get MSB of quotient - INC A - DEC A - RRA ; Bit 0 to bit 7 - JP M,RONDB ; Done - Normalise result - RLA ; Restore carry - LD A,E ; Get LSB of quotient - RLA ; Double it - LD E,A ; Put it back - LD A,D ; Get NMSB of quotient - RLA ; Double it - LD D,A ; Put it back - LD A,C ; Get MSB of quotient - RLA ; Double it - LD C,A ; Put it back - ADD HL,HL ; Double NMSB,LSB of divisor - LD A,B ; Get MSB of divisor - RLA ; Double it - LD B,A ; Put it back - LD A,(DIV4) ; Get VLSB of quotient - RLA ; Double it - LD (DIV4),A ; Put it back - LD A,C ; Get MSB of quotient - OR D ; Merge NMSB - OR E ; Merge LSB - JP NZ,DIVLP ; Not done - Keep dividing - PUSH HL ; Save divisor - LD HL,FPEXP ; Point to exponent - DEC (HL) ; Divide by 2 - POP HL ; Restore divisor - JP NZ,DIVLP ; Ok - Keep going - JP OVERR ; Overflow error - -ADDEXP: LD A,B ; Get exponent of dividend - OR A ; Test it - JP Z,OVTST3 ; Zero - Result zero - LD A,L ; Get add/subtract flag - LD HL,FPEXP ; Point to exponent - XOR (HL) ; Add or subtract it - ADD A,B ; Add the other exponent - LD B,A ; Save new exponent - RRA ; Test exponent for overflow - XOR B - LD A,B ; Get exponent - JP P,OVTST2 ; Positive - Test for overflow - ADD A,80H ; Add excess 128 - LD (HL),A ; Save new exponent - JP Z,POPHRT ; Zero - Result zero - CALL SIGNS ; Set MSBs and sign of result - LD (HL),A ; Save new exponent - DEC HL ; Point to MSB - RET - -OVTST1: CALL TSTSGN ; Test sign of FPREG - CPL ; Invert sign - POP HL ; Clean up stack -OVTST2: OR A ; Test if new exponent zero -OVTST3: POP HL ; Clear off return address - JP P,RESZER ; Result zero - JP OVERR ; Overflow error - -MLSP10: CALL BCDEFP ; Move FPREG to BCDE - LD A,B ; Get exponent - OR A ; Is it zero? - RET Z ; Yes - Result is zero - ADD A,2 ; Multiply by 4 - JP C,OVERR ; Overflow - ?OV Error - LD B,A ; Re-save exponent - CALL FPADD ; Add BCDE to FPREG (Times 5) - LD HL,FPEXP ; Point to exponent - INC (HL) ; Double number (Times 10) - RET NZ ; Ok - Return - JP OVERR ; Overflow error - -TSTSGN: LD A,(FPEXP) ; Get sign of FPREG - OR A - RET Z ; RETurn if number is zero - LD A,(FPREG+2) ; Get MSB of FPREG - DB 0FEH ; Test sign -RETREL: CPL ; Invert sign - RLA ; Sign bit to carry -FLGDIF: SBC A,A ; Carry to all bits of A - RET NZ ; Return -1 if negative - INC A ; Bump to +1 - RET ; Positive - Return +1 - -SGN: CALL TSTSGN ; Test sign of FPREG -FLGREL: LD B,80H+8 ; 8 bit integer in exponent - LD DE,0 ; Zero NMSB and LSB -RETINT: LD HL,FPEXP ; Point to exponent - LD C,A ; CDE = MSB,NMSB and LSB - LD (HL),B ; Save exponent - LD B,0 ; CDE = integer to normalise - INC HL ; Point to sign of result - LD (HL),80H ; Set sign of result - RLA ; Carry = sign of integer - JP CONPOS ; Set sign of result - -ABS: CALL TSTSGN ; Test sign of FPREG - RET P ; Return if positive -INVSGN: LD HL,FPREG+2 ; Point to MSB - LD A,(HL) ; Get sign of mantissa - XOR 80H ; Invert sign of mantissa - LD (HL),A ; Re-save sign of mantissa - RET - -STAKFP: EX DE,HL ; Save code string address - LD HL,(FPREG) ; LSB,NLSB of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - LD HL,(FPREG+2) ; MSB and exponent of FPREG - EX (SP),HL ; Stack them,get return - PUSH HL ; Re-save return - EX DE,HL ; Restore code string address - RET - -PHLTFP: CALL LOADFP ; Number at HL to BCDE -FPBCDE: EX DE,HL ; Save code string address - LD (FPREG),HL ; Save LSB,NLSB of number - LD H,B ; Exponent of number - LD L,C ; MSB of number - LD (FPREG+2),HL ; Save MSB and exponent - EX DE,HL ; Restore code string address - RET - -BCDEFP: LD HL,FPREG ; Point to FPREG -LOADFP: LD E,(HL) ; Get LSB of number - INC HL - LD D,(HL) ; Get NMSB of number - INC HL - LD C,(HL) ; Get MSB of number - INC HL - LD B,(HL) ; Get exponent of number -INCHL: INC HL ; Used for conditional "INC HL" - RET - -FPTHL: LD DE,FPREG ; Point to FPREG -DETHL4: LD B,4 ; 4 bytes to move -DETHLB: LD A,(DE) ; Get source - LD (HL),A ; Save destination - INC DE ; Next source - INC HL ; Next destination - DEC B ; Count bytes - JP NZ,DETHLB ; Loop if more - RET - -SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG - LD A,(HL) ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD (HL),A ; Save new MSB - CCF ; Complement sign - RRA ; Old sign to carry - INC HL - INC HL - LD (HL),A ; Set sign of result - LD A,C ; Get MSB - RLCA ; Old sign to carry - SCF ; Set MSBit - RRA ; Set MSBit of MSB - LD C,A ; Save MSB - RRA - XOR (HL) ; New sign of result - RET - -CMPNUM: LD A,B ; Get exponent of number - OR A - JP Z,TSTSGN ; Zero - Test sign of FPREG - LD HL,RETREL ; Return relation routine - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD A,C ; Get MSB of number - RET Z ; FPREG zero - Number's MSB - LD HL,FPREG+2 ; MSB of FPREG - XOR (HL) ; Combine signs - LD A,C ; Get MSB of number - RET M ; Exit if signs different - CALL CMPFP ; Compare FP numbers - RRA ; Get carry to sign - XOR C ; Combine with MSB of number - RET - -CMPFP: INC HL ; Point to exponent - LD A,B ; Get exponent - CP (HL) ; Compare exponents - RET NZ ; Different - DEC HL ; Point to MBS - LD A,C ; Get MSB - CP (HL) ; Compare MSBs - RET NZ ; Different - DEC HL ; Point to NMSB - LD A,D ; Get NMSB - CP (HL) ; Compare NMSBs - RET NZ ; Different - DEC HL ; Point to LSB - LD A,E ; Get LSB - SUB (HL) ; Compare LSBs - RET NZ ; Different - POP HL ; Drop RETurn - POP HL ; Drop another RETurn - RET - -FPINT: LD B,A ; <- Move - LD C,A ; <- exponent - LD D,A ; <- to all - LD E,A ; <- bits - OR A ; Test exponent - RET Z ; Zero - Return zero - PUSH HL ; Save pointer to number - CALL BCDEFP ; Move FPREG to BCDE - CALL SIGNS ; Set MSBs & sign of result - XOR (HL) ; Combine with sign of FPREG - LD H,A ; Save combined signs - CALL M,DCBCDE ; Negative - Decrement BCDE - LD A,80H+24 ; 24 bits - SUB B ; Bits to shift - CALL SCALE ; Shift BCDE - LD A,H ; Get combined sign - RLA ; Sign to carry - CALL C,FPROND ; Negative - Round number up - LD B,0 ; Zero exponent - CALL C,COMPL ; If negative make positive - POP HL ; Restore pointer to number - RET - -DCBCDE: DEC DE ; Decrement BCDE - LD A,D ; Test LSBs - AND E - INC A - RET NZ ; Exit if LSBs not FFFF - DEC BC ; Decrement MSBs - RET - -INT: LD HL,FPEXP ; Point to exponent - LD A,(HL) ; Get exponent - CP 80H+24 ; Integer accuracy only? - LD A,(FPREG) ; Get LSB - RET NC ; Yes - Already integer - LD A,(HL) ; Get exponent - CALL FPINT ; F.P to integer - LD (HL),80H+24 ; Save 24 bit integer - LD A,E ; Get LSB of number - PUSH AF ; Save LSB - LD A,C ; Get MSB of number - RLA ; Sign to carry - CALL CONPOS ; Set sign of result - POP AF ; Restore LSB of number - RET - -MLDEBC: LD HL,0 ; Clear partial product - LD A,B ; Test multiplier - OR C - RET Z ; Return zero if zero - LD A,16 ; 16 bits -MLDBLP: ADD HL,HL ; Shift P.P left - JP C,BSERR ; ?BS Error if overflow - EX DE,HL - ADD HL,HL ; Shift multiplier left - EX DE,HL - JP NC,NOMLAD ; Bit was zero - No add - ADD HL,BC ; Add multiplicand - JP C,BSERR ; ?BS Error if overflow -NOMLAD: DEC A ; Count bits - JP NZ,MLDBLP ; More - RET - -ASCTFP: CP '-' ; Negative? - PUSH AF ; Save it and flags - JP Z,CNVNUM ; Yes - Convert number - CP '+' ; Positive? - JP Z,CNVNUM ; Yes - Convert number - DEC HL ; DEC 'cos GETCHR INCs -CNVNUM: CALL RESZER ; Set result to zero - LD B,A ; Digits after point counter - LD D,A ; Sign of exponent - LD E,A ; Exponent of ten - CPL - LD C,A ; Before or after point flag -MANLP: CALL GETCHR ; Get next character - JP C,ADDIG ; Digit - Add to number - CP '.' - JP Z,DPOINT ; '.' - Flag point - CP 'E' - JP NZ,CONEXP ; Not 'E' - Scale number - CALL GETCHR ; Get next character - CALL SGNEXP ; Get sign of exponent -EXPLP: CALL GETCHR ; Get next character - JP C,EDIGIT ; Digit - Add to exponent - INC D ; Is sign negative? - JP NZ,CONEXP ; No - Scale number - XOR A - SUB E ; Negate exponent - LD E,A ; And re-save it - INC C ; Flag end of number -DPOINT: INC C ; Flag point passed - JP Z,MANLP ; Zero - Get another digit -CONEXP: PUSH HL ; Save code string address - LD A,E ; Get exponent - SUB B ; Subtract digits after point -SCALMI: CALL P,SCALPL ; Positive - Multiply number - JP P,ENDCON ; Positive - All done - PUSH AF ; Save number of times to /10 - CALL DIV10 ; Divide by 10 - POP AF ; Restore count - INC A ; Count divides - -ENDCON: JP NZ,SCALMI ; More to do - POP DE ; Restore code string address - POP AF ; Restore sign of number - CALL Z,INVSGN ; Negative - Negate number - EX DE,HL ; Code string address to HL - RET - -SCALPL: RET Z ; Exit if no scaling needed -MULTEN: PUSH AF ; Save count - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore count - DEC A ; Count multiplies - RET - -ADDIG: PUSH DE ; Save sign of exponent - LD D,A ; Save digit - LD A,B ; Get digits after point - ADC A,C ; Add one if after point - LD B,A ; Re-save counter - PUSH BC ; Save point flags - PUSH HL ; Save code string address - PUSH DE ; Save digit - CALL MLSP10 ; Multiply number by 10 - POP AF ; Restore digit - SUB '0' ; Make it absolute - CALL RSCALE ; Re-scale number - POP HL ; Restore code string address - POP BC ; Restore point flags - POP DE ; Restore sign of exponent - JP MANLP ; Get another digit - -RSCALE: CALL STAKFP ; Put number on stack - CALL FLGREL ; Digit to add to FPREG -PADD: POP BC ; Restore number - POP DE - JP FPADD ; Add BCDE to FPREG and return - -EDIGIT: LD A,E ; Get digit - RLCA ; Times 2 - RLCA ; Times 4 - ADD A,E ; Times 5 - RLCA ; Times 10 - ADD A,(HL) ; Add next digit - SUB '0' ; Make it absolute - LD E,A ; Save new digit - JP EXPLP ; Look for another digit - -LINEIN: PUSH HL ; Save code string address - LD HL,INMSG ; Output " in " - CALL PRS ; Output string at HL - POP HL ; Restore code string address -PRNTHL: EX DE,HL ; Code string address to DE - XOR A - LD B,80H+24 ; 24 bits - CALL RETINT ; Return the integer - LD HL,PRNUMS ; Print number string - PUSH HL ; Save for return -NUMASC: LD HL,PBUFF ; Convert number to ASCII - PUSH HL ; Save for return - CALL TSTSGN ; Test sign of FPREG - LD (HL),' ' ; Space at start - JP P,SPCFST ; Positive - Space to start - LD (HL),'-' ; '-' sign at start -SPCFST: INC HL ; First byte of number - LD (HL),'0' ; '0' if zero - JP Z,JSTZER ; Return '0' if zero - PUSH HL ; Save buffer address - CALL M,INVSGN ; Negate FPREG if negative - XOR A ; Zero A - PUSH AF ; Save it - CALL RNGTST ; Test number is in range -SIXDIG: LD BC,9143H ; BCDE - 99999.9 - LD DE,4FF8H - CALL CMPNUM ; Compare numbers - OR A - JP PO,INRNG ; > 99999.9 - Sort it out - POP AF ; Restore count - CALL MULTEN ; Multiply by ten - PUSH AF ; Re-save count - JP SIXDIG ; Test it again - -GTSIXD: CALL DIV10 ; Divide by 10 - POP AF ; Get count - INC A ; Count divides - PUSH AF ; Re-save count - CALL RNGTST ; Test number is in range -INRNG: CALL ROUND ; Add 0.5 to FPREG - INC A - CALL FPINT ; F.P to integer - CALL FPBCDE ; Move BCDE to FPREG - LD BC,0306H ; 1E+06 to 1E-03 range - POP AF ; Restore count - ADD A,C ; 6 digits before point - INC A ; Add one - JP M,MAKNUM ; Do it in 'E' form if < 1E-02 - CP 6+1+1 ; More than 999999 ? - JP NC,MAKNUM ; Yes - Do it in 'E' form - INC A ; Adjust for exponent - LD B,A ; Exponent of number - LD A,2 ; Make it zero after - -MAKNUM: DEC A ; Adjust for digits to do - DEC A - POP HL ; Restore buffer address - PUSH AF ; Save count - LD DE,POWERS ; Powers of ten - DEC B ; Count digits before point - JP NZ,DIGTXT ; Not zero - Do number - LD (HL),'.' ; Save point - INC HL ; Move on - LD (HL),'0' ; Save zero - INC HL ; Move on -DIGTXT: DEC B ; Count digits before point - LD (HL),'.' ; Save point in case - CALL Z,INCHL ; Last digit - move on - PUSH BC ; Save digits before point - PUSH HL ; Save buffer address - PUSH DE ; Save powers of ten - CALL BCDEFP ; Move FPREG to BCDE - POP HL ; Powers of ten table - LD B, '0'-1 ; ASCII '0' - 1 -TRYAGN: INC B ; Count subtractions - LD A,E ; Get LSB - SUB (HL) ; Subtract LSB - LD E,A ; Save LSB - INC HL - LD A,D ; Get NMSB - SBC A,(HL) ; Subtract NMSB - LD D,A ; Save NMSB - INC HL - LD A,C ; Get MSB - SBC A,(HL) ; Subtract MSB - LD C,A ; Save MSB - DEC HL ; Point back to start - DEC HL - JP NC,TRYAGN ; No overflow - Try again - CALL PLUCDE ; Restore number - INC HL ; Start of next number - CALL FPBCDE ; Move BCDE to FPREG - EX DE,HL ; Save point in table - POP HL ; Restore buffer address - LD (HL),B ; Save digit in buffer - INC HL ; And move on - POP BC ; Restore digit count - DEC C ; Count digits - JP NZ,DIGTXT ; More - Do them - DEC B ; Any decimal part? - JP Z,DOEBIT ; No - Do 'E' bit -SUPTLZ: DEC HL ; Move back through buffer - LD A,(HL) ; Get character - CP '0' ; '0' character? - JP Z,SUPTLZ ; Yes - Look back for more - CP '.' ; A decimal point? - CALL NZ,INCHL ; Move back over digit - -DOEBIT: POP AF ; Get 'E' flag - JP Z,NOENED ; No 'E' needed - End buffer - LD (HL),'E' ; Put 'E' in buffer - INC HL ; And move on - LD (HL),'+' ; Put '+' in buffer - JP P,OUTEXP ; Positive - Output exponent - LD (HL),'-' ; Put '-' in buffer - CPL ; Negate exponent - INC A -OUTEXP: LD B,'0'-1 ; ASCII '0' - 1 -EXPTEN: INC B ; Count subtractions - SUB 10 ; Tens digit - JP NC,EXPTEN ; More to do - ADD A,'0'+10 ; Restore and make ASCII - INC HL ; Move on - LD (HL),B ; Save MSB of exponent -JSTZER: INC HL ; - LD (HL),A ; Save LSB of exponent - INC HL -NOENED: LD (HL),C ; Mark end of buffer - POP HL ; Restore code string address - RET - -RNGTST: LD BC,9474H ; BCDE = 999999. - LD DE,23F7H - CALL CMPNUM ; Compare numbers - OR A - POP HL ; Return address to HL - JP PO,GTSIXD ; Too big - Divide by ten - JP (HL) ; Otherwise return to caller - -HALF: DB 00H,00H,00H,80H ; 0.5 - -POWERS: DB 0A0H,086H,001H ; 100000 - DB 010H,027H,000H ; 10000 - DB 0E8H,003H,000H ; 1000 - DB 064H,000H,000H ; 100 - DB 00AH,000H,000H ; 10 - DB 001H,000H,000H ; 1 - -NEGAFT: LD HL,INVSGN ; Negate result - EX (SP),HL ; To be done after caller - JP (HL) ; Return to caller - -SQR: CALL STAKFP ; Put value on stack - LD HL,HALF ; Set power to 1/2 - CALL PHLTFP ; Move 1/2 to FPREG - -POWER: POP BC ; Get base - POP DE - CALL TSTSGN ; Test sign of power - LD A,B ; Get exponent of base - JP Z,EXP ; Make result 1 if zero - JP P,POWER1 ; Positive base - Ok - OR A ; Zero to negative power? - JP Z,DZERR ; Yes - ?/0 Error -POWER1: OR A ; Base zero? - JP Z,SAVEXP ; Yes - Return zero - PUSH DE ; Save base - PUSH BC - LD A,C ; Get MSB of base - OR 01111111B ; Get sign status - CALL BCDEFP ; Move power to BCDE - JP P,POWER2 ; Positive base - Ok - PUSH DE ; Save power - PUSH BC - CALL INT ; Get integer of power - POP BC ; Restore power - POP DE - PUSH AF ; MSB of base - CALL CMPNUM ; Power an integer? - POP HL ; Restore MSB of base - LD A,H ; but don't affect flags - RRA ; Exponent odd or even? -POWER2: POP HL ; Restore MSB and exponent - LD (FPREG+2),HL ; Save base in FPREG - POP HL ; LSBs of base - LD (FPREG),HL ; Save in FPREG - CALL C,NEGAFT ; Odd power - Negate result - CALL Z,INVSGN ; Negative base - Negate it - PUSH DE ; Save power - PUSH BC - CALL LOG ; Get LOG of base - POP BC ; Restore power - POP DE - CALL FPMULT ; Multiply LOG by power - -EXP: CALL STAKFP ; Put value on stack - LD BC,08138H ; BCDE = 1/Ln(2) - LD DE,0AA3BH - CALL FPMULT ; Multiply value by 1/LN(2) - LD A,(FPEXP) ; Get exponent - CP 80H+8 ; Is it in range? - JP NC,OVTST1 ; No - Test for overflow - CALL INT ; Get INT of FPREG - ADD A,80H ; For excess 128 - ADD A,2 ; Exponent > 126? - JP C,OVTST1 ; Yes - Test for overflow - PUSH AF ; Save scaling factor - LD HL,UNITY ; Point to 1. - CALL ADDPHL ; Add 1 to FPREG - CALL MULLN2 ; Multiply by LN(2) - POP AF ; Restore scaling factor - POP BC ; Restore exponent - POP DE - PUSH AF ; Save scaling factor - CALL SUBCDE ; Subtract exponent from FPREG - CALL INVSGN ; Negate result - LD HL,EXPTAB ; Coefficient table - CALL SMSER1 ; Sum the series - LD DE,0 ; Zero LSBs - POP BC ; Scaling factor - LD C,D ; Zero MSB - JP FPMULT ; Scale result to correct value - -EXPTAB: DB 8 ; Table used by EXP - DB 040H,02EH,094H,074H ; -1/7! (-1/5040) - DB 070H,04FH,02EH,077H ; 1/6! ( 1/720) - DB 06EH,002H,088H,07AH ; -1/5! (-1/120) - DB 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) - DB 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) - DB 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) - DB 000H,000H,080H,081H ; -1/1! (-1/1) - DB 000H,000H,000H,081H ; 1/0! ( 1/1) - -SUMSER: CALL STAKFP ; Put FPREG on stack - LD DE,MULT ; Multiply by "X" - PUSH DE ; To be done after - PUSH HL ; Save address of table - CALL BCDEFP ; Move FPREG to BCDE - CALL FPMULT ; Square the value - POP HL ; Restore address of table -SMSER1: CALL STAKFP ; Put value on stack - LD A,(HL) ; Get number of coefficients - INC HL ; Point to start of table - CALL PHLTFP ; Move coefficient to FPREG - DB 06H ; Skip "POP AF" -SUMLP: POP AF ; Restore count - POP BC ; Restore number - POP DE - DEC A ; Cont coefficients - RET Z ; All done - PUSH DE ; Save number - PUSH BC - PUSH AF ; Save count - PUSH HL ; Save address in table - CALL FPMULT ; Multiply FPREG by BCDE - POP HL ; Restore address in table - CALL LOADFP ; Number at HL to BCDE - PUSH HL ; Save address in table - CALL FPADD ; Add coefficient to FPREG - POP HL ; Restore address in table - JP SUMLP ; More coefficients - -RND: CALL TSTSGN ; Test sign of FPREG - LD HL,SEED+2 ; Random number seed - JP M,RESEED ; Negative - Re-seed - LD HL,LSTRND ; Last random number - CALL PHLTFP ; Move last RND to FPREG - LD HL,SEED+2 ; Random number seed - RET Z ; Return if RND(0) - ADD A,(HL) ; Add (SEED)+2) - AND 00000111B ; 0 to 7 - LD B,0 - LD (HL),A ; Re-save seed - INC HL ; Move to coefficient table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to coefficient - CALL LOADFP ; Coefficient to BCDE - CALL FPMULT ; ; Multiply FPREG by coefficient - LD A,(SEED+1) ; Get (SEED+1) - INC A ; Add 1 - AND 00000011B ; 0 to 3 - LD B,0 - CP 1 ; Is it zero? - ADC A,B ; Yes - Make it 1 - LD (SEED+1),A ; Re-save seed - LD HL,RNDTAB-4 ; Addition table - ADD A,A ; 4 bytes - ADD A,A ; per entry - LD C,A ; BC = Offset into table - ADD HL,BC ; Point to value - CALL ADDPHL ; Add value to FPREG -RND1: CALL BCDEFP ; Move FPREG to BCDE - LD A,E ; Get LSB - LD E,C ; LSB = MSB - XOR 01001111B ; Fiddle around - LD C,A ; New MSB - LD (HL),80H ; Set exponent - DEC HL ; Point to MSB - LD B,(HL) ; Get MSB - LD (HL),80H ; Make value -0.5 - LD HL,SEED ; Random number seed - INC (HL) ; Count seed - LD A,(HL) ; Get seed - SUB 171 ; Do it modulo 171 - JP NZ,RND2 ; Non-zero - Ok - LD (HL),A ; Zero seed - INC C ; Fillde about - DEC D ; with the - INC E ; number -RND2: CALL BNORM ; Normalise number - LD HL,LSTRND ; Save random number - JP FPTHL ; Move FPREG to last and return - -RESEED: LD (HL),A ; Re-seed random numbers - DEC HL - LD (HL),A - DEC HL - LD (HL),A - JP RND1 ; Return RND seed - -RNDTAB: DB 068H,0B1H,046H,068H ; Table used by RND - DB 099H,0E9H,092H,069H - DB 010H,0D1H,075H,068H - -COS: LD HL,HALFPI ; Point to PI/2 - CALL ADDPHL ; Add it to PPREG -SIN: CALL STAKFP ; Put angle on stack - LD BC,8349H ; BCDE = 2 PI - LD DE,0FDBH - CALL FPBCDE ; Move 2 PI to FPREG - POP BC ; Restore angle - POP DE - CALL DVBCDE ; Divide angle by 2 PI - CALL STAKFP ; Put it on stack - CALL INT ; Get INT of result - POP BC ; Restore number - POP DE - CALL SUBCDE ; Make it 0 <= value < 1 - LD HL,QUARTR ; Point to 0.25 - CALL SUBPHL ; Subtract value from 0.25 - CALL TSTSGN ; Test sign of value - SCF ; Flag positive - JP P,SIN1 ; Positive - Ok - CALL ROUND ; Add 0.5 to value - CALL TSTSGN ; Test sign of value - OR A ; Flag negative -SIN1: PUSH AF ; Save sign - CALL P,INVSGN ; Negate value if positive - LD HL,QUARTR ; Point to 0.25 - CALL ADDPHL ; Add 0.25 to value - POP AF ; Restore sign - CALL NC,INVSGN ; Negative - Make positive - LD HL,SINTAB ; Coefficient table - JP SUMSER ; Evaluate sum of series - -HALFPI: DB 0DBH,00FH,049H,081H ; 1.5708 (PI/2) - -QUARTR: DB 000H,000H,000H,07FH ; 0.25 - -SINTAB: DB 5 ; Table used by SIN - DB 0BAH,0D7H,01EH,086H ; 39.711 - DB 064H,026H,099H,087H ;-76.575 - DB 058H,034H,023H,087H ; 81.602 - DB 0E0H,05DH,0A5H,086H ;-41.342 - DB 0DAH,00FH,049H,083H ; 6.2832 - -TAN: CALL STAKFP ; Put angle on stack - CALL SIN ; Get SIN of angle - POP BC ; Restore angle - POP HL - CALL STAKFP ; Save SIN of angle - EX DE,HL ; BCDE = Angle - CALL FPBCDE ; Angle to FPREG - CALL COS ; Get COS of angle - JP DIV ; TAN = SIN / COS - -ATN: CALL TSTSGN ; Test sign of value - CALL M,NEGAFT ; Negate result after if -ve - CALL M,INVSGN ; Negate value if -ve - LD A,(FPEXP) ; Get exponent - CP 81H ; Number less than 1? - JP C,ATN1 ; Yes - Get arc tangnt - LD BC,8100H ; BCDE = 1 - LD D,C - LD E,C - CALL DVBCDE ; Get reciprocal of number - LD HL,SUBPHL ; Sub angle from PI/2 - PUSH HL ; Save for angle > 1 -ATN1: LD HL,ATNTAB ; Coefficient table - CALL SUMSER ; Evaluate sum of series - LD HL,HALFPI ; PI/2 - angle in case > 1 - RET ; Number > 1 - Sub from PI/2 - -ATNTAB: DB 9 ; Table used by ATN - DB 04AH,0D7H,03BH,078H ; 1/17 - DB 002H,06EH,084H,07BH ;-1/15 - DB 0FEH,0C1H,02FH,07CH ; 1/13 - DB 074H,031H,09AH,07DH ;-1/11 - DB 084H,03DH,05AH,07DH ; 1/9 - DB 0C8H,07FH,091H,07EH ;-1/7 - DB 0E4H,0BBH,04CH,07EH ; 1/5 - DB 06CH,0AAH,0AAH,07FH ;-1/3 - DB 000H,000H,000H,081H ; 1/1 - - -ARET: RET ; A RETurn instruction - -CLS: LD A,016H ; ASCII Clear screen - JP PRNT ; Output character - -WIDTH: CALL GETINT ; Get integer 0-255 - LD A,E ; Width to A - LD (LWIDTH),A ; Set width - RET - -LINES: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - LD (LINESC),DE ; Set lines counter - LD (LINESN),DE ; Set lines number - RET - -DEEK: CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save number - POP HL ; Number to HL - LD B,(HL) ; Get LSB of contents - INC HL - LD A,(HL) ; Get MSB of contents - JP ABPASS ; Return integer AB - -DOKE: CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH DE ; Save address - CALL CHKSYN ; Make sure ',' follows - DB ',' - CALL GETNUM ; Get a number - CALL DEINT ; Get integer -32768 to 32767 - EX (SP),HL ; Save value,get address - LD (HL),E ; Save LSB of value - INC HL - LD (HL),D ; Save MSB of value - POP HL ; Restore code string address - RET - - -; HEX$(nn) Convert 16 bit number to Hexadecimal string - -HEX: CALL TSTNUM ; Verify it's a number - CALL DEINT ; Get integer -32768 to 32767 - PUSH BC ; Save contents of BC - LD HL,PBUFF - LD A,D ; Get high order into A - CP 000H - JR Z,HEX2 ; Skip output if both high digits are zero - CALL BYT2ASC ; Convert D to ASCII - LD A,B - CP '0' - JR Z,HEX1 ; Don't store high digit if zero - LD (HL),B ; Store it to PBUFF - INC HL ; Next location -HEX1: LD (HL),C ; Store C to PBUFF+1 - INC HL ; Next location -HEX2: LD A,E ; Get lower byte - CALL BYT2ASC ; Convert E to ASCII - LD A,D - CP 000H - JR NZ,HEX3 ; If upper byte was not zero then always print lower byte - LD A,B - CP '0' ; If high digit of lower byte is zero then don't print - JR Z,HEX4 -HEX3: LD (HL),B ; to PBUFF+2 - INC HL ; Next location -HEX4: LD (HL),C ; to PBUFF+3 - INC HL ; PBUFF+4 to zero - XOR A ; Terminating character - LD (HL),A ; Store zero to terminate - INC HL ; Make sure PBUFF is terminated - LD (HL),A ; Store the double zero there - POP BC ; Get BC back - LD HL,PBUFF ; Reset to start of PBUFF - JP STR1 ; Convert the PBUFF to a string and return it - -BYT2ASC LD B,A ; Save original value - AND 00FH ; Strip off upper nybble - CP 00AH ; 0-9? - JR C,ADD30 ; If A-F, add 7 more - ADD A,007H ; Bring value up to ASCII A-F -ADD30 ADD A,030H ; And make ASCII - LD C,A ; Save converted char to C - LD A,B ; Retrieve original value - RRCA ; and Rotate it right - RRCA - RRCA - RRCA - AND 00FH ; Mask off upper nybble - CP 00AH ; 0-9? < A hex? - JR C,ADD301 ; Skip Add 7 - ADD A,007H ; Bring it up to ASCII A-F -ADD301 ADD A,030H ; And make it full ASCII - LD B,A ; Store high order byte - RET - -; Convert "&Hnnnn" to FPREG -; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" -; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 -HEXTFP EX DE,HL ; Move code string pointer to DE - LD HL,00000H ; Zero out the value - CALL GETHEX ; Check the number for valid hex - JP C,HXERR ; First value wasn't hex, HX error - JR HEXLP1 ; Convert first character -HEXLP CALL GETHEX ; Get second and addtional characters - JR C,HEXIT ; Exit if not a hex character -HEXLP1 ADD HL,HL ; Rotate 4 bits to the left - ADD HL,HL - ADD HL,HL - ADD HL,HL - OR L ; Add in D0-D3 into L - LD L,A ; Save new value - JR HEXLP ; And continue until all hex characters are in - -GETHEX INC DE ; Next location - LD A,(DE) ; Load character at pointer - CP ' ' - JP Z,GETHEX ; Skip spaces - SUB 030H ; Get absolute value - RET C ; < "0", error - CP 00AH - JR C,NOSUB7 ; Is already in the range 0-9 - SUB 007H ; Reduce to A-F - CP 00AH ; Value should be $0A-$0F at this point - RET C ; CY set if was : ; < = > ? @ -NOSUB7 CP 010H ; > Greater than "F"? - CCF - RET ; CY set if it wasn't valid hex +TTYLIN: LD HL,BUFFER ; Get a line by character + LD B,1 ; Set buffer as empty + XOR A + LD (NULFLG),A ; Clear null flag +MORINP: CALL CLOTST ; Get character and test ^O + LD C,A ; Save character in C + CP DELETE ; Delete character? + JP Z,DODEL ; Yes - Process it + LD A,(NULFLG) ; Get null flag + OR A ; Test null flag status + JP Z,PROCES ; Reset - Process character + LD A,0 ; Set a null + CALL OUTC ; Output null + XOR A ; Clear A + LD (NULFLG),A ; Reset null flag +PROCES: LD A,C ; Get character + CP CTRL_G ; Bell? + JP Z,PUTCTL ; Yes - Save it + CP CTRL_C ; Is it control "C"? + CALL Z,PRNTCRLF ; Yes - Output CRLF + SCF ; Flag break + RET Z ; Return if control "C" + CP CR ; Is it enter? + JP Z,ENDINP ; Yes - Terminate input + CP CTRL_U ; Is it control "U"? + JP Z,KILIN ; Yes - Get another line + CP '@' ; Is it "kill line"? + JP Z,OTKLN ; Yes - Kill line + CP DELETE ; Is it delete? + JP Z,DELCHR ; Yes - Delete character + CP BACKS ; Is it backspace? + JP Z,DELCHR ; Yes - Delete character + CP CTRL_R ; Is it control "R"? + JP NZ,PUTBUF ; No - Put in buffer + PUSH BC ; Save buffer length + PUSH DE ; Save DE + PUSH HL ; Save buffer address + LD (HL),0 ; Mark end of buffer + CALL OUTNCR ; Output and do CRLF + LD HL,BUFFER ; Point to buffer start + CALL PRS ; Output buffer + POP HL ; Restore buffer address + POP DE ; Restore DE + POP BC ; Restore buffer length + JP MORINP ; Get another character + +PUTBUF: CP ' ' ; Is it a control code? + JP C,MORINP ; Yes - Ignore +PUTCTL: LD A,B ; Get number of bytes in buffer + CP 72+1 ; Test for line overflow + LD A,CTRL_G ; Set a bell + JP NC,OUTNBS ; Ring bell if buffer full + LD A,C ; Get character + LD (HL),C ; Save in buffer + LD (LSTBIN),A ; Save last input byte + INC HL ; Move up buffer + INC B ; Increment length +OUTIT: CALL OUTC ; Output the character entered + JP MORINP ; Get another character + +OUTNBS: CALL OUTC ; Output bell and back over it + LD A,BACKS ; Set back space + JP OUTIT ; Output it and get more + +CPDEHL: LD A,H ; Get H + SUB D ; Compare with D + RET NZ ; Different - Exit + LD A,L ; Get L + SUB E ; Compare with E + RET ; Return status + +CHKSYN: LD A,(HL) ; Check syntax of character + EX (SP),HL ; Address of test byte + CP (HL) ; Same as in code string? + INC HL ; Return address + EX (SP),HL ; Put it back + JP Z,GETCHR ; Yes - Get next character + JP SNERR ; Different - ?SN Error + +OUTC: PUSH AF ; Save character + LD A,(CTLOFG) ; Get control "O" flag + OR A ; Is it set? + JP NZ,POPAF ; Yes - don't output + POP AF ; Restore character + PUSH BC ; Save buffer length + PUSH AF ; Save character + CP ' ' ; Is it a control code? + JP C,DINPOS ; Yes - Don't INC POS(X) + LD A,(LWIDTH) ; Get line width + LD B,A ; To B + LD A,(CURPOS) ; Get cursor position + INC B ; Width 255? + JP Z,INCLEN ; Yes - No width limit + DEC B ; Restore width + CP B ; At end of line? + CALL Z,PRNTCRLF ; Yes - output CRLF +INCLEN: INC A ; Move on one character + LD (CURPOS),A ; Save new position +DINPOS: POP AF ; Restore character + POP BC ; Restore buffer length +ANSIINC: IF INCLUDE_ANSITERM = 1 + CALL ANSITERM ; Send it via the Ansi processor. + ELSE + CALL PRNT ; Send it . + ENDIF + RET + +CLOTST: CALL GETKY ; Get input character + AND 01111111B ; Strip bit 7 + CP CTRL_O ; Is it control "O"? + RET NZ ; No don't flip flag + LD A,(CTLOFG) ; Get flag + CPL ; Flip it + LD (CTLOFG),A ; Put it back + XOR A ; Null character + RET + +LIST: CALL ATOH ; ASCII number to DE + RET NZ ; Return if anything extra + POP BC ; Rubbish - Not needed + CALL SRCHLN ; Search for line number in DE + PUSH BC ; Save address of line + CALL SETLIN ; Set up lines counter +LISTLP: POP HL ; Restore address of line + LD C,(HL) ; Get LSB of next line + INC HL + LD B,(HL) ; Get MSB of next line + INC HL + LD A,B ; BC = 0 (End of program)? + OR C + JP Z,PRNTOK ; Yes - Go to command mode + CALL COUNT ; Count lines + CALL TSTBRK ; Test for break key + PUSH BC ; Save address of next line + CALL PRNTCRLF ; Output CRLF + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + INC HL + PUSH HL ; Save address of line start + EX DE,HL ; Line number to HL + CALL PRNTHL ; Output line number in decimal + LD A,' ' ; Space after line number + POP HL ; Restore start of line address +LSTLP2: CALL OUTC ; Output character in A +LSTLP3: LD A,(HL) ; Get next byte in line + OR A ; End of line? + INC HL ; To next byte in line + JP Z,LISTLP ; Yes - get next line + JP P,LSTLP2 ; No token - output it + SUB ZEND-1 ; Find and output word + LD C,A ; Token offset+1 to C + LD DE,WORDS ; Reserved word list +FNDTOK: LD A,(DE) ; Get character in list + INC DE ; Move on to next + OR A ; Is it start of word? + JP P,FNDTOK ; No - Keep looking for word + DEC C ; Count words + JP NZ,FNDTOK ; Not there - keep looking +OUTWRD: AND 01111111B ; Strip bit 7 + CALL OUTC ; Output first character + LD A,(DE) ; Get next character + INC DE ; Move on to next + OR A ; Is it end of word? + JP P,OUTWRD ; No - output the rest + JP LSTLP3 ; Next byte in line + +SETLIN: PUSH HL ; Set up LINES counter + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Save in LINES counter + POP HL + RET + +COUNT: PUSH HL ; Save code string address + PUSH DE + LD HL,(LINESC) ; Get LINES counter + LD DE,-1 + ADC HL,DE ; Decrement + LD (LINESC),HL ; Put it back + POP DE + POP HL ; Restore code string address + RET P ; Return if more lines to go + PUSH HL ; Save code string address + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + CALL GETKY ; Get input character + CP CTRL_C ; Is it control "C"? + JP Z,RSLNBK ; Yes - Reset LINES and break + POP HL ; Restore code string address + JP COUNT ; Keep on counting + +RSLNBK: LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + JP BRKRET ; Go and output "Break" + +FOR: LD A,64H ; Flag "FOR" assignment + LD (FORFLG),A ; Save "FOR" flag + CALL LET ; Set up initial index + POP BC ; Drop RETurn address + PUSH HL ; Save code string address + CALL DATA ; Get next statement address + LD (LOOPST),HL ; Save it for start of loop + LD HL,2 ; Offset for "FOR" block + ADD HL,SP ; Point to it +FORSLP: CALL LOKFOR ; Look for existing "FOR" block + POP DE ; Get code string address + JP NZ,FORFND ; No nesting found + ADD HL,BC ; Move into "FOR" block + PUSH DE ; Save code string address + DEC HL + LD D,(HL) ; Get MSB of loop statement + DEC HL + LD E,(HL) ; Get LSB of loop statement + INC HL + INC HL + PUSH HL ; Save block address + LD HL,(LOOPST) ; Get address of loop statement + CALL CPDEHL ; Compare the FOR loops + POP HL ; Restore block address + JP NZ,FORSLP ; Different FORs - Find another + POP DE ; Restore code string address + LD SP,HL ; Remove all nested loops + +FORFND: EX DE,HL ; Code string address to HL + LD C,8 + CALL CHKSTK ; Check for 8 levels of stack + PUSH HL ; Save code string address + LD HL,(LOOPST) ; Get first statement of loop + EX (SP),HL ; Save and restore code string + PUSH HL ; Re-save code string address + LD HL,(LINEAT) ; Get current line number + EX (SP),HL ; Save and restore code string + CALL TSTNUM ; Make sure it's a number + CALL CHKSYN ; Make sure "TO" is next + DB ZTO ; "TO" token + CALL GETNUM ; Get "TO" expression value + PUSH HL ; Save code string address + CALL BCDEFP ; Move "TO" value to BCDE + POP HL ; Restore code string address + PUSH BC ; Save "TO" value in block + PUSH DE + LD BC,8100H ; BCDE - 1 (default STEP) + LD D,C ; C=0 + LD E,D ; D=0 + LD A,(HL) ; Get next byte in code string + CP ZSTEP ; See if "STEP" is stated + LD A,1 ; Sign of step = 1 + JP NZ,SAVSTP ; No STEP given - Default to 1 + CALL GETCHR ; Jump over "STEP" token + CALL GETNUM ; Get step value + PUSH HL ; Save code string address + CALL BCDEFP ; Move STEP to BCDE + CALL TSTSGN ; Test sign of FPREG + POP HL ; Restore code string address +SAVSTP: PUSH BC ; Save the STEP value in block + PUSH DE + PUSH AF ; Save sign of STEP + INC SP ; Don't save flags + PUSH HL ; Save code string address + LD HL,(BRKLIN) ; Get address of index variable + EX (SP),HL ; Save and restore code string +PUTFID: LD B,ZFOR ; "FOR" block marker + PUSH BC ; Save it + INC SP ; Don't save C + +RUNCNT: CALL TSTBRK ; Execution driver - Test break + LD (BRKLIN),HL ; Save code address for break + LD A,(HL) ; Get next byte in code string + CP ':' ; Multi statement line? + JP Z,EXCUTE ; Yes - Execute it + OR A ; End of line? + JP NZ,SNERR ; No - Syntax error + INC HL ; Point to address of next line + LD A,(HL) ; Get LSB of line pointer + INC HL + OR (HL) ; Is it zero (End of prog)? + JP Z,ENDPRG ; Yes - Terminate execution + INC HL ; Point to line number + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + EX DE,HL ; Line number to HL + LD (LINEAT),HL ; Save as current line number + EX DE,HL ; Line number back to DE +EXCUTE: CALL GETCHR ; Get key word + LD DE,RUNCNT ; Where to RETurn to + PUSH DE ; Save for RETurn +IFJMP: RET Z ; Go to RUNCNT if end of STMT +ONJMP: SUB ZEND ; Is it a token? + JP C,LET ; No - try to assign it + CP ZNEW+1-ZEND ; END to NEW ? + JP NC,SNERR ; Not a key word - ?SN Error + RLCA ; Double it + LD C,A ; BC = Offset into table + LD B,0 + EX DE,HL ; Save code string address + LD HL,WORDTB ; Keyword address table + ADD HL,BC ; Point to routine address + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + PUSH BC ; Save routine address + EX DE,HL ; Restore code string address + +GETCHR: INC HL ; Point to next character + LD A,(HL) ; Get next code string byte + CP ':' ; Z if ':' + RET NC ; NC if > "9" + CP ' ' + JP Z,GETCHR ; Skip over spaces + CP '0' + CCF ; NC if < '0' + INC A ; Test for zero - Leave carry + DEC A ; Z if Null + RET + +RESTOR: EX DE,HL ; Save code string address + LD HL,(BASTXT) ; Point to start of program + JP Z,RESTNL ; Just RESTORE - reset pointer + EX DE,HL ; Restore code string address + CALL ATOH ; Get line number to DE + PUSH HL ; Save code string address + CALL SRCHLN ; Search for line number in DE + LD H,B ; HL = Address of line + LD L,C + POP DE ; Restore code string address + JP NC,ULERR ; ?UL Error if not found +RESTNL: DEC HL ; Byte before DATA statement +UPDATA: LD (NXTDAT),HL ; Update DATA pointer + EX DE,HL ; Restore code string address + RET + +TSTBRK: CALL CHKKY ; Check input status + OR A + RET Z ; No key, go back + CALL GETKY ; Get the key into A + CP ESC ; Escape key? + JR Z,BRK ; Yes, break + CP CTRL_C ; + JR Z,BRK ; Yes, break + CP CTRL_S ; Stop scrolling? + RET NZ ; Other key, ignore + + +STALL: CALL GETKY ; Wait for key + CP CTRL_Q ; Resume scrolling? + RET Z ; Release the chokehold + CP CTRL_C ; Second break? + JR Z,STOP ; Break during hold exits prog + JR STALL ; Loop until or + +BRK LD A,0FFH ; Set BRKFLG + LD (BRKFLG),A ; Store it + + +STOP: RET NZ ; Exit if anything else + DB 0F6H ; Flag "STOP" +PEND: RET NZ ; Exit if anything else + LD (BRKLIN),HL ; Save point of break + DB 21H ; Skip "OR 11111111B" +INPBRK: OR 11111111B ; Flag "Break" wanted + POP BC ; Return not needed and more +ENDPRG: LD HL,(LINEAT) ; Get current line number + PUSH AF ; Save STOP / END status + LD A,L ; Is it direct break? + AND H + INC A ; Line is -1 if direct break + JP Z,NOLIN ; Yes - No line number + LD (ERRLIN),HL ; Save line of break + LD HL,(BRKLIN) ; Get point of break + LD (CONTAD),HL ; Save point to CONTinue +NOLIN: XOR A + LD (CTLOFG),A ; Enable output + CALL STTLIN ; Start a new line + POP AF ; Restore STOP / END status + LD HL,BRKMSG ; "Break" message + JP NZ,ERRIN ; "in line" wanted? + JP PRNTOK ; Go to command mode + +CONT: LD HL,(CONTAD) ; Get CONTinue address + LD A,H ; Is it zero? + OR L + LD E,CN ; ?CN Error + JP Z,BERROR ; Yes - output "?CN Error" + EX DE,HL ; Save code string address + LD HL,(ERRLIN) ; Get line of last break + LD (LINEAT),HL ; Set up current line number + EX DE,HL ; Restore code string address + RET ; CONTinue where left off + +NULL: CALL GETINT ; Get integer 0-255 + RET NZ ; Return if bad value + LD (NULLS),A ; Set nulls number + RET + + +ACCSUM: PUSH HL ; Save address in array + LD HL,(CHKSUM) ; Get check sum + LD B,0 ; BC - Value of byte + LD C,A + ADD HL,BC ; Add byte to check sum + LD (CHKSUM),HL ; Re-save check sum + POP HL ; Restore address in array + RET + +CHKLTR: LD A,(HL) ; Get byte + CP 'A' ; < 'a' ? + RET C ; Carry set if not letter + CP 'Z'+1 ; > 'z' ? + CCF + RET ; Carry set if not letter + +FPSINT: CALL GETCHR ; Get next character +POSINT: CALL GETNUM ; Get integer 0 to 32767 +DEPINT: CALL TSTSGN ; Test sign of FPREG + JP M,FCERR ; Negative - ?FC Error +DEINT: LD A,(FPEXP) ; Get integer value to DE + CP 80H+16 ; Exponent in range (16 bits)? + JP C,FPINT ; Yes - convert it + LD BC,9080H ; BCDE = -32768 + LD DE,0000 + PUSH HL ; Save code string address + CALL CMPNUM ; Compare FPREG with BCDE + POP HL ; Restore code string address + LD D,C ; MSB to D + RET Z ; Return if in range +FCERR: LD E,FC ; ?FC Error + JP BERROR ; Output error- + +ATOH: DEC HL ; ASCII number to DE binary +GETLN: LD DE,0 ; Get number to DE +GTLNLP: CALL GETCHR ; Get next character + RET NC ; Exit if not a digit + PUSH HL ; Save code string address + PUSH AF ; Save digit + LD HL,65529/10 ; Largest number 65529 + CALL CPDEHL ; Number in range? + JP C,SNERR ; No - ?SN Error + LD H,D ; HL = Number + LD L,E + ADD HL,DE ; Times 2 + ADD HL,HL ; Times 4 + ADD HL,DE ; Times 5 + ADD HL,HL ; Times 10 + POP AF ; Restore digit + SUB '0' ; Make it 0 to 9 + LD E,A ; DE = Value of digit + LD D,0 + ADD HL,DE ; Add to number + EX DE,HL ; Number to DE + POP HL ; Restore code string address + JP GTLNLP ; Go to next character + +CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters + CALL POSINT ; Get integer 0 to 32767 to DE + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + PUSH HL ; Save code string address + LD HL,(LSTRAM) ; Get end of RAM + JP Z,STORED ; No value given - Use stored + POP HL ; Restore code string address + CALL CHKSYN ; Check for comma + DB ',' + PUSH DE ; Save number + CALL POSINT ; Get integer 0 to 32767 + DEC HL ; Cancel increment + CALL GETCHR ; Get next character + JP NZ,SNERR ; ?SN Error if more on line + EX (SP),HL ; Save code string address + EX DE,HL ; Number to DE +STORED: LD A,L ; Get LSB of new RAM top + SUB E ; Subtract LSB of string space + LD E,A ; Save LSB + LD A,H ; Get MSB of new RAM top + SBC A,D ; Subtract MSB of string space + LD D,A ; Save MSB + JP C,OMERR ; ?OM Error if not enough mem + PUSH HL ; Save RAM top + LD HL,(PROGND) ; Get program end + LD BC,40 ; 40 Bytes minimum working RAM + ADD HL,BC ; Get lowest address + CALL CPDEHL ; Enough memory? + JP NC,OMERR ; No - ?OM Error + EX DE,HL ; RAM top to HL + LD (STRSPC),HL ; Set new string space + POP HL ; End of memory to use + LD (LSTRAM),HL ; Set new top of RAM + POP HL ; Restore code string address + JP INTVAR ; Initialise variables + +RUN: JP Z,RUNFST ; RUN from start if just RUN + CALL INTVAR ; Initialise variables + LD BC,RUNCNT ; Execution driver loop + JP RUNLIN ; RUN from line number + +GOSUB: LD C,3 ; 3 Levels of stack needed + CALL CHKSTK ; Check for 3 levels of stack + POP BC ; Get return address + PUSH HL ; Save code string for RETURN + PUSH HL ; And for GOSUB routine + LD HL,(LINEAT) ; Get current line + EX (SP),HL ; Into stack - Code string out + LD A,ZGOSUB ; "GOSUB" token + PUSH AF ; Save token + INC SP ; Don't save flags + +RUNLIN: PUSH BC ; Save return address +GOTO: CALL ATOH ; ASCII number to DE binary + CALL REM ; Get end of line + PUSH HL ; Save end of line + LD HL,(LINEAT) ; Get current line + CALL CPDEHL ; Line after current? + POP HL ; Restore end of line + INC HL ; Start of next line + CALL C,SRCHLP ; Line is after current line + CALL NC,SRCHLN ; Line is before current line + LD H,B ; Set up code string address + LD L,C + DEC HL ; Incremented after + RET C ; Line found +ULERR: LD E,UL ; ?UL Error + JP BERROR ; Output error message + +RETURN: RET NZ ; Return if not just RETURN + LD D,-1 ; Flag "GOSUB" search + CALL BAKSTK ; Look "GOSUB" block + LD SP,HL ; Kill all FORs in subroutine + CP ZGOSUB ; Test for "GOSUB" token + LD E,RG ; ?RG Error + JP NZ,BERROR ; Error if no "GOSUB" found + POP HL ; Get RETURN line number + LD (LINEAT),HL ; Save as current + INC HL ; Was it from direct statement? + LD A,H + OR L ; Return to line + JP NZ,RETLIN ; No - Return to line + LD A,(LSTBIN) ; Any INPUT in subroutine? + OR A ; If so buffer is corrupted + JP NZ,POPNOK ; Yes - Go to command mode +RETLIN: LD HL,RUNCNT ; Execution driver loop + EX (SP),HL ; Into stack - Code string out + DB 3EH ; Skip "POP HL" +NXTDTA: POP HL ; Restore code string address + +DATA: DB 01H,3AH ; ':' End of statement +REM: LD C,0 ; 00 End of statement + LD B,0 +NXTSTL: LD A,C ; Statement and byte + LD C,B + LD B,A ; Statement end byte +NXTSTT: LD A,(HL) ; Get byte + OR A ; End of line? + RET Z ; Yes - Exit + CP B ; End of statement? + RET Z ; Yes - Exit + INC HL ; Next byte + CP '"' ; Literal string? + JP Z,NXTSTL ; Yes - Look for another '"' + JP NXTSTT ; Keep looking + +LET: CALL GETVAR ; Get variable name + CALL CHKSYN ; Make sure "=" follows + DB ZEQUAL ; "=" token + PUSH DE ; Save address of variable + LD A,(TYPE) ; Get data type + PUSH AF ; Save type + CALL EVAL ; Evaluate expression + POP AF ; Restore type + EX (SP),HL ; Save code - Get var addr + LD (BRKLIN),HL ; Save address of variable + RRA ; Adjust type + CALL CHKTYP ; Check types are the same + JP Z,LETNUM ; Numeric - Move value +LETSTR: PUSH HL ; Save address of string var + LD HL,(FPREG) ; Pointer to string entry + PUSH HL ; Save it on stack + INC HL ; Skip over length + INC HL + LD E,(HL) ; LSB of string address + INC HL + LD D,(HL) ; MSB of string address + LD HL,(BASTXT) ; Point to start of program + CALL CPDEHL ; Is string before program? + JP NC,CRESTR ; Yes - Create string entry + LD HL,(STRSPC) ; Point to string space + CALL CPDEHL ; Is string literal in program? + POP DE ; Restore address of string + JP NC,MVSTPT ; Yes - Set up pointer + LD HL,TMPSTR ; Temporary string pool + CALL CPDEHL ; Is string in temporary pool? + JP NC,MVSTPT ; No - Set up pointer + DB 3EH ; Skip "POP DE" +CRESTR: POP DE ; Restore address of string + CALL BAKTMP ; Back to last tmp-str entry + EX DE,HL ; Address of string entry + CALL SAVSTR ; Save string in string area +MVSTPT: CALL BAKTMP ; Back to last tmp-str entry + POP HL ; Get string pointer + CALL DETHL4 ; Move string pointer to var + POP HL ; Restore code string address + RET + +LETNUM: PUSH HL ; Save address of variable + CALL FPTHL ; Move value to variable + POP DE ; Restore address of variable + POP HL ; Restore code string address + RET + +ON: CALL GETINT ; Get integer 0-255 + LD A,(HL) ; Get "GOTO" or "GOSUB" token + LD B,A ; Save in B + CP ZGOSUB ; "GOSUB" token? + JP Z,ONGO ; Yes - Find line number + CALL CHKSYN ; Make sure it's "GOTO" + DB ZGOTO ; "GOTO" token + DEC HL ; Cancel increment +ONGO: LD C,E ; Integer of branch value +ONGOLP: DEC C ; Count branches + LD A,B ; Get "GOTO" or "GOSUB" token + JP Z,ONJMP ; Go to that line if right one + CALL GETLN ; Get line number to DE + CP ',' ; Another line number? + RET NZ ; No - Drop through + JP ONGOLP ; Yes - loop + +IF: CALL EVAL ; Evaluate expression + LD A,(HL) ; Get token + CP ZGOTO ; "GOTO" token? + JP Z,IFGO ; Yes - Get line + CALL CHKSYN ; Make sure it's "THEN" + DB ZTHEN ; "THEN" token + DEC HL ; Cancel increment +IFGO: CALL TSTNUM ; Make sure it's numeric + CALL TSTSGN ; Test state of expression + JP Z,REM ; False - Drop through + CALL GETCHR ; Get next character + JP C,GOTO ; Number - GOTO that line + JP IFJMP ; Otherwise do statement + +MRPRNT: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character +PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT +PRNTLP: RET Z ; End of list - Exit + CP ZTAB ; "TAB(" token? + JP Z,DOTAB ; Yes - Do TAB routine + CP ZSPC ; "SPC(" token? + JP Z,DOTAB ; Yes - Do SPC routine + PUSH HL ; Save code string address + CP ',' ; Comma? + JP Z,DOCOM ; Yes - Move to next zone + CP 59 ;";" ; Semi-colon? + JP Z,NEXITM ; Do semi-colon routine + POP BC ; Code string address to BC + CALL EVAL ; Evaluate expression + PUSH HL ; Save code string address + LD A,(TYPE) ; Get variable type + OR A ; Is it a string variable? + JP NZ,PRNTST ; Yes - Output string contents + CALL NUMASC ; Convert number to text + CALL CRTST ; Create temporary string + LD (HL),' ' ; Followed by a space + LD HL,(FPREG) ; Get length of output + INC (HL) ; Plus 1 for the space + LD HL,(FPREG) ; < Not needed > + LD A,(LWIDTH) ; Get width of line + LD B,A ; To B + INC B ; Width 255 (No limit)? + JP Z,PRNTNB ; Yes - Output number string + INC B ; Adjust it + LD A,(CURPOS) ; Get cursor position + ADD A,(HL) ; Add length of string + DEC A ; Adjust it + CP B ; Will output fit on this line? + CALL NC,PRNTCRLF ; No - CRLF first +PRNTNB: CALL PRS1 ; Output string at (HL) + XOR A ; Skip CALL by setting 'z' flag +PRNTST: CALL NZ,PRS1 ; Output string at (HL) + POP HL ; Restore code string address + JP MRPRNT ; See if more to PRINT + +STTLIN: LD A,(CURPOS) ; Make sure on new line + OR A ; Already at start? + RET Z ; Yes - Do nothing + JP PRNTCRLF ; Start a new line + +ENDINP: LD (HL),0 ; Mark end of buffer + LD HL,BUFFER-1 ; Point to buffer +PRNTCRLF: LD A,CR ; Load a CR + CALL OUTC ; Output character + LD A,LF ; Load a LF + CALL OUTC ; Output character +DONULL: XOR A ; Set to position 0 + LD (CURPOS),A ; Store it + LD A,(NULLS) ; Get number of nulls +NULLP: DEC A ; Count them + RET Z ; Return if done + PUSH AF ; Save count + XOR A ; Load a null + CALL OUTC ; Output it + POP AF ; Restore count + JP NULLP ; Keep counting + +DOCOM: LD A,(COMMAN) ; Get comma width + LD B,A ; Save in B + LD A,(CURPOS) ; Get current position + CP B ; Within the limit? + CALL NC,PRNTCRLF ; No - output CRLF + JP NC,NEXITM ; Get next item +ZONELP: SUB 14 ; Next zone of 14 characters + JP NC,ZONELP ; Repeat if more zones + CPL ; Number of spaces to output + JP ASPCS ; Output them + +DOTAB: PUSH AF ; Save token + CALL FNDNUM ; Evaluate expression + CALL CHKSYN ; Make sure ")" follows + DB ")" + DEC HL ; Back space on to ")" + POP AF ; Restore token + SUB ZSPC ; Was it "SPC(" ? + PUSH HL ; Save code string address + JP Z,DOSPC ; Yes - Do 'E' spaces + LD A,(CURPOS) ; Get current position +DOSPC: CPL ; Number of spaces to print to + ADD A,E ; Total number to print + JP NC,NEXITM ; TAB < Current POS(X) +ASPCS: INC A ; Output A spaces + LD B,A ; Save number to print + LD A,' ' ; Space +SPCLP: CALL OUTC ; Output character in A + DEC B ; Count them + JP NZ,SPCLP ; Repeat if more +NEXITM: POP HL ; Restore code string address + CALL GETCHR ; Get next character + JP PRNTLP ; More to print + +REDO: DB "?Redo from start",CR,LF,0 + +BADINP: LD A,(READFG) ; READ or INPUT? + OR A + JP NZ,DATSNR ; READ - ?SN Error + POP BC ; Throw away code string addr + LD HL,REDO ; "Redo from start" message + CALL PRS ; Output string + JP DOAGN ; Do last INPUT again + +INPUT: CALL IDTEST ; Test for illegal direct + LD A,(HL) ; Get character after "INPUT" + CP '"' ; Is there a prompt string? + LD A,0 ; Clear A and leave flags + LD (CTLOFG),A ; Enable output + JP NZ,NOPMPT ; No prompt - get input + CALL QTSTR ; Get string terminated by '"' + CALL CHKSYN ; Check for ';' after prompt + DB ';' + PUSH HL ; Save code string address + CALL PRS1 ; Output prompt string + DB 3EH ; Skip "PUSH HL" +NOPMPT: PUSH HL ; Save code string address + CALL PROMPT ; Get input with "? " prompt + POP BC ; Restore code string address + JP C,INPBRK ; Break pressed - Exit + INC HL ; Next byte + LD A,(HL) ; Get it + OR A ; End of line? + DEC HL ; Back again + PUSH BC ; Re-save code string address + JP Z,NXTDTA ; Yes - Find next DATA stmt + LD (HL),',' ; Store comma as separator + JP NXTITM ; Get next item + +READ: PUSH HL ; Save code string address + LD HL,(NXTDAT) ; Next DATA statement + DB 0F6H ; Flag "READ" +NXTITM: XOR A ; Flag "INPUT" + LD (READFG),A ; Save "READ"/"INPUT" flag + EX (SP),HL ; Get code str' , Save pointer + JP GTVLUS ; Get values + +NEDMOR: CALL CHKSYN ; Check for comma between items + DB ',' +GTVLUS: CALL GETVAR ; Get variable name + EX (SP),HL ; Save code str" , Get pointer + PUSH DE ; Save variable address + LD A,(HL) ; Get next "INPUT"/"DATA" byte + CP ',' ; Comma? + JP Z,ANTVLU ; Yes - Get another value + LD A,(READFG) ; Is it READ? + OR A + JP NZ,FDTLP ; Yes - Find next DATA stmt + LD A,'?' ; More INPUT needed + CALL OUTC ; Output character + CALL PROMPT ; Get INPUT with prompt + POP DE ; Variable address + POP BC ; Code string address + JP C,INPBRK ; Break pressed + INC HL ; Point to next DATA byte + LD A,(HL) ; Get byte + OR A ; Is it zero (No input) ? + DEC HL ; Back space INPUT pointer + PUSH BC ; Save code string address + JP Z,NXTDTA ; Find end of buffer + PUSH DE ; Save variable address +ANTVLU: LD A,(TYPE) ; Check data type + OR A ; Is it numeric? + JP Z,INPBIN ; Yes - Convert to binary + CALL GETCHR ; Get next character + LD D,A ; Save input character + LD B,A ; Again + CP '"' ; Start of literal sting? + JP Z,STRENT ; Yes - Create string entry + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + LD D,A ; Save 00 if "INPUT" + JP Z,ITMSEP ; "INPUT" - End with 00 + LD D,':' ; "DATA" - End with 00 or ':' +ITMSEP: LD B,',' ; Item separator + DEC HL ; Back space for DTSTR +STRENT: CALL DTSTR ; Get string terminated by D + EX DE,HL ; String address to DE + LD HL,LTSTND ; Where to go after LETSTR + EX (SP),HL ; Save HL , get input pointer + PUSH DE ; Save address of string + JP LETSTR ; Assign string to variable + +INPBIN: CALL GETCHR ; Get next character + CALL ASCTFP ; Convert ASCII to FP number + EX (SP),HL ; Save input ptr, Get var addr + CALL FPTHL ; Move FPREG to variable + POP HL ; Restore input pointer +LTSTND: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,MORDT ; End of line - More needed? + CP ',' ; Another value? + JP NZ,BADINP ; No - Bad input +MORDT: EX (SP),HL ; Get code string address + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,NEDMOR ; More needed - Get it + POP DE ; Restore DATA pointer + LD A,(READFG) ; "READ" or "INPUT" ? + OR A + EX DE,HL ; DATA pointer to HL + JP NZ,UPDATA ; Update DATA pointer if "READ" + PUSH DE ; Save code string address + OR (HL) ; More input given? + LD HL,EXTIG ; "?Extra ignored" message + CALL NZ,PRS ; Output string if extra given + POP HL ; Restore code string address + RET + +EXTIG: DB "?Extra ignored",CR,LF,0 + +FDTLP: CALL DATA ; Get next statement + OR A ; End of line? + JP NZ,FANDT ; No - See if DATA statement + INC HL + LD A,(HL) ; End of program? + INC HL + OR (HL) ; 00 00 Ends program + LD E,OD ; ?OD Error + JP Z,BERROR ; Yes - Out of DATA + INC HL + LD E,(HL) ; LSB of line number + INC HL + LD D,(HL) ; MSB of line number + EX DE,HL + LD (DATLIN),HL ; Set line of current DATA item + EX DE,HL +FANDT: CALL GETCHR ; Get next character + CP ZDATA ; "DATA" token + JP NZ,FDTLP ; No "DATA" - Keep looking + JP ANTVLU ; Found - Convert input + +NEXT: LD DE,0 ; In case no index given +NEXT1: CALL NZ,GETVAR ; Get index address + LD (BRKLIN),HL ; Save code string address + CALL BAKSTK ; Look for "FOR" block + JP NZ,NFERR ; No "FOR" - ?NF Error + LD SP,HL ; Clear nested loops + PUSH DE ; Save index address + LD A,(HL) ; Get sign of STEP + INC HL + PUSH AF ; Save sign of STEP + PUSH DE ; Save index address + CALL PHLTFP ; Move index value to FPREG + EX (SP),HL ; Save address of TO value + PUSH HL ; Save address of index + CALL ADDPHL ; Add STEP to index value + POP HL ; Restore address of index + CALL FPTHL ; Move value to index variable + POP HL ; Restore address of TO value + CALL LOADFP ; Move TO value to BCDE + PUSH HL ; Save address of line of FOR + CALL CMPNUM ; Compare index with TO value + POP HL ; Restore address of line num + POP BC ; Address of sign of STEP + SUB B ; Compare with expected sign + CALL LOADFP ; BC = Loop stmt,DE = Line num + JP Z,KILFOR ; Loop finished - Terminate it + EX DE,HL ; Loop statement line number + LD (LINEAT),HL ; Set loop line number + LD L,C ; Set code string to loop + LD H,B + JP PUTFID ; Put back "FOR" and continue + +KILFOR: LD SP,HL ; Remove "FOR" block + LD HL,(BRKLIN) ; Code string after "NEXT" + LD A,(HL) ; Get next byte in code string + CP ',' ; More NEXTs ? + JP NZ,RUNCNT ; No - Do next statement + CALL GETCHR ; Position to index name + CALL NEXT1 ; Re-enter NEXT routine + ; < will not RETurn to here , Exit to RUNCNT or Loop > + +GETNUM: CALL EVAL ; Get a numeric expression +TSTNUM: DB 0F6H ; Clear carry (numeric) +TSTSTR: SCF ; Set carry (string) +CHKTYP: LD A,(TYPE) ; Check types match + ADC A,A ; Expected + actual + OR A ; Clear carry , set parity + RET PE ; Even parity - Types match + JP TMERR ; Different types - Error + +OPNPAR: CALL CHKSYN ; Make sure "(" follows + DB "(" +EVAL: DEC HL ; Evaluate expression & save + LD D,0 ; Precedence value +EVAL1: PUSH DE ; Save precedence + LD C,1 + CALL CHKSTK ; Check for 1 level of stack + CALL OPRND ; Get next expression value +EVAL2: LD (NXTOPR),HL ; Save address of next operator +EVAL3: LD HL,(NXTOPR) ; Restore address of next opr + POP BC ; Precedence value and operator + LD A,B ; Get precedence value + CP 78H ; "AND" or "OR" ? + CALL NC,TSTNUM ; No - Make sure it's a number + LD A,(HL) ; Get next operator / function + LD D,0 ; Clear Last relation +RLTLP: SUB ZGTR ; ">" Token + JP C,FOPRND ; + - * / ^ AND OR - Test it + CP ZLTH+1-ZGTR ; < = > + JP NC,FOPRND ; Function - Call it + CP ZEQUAL-ZGTR ; "=" + RLA ; <- Test for legal + XOR D ; <- combinations of < = > + CP D ; <- by combining last token + LD D,A ; <- with current one + JP C,SNERR ; Error if "<<' '==" or ">>" + LD (CUROPR),HL ; Save address of current token + CALL GETCHR ; Get next character + JP RLTLP ; Treat the two as one + +FOPRND: LD A,D ; < = > found ? + OR A + JP NZ,TSTRED ; Yes - Test for reduction + LD A,(HL) ; Get operator token + LD (CUROPR),HL ; Save operator address + SUB ZPLUS ; Operator or function? + RET C ; Neither - Exit + CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? + RET NC ; No - Exit + LD E,A ; Coded operator + LD A,(TYPE) ; Get data type + DEC A ; FF = numeric , 00 = string + OR E ; Combine with coded operator + LD A,E ; Get coded operator + JP Z,CONCAT ; String concatenation + RLCA ; Times 2 + ADD A,E ; Times 3 + LD E,A ; To DE (D is 0) + LD HL,PRITAB ; Precedence table + ADD HL,DE ; To the operator concerned + LD A,B ; Last operator precedence + LD D,(HL) ; Get evaluation precedence + CP D ; Compare with eval precedence + RET NC ; Exit if higher precedence + INC HL ; Point to routine address + CALL TSTNUM ; Make sure it's a number + +STKTHS: PUSH BC ; Save last precedence & token + LD BC,EVAL3 ; Where to go on prec' break + PUSH BC ; Save on stack for return + LD B,E ; Save operator + LD C,D ; Save precedence + CALL STAKFP ; Move value to stack + LD E,B ; Restore operator + LD D,C ; Restore precedence + LD C,(HL) ; Get LSB of routine address + INC HL + LD B,(HL) ; Get MSB of routine address + INC HL + PUSH BC ; Save routine address + LD HL,(CUROPR) ; Address of current operator + JP EVAL1 ; Loop until prec' break + +OPRND: XOR A ; Get operand routine + LD (TYPE),A ; Set numeric expected + CALL GETCHR ; Get next character + LD E,MO ; ?MO Error + JP Z,BERROR ; No operand - Error + JP C,ASCTFP ; Number - Get value + CALL CHKLTR ; See if a letter + JP NC,CONVAR ; Letter - Find variable + CP '&' ; &H = HEX, &B = BINARY [G. Searle] + JR NZ, NOTAMP + CALL GETCHR ; Get next character + CP 'H' ; Hex number indicated? [function added] + JP Z,HEXTFP ; Convert Hex to FPREG + CP 'B' ; Binary number indicated? [function added] + JP Z,BINTFP ; Convert Bin to FPREG + LD E,SN ; If neither then a ?SN Error + JP Z,BERROR ; +NOTAMP: CP ZPLUS ; '+' Token ? + JP Z,OPRND ; Yes - Look for operand + CP '.' ; '.' ? + JP Z,ASCTFP ; Yes - Create FP number + CP ZMINUS ; '-' Token ? + JP Z,MINUS ; Yes - Do minus + CP '"' ; Literal string ? + JP Z,QTSTR ; Get string terminated by '"' + CP ZNOT ; "NOT" Token ? + JP Z,EVNOT ; Yes - Eval NOT expression + CP ZFN ; "FN" Token ? + JP Z,DOFN ; Yes - Do FN routine + SUB ZSGN ; Is it a function? + JP NC,FNOFST ; Yes - Evaluate function +EVLPAR: CALL OPNPAR ; Evaluate expression in "()" + CALL CHKSYN ; Make sure ")" follows + DB ")" + RET + +MINUS: LD D,7DH ; '-' precedence + CALL EVAL1 ; Evaluate until prec' break + LD HL,(NXTOPR) ; Get next operator address + PUSH HL ; Save next operator address + CALL INVSGN ; Negate value +RETNUM: CALL TSTNUM ; Make sure it's a number + POP HL ; Restore next operator address + RET + +CONVAR: CALL GETVAR ; Get variable address to DE +FRMEVL: PUSH HL ; Save code string address + EX DE,HL ; Variable address to HL + LD (FPREG),HL ; Save address of variable + LD A,(TYPE) ; Get type + OR A ; Numeric? + CALL Z,PHLTFP ; Yes - Move contents to FPREG + POP HL ; Restore code string address + RET + +FNOFST: LD B,0 ; Get address of function + RLCA ; Double function offset + LD C,A ; BC = Offset in function table + PUSH BC ; Save adjusted token value + CALL GETCHR ; Get next character + LD A,C ; Get adjusted token value + CP 2*(ZLEFT-ZSGN)-1 ; Adj' LEFT$,RIGHT$ or MID$ ? + JP C,FNVAL ; No - Do function + CALL OPNPAR ; Evaluate expression (X,... + CALL CHKSYN ; Make sure ',' follows + DB ',' + CALL TSTSTR ; Make sure it's a string + EX DE,HL ; Save code string address + LD HL,(FPREG) ; Get address of string + EX (SP),HL ; Save address of string + PUSH HL ; Save adjusted token value + EX DE,HL ; Restore code string address + CALL GETINT ; Get integer 0-255 + EX DE,HL ; Save code string address + EX (SP),HL ; Save integer,HL = adj' token + JP GOFUNC ; Jump to string function + +FNVAL: CALL EVLPAR ; Evaluate expression + EX (SP),HL ; HL = Adjusted token value + LD DE,RETNUM ; Return number from function + PUSH DE ; Save on stack +GOFUNC: LD BC,FNCTAB ; Function routine addresses + ADD HL,BC ; Point to right address + LD C,(HL) ; Get LSB of address + INC HL ; + LD H,(HL) ; Get MSB of address + LD L,C ; Address to HL + JP (HL) ; Jump to function + +SGNEXP: DEC D ; Dee to flag negative exponent + CP ZMINUS ; '-' token ? + RET Z ; Yes - Return + CP '-' ; '-' ASCII ? + RET Z ; Yes - Return + INC D ; Inc to flag positive exponent + CP '+' ; '+' ASCII ? + RET Z ; Yes - Return + CP ZPLUS ; '+' token ? + RET Z ; Yes - Return + DEC HL ; DEC 'cos GETCHR INCs + RET ; Return "NZ" + +POR: DB 0F6H ; Flag "OR" +PAND: XOR A ; Flag "AND" + PUSH AF ; Save "AND" / "OR" flag + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + EX DE,HL ; <- Get last + POP BC ; <- value + EX (SP),HL ; <- from + EX DE,HL ; <- stack + CALL FPBCDE ; Move last value to FPREG + PUSH AF ; Save "AND" / "OR" flag + CALL DEINT ; Get integer -32768 to 32767 + POP AF ; Restore "AND" / "OR" flag + POP BC ; Get value + LD A,C ; Get LSB + LD HL,ACPASS ; Address of save AC as current + JP NZ,POR1 ; Jump if OR + AND E ; "AND" LSBs + LD C,A ; Save LSB + LD A,B ; Get MBS + AND D ; "AND" MSBs + JP (HL) ; Save AC as current (ACPASS) + +POR1: OR E ; "OR" LSBs + LD C,A ; Save LSB + LD A,B ; Get MSB + OR D ; "OR" MSBs + JP (HL) ; Save AC as current (ACPASS) + +TSTRED: LD HL,CMPLOG ; Logical compare routine + LD A,(TYPE) ; Get data type + RRA ; Carry set = string + LD A,D ; Get last precedence value + RLA ; Times 2 plus carry + LD E,A ; To E + LD D,64H ; Relational precedence + LD A,B ; Get current precedence + CP D ; Compare with last + RET NC ; Eval if last was rel' or log' + JP STKTHS ; Stack this one and get next + +CMPLOG: DW CMPLG1 ; Compare two values / strings +CMPLG1: LD A,C ; Get data type + OR A + RRA + POP BC ; Get last expression to BCDE + POP DE + PUSH AF ; Save status + CALL CHKTYP ; Check that types match + LD HL,CMPRES ; Result to comparison + PUSH HL ; Save for RETurn + JP Z,CMPNUM ; Compare values if numeric + XOR A ; Compare two strings + LD (TYPE),A ; Set type to numeric + PUSH DE ; Save string name + CALL GSTRCU ; Get current string + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + POP DE ; Restore string name + PUSH BC ; Save address of string + PUSH AF ; Save length of string + CALL GSTRDE ; Get second string + CALL LOADFP ; Get address of second string + POP AF ; Restore length of string 1 + LD D,A ; Length to D + POP HL ; Restore address of string 1 +CMPSTR: LD A,E ; Bytes of string 2 to do + OR D ; Bytes of string 1 to do + RET Z ; Exit if all bytes compared + LD A,D ; Get bytes of string 1 to do + SUB 1 + RET C ; Exit if end of string 1 + XOR A + CP E ; Bytes of string 2 to do + INC A + RET NC ; Exit if end of string 2 + DEC D ; Count bytes in string 1 + DEC E ; Count bytes in string 2 + LD A,(BC) ; Byte in string 2 + CP (HL) ; Compare to byte in string 1 + INC HL ; Move up string 1 + INC BC ; Move up string 2 + JP Z,CMPSTR ; Same - Try next bytes + CCF ; Flag difference (">" or "<") + JP FLGDIF ; "<" gives -1 , ">" gives +1 + +CMPRES: INC A ; Increment current value + ADC A,A ; Double plus carry + POP BC ; Get other value + AND B ; Combine them + ADD A,-1 ; Carry set if different + SBC A,A ; 00 - Equal , FF - Different + JP FLGREL ; Set current value & continue + +EVNOT: LD D,5AH ; Precedence value for "NOT" + CALL EVAL1 ; Eval until precedence break + CALL TSTNUM ; Make sure it's a number + CALL DEINT ; Get integer -32768 - 32767 + LD A,E ; Get LSB + CPL ; Invert LSB + LD C,A ; Save "NOT" of LSB + LD A,D ; Get MSB + CPL ; Invert MSB + CALL ACPASS ; Save AC as current + POP BC ; Clean up stack + JP EVAL3 ; Continue evaluation + +DIMRET: DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + RET Z ; End of DIM statement + CALL CHKSYN ; Make sure ',' follows + DB ',' +DIM: LD BC,DIMRET ; Return to "DIMRET" + PUSH BC ; Save on stack + DB 0F6H ; Flag "Create" variable +GETVAR: XOR A ; Find variable address,to DE + LD (LCRFLG),A ; Set locate / create flag + LD B,(HL) ; Get First byte of name +GTFNAM: CALL CHKLTR ; See if a letter + JP C,SNERR ; ?SN Error if not a letter + XOR A + LD C,A ; Clear second byte of name + LD (TYPE),A ; Set type to numeric + CALL GETCHR ; Get next character + JP C,SVNAM2 ; Numeric - Save in name + CALL CHKLTR ; See if a letter + JP C,CHARTY ; Not a letter - Check type +SVNAM2: LD C,A ; Save second byte of name +ENDNAM: CALL GETCHR ; Get next character + JP C,ENDNAM ; Numeric - Get another + CALL CHKLTR ; See if a letter + JP NC,ENDNAM ; Letter - Get another +CHARTY: SUB '$' ; String variable? + JP NZ,NOTSTR ; No - Numeric variable + INC A ; A = 1 (string type) + LD (TYPE),A ; Set type to string + RRCA ; A = 80H , Flag for string + ADD A,C ; 2nd byte of name has bit 7 on + LD C,A ; Resave second byte on name + CALL GETCHR ; Get next character +NOTSTR: LD A,(FORFLG) ; Array name needed ? + DEC A + JP Z,ARLDSV ; Yes - Get array name + JP P,NSCFOR ; No array with "FOR" or "FN" + LD A,(HL) ; Get byte again + SUB '(' ; Subscripted variable? + JP Z,SBSCPT ; Yes - Sort out subscript + +NSCFOR: XOR A ; Simple variable + LD (FORFLG),A ; Clear "FOR" flag + PUSH HL ; Save code string address + LD D,B ; DE = Variable name to find + LD E,C + LD HL,(FNRGNM) ; FN argument name + CALL CPDEHL ; Is it the FN argument? + LD DE,FNARG ; Point to argument value + JP Z,POPHRT ; Yes - Return FN argument value + LD HL,(VAREND) ; End of variables + EX DE,HL ; Address of end of search + LD HL,(PROGND) ; Start of variables address +FNDVAR: CALL CPDEHL ; End of variable list table? + JP Z,CFEVAL ; Yes - Called from EVAL? + LD A,C ; Get second byte of name + SUB (HL) ; Compare with name in list + INC HL ; Move on to first byte + JP NZ,FNTHR ; Different - Find another + LD A,B ; Get first byte of name + SUB (HL) ; Compare with name in list +FNTHR: INC HL ; Move on to LSB of value + JP Z,RETADR ; Found - Return address + INC HL ; <- Skip + INC HL ; <- over + INC HL ; <- F.P. + INC HL ; <- value + JP FNDVAR ; Keep looking + +CFEVAL: POP HL ; Restore code string address + EX (SP),HL ; Get return address + PUSH DE ; Save address of variable + LD DE,FRMEVL ; Return address in EVAL + CALL CPDEHL ; Called from EVAL ? + POP DE ; Restore address of variable + JP Z,RETNUL ; Yes - Return null variable + EX (SP),HL ; Put back return + PUSH HL ; Save code string address + PUSH BC ; Save variable name + LD BC,6 ; 2 byte name plus 4 byte data + LD HL,(ARREND) ; End of arrays + PUSH HL ; Save end of arrays + ADD HL,BC ; Move up 6 bytes + POP BC ; Source address in BC + PUSH HL ; Save new end address + CALL MOVUP ; Move arrays up + POP HL ; Restore new end address + LD (ARREND),HL ; Set new end address + LD H,B ; End of variables to HL + LD L,C + LD (VAREND),HL ; Set new end address + +ZEROLP: DEC HL ; Back through to zero variable + LD (HL),0 ; Zero byte in variable + CALL CPDEHL ; Done them all? + JP NZ,ZEROLP ; No - Keep on going + POP DE ; Get variable name + LD (HL),E ; Store second character + INC HL + LD (HL),D ; Store first character + INC HL +RETADR: EX DE,HL ; Address of variable in DE + POP HL ; Restore code string address + RET + +RETNUL: LD (FPEXP),A ; Set result to zero + LD HL,ZERBYT ; Also set a null string + LD (FPREG),HL ; Save for EVAL + POP HL ; Restore code string address + RET + +SBSCPT: PUSH HL ; Save code string address + LD HL,(LCRFLG) ; Locate/Create and Type + EX (SP),HL ; Save and get code string + LD D,A ; Zero number of dimensions +SCPTLP: PUSH DE ; Save number of dimensions + PUSH BC ; Save array name + CALL FPSINT ; Get subscript (0-32767) + POP BC ; Restore array name + POP AF ; Get number of dimensions + EX DE,HL + EX (SP),HL ; Save subscript value + PUSH HL ; Save LCRFLG and TYPE + EX DE,HL + INC A ; Count dimensions + LD D,A ; Save in D + LD A,(HL) ; Get next byte in code string + CP ',' ; Comma (more to come)? + JP Z,SCPTLP ; Yes - More subscripts + CALL CHKSYN ; Make sure ")" follows + DB ")" + LD (NXTOPR),HL ; Save code string address + POP HL ; Get LCRFLG and TYPE + LD (LCRFLG),HL ; Restore Locate/create & type + LD E,0 ; Flag not CSAVE* or CLOAD* + PUSH DE ; Save number of dimensions (D) + DB 11H ; Skip "PUSH HL" and "PUSH AF' + +ARLDSV: PUSH HL ; Save code string address + PUSH AF ; A = 00 , Flags set = Z,N + LD HL,(VAREND) ; Start of arrays + DB 3EH ; Skip "ADD HL,DE" +FNDARY: ADD HL,DE ; Move to next array start + EX DE,HL + LD HL,(ARREND) ; End of arrays + EX DE,HL ; Current array pointer + CALL CPDEHL ; End of arrays found? + JP Z,CREARY ; Yes - Create array + LD A,(HL) ; Get second byte of name + CP C ; Compare with name given + INC HL ; Move on + JP NZ,NXTARY ; Different - Find next array + LD A,(HL) ; Get first byte of name + CP B ; Compare with name given +NXTARY: INC HL ; Move on + LD E,(HL) ; Get LSB of next array address + INC HL + LD D,(HL) ; Get MSB of next array address + INC HL + JP NZ,FNDARY ; Not found - Keep looking + LD A,(LCRFLG) ; Found Locate or Create it? + OR A + JP NZ,DDERR ; Create - ?DD Error + POP AF ; Locate - Get number of dim'ns + LD B,H ; BC Points to array dim'ns + LD C,L + JP Z,POPHRT ; Jump if array load/save + SUB (HL) ; Same number of dimensions? + JP Z,FINDEL ; Yes - Find element +BSERR: LD E,BS ; ?BS Error + JP BERROR ; Output error + +CREARY: LD DE,4 ; 4 Bytes per entry + POP AF ; Array to save or 0 dim'ns? + JP Z,FCERR ; Yes - ?FC Error + LD (HL),C ; Save second byte of name + INC HL + LD (HL),B ; Save first byte of name + INC HL + LD C,A ; Number of dimensions to C + CALL CHKSTK ; Check if enough memory + INC HL ; Point to number of dimensions + INC HL + LD (CUROPR),HL ; Save address of pointer + LD (HL),C ; Set number of dimensions + INC HL + LD A,(LCRFLG) ; Locate of Create? + RLA ; Carry set = Create + LD A,C ; Get number of dimensions +CRARLP: LD BC,10+1 ; Default dimension size 10 + JP NC,DEFSIZ ; Locate - Set default size + POP BC ; Get specified dimension size + INC BC ; Include zero element +DEFSIZ: LD (HL),C ; Save LSB of dimension size + INC HL + LD (HL),B ; Save MSB of dimension size + INC HL + PUSH AF ; Save num' of dim'ns an status + PUSH HL ; Save address of dim'n size + CALL MLDEBC ; Multiply DE by BC to find + EX DE,HL ; amount of mem needed (to DE) + POP HL ; Restore address of dimension + POP AF ; Restore number of dimensions + DEC A ; Count them + JP NZ,CRARLP ; Do next dimension if more + PUSH AF ; Save locate/create flag + LD B,D ; MSB of memory needed + LD C,E ; LSB of memory needed + EX DE,HL + ADD HL,DE ; Add bytes to array start + JP C,OMERR ; Too big - Error + CALL ENFMEM ; See if enough memory + LD (ARREND),HL ; Save new end of array + +ZERARY: DEC HL ; Back through array data + LD (HL),0 ; Set array element to zero + CALL CPDEHL ; All elements zeroed? + JP NZ,ZERARY ; No - Keep on going + INC BC ; Number of bytes + 1 + LD D,A ; A=0 + LD HL,(CUROPR) ; Get address of array + LD E,(HL) ; Number of dimensions + EX DE,HL ; To HL + ADD HL,HL ; Two bytes per dimension size + ADD HL,BC ; Add number of bytes + EX DE,HL ; Bytes needed to DE + DEC HL + DEC HL + LD (HL),E ; Save LSB of bytes needed + INC HL + LD (HL),D ; Save MSB of bytes needed + INC HL + POP AF ; Locate / Create? + JP C,ENDDIM ; A is 0 , End if create +FINDEL: LD B,A ; Find array element + LD C,A + LD A,(HL) ; Number of dimensions + INC HL + DB 16H ; Skip "POP HL" +FNDELP: POP HL ; Address of next dim' size + LD E,(HL) ; Get LSB of dim'n size + INC HL + LD D,(HL) ; Get MSB of dim'n size + INC HL + EX (SP),HL ; Save address - Get index + PUSH AF ; Save number of dim'ns + CALL CPDEHL ; Dimension too large? + JP NC,BSERR ; Yes - ?BS Error + PUSH HL ; Save index + CALL MLDEBC ; Multiply previous by size + POP DE ; Index supplied to DE + ADD HL,DE ; Add index to pointer + POP AF ; Number of dimensions + DEC A ; Count them + LD B,H ; MSB of pointer + LD C,L ; LSB of pointer + JP NZ,FNDELP ; More - Keep going + ADD HL,HL ; 4 Bytes per element + ADD HL,HL + POP BC ; Start of array + ADD HL,BC ; Point to element + EX DE,HL ; Address of element to DE +ENDDIM: LD HL,(NXTOPR) ; Got code string address + RET + +FRE: LD HL,(ARREND) ; Start of free memory + EX DE,HL ; To DE + LD HL,0 ; End of free memory + ADD HL,SP ; Current stack value + LD A,(TYPE) ; Dummy argument type + OR A + JP Z,FRENUM ; Numeric - Free variable space + CALL GSTRCU ; Current string to pool + CALL GARBGE ; Garbage collection + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string space +FRENUM: LD A,L ; Get LSB of end + SUB E ; Subtract LSB of beginning + LD C,A ; Save difference if C + LD A,H ; Get MSB of end + SBC A,D ; Subtract MSB of beginning +ACPASS: LD B,C ; Return integer AC +ABPASS: LD D,B ; Return integer AB + LD E,0 + LD HL,TYPE ; Point to type + LD (HL),E ; Set type to numeric + LD B,80H+16 ; 16 bit integer + JP RETINT ; Return the integr + +POS: LD A,(CURPOS) ; Get cursor position +PASSA: LD B,A ; Put A into AB + XOR A ; Zero A + JP ABPASS ; Return integer AB + +DEF: CALL CHEKFN ; Get "FN" and name + CALL IDTEST ; Test for illegal direct + LD BC,DATA ; To get next statement + PUSH BC ; Save address for RETurn + PUSH DE ; Save address of function ptr + CALL CHKSYN ; Make sure "(" follows + DB "(" + CALL GETVAR ; Get argument variable name + PUSH HL ; Save code string address + EX DE,HL ; Argument address to HL + DEC HL + LD D,(HL) ; Get first byte of arg name + DEC HL + LD E,(HL) ; Get second byte of arg name + POP HL ; Restore code string address + CALL TSTNUM ; Make sure numeric argument + CALL CHKSYN ; Make sure ")" follows + DB ")" + CALL CHKSYN ; Make sure "=" follows + DB ZEQUAL ; "=" token + LD B,H ; Code string address to BC + LD C,L + EX (SP),HL ; Save code str , Get FN ptr + LD (HL),C ; Save LSB of FN code string + INC HL + LD (HL),B ; Save MSB of FN code string + JP SVSTAD ; Save address and do function + +DOFN: CALL CHEKFN ; Make sure FN follows + PUSH DE ; Save function pointer address + CALL EVLPAR ; Evaluate expression in "()" + CALL TSTNUM ; Make sure numeric result + EX (SP),HL ; Save code str , Get FN ptr + LD E,(HL) ; Get LSB of FN code string + INC HL + LD D,(HL) ; Get MSB of FN code string + INC HL + LD A,D ; And function DEFined? + OR E + JP Z,UFERR ; No - ?UF Error + LD A,(HL) ; Get LSB of argument address + INC HL + LD H,(HL) ; Get MSB of argument address + LD L,A ; HL = Arg variable address + PUSH HL ; Save it + LD HL,(FNRGNM) ; Get old argument name + EX (SP),HL ; ; Save old , Get new + LD (FNRGNM),HL ; Set new argument name + LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value + PUSH HL ; Save it + LD HL,(FNARG) ; Get MSB,EXP of old arg value + PUSH HL ; Save it + LD HL,FNARG ; HL = Value of argument + PUSH DE ; Save FN code string address + CALL FPTHL ; Move FPREG to argument + POP HL ; Get FN code string address + CALL GETNUM ; Get value from function + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP NZ,SNERR ; Bad character in FN - Error + POP HL ; Get MSB,EXP of old arg + LD (FNARG),HL ; Restore it + POP HL ; Get LSB,NLSB of old arg + LD (FNARG+2),HL ; Restore it + POP HL ; Get name of old arg + LD (FNRGNM),HL ; Restore it + POP HL ; Restore code string address + RET + +IDTEST: PUSH HL ; Save code string address + LD HL,(LINEAT) ; Get current line number + INC HL ; -1 means direct statement + LD A,H + OR L + POP HL ; Restore code string address + RET NZ ; Return if in program + LD E,ID ; ?ID Error + JP BERROR + +CHEKFN: CALL CHKSYN ; Make sure FN follows + DB ZFN ; "FN" token + LD A,80H + LD (FORFLG),A ; Flag FN name to find + OR (HL) ; FN name has bit 7 set + LD B,A ; in first byte of name + CALL GTFNAM ; Get FN name + JP TSTNUM ; Make sure numeric function + +STR: CALL TSTNUM ; Make sure it's a number + CALL NUMASC ; Turn number into text +STR1: CALL CRTST ; Create string entry for it + CALL GSTRCU ; Current string to pool + LD BC,TOPOOL ; Save in string pool + PUSH BC ; Save address on stack + +SAVSTR: LD A,(HL) ; Get string length + INC HL + INC HL + PUSH HL ; Save pointer to string + CALL TESTR ; See if enough string space + POP HL ; Restore pointer to string + LD C,(HL) ; Get LSB of address + INC HL + LD B,(HL) ; Get MSB of address + CALL CRTMST ; Create string entry + PUSH HL ; Save pointer to MSB of addr + LD L,A ; Length of string + CALL TOSTRA ; Move to string area + POP DE ; Restore pointer to MSB + RET + +MKTMST: CALL TESTR ; See if enough string space +CRTMST: LD HL,TMPSTR ; Temporary string + PUSH HL ; Save it + LD (HL),A ; Save length of string + INC HL +SVSTAD: INC HL + LD (HL),E ; Save LSB of address + INC HL + LD (HL),D ; Save MSB of address + POP HL ; Restore pointer + RET + +CRTST: DEC HL ; DEC - INCed after +QTSTR: LD B,'"' ; Terminating quote + LD D,B ; Quote to D +DTSTR: PUSH HL ; Save start + LD C,-1 ; Set counter to -1 +QTSTLP: INC HL ; Move on + LD A,(HL) ; Get byte + INC C ; Count bytes + OR A ; End of line? + JP Z,CRTSTE ; Yes - Create string entry + CP D ; Terminator D found? + JP Z,CRTSTE ; Yes - Create string entry + CP B ; Terminator B found? + JP NZ,QTSTLP ; No - Keep looking +CRTSTE: CP '"' ; End with '"'? + CALL Z,GETCHR ; Yes - Get next character + EX (SP),HL ; Starting quote + INC HL ; First byte of string + EX DE,HL ; To DE + LD A,C ; Get length + CALL CRTMST ; Create string entry +TSTOPL: LD DE,TMPSTR ; Temporary string + LD HL,(TMSTPT) ; Temporary string pool pointer + LD (FPREG),HL ; Save address of string ptr + LD A,1 + LD (TYPE),A ; Set type to string + CALL DETHL4 ; Move string to pool + CALL CPDEHL ; Out of string pool? + LD (TMSTPT),HL ; Save new pointer + POP HL ; Restore code string address + LD A,(HL) ; Get next code byte + RET NZ ; Return if pool OK + LD E,ST ; ?ST Error + JP BERROR ; String pool overflow + +PRNUMS: INC HL ; Skip leading space +PRS: CALL CRTST ; Create string entry for it +PRS1: CALL GSTRCU ; Current string to pool + CALL LOADFP ; Move string block to BCDE + INC E ; Length + 1 +PRSLP: DEC E ; Count characters + RET Z ; End of string + LD A,(BC) ; Get byte to output + CALL OUTC ; Output character in A + CP CR ; Return? + CALL Z,DONULL ; Yes - Do nulls + INC BC ; Next byte in string + JP PRSLP ; More characters to output + +TESTR: OR A ; Test if enough room + DB 0EH ; No garbage collection done +GRBDON: POP AF ; Garbage collection done + PUSH AF ; Save status + LD HL,(STRSPC) ; Bottom of string space in use + EX DE,HL ; To DE + LD HL,(STRBOT) ; Bottom of string area + CPL ; Negate length (Top down) + LD C,A ; -Length to BC + LD B,-1 ; BC = -ve length of string + ADD HL,BC ; Add to bottom of space in use + INC HL ; Plus one for 2's complement + CALL CPDEHL ; Below string RAM area? + JP C,TESTOS ; Tidy up if not done else err + LD (STRBOT),HL ; Save new bottom of area + INC HL ; Point to first byte of string + EX DE,HL ; Address to DE +POPAF: POP AF ; Throw away status push + RET + +TESTOS: POP AF ; Garbage collect been done? + LD E,OS ; ?OS Error + JP Z,BERROR ; Yes - Not enough string apace + CP A ; Flag garbage collect done + PUSH AF ; Save status + LD BC,GRBDON ; Garbage collection done + PUSH BC ; Save for RETurn +GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer +GARBLP: LD (STRBOT),HL ; Reset string pointer + LD HL,0 + PUSH HL ; Flag no string found + LD HL,(STRSPC) ; Get bottom of string space + PUSH HL ; Save bottom of string space + LD HL,TMSTPL ; Temporary string pool +GRBLP: EX DE,HL + LD HL,(TMSTPT) ; Temporary string pool pointer + EX DE,HL + CALL CPDEHL ; Temporary string pool done? + LD BC,GRBLP ; Loop until string pool done + JP NZ,STPOOL ; No - See if in string area + LD HL,(PROGND) ; Start of simple variables +SMPVAR: EX DE,HL + LD HL,(VAREND) ; End of simple variables + EX DE,HL + CALL CPDEHL ; All simple strings done? + JP Z,ARRLP ; Yes - Do string arrays + LD A,(HL) ; Get type of variable + INC HL + INC HL + OR A ; "S" flag set if string + CALL STRADD ; See if string in string area + JP SMPVAR ; Loop until simple ones done + +GNXARY: POP BC ; Scrap address of this array +ARRLP: EX DE,HL + LD HL,(ARREND) ; End of string arrays + EX DE,HL + CALL CPDEHL ; All string arrays done? + JP Z,SCNEND ; Yes - Move string if found + CALL LOADFP ; Get array name to BCDE + LD A,E ; Get type of array + PUSH HL ; Save address of num of dim'ns + ADD HL,BC ; Start of next array + OR A ; Test type of array + JP P,GNXARY ; Numeric array - Ignore it + LD (CUROPR),HL ; Save address of next array + POP HL ; Get address of num of dim'ns + LD C,(HL) ; BC = Number of dimensions + LD B,0 + ADD HL,BC ; Two bytes per dimension size + ADD HL,BC + INC HL ; Plus one for number of dim'ns +GRBARY: EX DE,HL + LD HL,(CUROPR) ; Get address of next array + EX DE,HL + CALL CPDEHL ; Is this array finished? + JP Z,ARRLP ; Yes - Get next one + LD BC,GRBARY ; Loop until array all done +STPOOL: PUSH BC ; Save return address + OR 80H ; Flag string type +STRADD: LD A,(HL) ; Get string length + INC HL + INC HL + LD E,(HL) ; Get LSB of string address + INC HL + LD D,(HL) ; Get MSB of string address + INC HL + RET P ; Not a string - Return + OR A ; Set flags on string length + RET Z ; Null string - Return + LD B,H ; Save variable pointer + LD C,L + LD HL,(STRBOT) ; Bottom of new area + CALL CPDEHL ; String been done? + LD H,B ; Restore variable pointer + LD L,C + RET C ; String done - Ignore + POP HL ; Return address + EX (SP),HL ; Lowest available string area + CALL CPDEHL ; String within string area? + EX (SP),HL ; Lowest available string area + PUSH HL ; Re-save return address + LD H,B ; Restore variable pointer + LD L,C + RET NC ; Outside string area - Ignore + POP BC ; Get return , Throw 2 away + POP AF ; + POP AF ; + PUSH HL ; Save variable pointer + PUSH DE ; Save address of current + PUSH BC ; Put back return address + RET ; Go to it + +SCNEND: POP DE ; Addresses of strings + POP HL ; + LD A,L ; HL = 0 if no more to do + OR H + RET Z ; No more to do - Return + DEC HL + LD B,(HL) ; MSB of address of string + DEC HL + LD C,(HL) ; LSB of address of string + PUSH HL ; Save variable address + DEC HL + DEC HL + LD L,(HL) ; HL = Length of string + LD H,0 + ADD HL,BC ; Address of end of string+1 + LD D,B ; String address to DE + LD E,C + DEC HL ; Last byte in string + LD B,H ; Address to BC + LD C,L + LD HL,(STRBOT) ; Current bottom of string area + CALL MOVSTR ; Move string to new address + POP HL ; Restore variable address + LD (HL),C ; Save new LSB of address + INC HL + LD (HL),B ; Save new MSB of address + LD L,C ; Next string area+1 to HL + LD H,B + DEC HL ; Next string area address + JP GARBLP ; Look for more strings + +CONCAT: PUSH BC ; Save prec' opr & code string + PUSH HL ; + LD HL,(FPREG) ; Get first string + EX (SP),HL ; Save first string + CALL OPRND ; Get second string + EX (SP),HL ; Restore first string + CALL TSTSTR ; Make sure it's a string + LD A,(HL) ; Get length of second string + PUSH HL ; Save first string + LD HL,(FPREG) ; Get second string + PUSH HL ; Save second string + ADD A,(HL) ; Add length of second string + LD E,LS ; ?LS Error + JP C,BERROR ; String too long - Error + CALL MKTMST ; Make temporary string + POP DE ; Get second string to DE + CALL GSTRDE ; Move to string pool if needed + EX (SP),HL ; Get first string + CALL GSTRHL ; Move to string pool if needed + PUSH HL ; Save first string + LD HL,(TMPSTR+2) ; Temporary string address + EX DE,HL ; To DE + CALL SSTSA ; First string to string area + CALL SSTSA ; Second string to string area + LD HL,EVAL2 ; Return to evaluation loop + EX (SP),HL ; Save return,get code string + PUSH HL ; Save code string address + JP TSTOPL ; To temporary string to pool + +SSTSA: POP HL ; Return address + EX (SP),HL ; Get string block,save return + LD A,(HL) ; Get length of string + INC HL + INC HL + LD C,(HL) ; Get LSB of string address + INC HL + LD B,(HL) ; Get MSB of string address + LD L,A ; Length to L +TOSTRA: INC L ; INC - DECed after +TSALP: DEC L ; Count bytes moved + RET Z ; End of string - Return + LD A,(BC) ; Get source + LD (DE),A ; Save destination + INC BC ; Next source + INC DE ; Next destination + JP TSALP ; Loop until string moved + +GETSTR: CALL TSTSTR ; Make sure it's a string +GSTRCU: LD HL,(FPREG) ; Get current string +GSTRHL: EX DE,HL ; Save DE +GSTRDE: CALL BAKTMP ; Was it last tmp-str? + EX DE,HL ; Restore DE + RET NZ ; No - Return + PUSH DE ; Save string + LD D,B ; String block address to DE + LD E,C + DEC DE ; Point to length + LD C,(HL) ; Get string length + LD HL,(STRBOT) ; Current bottom of string area + CALL CPDEHL ; Last one in string area? + JP NZ,POPHL ; No - Return + LD B,A ; Clear B (A=0) + ADD HL,BC ; Remove string from str' area + LD (STRBOT),HL ; Save new bottom of str' area +POPHL: POP HL ; Restore string + RET + +BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top + DEC HL ; Back + LD B,(HL) ; Get MSB of address + DEC HL ; Back + LD C,(HL) ; Get LSB of address + DEC HL ; Back + DEC HL ; Back + CALL CPDEHL ; String last in string pool? + RET NZ ; Yes - Leave it + LD (TMSTPT),HL ; Save new string pool top + RET + +LEN: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GETLEN: CALL GETSTR ; Get string and its length + XOR A + LD D,A ; Clear D + LD (TYPE),A ; Set type to numeric + LD A,(HL) ; Get length of string + OR A ; Set status flags + RET + +ASC: LD BC,PASSA ; To return integer A + PUSH BC ; Save address +GTFLNM: CALL GETLEN ; Get length of string + JP Z,FCERR ; Null string - Error + INC HL + INC HL + LD E,(HL) ; Get LSB of address + INC HL + LD D,(HL) ; Get MSB of address + LD A,(DE) ; Get first byte of string + RET + +CHR: LD A,1 ; One character string + CALL MKTMST ; Make a temporary string + CALL MAKINT ; Make it integer A + LD HL,(TMPSTR+2) ; Get address of string + LD (HL),E ; Save character +TOPOOL: POP BC ; Clean up stack + JP TSTOPL ; Temporary string to pool + +LEFT: CALL LFRGNM ; Get number and ending ")" + XOR A ; Start at first byte in string +RIGHT1: EX (SP),HL ; Save code string,Get string + LD C,A ; Starting position in string +MID1: PUSH HL ; Save string block address + LD A,(HL) ; Get length of string + CP B ; Compare with number given + JP C,ALLFOL ; All following bytes required + LD A,B ; Get new length + DB 11H ; Skip "LD C,0" +ALLFOL: LD C,0 ; First byte of string + PUSH BC ; Save position in string + CALL TESTR ; See if enough string space + POP BC ; Get position in string + POP HL ; Restore string block address + PUSH HL ; And re-save it + INC HL + INC HL + LD B,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,B ; HL = address of string + LD B,0 ; BC = starting address + ADD HL,BC ; Point to that byte + LD B,H ; BC = source string + LD C,L + CALL CRTMST ; Create a string entry + LD L,A ; Length of new string + CALL TOSTRA ; Move string to string area + POP DE ; Clear stack + CALL GSTRDE ; Move to string pool if needed + JP TSTOPL ; Temporary string to pool + +RIGHT: CALL LFRGNM ; Get number and ending ")" + POP DE ; Get string length + PUSH DE ; And re-save + LD A,(DE) ; Get length + SUB B ; Move back N bytes + JP RIGHT1 ; Go and get sub-string + +MID: EX DE,HL ; Get code string address + LD A,(HL) ; Get next byte ',' or ")" + CALL MIDNUM ; Get number supplied + INC B ; Is it character zero? + DEC B + JP Z,FCERR ; Yes - Error + PUSH BC ; Save starting position + LD E,255 ; All of string + CP ')' ; Any length given? + JP Z,RSTSTR ; No - Rest of string + CALL CHKSYN ; Make sure ',' follows + DB ',' + CALL GETINT ; Get integer 0-255 +RSTSTR: CALL CHKSYN ; Make sure ")" follows + DB ")" + POP AF ; Restore starting position + EX (SP),HL ; Get string,8ave code string + LD BC,MID1 ; Continuation of MID$ routine + PUSH BC ; Save for return + DEC A ; Starting position-1 + CP (HL) ; Compare with length + LD B,0 ; Zero bytes length + RET NC ; Null string if start past end + LD C,A ; Save starting position-1 + LD A,(HL) ; Get length of string + SUB C ; Subtract start + CP E ; Enough string for it? + LD B,A ; Save maximum length available + RET C ; Truncate string if needed + LD B,E ; Set specified length + RET ; Go and create string + +VAL: CALL GETLEN ; Get length of string + JP Z,RESZER ; Result zero + LD E,A ; Save length + INC HL + INC HL + LD A,(HL) ; Get LSB of address + INC HL + LD H,(HL) ; Get MSB of address + LD L,A ; HL = String address + PUSH HL ; Save string address + ADD HL,DE + LD B,(HL) ; Get end of string+1 byte + LD (HL),D ; Zero it to terminate + EX (SP),HL ; Save string end,get start + PUSH BC ; Save end+1 byte + LD A,(HL) ; Get starting byte + CP '$' ; Hex number indicated? [function added G. Searle] + JP NZ,VAL1 + CALL HEXTFP ; Convert Hex to FPREG + JR VAL3 +VAL1: CP '%' ; Binary number indicated? [function added] + JP NZ,VAL2 + CALL BINTFP ; Convert Bin to FPREG + JR VAL3 +VAL2: CALL ASCTFP ; Convert ASCII string to FP +VAL3: POP BC ; Restore end+1 byte + POP HL ; Restore end+1 address + LD (HL),B ; Put back original byte + RET + +LFRGNM: EX DE,HL ; Code string address to HL + CALL CHKSYN ; Make sure ")" follows + DB ")" +MIDNUM: POP BC ; Get return address + POP DE ; Get number supplied + PUSH BC ; Re-save return address + LD B,E ; Number to B + RET + +INP: CALL MAKINT ; Make it integer A + LD (INPORT),A ; Set input port + CALL INPSUB ; Get input from port + JP PASSA ; Return integer A + +POUT: CALL SETIO ; Set up port number + JP OUTSUB ; Output data and return + +WAIT: CALL SETIO ; Set up port number + PUSH AF ; Save AND mask + LD E,0 ; Assume zero if none given + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + JP Z,NOXOR ; No XOR byte given + CALL CHKSYN ; Make sure ',' follows + DB ',' + CALL GETINT ; Get integer 0-255 to XOR with +NOXOR: POP BC ; Restore AND mask +WAITLP: CALL INPSUB ; Get input + XOR E ; Flip selected bits + AND B ; Result non-zero? + JP Z,WAITLP ; No = keep waiting + RET + +SETIO: CALL GETINT ; Get integer 0-255 + LD (INPORT),A ; Set input port + LD (OTPORT),A ; Set output port + CALL CHKSYN ; Make sure ',' follows + DB ',' + JP GETINT ; Get integer 0-255 and return + +FNDNUM: CALL GETCHR ; Get next character +GETINT: CALL GETNUM ; Get a number from 0 to 255 +MAKINT: CALL DEPINT ; Make sure value 0 - 255 + LD A,D ; Get MSB of number + OR A ; Zero? + JP NZ,FCERR ; No - Error + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + LD A,E ; Get number to A + RET + +PEEK: CALL DEINT ; Get memory address + LD A,(DE) ; Get byte in memory + JP PASSA ; Return integer A + +POKE: CALL GETNUM ; Get memory address + CALL DEINT ; Get integer -32768 to 3276 + PUSH DE ; Save memory address + CALL CHKSYN ; Make sure ',' follows + DB ',' + CALL GETINT ; Get integer 0-255 + POP DE ; Restore memory address + LD (DE),A ; Load it into memory + RET + +ROUND: LD HL,HALF ; Add 0.5 to FPREG +ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE + JP FPADD ; Add BCDE to FPREG + +SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL + DB 21H ; Skip "POP BC" and "POP DE" +PSUB: POP BC ; Get FP number from stack + POP DE +SUBCDE: CALL INVSGN ; Negate FPREG +FPADD: LD A,B ; Get FP exponent + OR A ; Is number zero? + RET Z ; Yes - Nothing to add + LD A,(FPEXP) ; Get FPREG exponent + OR A ; Is this number zero? + JP Z,FPBCDE ; Yes - Move BCDE to FPREG + SUB B ; BCDE number larger? + JP NC,NOSWAP ; No - Don't swap them + CPL ; Two's complement + INC A ; FP exponent + EX DE,HL + CALL STAKFP ; Put FPREG on stack + EX DE,HL + CALL FPBCDE ; Move BCDE to FPREG + POP BC ; Restore number from stack + POP DE +NOSWAP: CP 24+1 ; Second number insignificant? + RET NC ; Yes - First number is result + PUSH AF ; Save number of bits to scale + CALL SIGNS ; Set MSBs & sign of result + LD H,A ; Save sign of result + POP AF ; Restore scaling factor + CALL SCALE ; Scale BCDE to same exponent + OR H ; Result to be positive? + LD HL,FPREG ; Point to FPREG + JP P,MINCDE ; No - Subtract FPREG from CDE + CALL PLUCDE ; Add FPREG to CDE + JP NC,RONDUP ; No overflow - Round it up + INC HL ; Point to exponent + INC (HL) ; Increment it + JP Z,OVERR ; Number overflowed - Error + LD L,1 ; 1 bit to shift right + CALL SHRT1 ; Shift result right + JP RONDUP ; Round it up + +MINCDE: XOR A ; Clear A and carry + SUB B ; Negate exponent + LD B,A ; Re-save exponent + LD A,(HL) ; Get LSB of FPREG + SBC A, E ; Subtract LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + SBC A,D ; Subtract NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + SBC A,C ; Subtract MSB of BCDE + LD C,A ; Save MSB of BCDE +CONPOS: CALL C,COMPL ; Overflow - Make it positive + +BNORM: LD L,B ; L = Exponent + LD H,E ; H = LSB + XOR A +BNRMLP: LD B,A ; Save bit count + LD A,C ; Get MSB + OR A ; Is it zero? + JP NZ,PNORM ; No - Do it bit at a time + LD C,D ; MSB = NMSB + LD D,H ; NMSB= LSB + LD H,L ; LSB = VLSB + LD L,A ; VLSB= 0 + LD A,B ; Get exponent + SUB 8 ; Count 8 bits + CP -24-8 ; Was number zero? + JP NZ,BNRMLP ; No - Keep normalising +RESZER: XOR A ; Result is zero +SAVEXP: LD (FPEXP),A ; Save result as zero + RET + +NORMAL: DEC B ; Count bits + ADD HL,HL ; Shift HL left + LD A,D ; Get NMSB + RLA ; Shift left with last bit + LD D,A ; Save NMSB + LD A,C ; Get MSB + ADC A,A ; Shift left with last bit + LD C,A ; Save MSB +PNORM: JP P,NORMAL ; Not done - Keep going + LD A,B ; Number of bits shifted + LD E,H ; Save HL in EB + LD B,L + OR A ; Any shifting done? + JP Z,RONDUP ; No - Round it up + LD HL,FPEXP ; Point to exponent + ADD A,(HL) ; Add shifted bits + LD (HL),A ; Re-save exponent + JP NC,RESZER ; Underflow - Result is zero + RET Z ; Result is zero +RONDUP: LD A,B ; Get VLSB of number +RONDB: LD HL,FPEXP ; Point to exponent + OR A ; Any rounding? + CALL M,FPROND ; Yes - Round number up + LD B,(HL) ; B = Exponent + INC HL + LD A,(HL) ; Get sign of result + AND 10000000B ; Only bit 7 needed + XOR C ; Set correct sign + LD C,A ; Save correct sign in number + JP FPBCDE ; Move BCDE to FPREG + +FPROND: INC E ; Round LSB + RET NZ ; Return if ok + INC D ; Round NMSB + RET NZ ; Return if ok + INC C ; Round MSB + RET NZ ; Return if ok + LD C,80H ; Set normal value + INC (HL) ; Increment exponent + RET NZ ; Return if ok + JP OVERR ; Overflow error + +PLUCDE: LD A,(HL) ; Get LSB of FPREG + ADD A,E ; Add LSB of BCDE + LD E,A ; Save LSB of BCDE + INC HL + LD A,(HL) ; Get NMSB of FPREG + ADC A,D ; Add NMSB of BCDE + LD D,A ; Save NMSB of BCDE + INC HL + LD A,(HL) ; Get MSB of FPREG + ADC A,C ; Add MSB of BCDE + LD C,A ; Save MSB of BCDE + RET + +COMPL: LD HL,SGNRES ; Sign of result + LD A,(HL) ; Get sign of result + CPL ; Negate it + LD (HL),A ; Put it back + XOR A + LD L,A ; Set L to zero + SUB B ; Negate exponent,set carry + LD B,A ; Re-save exponent + LD A,L ; Load zero + SBC A,E ; Negate LSB + LD E,A ; Re-save LSB + LD A,L ; Load zero + SBC A,D ; Negate NMSB + LD D,A ; Re-save NMSB + LD A,L ; Load zero + SBC A,C ; Negate MSB + LD C,A ; Re-save MSB + RET + +SCALE: LD B,0 ; Clear underflow +SCALLP: SUB 8 ; 8 bits (a whole byte)? + JP C,SHRITE ; No - Shift right A bits + LD B,E ; <- Shift + LD E,D ; <- right + LD D,C ; <- eight + LD C,0 ; <- bits + JP SCALLP ; More bits to shift + +SHRITE: ADD A,8+1 ; Adjust count + LD L,A ; Save bits to shift +SHRLP: XOR A ; Flag for all done + DEC L ; All shifting done? + RET Z ; Yes - Return + LD A,C ; Get MSB +SHRT1: RRA ; Shift it right + LD C,A ; Re-save + LD A,D ; Get NMSB + RRA ; Shift right with last bit + LD D,A ; Re-save it + LD A,E ; Get LSB + RRA ; Shift right with last bit + LD E,A ; Re-save it + LD A,B ; Get underflow + RRA ; Shift right with last bit + LD B,A ; Re-save underflow + JP SHRLP ; More bits to do + +UNITY: DB 000H,000H,000H,081H ; 1.00000 + +LOGTAB: DB 3 ; Table used by LOG + DB 0AAH,056H,019H,080H ; 0.59898 + DB 0F1H,022H,076H,080H ; 0.96147 + DB 045H,0AAH,038H,082H ; 2.88539 + +LOG: CALL TSTSGN ; Test sign of value + OR A + JP PE,FCERR ; ?FC Error if <= zero + LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + LD BC,8035H ; BCDE = SQR(1/2) + LD DE,04F3H + SUB B ; Scale value to be < 1 + PUSH AF ; Save scale factor + LD (HL),B ; Save new exponent + PUSH DE ; Save SQR(1/2) + PUSH BC + CALL FPADD ; Add SQR(1/2) to value + POP BC ; Restore SQR(1/2) + POP DE + INC B ; Make it SQR(2) + CALL DVBCDE ; Divide by SQR(2) + LD HL,UNITY ; Point to 1. + CALL SUBPHL ; Subtract FPREG from 1 + LD HL,LOGTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD BC,8080H ; BCDE = -0.5 + LD DE,0000H + CALL FPADD ; Subtract 0.5 from FPREG + POP AF ; Restore scale factor + CALL RSCALE ; Re-scale number +MULLN2: LD BC,8031H ; BCDE = Ln(2) + LD DE,7218H + DB 21H ; Skip "POP BC" and "POP DE" + +MULT: POP BC ; Get number from stack + POP DE +FPMULT: CALL TSTSGN ; Test sign of FPREG + RET Z ; Return zero if zero + LD L,0 ; Flag add exponents + CALL ADDEXP ; Add exponents + LD A,C ; Get MSB of multiplier + LD (MULVAL),A ; Save MSB of multiplier + EX DE,HL + LD (MULVAL+1),HL ; Save rest of multiplier + LD BC,0 ; Partial product (BCDE) = zero + LD D,B + LD E,B + LD HL,BNORM ; Address of normalise + PUSH HL ; Save for return + LD HL,MULT8 ; Address of 8 bit multiply + PUSH HL ; Save for NMSB,MSB + PUSH HL ; + LD HL,FPREG ; Point to number +MULT8: LD A,(HL) ; Get LSB of number + INC HL ; Point to NMSB + OR A ; Test LSB + JP Z,BYTSFT ; Zero - shift to next byte + PUSH HL ; Save address of number + LD L,8 ; 8 bits to multiply by +MUL8LP: RRA ; Shift LSB right + LD H,A ; Save LSB + LD A,C ; Get MSB + JP NC,NOMADD ; Bit was zero - Don't add + PUSH HL ; Save LSB and count + LD HL,(MULVAL+1) ; Get LSB and NMSB + ADD HL,DE ; Add NMSB and LSB + EX DE,HL ; Leave sum in DE + POP HL ; Restore MSB and count + LD A,(MULVAL) ; Get MSB of multiplier + ADC A,C ; Add MSB +NOMADD: RRA ; Shift MSB right + LD C,A ; Re-save MSB + LD A,D ; Get NMSB + RRA ; Shift NMSB right + LD D,A ; Re-save NMSB + LD A,E ; Get LSB + RRA ; Shift LSB right + LD E,A ; Re-save LSB + LD A,B ; Get VLSB + RRA ; Shift VLSB right + LD B,A ; Re-save VLSB + DEC L ; Count bits multiplied + LD A,H ; Get LSB of multiplier + JP NZ,MUL8LP ; More - Do it +POPHRT: POP HL ; Restore address of number + RET + +BYTSFT: LD B,E ; Shift partial product left + LD E,D + LD D,C + LD C,A + RET + +DIV10: CALL STAKFP ; Save FPREG on stack + LD BC,8420H ; BCDE = 10. + LD DE,0000H + CALL FPBCDE ; Move 10 to FPREG + +DIV: POP BC ; Get number from stack + POP DE +DVBCDE: CALL TSTSGN ; Test sign of FPREG + JP Z,DZERR ; Error if division by zero + LD L,-1 ; Flag subtract exponents + CALL ADDEXP ; Subtract exponents + INC (HL) ; Add 2 to exponent to adjust + INC (HL) + DEC HL ; Point to MSB + LD A,(HL) ; Get MSB of dividend + LD (DIV3),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get NMSB of dividend + LD (DIV2),A ; Save for subtraction + DEC HL + LD A,(HL) ; Get MSB of dividend + LD (DIV1),A ; Save for subtraction + LD B,C ; Get MSB + EX DE,HL ; NMSB,LSB to HL + XOR A + LD C,A ; Clear MSB of quotient + LD D,A ; Clear NMSB of quotient + LD E,A ; Clear LSB of quotient + LD (DIV4),A ; Clear overflow count +DIVLP: PUSH HL ; Save divisor + PUSH BC + LD A,L ; Get LSB of number + CALL DIVSUP ; Subt' divisor from dividend + SBC A,0 ; Count for overflows + CCF + JP NC,RESDIV ; Restore divisor if borrow + LD (DIV4),A ; Re-save overflow count + POP AF ; Scrap divisor + POP AF + SCF ; Set carry to + DB 0D2H ; Skip "POP BC" and "POP HL" + +RESDIV: POP BC ; Restore divisor + POP HL + LD A,C ; Get MSB of quotient + INC A + DEC A + RRA ; Bit 0 to bit 7 + JP M,RONDB ; Done - Normalise result + RLA ; Restore carry + LD A,E ; Get LSB of quotient + RLA ; Double it + LD E,A ; Put it back + LD A,D ; Get NMSB of quotient + RLA ; Double it + LD D,A ; Put it back + LD A,C ; Get MSB of quotient + RLA ; Double it + LD C,A ; Put it back + ADD HL,HL ; Double NMSB,LSB of divisor + LD A,B ; Get MSB of divisor + RLA ; Double it + LD B,A ; Put it back + LD A,(DIV4) ; Get VLSB of quotient + RLA ; Double it + LD (DIV4),A ; Put it back + LD A,C ; Get MSB of quotient + OR D ; Merge NMSB + OR E ; Merge LSB + JP NZ,DIVLP ; Not done - Keep dividing + PUSH HL ; Save divisor + LD HL,FPEXP ; Point to exponent + DEC (HL) ; Divide by 2 + POP HL ; Restore divisor + JP NZ,DIVLP ; Ok - Keep going + JP OVERR ; Overflow error + +ADDEXP: LD A,B ; Get exponent of dividend + OR A ; Test it + JP Z,OVTST3 ; Zero - Result zero + LD A,L ; Get add/subtract flag + LD HL,FPEXP ; Point to exponent + XOR (HL) ; Add or subtract it + ADD A,B ; Add the other exponent + LD B,A ; Save new exponent + RRA ; Test exponent for overflow + XOR B + LD A,B ; Get exponent + JP P,OVTST2 ; Positive - Test for overflow + ADD A,80H ; Add excess 128 + LD (HL),A ; Save new exponent + JP Z,POPHRT ; Zero - Result zero + CALL SIGNS ; Set MSBs and sign of result + LD (HL),A ; Save new exponent + DEC HL ; Point to MSB + RET + +OVTST1: CALL TSTSGN ; Test sign of FPREG + CPL ; Invert sign + POP HL ; Clean up stack +OVTST2: OR A ; Test if new exponent zero +OVTST3: POP HL ; Clear off return address + JP P,RESZER ; Result zero + JP OVERR ; Overflow error + +MLSP10: CALL BCDEFP ; Move FPREG to BCDE + LD A,B ; Get exponent + OR A ; Is it zero? + RET Z ; Yes - Result is zero + ADD A,2 ; Multiply by 4 + JP C,OVERR ; Overflow - ?OV Error + LD B,A ; Re-save exponent + CALL FPADD ; Add BCDE to FPREG (Times 5) + LD HL,FPEXP ; Point to exponent + INC (HL) ; Double number (Times 10) + RET NZ ; Ok - Return + JP OVERR ; Overflow error + +TSTSGN: LD A,(FPEXP) ; Get sign of FPREG + OR A + RET Z ; RETurn if number is zero + LD A,(FPREG+2) ; Get MSB of FPREG + DB 0FEH ; Test sign +RETREL: CPL ; Invert sign + RLA ; Sign bit to carry +FLGDIF: SBC A,A ; Carry to all bits of A + RET NZ ; Return -1 if negative + INC A ; Bump to +1 + RET ; Positive - Return +1 + +SGN: CALL TSTSGN ; Test sign of FPREG +FLGREL: LD B,80H+8 ; 8 bit integer in exponent + LD DE,0 ; Zero NMSB and LSB +RETINT: LD HL,FPEXP ; Point to exponent + LD C,A ; CDE = MSB,NMSB and LSB + LD (HL),B ; Save exponent + LD B,0 ; CDE = integer to normalise + INC HL ; Point to sign of result + LD (HL),80H ; Set sign of result + RLA ; Carry = sign of integer + JP CONPOS ; Set sign of result + +ABS: CALL TSTSGN ; Test sign of FPREG + RET P ; Return if positive +INVSGN: LD HL,FPREG+2 ; Point to MSB + LD A,(HL) ; Get sign of mantissa + XOR 80H ; Invert sign of mantissa + LD (HL),A ; Re-save sign of mantissa + RET + +STAKFP: EX DE,HL ; Save code string address + LD HL,(FPREG) ; LSB,NLSB of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + LD HL,(FPREG+2) ; MSB and exponent of FPREG + EX (SP),HL ; Stack them,get return + PUSH HL ; Re-save return + EX DE,HL ; Restore code string address + RET + +PHLTFP: CALL LOADFP ; Number at HL to BCDE +FPBCDE: EX DE,HL ; Save code string address + LD (FPREG),HL ; Save LSB,NLSB of number + LD H,B ; Exponent of number + LD L,C ; MSB of number + LD (FPREG+2),HL ; Save MSB and exponent + EX DE,HL ; Restore code string address + RET + +BCDEFP: LD HL,FPREG ; Point to FPREG +LOADFP: LD E,(HL) ; Get LSB of number + INC HL + LD D,(HL) ; Get NMSB of number + INC HL + LD C,(HL) ; Get MSB of number + INC HL + LD B,(HL) ; Get exponent of number +INCHL: INC HL ; Used for conditional "INC HL" + RET + +FPTHL: LD DE,FPREG ; Point to FPREG +DETHL4: LD B,4 ; 4 bytes to move +DETHLB: LD A,(DE) ; Get source + LD (HL),A ; Save destination + INC DE ; Next source + INC HL ; Next destination + DEC B ; Count bytes + JP NZ,DETHLB ; Loop if more + RET + +SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG + LD A,(HL) ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD (HL),A ; Save new MSB + CCF ; Complement sign + RRA ; Old sign to carry + INC HL + INC HL + LD (HL),A ; Set sign of result + LD A,C ; Get MSB + RLCA ; Old sign to carry + SCF ; Set MSBit + RRA ; Set MSBit of MSB + LD C,A ; Save MSB + RRA + XOR (HL) ; New sign of result + RET + +CMPNUM: LD A,B ; Get exponent of number + OR A + JP Z,TSTSGN ; Zero - Test sign of FPREG + LD HL,RETREL ; Return relation routine + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD A,C ; Get MSB of number + RET Z ; FPREG zero - Number's MSB + LD HL,FPREG+2 ; MSB of FPREG + XOR (HL) ; Combine signs + LD A,C ; Get MSB of number + RET M ; Exit if signs different + CALL CMPFP ; Compare FP numbers + RRA ; Get carry to sign + XOR C ; Combine with MSB of number + RET + +CMPFP: INC HL ; Point to exponent + LD A,B ; Get exponent + CP (HL) ; Compare exponents + RET NZ ; Different + DEC HL ; Point to MBS + LD A,C ; Get MSB + CP (HL) ; Compare MSBs + RET NZ ; Different + DEC HL ; Point to NMSB + LD A,D ; Get NMSB + CP (HL) ; Compare NMSBs + RET NZ ; Different + DEC HL ; Point to LSB + LD A,E ; Get LSB + SUB (HL) ; Compare LSBs + RET NZ ; Different + POP HL ; Drop RETurn + POP HL ; Drop another RETurn + RET + +FPINT: LD B,A ; <- Move + LD C,A ; <- exponent + LD D,A ; <- to all + LD E,A ; <- bits + OR A ; Test exponent + RET Z ; Zero - Return zero + PUSH HL ; Save pointer to number + CALL BCDEFP ; Move FPREG to BCDE + CALL SIGNS ; Set MSBs & sign of result + XOR (HL) ; Combine with sign of FPREG + LD H,A ; Save combined signs + CALL M,DCBCDE ; Negative - Decrement BCDE + LD A,80H+24 ; 24 bits + SUB B ; Bits to shift + CALL SCALE ; Shift BCDE + LD A,H ; Get combined sign + RLA ; Sign to carry + CALL C,FPROND ; Negative - Round number up + LD B,0 ; Zero exponent + CALL C,COMPL ; If negative make positive + POP HL ; Restore pointer to number + RET + +DCBCDE: DEC DE ; Decrement BCDE + LD A,D ; Test LSBs + AND E + INC A + RET NZ ; Exit if LSBs not FFFF + DEC BC ; Decrement MSBs + RET + +INT: LD HL,FPEXP ; Point to exponent + LD A,(HL) ; Get exponent + CP 80H+24 ; Integer accuracy only? + LD A,(FPREG) ; Get LSB + RET NC ; Yes - Already integer + LD A,(HL) ; Get exponent + CALL FPINT ; F.P to integer + LD (HL),80H+24 ; Save 24 bit integer + LD A,E ; Get LSB of number + PUSH AF ; Save LSB + LD A,C ; Get MSB of number + RLA ; Sign to carry + CALL CONPOS ; Set sign of result + POP AF ; Restore LSB of number + RET + +MLDEBC: LD HL,0 ; Clear partial product + LD A,B ; Test multiplier + OR C + RET Z ; Return zero if zero + LD A,16 ; 16 bits +MLDBLP: ADD HL,HL ; Shift P.P left + JP C,BSERR ; ?BS Error if overflow + EX DE,HL + ADD HL,HL ; Shift multiplier left + EX DE,HL + JP NC,NOMLAD ; Bit was zero - No add + ADD HL,BC ; Add multiplicand + JP C,BSERR ; ?BS Error if overflow +NOMLAD: DEC A ; Count bits + JP NZ,MLDBLP ; More + RET + +ASCTFP: CP '-' ; Negative? + PUSH AF ; Save it and flags + JP Z,CNVNUM ; Yes - Convert number + CP '+' ; Positive? + JP Z,CNVNUM ; Yes - Convert number + DEC HL ; DEC 'cos GETCHR INCs +CNVNUM: CALL RESZER ; Set result to zero + LD B,A ; Digits after point counter + LD D,A ; Sign of exponent + LD E,A ; Exponent of ten + CPL + LD C,A ; Before or after point flag +MANLP: CALL GETCHR ; Get next character + JP C,ADDIG ; Digit - Add to number + CP '.' + JP Z,DPOINT ; '.' - Flag point + CP 'E' + JP NZ,CONEXP ; Not 'E' - Scale number + CALL GETCHR ; Get next character + CALL SGNEXP ; Get sign of exponent +EXPLP: CALL GETCHR ; Get next character + JP C,EDIGIT ; Digit - Add to exponent + INC D ; Is sign negative? + JP NZ,CONEXP ; No - Scale number + XOR A + SUB E ; Negate exponent + LD E,A ; And re-save it + INC C ; Flag end of number +DPOINT: INC C ; Flag point passed + JP Z,MANLP ; Zero - Get another digit +CONEXP: PUSH HL ; Save code string address + LD A,E ; Get exponent + SUB B ; Subtract digits after point +SCALMI: CALL P,SCALPL ; Positive - Multiply number + JP P,ENDCON ; Positive - All done + PUSH AF ; Save number of times to /10 + CALL DIV10 ; Divide by 10 + POP AF ; Restore count + INC A ; Count divides + +ENDCON: JP NZ,SCALMI ; More to do + POP DE ; Restore code string address + POP AF ; Restore sign of number + CALL Z,INVSGN ; Negative - Negate number + EX DE,HL ; Code string address to HL + RET + +SCALPL: RET Z ; Exit if no scaling needed +MULTEN: PUSH AF ; Save count + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore count + DEC A ; Count multiplies + RET + +ADDIG: PUSH DE ; Save sign of exponent + LD D,A ; Save digit + LD A,B ; Get digits after point + ADC A,C ; Add one if after point + LD B,A ; Re-save counter + PUSH BC ; Save point flags + PUSH HL ; Save code string address + PUSH DE ; Save digit + CALL MLSP10 ; Multiply number by 10 + POP AF ; Restore digit + SUB '0' ; Make it absolute + CALL RSCALE ; Re-scale number + POP HL ; Restore code string address + POP BC ; Restore point flags + POP DE ; Restore sign of exponent + JP MANLP ; Get another digit + +RSCALE: CALL STAKFP ; Put number on stack + CALL FLGREL ; Digit to add to FPREG +PADD: POP BC ; Restore number + POP DE + JP FPADD ; Add BCDE to FPREG and return + +EDIGIT: LD A,E ; Get digit + RLCA ; Times 2 + RLCA ; Times 4 + ADD A,E ; Times 5 + RLCA ; Times 10 + ADD A,(HL) ; Add next digit + SUB '0' ; Make it absolute + LD E,A ; Save new digit + JP EXPLP ; Look for another digit + +LINEIN: PUSH HL ; Save code string address + LD HL,INMSG ; Output " in " + CALL PRS ; Output string at HL + POP HL ; Restore code string address +PRNTHL: EX DE,HL ; Code string address to DE + XOR A + LD B,80H+24 ; 24 bits + CALL RETINT ; Return the integer + LD HL,PRNUMS ; Print number string + PUSH HL ; Save for return +NUMASC: LD HL,PBUFF ; Convert number to ASCII + PUSH HL ; Save for return + CALL TSTSGN ; Test sign of FPREG + LD (HL),' ' ; Space at start + JP P,SPCFST ; Positive - Space to start + LD (HL),'-' ; '-' sign at start +SPCFST: INC HL ; First byte of number + LD (HL),'0' ; '0' if zero + JP Z,JSTZER ; Return '0' if zero + PUSH HL ; Save buffer address + CALL M,INVSGN ; Negate FPREG if negative + XOR A ; Zero A + PUSH AF ; Save it + CALL RNGTST ; Test number is in range +SIXDIG: LD BC,9143H ; BCDE - 99999.9 + LD DE,4FF8H + CALL CMPNUM ; Compare numbers + OR A + JP PO,INRNG ; > 99999.9 - Sort it out + POP AF ; Restore count + CALL MULTEN ; Multiply by ten + PUSH AF ; Re-save count + JP SIXDIG ; Test it again + +GTSIXD: CALL DIV10 ; Divide by 10 + POP AF ; Get count + INC A ; Count divides + PUSH AF ; Re-save count + CALL RNGTST ; Test number is in range +INRNG: CALL ROUND ; Add 0.5 to FPREG + INC A + CALL FPINT ; F.P to integer + CALL FPBCDE ; Move BCDE to FPREG + LD BC,0306H ; 1E+06 to 1E-03 range + POP AF ; Restore count + ADD A,C ; 6 digits before point + INC A ; Add one + JP M,MAKNUM ; Do it in 'E' form if < 1E-02 + CP 6+1+1 ; More than 999999 ? + JP NC,MAKNUM ; Yes - Do it in 'E' form + INC A ; Adjust for exponent + LD B,A ; Exponent of number + LD A,2 ; Make it zero after + +MAKNUM: DEC A ; Adjust for digits to do + DEC A + POP HL ; Restore buffer address + PUSH AF ; Save count + LD DE,POWERS ; Powers of ten + DEC B ; Count digits before point + JP NZ,DIGTXT ; Not zero - Do number + LD (HL),'.' ; Save point + INC HL ; Move on + LD (HL),'0' ; Save zero + INC HL ; Move on +DIGTXT: DEC B ; Count digits before point + LD (HL),'.' ; Save point in case + CALL Z,INCHL ; Last digit - move on + PUSH BC ; Save digits before point + PUSH HL ; Save buffer address + PUSH DE ; Save powers of ten + CALL BCDEFP ; Move FPREG to BCDE + POP HL ; Powers of ten table + LD B, '0'-1 ; ASCII '0' - 1 +TRYAGN: INC B ; Count subtractions + LD A,E ; Get LSB + SUB (HL) ; Subtract LSB + LD E,A ; Save LSB + INC HL + LD A,D ; Get NMSB + SBC A,(HL) ; Subtract NMSB + LD D,A ; Save NMSB + INC HL + LD A,C ; Get MSB + SBC A,(HL) ; Subtract MSB + LD C,A ; Save MSB + DEC HL ; Point back to start + DEC HL + JP NC,TRYAGN ; No overflow - Try again + CALL PLUCDE ; Restore number + INC HL ; Start of next number + CALL FPBCDE ; Move BCDE to FPREG + EX DE,HL ; Save point in table + POP HL ; Restore buffer address + LD (HL),B ; Save digit in buffer + INC HL ; And move on + POP BC ; Restore digit count + DEC C ; Count digits + JP NZ,DIGTXT ; More - Do them + DEC B ; Any decimal part? + JP Z,DOEBIT ; No - Do 'E' bit +SUPTLZ: DEC HL ; Move back through buffer + LD A,(HL) ; Get character + CP '0' ; '0' character? + JP Z,SUPTLZ ; Yes - Look back for more + CP '.' ; A decimal point? + CALL NZ,INCHL ; Move back over digit + +DOEBIT: POP AF ; Get 'E' flag + JP Z,NOENED ; No 'E' needed - End buffer + LD (HL),'E' ; Put 'E' in buffer + INC HL ; And move on + LD (HL),'+' ; Put '+' in buffer + JP P,OUTEXP ; Positive - Output exponent + LD (HL),'-' ; Put '-' in buffer + CPL ; Negate exponent + INC A +OUTEXP: LD B,'0'-1 ; ASCII '0' - 1 +EXPTEN: INC B ; Count subtractions + SUB 10 ; Tens digit + JP NC,EXPTEN ; More to do + ADD A,'0'+10 ; Restore and make ASCII + INC HL ; Move on + LD (HL),B ; Save MSB of exponent +JSTZER: INC HL ; + LD (HL),A ; Save LSB of exponent + INC HL +NOENED: LD (HL),C ; Mark end of buffer + POP HL ; Restore code string address + RET + +RNGTST: LD BC,9474H ; BCDE = 999999. + LD DE,23F7H + CALL CMPNUM ; Compare numbers + OR A + POP HL ; Return address to HL + JP PO,GTSIXD ; Too big - Divide by ten + JP (HL) ; Otherwise return to caller + +HALF: DB 00H,00H,00H,80H ; 0.5 + +POWERS: DB 0A0H,086H,001H ; 100000 + DB 010H,027H,000H ; 10000 + DB 0E8H,003H,000H ; 1000 + DB 064H,000H,000H ; 100 + DB 00AH,000H,000H ; 10 + DB 001H,000H,000H ; 1 + +NEGAFT: LD HL,INVSGN ; Negate result + EX (SP),HL ; To be done after caller + JP (HL) ; Return to caller + +SQR: CALL STAKFP ; Put value on stack + LD HL,HALF ; Set power to 1/2 + CALL PHLTFP ; Move 1/2 to FPREG + +POWER: POP BC ; Get base + POP DE + CALL TSTSGN ; Test sign of power + LD A,B ; Get exponent of base + JP Z,EXP ; Make result 1 if zero + JP P,POWER1 ; Positive base - Ok + OR A ; Zero to negative power? + JP Z,DZERR ; Yes - ?/0 Error +POWER1: OR A ; Base zero? + JP Z,SAVEXP ; Yes - Return zero + PUSH DE ; Save base + PUSH BC + LD A,C ; Get MSB of base + OR 01111111B ; Get sign status + CALL BCDEFP ; Move power to BCDE + JP P,POWER2 ; Positive base - Ok + PUSH DE ; Save power + PUSH BC + CALL INT ; Get integer of power + POP BC ; Restore power + POP DE + PUSH AF ; MSB of base + CALL CMPNUM ; Power an integer? + POP HL ; Restore MSB of base + LD A,H ; but don't affect flags + RRA ; Exponent odd or even? +POWER2: POP HL ; Restore MSB and exponent + LD (FPREG+2),HL ; Save base in FPREG + POP HL ; LSBs of base + LD (FPREG),HL ; Save in FPREG + CALL C,NEGAFT ; Odd power - Negate result + CALL Z,INVSGN ; Negative base - Negate it + PUSH DE ; Save power + PUSH BC + CALL LOG ; Get LOG of base + POP BC ; Restore power + POP DE + CALL FPMULT ; Multiply LOG by power + +EXP: CALL STAKFP ; Put value on stack + LD BC,08138H ; BCDE = 1/Ln(2) + LD DE,0AA3BH + CALL FPMULT ; Multiply value by 1/LN(2) + LD A,(FPEXP) ; Get exponent + CP 80H+8 ; Is it in range? + JP NC,OVTST1 ; No - Test for overflow + CALL INT ; Get INT of FPREG + ADD A,80H ; For excess 128 + ADD A,2 ; Exponent > 126? + JP C,OVTST1 ; Yes - Test for overflow + PUSH AF ; Save scaling factor + LD HL,UNITY ; Point to 1. + CALL ADDPHL ; Add 1 to FPREG + CALL MULLN2 ; Multiply by LN(2) + POP AF ; Restore scaling factor + POP BC ; Restore exponent + POP DE + PUSH AF ; Save scaling factor + CALL SUBCDE ; Subtract exponent from FPREG + CALL INVSGN ; Negate result + LD HL,EXPTAB ; Coefficient table + CALL SMSER1 ; Sum the series + LD DE,0 ; Zero LSBs + POP BC ; Scaling factor + LD C,D ; Zero MSB + JP FPMULT ; Scale result to correct value + +EXPTAB: DB 8 ; Table used by EXP + DB 040H,02EH,094H,074H ; -1/7! (-1/5040) + DB 070H,04FH,02EH,077H ; 1/6! ( 1/720) + DB 06EH,002H,088H,07AH ; -1/5! (-1/120) + DB 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) + DB 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) + DB 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) + DB 000H,000H,080H,081H ; -1/1! (-1/1) + DB 000H,000H,000H,081H ; 1/0! ( 1/1) + +SUMSER: CALL STAKFP ; Put FPREG on stack + LD DE,MULT ; Multiply by "X" + PUSH DE ; To be done after + PUSH HL ; Save address of table + CALL BCDEFP ; Move FPREG to BCDE + CALL FPMULT ; Square the value + POP HL ; Restore address of table +SMSER1: CALL STAKFP ; Put value on stack + LD A,(HL) ; Get number of coefficients + INC HL ; Point to start of table + CALL PHLTFP ; Move coefficient to FPREG + DB 06H ; Skip "POP AF" +SUMLP: POP AF ; Restore count + POP BC ; Restore number + POP DE + DEC A ; Cont coefficients + RET Z ; All done + PUSH DE ; Save number + PUSH BC + PUSH AF ; Save count + PUSH HL ; Save address in table + CALL FPMULT ; Multiply FPREG by BCDE + POP HL ; Restore address in table + CALL LOADFP ; Number at HL to BCDE + PUSH HL ; Save address in table + CALL FPADD ; Add coefficient to FPREG + POP HL ; Restore address in table + JP SUMLP ; More coefficients + +RND: CALL TSTSGN ; Test sign of FPREG + LD HL,SEED+2 ; Random number seed + JP M,RESEED ; Negative - Re-seed + LD HL,LSTRND ; Last random number + CALL PHLTFP ; Move last RND to FPREG + LD HL,SEED+2 ; Random number seed + RET Z ; Return if RND(0) + ADD A,(HL) ; Add (SEED)+2) + AND 00000111B ; 0 to 7 + LD B,0 + LD (HL),A ; Re-save seed + INC HL ; Move to coefficient table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to coefficient + CALL LOADFP ; Coefficient to BCDE + CALL FPMULT ; ; Multiply FPREG by coefficient + LD A,(SEED+1) ; Get (SEED+1) + INC A ; Add 1 + AND 00000011B ; 0 to 3 + LD B,0 + CP 1 ; Is it zero? + ADC A,B ; Yes - Make it 1 + LD (SEED+1),A ; Re-save seed + LD HL,RNDTAB-4 ; Addition table + ADD A,A ; 4 bytes + ADD A,A ; per entry + LD C,A ; BC = Offset into table + ADD HL,BC ; Point to value + CALL ADDPHL ; Add value to FPREG +RND1: CALL BCDEFP ; Move FPREG to BCDE + LD A,E ; Get LSB + LD E,C ; LSB = MSB + XOR 01001111B ; Fiddle around + LD C,A ; New MSB + LD (HL),80H ; Set exponent + DEC HL ; Point to MSB + LD B,(HL) ; Get MSB + LD (HL),80H ; Make value -0.5 + LD HL,SEED ; Random number seed + INC (HL) ; Count seed + LD A,(HL) ; Get seed + SUB 171 ; Do it modulo 171 + JP NZ,RND2 ; Non-zero - Ok + LD (HL),A ; Zero seed + INC C ; Fillde about + DEC D ; with the + INC E ; number +RND2: CALL BNORM ; Normalise number + LD HL,LSTRND ; Save random number + JP FPTHL ; Move FPREG to last and return + +RESEED: LD (HL),A ; Re-seed random numbers + DEC HL + LD (HL),A + DEC HL + LD (HL),A + JP RND1 ; Return RND seed + +RNDTAB: DB 068H,0B1H,046H,068H ; Table used by RND + DB 099H,0E9H,092H,069H + DB 010H,0D1H,075H,068H + +COS: LD HL,HALFPI ; Point to PI/2 + CALL ADDPHL ; Add it to PPREG +SIN: CALL STAKFP ; Put angle on stack + LD BC,8349H ; BCDE = 2 PI + LD DE,0FDBH + CALL FPBCDE ; Move 2 PI to FPREG + POP BC ; Restore angle + POP DE + CALL DVBCDE ; Divide angle by 2 PI + CALL STAKFP ; Put it on stack + CALL INT ; Get INT of result + POP BC ; Restore number + POP DE + CALL SUBCDE ; Make it 0 <= value < 1 + LD HL,QUARTR ; Point to 0.25 + CALL SUBPHL ; Subtract value from 0.25 + CALL TSTSGN ; Test sign of value + SCF ; Flag positive + JP P,SIN1 ; Positive - Ok + CALL ROUND ; Add 0.5 to value + CALL TSTSGN ; Test sign of value + OR A ; Flag negative +SIN1: PUSH AF ; Save sign + CALL P,INVSGN ; Negate value if positive + LD HL,QUARTR ; Point to 0.25 + CALL ADDPHL ; Add 0.25 to value + POP AF ; Restore sign + CALL NC,INVSGN ; Negative - Make positive + LD HL,SINTAB ; Coefficient table + JP SUMSER ; Evaluate sum of series + +HALFPI: DB 0DBH,00FH,049H,081H ; 1.5708 (PI/2) + +QUARTR: DB 000H,000H,000H,07FH ; 0.25 + +SINTAB: DB 5 ; Table used by SIN + DB 0BAH,0D7H,01EH,086H ; 39.711 + DB 064H,026H,099H,087H ;-76.575 + DB 058H,034H,023H,087H ; 81.602 + DB 0E0H,05DH,0A5H,086H ;-41.342 + DB 0DAH,00FH,049H,083H ; 6.2832 + +TAN: CALL STAKFP ; Put angle on stack + CALL SIN ; Get SIN of angle + POP BC ; Restore angle + POP HL + CALL STAKFP ; Save SIN of angle + EX DE,HL ; BCDE = Angle + CALL FPBCDE ; Angle to FPREG + CALL COS ; Get COS of angle + JP DIV ; TAN = SIN / COS + +ATN: CALL TSTSGN ; Test sign of value + CALL M,NEGAFT ; Negate result after if -ve + CALL M,INVSGN ; Negate value if -ve + LD A,(FPEXP) ; Get exponent + CP 81H ; Number less than 1? + JP C,ATN1 ; Yes - Get arc tangnt + LD BC,8100H ; BCDE = 1 + LD D,C + LD E,C + CALL DVBCDE ; Get reciprocal of number + LD HL,SUBPHL ; Sub angle from PI/2 + PUSH HL ; Save for angle > 1 +ATN1: LD HL,ATNTAB ; Coefficient table + CALL SUMSER ; Evaluate sum of series + LD HL,HALFPI ; PI/2 - angle in case > 1 + RET ; Number > 1 - Sub from PI/2 + +ATNTAB: DB 9 ; Table used by ATN + DB 04AH,0D7H,03BH,078H ; 1/17 + DB 002H,06EH,084H,07BH ;-1/15 + DB 0FEH,0C1H,02FH,07CH ; 1/13 + DB 074H,031H,09AH,07DH ;-1/11 + DB 084H,03DH,05AH,07DH ; 1/9 + DB 0C8H,07FH,091H,07EH ;-1/7 + DB 0E4H,0BBH,04CH,07EH ; 1/5 + DB 06CH,0AAH,0AAH,07FH ;-1/3 + DB 000H,000H,000H,081H ; 1/1 + + +ARET: RET ; A RETurn instruction + +CLS: LD A,016H ; ASCII Clear screen + JP PRNT ; Output character + +WIDTH: CALL GETINT ; Get integer 0-255 + LD A,E ; Width to A + LD (LWIDTH),A ; Set width + RET + +LINES: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + LD (LINESC),DE ; Set lines counter + LD (LINESN),DE ; Set lines number + RET + +DEEK: CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save number + POP HL ; Number to HL + LD B,(HL) ; Get LSB of contents + INC HL + LD A,(HL) ; Get MSB of contents + JP ABPASS ; Return integer AB + +DOKE: CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH DE ; Save address + CALL CHKSYN ; Make sure ',' follows + DB ',' + CALL GETNUM ; Get a number + CALL DEINT ; Get integer -32768 to 32767 + EX (SP),HL ; Save value,get address + LD (HL),E ; Save LSB of value + INC HL + LD (HL),D ; Save MSB of value + POP HL ; Restore code string address + RET + + + ; HEX$(nn) Convert 16 bit number to Hexadecimal string + +HEX: CALL TSTNUM ; Verify it's a number + CALL DEINT ; Get integer -32768 to 32767 + PUSH BC ; Save contents of BC + LD HL,PBUFF + LD A,D ; Get high order into A + CP 000H + JR Z,HEX2 ; Skip output if both high digits are zero + CALL BYT2ASC ; Convert D to ASCII + LD A,B + CP '0' + JR Z,HEX1 ; Don't store high digit if zero + LD (HL),B ; Store it to PBUFF + INC HL ; Next location +HEX1: LD (HL),C ; Store C to PBUFF+1 + INC HL ; Next location +HEX2: LD A,E ; Get lower byte + CALL BYT2ASC ; Convert E to ASCII + LD A,D + CP 000H + JR NZ,HEX3 ; If upper byte was not zero then always print lower byte + LD A,B + CP '0' ; If high digit of lower byte is zero then don't print + JR Z,HEX4 +HEX3: LD (HL),B ; to PBUFF+2 + INC HL ; Next location +HEX4: LD (HL),C ; to PBUFF+3 + INC HL ; PBUFF+4 to zero + XOR A ; Terminating character + LD (HL),A ; Store zero to terminate + INC HL ; Make sure PBUFF is terminated + LD (HL),A ; Store the double zero there + POP BC ; Get BC back + LD HL,PBUFF ; Reset to start of PBUFF + JP STR1 ; Convert the PBUFF to a string and return it + +BYT2ASC LD B,A ; Save original value + AND 00FH ; Strip off upper nybble + CP 00AH ; 0-9? + JR C,ADD30 ; If A-F, add 7 more + ADD A,007H ; Bring value up to ASCII A-F +ADD30 ADD A,030H ; And make ASCII + LD C,A ; Save converted char to C + LD A,B ; Retrieve original value + RRCA ; and Rotate it right + RRCA + RRCA + RRCA + AND 00FH ; Mask off upper nybble + CP 00AH ; 0-9? < A hex? + JR C,ADD301 ; Skip Add 7 + ADD A,007H ; Bring it up to ASCII A-F +ADD301 ADD A,030H ; And make it full ASCII + LD B,A ; Store high order byte + RET + + ; Convert "&Hnnnn" to FPREG + ; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" + ; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 +HEXTFP EX DE,HL ; Move code string pointer to DE + LD HL,00000H ; Zero out the value + CALL GETHEX ; Check the number for valid hex + JP C,HXERR ; First value wasn't hex, HX error + JR HEXLP1 ; Convert first character +HEXLP CALL GETHEX ; Get second and addtional characters + JR C,HEXIT ; Exit if not a hex character +HEXLP1 ADD HL,HL ; Rotate 4 bits to the left + ADD HL,HL + ADD HL,HL + ADD HL,HL + OR L ; Add in D0-D3 into L + LD L,A ; Save new value + JR HEXLP ; And continue until all hex characters are in + +GETHEX INC DE ; Next location + LD A,(DE) ; Load character at pointer + CP ' ' + JP Z,GETHEX ; Skip spaces + SUB 030H ; Get absolute value + RET C ; < "0", error + CP 00AH + JR C,NOSUB7 ; Is already in the range 0-9 + SUB 007H ; Reduce to A-F + CP 00AH ; Value should be $0A-$0F at this point + RET C ; CY set if was : ; < = > ? @ +NOSUB7 CP 010H ; > Greater than "F"? + CCF + RET ; CY set if it wasn't valid hex -HEXIT EX DE,HL ; Value into DE, Code string into HL - LD A,D ; Load DE into AC - LD C,E ; For prep to - PUSH HL - CALL ACPASS ; ACPASS to set AC as integer into FPREG - POP HL - RET +HEXIT EX DE,HL ; Value into DE, Code string into HL + LD A,D ; Load DE into AC + LD C,E ; For prep to + PUSH HL + CALL ACPASS ; ACPASS to set AC as integer into FPREG + POP HL + RET -HXERR: LD E,HX ; ?HEX Error - JP BERROR +HXERR: LD E,HX ; ?HEX Error + JP BERROR -; BIN$(NN) Convert integer to a 1-16 char binary string -BIN: CALL TSTNUM ; Verify it's a number - CALL DEINT ; Get integer -32768 to 32767 -BIN2: PUSH BC ; Save contents of BC - LD HL,PBUFF - LD B,17 ; One higher than max char count -ZEROSUP: ; Suppress leading zeros - DEC B ; Max 16 chars - LD A,B - CP 001H - JR Z,BITOUT ; Always output at least one character - RL E - RL D - JR NC,ZEROSUP - JR BITOUT2 -BITOUT: - RL E - RL D ; Top bit now in carry -BITOUT2: - LD A,'0' ; Char for '0' - ADC A,0 ; If carry set then '0' --> '1' - LD (HL),A - INC HL - DEC B - JR NZ,BITOUT - XOR A ; Terminating character - LD (HL),A ; Store zero to terminate - INC HL ; Make sure PBUFF is terminated - LD (HL),A ; Store the double zero there - POP BC - LD HL,PBUFF - JP STR1 + ; BIN$(NN) Convert integer to a 1-16 char binary string +BIN: CALL TSTNUM ; Verify it's a number + CALL DEINT ; Get integer -32768 to 32767 +BIN2: PUSH BC ; Save contents of BC + LD HL,PBUFF + LD B,17 ; One higher than max char count +ZEROSUP: ; Suppress leading zeros + DEC B ; Max 16 chars + LD A,B + CP 001H + JR Z,BITOUT ; Always output at least one character + RL E + RL D + JR NC,ZEROSUP + JR BITOUT2 +BITOUT: + RL E + RL D ; Top bit now in carry +BITOUT2: + LD A,'0' ; Char for '0' + ADC A,0 ; If carry set then '0' --> '1' + LD (HL),A + INC HL + DEC B + JR NZ,BITOUT + XOR A ; Terminating character + LD (HL),A ; Store zero to terminate + INC HL ; Make sure PBUFF is terminated + LD (HL),A ; Store the double zero there + POP BC + LD HL,PBUFF + JP STR1 -; Convert "&Bnnnn" to FPREG -; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" -BINTFP: EX DE,HL ; Move code string pointer to DE - LD HL,00000H ; Zero out the value - CALL CHKBIN ; Check the number for valid bin - JP C,BINERR ; First value wasn't bin, HX error -BINIT: SUB '0' - ADD HL,HL ; Rotate HL left - OR L - LD L,A - CALL CHKBIN ; Get second and addtional characters - JR NC,BINIT ; Process if a bin character - EX DE,HL ; Value into DE, Code string into HL - LD A,D ; Load DE into AC - LD C,E ; For prep to - PUSH HL - CALL ACPASS ; ACPASS to set AC as integer into FPREG - POP HL - RET + ; Convert "&Bnnnn" to FPREG + ; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" +BINTFP: EX DE,HL ; Move code string pointer to DE + LD HL,00000H ; Zero out the value + CALL CHKBIN ; Check the number for valid bin + JP C,BINERR ; First value wasn't bin, HX error +BINIT: SUB '0' + ADD HL,HL ; Rotate HL left + OR L + LD L,A + CALL CHKBIN ; Get second and addtional characters + JR NC,BINIT ; Process if a bin character + EX DE,HL ; Value into DE, Code string into HL + LD A,D ; Load DE into AC + LD C,E ; For prep to + PUSH HL + CALL ACPASS ; ACPASS to set AC as integer into FPREG + POP HL + RET -; Char is in A, NC if char is 0 or 1 -CHKBIN: INC DE - LD A,(DE) - CP ' ' - JP Z,CHKBIN ; Skip spaces - CP '0' ; Set C if < '0' - RET C - CP '2' - CCF ; Set C if > '1' - RET + ; Char is in A, NC if char is 0 or 1 +CHKBIN: INC DE + LD A,(DE) + CP ' ' + JP Z,CHKBIN ; Skip spaces + CP '0' ; Set C if < '0' + RET C + CP '2' + CCF ; Set C if > '1' + RET -BINERR: LD E,BN ; ?BIN Error - JP BERROR +BINERR: LD E,BN ; ?BIN Error + JP BERROR -JJUMP1: LD IX,-1 ; Flag cold start - JP CSTART ; Go and initialise +JJUMP1: LD IX,-1 ; Flag cold start + JP CSTART ; Go and initialise - ; Restored SCREEN command updated for the MZ80A. - ; The MZ80A uses 0,0 -> COLW-1,ROW-1 addressing as opposed to the NASCOM 1,1 -> 48,16 - ; -SCREEN: CALL GETINT ; Get integer 0 to 255 - PUSH AF ; Save column - CALL CHKSYN ; Make sure "," follows - DB "," - CALL GETINT ; Get integer 0 to 255 - POP BC ; Column to B - PUSH HL ; Save code string address - PUSH BC ; Save column - CALL SCRADR ; Set screen coordinates. - POP HL ; Rstore code string address - RET + ; Restored SCREEN command updated for the MZ80A. + ; The MZ80A uses 0,0 -> COLW-1,ROW-1 addressing as opposed to the NASCOM 1,1 -> 48,16 + ; +SCREEN: CALL GETINT ; Get integer 0 to 255 + PUSH AF ; Save column + CALL CHKSYN ; Make sure "," follows + DB "," + CALL GETINT ; Get integer 0 to 255 + POP BC ; Column to B + PUSH HL ; Save code string address + PUSH BC ; Save column + CALL SCRADR ; Set screen coordinates. + POP HL ; Rstore code string address + RET -SCRADR: LD B,A ; Line and column to BC once checked. - OR A ; Test it - JP Z,FCERR ; Zero - ?FC Error - CP ROW+1 ; Number of lines - JP P,FCERR ; > Number of lines then ?FC Error - DEC B ; Sharp uses 0,0 addressing so once value verified, decrement. - POP DE ; RETurn address - POP AF ; Get column - PUSH DE ; Re-save RETurn - LD C,A ; Column to DE - OR A ; Test it - JP Z,FCERR ; Zero - ?FC Error - CP COLW+1 ; Number of characters per line - JP P,FCERR ; > number of characters then ?FC Error - DEC C ; Sharp uses 0,0 addressing. - LD (DSPXY),BC ; Save coordinates. - RET +SCRADR: LD B,A ; Line and column to BC once checked. + OR A ; Test it + JP Z,FCERR ; Zero - ?FC Error + CP ROW+1 ; Number of lines + JP P,FCERR ; > Number of lines then ?FC Error + DEC B ; Sharp uses 0,0 addressing so once value verified, decrement. + POP DE ; RETurn address + POP AF ; Get column + PUSH DE ; Re-save RETurn + LD C,A ; Column to DE + OR A ; Test it + JP Z,FCERR ; Zero - ?FC Error + CP COLW+1 ; Number of characters per line + JP P,FCERR ; > number of characters then ?FC Error + DEC C ; Sharp uses 0,0 addressing. + LD (DSPXY),BC ; Save coordinates. + RET -ARETN: RETN ; Return from NMI +ARETN: RETN ; Return from NMI -TSTBIT: PUSH AF ; Save bit mask - AND B ; Get common bits - POP BC ; Restore bit mask - CP B ; Same bit set? - LD A,0 ; Return 0 in A - RET +TSTBIT: PUSH AF ; Save bit mask + AND B ; Get common bits + POP BC ; Restore bit mask + CP B ; Same bit set? + LD A,0 ; Return 0 in A + RET -OUTNCR: CALL OUTC ; Output character in A - JP PRNTCRLF ; Output CRLF +OUTNCR: CALL OUTC ; Output character in A + JP PRNTCRLF ; Output CRLF - ; Method to load BASIC text program. -LOAD: LD A,TAPELOAD ; Set the type of operation into the flag var. - JR CLOAD0 + ; Method to load BASIC text program. +LOAD: LD A,TAPELOAD ; Set the type of operation into the flag var. + JR CLOAD0 - ; Method to load a cassette image (tokenised basic script). - ; -CLOAD: LD A,CTAPELOAD ; Set the type of operatiom into the flag var. -CLOAD0: LD (TPFLAG),A - LD A,(HL) ; Get byte after "CLOAD" - ;CP ZTIMES ; "*" token? ("CLOAD*") - ;JP Z,ARRLD1 ; Yes - Array load - SUB ZPRINT ; "?" ("PRINT" token) Verify? - JP Z,FLGVER ; Yes - Flag "verify" - XOR A ; Flag "load" - DB 01H ; Skip "CPL" and "INC HL" -FLGVER: CPL ; Flag "verify" - INC HL ; Skip over "?" - PUSH AF ; Save verify flag - DEC HL ; DEC 'cos GETCHR INCs - CALL GETCHR ; Get next character - LD A,0 ; Any file will do - JP Z,SDNONAM ; No name given - error. - CALL EVAL ; Evaluate expression - CALL GTFLNM ; Get file name - POP AF - OR A - JP NZ,SDVERF - ; - LD HL,TZSVC_FILENAME ; Set the filename to be created. - LD A,(TMSTPL) - CP TZSVCFILESZ ; Check size of filename, cant be more than an MZF name of 17 chars. - JP NC,SDFNTG - LD B,A -CLOAD1: LD A,(DE) ; Copy filename into service record. - LD (HL),A - INC DE - INC HL - DJNZ CLOAD1 - XOR A - LD (HL),A ; Terminate filename. - ; - CALL CLRPTR ; Initialise memory to NEW state ready for program load. - LD A,(TPFLAG) ; What are we processing, cassette image or text? - CP CTAPELOAD - JR Z,CLOAD2 ; Is this a cassette image load? - CALL LDTXT ; BASIC text load. - JR SDLOADE -CLOAD2: SCF - CALL PRCFIL ; Process file as a load request. -CLOAD3: PUSH HL - LD HL,(BASTXT) ; Get start of program memory. - LD BC,(TZSVC_LOADSIZE) ; Get the actual load size. - ADD HL,BC ; Find the end. - XOR A - LD (HL),A ; Last two bytes are xeroed as they are for the next line number. - INC HL - LD (HL),A - INC HL - LD (PROGND),HL ; Set it as the end of program memory. - POP HL - JR SDLOADE ; Exit and tidy up. + ; Method to load a cassette image (tokenised basic script). + ; +CLOAD: LD A,CTAPELOAD ; Set the type of operatiom into the flag var. +CLOAD0: LD (TPFLAG),A + LD A,(HL) ; Get byte after "CLOAD" + ; CP ZTIMES ; "*" token? ("CLOAD*") + ; JP Z,ARRLD1 ; Yes - Array load + SUB ZPRINT ; "?" ("PRINT" token) Verify? + JP Z,FLGVER ; Yes - Flag "verify" + XOR A ; Flag "load" + DB 01H ; Skip "CPL" and "INC HL" +FLGVER: CPL ; Flag "verify" + INC HL ; Skip over "?" + PUSH AF ; Save verify flag + DEC HL ; DEC 'cos GETCHR INCs + CALL GETCHR ; Get next character + LD A,0 ; Any file will do + JP Z,SDNONAM ; No name given - error. + CALL EVAL ; Evaluate expression + CALL GTFLNM ; Get file name + POP AF + OR A + JP NZ,SDVERF + ; + LD HL,TZSVC_FILENAME ; Set the filename to be created. + LD A,(TMSTPL) + CP TZSVCFILESZ ; Check size of filename, cant be more than an MZF name of 17 chars. + JP NC,SDFNTG + LD B,A +CLOAD1: LD A,(DE) ; Copy filename into service record. + LD (HL),A + INC DE + INC HL + DJNZ CLOAD1 + XOR A + LD (HL),A ; Terminate filename. + ; + CALL CLRPTR ; Initialise memory to NEW state ready for program load. + LD A,(TPFLAG) ; What are we processing, cassette image or text? + CP CTAPELOAD + JR Z,CLOAD2 ; Is this a cassette image load? + CALL LDTXT ; BASIC text load. + JR SDLOADE +CLOAD2: SCF + CALL PRCFIL ; Process file as a load request. +CLOAD3: PUSH HL + LD HL,(BASTXT) ; Get start of program memory. + LD BC,(TZSVC_LOADSIZE) ; Get the actual load size. + ADD HL,BC ; Find the end. + XOR A + LD (HL),A ; Last two bytes are xeroed as they are for the next line number. + INC HL + LD (HL),A + INC HL + LD (PROGND),HL ; Set it as the end of program memory. + POP HL + JR SDLOADE ; Exit and tidy up. SDVERF: -SDLOADE:LD HL,OKMSG ; "Ok" message - CALL PRS ; Output string - JP SETPTR ; Set up line pointers +SDLOADE: LD HL,OKMSG ; "Ok" message + CALL PRS ; Output string + JP SETPTR ; Set up line pointers - ; Methods to open, read and close an SD file for retrieval of basic program data. Cassette files are read/written - ; directly to memory by the K64F but text files, as they are being expanded/compressed, need to be read/written - ; sector by sector. -LDOPEN: XOR A - LD (TZSVC_FILE_SEC),A ; Starting sector number of file to load. - LD A,TZSVC_FTYPE_BAS ; Type of file is CASsette, the K64F will know how to handle it. - LD (TZSVC_FILE_TYPE),A - LD A,TZSVC_CMD_READFILE - CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. - OR A ; Zero means no physical error occurred. - JP NZ, SDOPER ; Open error, K64F didint respond, cannot read! - LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. - OR A - JP NZ, SDOPER ; Same thing, if K64F processes request and returns an error, open or read problem! - LD HL,TZSVCSECTOR ; Start at beginning of sector. - LD (SECTPOS),HL - RET + ; Methods to open, read and close an SD file for retrieval of basic program data. Cassette files are read/written + ; directly to memory by the K64F but text files, as they are being expanded/compressed, need to be read/written + ; sector by sector. +LDOPEN: XOR A + LD (TZSVC_FILE_SEC),A ; Starting sector number of file to load. + LD A,TZSVC_FTYPE_BAS ; Type of file is CASsette, the K64F will know how to handle it. + LD (TZSVC_FILE_TYPE),A + LD A,TZSVC_CMD_READFILE + CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. + OR A ; Zero means no physical error occurred. + JP NZ, SDOPER ; Open error, K64F didint respond, cannot read! + LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. + OR A + JP NZ, SDOPER ; Same thing, if K64F processes request and returns an error, open or read problem! + LD HL,TZSVCSECTOR ; Start at beginning of sector. + LD (SECTPOS),HL + RET -LDCLOSE:LD A,TZSVC_CMD_CLOSE ; Close file. - CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. - OR A ; Zero means no physical error occurred. - JP NZ, SDCLER ; Close error, K64F didint respond, cannot close the file. - LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. - OR A - JP NZ, SDCLER ; Same thing, if K64F closes file and returns an error, closing problem (SD removed!)! - RET +LDCLOSE: LD A,TZSVC_CMD_CLOSE ; Close file. + CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. + OR A ; Zero means no physical error occurred. + JP NZ, SDCLER ; Close error, K64F didint respond, cannot close the file. + LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. + OR A + JP NZ, SDCLER ; Same thing, if K64F closes file and returns an error, closing problem (SD removed!)! + RET -LDBUF: LD A,(TZSVC_FILE_SEC) ; Update the virtual file sector number so the K64F knows what to read. - INC A - LD (TZSVC_FILE_SEC),A - LD A, TZSVC_CMD_NEXTREADFILE - CALL SVC_CMD ; And make communications with the I/O processor, returning with the required record. - OR A ; Zero means no physical error occurred. - JP NZ, SDRDER ; Write error, K64F didint respond, cannot write so flag as error! - LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. - OR A - JP NZ, SDRDER ; Same thing, if K64F read from file returns an error, read error (SD removed or disk error!)! - RET +LDBUF: LD A,(TZSVC_FILE_SEC) ; Update the virtual file sector number so the K64F knows what to read. + INC A + LD (TZSVC_FILE_SEC),A + LD A, TZSVC_CMD_NEXTREADFILE + CALL SVC_CMD ; And make communications with the I/O processor, returning with the required record. + OR A ; Zero means no physical error occurred. + JP NZ, SDRDER ; Write error, K64F didint respond, cannot write so flag as error! + LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. + OR A + JP NZ, SDRDER ; Same thing, if K64F read from file returns an error, read error (SD removed or disk error!)! + RET - ; Method to load a NASIC program which is stored as TEXT into memory. This is accomplied sector by sector, line by line, - ; each line needs to be read, tokenised and stored. - ; -LDTXT: CALL LDOPEN ; Open file, read the first sector of data. - LD HL,(PROGND) ; After reset the pointer points to the first line number not the first address - DEC HL ; Update it to keep the later logic more simple. - DEC HL - LD (PROGND),HL - ; -LDTXT0: LD HL,(TZSVC_LOADSIZE) ; Get size of sector loaded. - LD BC,TZSVCSECTOR ; Address of sector - ADD HL,BC ; End of sector address - PUSH HL - POP BC ; BC contains sector end address. - LD HL,(SECTPOS) ; Get position in sector for next line. - LD DE,STACKE ; Copy line into temporary area in case we span sectors. -LDTXT1: PUSH HL - OR A - SBC HL,BC ; So long as the end sector address is greater than the pointer we will have carry. - POP HL - JR C,LDTXT2 ; Check that we havent got to the end of the current sector. - CALL LDBUF ; End of current sector so load new. - LD HL,(TZSVC_LOADSIZE) - LD A,H - OR L - JR Z,LDTXTE ; No bytes in sector means end of file,exit. - LD HL,TZSVCSECTOR ; Start at beginning of sector. -LDTXT2: LD A,(HL) ; Copy the string from the sector to the temporary area. - LD (DE),A - INC HL - CP CR - JR Z,LDTXT3 ; CR means EOS. - CP LF - JR Z,LDTXT3 ; LF means EOS. - INC DE - JR LDTXT1 -LDTXT3: LD A,(HL) ; If CR make sure any LF is wasted. - CP LF - JR NZ,LDTXT4 - INC HL -LDTXT4: LD (SECTPOS),HL - LD HL,STACKE ; Start of line to insert. - XOR A - LD (DE),A ; Terminate string, BASIC uses NULL terminated strings. - CALL ATOH ; Get line number into DE - PUSH DE ; Save line number - CALL CRUNCH ; Convert text to tokens. A returns with size of line in BUFFER. - LD L,C ; Length of string to L. - LD H,0 - LD BC,(PROGND) - PUSH BC - ADD HL,BC ; Find new end - LD (PROGND),HL ; Update end of program pointer - POP DE ; Get back old pointer. - EX DE,HL - LD (HL),E ; Set pointer to end of line. - INC HL - LD (HL),D - INC HL ; Move onto line number. - POP DE ; Get back line number, - LD (HL),E - INC HL - LD (HL),D ; Store line number. - INC HL ; HL now points to first location for tokenised line. - LD DE,BUFFER ; Copy buffer to program -LDMVBUF:LD A,(DE) ; Get source - LD (HL),A ; Save destinations - INC HL ; Next source - INC DE ; Next destination - OR A ; Done? - JP NZ,LDMVBUF ; No - Repeat - ; - JP LDTXT0 ; Get next line. -LDTXTE: CALL LDCLOSE ; Close file for exit. - RET + ; Method to load a NASIC program which is stored as TEXT into memory. This is accomplied sector by sector, line by line, + ; each line needs to be read, tokenised and stored. + ; +LDTXT: CALL LDOPEN ; Open file, read the first sector of data. + LD HL,(PROGND) ; After reset the pointer points to the first line number not the first address + DEC HL ; Update it to keep the later logic more simple. + DEC HL + LD (PROGND),HL + ; +LDTXT0: LD HL,(TZSVC_LOADSIZE) ; Get size of sector loaded. + LD BC,TZSVCSECTOR ; Address of sector + ADD HL,BC ; End of sector address + PUSH HL + POP BC ; BC contains sector end address. + LD HL,(SECTPOS) ; Get position in sector for next line. + LD DE,STACKE ; Copy line into temporary area in case we span sectors. +LDTXT1: PUSH HL + OR A + SBC HL,BC ; So long as the end sector address is greater than the pointer we will have carry. + POP HL + JR C,LDTXT2 ; Check that we havent got to the end of the current sector. + CALL LDBUF ; End of current sector so load new. + LD HL,(TZSVC_LOADSIZE) + LD A,H + OR L + JR Z,LDTXTE ; No bytes in sector means end of file,exit. + LD HL,TZSVCSECTOR ; Start at beginning of sector. +LDTXT2: LD A,(HL) ; Copy the string from the sector to the temporary area. + LD (DE),A + INC HL + CP CR + JR Z,LDTXT3 ; CR means EOS. + CP LF + JR Z,LDTXT3 ; LF means EOS. + INC DE + JR LDTXT1 +LDTXT3: LD A,(HL) ; If CR make sure any LF is wasted. + CP LF + JR NZ,LDTXT4 + INC HL +LDTXT4: LD (SECTPOS),HL + LD HL,STACKE ; Start of line to insert. + XOR A + LD (DE),A ; Terminate string, BASIC uses NULL terminated strings. + CALL ATOH ; Get line number into DE + PUSH DE ; Save line number + CALL CRUNCH ; Convert text to tokens. A returns with size of line in BUFFER. + LD L,C ; Length of string to L. + LD H,0 + LD BC,(PROGND) + PUSH BC + ADD HL,BC ; Find new end + LD (PROGND),HL ; Update end of program pointer + POP DE ; Get back old pointer. + EX DE,HL + LD (HL),E ; Set pointer to end of line. + INC HL + LD (HL),D + INC HL ; Move onto line number. + POP DE ; Get back line number, + LD (HL),E + INC HL + LD (HL),D ; Store line number. + INC HL ; HL now points to first location for tokenised line. + LD DE,BUFFER ; Copy buffer to program +LDMVBUF: LD A,(DE) ; Get source + LD (HL),A ; Save destinations + INC HL ; Next source + INC DE ; Next destination + OR A ; Done? + JP NZ,LDMVBUF ; No - Repeat + ; + JP LDTXT0 ; Get next line. +LDTXTE: CALL LDCLOSE ; Close file for exit. + RET - ; Method to save BASIC text to file. - ; -SAVE: LD A,TAPESAVE ; Set the type of operation into the flag var. - JR CSAVE0 + ; Method to save BASIC text to file. + ; +SAVE: LD A,TAPESAVE ; Set the type of operation into the flag var. + JR CSAVE0 - ; Method to save a cassette image (tokenised basic script). - ; -CSAVE: LD A,CTAPESAVE ; Set the type of operatiom into the flag var. -CSAVE0: LD (TPFLAG),A - ; - LD B,1 ; Flag "CSAVE" - ;CP ZTIMES ; "*" token? ("CSAVE*") - ;JP Z,ARRSV1 ; Yes - Array save - CALL EVAL ; Evaluate expression - PUSH HL - CALL GTFLNM ; Get file name - ; - LD HL,TZSVC_FILENAME ; Set the filename to be created. - LD A,(TMSTPL) - CP TZSVCFILESZ ; Check size of filename, cant be more than an MZF name of 17 chars. - JP NC,SDFNTG - LD B,A -CSAVE1: LD A,(DE) ; Copy filename into service record. - LD (HL),A - INC DE - INC HL - DJNZ CSAVE1 - XOR A - LD (HL),A ; Terminate filename. - ; - LD A,(TPFLAG) ; What are we processing, cassette image or text? - CP CTAPESAVE - JR Z,CSAVE2 ; Is this a cassette image save? - ; - PUSH DE - CALL SVOPEN ; Open the required file for writing. - CALL SVTXT ; Expand and save text into the file - CALL SVCLOSE ; Finish by closing file so no corruption occurs. - POP DE - JR CSAVEE -CSAVE2: SCF - CCF - CALL PRCFIL ; Process file as a save request. -CSAVEE: POP HL - RET + ; Method to save a cassette image (tokenised basic script). + ; +CSAVE: LD A,CTAPESAVE ; Set the type of operatiom into the flag var. +CSAVE0: LD (TPFLAG),A + ; + LD B,1 ; Flag "CSAVE" + ; CP ZTIMES ; "*" token? ("CSAVE*") + ; JP Z,ARRSV1 ; Yes - Array save + CALL EVAL ; Evaluate expression + PUSH HL + CALL GTFLNM ; Get file name + ; + LD HL,TZSVC_FILENAME ; Set the filename to be created. + LD A,(TMSTPL) + CP TZSVCFILESZ ; Check size of filename, cant be more than an MZF name of 17 chars. + JP NC,SDFNTG + LD B,A +CSAVE1: LD A,(DE) ; Copy filename into service record. + LD (HL),A + INC DE + INC HL + DJNZ CSAVE1 + XOR A + LD (HL),A ; Terminate filename. + ; + LD A,(TPFLAG) ; What are we processing, cassette image or text? + CP CTAPESAVE + JR Z,CSAVE2 ; Is this a cassette image save? + ; + PUSH DE + CALL SVOPEN ; Open the required file for writing. + CALL SVTXT ; Expand and save text into the file + CALL SVCLOSE ; Finish by closing file so no corruption occurs. + POP DE + JR CSAVEE +CSAVE2: SCF + CCF + CALL PRCFIL ; Process file as a save request. +CSAVEE: POP HL + RET - ; Methods to open, write and close an SD file for storage of basic program data. Cassette files are read/written - ; directly to memory by the K64F but text files, as they are being expanded/compressed, need to be read/written - ; sector by sector. - ; -SVOPEN: PUSH HL - XOR A - LD (TZSVC_FILE_SEC),A ; Starting sector number. - LD A,TZSVC_FTYPE_BAS ; Type of file is BASic, the K64F will know how to handle it. - LD (TZSVC_FILE_TYPE),A - LD HL,0 - LD (TZSVC_SAVESIZE),HL ; Initialise the sector size count. - POP HL - LD A,TZSVC_CMD_WRITEFILE - CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. - OR A ; Zero means no physical error occurred. - JP NZ, SDCRER ; Create error, K64F didint respond, cannot write! - LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. - OR A - JP NZ, SDCRER ; Same thing, if K64F processes request and returns an error, creation problem! - RET + ; Methods to open, write and close an SD file for storage of basic program data. Cassette files are read/written + ; directly to memory by the K64F but text files, as they are being expanded/compressed, need to be read/written + ; sector by sector. + ; +SVOPEN: PUSH HL + XOR A + LD (TZSVC_FILE_SEC),A ; Starting sector number. + LD A,TZSVC_FTYPE_BAS ; Type of file is BASic, the K64F will know how to handle it. + LD (TZSVC_FILE_TYPE),A + LD HL,0 + LD (TZSVC_SAVESIZE),HL ; Initialise the sector size count. + POP HL + LD A,TZSVC_CMD_WRITEFILE + CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. + OR A ; Zero means no physical error occurred. + JP NZ, SDCRER ; Create error, K64F didint respond, cannot write! + LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. + OR A + JP NZ, SDCRER ; Same thing, if K64F processes request and returns an error, creation problem! + RET -SVCLOSE:CALL SVBUF ; Flush out any unwritten data. - LD A,TZSVC_CMD_CLOSE ; Close file. - CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. - OR A ; Zero means no physical error occurred. - JP NZ, SDCLER ; Close error, K64F didint respond, cannot write so flag as error! - LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. - OR A - JP NZ, SDCLER ; Same thing, if K64F closes file and returns an error, closing problem (SD removed!)! - RET +SVCLOSE: CALL SVBUF ; Flush out any unwritten data. + LD A,TZSVC_CMD_CLOSE ; Close file. + CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. + OR A ; Zero means no physical error occurred. + JP NZ, SDCLER ; Close error, K64F didint respond, cannot write so flag as error! + LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. + OR A + JP NZ, SDCLER ; Same thing, if K64F closes file and returns an error, closing problem (SD removed!)! + RET -SVBUF: LD A, TZSVC_CMD_NEXTWRITEFILE - CALL SVC_CMD ; And make communications with the I/O processor, returning with the required record. - OR A ; Zero means no physical error occurred. - JP NZ, SDWRER ; Write error, K64F didint respond, cannot write so flag as error! - LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. - OR A - JP NZ, SDWRER ; Same thing, if K64F write to file and returns an error, write error (SD removed or disk full!)! - LD A,(TZSVC_FILE_SEC) ; Update the virtual file sector number - INC A - LD (TZSVC_FILE_SEC),A - LD DE,0 - LD (TZSVC_SAVESIZE),DE ; Initialise to empty sector. - RET +SVBUF: LD A, TZSVC_CMD_NEXTWRITEFILE + CALL SVC_CMD ; And make communications with the I/O processor, returning with the required record. + OR A ; Zero means no physical error occurred. + JP NZ, SDWRER ; Write error, K64F didint respond, cannot write so flag as error! + LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. + OR A + JP NZ, SDWRER ; Same thing, if K64F write to file and returns an error, write error (SD removed or disk full!)! + LD A,(TZSVC_FILE_SEC) ; Update the virtual file sector number + INC A + LD (TZSVC_FILE_SEC),A + LD DE,0 + LD (TZSVC_SAVESIZE),DE ; Initialise to empty sector. + RET - ; Methods to write into the SD sector a BASIC script as it is expanded into text. - ; -WRLINE: PUSH BC ; Convert line number in DE into text. - XOR A - LD B,80H+24 ; 24 bits - CALL RETINT ; Return the integer - CALL NUMASC ; Output line number in decimal - POP BC - LD HL,PBUFF ; Text version of line number now in PBUFF -WRLINE1:LD A,(HL) ; Loop and write to service command sector, 0 terminates string. - OR A - RET Z - CALL WRBUF - INC HL - JR WRLINE1 + ; Methods to write into the SD sector a BASIC script as it is expanded into text. + ; +WRLINE: PUSH BC ; Convert line number in DE into text. + XOR A + LD B,80H+24 ; 24 bits + CALL RETINT ; Return the integer + CALL NUMASC ; Output line number in decimal + POP BC + LD HL,PBUFF ; Text version of line number now in PBUFF +WRLINE1: LD A,(HL) ; Loop and write to service command sector, 0 terminates string. + OR A + RET Z + CALL WRBUF + INC HL + JR WRLINE1 -WRCRLF: LD A,CR ; Carriage return first. - CALL WRBUF - LD A,LF ; Now line feed. -WRBUF: PUSH HL ; Save as were using it. - PUSH DE - LD DE,(TZSVC_SAVESIZE) ; Get current pointer into sector for next char. - LD HL,TZSVCSECTOR ; Add in the absolute address of the service sector. - ADD HL,DE - LD (HL),A ; Save at correct location. - ;CALL PRNT ; Print out what is being saved, debug! - INC DE - LD (TZSVC_SAVESIZE),DE ; Update the sector location for next byte. - LD A,D - CP 2 ; Test to see if buffer full. Hard coded 512 byte msb as Glass isnt resolving shift right correctly. - JR NZ,WRBUF1 - CALL SVBUF ; Save the buffer. - ; Write out buffer. -WRBUF1: POP DE - POP HL ; Restore and get out. - RET +WRCRLF: LD A,CR ; Carriage return first. + CALL WRBUF + LD A,LF ; Now line feed. +WRBUF: PUSH HL ; Save as were using it. + PUSH DE + LD DE,(TZSVC_SAVESIZE) ; Get current pointer into sector for next char. + LD HL,TZSVCSECTOR ; Add in the absolute address of the service sector. + ADD HL,DE + LD (HL),A ; Save at correct location. + ; CALL PRNT ; Print out what is being saved, debug! + INC DE + LD (TZSVC_SAVESIZE),DE ; Update the sector location for next byte. + LD A,D + CP 2 ; Test to see if buffer full. Hard coded 512 byte msb as Glass isnt resolving shift right correctly. + JR NZ,WRBUF1 + CALL SVBUF ; Save the buffer. + ; Write out buffer. +WRBUF1: POP DE + POP HL ; Restore and get out. + RET - ; Method to save the current program in memory to SD card as text. - ; This is the most common way of working with basic scripts, the cassette - ; image type offers speed but in this day and age it is not so much needed. - ; -SVTXT: LD DE,0 - CALL SRCHLN ; Search for line number in DE - PUSH BC ; Save address of line - CALL SETLIN ; Set up lines counter - JR SVTXT1 ; Skip CR on first line. -SVTXT0: CALL WRCRLF ; Write CRLF to buffer. -SVTXT1: POP HL ; Restore address of line - LD C,(HL) ; Get LSB of next line - INC HL - LD B,(HL) ; Get MSB of next line - INC HL - LD A,B ; BC = 0 (End of program)? - OR C - RET Z ; Yes - finish save. - CALL SVCNT ; Count lines - PUSH BC ; Save address of next line - LD E,(HL) ; Get LSB of line number - INC HL - LD D,(HL) ; Get MSB of line number - INC HL - PUSH HL ; Save address of line start - CALL WRLINE ; Write out the line number. - LD A,' ' ; Space after line number - POP HL ; Restore start of line address -SVTXT2: CALL WRBUF ; Output character in A -SVTXT3: LD A,(HL) ; Get next byte in line - OR A ; End of line? - INC HL ; To next byte in line - JP Z,SVTXT0 ; Yes - get next line - JP P,SVTXT2 ; No token - output it - SUB ZEND-1 ; Find and output word - LD C,A ; Token offset+1 to C - LD DE,WORDS ; Reserved word list -SVTXT4: LD A,(DE) ; Get character in list - INC DE ; Move on to next - OR A ; Is it start of word? - JP P,SVTXT4 ; No - Keep looking for word - DEC C ; Count words - JP NZ,SVTXT4 ; Not there - keep looking -SVTXT5: AND 01111111B ; Strip bit 7 - CALL WRBUF ; Output first character - LD A,(DE) ; Get next character - INC DE ; Move on to next - OR A ; Is it end of word? - JP P,SVTXT5 ; No - output the rest - JP SVTXT3 ; Next byte in line + ; Method to save the current program in memory to SD card as text. + ; This is the most common way of working with basic scripts, the cassette + ; image type offers speed but in this day and age it is not so much needed. + ; +SVTXT: LD DE,0 + CALL SRCHLN ; Search for line number in DE + PUSH BC ; Save address of line + CALL SETLIN ; Set up lines counter + JR SVTXT1 ; Skip CR on first line. +SVTXT0: CALL WRCRLF ; Write CRLF to buffer. +SVTXT1: POP HL ; Restore address of line + LD C,(HL) ; Get LSB of next line + INC HL + LD B,(HL) ; Get MSB of next line + INC HL + LD A,B ; BC = 0 (End of program)? + OR C + RET Z ; Yes - finish save. + CALL SVCNT ; Count lines + PUSH BC ; Save address of next line + LD E,(HL) ; Get LSB of line number + INC HL + LD D,(HL) ; Get MSB of line number + INC HL + PUSH HL ; Save address of line start + CALL WRLINE ; Write out the line number. + LD A,' ' ; Space after line number + POP HL ; Restore start of line address +SVTXT2: CALL WRBUF ; Output character in A +SVTXT3: LD A,(HL) ; Get next byte in line + OR A ; End of line? + INC HL ; To next byte in line + JP Z,SVTXT0 ; Yes - get next line + JP P,SVTXT2 ; No token - output it + SUB ZEND-1 ; Find and output word + LD C,A ; Token offset+1 to C + LD DE,WORDS ; Reserved word list +SVTXT4: LD A,(DE) ; Get character in list + INC DE ; Move on to next + OR A ; Is it start of word? + JP P,SVTXT4 ; No - Keep looking for word + DEC C ; Count words + JP NZ,SVTXT4 ; Not there - keep looking +SVTXT5: AND 01111111B ; Strip bit 7 + CALL WRBUF ; Output first character + LD A,(DE) ; Get next character + INC DE ; Move on to next + OR A ; Is it end of word? + JP P,SVTXT5 ; No - output the rest + JP SVTXT3 ; Next byte in line -SVCNT: PUSH HL ; Save code string address - PUSH DE - LD HL,(LINESC) ; Get LINES counter - LD DE,-1 - ADC HL,DE ; Decrement - LD (LINESC),HL ; Put it back - POP DE - POP HL ; Restore code string address - RET P ; Return if more lines to go - PUSH HL ; Save code string address - LD HL,(LINESN) ; Get LINES number - LD (LINESC),HL ; Reset LINES counter - POP HL ; Restore code string address - JP SVCNT ; Keep on counting +SVCNT: PUSH HL ; Save code string address + PUSH DE + LD HL,(LINESC) ; Get LINES counter + LD DE,-1 + ADC HL,DE ; Decrement + LD (LINESC),HL ; Put it back + POP DE + POP HL ; Restore code string address + RET P ; Return if more lines to go + PUSH HL ; Save code string address + LD HL,(LINESN) ; Get LINES number + LD (LINESC),HL ; Reset LINES counter + POP HL ; Restore code string address + JP SVCNT ; Keep on counting - ; Method to process a cassette based file load/save. - ; The file is stored in a tokenised format and maintains a degree - ; of compatibility with NASCOM files. To use NASCOM files please - ; see the 'nasconv' tool which updates the tokens as this version - ; of BASIC adds additional commands which meant adjusting token values. - ; -PRCFIL: JR NC,PRCFIL1 - LD HL,(BASTXT) ; Get start of program memory. - LD (TZSVC_LOADADDR), HL - LD DE,(LSTRAM) - EX DE,HL - SBC HL,DE - LD (TZSVC_LOADSIZE),HL ; Place max size we can load into the service loadsize field. - LD A,TZSVC_CMD_LOADFILE - JR PRCFIL2 -PRCFIL1:LD DE,(BASTXT) ; Get start of program memory. - LD (TZSVC_SAVEADDR), DE - LD HL,(PROGND) ; End of program information - SBC HL,DE ; Get size of program. - LD (TZSVC_SAVESIZE),HL ; Store into service record. - LD A,TZSVC_CMD_SAVEFILE -PRCFIL2:PUSH AF ; Save service command to execute. - ; - ; Setup the service record for the file load/save. - ; - LD A,0FFh ; Tag the filenumber as invalid. - LD (TZSVC_FILE_NO), A - LD A,(TMSTPL) - CP TZSVCFILESZ ; Check size of filename, cant be more than an MZF name of 17 chars. - JR NC,SDFNTG - LD A,TZSVC_FTYPE_CAS ; Type of file is CASsette, the K64F will know how to handle it. - LD (TZSVC_FILE_TYPE),A - POP AF - CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. - OR A ; Zero means no physical error occurred. - JR Z, PRCFIL3 - JR SDPHYER -PRCFIL3: LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. - OR A - RET Z - LD A,(TZSVCCMD) - CP TZSVC_CMD_LOADFILE - JR Z,SDLDER - JR SDSVER + ; Method to process a cassette based file load/save. + ; The file is stored in a tokenised format and maintains a degree + ; of compatibility with NASCOM files. To use NASCOM files please + ; see the 'nasconv' tool which updates the tokens as this version + ; of BASIC adds additional commands which meant adjusting token values. + ; +PRCFIL: JR NC,PRCFIL1 + LD HL,(BASTXT) ; Get start of program memory. + LD (TZSVC_LOADADDR), HL + LD DE,(LSTRAM) + EX DE,HL + SBC HL,DE + LD (TZSVC_LOADSIZE),HL ; Place max size we can load into the service loadsize field. + LD A,TZSVC_CMD_LOADFILE + JR PRCFIL2 +PRCFIL1: LD DE,(BASTXT) ; Get start of program memory. + LD (TZSVC_SAVEADDR), DE + LD HL,(PROGND) ; End of program information + SBC HL,DE ; Get size of program. + LD (TZSVC_SAVESIZE),HL ; Store into service record. + LD A,TZSVC_CMD_SAVEFILE +PRCFIL2: PUSH AF ; Save service command to execute. + ; + ; Setup the service record for the file load/save. + ; + LD A,0FFh ; Tag the filenumber as invalid. + LD (TZSVC_FILE_NO), A + LD A,(TMSTPL) + CP TZSVCFILESZ ; Check size of filename, cant be more than an MZF name of 17 chars. + JR NC,SDFNTG + LD A,TZSVC_FTYPE_CAS ; Type of file is CASsette, the K64F will know how to handle it. + LD (TZSVC_FILE_TYPE),A + POP AF + CALL SVC_CMD ; And make communications wit the I/O processor, returning with the required record. + OR A ; Zero means no physical error occurred. + JR Z, PRCFIL3 + JR SDPHYER +PRCFIL3: LD A,(TZSVCRESULT) ; Check the result from the K64F, non zero is an error. + OR A + RET Z + LD A,(TZSVCCMD) + CP TZSVC_CMD_LOADFILE + JR Z,SDLDER + JR SDSVER -SDNONAM:LD HL,BADFN ; Must give a name for SD card load and save. -SDERR: CALL PRS - POP AF ; Waste return address. - JP ERRIN -SDFNTG: LD HL,FNTOOG - JR SDERR -SDPHYER:LD HL,PHYERR - JR SDERR -SDLDER: LD HL,LOADERR - JR SDERR -SDSVER: LD HL,SAVEERR - JR SDERR -SDCRER: LD HL,CREATER - JR SDERR -SDCLER: LD HL,CLOSEER - JR SDERR -SDWRER: LD HL,WRITEER - JR SDERR -SDOPER: LD HL,OPENER - JR SDERR -SDRDER: LD HL,READER - JR SDERR +SDNONAM: LD HL,BADFN ; Must give a name for SD card load and save. +SDERR: CALL PRS + POP AF ; Waste return address. + JP ERRIN +SDFNTG: LD HL,FNTOOG + JR SDERR +SDPHYER: LD HL,PHYERR + JR SDERR +SDLDER: LD HL,LOADERR + JR SDERR +SDSVER: LD HL,SAVEERR + JR SDERR +SDCRER: LD HL,CREATER + JR SDERR +SDCLER: LD HL,CLOSEER + JR SDERR +SDWRER: LD HL,WRITEER + JR SDERR +SDOPER: LD HL,OPENER + JR SDERR +SDRDER: LD HL,READER + JR SDERR + + ; Command to change the Z80 CPU frequency if running with the tranZPUter upgrade. +SETFREQ: CALL POSINT ; Get frequency in KHz + PUSH HL + ; + LD (TZSVC_CPU_FREQ),DE ; Set the required frequency in the service structure. + LD A,D + CP E + JR NZ,SETFREQ1 + LD A, TZSVC_CMD_CPU_BASEFREQ ; Switch to the base frequency. + JR SETFREQ2 +SETFREQ1: LD A, TZSVC_CMD_CPU_ALTFREQ ; Switch to the alternate frequency. +SETFREQ2: CALL SVC_CMD + OR A + JR NZ,SETFREQERR + LD A,D + CP E + JR Z,SETFREQ4 ; If we are disabling the alternate cpu frequency (ie. = 0) indicate success. + LD A, TZSVC_CMD_CPU_CHGFREQ ; Switch to the base frequency. + CALL SVC_CMD + OR A + JR NZ,SETFREQERR + LD HL, (TZSVC_CPU_FREQ) ; Get the actual frequency the K64F could create. + CALL PRNTHL ; Output amount of free memory + LD HL,FREQSET ; Output the actual frequency. +SETFREQ3: CALL PRS ; Output string + POP HL + RET +SETFREQ4: LD HL,FREQDEF ; Set to default. + JR SETFREQ3 + ; +SETFREQERR: LD HL,FREQERR + JR SDERR -MONITR: -MONITR2 IF BUILD_TZFS = 1 - ; Swtch memory back to TZFS mode. - LD A, TZMM_TZFS - OUT (MMCFG),A - ENDIF - JP REBOOT ; Restart (Normally Monitor Start) +MONITR: +MONITR2 IF BUILD_TZFS = 1 + ; Switch memory back to TZFS mode. + LD A, TZMM_TZFS + OUT (MMCFG),A + ENDIF + JP REBOOT ; Restart (Normally Monitor Start) ;------------------------------------------------------------------------------- ; TIMER INTERRUPT @@ -7515,16 +7549,19 @@ FDCAVAIL: DB "FDC", NOBDOS: DB "I/O Processor failed to load BDOS, aborting!", CR, LF, NUL SVCRESPERR: DB "I/O Response Error, time out!", CR, NUL SVCIOERR: DB "I/O Error, time out!", CR, NUL -BADFN: DB "Filename missing!", 0, 0, 0 -FNTOOG: DB "Filename too long!", 0, 0, 0 -PHYERR: DB "SD/K64F IO error!", 0, 0, 0 -LOADERR: DB "File loading error!", 0, 0, 0 -SAVEERR: DB "File save error!", 0, 0, 0 -CREATER: DB "File create error!", 0, 0, 0 -CLOSEER: DB "File close error!", 0, 0, 0 -WRITEER: DB "File write error!", 0, 0, 0 -OPENER: DB "File open error!", 0, 0, 0 -READER: DB "File read error!", 0, 0, 0 +BADFN: DB "Filename missing!", CR, NUL +FNTOOG: DB "Filename too long!", CR, NUL +PHYERR: DB "SD/K64F IO error!", CR, NUL +LOADERR: DB "File loading error!", CR, NUL +SAVEERR: DB "File save error!", CR, NUL +CREATER: DB "File create error!", CR, NUL +CLOSEER: DB "File close error!", CR, NUL +WRITEER: DB "File write error!", CR, NUL +OPENER: DB "File open error!", CR, NUL +READER: DB "File read error!", CR, NUL +FREQERR: DB "Failed to change frequency!", CR, NUL +FREQSET: DB " KHz set.", CR, LF, NUL +FREQDEF: DB "Set to default.", CR, LF, NUL ;------------------------------------------------------------------------------- ; END OF STATIC LOOKUP TABLES AND CONSTANTS diff --git a/software/asm/include/BASIC_Definitions.asm b/software/asm/include/BASIC_Definitions.asm index 932c613..6b447eb 100644 --- a/software/asm/include/BASIC_Definitions.asm +++ b/software/asm/include/BASIC_Definitions.asm @@ -58,8 +58,8 @@ TAPESAVE EQU 3 CTAPESAVE EQU 4 ; Build options. Set just one to '1' the rest to '0'. -BUILD_MZ80A EQU 1 ; Build for the standard Sharp MZ80A, no lower memory. Manually change MAXMEM above. -BUILD_TZFS EQU 0 ; Build for TZFS where extended memory is available. +BUILD_MZ80A EQU 0 ; Build for the standard Sharp MZ80A, no lower memory. Manually change MAXMEM above. +BUILD_TZFS EQU 1 ; Build for TZFS where extended memory is available. INCLUDE_ANSITERM EQU 1 ; Include the Ansi terminal emulation processor in the build. ; Debugging diff --git a/software/asm/tzfs.asm b/software/asm/tzfs.asm index 8fe522b..704e80f 100644 --- a/software/asm/tzfs.asm +++ b/software/asm/tzfs.asm @@ -565,7 +565,7 @@ SETFREQ: CALL ConvertStringToNumber ; Conve JR NZ,SETFREQ1 LD A, TZSVC_CMD_CPU_BASEFREQ ; Switch to the base frequency. JR SETFREQ2 -SETFREQ1: LD A, TZSVC_CMD_CPU_ALTFREQ ; Switch to the base frequency. +SETFREQ1: LD A, TZSVC_CMD_CPU_ALTFREQ ; Switch to the alternate frequency. SETFREQ2: CALL SVC_CMD OR A JR NZ,SETFREQERR