From 70995430ac252331f061f518e17b347c79704902 Mon Sep 17 00:00:00 2001 From: Matt Jenkins Date: Tue, 12 May 2026 14:27:05 +0100 Subject: [PATCH] Original import of base code --- README.md | 9 + bbc/basic.rom | Bin 0 -> 12824 bytes bin/ansi | Bin 0 -> 616 bytes bin/basic | 1 + bin/bbcbasic | Bin 0 -> 15384 bytes bsd/ansi | Bin 0 -> 698 bytes bsd/basic | 1 + bsd/bbcbasic | Bin 0 -> 15032 bytes demos/8queens | Bin 0 -> 1841 bytes demos/clocksp | Bin 0 -> 2005 bytes demos/colourgrid | Bin 0 -> 339 bytes demos/colours | Bin 0 -> 1991 bytes demos/kbdtest | Bin 0 -> 3182 bytes demos/mathspeed | Bin 0 -> 2544 bytes demos/neobbc | Bin 0 -> 3776 bytes demos/tinypdp | Bin 0 -> 2574 bytes docs/bbcbasic.txt | 1200 +++++++++++++++++++++++++ docs/keymap | 51 ++ docs/read.me | 32 + docs/read2.me | 187 ++++ rt11/basic.sav | Bin 0 -> 16370 bytes src/!MkAnsi | 8 + src/!MkAnsi.bat | 3 + src/!MkAnsiBSD.bat | 3 + src/!MkBSD.bat | 6 + src/!MkRT11 | 8 + src/!MkRT11.bat | 6 + src/!MkTube | 8 + src/!MkTube.bat | 7 + src/!MkUnix | 8 + src/!MkUnix.bat | 6 + src/AnsiKBD | 221 +++++ src/Assembler | 69 ++ src/Commands | 1967 +++++++++++++++++++++++++++++++++++++++++ src/CommonIO | 424 +++++++++ src/Debug | 306 +++++++ src/Errors | 68 ++ src/Evaluate | 869 +++++++++++++++++++ src/Execute | 305 +++++++ src/Functions | 2068 ++++++++++++++++++++++++++++++++++++++++++++ src/GeneralIO | 81 ++ src/Interface | 873 +++++++++++++++++++ src/MakeMain | 27 + src/MakeRT11 | 15 + src/MakeTube | 10 + src/MakeUnix | 18 + src/ROMHdr | 61 ++ src/RT11Hdr | 76 ++ src/RT11IO | 1564 +++++++++++++++++++++++++++++++++ src/Stack | 254 ++++++ src/Startup | 322 +++++++ src/SysVars | 112 +++ src/TokenEqus | 148 ++++ src/Tokens | 626 ++++++++++++++ src/TrigLog | 46 + src/TubeIO | 154 ++++ src/UnixIO | 2002 ++++++++++++++++++++++++++++++++++++++++++ src/Variables | 743 ++++++++++++++++ src/Version | 150 ++++ src/ansi.mac | 505 +++++++++++ 60 files changed, 15628 insertions(+) create mode 100644 bbc/basic.rom create mode 100644 bin/ansi create mode 100644 bin/basic create mode 100644 bin/bbcbasic create mode 100644 bsd/ansi create mode 100644 bsd/basic create mode 100644 bsd/bbcbasic create mode 100644 demos/8queens create mode 100644 demos/clocksp create mode 100644 demos/colourgrid create mode 100644 demos/colours create mode 100644 demos/kbdtest create mode 100644 demos/mathspeed create mode 100644 demos/neobbc create mode 100644 demos/tinypdp create mode 100644 docs/bbcbasic.txt create mode 100644 docs/keymap create mode 100644 docs/read.me create mode 100644 docs/read2.me create mode 100644 rt11/basic.sav create mode 100644 src/!MkAnsi create mode 100644 src/!MkAnsi.bat create mode 100644 src/!MkAnsiBSD.bat create mode 100644 src/!MkBSD.bat create mode 100644 src/!MkRT11 create mode 100644 src/!MkRT11.bat create mode 100644 src/!MkTube create mode 100644 src/!MkTube.bat create mode 100644 src/!MkUnix create mode 100644 src/!MkUnix.bat create mode 100644 src/AnsiKBD create mode 100644 src/Assembler create mode 100644 src/Commands create mode 100644 src/CommonIO create mode 100644 src/Debug create mode 100644 src/Errors create mode 100644 src/Evaluate create mode 100644 src/Execute create mode 100644 src/Functions create mode 100644 src/GeneralIO create mode 100644 src/Interface create mode 100644 src/MakeMain create mode 100644 src/MakeRT11 create mode 100644 src/MakeTube create mode 100644 src/MakeUnix create mode 100644 src/ROMHdr create mode 100644 src/RT11Hdr create mode 100644 src/RT11IO create mode 100644 src/Stack create mode 100644 src/Startup create mode 100644 src/SysVars create mode 100644 src/TokenEqus create mode 100644 src/Tokens create mode 100644 src/TrigLog create mode 100644 src/TubeIO create mode 100644 src/UnixIO create mode 100644 src/Variables create mode 100644 src/Version create mode 100644 src/ansi.mac diff --git a/README.md b/README.md index a3cfab4..1a175dd 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,11 @@ # pdp11-bbcbasic BBC Basic for the PDP-11 + +This is a fork of the excellent BBC Basic interpreter for +PDP-11 by J. G. Harston. All credit for this work must +go to them. This is merely a few bugfixes and improvements. + +Original code and information can be found here: +https://mdfs.net/Software/PDP11/BBCBasic/ + + diff --git a/bbc/basic.rom b/bbc/basic.rom new file mode 100644 index 0000000000000000000000000000000000000000..a7a6723727be1e3f735f9ffe7d44e32743f6c693 GIT binary patch literal 12824 zcmZ8{4SZD9weLQA&rD{{OpY$fj?@T^sQb1o+BGgJd0`kjS3MFA%>74BxK%yoq@K$ zm;BD2bI#spf2_Se{%fuMEs51s1izSJsjsTP;Rd~;ys^5HmCn8KX1%!d2K|m@tMqxL z^A^lx#g#Mfn7e51;$>?eT(^1^V|y5zD>23%k{0im25;D}4zAcgV{rL?+n{g1Q&jS58i#Z$-Rva{Ptgp`t%<`0;4&j@*9?Shs)C zp#AE|2fCH7b`8I>nV0^5EyU){eDn9snXxSC<5I@F0t?5V#8Qr&(lX_v`2pql{Dn$N zlO1Q~8LH8`l9ee(=Np>DVrs1QXlcr^uCz=(FuzQG57*xLsZH_u&QMZKwi>1Go!QJG zQhy1uSLO#;fj#BeI5)r){IaYon^IAk*%-ZgslK#z?Sm^XabeU3$(QlcbavUt$=PAMcjkvs+=WQ(MnKr*b zc-7eUnWZs5OINidi&*+pq)e6PcWPxSn;+AxSnr-ZL(}p5`nPFiywtCx952~Y4wvN` zZdJWItW6pjlq{dD%Dfac7^Qyur$FFRxcD25C_3EE6W>q`!^)qu~ zEwNS~3w=6>`ZukUc$-r3j9_uhqN0UMk8gQ=OK^+YalgoN8(xIgsw`IAbCG1&d=UuWF^~09WBSP)eUS$zhURxF9-1utLHRJV^;Eb=!!Eh_4lH2o#3vaY6XNyC_} zvb?6|sI78wd3EiF_-QD7hga74%Nsrtl{IyZ{=a5b)-3uM_l9k|2?m&UK&Di=W$zALwWOm+x)dv^$m5Ep9l)hew&B;pe^>pp+<#Zo z4zaMV;d9%OEUc9ln3U zT~h}town8Z7d90Z8@$F}`vQulFIi39qW|DEwJ-8JtE&o&WBks#D*snDlpVNT>OW(v z#iYMR*?d6M)-}Dv>uRe0AnIz*+UgcAjPSaKP7X5ER@Xje{?;vNdd0k1QvWiqYpkrP zPTT4mFvo9f_2rBFJ?{FZhX3uZul~QHzNW5e&{kiEy5c>YNIT@MuWNi&V4;V2gTHA> zL+wS;;IH?WH(kJUeO*J-2%gKU&f6ONcMexHEU6t84dqp@p|Y{5uEC$mX{cVb80(Ak zhT5v%pl$7vJ1hJR2YF+YzrLF{mM``H(bl-A_I2J^UHhNB@dpiid1HO$&r#n{n4q${ zc2Qw*k~e}wsy?ux*ZNDMsl4_L-n7_XyV>4U_a<*DuPENgn;Ob1{o^@J*qz7SO$|%@ zzZGDr>YB^8C5;Vl@ugKu&e^~c|HYSLO>c|l>Z+#26DA1`bCBRqoW6V?dxYIN!p%+o zGrx1?gAcA;b)WtyG@@6HYn-W4%5gyA&>aWnl8!r8Vr)M=*CLvq)7fRw2T9_xuh*?R z*f^fzHx07MJbsg%36XNV!iFMly__j1?_$}|2!kws6K7T)yGdadVL(&F{XSNqbjbxh z$3kvhXSWDBe6TmoPV{C&iaRy&Y1~skH^SWdG$wewHOStR;x`$rkGu6-SWLL}S5S%MwsV>?zGK zd|b@K0k)@jU#pFsm4aHzQ&4hENtvvalqq>7Wly+EG+}5z0~KB>F5BoV>GMp?c8PtS z)3ckOI}P6JllOW0XM5#0)Q@J*m-cx+n4NMorBj>wXS+g4&!O3{?T!U$ec3wwft9OT z$#&lFOgYvU8{6NRP1GQM+UCVfHoY?25-O9Qo*iH<7Xz%MIORADj!!wxW~UqjMJdOm z>&xW!*?pcB7@-1m-ps~OYeSD`W{gP2$$japh~Xl;Jj|q)@_Vb9q!`+F8SQXD3hnwv z1ZB5g#V+wa*l9b53`U9C?&vLS6lFG>Wxh+ZH$_=b?(9IXJiAMdd2F*!i=<~_mNa!B zVrW0aczb809J^#g`w{M6oRL8UJ7#<+`M@9TGn${HJrzjsnwS`Yy_vXY$Q*4FD^dovp`kwR=>0`Zn zLe4r`bV@vLf52Wc_06oHJj7nK7EDd*4_Q9S+CBAve%yZ6`afA|+G6dze4BNzebvN1 zK5HrycIyydKD~e`=@)H2=L-JfR9Cv#UTA-4ddl(kWeZf|x@G^Xl`RkS{w~(H@At>B zOX=IOSJBH#- zmy#UomuJ=ebe+DsO+UuGN}Hmf?cEb8$MPxk>yCbp{hB9kV!ju-S0x;D!WqmDuGd0A zO$&uIw{B$|t2iR7j~lW>WKdOtz2D>3EllD+?}@MgTjLb<%v=_zG%v0dHMBUrn(r-x&GO*1o?7ecQEOGSd)On|zM9+q2 zUNKuXITCAS(xgaeYC**C=*5yEEej~u6k8M_b2+G)S|^=yEWS*%`|}mrofvZ-*B@N7 z?8mK)4Jck<-2zxL;_?Ad63Eq&aGv2p4QcN~N4INS#MhjNH18~7XF;OC?ZMEISktEq`DC3`G|D<;XkOp9jX|ie=07;|wd@J8qoZ zk(MwcFGgJGfNrpp1xh-|>saeG`VFkITRZA>3a=8x%7svR6QG@aV^9mQX=5xez>a`R zCylX7)Z-aD(WOi+m_ZagZazuq@s8n8ewk{YVZ%D#P$#_As6A>gd)#KWn>%iS{6<)o z=)~_?>W5XY>UBSxW+%a2zTPhETH3T3minarx5$8!@j_tPQ@hd{N3lO*{o{Jv{VISx(h&_2NZBa^|~>07Vxw(D~9&NtcZK=vue2K(L~ z$=uZ>d^X~O=AGTJ{Z!Xt->uMoqn}HC@__a^3wadwkgBjZ)PW+R%Yjk7cJ(@aeXwAvagR$tz5Qh#yb5c%hvsPh5k9ci;hmCz5HB%XxZA8%kF)k74J5W7C!nW z5FYKNd_m~OD0D}=fD-=fbVrW?-4Hj;2ECJ>ZG}X0uLvkl z7e+8w&hka@WeZbyNNWdQZ_0m6c|%==e({{YHM$GF^VaB)Nui31F4~9FMCr|=G|pY- zIF2jhSh0>ixe8XlP&$-Hw%4odMsGTLGqhdMoQ5_8z1Y077#y8)oSsCw^l+9XpEPk$ z9q^1y_d+*QeLZ)h1TQI8m1cas+wdHnuBbg)k4CyDI2lO7G2x(D#=*likUNmWYaLprworLPyMJ1j765ZZu%XGsf!UCyyHcddEFz$Krv+F= zs!YCqT9?^!K#-0(Y4&ykIws}lzcAyh{-9~WS;9FJh&p*wFkQrx&RkL6+l*1XqB$zq zbd*3hC`;IRwEBiqKQ`!-KJdyy<_C7iyiLS&3&y@WKSiQmHnCIql4hK8th!KqR$sep z)qSu!h)b}bDSs!>!(wJJV-h~m*;?roXuDzf1I+Q(3o{{!5B?N7hXAK3qbE!mop!;C zniG(mqs}gkG}k>NZhbmih;RF0GgFS*5t8>G_Y0l9L^xfn}AzuPG^Yf9tA{R_dx6GuVYC%emuzew{g$Lk{gdIPE=^0S zhId58SJ1Kwy5w8(63GiMjkJ7gg*CyCzXPO;R-}Lrl6@6 zub*Pb9R4Ot2UzI{B9_2<@)YvRtELFWF1XU!(utl&t}E<`g9fA-0?Y2{C^`E=A`j%$b&%pA;NCp1N@IO=-GE}j zjEA!W?8OTSjp6>af&lx~1;caEbGSDO3`f%TqkobHqE+&|J35n11I3pQUH9lrym<|8 zN}!Km5r?dgmf+3l^z|6|X}td)%f|a#hAfYMkHG_u-U_~_w;bhdChd==$(O&xW{Cl3 z3>eyOQgs81JEw{tf=47de)8AM9)W)gnfg$Nz=;4m{MCSxSi*wOGU2kg%AM_?(^01_ z2;X0d6|rEav%?v>qK$rqzBC@M=RcrWB1fBdrMUKM=nHG;Sytt$bj9US@Fou>{4AK! zU>lexM5|rLCI{(vI8Er*&PiK$S~@hb><<*%_%tEA5knalNqGAmrjB}3It@xL{>Iky z@S0ZrCo3N`(FW;?jYIC}bW`qUeKY6L>4*@}?rg&9JEZ}0v<=c{7>(ZFeLCfsW>T!v zq*yyBMl++j<)A3}m}|s2d^^e1SwYr}UBBZ>%~EjzHKjD>L=BgK;lS$?7B1;7(IrbQ zu_bGm4=WkOH!@ny667Zgf;*;|y}|Nhf99|`s6U8{MzaY*am8l+EZBH=^xLLHhRn7d z%#C)@D{VjKXVCT)vu(zoy@zF?E{JOz`g)5GNmu-zLC2%h%vH(IFVV{x>Ytg2JF`XN za`6~YWizw)UJ%b#iu2`G%0#PEg8Mr1P zlPuAGjtm0f<_Nj@xnlMRX63!SULxzy%{W+Q&c*C?tnwb{e(LQYN-vv=(g$9TX*WPK z6|q7*Kgx0;iTs-tVWL?SZ)US&DCe>j7&*Wgto^t|NZ|NjD&ml0+G^~q=|e~BOiUZo z$}p#%K?VKfoSQ<3bg}=g61}dnNngEIuc)pi{#i3vgou`qlHl0uBiuC>G5mvROFivN z9`^6R1WDK&V0oGWX$o3V%F#CHfNnhvYmU|}mCg}plb%z3SSwMY0AKdN<2-SWzD=3m zQgr6Xxr}XmD@`lOpz^)rgu8bu)Nfo1n)rOTlGOfqFrgi+iEA6s-)C6^h^9O*{R0o% z7`=H45|;To<@n%SZf5SLe+N#LqC?vU^n<7xMI54jpibiD zxmV@^tCIG@1CW^)Z^Q7umS+)1a5aXQ8c8-?omg{a3*ALX69iL^@d4-trCpB0(+c;u zLw6s7F7Yblo#mO{8QJ0uV_vlrx_w09Y`5Z7YVdBwSV)7#S4igr75;l@{pygh$%d%s z!)EMcwkfBr=CdViwEhTGUt{7Zuj1DCF?%=@4|*3dxAJ>~u=%8$t6-bb=};gEX{?FZ!dhA_-Ncw)f&mqHqO z?e7-EoD0Au8%Diy47)st+5un(#E220mPA~ZWa6fB*C82k4-S8U6BV5zwxpCbQ~V6^ zj4W2)GoqEU%nlxMo(w)!1RKK-_m-L(>#hQ!ATDm|qlD8EJlqTEbJ)h>&Ig58@yc8E zAd|xb8q;whKH7oWgO)?`d1e!5;$N=-;0*VmVxZc4o2({v>w74^^hDtS z=Lw#~sLJDr6i=`NPk)zvdchieY8&%ar6Be1U;G`5~8K7B5 zkYEu8_~?%D3Wc|H=pqtVcz;L{x-|@qd!;ARnHlSIeJTk)r9KSczisG$_Xr{LS>x2B zkdw~If@pJNUK{jIFrTzd!xqRkq9u#DA&E3u8vWG zUJEemdoaQR%v?g8XQt^hO7Pjrx+29QeHnr(29*PUPLkU^kE{X$j8Zi13Ew zcFaVuik8lNL)o(H8;n2Bt1#Q>7}-m*A$On3Z(O&Qa!%`3uSUFO)qTv=SEQK?CD`Id zeDO>;0iTSt-92ikMVe|0$6AstQ-49RFd?a?)+Il|J|;|hRkL>Wh%;0`5?!fFk(d&a zxwK`MgA+E-=wHM!1e! z&N^C+O{;*>qa(5}D#OkFVd@W3$fBn`uHpYUI3%Vl+U4Of;KIOOwZr!Vc zTf-UTDM6A_Qp{E5taKWP(^53HC3STa5$6|gS=Ly-gN-F%b4Q4ivG^7mu_-}~d(>t3Gl5rC#3Ht-@8?kM&3lsy1 zDbjk!|ZaNWqlhThZ@4jF2~+5ba;1=hhHSc{ zyL>KtBsfQA)`-m8=h&GPvGMk=?JVdFek~*O*C(ImeaH@mTr{5K>Vt<7)VjbwL=}pB z(XIv99l%a^pUkUT`Or%97|6X3>yNaqT}@-3hgVrY2t?HZdO~LcFZd7-z4Zcz^n@=W zmtwXcdLNm{)IYSIto^kY;#j*RGdY7|$}!soI%p|e5fOd}cH16Fwo0th8TuMKgc;jd zT>g?1Mu5x(w?;!~OM5_X$m2OU{Li~_*ZDTp3i-E>T#eW)G~bX0F_7DO@6!%bR{;f% zbg6x<7R>4X^D!ledB2$I(kc~h#!ITsTfm_l+;u8mjDX7 zot5`iuBRttby-!fWj$i7;CPBqBZ_M3rljX!u19Kqt{(KjSsq)`^KPytB|UHD=Aqo1 zn~U=GT$g$8kdoW~E0?4EO)lwY>54}{8t&d9%aaM`FjkaK3uMdbUF}d(Ifs1gQD^6p zjwLj6y3cvIQ#-UC@w_X~wQ{GwR_^d;R^}SI>a|eJvQQ+j&&KvDS8y}^$F|?<@~vl^ z1Flk6z%|zu*j(aD$mbA+)m;hC^{%*cw&@3Ds0oh%+7;X~MzeWq$WSJQ2$i!Re1Y8% z+&xude}czLnGr}I{HulIur!06vK=`Xn}pK<&Xn?=vrOLS%&aIpNS^%loU4+V^V*Hx z4}1bMrdHz|jL>qe8_w*>!u+8UEo~79jWQX$idG5-lY)yT3o09ZYWmELpbuN?nDpMC^m#H^qlSOr)G-cyEABd}{P=K;)KaeZQ0?QE!E?e_e7A^!J*r?>^hv+M#`jzFf%a7NV~Y zqeW(UJ1k}bXYg=71mjUDnI%Ik2NY@t?`k)KE<-?FF>L{2`tUTQWF#}s3e1z`zbzmq zDhI;iEVv~CI+YAZ zVay;=ie{DB4+;B0y&!txw1)!h^aNo*+7H?doV-xHnimmLD>P&YD@1gQcqVuz;k+J5 zsj{F$7E>p~Gl;K2HdOu^QGtoCDB_<~lCGqS@}v@><(3Z98Z;fxDPOyG*~7$Ji;w3v z{`B4lf4p|(nsxN-ov0DC<7Z$mydf^LUcx2`SrbyP>9a9kz0}LidqRyQ+A zIDK;5D)#1cmV@VaPaE1~)P82|fb8NtjFq%J2QETetAQThLk{)h(>VL$NNAH-jzs$X z0D75sTnOr6!|4vq(DKm7ugq_^St$nf1ispJI-#j}Z$EzC^kEuKOR#2ywh-g|BnNsO zS&-8-tDDhBy9T|$4mo)+rd`8=8fAo_o0sIHhqX9Og|=401UFj`N=!BIb}q(v>61KQ zv0E^oZps{eLJ@kzr;!!-8gk&k$&n3^ABz9cd0fLkk+vY`<%V=zkM>RJn3e^X4ePfM z(x?47`z6i?nf}s_FOenqa(Dg$6~3Wrpf?~A%Tq<2+Rak)>wr@aPt-i8R58g`!`3 zEKZVZ>($O%|}EGm)LK zl{YiXmv zQtptxqw~<4#rGwg8G@A=5DuIWqAd1$L2ExML_UYExQ1P&!QEd{PlU)DkO7VrNvzWu z!3-<#p6twj;C|>7@zPvmN)9m~uak6c1#t_sAYQE%zmyoXr{Nzrx!wL{FyE^NT^y0k zyi*iAqcydow*o=YJw!yn2gr7vl8^-sAX|v&;3?w2-CrO|d&(99Uw#qNXw1{lNmsK& z$05UG*y{y&Yv$PE(_vtu)iC@(?`-VPrJ2wM>Z=LWoj60t!Csd zXaTC?hUaINnCD(=45wJUrVibaCR{Y&skQo+**BKS4OU-1GD%Y{6qCk@xbbkRRc5zZ z|G0@{rR8YCdC5FAjVvqT8-&j3B=!eKy0jQF(q95)()<0rY2cwt7N0_=^jzjCy#k!l zD}RD?Xfyl*L{C}fS8`#i5%x)A?P zBYI5~`|Pjo=rD7DrXS(%Hq%N}sa={?qEk!b1JE!Zr?Ac~BIS9+@&xvuC^t(AD4jSP z&?!fL6m(h8hm%>lE!}Zg+T+Z(CGX1Vb&`?nZbO?$BhQ4on8@iiOljHtA(wNyQ^4oX zW38Q7>unf~qC5+jfhgfN;X_mcCx{4LZR!%^K}gMqs{g?sFI$7uFz^G(ZFV=%akod3 zy04RX_hdA%3}p;`iWt@BM!7&+nb4BHzL}Odml63<3-- zXfa{VmuECB&6_x;G`~nNC;()%#&NXDCKpO2Ecu1f3tZQvMbNV@ALVe1-|sE*AC{5M z(xl=M#hXYbHFx2L2}#r4Kc)%(SRnbO#psz+iytQFgx|?m(=M?FAD#Wrl(xD!%&;d) z*Mz$~;|8Sn^xz6}h8Ac3YUa~?6H{H+SchwL)f}Sd6kE$m*^att3B!I}UG!AN=B!q* zp=N#T-$bw{e>CxTw`a&!^8_(wNDT|2pY^1cD=v~AIBJVRq6;Ly3Y_W|4kR{q-Ea&h zH~g)bF=A_tvz^u3U~Oo*by+QCQAI`bSyZjd=o4f$mu2Ppu)hMi`C+^ePSw6usw*=j zeV4;)%xM#5XqCmJrma-fm`0uXmzh2U57@^m93<=b-`-$=Lwq~Iyr1648?4egz9il= zuj>sw#d*?`M;MKav$;~vZfw||ecx^@-?JN{Z8sjZw#5xmxuY_t>Qo%pSrJazsi;qg LwjR{@JY4Y);p?#{ literal 0 HcmV?d00001 diff --git a/bin/basic b/bin/basic new file mode 100644 index 0000000..6e6ff54 --- /dev/null +++ b/bin/basic @@ -0,0 +1 @@ +bbcbasic gU2EM0NR$?V4d|fD z+L=6NNP=wCL|9ka2*}^{ul}`FaQ(a8JC9JLG)1&%Eu~Q*A|j6vGLVGK{=Pe4SDbSn z=iKx7&iD9z-*;jaY>ODXCNkqcfhFt>_ju$_7yIQ?iZ&uXt5NGtL$Fa-ZW+x6MqV@w-@_ahAm-VGRx1>aUHdk6_wq6 zw^mS4s1@X|SYD_tU#YFEt>3hE!+I@u*4zc!w955sx7?XFt?*8*aKpwY>eoK}$Y$-n zSxaXvtEu0#8LjUA{(|q%oRd3eej3x=^A{ge(~=%J7c*G6IAMQ&>LK?G+|R`?2Q$rM zarflKSz?Y7*?s4th>stfryOmYGL{pb|O5gvht=B=D5&PbGab)#1Ui&gt%*h5EAs+!wECc2k~evmpxxj>DPiZVRfsd?8Tx(L?(MwQOBi!Yw`5gp*r2Ui z`!Hj1Rbrx&u&=ach<%uo#e6Z`s3z=lt*)*a>?LO7%~B5PFPOdzi%OIF77MfdlA-|5 zFIdsR^9xsW^8BKe`Nhxk{1t^eQIzcB`4uJq#`7yHN)PdZrM`+6#DcQQia%KkON&b@ z%ZDw6`NhR2EQQPRmzR8kOL_Kx@xo$Xe)*?jVR7jS-=D38#Y;cK{ffVcg{3S0ofno? zmQ=im`{Gi3U6fyuf3l#+w{$lz@-6u*ieg`d?{~at`N|-Q`%hVl%JZxKX7QC2m6ewk zelFss7sX0nacPE zcmH#)wa7+UO};78m_qEG@ZUDP6K8%uCCgILJ`4ykv)QEv>A0!?>v| zd!3iAC@fx{w3L-&j+ZTE`AdE6uCj{qe|42D|9@gxacRXROIa!EroG9DwEa0{r7PYN zvCtk~?yIOQFS#a``^tRz6<6_GR$5*$i0AyGE0%KK{R0K%l_l53^8BJ-qjE(>X}K?v zUcP+kGORDk%S(!WgSI7=_ZRrekMb22zOrq6MgB_PA1o`Dmb}eZEH8P7ulP~<0luQF zum$zy*)b}Ymn_Ym7UwI#Aw?fs&}-R{Sdm|HkXJ18m29_Fl)lR=@(ZT5@{02OLf=Sw z1$O5dS4DZH?>|K_)$-ySmdX|7@9~vIl@~2wiT}@6VomRhRm+PimO&AL1jjf?@JCKx zeuzE7?i}aFCV#~5U%P43+Vu}>PeUW-C{dL&SxDI90*B@}x)53}Pv8CVLX%kavc_(R z-H;*g+P zA&ZDEZ921HM9$vlQPs=-Q;1e_w9cW{s?6R(YmGV4LdF|?s+ZZYo}Y;?hq|S>B;tO0 z_OC)wUoLx5Af0fE2^e*9xIq56^Jx}k+{v9$-yf4+S@$hY@-lkX)hx!h=&HyfOcV;_ zs83HuE4{3vJ;HP;fpKk&bjnNk#nd4oU-3TY=*q-gXECSPDCy7M2sBDQxl#Jz-u{sH zxu6_o-ICrh8i+g_X3bKg^!v8Hz?F9dCa^1__c@~BMbPjk?0l%A!v}2`m)LXNQcyNV zXsh9R+dl^CRm?(GnR3HvK-SO}`5CFk&jeLGJJ*I}hRBj$Ju zdqH-Ahfg>#vg&;<%p&ej7kFP3n5!$vWU=5y&UB{xl7*}9O2#9DL?VG`ZQp6{)rDP>?Bks_GpychC06y_1 zhp`U}b2-W-xh^e@rGr))OA8-teRx5lZPfysn0Woc1wUC}!u-eOdRl+9Ak6yIB>l8H zIjAsLhw9lps_3q0~|3p~$$Z-FZ6>QkV?+p|2anG3qz zmIY4nkh|Yg_3}CJUAJ_|eb$pB9aMTf_XvmFCq0;FGSPO{;|#{#Cp@t1_W4PzX0x_# z?fP1>nGZP<_SV_@?rslJgLr9W4rbDJz+(z}q&*%#d*qs*JvlRBKMHP7*iWXxx=u~l z&$>NQtEbz&5hLV*&fD2AYAxuoYtEpcpE;DYgmq^`eabFW=dW7M1X)*qz@loV6x?@3 z3`j1mhz;>>SZ5oD>~#^PU0n;=b(Cpry74Z_-V;6T6FmOTv7Tlr;?D4#6XR~lBTVWG z>*`N1*2!70{*tc#6!*twrBJ}(S)T}A@Wwz+)yuS>qR4 zktA}IY1nCMmCMG5g)Xs?cHY~Wu;0d%knYnUmHEsW)~7CE_OO1&nrf}(GLCoO$5X4g zODxIWBWj85iLI=7>K69K6iqxo`QwSx#LuSoPWjn{_ebBDcy!8Z+8(Vs`B3t>@T#_b z)MVW?wNLD_t+9=0Z(6rV{cOMawAP_*HXXA*KIsMRgzc>PL6)23=503?ncuM0kH-0s zHp(sLOMLp2EG8%SS>`w%;ZII-CNw@zfw1^8Isd9O1S0s;82p` z>>JZdAKR>LsMAie9Jx*={rtda!oFZ4U0q%GvS0DoJm!6s=O~1JPB;RYfh}qe9@NV-;~pc}AD)VhT&e*oW;d&BO%W(jI1hw#p%vMP)$=s5^6+n8OLZnKJlmA{!st zFGp)_Y^R3CVXOd1^NqQp(pY^+<6%ELcePQ9LCO>IuDLel&32JBsBgA&tgoUYD&62= zwlg=0r!qVZK{qo&6c0n!hncOFR=0ja)$7URG?okOO0yp)HAwi=x~a1LbV30oBi@4YLeC%egaQ zpE%5hsJ~ttQN^Q7zK7^{+;|eu-^zhtrbiijj|Hnds5tLgj@lzO&ofy@yW9~Iq&Lj0 zViT?xup`8Iui8Ay**VnDdjlS&cTS@Ho7o9_V3MEx@(TD8Uw?|)s=cM~nM_hlO@hMD z4+ucf;Jrx+d-S>ww!Em*^-_|Z0dILbo3Up}!&;ci;@V%reR9h0$hL@t8^HO{^<7V6 z9NHnUOv824r4!P&`0H#s}~M%CVT*~TeA2bF=li7v;kYb6^tYirkQ zHQJZjx(ypP5@p}JKB=%~{T-XNM{72(enk6{-tE6WnRfC^?eUuWwKc2O)#BZ=*R!8~ z7gF=?gq^Q*_9gp-H=+N=-RY=1K4gb2Bkho|PaFTOIDeANj>C$L-nQRuVX2>!>FPGL zU8T^x0>*bMN8&7odZ+OV?#^W7#ns7r=RdPShm-Mu-uVQ+$x-5EqS)-tfCL@L%wUIV zGq9@L?@rWmHtufl{}A#2Z*KDcvFkt$nI%e}dKIm%hn_%Dj%awv)hE;q33de8it_1)WOBBu4bTvj~uS9lfX2@OLu|VarY~^MDfX@ zUw$<=jG1zlDF$9QF_{O|25@y-<_`Iw@)UZ-bLP&jeejrfcJ&+dx$l~jcHtb+x&8XB zQS3KIF=GwgQW0!@w$PKIgBm&Ve)Kg5ed+2x=uBPhheoX0I}O|n4L6pw=wYiVlXP%E z>2uq1bD))}zKpw2f{$dgLi4>gR(GGBEi3J6yGmMT<#^x+d%vCL7zO_d!3Ybk(B1Lb z=~;EMkd>2FrQ#aB4&Wi_?irHqx&rT%B!?grxZj+@( zHL9`z>Bs#*2K$&vICRDW8uT-G=g`eLvNtQeYceG2OLiN|t8Bcu^W}X&W(j-WVA^+_ z-VZvT7_@%(T=&@e)teEKU@TIb&OUUU6n>cH&6*BQpjY)k}2D^e*mpS!gfhOq&rz~MUpmoA+)c-<^eQSQQK)tlFv-px`oUlK6b=n23zGnTy zur`RPuz(?Xr_sYQW-=lW3&p0|LWhX9+XgIPlf6t)E4eg<0!o*g7fUybK4#EC%>ST||N1Y$9nh*@RBZmYoZ*ef8= zY%0IVW=a(PNW&j#um8H9b4#I4;H{_HWk(eRuC&V?^5L$nFnk zkT$Z3Lhp@G3ON=H1f>xk+5P@qRD(HPmAI$%KV~HCk7SdVBB0kpSAU8%*4r+Ho54jh z*a>LHA7FSz24PUF44Pp6RT|TY(N+n~lD<1_hM)+&dF+lr~5BlE+ z`-IgF(0=?oo;kaQ-eD&)f^H74x=+3>n6N)JCCAtivYqu)Ozm;>_OmIbvZyr3Ps|G# z8u5WCy2RmMvZS9a7(~xgz=2aJ)+ow0k;_fhP3U*-lC_q}l&t&jH2$qyayl((| zJvxjv-Z#(%n#^DWD1X2%qnr%i57rekKQMX@C1+m=6a$3*?}wgHU|I0gCz~+WlWDMS zS7R!}eS4Oly>?Z1XG}lV*#*=_a`4mtB?kt*ueiGIWRpSb$NMKdeJ56?FeR8al1zuvJ)8x!|G=N4Y9F_n$Ux-X) zfhI?zBY0B}{StktJX*$oL@`5-Hoq03>aU zq>ED3%hTACn9=kbTLiNB+=zCi<~xlYzzQFN#;3k|Q0A~nD81nGh@1?i>#5zDr3{8SP01_O54? zq-!RyJI#PJ1g!{h{Y!Re)N`=mXkA_C7=#vi?QA#JN|eaLmmTmg2QSjM3FBLe!<@dD zvWV{`X(cHX{@w`T?ENzJ8%5qE^%PhCa5SbKEsm;N(O-|X4{?(&;qUm@!syKoNLQ*o zw9mycsks~8T*Cf>m9j916j@;R(C#CFqC5>i6OHO2ARa`|D8A6;1I{Eqo^x{^uqDYH zAbyGE;O$2ET4h$^2ChU9J0q#4UlZ0`SWS0f(gFc^onJvO$PH2yo>i!~0UEmpdL&0C zZ!E*`#>fH(hI5oAX!Jpuv;A_8T#R??hJz~XyiA%NNbncIEk6(HZ5G5fpD-dNcNsET zV?3KedhJg^^^FF4%8^~#A!ZFx zlQduy+9A5`RS(IHG9)00Rmh^Dy~%P|#E%WnJLQ)Wmxn>QMtnhSW3^^n1$LA5J{d5{S;Km!UJ6yTyOi^mYl#GbCp@U)$Q{Y%9B+fo|IO^CW=EynHPA$NsP@l>){1E+YL~Y#EBV7@8 zYK<&CY}h_c3im*dn zSvz>_5@dU%N1`>RzCIVwC0!DBRUsaZOadZ+*MUEup9(EFYHN+EN8EzcID<1wSU@(Q zX)?#v5^DOQ(b0IGBZ_=kh=5{;+sp=K%i1Y^^lbJK$7vqNnDR4z_Vy?{^1=_;=U2^v z=XWu0!5G#R5}14kgRW+54RRZjk@3yJ?&e)1lqZbrxm3S?g0sEOgI z%zJ~fsF_31u{V1nEt#@6xrsP9l=?UhocAhb^6nrZ@VO(@qbS84<3zN*w+?zHkV)F5 zyaN)AXvk8oOV{D24DjctTA=BB5}s$~-yTC0gk=3z|35~LIhgTg^j?fv3y9*}Y4}Al z-fkSEHNS$pg28lnwlRlG9K?Lcdyl|MAp21rn8^{n4N474v{qyV)lHeY+_CR6Mjzot znCYv-WF5(3G@Q*`vALeINSl$8UAJNV!_3f7q>XerQ0+qO@O+4Jy@WS|)xso8C{i7- zp7d`N=Mn|Q(6HnQj2jjWN-bv%%5g_9i=?PU%`iD5XNpEK>Z3 zhvJA$k>8UwTnFpw6rzq(LBu!`QOA2hC#Sdspd2C+TMf<=}4#BK!bs+z?wrr zIZ`J4=v&e7>9_2hX<;lNIH4~B(Cdr6Wr!NULph*PKECg;e!6(Lk$+9D#OG*x8l9$Qhz!SRe%+ z*j6JyM_N&WPW)%Y=INb96a{@AC<%K*W5^=e0*Y}&WMK>GjY0fu(3nxjID?)p-dNUD z<`7{we`-O-jVV%a{zenC28(1-4#G}b7?+5~yWo{{T}LKrU;q?qzaDj55*r@nEPCb_ zsC_-ASxI^vVyLj1XjxcI6zq}uIXDU0=Y(S}Bw+5q zBJ`Vw5vC8s#D;Itb8QekFEV=WR;R%J>%b@$A*HXQPOsAz4$PF8IV|ypnKmYbExh4d z8w)rB-%7~kbxY@XH}ZW!CyggKyWvR$)MoGxQHA1Kv}=e!04Ft_$tYU;_*&y=$Eqi^ zCu{3BVC;%3@Egl60X;QB=RsEj8+Z}xL|z%P^DOkq9HRx%`}k<8{_!nj-RE45V(o&& zq!ePw$86_oprz;xi=oG1t8L+Ut-uN$!Edocn6ZULrLQ?*0!Un7XIBtyX%FZPc{Zm9 z{`YQdyi%u_A^j5vZ^dLDGTxB(fE;|@Xy_>Tk%P@jcdZFCYPu4U1DN%@iDtD>=0-f^ zp(`fvCkJo+4Ec?J!g&~h)nP9l>?hrY$RM6G@%&06h4BU@3I4%;*vDHxc-l7x3|yC* zT}mF=733I_4N_BYql11aRG$bm$sWPmsXKM22+XsX<#!ftp(kW%Sy88H3!bgY!`t6)6f|1MGkKX&ggmn=bkXxY`2Kf>*5J^B3&^Y;{ zA%7fDSv9M+RMRY$T&@FGNqB3L!6l%R?%p%rHAzo8LpYb@eqnqRzZiaT{JQa@uWmE) z%sdpW#3>^}&;~a4mQjv8;{GkZ`R({-xe5XyhN3K37G?1>JxNndOpQ*BR~JJDt1}3j zZqG#48Jd4op)w<*K+adv1V78lqS_Y~Di5Qi>mlQ5Gx92N#9HIVQ-)EtVpK1_KW&ez zdp?V)W0ptNAihc1W&9Qx)F!{T19!p99(7i2pZZa6pV|x!?q{!DOt`m?-!nd#dC0wE zJY``*&APOpN)^G>u_>wA=IXBN=otGrMtki8vIA)IH7upk=M)ktXXx+COHeW zS?#cqd^iN8=#93e1!GQES2iMRG1X-FyjF@5cTIzQ(-{jJJX?A)!86Nhhvo2QwPv+a z&Pq@eLNH!4rz@UCMe@tl<3RK0D5EfmErz~a%od^C%D#^>8+k$Uud~C5I^jITKZL6G zPGu{3)$0PA#>x@5ApV2q$}?5dY-r?3$hcB3V~k!bJl}};FZ|rZDU$1FGrrI}w<0D> zlzv383e;CN>|V1J0QGZ>)=yq&s%=z1L0?YfX|vJSCtXvGaxpAr3@7R6qz7e52zOD* z5UWAi0IpT%f-3#MS`l?VV)a1mLOe{fJcn7b%>NQ09|{Mm;w;dS*>ywIpar;iqkwA<%l zCvt*ZVx5FYVv;HforZVDyk$ZsH|_~3l5}(UAtHP;{v5q21pkruUiES|%Yh~=8rwwP zN&~!ISjXr*#*t%D(-`g$g%fwDJX}-eOTZ|ICM%8P)d-f5ci#}`n|ccbjymYIzutCB zF22j`5!X`wB%8TVPGwmrbD0v>U;aLG!ZXNc4%|Ng{O9WWM_>p2C#BMbD$x}a+;1FZ^v1Zk#nBbrD{wa%hCnX>*vwSs#Bs!J^b=qBgW4_9|KPM z_JWf^x1Dt&E`2VhD%AI>D~8Xq`J4bNMi>iypGt>5NA&O<&FTU4(V#*nupS2wMAUIC zpi-s>I=M0vJ=Eh=6!eiZfO3cPsK68*Z<{d2$-ia*fjx-%Y=fSH zufP{nbo7Rpvg7%wP3kn2p%qCt4C`)2PKQ z|ESe*%VTnW=j8$MgJ-TH8$jqWi^UzWw3KyRz)a5|BLWLc`}rVIP>H5aNMW}sq$1gc z+Ae%`DoMH?nn-rw4PtC())={vTqz(^O@@P{Aa!biGV9q!EZq4uqE^s7v_8UsO%kE! zRAl$aS;QbfgI!<8p(BpA3urS298ryocQ#f@xj_1kPBRxv%LSbN!8+|Y=|lPGg+`oH z%;eAz<8Y=Z<$Z>}rd|kr@3Nbu$W(zfIa)Bg^>`0FA-zsJ^EGkMXOOTS2Ap+U9tLu9;(LY|=&RT% z_O;>veub#^*OnkO4Zfo>7fOH6^~}PWhq1#O|3ch!3OuAEKH+C$!M_ywTlE+6y1w{| zzGJqky}OXB#9PoT4<~r0q2;mTe%XT6Hej`{+WhheI4{XO(xB{7&f|2#g*-pI;E1@7 z)5?<(_YtLPPa5-z9;F8@&Cur;^5982a4uSoxL-rYl?ge9*4&>Y1k~r=rFd&>tsca- zyqU-eO)^oG8RywXLWx?5g_J+Ek#xLrBIXz}PCFxCiU5QGzIAfQEGj{pUlGdyO{zrVI`Vw|%*QXR1-dMlk;rg0K(-_v;`=MWU z0?8o%^O=j+Dc$Z7#QCdUP9h>r)Y3k4bqz2(=s6a5d4^pmQkqq>KR5k(M$9U zdQtw~iY-Ibr736l*VdOwBex1xL?2h_ixTcZ{)PYa-%Q`I37HH`z{MExf zM*jHCq(^x(Eg`>==22e5_0=@0n~J)KI+9nl_b#RYcYyPu{-BTvo*1xs2gypHgLJJ9oDl{e^~nXOKau2^(RTBEP$iAchK-Qe43sKa zd+m3Kf4Q_@Ao}4#Y&;Dmq7dPo+9h@-q_iX2V}IVOorll1^UYf;CiknMn(Ea8(z zx!D{67sL>w_&w(OfZ5*8aDpRs9`{MRt7`(#8qJGr;RH|_vS=Sd9}gLI*Iq%O(g#LPy?8Sxm#Kj0u zO#X}ia*ub5K~4B+v=;Wqo`7z2%oxIZH3 zKn1*N&rINv@{Up7->I==@`7*#nidg%RcX21h8UmVm&e&yOZKAc;XvjR_y$a3EsN&r zIB~GB#XC2FILI*vaspo1535HWw1(LoEy<**#nbwgHKAs<9JMl>Jzy=id3S_#$5eP% zf@E&#_yJ?H!V#6Su96jq4!=hiCg-2a~iG+amw=>5hbZu5~W{ ziYM2qSK|DKZ$UEgj+13LtcW4v8I(oL(Vc-+I5Fq%;j1vC9y8D*V-L9=^~OBUVfnV3HBoQ3E`Tk?Wxz%z-jUf0 z66JX3T9846U3(f)Tp*PR9{JZ6LOQhe{Yjt&-0P|X{p^CSm~*_J4BMl%k8Y@cLaSN5 zx^@$tnS$Mi210$t@hepC-%!8iyIN2VcqB*8ZlTp?OE>}Ko^P3DxkW3`KZ(;>EhKLi zvtOQWNvO`2$;KK~oN4*ZLO*-|LqX;(V}$RAb7X5vx`uqWmP`)e3<1uAj6!M<)uita zo2vHAg2Y7Bruq1rC&U2P0gqF5C^)}QeQJI}b+jBdC)CI1$ISF^n8d>iB2yzs=3dkO*tLqEKQH-pgi;G(3H>$`8W>%PlL<}~rF7Vt0Pg?jBfXjg^P z{&eQ)7wm7`&(;k4S-XkOmla}1G+4PtV^jfc=#;%aB*I3KEhJQjT?37ETbeipE7R4S zMW!sCL1-{~Mgr=AO%l>tiXcOT#~Z$Yh53S_xWP;g^hSS$R{v4Z$mNnX1x4E)vt?lZ zr-l-3Kewd?b!bPIHi01;&J*t_Y^Cj9gL_JCZvo>R9%496l!g;pDUL9KGYD-^jzbXY zAiJLSa+6m!wai!~Fgh6wZ6yhUSN2E?O?9$pyw@G+_+MBMmOP`8B;|be@q}t_Ie{~fAB!IOI8cBE zZ)`0%_op5ZqN1_?*b^O|C;gR$Bt{$#t~+e_TM64X4(=O=9mzI&c4<~nun+sN--uA; zTyFp}lUW0D8&2HQ`8%4yPT2HC;=<5Q%*rE9#Fh4HT!=IZRtpP6do<1tLdLag4VVF0-0W+_leb^nIaS1N5~fFFJCkY#kmIski}VH@(K8gM zK9A>KBma`35!Tcqgc_uS@wI`4pSKAD<1~Pg#7*U8lA5AU;aCS>L^tP2hF1r?rkH z-mxL*XBJ7n|Dx{pMNZhX`JqHQj60{ZUR KnA>#JF!nz+bg(f1 literal 0 HcmV?d00001 diff --git a/bsd/ansi b/bsd/ansi new file mode 100644 index 0000000000000000000000000000000000000000..ca402693c1c4af01a1b326cea55ad932b7becfff GIT binary patch literal 698 zcmYjPL1+^}6n!(B*3Fv6R9RA7OLNLWmbz(^t~Me?jYPrQS`WGOkX(e6qR=fKY9iVt zA>dwuUQ$Fv#8bg)k4`S4P>>wFw+DmtVnlF3ME$!PiZlG>&3kYEe*<%bE%Wn;BU}u9 z)vq0%R?>>pSctu^$Utnw5l1D-i^lPddC_?WQdt8Kork>JS?9-iGL?enBvbdGOCsnI z_OY?c9Aw;WzSCUfzqsgJ;UdOPP4jL61K)WSraMEN**eR8{-%M!52=fKEZp521K93K z?ocj?YK7ZaV|Gj7UZsXe!27da6Tiel&mF=RdHQU$-d8!PtHfL+)yK<(=Z1KV@M*f! zErh8fq~GOURA#2~oOu<-Hd$AFK)D~2YXZG?o^IVF93!Vfb)PzX#mDv;G@9Z|8NWB` zil~$i8D+@KW88IuDV}N?7ihjeYn}dnMIFyE@!7y=E%{WSuwlAWj5E`nV4^cc^B?hG zZf*fw>ZxX4ML&kd};~hpMU+JkC z!}nAvS&OqhJMj$t$xW&!u#td+n)>3z+sOzx<`RBlhO`oC`0v8OOKcB{_v2xp(HnK%J Z={Y^CoBFJwXY?$645J!pwD@tD#y?_1&;tMf literal 0 HcmV?d00001 diff --git a/bsd/basic b/bsd/basic new file mode 100644 index 0000000..d8aa9c6 --- /dev/null +++ b/bsd/basic @@ -0,0 +1 @@ +bbcbasic $@ | ansi diff --git a/bsd/bbcbasic b/bsd/bbcbasic new file mode 100644 index 0000000000000000000000000000000000000000..0cf2cf0d3bd033de66d209dc69d138c85b522541 GIT binary patch literal 15032 zcmYj&3w#t+miMh&olbXkC#g!8cJyVZ|mkiiV1gRaA{QJ_Ucz!1`eg!K16)!>ZS zw_dky-Fxmi|MN_ua9|!|4~b0wPhe5A`%%lXansrd`#s3Ms!6lzKD6Hm+O0a?NTrcgCE#YEE%=>FgP^X5E#PQ*xJDvS#fw>sCJY z_y+ZX8H;8tZdkW|13J#SckaE@XXnn&Phw1S%$|QtNs1N7(=dzt`BC%stUgB$&U5k0 zz-$+=u;b48>0-7musdsBz{O&v_2DcQJLfB~8Rxet1-7xmfRcbU?@HAa703N~0j$C$ z`*aByn5cuI>VW~H2-f3jzYt(gX);!5r zf~^g2*Gv!82O6Es^Yvvse=lJIZ<335i7bdY6xVa%#qJlo-QBh>yFZDI^7vVd4e@5V zzR;tDEXiW1(ZGU^szSFMtp7lMpfF>npx)pf36x|VLYUcJq~E7q&YoMN_%OF*V|vY+ zHR`gJk1-ZjBqrLT=B0_LVgz$CCS3BhDpB*CM7w_)dyScRyOfRR7Y(OQvL-FRhj?EOUhhDRbPrFWfj$~|4A$9 zFR7?4ui1t3vI@LiT2xbXvbfZ>Xg4o)E&L0bGFOf3_q=q;QV*I3PZ>+Ait7H?=qfL* ztg0yaTExi!nx(F?ib~fvMps$2tJCDdl>OXQRradrs;a7}YG0x781>S$jURD7roi~=b7S?3uXuQl-{;z0izGGz-i~cV!D}RGOxTG{QC%_-9D0O{r zMB9qfrLGIca!mRMv~@?s@`{=_c|}?2AH<6Ci^htD3w^wzs*QsTBoxNnz!|n z+RC?hMRiHpl9;iw3UmC?SXs2l)n%`&srqMo<&ys=R+d%NTsBr#;91T)oJc#EU0G56 zu84*9^D0+OZB_X-vC38HDyq4P>&l9%nqgcQm0mGcxgH!UuBt5`5vz(y-^0V|nu;n{ zG`VWYqQzKWkXMzL{u}z1*FIS6syfQ6Yh0C^d3DiJ*C)p6Mdk1F>LumB@Ul zOSa&7Rc46VCFP4UbHcnD98&tZ5u;XK7i)^jKj1ZsUFBO%H5DK7nxf*I4qj7LRN@*- zuEFlSXs@ZNb^W^trdm>V!&qBgb%-x5t-WLfOZ*34iZy*C)-5TmSv;bUg zPq9bXo#R~J4PxEvD!U=} zLXNoP?6Iq6HioNU-eoqC2lGr!6r<+1*`Uv^7BLy^Lo5k+aG3@3I7{GxJee6p4LA{W zIa#sXE~R&!^w?FE%@ZZ>(ViGP(~|@lZd1gsgO19%K4w=ln8<^TZgyA*=4q^#+tqn2 zAllWb%!n^?_7M*%PWJCYu$H5DHuY9y_AYv>%!(c|?r2#~X2N=&5MTH9N?}RF`P9tc zdV{W9wo4#PIK>2fHN#gdf8O%~3o>ry)}ZT;F{iA#?vL?Gy4I9*#y4t;$O23hishh7 ziv??)th+0~G%1SjniyfqYxsqfaiPfOeA(hp!(3-DtJo@OFWqprN-nuo`n$b@Ugygm z*~fY%t$W-Zc*)1wrB>+=oe}qy-w8}$S48K_M8iv<;V;<*Z%wxgXc(5*%e|6E*1yo% zz_reQa5u?8e9I#r?;LlxNVEOpu@Ua<7Clk(0X8al6hg__JZj#`lYC8BDNhYq-o;*! zUf{kH7JON8zU*TG$LIOZT>`WFV@wu{cX6gM%@xxT++Arw0F+5t4S;wv{G4;?}Luz`O(ft^G#y(t%vgK@(q~(jQx+7l^HRU-_;o$Uwj+Fdf2hX>P zeU6KHb+4ZX-}Op;jx%}L(g(JadG`o?jxY0|&0^8cGkI1|*l|1$+TENVQyVs@t5&XV zB%S%FC2C$aL)#t5BWe&YEzQPEI^WAPcnYLf^P1V?*P7Y3X;Jf0aC_8zG6~u>D{4OH zD3H8)y^dA*!UE8FD;vdABSu^?Ygo|E_Qi}o%^FZz%tC$9vL#HAHRV1QRP2&x-xbj< z+0{~Zo%cdJn>b|8Pn5R%=dlsANo=ZqFUAgu1zq;M=AP8Nb}8UU&O0xL9mYIia>S=8 zzr?rRpAPLWY09r~eqegs3h+<=LU4jNhO+Bkr~MR#c2L#;?)0%+U;67=uVnXkvIH+l zB1fBqou*#7Y@$!_i>CoYauiHw6lrv-fAx6xOXqEI>en~ zdFCEbjc$!@Vr5wy+1pc8@j}MulXAqbvIeF+amPpFZ%;ZpuS|58fc3gNv-8yba z+?f>-{iYSBG4-9qjnW|7pKwO)RyP=qB|bg*74?MaT*4zPH^vh--zZFY+q7;x%&)8C z+?a5gPo0v^P*~!+JYMNv!oDwx_Hw*y64GsU;$W}D>{CA+Y@AoIML$Uj@ zPy24j)z7Tn(6CW$T(@q`I>^gM_tfo~#*CuYa}u;18k_D7KmwY;=l)3^rOD=!Z=q$~ z-VBy1hAgt1*@}R!vFBT)lAbTHYohoCY?Eu))u_3HktEDx&9-Itv_o>*#>sB^12~jq zIP=ETil;WHYns%PEL(1p37;PxkDBLBqNCkEpZ%7H@|g1to^2!R=Y++b=H94y+=}Ay zD0Vf0ajYUN*&=kL-xS$I z?|wPhXkt55boOBdur%M8E!tY^`&900X6LWAN+C#jRPLT_vc1zKvKHl?E{^rpbO)sy z+{bq0#&A`MtLwmKCWzu;V7-r-I%svP@2Gn#7RzC|uw7~Pw@Gc1z%iyph?}!7eTXZbBp4XJp&$V zKzcxKQNnV_`X^t=`k8M>t^lfv4gEf`{-^cNk|j~S;rmbQ&)QL`xM78QieZHZ$F#G1 zVghEAjW5nM!>2Hj<~eBAl<`7sK*Jh0D<>=#Fgg`k{hg)f8IioDKna#_I znkS92>onegiKtRwyK@%N@3?*?V7#S6p0om6>MSEx`GL(eYYCnnF%`Th>-}=a43J(Q zOBCC1yoenk&U?dDU^|mb;~W|)u$|0}c6|$!a8GV#uU-LP;_c7zv~F(&yCxc>kP-uh zw+{)hqQQHUqvqg<3%b0t$NpN3ods_>d)l#QFh^xf?uRuG3Y!jg z3HqLf;j0l3)a~62jZe>NO#5Zp?Wp;v27nM9XkBWn4Y4eH9( zYJ+-OUA1P-TB7Wsk;x?utAD;heX?Q0^2gQFbZ`Gi2JPf&_34InD;t)rYQ(*lMlxUc z5K{Bu9XsCQ>@@p=w_*I&-N|@%{JI&sjL;!!&YAdwm_J!&$Dzf>Z{P1QviQ%+G-WgT zF0;|R-1>V<$HFXx=T`ma*`3D7i))g#o?o+Jik;zfS!BZ#Vh>*a)nKv~pWSxr$yxGnO!#@l}?9*&V%hH+;FP7;~R7 zT$vzxlRQ~O?1CyU^4e8E#T_Tv~BVSwr4RauG4n-_rYu4;UCoL^T0JL?ZSDYbJxhN zub6LsB>`*bl}e%OGll+C4b;e%_hYOX7)w+30W&pa5Qtc}HwWAdgquJpdN|RLMi}h2 zMI441*+6A_Udiof!AEj}jplo8g623gUAA>8T?(Pj(uuGi%!6i{V-Wl+cmm8*tvR&m z$>~k9ke;31WHU%2MhiebU8%q=quXHuUm3Aa@%~YB{dKn@h>KxQ+JPWRT(kUMBrFMI zc8^AXR%3_{;oBWN(l;GF}Tvt?&`vOfb7b(-Cd_9~kw?s$D4EVHONGMw}i zrw@Y8Cx#P$x^8-E_3{mfN-!2^OlF^2P6~gQ?o6K|-tN)<zVJSg&^IohxEVdMPN; zlp2s*6)uy7$YP`=U{j0$JuRmNj#)&_|1}b~`u;4Ou(T+xN}IA!{y=$lTDua2#R>c~ zgey~Zi=|UXf+QyCNHDD5%V2}JN@63>i`2U<%6T(8GLg712~t!aB@8o&&9?k$&Fq0_ zfiz=UyWVp^By>5ek9G#=5;b4A`tytGdR=p~kmWAe(BV9HEQ^ONDPmDi9lnw+*7-#? z1ud)^wA0uX^!kz0I7T2zFF0i(bHQ3CyN$-5hi~7SpDfTQo$MUmq!~xe&tA>BsIF^R z{TQ?jVk*q7OWqlbu$US22*fLq?`9oo96EoN+Z9 zPtHJUPFUI%!mOrYyE=s}#JgWXSAu7UNz#|&`WtbQM}(~#(`5p&n6#+5e+u-r0$Uz? z1^${s?V%~m7KFdzRt8{I0{y3)6g+8UOZ%sU>oxG&&M6_waWN#Z-;4;_?vr<=h_ugv z-JeV)G%|_8zzuKQax5M4NMk&(`@_5F3FdTF;sqVAPla_qg}f92qxN0>71p@UblKMq zE}F(p02%MY4oA(U?2MQ6?^K`;QR;ueE%XlIc+g_;(6db@Pa2IK7~nq87L*8C5=4@g z!&gGmC@c%R|L3e1`_Tb3vHQ2M93TeSpg>_DLHZM&?>M`f?%UrTmyYoT$f!5VBJ6BtrJ7EA4Q=5 z1JF-c?GWw9zu=m)YZx8lrFtA3UUfvi-GjZ($kum+bZ23Pp(~8h=42QugVHcRk>}PC zF*8GxIQ&Z%Yi4tYqvrICs9DaSc%vwrL@u}0w_)7z$(db2P=HXOnaSV-FElBA@qrEoa`3CakprFHSM2_~SO#eQ^xz#Y+=Z2CxHAnn1YJIu z@WM3QIUliY^oTs1Yk9rbb4-L zLCa+Em*5UT3ZDHfGx^}nLYlr%A!=eXJNJD=4%IUEYfQ8ntVNa<(CCE4=!S#{fh^{3 zv$R?~H*x4yjHU2kCI1D*3_1Gzmk?Bb3#3T!yv9ncCDx!c0vO`K4Alc7}+8~#91jITqI9nq38F$~YXRY#}yh4Y}~!#^5po>|+dKDlze zZeb8g>>RZFr|1%2_~Y~!rXU(XJJX5PyM>7UwT;3z_!`|`cOKe6r&ya#u@+E_W=7BI zK~eH3SBaPK?gSmJ+^h~ezVPOgD)B0w;pv0W1C1GQ_J6DzrZ zcO>-67RfUh2X9Q$M}xk{{!C}n@%%7;^ffM$<(8vAp9;-x_s`U2(WCcmWp?!2b+hjY zegS>o(EG+c*hg6+o^8Uf8)F^hgF+njXJ0nIkfEsJm zcx!J$mN9qutiW0=rBVqH#D|zLWag&Dc|uI@f*ykeL~m-DDK4to|entEfSKpLOx(XRM>bJ#(w@KGQ>jn$7fn@vXR1fK_#S-_(#mWk^ZSPCRC z{l~|>M6W%#b2mGQb_RPK-)&~!$jxj_Ankwoa@1#r6t2Op>K?PdLbqW9N&)7y=dz4( zGA~Uc3v{vTp=oMGNsYQ@om#x4oOq|@au(uNq7VkR-s$7kQJ?0z95YnXo}^;$`o~GS zro(op84yCyiV)YoYzCs9hYm;Y`Vz}9P~^>Xy;v(zA{}pb!@nH9MDIrRcPS2Y=2BcE z9*WUQ;#T;fF|xDw%QS9KaqIT@emSgsax|nIEek4}FkXLR1aT9;@K^iS$mq^CNLT!A zpwFe0_}q1GE^2-yQNw7^B}V8y^!rSpC{GKliB_c#77wCl6kqVWU}q8^&%QYi=#p4A zEPjb)9(QI2A5PewYY`>f>m*L*3QI7&WFB8(k5`5mX@gF@}rxCHuXY@$P-MWl6 z=+_3X*7z$>eXVXiWy^N8k0p93@>6^}MSk4S^8w|=9h%a|%Js<4$DO0Fe=1Y9DXlij zleFL~v_o{N)&t9SST?Z|oEcfZ&B#h&12wb4(KieS4EqiH40{ZI!$--J z%(o?)%;|~OOz$MWoqR5#+i)Oxt6?m0wQ;Gb-*(3Koas?pm+2K#&Da?!EFUzTl1@sy zY+p*RnBI{(OxsM}#G{gC+isdYbWYwXmx;;O_nQt$A4;E_w%WGYo|CSp9F)7H9A!d=tD!Yc2To&KEe#=?+ z_AF=>eyk@qj!`lq-Z}<_EC%Cp`+@-vQO82s^p76+9Hs;h%Rw^4BMn{1l+qjqNFxQlojw5NSe|`(vHEb7HCe=kS)+~ zoo$n@d-^fjHYp$nm|%_nBkItq zE4#pBmm%9@{SvJ){`PsdCTWtevkviaWD*bo9D)70Jqsu}Zt4gs{SHBDoyM8bCm70bN7RTX_f znGbkmQBCjyV{eW`C>hr`xzR8+$N&$eNDg_cN(Ef zRW~FW(U3)4lSbgD4Dsz*Mj(BEwBW_rlR}7skgVSt{~?T+jTvvi=w+C-fGEygx?d#Y z?%H8m^8uU{4=2O34O#5sFy=$vdjMJj*^henbdKn)M{2PJ8%0)J-{&9(gvhtSFKt77}F7o&`6Wr^>)M#FL)`}OZKLxUYKn32I|B0 zlYc{TE>W=Q2uq&8ZKI-2sU@t%cHH7gCn+vb1z$k+NL=XNXXa#m$FUX>N~uIm5Gnq{ zy z#^|lDh~C!5cbOpIYj|elP4aYaTI-2h#Y}-LFn0~u#r>XiGuyoAO|M_eNI^BKmz6r z6=K{4_`=kokl6AAMsDqK4|vhxz~WVYUe=zV-V{`~2Uq}^v<4Pxzr z#H6^zQiR#&tDvQ5^@-l6p{q^4aHGIVES?{*LzuCV1*Pve*#wX{_YS`YeQ6Kq4tX|b zhW>Up)?R6{B|!Qo4d05%JgVOz^ne_E-Kt|0{K(;UTW_NQGitjMklmQ|htYPWMCN)t zFQv z&n_;H>y(W1;115 z8Szmam%@&*i4LLe^-7(et;Vq9;zUIVJI+r`MH`uzg7(ZrtA1`4!n?np$kCpjNVqKA zwEYR)HVqnH4q1k z6<=BQ;4R;TB9fVis;W%eymw6F(j`P#D<^~; z~HpqZ?PL9w@((>AK}+h#sl6Jyr{*{ciQDP z$%NdBQ7EuoSEBMYr9c{1;w$oBCV%}-&TWF8%i5382Tw!02rbC1Pz-~7iD`%=APT5g z{;0?wyA@W?>W%d@i-kWnfvY6kHOSx+&`EQ=YPV0;VpcEek{sLZLHt7ah4JgfkKVdn z&ogsxuohKDWI^k;v9pqLiL` zb6DB)RY*x$5>z~R2T>UO=IYcYzqcD_p0s{tMq@znMq%1dm;va=geEm8EP`LBx?xQ445@tij#1*DcVvS2gWR_qPU zJ2K$76=B>rbCA5oJHLT_#(vMa)MN`NvVg3757~yJUd?fAf>6Iu&+Dar)vj1&gPe}1 z>0Qu~eAEj|(HZPa@`S8*e*Wy&Z_X7>Xx?`MT*H?e!sW+E?0{&l7gQ76)sMr4y!`kg7^=}RcNTE+0d6KBjZY=r0AmjVj_kQ+bTVt#81;(->Pn(IczVK)1?fuY{Aym>)r3Yn6$nK(+ zAy$L71zfAl0aXTJYXy{i#OkS_d>v4&?tzFSWKQ~ zc43_CKH3Y~2~<(Y*-ADdp9w(5X)F`5E8>?u7ebahVIP&Gw@TvViSPr0YmwcQet_Sv zUZ6;RSPommR?2${WF6PHf|iJmo=PrSx31wC;;T)kQmUU?wto4#m1{T9_0;h)k#_q6 z^hCCYORR@1l8~f`LXYm9F=wUF!}W8r6iK={{16eo8Go7Xlz{)pd#`&vlVt-5o#}1l zt+c?~g?0?)F^(LIlEiR^D4e)E?%^8JUW1K-XtJ%9yc)sib?&?Ap+Fx$J zB^N(s_K0gKf0D`UXtP*4+FWMyX|LbQtndtqm<8t#!~V1T{{gmx_WHB%@iYthkp&(9 znx-k4OgnoUcx*9hh7y2e*O0S9wEO#PU{OSI;k$Ejj=0ZxXvR|s;=we|l5st7UQ;IG zscdb9+`=lg61sC(L+~vu8b%z3B{z1ypra%$q)cGR0^#}vjI!*MDAEY8o^OTEnu;-w zTIk(A3j@Asc&qPxNU_nEPhHV{mJR0xXfd*}fD@;Zf#--Go~Kzoj4@giU;^v6aCbnt zjky)d^Z=7<(=ft1R7D};VR55vvK$qdO~c(s@QssyNreUW2sP)nPqwsg|&c559 zmT!YEXwxtnqTBEu+mt+^ZtoP-pCNXLHIe;7(X9c=0*h9HuTK>!33}}B3pIw?H0p87 zKUxM(ihE4fpS(O+{NS0Z$Oe%0n9jnMP*Pkw&Si!dkr9E0rTu(_C}<1DE2OYnOUr{-e9!Mlxa0fBAvn%vm$ZWG)rYGmkBn9!R1alR^cZga6duV-R13qCU z>p33TJ#r2)2+&~XcVS?}(JldfQos=l&GfcOq+B4qM-|Pp%}WGS|6rYFRQgapT7@P9 zUD7xZ;x^P2#l27OcQguF->;YqQXorUZI&&V-D=ziFPYz>o%xP9=qpHAKZBihma0$i z1@s^eJ#5}BFd(Mp8q;}v&Ufy#Y@6H45wTowj$&f8o)(OD-b_(D#5{D%$%^+GVxXH5 zn`7VU{_nSlYJX?+V6J$NzL|py8j1n@)j;G{h&G*+tBoB7e*NOkUSF z-_m>OiFJE-B3FsKpxFXc@Z_N9vE$7$PtlYXtoF^sX8Bq&Wy%Vq!Q=wlx#WOyv9OuF zhl;8G6j)NRfTJ&^Zch?(iUqbK=$QaKzgP&bMM7P4a=>vQC4f4VY#lZC$H)STIJ#4u z4W^C)X=jQv4LPC728uGHo^8wz4?#t!ZLk^;kP*R6SMUBi>8 z6K`e%pEk=T*f5Zguk5_Z*6X;I+>V%b3=wIfmim?5Kg7(S=LDQB(Dg#8tzAhFsP1SQ zcEa@MDAxH^Qq-X(f0-1g+SA5n`A8D|q6!;5h&C2`FR4I!2fw$Gz=b70-pp2g3IvG| zwQMg&fXaj`ridra_F}nAk)vziBooWPy!ZW&0BwJf{30BE$V+L;arlbx+l{>#Ej>O8 zsuo0jl;By6V*BeTiEMjTeBX+Vv1JYGS1#YS{P7hl*Ljz(@HVbrzO`wi`|-wAYg<;W zX;`uOpPpK|p>2J`(~TX>oBLdDWX`oYALV|PyE%7%F1+sUI{#E;YU)r^H=^fpbJ1>M z)6vdEBu|4yKzY=@nN($Yq|?MHLT2AbwXhoId)VNHk0o>mYE|ahH;Q{f$-bwEo%4EL zinv>T>KSmkV?~n&XMT+8EburaA)q{rUAlMzSObrP{D(@&!QueV1Kl^r!cTS}LK1q?i{5SM z-J_3qo~pUMLDPD@o+fK_#+ zc4;iNi+CN;eo)8&9}HG`H%W=Rn^0DRh2aASMc@q}UmN3?(G!MzP$h}Ygm#eFG_(ro zdG+^*eA(6K5%;hoDxQQE@dw`y^)fr_wRIuRW8PpG5L$uZq&L9HYS8i}r20_<>A;8d zw#pE|{)Z5q_yguT*I@2qsNINH;!ZNz{dd4lqj`}QyaQB5#dP9zjKTD0*Pw|>E`ABV zvm+0L8N!O4CjQLpQQkxE0Q#T6Uo`wuw{P#$Gc)s;j7rPPKm{fwc#G^f0Vh1i6iz)5M`KRVPHR+QL11SR?drp@e6^km=wvNMYnCwHK#c90drw#l zzG;#u7q)pfdk^>h z{^LI!IsEYpZv7F{pRvxZ?rrR!H5Lel!i>qevYM+ROQSg^C33O9R>OJxpBp|a>~KVY z_RNVW?m6zX{B#5Kcz(LXlI5Rmi6UlznkS_Yd-4!zwENsPIrErBNKFAsBG!+nIW!)x z+cOi0(7Ns3?m!BnQO}^s-Q_zErc(ya|w)m9jlD1jhf>LqgIO=3)kFO^mkVFhB*;&I$Q${ z5Z7~*VXRVPd;~L%;Qs3fkTDjS1MFZT`({oej%Hj-?C2Z|dw-4<*G#YOF%th;X35Fy zu`Og(Pxx$*K>x|cC)ccdMr~NWym3A1iBJ=8{0iM~UbAk+-`ss4Iyzg<+(PjJ#JRUn zl?AE-4Nai0b&E%Fpqk^?_cpWOaY5!=?81Csw&WrDLm%n(mz=mISw-Ggjm56>zD6tF zHpRe2i0{!zErz;1Gr&OsWpf_o-cZE~%aq=2&xYe0mI@|`bGv7Fk>cGe==a$Nm?8CB(qrL6NFvfkhUHJCTbNkqgYmx{Vl# zG?Wu@N3#CMVwBft;}PW`>>kvoU|fL{g%Y+nt(1*LxE(r118>pa5Ww%Xm{9vhTKzWc zLFN`3&8{ZG9*ThS`*qKI@%0v195QP`%zg&WsjiIr?SRIbE#`W6U_R5uR2&8DV6vBL znHVx|L1{nMn@zhUrRlOrd^mvI997qdIR8>VrzpM~(MHrenUBP1r4v*GU#g1w-zSh9 zge+8}8H^?RDAr1&sF?K#cq#@zhv?!2rzNoY-XA*+Y@Ubs22my53X9Jn*l0$Ml%nQT zZ}#*^5c>hm93!8<9I~)X8($pqAVn?bP(LG*o-&eYF{XeQrPpw)-vy(xQ zx_x93Ozt4=6+jyxcVV4wli}}D_5gc*mEEI)sROoCVO$Pv22^1EPG%;9!lNCZu~gKm zeS*>Ib??g!zP&@Qj=B>X8d!-Z3-Q;Aqy-M(e9tE~*ZSoRYa4a#LAU^oz&30dc5Gx6 z4ZIzHmw~J4PvB})>_ literal 0 HcmV?d00001 diff --git a/demos/8queens b/demos/8queens new file mode 100644 index 0000000000000000000000000000000000000000..c3f7504185b619bdbdbc8901f12e7c49d5ea3b1f GIT binary patch literal 1841 zcmZ`)Uuaup6u*BgmbGWKt@|f#9Bz9he{SJ^N!KPfrkJL2t#s+1M4O1Lv|F}?#iTT? zc4ZIS96r=e6hy=a8P*4p;ltR&2F?c&@xcf2!3R;N)q`q-nP%B>C<+ z-}#;2`JMB90cl6uIu2lHVlkI1mO*;dT*pNI#K{G8EI7Wnyj;i`SennD$QNe{IC~ls zg;SHcxtaVtNC$lDn0`5zJ5|P+;xRm0DwG!I%e*PIFf%_?TEMwnX|9k1$O5yB%-~TC#x1=kcd{!9W9eApKi!fQw3=cNME+z36jJl7)al^f{VJ~-#6U^=@;(F zA00nzu+Qp5|DXMLN%)X;7yGU1N>=x~vPTJ4erRt6N!1XpVs#}T3=#HfJ`LoZ&9^b5 zgS@wyl?PdC`U_-(zxrCpk|7k3pV~#`U$>lm@v+fo4<|u>rtKcab-X~~(GbY#_6lBR z!zx}JIuir=2vB#47-4{X@?bqZwK_$pgf=`jHJu`~^vGBeU&F?7{L~M5zSTt_UT1dP za}&L~O_{8o{Kf;yL@M*$rduF?K)T5vx4XL4>bTZj;W;FxM4jqft5X>oi5(hC#zsN@ zjKja;@NYZa@D1n9wx2Ld+6ufzr$oNJ$H8+-cQHX;Z~6`7e-BhR#dWee)h4H=>p)5~ zWl=gPi}LtxH_Imf6YUwhB^GDP>Y$j^C&i+YnZKPc!}@a(pbYJ?cW3k-;RIx91xm7$ zgyddR=NQKXC9})HrKUK@)N^Har%iQ@@Q796v5FlPcB8^%zPNB?5R{jg!`W>(tkgKv zpm{1mdCTQcM+4=(`;t!kJ4S~6Q(tLnwD8!g8D-JYzRSj0PQl!?d2N^)Z?4xRGsUrZ}9W*(2nK(bV{>2 zo<%{$RB@_1LWiM>gWcr3VAbc0oD*~(dOQSf$8v-h&m&oubiX@|Ufb#g_4Qa|BwbR$ zaE}na37xJg=eLT?wHDYTn6(Y8P0*=U-=VXkzTeM(4)mc}svxiVGUH$84}&ytJT%k+ N_SnO%UM3;``yVdC^YH)x literal 0 HcmV?d00001 diff --git a/demos/clocksp b/demos/clocksp new file mode 100644 index 0000000000000000000000000000000000000000..a40464ecdf12926e6e8f9373fc81a62d210d6567 GIT binary patch literal 2005 zcmZ{lO>E;-5P%bjUJ&NA2M&lGdHZ&gx<8KdS6=JvI%(2o)udV5iBJzn-o#BUQaiGf zE+8&&Kp=s{UXXyxB5`5Q2=)Ska^cLGl|V)835l#y2_aQ5Yx^{vXKI2M@K2Wc z7E{v+nU|QF15cH*s*TvCTB9m6H4FKI1#; zz9g@vd0x#kZm4-)KoU3ALMYur8ZW9_^dUrQ)q$wnRtNNAt*DvM@w_hJBW{E~a9!Qu zXS%9O20zzxW++@S8Q(=)mQqSame=s>aW}Th;zDE}X${MFEVuVB;Dpvt_xV{vZAf{3 z-pCcEw90>J6{5B31F`J(?6&P+NGmh)_6%QTCZVh6WtJmHG4^C)m7q#Wo|;%Cs9PC3 zT-wv8-p)CEiXOuQD8f5n@ZYDfJ%XhZ$`rOouvZZ_@pqm#@%I!RM%Wg@@^i4-2sX2< zMzFVxnY$OlLVpRzh{xuDw+NWXW|Q)2c6=VU2>D)eAez3@UfcEB(6fUc9W6d+-=j}t zOvJ&vDRI;FTstRn9Wzsid}!j#W)8CpQpDN|Za-A-fm*cr;h7h@bFWf|1R7Jzo%hm0QRxQ`+ zyP8?vtC~f_6!|HY)B{ZY6vt&J-)W1>pKFV2O8B3W5^?EdEK0?t*{l+mzI{@jnrhJ? zK4-f@wr7=WdXmxx+5Uw-5V5?QcB}8((6l<8X$VKrnVkxMOd*~l)`_?-C#OkMC*n6q z+}<j>~nH_ITPOySH+DJQ65R-%L+dS(!8~*V zz#pENbKA#u-U6#_IWE?K61INi7}EeOA`2>3fZHR)C&(MQAskcaA(39G zSpEw3ECqCX8VC$aFR(iYaNzlH5b8qk8X}GYA^LV^q@4gcJJHTS!Sj8)Ninp2AGI78 zf>AwF#tYF8wnMFi3`%mP>K)^riVTL0$v_t=ZiMv%KHW1EzT@!~5x#GC?65WA<{xhi h0q+`G*7W)m(`CThV!V1PqJ}@d7RE9m`Wd?Z_djv{O}YR8 literal 0 HcmV?d00001 diff --git a/demos/colourgrid b/demos/colourgrid new file mode 100644 index 0000000000000000000000000000000000000000..5dd729d1d5b999f61fc18a6c4074abe74e8d9d00 GIT binary patch literal 339 zcmd;O;1c?xV5i`mpOar&4h_M?K50uVUC^(v_= zxuvHlS@Sa3XgpR(N>{ZtP}rehXlnIQNkPfF4k%y^)S+Z;^%f*)^^upsP2jOY8eAPO zLxA{4g}p{VyFluJ5?}@|LljUM!Z==r6v_7rhUPkkMi$y2gTNf1YF>ss36P_pb|D#1 zA^$}oAjs1%L?Ji?NV%(MnCLir1gWSw8EOKZ+r$ZW5idgz7s%HjmrVl-fsI_i`hfR8 E0C7oRr~m)} literal 0 HcmV?d00001 diff --git a/demos/colours b/demos/colours new file mode 100644 index 0000000000000000000000000000000000000000..aeb8222846590706a70dabfaebd47e82951ee9ae GIT binary patch literal 1991 zcmb7FPiP}m7@q<6B0ObXg%z=WJ~B-vGift3`7?c!1ZSp6R66aFw#EuBw41T1#$-uS zS)oXGL8Z6{PYPc2pa(^S1rLi**={{}@Z`bM9)yB9NY&tqAV~e*OeXzvlhXFR?|tw4 zec$i*y>E!{;KTQ!1a7C*+3fa+@M!ElEcv}YyfC{Ajqb)9eiz(@xrOB#^fs?v?R5J@ zm^jCXkjU9mG0k3-iW=+mq+%lR&19ug$;jLIFP)aJ>)9M@cbw`ho^c1=l!>5c2Y{P` z2{)nV_bYQ!(PX%AY8WR6??px}7g;}lqz0~ z4dCNKN!QbX2VNjT<&gn==*0>pP0z3+FGhq*7tnvti>bOC+ zRrcRXcoK$8nKG84Q2f~sEqPhRH1n9t&8MS`hp>}C+-W`axgDF<6-~BmB;tef2hd$# z!y>U_17SZYxTqC3Vd%V^3Ux^)0@JoB7fR{Ch^j?KEf-jc@Ws>sLbZ_~Ew8!~iW#kL zKt8l`qFjjxUnhsK$BPQ9aiyRNpsJQaTGWi9b9!Wp2;V9LNMJCYQ1LiQ7>b`p3sk z#Ty17_bwc=13;co(x6X>@QWJNiAf^dsOfp9AQ768O+^I|;g81$c$s%2uVqA%p%dXB z8iAowauNTG8N;zP;k3R071e~-vG00-X^CTFrg!H%&*B3}GI;)s+4 z_l9=NBBDBR0^|h$VNSW&A)=1oMLN=jsa?YYtM(i2!0?_=!W=?sd%=MV2(B3>?@Wj&ut*wVHxCylA>m`H`& zG&yMoi|~+$&Dj%|u`TVGYD-B6VbloCl&xd4gAeKS84(G+1YG0V9lqyW*nJnufFa#;7Tx(k(YN~9l)2PKHt%4z3F#-FqM%*FPh7K zL#6RMbdAT1w;NQA(vhv5M7Z8IWQ!idodTLdr1xKrkRnlWbQtuxSE5hAq?=aSrvUMI zt{6NHpi5>_hMJKrb{Nd_%*+^p zh<7jk_3vi|!w6mp4t|Ci&t!@C!#RAGKc()0(?Y$}8j4r#w$&BCr8=!mU-eek{kH19 gx!P9i&5gcK#Gju;XY@oz^y6--w~iiay-$w*0|;$2(f|Me literal 0 HcmV?d00001 diff --git a/demos/kbdtest b/demos/kbdtest new file mode 100644 index 0000000000000000000000000000000000000000..6c18da526552fd1d184d32c72fa0be1521b8c71d GIT binary patch literal 3182 zcmaJ@O>7)V6>g7+Ku8?{n?*qzR<*UB$#kYC)78`S{>^ED|#8SLwT8FOcX*$ZBs1v#cuSC2!EW>`ywpwo+l2m$*&yPA6Wd z*SY;3`x=X->g%RCbxcUkb-`6-rV8u#?I)3>RQiT}z})1_?0pGJMviH6`(HxnLfD6Q zipKNboYA}1jWc7|ABLu8Ym|4qKA^DNg?rJXzEjWE~@o7*hh@%^s9$pWA8>3f6p zy{%v{B&(V>%`ak2Rs2)$tIF>D0i~GYdy7fe4Eu18FExkV>s~zwTV9*%>4hY_#fp~p zrZ6%>F9L#;M%5B}HaNds`Y_Oc0NC|AL7IRy`;gZLtqcYm2F&x@{Jg4si=6oGv%ThE zm~_YyTYB?DRr$g4A-lI_q-n03WRfCj<>kV7Dn`@0!qBiAiEGn$MFCT&`ps=G5>b_( zJ|nT|2jQS1Rpl4z2T}NDNmYJz4i$<}ZzI$wg$0Z9yO30s-<=%`LN{`kbpEKtRYs*@ zngtZ#)4H+(ROK(H-cgl*(DC{Amna-EVAX=>e})W_RdCoW+~qL62mcb z8-&NdC=W+o#CtsR05zRK#?=Y^j0DY_*o+-0enu(?i3Wg|J|7vD^J?vt+A6_b;wTAZ ze%6qO&q&SjY5x}9Mbp4@zHv;iux;ZA0v++geL$p{F?`+!AGT4l|#$`ZltN&Ro@9}-Gc z>Z3>qtr2$pVXk8U@O$pavtx*e!tqnmvA{>$ev@f9FcK?JYF@*O!Cs*HKw4CiRHys!xPJO>#sn z`U6q>_Df@Qvik5r8N@qq@nPg6T1rL~H7w3Vi%UTz@UIgFq|}K=EUGYgeZU|jknQ8% z|32#Haa4O;l2HlzH)QIWEFVff8|A!^wTL2h;!h?4&f@Uw@s2Q9M+gj426>`N@>4RF zcV3V#fWIS(o(lHeXQXeJn*F9f;{P#D`o#Y}yFYG$IO%HQQ{dc<&cn&Zf5=niU7NLL zvU)2!s}t2a3R@?h@l*A6WI;!1>yUr|77&_F9^(f=s)^5SejNG~(CdcI>OyC%ZqiR4 zGmAb7_$XqOFv@y;O0Nq8LtvN~c?=7q!0o@PiE~S226Z)Z8KA%fBJcnQuwz&ZU@$4| z!thBvHIb?up;dNmen*sf9O*F<5T#^-A$o@JSror?$hbrhGav5|Vv9nPg`!iXjF0#dF0I%=yN3!kk5G zl-PMR=RIBtwzq?J5PG<3a(FbX&a+Ch*V^edhe5~~bGHY>u-RsnMg=p*UR!4?^dJj& zw&lEfc_l}uHF#qn=UjJ_cz Jog>*N{|AXhe}Mo1 literal 0 HcmV?d00001 diff --git a/demos/mathspeed b/demos/mathspeed new file mode 100644 index 0000000000000000000000000000000000000000..acf41235c8b0548ce63781785ade5700494288a0 GIT binary patch literal 2544 zcma)-J!lj`7>0KS0}@z4u@H=LTv*YK%kJHg2z#D*a0DXc6g)&MglG;^geb`oEG&!x zi(p|uEG)#rLM&Vm3k$KZ5DN>ju(GhSu<{@_f#_jza6bw+n@ zv6F0euD5XRdbd08I(tXkexnk{t}{N8xXzJ-eQ#!|*S*?ZW)tlHQ{vS(s@0=)*Qp+F z`i-`qbo|C<^0O%pPSg_qThk9K$#4D;C;j?n*zxP$l@)%h7K>viq|{JOoy=0Ft0*-z zr!voV&K~G{(~H;UdOFC9lf}5S4B|W_Y5cA`oRKI8WfC3gu3mWi#suio`3koc4egQQa z%x`L+Wgvfy5B=y6e^rWzsRfYi06jsjCu@=HLU?99!w$*5F$u5en|K(`oXCZfV_Z0y z;=;)(NqB^WlhasuWEW04lJE!%Czr7BXnWyg0fcKXm(@ngK;8u5I>b9_r#8TQAUslq zKSX$DJs|uE205lA*Y=}tb*JQQ)#J<69SWfn|22HO;v;3~WA^sv$=k7H(8L;W;{ zb&5=705nm$6rrIxl}~`S_ylO1Pk>&KCNO)Zg(g5RE6DtPyl$TWU6dvua&fh*3bqK| zeggCsOhAjefhJIf^gc{L&-n;Vz=ru0CLj`(3A|AHOxb#w3A~00WRwt^eKhGirArZN LnZQRrfxrI%;*I7P literal 0 HcmV?d00001 diff --git a/demos/neobbc b/demos/neobbc new file mode 100644 index 0000000000000000000000000000000000000000..17e3e45b8fafd47f56b851455139044c3a0cb192 GIT binary patch literal 3776 zcmaJ^TWlLy8MYl(;x^p66r@Gf>5<2Hd`aix%XlVEJ8|qLY!h3y)23w?WIy=p4;EpXfkzH)uh1FsUx=7_O?5XJ?8dqvJOJpydH!{&A74fi^(6gcygB?Y3fBUW`AE!OOJyNzCpb=o~Q!3H}$w%r(B zXGFT*_l8nHKh^BE!uglVwNGDkhsE9vDKJM8O1Xzx+WM2V)!3HvsgLCxE-rt<7}; zUh#oqy*>r56ELN!Qs8sTBN4HwY#5lr`u{^oGjx_nzvyChox~gSFE;FV|YQL>CxA!Prj+{?w)~N5v^9H_mCrN8=@5p&GBL#jK zc}$~>5*n$U^HVFhQYk6$(|MxlIK=5)f2CQkGDn8+v(TYh6*=$7)+fuAI#aFHa>aU{ zbmL44{5(6tGE#IbAuy9>Ut)p+X}%%ql%nZAMa@ZpS7gEDOqeun%9NYJVE^waEPoD< z?`ek3mr%$Sw{L5z{fl40PH|#gaNP}VQ=Evbr$8=L&aE7iQU*xXx~840 z*6KC?-#$CF_YI{g&*J2zshtm@^7yLwYMErUVP9dnJ8YhW@M5$R@U0w%G3f8|u z#JPDeP8K*mbU1EY+OFQjM{t za;;vfU0z-+mRX@(sg_yQA=K*HrAv%es>`c&Rx4JQol8psa9N;u0v5zFNK!_Tf}f&5 zUZ2Brz-PJT;d727`zWgYq@GeNIskzQAbX|`%1}?=%3VwF! z1h0sRC_ng04MK%ZUs19Np$*Dz=~Ov!u{D)jRQJIzd~nQ@o%RbZ|M+b!4Z@u>C#)Ou z7H$EAdd#gBsr{zxpF$dfjM%oqHgB~D=+XXQkK5Qv!Iz#H^UZcgn9OYt9PaLr+xJW< z_#+C(LG*=<7U}~*m@^ePEy{6!`rcXMRFi_gw8#8ecWOk@%E-&$jGhi_{62)E6o&^WIuHrE*2)KsD#@`9Q3adADN z;mkq2|4{Uig`I)dA9y~aStt}tbD~3!8wnlUNg=~56-ws96Gu|;HFER82k6dN6W6GQ zupE7OB<^UHikR*g3h2L2`$W3zcxADoX`qJQ`Ls_>QE@v}TsuJXZSva_9t^=eqw0ygu50@T$1NeH8#yaHs9q~T$P0>JG~cr{hK{#cp2D} zqZ+{6egb=Cid}ju_BWX^uTyyaIp73}(kC>M4R6u-yIJz7(?|OdFl*E6WDpn=Ddr~n z&LOg(>Qd;BXYMyU1H2dqn2g`lbTdv{G%r0xp}#&e5~o>lgk=0$ODFE-aBqeF{{Gi} z;+uGDrO-bSsF~1v99*N^dQF;nFYQk!kLV`6;SM|us?&9nzloC&xs^UUTXQY`}nFhHM{#kyJ=n7uI(fM>< z%cTVl7v<bm>@23xOugX7PVm40idY&|@m5JjjM8LZz(9+u{A~12GNNIbzaUeJvBT6a z%~b7a{~$CZ4LoB0h5w~vMiOv0p4JdSAAeVxd9DdR!7%Q6kbON70>`e98iT?cgVP2?;3e`?bz95lkTqV)~y|Hz1t-Gh$^xxwFtLW zQY4TNN)SS#;m{KYPCZycLWmQGa%k1G7Y>{_aDgDCN*Dzph}2$?3Vd(YPSTV@56SF! z-n^gheeb{V|H0M zU)giQvFt!Nmzc88ykmcFN5Tn&eXA}Uc%~!tT@Wrri)uB$$%U z^r0kYpMA3{oZ_lndgU`qC;fAsQ|X+Jdy!DH22)J?)(j-CkjPNy^o-C=sLhteg#DWh zRrcn^k~SwYmO8PzdC|lnQzrBG+-$=cTvWGj7&*EE|3=gELc_|G>hvbX5ebd#X$G|a zUMSgjY*#p+UNtO@CmUUNf$P^)`>qSKb{{7O;m|->!PB%g382r**uR{@e#*3e;cmIy zs)V7POmTOV#4o3Lifitu%9PHdcXLcRn_cg<)2>j-mMfMGvluHki|@N)(lTv_zsOge zt1cA3wSS%9b%l`IyYZeW?~SfYG-npNr=-exF>N`i@jP@O#fHI|@=-pP zk%;4BaA8sC<%J6i@L*#}=pCWAg?#|&AEe1-%ExwFI0vMVy(FA;TP&xleokE(%iA6B zL@bY4BoZIMDRm`fU}4JTwVV zEt3U=zsCJ~%WpPnGk&?^&r}Y(Wk2-%D2!UoR;yWe!V1KRKPs3i;P+@YiKt>wPS-%l@waBaaUM=K$>`%tZn*XJ4 zNkFx}rFxYzT%AEoCn+;+GWK;^26?iIG*s)&VBpBEn@st3AXkB0c*09QNbZMYvA&Xo zh#0cQy`b(jYTl8WR}Z~e-FbuAI4z4fg}Ucb!$A3bvn8RGCp&Y;5_}p`4&dl_h6bxB;VQCGh2<(NOM{(V24hww z^a%+{VN7+nmJN(`N> zB*G0rO<7cYrUNu4OX@NTmq^n}dNUQTa@;#y@#>LxIP&V1K_P)KG4XfuB@w+!0LAze zNyQPj9?iM6s1?<`AgVPZw7Uv+5l1J<c-tBoGg>Q`#Zdio!ugrPw0nn#5pinUZ0WvM{KV&`tWW2xaf+ zJEZa@)sd~%_x0T=K_K_MYE#7cj$F_Zv4t+6xU-?yo8cMGg&PT~%=^49Af+emz1kY|@L@e$YN%25J zx_RL9RT_1Y+ySN%ZvjzEro=b;IyG0CV;h**81MKd@K?~K=o6hC8hYp3Eb-mJepgJ& zwv|S;%3B&&xo&2=nD7})U;_Ooo5W!1IzPnqE=HrOUFTW)1UWT+&t04VKgd(>*eJ`F zg`DLuGq~>%#Dh*I``>{yNn}mXakn~_xV;BO1ZV%+zwK<`?{;!z&mr}Or42N&gSzd8P#?(x$ QV4(2uM!{=?qGx~q11R*xf&c&j literal 0 HcmV?d00001 diff --git a/docs/bbcbasic.txt b/docs/bbcbasic.txt new file mode 100644 index 0000000..bc10d73 --- /dev/null +++ b/docs/bbcbasic.txt @@ -0,0 +1,1200 @@ + BBC BASIC for the PDP11 + ======================= + J.G.Harston, 70 Camm Street, Walkley, Sheffield, S6 3TR + http://mdfs.net/Software/PDP11/BBCBasic + Date: 01-Aug-2023 + + PDP11 BBC BASIC + + (C) Copyright J.G.Harston 1989-2023 + + +1. Introduction + + PDP11 BBC BASIC has been designed to be as compatible as possible with + Version 4 of the 6502 BBC BASIC resident in the BBC Micro Master series. + The language syntax is not always identical to that of the 6502 version, + but in most cases the PDP11 version is more tolerant. + + BBC BASIC uses UNIX TRAP calls, RT11/RSTS EMT calls or Tube EMT calls to + interface with the host system. It can be installed in a suitable + directory such as /usr/bin. + + PDP11 BBC BASIC is started with a 'bbcbasic' or 'run basic' command, and + on startup will display a startup message similar to: + + PDP11 BBC BASIC IV Version 1.00 + (C) Copyright J.G.Harston 1989,2010 + > + + *QUIT will return to the calling process, *HELP will report the current + host interface version. When running on Unix the output can be piped with + 'bbcbasic | ansi' to output ANSI control sequences. + + +2. Memory utilisation + + PDP11 BBC BASIC requires about 16K of code space, resulting in a value + of PAGE of about &4000. The remainder of the user memory is available for + BASIC programs, variables (heap) and stack. Depending on the system, + HIMEM can have a value up to &FF00. + + +3. Commands, statements and functions + + The syntax of BASIC commands, statements and functions are the same as + the 6502 BASIC for the BBC Micro version (BASIC 4). Some commands and + functions are implemented by calling operating system entry points via + Unix TRAP or RT11/RSTS EMT instructions and, if supported, by PDPTube EMT + instructions, so their functionality depends on the level of support + implemented by the host interface. + + +4. Special characters + + ! 32-bit indirection + $ String variable or string indirection + % Integer variable or precedes binary constant + & Precedes hexadecimal constant + &o Precedes octal constant + ' New line in PRINT or INPUT + * Precedes an "operating system" command + : Separates statements typed on the same line + ; Introduce comment in assembler, suppress action in PRINT + ? 8-bit indirection (PEEK & POKE) + [ Enter assembler + ] Exit assembler + ~ Convert to hex (PRINT and STR$) + = Convert to octal (PRINT and STR$) + / Convert to binary (PRINT and STR$) + + +5. Variables + + Variable names may be of unlimited length and all characters are + significant. Variable names must start with a letter. They can only + contain the characters A..Z, a..z, 0..9 and underline. Embedded keywords + are allowed. Upper and lower case variable names are distinguished. + + The following types of variable are allowed: + A real numeric + A% integer numeric + A$ string + + The variables A%..Z% are regarded as special in that they are not cleared + by the commands or statements RUN, CHAIN and CLEAR. In addition A%, B%, + C%, D%, E%, F%, X% and Y% have special uses in CALL and USR routines and + O% & P% have special meanings in the assembler (code origin and program + counter respectively). The special variable @% controls numeric print + formatting. The variables @%..Z% are called "static variables", all other + variables are called "dynamic variables". + + Real variables have a range of approximately +-1E-38 to +-1E38 and + numeric functions evaluate to 9 significant figure accuracy. Internally + every real number is stored in 40 bits. + + Integer variables are stored in 32 bits and have a range of + -2,147,483,648 to 2,147,483,647. + + String variables may contain from 0 to 255 characters. + + All arrays must be dimensioned before use. + + All statements can also be used as direct commands. + + +6. Immediate Commands + + Immediate commands are used at the BASIC prompt. + + Command Function + + AUTO [start][,inc] Generate line numbers. + + DELETE start,end Delete program lines. + + LIST [line][,line] List all or part of program. + + LISTO number Control indentation in LIST. + + LOAD "filename" Load a program into memory. + + NEW Delete current program & variables. + + OLD Recover a program deleted by NEW. + + RENUMBER [start][,inc] Renumber the program lines. + + SAVE ["filename"] Save the current program to disk. If the first + line of the program is a line 'REM > filename' + then SAVE with no filename will use the + filename in the REM statement. + + +7. Program Commands + + The following commands can be used in programs or directly from the BASIC + prompt. + + CALL address[,arg list] Call assembly language routine. + + CLEAR Clear dynamic variables. + + DATA list Data for READ statement. + + DEF FNname[(arg list)] Define a function. + DEF PROCname[(arg list)] Define a procedure. + + DIM var(sub1[,sub2...])[,..] + Dimension one or more arrays. + DIM var exp [,var exp...] Reserve space for assembler etc. + + END Terminate program. + + ENDPROC Return from a procedure, dropping out of + any FOR...NEXT or REPEAT...UNTIL loop, + restoring any local variables, error + handler and DATA pointer + + ERROR [EXT] n,string Generate an error with error number n and + text string. If EXT is present, terminates + the program and returns n to the calling + process. + + FOR var=exp TO exp [STEP exp] + Begin a FOR...NEXT loop. + + GOSUB exp Call a BASIC subroutine. + + GOTO exp Branch to specified line. + + HIMEM=exp Set top of memory used by BASIC and clears + subroutine and loop stack. + + IF exp THEN stmts [ELSE stmt] + Do statement(s) if exp non-zero. + IF exp THEN line [ELSE line] + Branch if exp non-zero. + + [LET] var = exp Assignment. + + LOCAL var[,var...] Declare variables local to function or + procedure. + + LOCAL ERROR Localise error handler. + + LOCAL DATA Localise DATA pointer. + + LOMEM=exp Set start address of dynamic variable storage + and clears dynamic variables. + + NEXT [var[,var...]] End FOR...NEXT loop. + + ON exp GOTO line,line.. [ELSE line] + Computed GOTO. + ON exp GOSUB line,line.. [ELSE line] + Computed GOSUB. + ON exp PROCname.. [ELSE PROCname] + Computed PROC call. + + ON ERROR LOCAL Localise error handler + ON ERROR stmts Do statement(s) on error. + ON ERROR OFF Restore default error handling. + + PAGE=exp Set memory address of user's current program. + + PROCname[(parameter list)] Call a procedure. + PROC(exp)[(parameter list)] Indirectly call a procedure. + + READ var[,var...] Read data from DATA statement(s). + + REM any text Remark + + REPEAT Begin a REPEAT...UNTIL loop. + + REPORT Print error message for last error. + + RESTORE [line] Reset data pointer to beginning or to + specified line. + + RESTORE DATA Restore localised DATA pointer. + + RESTORE ERROR Restore localised error handler. + + RETURN Return from subroutine. + + RUN Run the current program. + + STOP Stop program and generate untrappable error. + + TRACE ON Start trace mode. + TRACE OFF End trace mode. + TRACE exp Trace lines less than exp. + + UNTIL exp Terminate loop if exp is non-zero. + + WIDTH exp Set print output width. + + +8. Operators + + Symbol Function + + + Addition or string concatenation. + - Negation or subtraction. + * Multiplication. + / Division. + ^ Involution (raise to power). + EOR Bitwise exclusive-OR (integer). + OR Bitwise OR (integer). + AND Bitwise AND (integer). + MOD Modulus (integer result). + DIV Integer division (integer result). + = Equality. + <> Inequality. + < Less than. + > Greater than. + <= Less than or equal. + >= Greater than or equal. + + The precedence of operators is: + + 1. Expressions in parentheses, functions, negation, NOT. + + 2. ^ + + 3. *, /, MOD, DIV + + 4. +, - + + 5. =, <, >, <>, <=, >= + + 6. AND + + 7. OR, EOR + + +9. Arithmetic Functions + + Function Action + + ! num 32-bit indirection + + ? num 8-bit indirection + + | num 40-bit indirection + + - num Unary minus + + + num Unary plus + + ^ var Address of variable + + ABS num Absolute value of numeric value. + + ACS num Arc-cosine of numeric value, in radians. + + ASN num Arc-sine of numeric value, in radians. + + ATN num Arc-tangent of numeric value, in radians. + + COS num Cosine of radian numeric value. + + DEG num Value in degrees of radian numeric value. + + EXP num e raised to the power of numeric value. + + INT num Largest integer less than numeric value. + (Note: INT rounds towards negative infinity, + whereas intvar%= rounds towards zero.) + + LN num Natural logarithm of numeric value. + + LOG num Base-ten logarithm of numeric value. + + NOT One's complement (integer). + + PI Returns 3.14159265. + + RAD num Radian value of numeric value in degrees. + + RND[(exp)] RND returns random 32-bit integer. + RND(-n) seeds sequence. + RND(0) repeats last value in RND(1) form. + RND(1) returns number between 0 and 0.999999999 + RND(n) returns random integer between 1 and n. + + SGN num 1 if exp>0, 0 if exp=0, -1 if exp<0. + + SIN num Sine of radian numeric value. + + SQR num Square root of numeric value. + + TAN num Tangent of radian numeric value. + + +10. String Functions + + Function Action + + "text" Constant string. + + $ num cr-terminated string indirection. + + $$ num null-terminated string indirection. + + ASC str Returns ASCII value of first character of string. + Returns -1 if null string. + + CHR$ num Returns one-character string with ASCII value of exp. + + EVAL str Evaluates str as an expression and returns resulting + number or string. + + INSTR(r,s[,n]) Returns position of string s in string r, optionally + starting at position n. + + LEFT$(str,exp) Returns leftmost exp characters of string. If exp is + longer than the string, the whole string is returned. + exp is taken as an 8-bit value, so LEFT$(s$, -1) will + return the whole string. + + LEN str Returns length of string (0-255). + + MID$(str,m[,n]) Returns sub-string from position m, of length n or to end. + If the calculated string length passes the end of the + string, the whole string from the start position is + returned. exp is taken as an 8-bit value, so MID$(s$,m,-1) + will return the whole string starting from position m. + + RIGHT$(str,exp) Returns rightmost exp characters of string. If exp is + longer than the string, the whole string is returned. + exp is taken as an 8-bit value, so RIGHT$(s$, -1) will + return the whole string. + + STR$[~|=|/] exp Returns string representation of exp in decimal, hex, + octal or binary. + + STRING$(n,str) Returns a string consisting of n copies of str. + + VAL str Returns numeric value of str. IF str does not begin with + a signed or unsigned numeric constant, VAL returns zero. + + +11. Program Functions + + COUNT Returns number of characters printed since last new line, + CLS or MODE. + + END Returns end of BASIC's variable heap. + + ERL Returns line number of last error. If the error occurs on + the same line as a FOR/REPEAT/GOSUB/PROC/FN it may be the + line of the matching NEXT/UNTIL/RETURN/ENDPROC/=. + + ERR Returns error number of last error. + + FALSE Returns zero. + + FNname[(parameter list)] + Call named user-defined numeric or string function. + + FN(exp)[(parameter list)] + Indirectly call user-defined numeric or string function. + + HIMEM Returns top of memory used by BASIC. + + LOMEM Returns start address of dynamic variable storage. + + PAGE Returns memory address of current user's program. + + REPORT$ Returns error message for last error. + + TOP Returns first address after end of user's program. + + TRUE Returns -1. + + USR Calls a machine code routine and returns integer. + + +12. I/O Commands + + CLG + Sends VDU 16 to the output stream to clear the graphics area of the + screen and set it to the currently selected graphics background colour + using the current background plotting action (set by GCOL). + + CLS + Sends VDU 12 to the output stream to clear the text area of the screen + and set it to the currently selected text background colour. The text + cursor is moved to the 'home' position (0,0) at the top left-hand corner + of the text area. + + COLOUR l + Sends VDU 17,n to the output stream to select the current text colour. + + COLOUR l,p + Sends VDU 19,l,p,0,0,0 to the output stream to set the palette entry for + logical colour l to physical colour p. + + COLOUR l,r,g,b + Sends VDU 19,l,16,r,g,b to the output stream to set the palette entry for + logical colour l to physical colour r,g,b. If l is negative, then sends + VDU 19,l,24,r,g,b to the VDU to set the physical colour of the border. + + DRAW x,y + Draws a line with the current graphics foreground colour and action from + the last point visited to the specified absolute X and Y position. The + size of the screen is always TEXTCOLS*2^(10-INT(LN(A2)/LN(2))) pixels + wide and TEXTROWS*16 pixels high. This is 1280x1024 pixels for a 80x32 + screen mode. DRAW x,y sends PLOT 5,x,y to the output stream. + + ENVELOPE a,b,c,d,e,f,g,h,i,j,k,l,m,n + Used in conjunction with SOUND to control the pitch and/or amplitude of a + sound whilst it is playing. + + GCOL [m,]c + Sends VDU 18,m,c to the VDU to set the current graphics foreground or + background colour and plotting mode. If m is not specified, 0 is used. + The modes are: + + 0 Plot the colour specified. + 1 OR the colour with the colour that is already there. + 2 AND the colour with the colour that is already there. + 3 Exclusive-OR the colour with the colour that is already there. + 4 Invert the colour that is already there. + 5 No change to the colour that is already there. + + INPUT [LINE]["prompt"[,]]var[,var] + Request input from user. Comma after prompt causes question mark. If LINE + is present, accepts the whole line including commas, quotes, etc. + + MODE n + Sends VDU 22,n to the output stream to set the screen display mode. The + screen is cleared and all the graphics and text parameters (colours, + origin, etc) are reset to their default values. + + MOVE x,y + Moves the graphics cursor to an absolute position without drawing a line. + The size of the screen is always TEXTCOLS*2^(10-INT(LN(A2)/LN(2))) pixels + wide and TEXTROWS*16 pixels high. This is 1280x1024 pixels for a 80x32 + screen mode. MOVE x,y sends PLOT 4,x,y to the output stream. + + OFF + Turns the cursor off by sending VDU 23,1,0,0,0,0,0,0,0,0 to the output + stream. + + ON + Turns the cursor on by sending VDU 23,1,1,0,0,0,0,0,0,0 to the output + stream. + + OSCLI string + Pass string to operating system to execute a command. + + PLOT [k,]x,y + A multi-purpose drawing statement. Two or three numeric values follow the + PLOT keyword: the first specifies the type of point, circle, triangle, + line etc. to be drawn; the second and third values give the X and Y + coordinates to be used (in that order). If only two numeric values are + given, then k=69 is used to plot a single point. The two most commonly + used statements, PLOT 4 and PLOT 5, have the duplicate keywords MOVE and + DRAW. The size of the screen is always TEXTCOLS*2^(10-INT(LN(A2)/LN(2))) + pixels wide and TEXTROWS*16 pixels high. This is 1280x1024 pixels for a + 80x32 screen mode. + + PLOT sends VDU 25,k,x MOD 256,x DIV 256,y MOD 256,y DIV 256 to the output + stream. + + The following PLOT codes are defined: + + PLOT 0 Move to a new position. + PLOT 1 Draw in current GCOL foreground colour and action. + PLOT 2 Draw in inverse colour, as though using GCOL 4. + PLOT 3 Draw in current GCOL background colour and action. + + PLOT 0+n Use relative coordinates + PLOT 8+n Use absolute coordinates + + PLOT 8-15 Last point in line omitted when inverted plotting used. + + PLOT 16-23 Lines are drawn dotted. + + PLOT 24-31 Lines are drawn dotted, omitting last point. + + PLOT 32-39 Solid line, first point omitted. + + PLOT 40-47 Solid line, both end points omitted. + + PLOT 48-55 Dotted line, initial point omitted. + + PLOT 56-63 Dotted line, both end points omitted. + + PLOT 64-71 Single point is plotted. + + PLOT 72-79 Horizontal line filling. + + PLOT 80-87 Plot and fill a triangle formed by the specified position + and the last two points visited. + + PLOT 88-95 Horizontal line blanking. + + PRINT [TAB(x[,y])][SPC n]['][;][~][=][/][exp[,exp...][;] + Print data to output stream. + + QUIT [n] + Terminates the program, passing return value or 0 to calling process. + + SOUND OFF + Turns off sound output. + + SOUND ON + Turns on sound output. + + SOUND channel,loudness,pitch,duration + Generates sounds according to the four 16-bit parameters as follows: + + channel + Bits 0-3 are the channel number (0-15). If bit 4 is set, the sound + queue is flushed and the new sound is started immediately. Bits + 5-12 may select addition functions where supported. Channels &2000 + and higher and -1 and lower are reserved for other systems. + + loudness + Values from -15 to -1 select a sound of amplitude 15 to 1 + respectively with constant pitch, zero selects silence and values + from 1 to 16 select an envelope (see ENVELOPE statement). Other + values are reserved. + + pitch + This selects the initial pitch. Middle C is 101, and a semitone + change in pitch is a change of 4. Pitch is an 8-bit value and bits + 8-15 are ignored. + + duration + Values from 0 to 254 select the duration of the sound, in units of + approximately 1/20 second. The value -1 causes an indefinite sound, + which can only be stopped by issuing another SOUND statement with + the "flush" bit set or by pressing the ESCAPE key. Other values are + reserved. + + TIME=exp + Sets system elapsed time counter. The program needs to be running with + appropriate permissions for this to be effective, otherwise there is no + effect. + + TIME$=string + Sets the system real-time clock. The program needs to be running with + appropriate permissions for this to be effective, otherwise there is no + effect. The string must be one of the following formats: + + hh:mm:ss for time only + dd Mon yyy for date only + Day,dd Mon yyyy.hh:mm:ss for full date and time + + Where: + + Day is the abbreviated weekday name (Mon, Tue, etc). + dd is the day of the month (01, 02, etc). + Mon is the abbreviated month name (Jan, Feb ,etc). + yyyy is the year (2003, 2004, etc). + hh is hours (00 to 23). + mm is minutes (00 to 59). + ss is seconds (00 to 59). + + The host may support other formats for functions such as setting alarms, + synchronising sources, and other purposes. + + VDU exp[,|;[exp...]][|] + Sends a list of numeric arguments to the VDU. A 16-bit value can be sent + if the value is followed by a ';'. It is sent as a pair of characters, + least significant byte first. If the expression list is terminated with | + then nine following zeros are sent. + + +13. I/O Functions + + ADVAL channel + Returns information about input devices such as a joystick or mouse, if + fitted, or the number of free spaces in a buffer. + + ADVAL(0) joystick buttons ADVAL(-1) bytes in keyboard buffer + ADVAL(1) joystick 1 X-position ADVAL(-2) bytes in serial input buffer + ADVAL(2) joystick 1 Y-position ADVAL(-3) free space in serial output + ADVAL(3) joystick 2 X-position ADVAL(-4) free space in printer output + ADVAL(4) joystick 2 Y-position ADVAL(-5) free space in chn 0 SOUND queue + ADVAL(-6) free space in chn 1 SOUND queue + ADVAL(7) mouse X position ADVAL(-7) free space in chn 2 SOUND queue + ADVAL(8) mouse Y position ADVAL(-8) free space in chn 3 SOUND queue + ADVAL(-9) bytes in mouse input buffer + ADVAL(-10) bytes in MIDI input buffer + ADVAL(-11) free space in MIDI output buffer + + GET/GET$ + Waits for keypress and returns ASCII value or one-character string. + + GET(port) + Reads a value from the specified I/O port. + + GET(x,y)/GET$(x,y) + Reads a character from the specified character position. + + INKEY/INKEY$ exp + With a positive argument waits for the specified maximum time in + centiseconds for a character from the current input stream, or returns "" + or -1 if no key pressed. With a negative argument returns the host type + or checks for an individual keypress. + + MODE + Returns current screen mode. + + POINT(x,y) + Returns the colour of the screen at the coordinates specified. If the + point is outside the graphics window, then -1 is returned. + + POS + Returns the current horizontal position of the text cursor on the screen. + The left hand column is 0 and the right hand column is one fewer than the + number of text columns in the current display MODE. + + QUIT + Returns FALSE if running in interactive/editing mode, returns TRUE if a + program has been CHAINed from the command line. + + TIME + Returns the system elapsed time clock in centiseconds. + + TIME$ + Reads the system real-time clock, returning a 24-character string in the + following format: + + Day,dd Mon yyyy.hh:mm:ss + + Where: + + Day is the abbreviated weekday name (Mon, Tue, etc). + dd is the day of the month (01, 02, etc). + Mon is the abbreviated month name (Jan, Feb ,etc). + yyyy is the year (2003, 2004, etc). + hh is hours (00 to 23). + mm is minutes (00 to 59). + ss is seconds (00 to 59). + + If no real-time clock is available, a null string is returned. + + VDU num + Returns the VDU variable at offset num. + + VPOS + Returns the vertical position of the text cursor. The top row is row 0 + and the bottom row is one fewer than the number of text rows in the + current display MODE. + + +14. File I/O Commands + + BPUT#chan,exp + Write least-significant byte of exp to output stream. + + BPUT#chan,string[;] + Write string to output stream, followed by if ';' not present. + + CHAIN string + Load and run a program. + + CLOSE#chn + Closes the specified channel. IF chn=0 close all files. + + EXT#chn=exp + Sets the extent of an open file. + + INPUT#chn,var[,var...] + Reads data from an opened file with multiple calls to BGET. + + PRINT#chn,exp[,exp...] + Writes data to an opened file with multiple calls to BPUT. + + PTR#chn=exp + Sets the current pointer for an open file. + + RUN string + Load and run program. + +15. File I/O Functions + + BGET#chn + Reads a byte from a channel previously opened with OPENIN or OPENUP. + + EOF#chn + Returns TRUE if at the end of the opened file specified by the handle. + + EXT#chn + Returns the total length of the opened file specified by the handle. + + GET$#chn + Read a - or -terminated string from an open file. + + OPENIN string + Opens a file for reading and returns the channel number of the file. A + returned value of zero signifies that the specified file was not found, + or could not be opened for some other reason. + + OPENOUT string + Opens a file for writing and returns the channel number of the file. If + the specified file does not exist it is created. If the specified file + already exists it is truncated to zero length and all the data in the + file is lost. A returned value of zero indicates that the specified file + could not be created. + + OPENUP string + Opens a file for update (reading and writing) and returns the channel + number of the file. A returned value of zero signifies that the specified + file was not found on the disk, or could not be opened for some other + reason. + + PTR#chn + Returns the current pointer for an open file. + + +16. Print Formatting + + By default, strings are printed left-justified and numbers are printed + right-justified in a print zone. Numeric quantities will be printed left- + justified if preceded by a semicolon (;). A comma (,) causes a tab to the + beginning of the next print zone, unless the cursor is already at the + start of a zone. An apostrophe (') in a PRINT or INPUT statement forces a + new-line. A trailing semicolon in a PRINT statement suppresses the + new-line. TAB(x), TAB(x,y) and SPC(n) may be used in PRINT and INPUT + statements to position the cursor. A tilde (~) causes numbers to be + printed in hex, an equals (=) causes numbers to be printed in octal, and + a slash (/) causes numbers to be printed in binary. + + The variable @% controls numeric formatting as follows: + + LS byte: Width of print zone, 0-255. Normally 10. + Byte 2 : Number of significant figures or decimal places. Maximum 10. + Byte 3 : Print format type: 0 - General format (default) + 1 - Exponential format + 2 - Fixed format. + MS byte: STR$ flag. If zero then STR$ formats in G9 mode. If nonzero + zero then STR$ formats according to bytes 2 & 3 of @%. + + Examples Result + @%=&2010A 01234567890123456789 + + PRINT "HELLO",8 HELLO 8.0 + PRINT "HELLO" 8 HELLO 8.0 + PRINT "HELLO";8 HELLO8.0 + PRINT "HELLO",;8 HELLO 8.0 + + Value G9 G2 E2 F2 + @%=&90A @%=&20A @%=&1020A @%=&2020A + + .001 1E-3 1E-3 1.0E-3 0.00 + .006 6E-3 6E-3 6.0E-3 0.01 + .01 1E-2 1E-2 1.0E-2 0.01 + .1 0.1 0.1 1.0E-1 0.10 + 1 1 1 1.0E0 1.00 + 10 10 10 1.0E1 10.00 + 100 100 1E2 1.0E2 100.00 + 1000 1000 1E3 1.0E3 1000.00 + + +17. Error codes + + Immediate mode only: + 0 Silly 0 RENUMBER space 0 LINE space + + Untrappable: + 0 No room 0 Sorry 0 STOP + Bad program + + Trappable: + 4 Mistake 4 Missing = 5 Missing , + 6 Type mismatch 7 Not in a function 9 Missing " + 10 Bad DIM 11 DIM space 12 Not LOCAL + 13 Not in a PROC 14 Array 15 Subscript + 16 Syntax error 17 Escape 18 Division by zero + 19 String too long 20 Too big 21 -ve root + 22 Log range 23 Accuracy lost 24 Exp range + 26 No such variable 27 Missing ) 28 Bad HEX, OCT or BIN + 29 No such FN/PROC 30 Bad call 31 Arguments + 32 Not in a FOR loop 33 Can't match FOR 34 Bad FOR variable + 35 Bad STEP 36 Missing TO 37 No room for FN/PROC + 38 No GOSUB 39 ON syntax 40 ON range + 41 No such line 42 Out of DATA 43 No REPEAT + 44 No room for FOR/REPEAT 45 Missing # 54 ERROR/DATA not LOCAL + + 190 Directory full 192 Too many open files 192 Can't save file + 196 File exists 198 Disk full 200 Close error + 202 Data lost 204 Bad name 214 File not found + 222 Channel 223 End of file 242 Bad memory access + 243 Bad word access 253 Bad string 254 Bad command + + +18. Indirection operators + + Indirection is the process which is provided by PEEK and POKE in other + dialects of BASIC. There are three indirection operators: + + Name Purpose No. of bytes affected + ? query byte indirection operator 1 + ! pling word indirection operator 4 + | bar real indirection operator 5 + $ dollar cr-string indirection operator 1 to 256 + $$ double-dollar null-string indirection operator 1 to 256 + + Y=PEEK(X) is equivalent to Y=?X + POKE X,Y is equivalent to ?X=Y + + ! acts on four successive bytes. For example, !M=&12345678 would load &78 + into address M, &56 into address M+1, &34 into address M+2 and &12 into + address M+3. + + | acts on five successive bytes. For example, |M=0.5 would load &00 into + address M, &00 into address M+1, &00 into address M+2, &20 into address + M+3 and &82 into address M+4. + + $ writes a string followed by carriage return, CHR$13, into memory at a + specified address, e.g. $M="ABCDEF" will place the ASCII characters A to + F in locations M to M+5 and will load &0D into address M+6. + + $$ writes a string followed by a null, CHR$0, into memory at a specified + address, e.g. $$M="ABCDEF" will place the ASCII characters A to F in + locations M to M+5 and will load &00 into address M+6. + + Query (?) and pling (!) can also be used as binary operators, e.g. M?3 + means "the contents of memory location M+3". The left-hand operand must + be a variable, not a constant. + + The power of indirection operators is in the way they can be used to + create your own data structures. For example you may need a structure + consisting of a 10 character string, an 8-bit number and a reference to a + similar structure. If M is the address of the start of the structure + then: + + $M is the string + M?11 is the 8-bit number + M!12 is the address of the related structure. + + In this way you can create and manipulate linked lists and tree + structures in memory, very easily. + + A 5-byte real can hold a 4-byte integer with the real exponent set to + zero and the mantissa holding the integer value. The mantissa is stored + in memory in the lower four bytes so that if |address is an integer, then + !address will return it. For example, if you do |address=A% then !address + will return A%. + + Similarly, a 4-byte integer can hold an 8-bit byte with the top 23 bits + clear. The lowest byte is stored in the lowest memory address so that if + !address is a byte, then ?address will return it. For example, if you do + !address=A% and A% is an 8-bit byte then ?address will return A%. + + +19. Access to machine code + + The USR function and the CALL statement provide a flexible interface + between BASIC and machine code routines. Both USR and CALL initialise + the PDP11's registers prior to the machine-code call as follows: + + R0 register = A% + R1 register = B% + R2 register = C% + R3 register = D% + R4 register = E% + R5 register = F% + R6 register = stack with return address at the top + R7 register = entry point of machine code routine + + USR address + Calls the machine-code routine and returns a 32-bit integer made + up of the contents of R0 and R1 (least-significant to most- + significant) on return from the routine. + + CALL address[,parameter list] + Sets up a parameter block on the stack containing details of the + parameters, along with a return address, in the following format: + + Return address 2 bytes at (sp) + BASIC return address 2 bytes at 2(sp) + + Number of parameters 2 bytes at 4(sp) + + Parameter type 2 bytes at 6(sp) + Parameter address 2 bytes at 8(sp) + + Parameter type ) repeated as often as necessary + Parameter address ) + + The parameter types are: + + Code No. Parameter Type Example + &0001 Byte (8 bits) ?A% or A%?num + &0004 Word (32 bits) !A% or A% or A%!num or A%(...) + &0005 Real (40 bits) |A or A or A(...) + &8000 Movable string A$ or A$(...) + &8100 Fixed cr-string $A% + &8200 Fixed null-string $$A% + + Parameters are passed by reference and may be changed by the machine-code + routine. + + Except in the case of a movable string (normal string variable), the + parameter address given is the absolute address at which the item is + stored. In the case of movable strings (type &8000) it is the address of + a 4-byte parameter block containing the start address of the string (LSB + first), the current length and the maximum length in that order. + + Integer variables are stored in twos complement form with their least + significant byte first. + + CR-terminated fixed strings are stored as the characters of the string + followed by a carriage return (&0D). + + Null-terminated fixed strings are stored as the characters of the string + followed by a null (&00). + + Floating point variables are stored in binary floating point format with + their least significant byte first; the fifth byte is the exponent. The + mantissa is stored as a binary fraction in sign and magnitude format. Bit + 7 of the most significant byte is the sign bit and, for the purposes of + calculating the magnitude of the number, this bit is assumed to be set to + one. The exponent is stored as an integer in excess 128 format (to find + the exponent subtract 128 from the value in the fifth byte). + + If the exponent byte of a floating point number is zero, the number is an + integer stored in integer format in the mantissa bytes. Thus an integer + can be represented in two different ways in a real variable. For example + the value +10 can be stored as: + + address +0 +1 +2 +3 +4 + 0A 00 00 00 00 Integer 10 + 00 00 00 20 83 (1 + 0.25) * 2^3 + + USR or a CALL to an address in the &FF00-&FFFF range accesses various OS + functions as detailed in section 20. + + +20. Operating system interface + + All Operating System ("star") commands are passed to the host to + implement. The *QUIT command is checked for to exit the current program. + + CALLs and USRs to addresses in the range &FF00 to &FFFF provide access to + the machine operating system, as with the BBC microcomputer. The + PDP11's R0, R1 and R2 registers are initialised to the integer variables + A%, X% and Y% respectively. If X%<256, then R1 is set to X%+256*Y%. If + calling OSARGS, OSBGET or OSBPUT, then R1 is set to Y% and R2 is set to + X%. + + In the case of USR, the returned 32-bit value is composed of the PDP11's + R2, R1 and R0 registers corresponding to the 6502's Y, X and A registers, + most significant to least significant, as follows: + + b0-b7 = R0 + b8-b15 = R1 + b16-b23 = R2 + b24 = Carry flag + + +21. The VDU system + + Control Characters: + + The following VDU codes are defined. BBC BASIC itself does not implement + the actions specified, it just issues the byte sequence. The output from + BBC BASIC can be piped into a suitable VDU driver to implement the VDU + sequences with a command such as bbcbasic | ansi. The RT11 version of + BBC BASIC includes an ANSI text and colour driver. + + VDU 0 Null. + + VDU 1,n Send byte to raw output, bypassing VDU driver. + + VDU 2 Enable printer. + + VDU 3 Disable printer. + + VDU 4 Causes text to be written at the text cursor. + + VDU 5 Causes text to be written at the graphics cursor. + + VDU 6 Enables VDU output. Cancels the effect of VDU 21. + + VDU 7 Causes a "beep". + + VDU 8 Moves the text cursor left one character. + + VDU 9 Moves the text cursor right one character. + + VDU 10 Moves the text cursor down one line. + + VDU 11 Moves the text cursor up one line. + + VDU 12 CLS: Clears the text window to the current text background + colour and moves the text cursor to (0,0). + + VDU 13 Moves the text cursor to the left-hand edge of the window, but + does not move it vertically. + + VDU 14 Enter paged mode. + + VDU 15 Stop paging. + + VDU 16 CLG: Clears the graphics window using the current background + GCOL action and colour. + + VDU 17,n COLOUR n: Sets the text foreground, background or border colour. + COLOUR &00+n sets the text foreground colour where supported. + COLOUR &40+n sets any text extension colour where supported. + COLOUR &80+n sets the text background colour where supported. + COLOUR &C0+n sets the border colour where supported. + The colour n is %fibgr: flash, bright, blue, green, red. + + VDU 18,a,c + GCOL a,c: Sets the graphics colour and plot action. The colour + numbers are as for VDU 17. + + VDU 19,l,p,r,g,b + Sets the logical to physical colour mapping. + + VDU 20 Sets text and graphics colours to their default values + (background black, foreground white) and resets the palette. + + VDU 21 Disable VDU output. All VDU commands except 6 are ignored. + + VDU 22,n MODE n: Selects a new screen mode and resets all screen driver + variables (colours, palette, windows, cursor positions, graphics + origin etc.). + + VDU 23,n,r1,r2,r3,r4,r5,r6,r7,r8 + Program user-defined graphics characters, and various VDU + functions. + + VDU 24,leftx;bottomy;rightx;topy; + Define graphics window. + + VDU 25,n,x;y; + PLOT k,x,y: Performs a PLOT action. + + VDU 26 Reset text and graphics windows to their default positions + (filling the whole screen), home text cursor, move graphics + cursor to 0,0 and reset the graphics origin to 0,0. + + VDU 27 Do nothing. The native VDU system may interpret any following + characters. + + VDU 28,leftx,bottomy,rightx,topy + Set a text window. The text cursor is moved to the new home + position. + + VDU 29,x;y; + Move the graphics origin to the specified coordinates. + + VDU 30 Home the text cursor, to the top-left hand corner of the text + window. + + VDU 31,x,y + TAB(x,y): Moves the cursor to the position (x,y) if within the + text window. If the coordinates are invalid they are ignored. + + VDU 127 Backspace the cursor by one position and delete the character + there. + + +22. Operating System Commands + + The following commands are implemented by the host code that interfaces + BBC BASIC to the host system. + + *| comment Everything after the | is ignored. + + */filename [parameters] Run the specified file. + + *HELP Displays help message. + + *QUIT Return to calling process, if supported. + + *ESC [ON|OFF] Enables or disables the Escape key. + + *LOAD filename [addr] Loads data into memory. If the host supports + load addresses the hex addr can be omitted. + + *SAVE filename start end [exec [load]] + *SAVE filename start+length [exec [load]] + Save data from memory to disk, from the start + to the byte before end. If the host does not + support load/execution addresses, they are + ignored. Addresses are all specified in hex. + + If a *command is not recognised, it is passed to the host to execute. + + A "star" command cannot contain variable names and must be the last item + on a program line. To include a variable name use the OSCLI statement, + e.g. to delete a file whose name is known only at run time: + + OSCLI "rm "+filename$ + + +23. Random access files + + BBC BASIC supports both random access and the ability to modify (update) + a previously written file. Random access is performed by a single pointer + (PTR#chn) which can be positioned anywhere in the file. The pointer is + automatically incremented after every read or write operation (using + BGET#, BPUT#, INPUT# or PRINT#). + + Examples: + + 100 REM Read a file backwards + 110 in%=OPENIN(filename$):size=EXT#in% + 120 FOR point=size-1 TO 0 STEP -1 + 130 PTR#in%=point : PRINT CHR$(BGET#in%); + 140 NEXT : CLOSE #in% + + 100 REM Update a "record" in a random-access file + 110 in%=OPENUP(filename$) + 120 PTR#in%=record_number*record_length + 130 PRINT #in%,new_data,new_data$ + 140 CLOSE #in% + + +24. Host Environment + + The host system can be identified in several ways: + + A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256 returns 8 when running on UNIX to + indicate UNIX and UNIX style pathnames directory/filename.ext. It returns + &2B if running on RSTS/RT11/UKNC to indicate D:filename.ext pathnames. + + If OSBYTE 0 returns 8, then INKEY-256 returns: + &FE: NetBSD &F6: OpenBSD + &FB: BeOS &F5: Amiga + &F9: Linux &F4: GNU FreeBSD + &F8: MacOS &F3: GNU + &F7: FreeBSD + &Bx: PDP11 Unix, &B5=Unix v5, &B6=Unix v6, &B7=Unix v7, &B8=Unix v8 + &B9=BSD2.9, &BB=BSD2.11 + (interim: &B0=RT11/RSX/RSTS) + + If OSBYTE 0 returns 8, then A%=0:Y%=0:fs%=(USR&FFDA)AND&FF will return 24 + to indicate a UNIX filing system. + + [OPT 0:NOP:] assembles &A0 to identify the CPU as a PDP11. + + +25. Technical notes + + Some ARM BASIC V double-tokens are recognised internally, but are listed + as the single-token components. + + Internal memory: + ^@%-512 : String buffer, can be fetched with $(^@%-512) or $(PAGE-&300) + ^@%-256 : Input buffer, can be fetched with $(^@%-256) or $(PAGE-&200) + ^@% : Integer variables + ^@%+108 : Pointers to dynamic variables + ^@%+242 : Memory structure pointers + ^@%+256 : Default PAGE + + A%=EVAL("0:"+text$):token$=$(^@%-510) + will tokenise text$ and put it in token$. diff --git a/docs/keymap b/docs/keymap new file mode 100644 index 0000000..76001e7 --- /dev/null +++ b/docs/keymap @@ -0,0 +1,51 @@ + PDP11 BBC BASIC Keymap + ====================== +Where it is possible to read function and editing keys, on non-Acorn systems they are +returned using a regular keymapping. Where keypad keys can be read they will be returned +as &100+x if read with ADVAL. + ++===+=====+=====+===+====+===+====+====+====+=====+====+=====+=====+====+====+====+====+ +| | x0 | x1 | x2| x3 | x4| x5 | x6 | x7 | x8 | x9 | xA | xB | xC | xD | xE | xF | ++===+=====+=====+===+====+===+====+====+====+=====+====+=====+=====+====+====+====+====+ +|10x| | | | | | | | | | | | | |KPentr| | | ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|12x| | | | | | | | | | | KP* | KP+ | KP,| KP-| KP.| KP/| ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|13x| KP0 | KP1 |KP2| KP3|KP4| KP5| KP6| KP7| KP8 | KP9| | | | | | | ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|18x| F0 | F1 | F2| F3 | F4| F5 | F6 | F7 | F8 | F9 | F10 | F11 | F12| F13| F14| F15| +| | Prnt| | | | | | | | | | | | | Num| Scr| Brk| ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|19x| sF0 | sF1 |sF2|sF3 |sF4|sF5 | sF6| sF7| sF8 | sF9| sF10| sF11|sF12|sF13|sF14|sF15| +| |sPrnt| | | | | | | | | | | | |sNum|sScr|sBrk| ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|1Ax| cF0 | cF1 |cF2|cF3 |cF4|cF5 | cF6| cF7| cF8 | cF9| cF10| cF11|cF12|cF13|cF14|cF15| +| |cPrnt| | | | | | | | | | | | |cNum|cScr|cBrk| ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|1Bx| aF0 | aF1 |aF2|aF3 |aF4|aF5 | aF6| aF7| aF8 | aF9| aF10| aF11|aF12|aF13|aF14|aF15| +| |aPrnt| | | | | | | | | | | | |aNum|aScr|aBrk| ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|1Cx| WinL| Menu| | | | | Ins| Del| Home| End| PgDn| PgUp| <- | -> | Dn | Up | +| |sWinR| | | | | | | | | | | | | | | | ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|1Dx|sWinL|sMenu| | | |sTAB|sIns|sDel|sHome|sEnd|sPgDn|sPgUp| s<-| s->| sDn| sUp| +| | WinR| | | | | | | | | | | | | | | | ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|1Ex|cWinL|cMenu| | | |cTAB|cIns|cDel|cHome|cEnd|cPgDn|cPgUp| c<-| c->| cDn| cUp| +| |aWinR| | | | | | | | | | | | | | | | ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ +|1Fx|aWinL|aMenu| | | |aTAB|aIns|aDel|aHome|aEnd|aPgDn|aPgUp| a<-| a->| aDn| aUp| +| |cWinR| | | | | | | | | | | | | | | | ++---+-----+-----+---+----+---+----+----+----+-----+----+-----+-----+----+----+----+----+ + +INKEY and GET return an 8-bit value, ADVAL(127) returns a 16-bit value &100+key. + +Whether particular keypresses are passed to BASIC depends on the particular platform. In +particular, some systems don't return distinct values for shift or ctrl pressed with a +key. For example, on some systems Shift-f1 onwards returns f11 onwards. This results in +the extension of the function keys from f11 onwards being duplicated as Shift-f1 onwards: + + +-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+ +key | f1 | f2 | f3 | f4 | | f5 | f6 | f7 | f8 | | f9 | f10 | f11 | f12 | |Print|Scrl |Break| +sft | f11 | f12 |Print|Scrl | |Break| Win | Menu|Japan| |Japan|Japan| f11 | f12 | |Print|Scrl |Break| + +-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+-----+ +-----+-----+-----+ diff --git a/docs/read.me b/docs/read.me new file mode 100644 index 0000000..16c3ad8 --- /dev/null +++ b/docs/read.me @@ -0,0 +1,32 @@ + BBC BASIC for the PDP11 + ======================= + J.G.Harston, 70 Camm Street, Walkley, Sheffield, S6 3TR + mdfs.net/Software/PDP11/BBCBasic + Date: 10-May-2025 + +This is a PDP11 implementation of the BBC BASIC programming language. It +implements BBC BASIC IV, with a few additions from BBC BASIC V. + +Communication with the host system is via Unix TRAP, RT11/RSTS EMT or Tube +EMT instructions. + +BBC BASIC is started with 'bbcbasic', 'RUN BASIC' or 'BASIC'. *QUIT will +return to the calling process, *HELP will report the current host interface +version. + +A filename may be passed on the command line, where it is loaded and run as +though CHAINed. If the first byte of a loaded file is '#' any following +bytes up to a control character are ignored, and any following data is +loaded as untokenised program code. This allows a text file to start with, +for example: + + #! bbcbasic + +On Unix you can pipe the output through a supplied 'ansi' command which will +translate output sequences to ANSI terminal control sequences, for example: + + bbcbasic | ansi + +Calls to BBC MOS entries at &FF00-&FFFF are translated to appropriate host +calls. [NOP] assembles a &A0 to identify the CPU as a PDP11. + diff --git a/docs/read2.me b/docs/read2.me new file mode 100644 index 0000000..fe4d4bc --- /dev/null +++ b/docs/read2.me @@ -0,0 +1,187 @@ + BBC BASIC for the PDP11 + ======================= + Implementation Notes + Date: 10-May-2025 + +This is a PDP11 implementation of the BBC BASIC programming language. It +implements BBC BASIC IV, with a few additions from BBC BASIC V. It requires +a PDP11 with the MUL, XOR and SXT instructions, such as PDP11/23 or better. + +BASIC V extensions +------------------ +The following extensions are implemented: + =END =GET$#chn =MODE =QUIT + =REPORT$ =VDU n =^variable BPUT#chn,s$[;] + %binary &oOctal @Octal ERROR [EXT] n,s$ + =STR$= =STR$/ COLOUR l,p COLOUR l,r,g,b + OFF ON SOUND OFF SOUND ON + GCOL c PLOT x,y QUIT [n] RUN s$ + +Implementation notes, v0.45 +--------------------------- +The following are not yet implemented: +* Negative and non-integer exponents (eg A=2E-4 and A=3^2.5) +* All Trig/Log: SIN COS TAN ASN ACS ATN DEG RAD EXP LOG LN real^ realSQR +* @% is ignored when converting numbers to string, float conversion is fixed + at &000009xx, that is General to 9 significant figures, integer is fixed + at &00000Axx, that is General to 10 digits. +* Real numbers larger than 999999999 do not print correctly. + +LOCAL ERROR/DATA cannot be used inside FOR/NEXT or REPEAT/UNTIL loops. It +can only be used within PROC/FN immediately after any LOCAL variables. INPUT +acts the same as INPUT LINE. + +The binary image ends with a &0000 word. An embedded BASIC program can be +appended to the binary image by replacing the &0000 word with the length of +the BASIC program, appending the empty workspace and the BASIC program to +the end of the image, and setting the "Initialised Data" word in the Unix +header to the size of the whole image including the BASIC program. This is +currently not implemented on RSTS/RT11. + + + Platform-Specific Information + ============================= +All platform-specific operations are passed to a Host module. This can be +rewritten to target any other platform without touching the interpreter +itself. + +PDP11 Unix +---------- +When running on PDP11 Unix: +* OSBYTE 0,1 returns X=8, indicating filenames are '/directory/file.ext'. +* INKEY-256 returns &Bx to indicate a PDP11, with: + &B4 for Unix v4 &B5 for Unix v5 &B6 for Unix v6 + &B7 for Unix v7 &B9 for BSD2.9 &BB for BSD2.11 +* When using a Unix filing system OSARGS 0,0 returns 24. + +The 'ansi' tool translates BBC VDU sequences to ANSI text positioning and +colour codes, so running 'bbcbasic | ansi' will allow ANSI text control +where supported. To support a graphics display a similar piped output tool +can be used. + +Unix before version 7 does not return information from the seek() call, so +consequently, reading PTR, EXT and EOF do not work from BASIC. + +Currently the BSD2.9 keyboard queue is not detected, so function/editing +keys are not correctly returned. + +PDP11 RT11/RSTS +--------------- +When running on RSTS/RT11/UKNC: +* INKEY-256 returns &B0 for "Generic PDP11" or &B1 for UKNC. +* OSBYTE 0,1 returns &2B to indicate 'd:fname.ext' filenames. + +The RT11 HostIO interface includes a driver for ANSI text positioning and +colour supports the VT52, VT100 and UKNC/Electronica. + +The RT11/RSTS OS interface currently only implements: +* LOAD, SAVE, CHAIN - implemented +* OPENIN, OPENOUT, OPENUP, CLOSE - implemented +* BGET, BPUT, GBPB - not yet implemented +* PTR, EXT, EOF - not yet implemented +* The only OSCLI/*command currently implemented is '*.' + +VDU implementation +------------------ +With BBC BASIC, VDU commands are send straight to the host's VDU driver. On +RT11/RSTS, or on Unix piping output through 'ansi', VDU control codes are +translated to the appropriate ANSI sequences to select text positioning and +colours. A lot of testing and experimentation has been done to work out the +best translation of VDU code to native control sequences to get as close an +implementation as possible. + +VDU 0 - Null VDU 12 - CLS VDU 24 +VDU 1,n - Raw output VDU 13 - Carriage return VDU 25 +VDU 2 VDU 14 VDU 26 +VDU 3 VDU 15 VDU 27 +VDU 4 VDU 16 VDU 28 +VDU 5 VDU 17,n - COLOUR n VDU 29 +VDU 6 VDU 18 VDU 30 - HOME +VDU 7 - BELL VDU 19 VDU 31,x,y - TAB(x,y) +VDU 8 - LEFT VDU 20 - Select default colours VDU 127 - DELETE +VDU 9 - RIGHT VDU 21 +VDU 10 - DOWN VDU 22,n - MODE n +VDU 11 - UP VDU 23 + +Where supported: + COLOUR &00+n sets the text foreground colour + COLOUR &40+n sets any extension colour + COLOUR &80+n sets the text background colour + COLOUR &C0+n sets the border colour +Colour numbers are the standard %LxxFIBGR. + +VDU 1,n sends the character n directly to the host's TTYOUT output, bypassing +any VDU driver. VDU 27 can be used to introduce a host CSI sequence. + +UKNC VDU driver +~~~~~~~~~~~~~~~ +MODE n selects a 80x24, 40x24 or 20x24 screen mode: + 0: 80x24 3: 80x24 6: 40x24 + 1: 40x24 4: 40x24 7: 40x24 + 2: 20x24 5: 20x24 +The UKNC has 8 colours in every screen mode. +COLOUR &40+n sets the cursor colour. +VDU 14 selects Cyrillic characters, VDU 15 selects Latin characters. + +Top-bit-set characters are sent directly to CONOUT bypassing the 7-bit filter +on TTYOUT, allowing the full character set and top-bit CSI sequences to be +used, eg VDU 27,164 to turn underline on. + +Keyboard input +-------------- +The keyboard mapping is that indicated by the Host OS value returned by +OSBYTE 0,1 and INKEY-256. +* For Hosts OS 0-7 it is the RISC OS "semi-regular" mapping: + function keys f0-f9 are &80-&89 + function keys f10-f12 are &CA-&CC + editing keys are &8B-&8F for Copy,Left,Right,Down,Up +* For other hosts it is the "regular" mapping: + function keys are &80-&8F for f0 to f15 + editing keys are &C6-&CF for Ins,Del,Home,End,PgDn,PgUp,Left,Right,Down,Up +* Shift and Ctrl modify the top-bit keycodes by XORing with &10 and &20. + +Where supported by the hardware/operating system: +* EOF#0 returns FALSE if there are keypresses pending. +* ADVAL(-1) will return non-zero if there are entries in the keyboard buffer. +* ADVAL(127) will wait for and return a 16-bit keypress. +* INKEY(&8000+n) will wait up to n centiseconds and return a 16-bit keypress. + +16-bit keypresses return &100+n for function and editing keys. + +Escape processing +----------------- +Testing for the Escape key can be disabled with *ESC OFF and enabled with +*ESC ON. Only Unix v7 allows the Escape key to be tested in the background. +On Unix v6, Unix v5 and RT11 the Escape key has to be polled in the +foreground. To avoid slowing the interpreter excessively, this polling is +only done once every 256 tests. Testing has shown this slows the interpreter +down about 1%-2% compared to never checking for Escape. LIST checks for +Escape at the end of every displayed line. + +Porting to other platforms +-------------------------- +PDP11 BBC BASIC will run on any PDP11 platform. The interpreter communicates +with the platform it is running on via a platform-dependant Host module. BBC +BASIC can be ported to another platform by simply writing an appropriate +IOHost module and, if neccessary, a target-specific header. See the existing +UnixIO, TubeIO and RT11IO modules and headers as a starting point. + +PDP11 CPU Requirements +---------------------- +PDP11 BBC BASIC requires the PDP11 instructions: XOR, MUL, SXT, so this +requires a PDP11/23 or better. The Unix version of BASIC is written to run +on a minimum of PDP11 Unix Version 4, as it needs the indir() and signal() +system calls. + +Machine code interface +---------------------- +MOS calls to &FFxx are translated to the correct EMT or TRAP calls for the +host being run on. There is currently no built-in way to directly make EMT +or SYS calls, but you can do so by manually building a bit of code in memory +and calling it. For example, to call EMT 0 (OSQUIT) you could do: + + !END=&878800:CALL END + +This pokes EMT 0:RTS PC into memory just above the heap, then calls it. As +long as you do not create any new variables or strings between poking and +reading, data poked at END is unchanged between statements. diff --git a/rt11/basic.sav b/rt11/basic.sav new file mode 100644 index 0000000000000000000000000000000000000000..c538e8824d709d1f12859f2b371c79b1dfbc039b GIT binary patch literal 16370 zcmdUWdw3L8n)j(wolbXkCsZXV8VIdLNHVAa0|KpvflfLN#EnTNBxH7UoCHafSp*i) zpv&WQ=h7V$WTO&cT^J*`bzSvyTnAj&ovprvL1Yk7(RCOmDr685LVy&Pkp6yeHO%by z*Z%iC&%)EEs!p9cm-oEy@4cNc_CNgNjC-rlX5s(P?tjVa1pWJ8GS~kf(=_Zm@AAlB z_?qS8zWK7DO7=4)x*FhAr>g>ss8>r2`_r>L(jlKmI*8wUKBH@&PYT9W=5y^xV|LN_ zEWqCJHM0zxVV^&(nWf`8YON}*nm%1CDe-9~#f!>(TG?W4apUSW%T}(?3a8DyTboi{ zGkyAPX;XZ+X}*=Ko?N}`kw@2R_f1*IMWaVqRlBww5AQJ62H zrZB_4HA7c5T*uCeUZDcJ-#QYdm?EU>A9_ytE{!#vJKltkJ@v?!_emIaDH{8l`FL+%N}7Yu1ZW)4Ey5L3~>N+vZkC1x2lGHW~!^VfW5+O zyj{x2`?HpB!lKfq{)&ZJaYbo>7ndyB#EX54dU$c^;^OibdGR9OW)u}$cyUd|Kk(w( zn#z5=WP!itC9$Ncw&t@`UuAh^ZS^&)ueiMYsMWWyxUAxHT&i>bgZs+;#noSkzVgaN z{{Kq#l`r@b_ltfn`YIRwBllI-R@7|8eR(CmE-kJpK2}odU$Bjr`se=vMY+Gm|65*K zwm695{^Qot>f*XTTKyHJRn?WguSDGRqgd=OudMQaZS|Kg@^{(%m~t=oSC{`%^jB9` zR<|>M<@`R;Us>IP+Ul1@|BtI);r<`jY!~NOR)1riUyRRoi1RCU<}9eJsXUpEb>;qs zquj+8R4%G5Ig!2q6CAKEEW6)-{|m0N3M~1QwQT;MtYsB{<^Sv4|K#R%H!d}=qF7W@ zJ>{QxdD)_x4^US4L%h7QxOBg@yb|9(?<%hZl}=mB{qt*br|7)gU-8c%6kO^h2?-;;glD{`@en ztZw5VLq%D|M)O)(Tl1!QQ(N^0uUzCSFH2afsxim&)~ezK{%%)QP4(Zqs>=S4SXEwG zGia@<#JeePaU$(depTh7Ux`@gAztmTsjaTKELQug{KYkw@LW|{T{Dd5;?fJ&YXAKg zOR8%tu87serElZqqMFKTzmZ;DwqPOF7vby6}9)5_^S`{MK%7a4!)>(vHy40 zMGGq4;fu;De$5yCsCo}yRONdH@2hiTRF+jN$ej}Bi@+hJpIXst)m5>kxMDA_S?I6W zV5_Nom)8`ROzGq`)x|#lNO}!+=Q&qRb*=y3L@-rZ`E_gUqU!hf;?ml4RDg9IOO`toD!5q9SYH#hkce*dyHYnH8eM0*x+o3BJw&Sb%`#{~}L zI5-z5SE_IObgo6L+oiGVVjtv)OWq!rW@jUKiq0Bj<9T$JjftXRf0GS`U0N}dQT~{v z0S^XQbQWhRJTgmW7EuRIMEzb?BDYIf-N%A1O=I_pQs`h$f}Q9|gABK+;#X03&D=0^ zX*o>f(Z&GVFGOeQtdG02ds#$uX}2>gM&#^$9#y^U--Ku_N9%lQt;+0IXst0PTF9u; z^SsQ4_557i73!1Xl8F1;b6*Zc{e^6+K$vix2^cjeTq1wk^DK)p?&Qv>|D%Lg*8TGm zyo#Q6HH-0ex+<~=6NM5v>emy|S})tw9bvj;U|bs`OnC*rn0i$#R=h7bdNVQCY0N3M zO8WEH1Fe!@Zk7IO$56=oLQoE~K1ts+8i+g}X6;g|^kLUP;KHv3Ca?>l_XVQiIneL{ zb|zG_$qzJ)OYDU{DJYvGbTx3j>t}%`If}7@@{z95K#Me^cQkQ@dpC(e!~QC}CInSN z$r;?RZ{TU+Cajca#2mlEUXWhk;iC?Wta@JvvxxhPIo_=TbM+>eES7BLOlP`3VIp{- z%A(mqUf{V7JQwP}6Lj=}Z=|}NY3w?$+nHcCF(?J4y6qY`!n<>b)B7OMH-iPGh+kj} zfXG{?Mckn|LCL!*8+_tTT*E%JOyejwPIGB#EFHAcSXy{*=Oc5Bt|fD9qVdLqa~_yu z!Tjr|c{+bIC(H)a1pTxoIjAsbhf`B|sG04azOT{B&I$q5a8I10&GAU%=6K`@b3D)A zI!6_C^=VLH_Eb-2=A1sab&gZq=N>Am+jSaz*C*|BpDN0i_A32FcM1F4$BLlM5=Pgl zB4;q}K3W9LZl9gd8rEvdm#t_do%xW%upgPKZ|f@}Y7j3i&c{r;_7quy9%*|~Gkf%M zGdp;PVLu3NH|)pKpk4DYQ@2OzEb4Qw!U%Ig=MC%{-dfS)YlXvtesW*J8rGc=^=XGt zU%aG@39_yhv8bBq4DP%j1|*kO%C7Q0XlEOT?DZ0*UA_0RD=5?0?Pgtqy(fCQvx}O0 z#ul|p5qCz>X)*4WiiAl6VO@OyW93f8K1jOyQ{0c6nzRDsshv{8; zJ*=NhO}5qw8Ashcc)4xEG8#*T4y*OPoqUL2Vk zia-LIz~{XagKCrFmv5qF-HsfVA;uhXfGNd5*TgScBwx?x*fml79Ja}2?5bh!WF!gq zvSy{}o_0u1+bG#BAA&*uH=kQrE~1_P=Z45}_Ig>kGRE-BCHl3h&NQZe>%w@b4yfj`q7X3cDgL#&F* zf)Y?S7cw!Qll5lF;IE5pd}y~EZM3n?8XAYO0$7@F-YqJv_4_m)Zf2)1wMsEaxgl@4 z+ortLEwUE%t!|F>)ohAN*Lj$2E==I53Qt#o%}fx*{lNM#vvtzyR%F+`kw{Eog|J;| z_T!{BN#N+yq472;j-GY*+`C!B_;93=31h>-Nm*gtU2wM`3k}V3?%ftyl(-a7O~gqU z_J!ApcAwm!-KlGi;Jrdk1UDW_3(dS ze^y=TB*VWNdykV6+d)&X^-ob1Um`d^7gc2&l0A#uvEph z--id}q~DQi70GS@=L73|pT#^}y*Xehah+i=xH1HqX=4THJ6zvQ!MyHhRX@dj)p&4r zV$KcDPQPBa<6Sln);uU|+tV$Wdm4wIMm$irqXQbB-qqN4%e32u{qWU3X+Zsk1>G`x zLXp{C<>D-&%i$|p#mcqXvK3l`_KmiD<;qn=+4rtY@-?jZ!CLLHhP4krs(nLsyRYQX zPJW|3(Xe`1!;{03*=u+MoL`fuHqj(10{+M&w`9Sr-F@!yNH zC&}yxwAko`-EJ#O{+vu#JJ5ECLh}lk-z^@Avl!kx&0la^CL=GdN!EM*jtx7Uj0g0d zC-F_b60Z`)c6SCOXisJa+t-+ZRoybnXyk0%Eb#wT;{SiW!T*P^z-q{>PzKaXXmxpJ z8KW6rVkwy2!OM5Rm%D^McUt3BDPmB4F>kN(DcZEVE$AIMHxpLFRp6I8?05CH!#eoH z;p#mGn}&Gl4p2Mpesv~MJV$JnUz-`mOgYOG18-QE%!6tRxVkHIqr6vn8olB@2z$~61WDt%oBz8#N7YzG83xmegEi}I~ z;$EfZt`w!29W}_qwFYQzIZ~?{Rat=WaW^c3oy;QaJ81mgr_ui1$vQMw;7x_vjgLa z`_jl3Gzh~iVzYAZjAnM9;gM#{Xg6E-i-ayG&E8G`T@3q~OFuZPtuZw>i#cwC4IQ5q zNaXRjV~kkbQ-@LV#kyXRO-2c;24w-efL7-@^D14%8t^{Sn+k-w=*R9gZNq zTWRADl{`0d=P>rr4jGD2ybKb8rFE<#a_^)fL%mc#LlD4f$sF$hahkJTqwUHeB^uNi0N$(4;-rHCX zX#K=c_OrKPWjbmKfJ26T=}^kE1*kclxCNuWiuxb2G}M<5S)TnNgSXo|2OLke9OYb- z>PHjgwO?hoivx}btY(`@&-E}UavjykLX&`^lvu|S)n)e*dbL%&2{Dvwt2A5qMZqs?!GsQNOHA|?0=D|Pyu zQRxb}k_Tgc7D!^(dgcz&YS*&y0lHpHkUeYTgwpFRt*Y4YAw@C1ib*a+OGd;vJo{D? zo!${ngOWcvZ>@Q9RipOUvNfiKK`60h$kjX9l=wO4r#?Fw(E!?+F04Kv449*>6TZf1 zRKNN(w1G*nHj`p4pcu`J-qnMm;FjW^ZeCA=v_o6ga4F2HWX z7^4<0Xil+R66zzhtC$xnIfHK`w8|IBGZ+PLOf-9gzQ_JdWmEBfKYlbC7s+y)V!po} zn%&iVrzwj;vu!JLq21OSZIALZX#1MkHtE4W#8UBYJ${?e*B(A3BvF6Hp#9k#b5#qSid~Qa&lJlLy_F#n%0r9D?Ln!mv zB$Qt8c|@HKJj!Facz%|Rfdpoqe>6n&+K!q#*fEsT*rOP?nSCucvk`%`|KOkzwnGY6 zVpmO%xwq1^VI!&sbJ{*Aqo3S!6UhQy=>KtnR_UwJR<71c$|{I=S_bnFw-SXoxb>DW zcU}wY{=tN$iuNP}dv|D*q-!c{cbWkq1g!{h{Xshr^)z%iTG#s=!$6VOPxWD~M2ReX zxe5N|@HzU{Fu$cZ%!zYJjrd-IR+6;B-y0!2d$&yeM%936kMEY_>hBK5)PvfSyzm$qB48HYRq4&`46M>>UEwCn9)qSvd z5Iv*#La!foCh_r%8}ooJN#w)gmsmb(SHah+N+oXKN(8Ypl4|<3Va>jJx(gEu1mJc4 z3AiA)NKtrJq5c*i_95U%zD(X&hUtxw1`b@ySK5H+!!l>P<$Spub<3{>Rp@z{kRF!c zFM{j-Ca8B=5!-yyjFjAA%4mc6YzgU&KLyoSnbuRj?9%qJ)DT5}=1!!@PXKy8q8@SU z>ONLsMt(l%x(55FYRpEpRiQjd3r3+GqU#QIpWG@#0uoq-ESl&|n!_r7YI@#Dzm&K< z49d0Q3u+r{Ou7JPekx^?<<;~JmXXvI*2T6%$_eFZ z+e1pX?Il~y$O$Pf@39@1j!9dUFQk`jZ%LiDjkZwgK}lC$w9UA9O5Pxsi|JQ)+uoDj zl|Hp?P&O)0OIOG2k-McMw&zoKN&~6A(oEZW+ZOxW)K}qXTjeTw25;iicqx0EPgADZ zej-0DA5H83?%XhAu+y>DNG)q~X-`AjP!7wb{SX#0?hr}76ZjNVNyEdsGP&ONy=k$) z~`+sMvW(LTrP>GvGu+hZw0X zWOWoHL(C$TRdo-mg)F&uha4vZFXln3@WVZYNsN*a@is9i=CA|~_dw$8W3NRWYs7px zU)rn%m=qdNnT8*tpRITsw;Yl#2%EK5mL4{BpC*L|AZ-JXx&c$-wp%tzUkj+aV?fPl z9#EIUS0HK15=lEo^ID)eNkg_k!;x3d_u2(A!2SB1f3uO#Ub8(5kDt!DEAv?U6$gtugua>3}ZjlCY%?@o;1k5COab z`}4&-px~&jGpZiARghW>IJ1TYWCPlAIIh-E+t;m*)-xPY$UtELtV!#>!?%W3bOE%vW zgR%#(8Hbr7h&nK*W~4;s^{tv1j>^10D2rN32pD^#Cql`jz9}@~;85!02<*JqFq3zO z$pW7_LOqI7+%Zl>TVE4!CXh+!QoRWhjcCXMu1iby!QyS1hOCXfvFtP z+o05om`Qs0)T%bRwd$LJ%x6f=G88fiz;7%itV7p+}QS){c{$u3{H;t^&d6rqtW z2kKpj9i9nMu9xi1V7)NO8j94%>nHsK#koX5F%gzLfpOPFlTu}@MLFUKW|0*8G$9<3 zgAx}u?X+{UzLQvs2&LrHQbdaX@K7AFDe`-=t~EisI)$j?cn~oTBkFiB=;RcafGLNF z1o>aBje6Hg*mQ*HHqhYWCD@u*gL0%w_|f;G>C>;Jfo-YP^5;Gyi% zz^9?4g(*OS3?bqyb@&`QBCr%^U1!`JMGUnz{)!0#M#DQRZ<42ml2Uh@kP7`V8NrcAvw}WnU%7Ou5mYAPpfeleARz zF444B5jg_wqR_L8VIyaVlBt0dcwpmcw@fLU` zy;qQlx_A*3>b??n42ms}aTY!K3%q?X(WErVEf}fY4Jn1D7Qul7@U~KrdrKwhafl&b zJ<-xvPZT^P4RLT1(C4UQCM00y#X0DAE=IWhVoYrL9z8b((eoU$=RS2Z^uG=p#VRE6 zI_mT~ZQ;OFiKT=k-ZIt3gs_#jd~ag`N8o!2xx7B9(9clL&m!ep^ATcRvu@qyrvo+9CbcV&y6VTPRaJ*4qK1c9->=0&b zWl`x{PBsA~F0i>bh_*vUC{4LJI2&@Tv@!$|)7b1gr&cySp zM$*O`mL&KGyP+R%{tWv&*DsoOU2=9wd1M!mV@R|}ZT+nd`X#M;BhV&$1aFV-)SV)1 zo_Vae$G482kfmj%J(hKdo`T;g_Kf(biA!-e)7(Pct}2tCoz}Q}=vGyTyU*U5f%5dN zV^E&D)oI?_h4{8}w{nz!x|MKQxMBMfx~(6wybyC-#EKFL5!r95dvqu+pA#rH(^lJB zOEahY^e5ZYL+cQ&yYXBhwfQTgR)2D3`9n8-6N*UYBC4t}ecQT;ferLOvTfBw?>e@j z*|~ILvvbMB<_+}|W70W9SZgN6+|?7Kjyp_mCrM2pIFOZc0yLXXhje*tknC^vqd#Fc zMDCg-u#e!^QpN+`6}+g0(0BS^n`A?7#VUA|(QHE=$@WNBvy&_89VCDK7S0vH%w_FH z??c}}y9h1Ftxybue2D@?5)cJ6PyT4g9|u%c&+4u9G>iG?o4{2PYArIj1a#8f+ug27 zdcqmPxg_^X?kIjS{Nnia;YVLhF!Rhj6s^T6BeI}P+t^!0Ir516H~8i^?smBj0wIQ? zELas~@so!VmWG%b{Xx9G95NU;ZPWKr27&zV$W*>5m&nCRn$XPNR>*RlZMKn7(o?$m z)Jb~6{88OYW2khZ^rG&BJ+5y5GNz6xi>g6hsbNZSqqQz=T^I|cGhXDn>+ zZ0X4Y&n&AOn!}sbnbk=-D?w4ng7Kzsy5d<>q-ME(B53{sWfUf{dBDqgY!1rx>>iZ4 z$P1Exof}5f3FjgHI#jnKk1ghPZwPD(t47>{_z%ccYN@B$(8!aJaiw0yn7vqeu^I8d z_bUshNNzJL_*(B-kC-e``cWZOpuTdU_u8cZsGo1Pe(G#nW2^c(`f?&qn~T0a@69vI zdC-(GoTQ_Z9+V{^yNgPOSPjY+aIHEMR2hP;6;Wp+Ru79^h=*yGr!h;G`5z+WL*cNh zI16mb?7c4PK$n<=-FvN&k6HBi zk~I&nUbbp2J>NcBF4AtFfu6_@a*6ejMG})#QRp$fGv=)ldboK{mLf?vhaV!sH{&l* zjSu`s-h17yT$T?cES=Cs-bxF+U1-PXEXI*zQPUXi5QP)BB|ThA<}0vK5KUHE$*U2p zA@9zspl`Ak7C7Dk*Zwf!rd<3vvqxM@`IB7cLYc?1P!=*Jtna#qIpG-;GY9T}0{hR^ z`!m=M`mU$oCN8IN$ zG~@9UaZe^^>3Hrxt*hhlHsEN5+`@`<5V~_%Lx?aqboAH+OK#+}r*pyhm^zlF3xw-u z(94qJqDVdb@^mYF)(rG9$NYA-gCUPph_CjYj;RWbeEfpxv#dQWK#P%$1)MmZ4m?Nn z@HEZpC+MR^1tzdV4jzc8<5)nYOb;-*HWNLp#;GX8h9$BEj!Fjwrs$|Wh<=X!Ap;iJ zgP2bTbWQvZ6nRJF8PWdlAq94v1X&O1q39l+s@46Y2@5h=F383$XkU|vsHt$#uzn!e z2siQeG|u{%{!#o}cxT`4&YZ2l7gTighLz(4Y@0eusM|3a=g$y3#G1%{q3G7zk^>g4 z1Ye&{sHB*&zt6P<&Zbd|oBmNQI4S8dIsfeC!QuzcTtYU0tj8=Ccf`_?+VO5?c@7y7 zXjt0M2Z@48G`Lj%!Ryd3&`~5bvsEx^3(!l z)^p8Rxbs^?t$;nWKC%IwcCwz6k=+BQ5Q6{>wtO20MjY%G&}Ixc;*^cPwuzJrr0;MB z!~UtQOu*?MtkaH@K9rA++Dy7+av;PwoGD6rpP_H57qY%5*ep^cPhf41XE3`JsHeEu z8?-au5(j+=2|L7KXPu4;C@lojSpk-sIsC$H=4Khby9*18>AkgG&3Xf_uoc&4D`;Umqm6|&KS)fS{S%OhEo zDf39fSsvv~Rzy8p+RQfCBkm(u)u)Mw`+!=vJ&k!qk8%htQ-J4ZOA#xu<6LxB#QnM& z!8w$C6E$}y$O0O0Z&AGswoZ?muoR^=Qm-)jaKt zd?_LrWQEfS>WQDUs}W?DzlA+X^&j*kVEL5d5Nf>R5k*-P{!dQtw;ODcOYFS&0gQW8rV)+~E?x%ZNXaD4uwB`Ug0j1s;baMAV;P7tS6<7IUW;{-^MK zu`|*r!va2+F#2S+B(wSOLz&c$`BFeh_Ho2rlcu{XkeMt02pEKur(%#i^){=g`*xh_ z2iKUqtRrTQQ-+9BoCgl3u(KhC_&`J*EKPFlgI}Bs6Z#XS+Yt9wln>;9`j-=HbT&(X zjh{Sk;Fp`_eURdHz~?&ry~AB*=J>6IN74RD6!uW1VQ-fz~0jHKF11gv0#iA|$Lnkz)2;gR@croW-KE1MT4Dx?Pjl zb)4RP6YVotq~7bO?vAkP?u>4oWptCSK(rqevcLy}RlbR&B(RB4R)>WV1_uqm8vsft zIA&B}nGLF>u{)t1Bvyb@B|WeG7LhNP_6x*4T!@ONp+x*4yjdG$Cqqg%;ym^fV!zM| z3@5z-PS&E1FCf*2MACu#%`yspjsl~H_=lM5tD?P|;p|58B<>XaEkZW(M09$9PP>kW z7w^(;VJV?MI_3&oWLt}8(VS^LBUZ9%NLOZ~gdLE26(bE;sfWwZ*Cag;fID5t7GWK* zbqmB>LqYXzw2q+t`)K)qX$2RV`I~#0jPsa-zz!y)go^8%I4dqjVC58VeR-C5 zok?@}akS#!9b_LJ`rX044^sEDv)?<@SXZ#6wXHoA?s%s2vklK~40VL|@B8fsA0F8M z!LtGL6*J$lt_^{W?C*6JiN@lL$%V33r~$33agOXhWN4YMdebN$0!}6pgeQ;>A?ZPR zq-l~zD*w<>D_!?}NK_S(v)?@L+YV1>hLkVu2A(i?K)K#Qx)t$#%SZ=K;3dv<2o#;6 zn)%K0pxq;%wtqhLgfn;ALS#T;m3)Ty(1BAOkkswdSPighWOkFXS9x^IZt@}237*~Q z9_e-bUQ0LBp?UPQGo577)XC~tPYCtQ---H;bi=*T-iEuDzqGJV5CgEf?gOnK!YrH~ z#Ozq)K}jN-3^9YlSSp;4hjvC6w|Gxs0o!mf9` zm?Bs78?s2}Vmf4zQ8XFchdK&4#DP5I4Pi;e) zL`B`Ep>w~l3qK6gN|S5S)p3Fi8Y&=v4Ne{> zyuw%pSsD+q$zk*XA0aZ!i+pmvq{C(*ZlxIr;XtO>nH-t4QH#o)@MVAxh22m@m7 zy6hh0gbycM>1s2cet8(@$Z>rUSHvA9J#P#X!-HK+xMEuD>kp3*uQe=Py1H@A8g`H# znwBkZT+#4YBa0RT&er$5~SN8WfmIv>rn6*vmmwDNJVX`qv|7d)%Z zuz7lhC{Thu7Wq(@l^p3Fjk_EynvR zJ~`qV6(aqJO@cxPu0;A_p<d$up;t87ApOf z2%T5E1udq5&od;8kbxK+or^*&@uZFEyEJf!1dl~z6#1EnOc^+x#iYylJ2{FlNVp&2 z-YrMq+cM&a3|Q>Wz!EBPZImEa@qV(awOS0{+|f zhy~}owkGBooj@nk3Mj;oEi!$xOL--Lj%P3xP`XLPyxvP7d(=~INgol>9ihPBVu=Ve5QuEnp%Q$l+?FT}av={yrB{WlM5`vv04YRHDauCQsabQ#$J^tUr#Vg0m=4KFm?_cl)L zRX`KM);4>4g9oI4!JBHc4lT-FL5o`RDYESw-rSuUCq0UwcbN2hB#*OVMkIR~jzt=$12?mG!!}DKXNOoRdUisp@V6%Okhu-$>W|TLu@hR5g}C8v;k#p5 zVdIUb`1V*%i}A)9{*SR+T8u_bdlXol{nyA0jOy+OImJC*8#NjQp$hq)pU=~`l|l9k zg^zoRK;JpI&&5cOnzP1e+wS1{XNAm)h?vg&Ay4-hjvec^A%FI>Kyq&PhV*UtYc#ca zp4kV`k&7Rzo+5pgX5P)joowFCD$=(dLPpGHK20zBxaTfdKl>9(cXIT9#Vlsts4;$R zV>^Ttk=}f)PA{Z3kFk$?0-(%Vb9RR6DGUhqP;wR`XuSmW=3i2&JBWV&i9GOioSeHV$^6y!l@i#tHet zy+XHevu5=ChW-t2ZRH(o;rR`#khXYh16ps;H|X1iSHH@Bz!%6a4P@UR$bMkPeSz$S z*(e?;d@R6F78VxZx6r&Vm|ifeU}k}*;I6`gnS}+@3(=-<=8W0XXWiwg{6VHYJ8#nT z?5d*a>!;s2y<}El(G0pwFS?5^Gm2)?<*uSxbeUN+n=XY#9=c2~x|=RDiteGyT}9Ii S={mD0`$6=0SHM%q*#8BqHk14S literal 0 HcmV?d00001 diff --git a/src/!MkAnsi b/src/!MkAnsi new file mode 100644 index 0000000..4d5ee12 --- /dev/null +++ b/src/!MkAnsi @@ -0,0 +1,8 @@ +| Makes ansi VDU driver PDP11 Unix +| +*Dir +*X Access ^.ansi wr/r +*/net::Software.PDP11.Assembler.AsmPDP ansi/mac ^.ansi ansi/lst +*Access ^.ansi r/r +*SetType ^.ansi FE6 +*IfRetVal Error Assembly error diff --git a/src/!MkAnsi.bat b/src/!MkAnsi.bat new file mode 100644 index 0000000..1ceebaf --- /dev/null +++ b/src/!MkAnsi.bat @@ -0,0 +1,3 @@ +cd /D %0\.. +..\..\Assembler\AsmPDP ansi.mac ..\ansi ansi.lst +if ERRORLEVEL 1 pause diff --git a/src/!MkAnsiBSD.bat b/src/!MkAnsiBSD.bat new file mode 100644 index 0000000..0b6194e --- /dev/null +++ b/src/!MkAnsiBSD.bat @@ -0,0 +1,3 @@ +cd /D %0\.. +..\..\Assembler\AsmPDP -DBSD ansi.mac ..\bsdansi ansi.lst +if ERRORLEVEL 1 pause diff --git a/src/!MkBSD.bat b/src/!MkBSD.bat new file mode 100644 index 0000000..8a5860c --- /dev/null +++ b/src/!MkBSD.bat @@ -0,0 +1,6 @@ +@rem Makes PDP-11 BBC BASIC for BSD2.11 +@rem +@cd /D %0\.. +..\..\Assembler\AsmPDP -DBSD211 MakeUnix ..\bsdbasic basic.lst +if ERRORLEVEL 1 pause +if NOT ERRORLEVEL 1 UpdSize ..\bsdbasic. logBSD.log diff --git a/src/!MkRT11 b/src/!MkRT11 new file mode 100644 index 0000000..ebd9de8 --- /dev/null +++ b/src/!MkRT11 @@ -0,0 +1,8 @@ +| Makes PDP11 BBC BASIC with RT11 I/O, with listing output +| +*Dir +*X Access ^.basicRT11 wr/r +*/net::Software.PDP11.Assembler.AsmPDP MakeRT11 ^.basic/sav basic/lst +*Access ^.basic/sav r/r +*SetType ^.basic/sav 1C5 +*IfRetVal Error Assembly error diff --git a/src/!MkRT11.bat b/src/!MkRT11.bat new file mode 100644 index 0000000..b7b3e2f --- /dev/null +++ b/src/!MkRT11.bat @@ -0,0 +1,6 @@ +rem Makes PDP11 BBC BASIC with RT11 I/O +rem +cd /D %0\.. +..\..\Assembler\AsmPDP MakeRT11 ..\basic.sav basic.lst -a +if ERRORLEVEL 1 pause +if NOT ERRORLEVEL 1 UpdSize ..\basic.sav logRT11.log diff --git a/src/!MkTube b/src/!MkTube new file mode 100644 index 0000000..7bc7ed2 --- /dev/null +++ b/src/!MkTube @@ -0,0 +1,8 @@ +| Makes PDP11 BBC BASIC ROM for PDP11 Tube system, with BBC I/O only +| +*Dir +*X Access ^.basic/rom wr/r +*/net::Software.PDP11.Assembler.AsmPDP MakeTube ^.basic/rom basic/lst +*Access ^.basic/rom r/r +*SetType ^.basic/rom BBC +*IfRetVal Error Assembly error diff --git a/src/!MkTube.bat b/src/!MkTube.bat new file mode 100644 index 0000000..5fa1592 --- /dev/null +++ b/src/!MkTube.bat @@ -0,0 +1,7 @@ +rem Makes PDP11 BBC BASIC ROM for PDP11 Tube system, with BBC I/O +rem +cd /D %0\.. +..\..\Assembler\AsmPDP MakeTube ..\basic.rom basic.lst +if ERRORLEVEL 1 pause +if NOT ERRORLEVEL 1 UpdSize ..\basic.rom logROM.log +exit diff --git a/src/!MkUnix b/src/!MkUnix new file mode 100644 index 0000000..5398fd2 --- /dev/null +++ b/src/!MkUnix @@ -0,0 +1,8 @@ +| Makes PDP11 BBC BASIC with Unix I/O and BBC fall-back, with listing output +| +*Dir +*X Access ^.bbcbasic wr/r +*/net::Software.PDP11.Assembler.AsmPDP MakeUnix ^.bbcbasic basic/lst +*Access ^.bbcbasic r/r +*SetType ^.bbcbasic FE6 +*IfRetVal Error Assembly error diff --git a/src/!MkUnix.bat b/src/!MkUnix.bat new file mode 100644 index 0000000..7b8feab --- /dev/null +++ b/src/!MkUnix.bat @@ -0,0 +1,6 @@ +rem Makes PDP11 BBC BASIC with Unix I/O +rem +cd /D %0\.. +..\..\Assembler\AsmPDP MakeUnix ..\bbcbasic basic.lst -a +if ERRORLEVEL 1 pause +if NOT ERRORLEVEL 1 UpdSize ..\bbcbasic. logUnix.log diff --git a/src/AnsiKBD b/src/AnsiKBD new file mode 100644 index 0000000..20be744 --- /dev/null +++ b/src/AnsiKBD @@ -0,0 +1,221 @@ +; > AnsiKBD +; 28-Jul-2023 Seperating out and optimising ANSI keypress processing. +; 30-Jul-2023 New KBDTest routines, IO_Escape calls them. +; 31-Jul-2023 Optimised ANSI keypress processing. +; 01-Aug-2023 KBD_Test returns R0=pending, EQ/NE set. +; 10-Mar-2024 Tweeks for oddities in various PuTTY setttings and fkey overlaps. + +#ifndef UKNCOK +#define UKNCOK 0 +#endif + +; Low-level read from TTYIN +; ------------------------- +; Read from local key buffer and TTYIN, translate extended keypress sequences +; On exit: VS=No keypress +; VC=Key press returned +; R0=16-bit character code +; +;.KBD_TESTKEYBUF +;jsr pc,KBD_TestKey ; Test for keypress or get pending keypress +;beq KBD_GETKEYnokey ; No key pressed +.KBD_GETKEYBUF +jsr pc,KBD_WaitKey ; Get the pending keypress +cmpb r0,#27 +beq KBD_GETKEYext ; , test for extended keypress +#ifdef KBDUPPER + cmpb r0,#ASC"a" + bcs KBD_GETKEYcheck + cmpb r0,#ASC"z"+1 + bcc KBD_GETKEYcheck + bic #32,r0 ; Force to upper case + .KBD_GETKEYcheck +#endif +#ifdef KBDCRLF + cmpb r0,#13 + beq KBD_GETKEYcr ; , swallow following +#endif +#ifdef UKNCADDR + cmp r0,#25 ; Test for UKNC cursor keys + bcs KBD_GETKEYok + cmp r0,#30 + bcc KBD_GETKEYok + #if UKNCOK<0 + tst @#UKNCADDR ; Look inside host's workspace + beq KBD_GETKEYok ; EQ=not UKNC + #else + cmp @#UKNCADDR,#UKNCOK ; Look inside host's workspace + bne KBD_GETKEYok ; NE=not UKNC + #endif + movb KBD_KEYUKNC-25(r0),r0 ; Translate cursor keys +#endif +.KBD_GETKEYok +bic #&FF00,r0 ; Remove any sign extension, V cleared, C unchanged +rts pc +#ifdef KBDCRLF + .KBD_GETKEYcr + jsr pc,KBD_WaitKey ; Swallow following , returns CC + mov #13,r0 ; Clears V + rts pc +#endif +.KBD_GETKEYesc +mov #27,r0 ; Clears V +rts pc + +.KBD_GETKEYext ; - check for or +jsr pc,KBD_TestKeyDelay ; Test for keypress or get pending keypress +beq KBD_GETKEYesc ; , return +jsr pc,KBD_WaitKey ; Get the keypress +cmpb r0,#27 +beq KBD_GETKEYext ; - doubled prefix, keep waiting +; +; Could be: +; '?' <@-7F> -> upper/lower case translation +; 'O' <@-7F> -> upper/lower case translation +; '[' () <@-7F> -> parse sequence +; '[' '[' <@-4F> -> offset upper case translation +; <@-7F> -> upper case translation +; +mov r1,-(sp) ; Save R1 +clr r1 ; Modifiers=0 +cmpb r0,#ASC"[" +beq KBD_GETKEYopen ; [() +cmpb r0,#ASC"O" +beq KBD_GETKEYtwo ; O +cmpb r0,#ASC"?" +beq KBD_GETKEYtwo ; ? +bcc KBD_GETKEYone ; +.KBD_GETKEYnokeyPop +mov (sp)+,r1 ; Restore R1 +.KBD_GETKEYnokey +sev +rts pc ; No keypress + +.KBD_GETKEYsemi +swab r1 ; Swap key and modifier +; nb: [Z is sTAB via here +.KBD_GETKEYopen +jsr pc,KBD_WaitKey +cmpb r0,#ASC"[" +beq KBD_GETKEYtwice ; [[A-E -> P-T +cmpb r0,#&3B +beq KBD_GETKEYsemi ; ; +;cmpb r0,#ASC"0" +;bcs KBD_GETKEYnokeyPop ; <'0' - no key +cmpb r0,#ASC"9"+1 +bcc KBD_GETKEYone ; >'9' - end of +bic #&FFF0,r0 ; Reduce digit to 0-9 +cmp r1,#&0100 +bcc KBD_GETKEYadd +add r1,r1 ; *2 +mov r1,-(sp) +add r1,r1 ; *4 +add r1,r1 ; *8 +add (sp)+,r1 ; r1=r1*10 +.KBD_GETKEYadd +add r0,r1 ; r1=r1*10+r0 +br KBD_GETKEYopen ; Get another digit + +.KBD_GETKEYtwice +jsr pc,KBD_WaitKey +add #15,r0 ; Convert 'A'+ to 'P'+ +.KBD_GETKEYone +;cmpb r0,#ASC"@" +;bcs KBD_GETKEYnokeyPop ; <'@' - no key +;cmpb r0,#&80 +;bcc KBD_GETKEYnokeyPop ; >7F - no key +cmp r0,#ASC"~" +bne KBD_GETKEYctrl ; Not ...~ +; +; [~ - r1=0 +; [~ - r1=%0000 0000 00nn nnnn - 00 +; [;~ - r1=%00nn nnnn 0000 nnnn - +cmp r1,#&0100 +bcs KBD_GETKEYswap ; r1 is 00 +swab r1 ; r1 now +.KBD_GETKEYswap +movb r1,r0 ; r0= +swab r1 ; r1 is +add #KBD_KEYTABLE2-KBD_KEYTABLE1,r0 +br KBD_GETKEYtable ; Translate and add modifiers + +; nb: OZ is f11 via here +.KBD_GETKEYtwo +jsr pc,KBD_WaitKey ; O and ? +cmp r0,#ASC"Z" ; Special case for OZ +bne KBD_GETKEYletter +movb #ASC"O",r0 ; Can't get 'O' via this route, so use it +; +; - r1=0000 +; [ - r1=%0000 0000 00nn nnnn - 00 +.KBD_GETKEYletter +bic #&FFC0,r0 ; Reduce to 0-63 +cmp r0,#ASC" " +bcc KBD_GETKEYchar ; ? -> keypad digit +.KBD_GETKEYctrl +bic #&FFE0,r0 ; Reduce to 0-31 +.KBD_GETKEYtable +movb KBD_KEYTABLE1(r0),r0 ; Fetch from table +beq KBD_GETKEYnokeyPop ; No translation +bic #&FFF8,r1 ; Reduce modifier to 0-7 +movb KBD_KEYTABLE3(r1),r1 ; Convert to XOR value +xor r1,r0 ; Modify keypress +.KBD_GETKEYchar +bic #&FF00,r0 ; Drop any sign extension +bis #&0100,r0 ; Return &0100+keycode +mov (sp)+,r1 ; Restore R1 +rts pc + +#ifdef UKNCADDR + .KBD_KEYUKNC + ;UKNC Rgt Lft + EQUB &CD,&CC ; Overlaps next table +#endif +; +; x ? x O x [ x +.KBD_KEYTABLE1 +; Up Dwn Rgt Lft Bgn End KP5 +; @ A B C D E F G +EQUB &00,&CF,&CE,&CD,&CC,&C5,&C9,&07 +; +; Hme cDn cRt KPent f11 +; H I J K L M N O +EQUB &C8,&00,&EE,&ED,&0C,&0D,&00,&8B +; +; f1 f2 f3 f4 f5 f6 f6 f8 +; P Q R S T U V W +EQUB &81,&82,&83,&84,&85,&86,&87,&88 +; +; f9 f10 sTAB f12 f6 f8 +; X Y Z [ \ ] ^~ _7F +EQUB &89,&8A,&D5,&8C,&8D,&8E,&86,&88 +; nb: OZ is f11, [Z is sTAB +; +; [ num ~ +.KBD_KEYTABLE2 +; f6 +; Del Hme Ins Del End PgUpPgDnHme End Num +; 00 01 02 03 04 05 06 07 08 09 +EQUB &86,&C8,&C6,&C7,&C9,&CB,&CA,&C8,&C9,&8D +; +; f0 f1 f2 f3 f4 f5 f6 f7 f8 +; 10 11 12 13 14 15 16 17 18 19 +EQUB &80,&81,&82,&83,&84,&85,&00,&86,&87,&88 +; +; Prn Scr Brk +; f9 f10 f11 f12 f13 f14 f15 f16 +; 20 21 22 23 24 25 26 27 28 29 +EQUB &89,&8A,&00,&8B,&8C,&80,&8E,&00,&8F,&C0 +; +; Menu +; f17 f18 f19 f20 +; 30 31 32 33 34 +EQUB &00,&C1,&C2,&C3,&C4 +; +.KBD_KEYTABLE3 +; 0 1 2 3 4 5 6 7 modifier +; 0 1 2 3 4 5 6 bitmap +; non sft alt s+a ctl c+s c+a +EQUB &00,&00,&10,&30,&10,&20,&30,&20 ; XOR value +ALIGN + diff --git a/src/Assembler b/src/Assembler new file mode 100644 index 0000000..d082458 --- /dev/null +++ b/src/Assembler @@ -0,0 +1,69 @@ +; > Assembler +; BASIC assembler for the PDP11 + +; Any assembly code just assembles a NOP to identify the BASIC. + + +.cmdAssem +mov SV_INT_P,r0 ; Get P% to store assembly code +;bic #1,r0 ; Ensure even address +;mov #160,(r0) ; Just store a NOP for identification +movb #160,(r0)+ ; Just store a NOP for identification +clrb (r0) +.cmdAssemLp +movb (r5)+,r0 ; Step to ] or +cmpb r0,#ASC"]" +beq cmdAssemExit +cmpb r0,#13 +bne cmdAssemLp +dec r5 +.cmdAssemExit +rts pc + + +;; Only assembly implemented is: +;; NOP +;; EQUD &nnnn +;; OPT &nn - ignored +; +;.AssemCR +;dec r5 +;.cmdAssem +;jsr pc,UpdateLPTR +;bcc AssemExit ; End of program +;movb (r5)+,r0 +;cmpb r0,#13 +;beq AssemCR ; Step to next line +;cmpb r0,#ASC"]" +;beq AssemExit ; ] - end of assembly +;bic #32,r0 ; Force to upper case +;clr r4 ; r4=0 - EQUW +;cmpb r0,#ASC"E" ; EQUW +;beq AssemWord +;dec r4 ; r4=-1 - OPT +;cmpb r0,#ASC"O" ; OPT +;beq AssemWord +;mov #160,r4 ; r4=160 - anything else is NOP +;.AssemWord +;movb (r5)+,r0 +;cmpb r0,#ASC"A" +;bcc AssemWord ; Skip to non-letter +;dec r5 +;cmp r4,#160 +;beq AssemStore ; Store NOP +;.AssemEqu +;mov r4,-(sp) ; Save -1/0 +;jsr pc,Evaluate +;mov (sp)+,r3 +;bne cmdAssem ; EQ - OPT, skip +;.AssemStore +;mov SV_INT_P,r0 ; Get P% to store assembly code +;bic #1,r0 +;mov r4,(r0)+ ; Store assembled word +;mov r0,SV_INT_P +;cmpb (r5)+,#ASC"," +;bne AssemCR ; Not comma, step to next statement +;clr r4 +;br AssemEqu ; Do another EQUW +;.AssemExit +;rts pc diff --git a/src/Commands b/src/Commands new file mode 100644 index 0000000..fdad779 --- /dev/null +++ b/src/Commands @@ -0,0 +1,1967 @@ +; > Commands +; BASIC commands + +; 09-Feb-2008: Removed 80-BF from command table, OFF/ERROR/EXT checked for explicitly +; Started writing cmdON to split between subfunctions +; Started work on PRINT - comma doesn't work, rest untested +; 12-Feb-2008: PRINT works, including all print formatters! +; 04-Sep-2008: LIST, REPEAT/UNTIL, GOTO/GOSUB/RETURN, RESTORE, IF, TRACE +; 09-Mar-2009: GOTO/GOSUB/RESTORE search for destination line +; 05-Nov-2009: RESTORE [DATA|ERROR], LOCAL [DATA|ERROR], ENDPROC, = +; 08-Nov-2009: PROC(addr%), FN(addr%) +; 15-May-2010: LET stores numbers +; 24-Jun-2011: DELETE checks for &C7xx double tokens +; 31-Jan-2012: String assigment, doesn't yet reclaim lost string space +; DIM var size done. +; DIM var(etc) tries to find a variable called var(etc) +; Assign reduces real to int if int%=real +; 28-Jun-2013: PRINT# done. +; 20-Nov-2013: FOR/NEXT done. HIMEM checks moving will leave some free memory. +; 04-Dec-2013: Stacked loops/calls don't stack duplicate cmdret, loops step past any +; null start of loop (eg REPEAT steps to next line) +; 07-Dec-2013: READ done, including reading raw strings. PROC/FN calls, ENDPROC/= return. +; PROC/FN only without parameters. Need to check layout of stacked local +; variables. +; 09-Dec-2013: FN/PROC lookup moved to Variables, callable by ^PROC/^FN. DIM space. +; 13-Dec-2013: FN/PROCname(params) working - LOCAL not working properly. +; Stacked data struture needs tweeking to combine size+type +; 24-Dec-2013: SubCall/SubReturn stacks and pops data with combined size+type +; LOCAL [DATA][ERROR][variables] working, and popped off correctly +; RESTORE [DATA][ERROR], RESTORE + +; 31-Dec-2013: INPUT, INPUT# done, replaced "Unimplemented command" message with error. +; 03-Jan-2014: AUTO checks program consistancy in case of Bad program. +; 28-Jan-2014: LIST takes parameters, generalised line number parsing routine. +; 05-Feb-2014: DIM array() seems to work. Needs some further testing. +; = copies returned string to buffer before unstacking what could be +; a localised version of the same string. +; 31-Aug-2015: Low numbered commands use lookup table instead of loads of CMPs. +; 07-Sep-2015: ON GOTO/GOSUB implemented. DIM fails with more than one dimension. +; 12-Oct-2015: TRACE ON|OFF steps r5 past ON|OFF. +; 28-Jun-2017: FOR/NEXT have loop type on stack correct way around. +; 23-Apr-2020: PRINT preserves R1 at this level, allows NumberToString to corrupt everything. +; 13-Mar-2021: LIST doesn't detokenise within strings. *BUG* Detokensises after REM. +; 07-Jan-2022: Bugfix added to avoid bug in RT11Em. +; 03-Oct-2023: Unwinding from FN drops subroutines addresses when resetting SV_STACK. +; 12-Mar-2024: CallSub/RetSub pushes/pops SV_STACK - optimised code and fixed unwinding bug. +; 18-Mar-2024: HIMEM= sets SV_STACK, lots of small misc. optimisations. +; To do: LIST ,n and LIST n, don't detokenised after REM. +; To do: If oldstring+len=VAREND, extend newstring into VAREND. - has this already been done? + + +; Command address table +; ===================== +; On entry to command subroutines, +; r5=>next character, spaces not skipped +; r0=(token-&C6)*2 +; r1=dispatch address +; +.CommandTable +EQUW cmdAUTO-$ ; &C6 - AUTO +EQUW cmdDELETE-$ ; &C7 - DELETE and double-byte immediate commands +EQUW cmdLOAD-$ ; &C8 - LOAD and double-byte program commands +EQUW cmdLIST-$ ; &C9 - LIST +EQUW cmdNEW-$ ; &CA - NEW +EQUW cmdOLD-$ ; &CB - OLD +EQUW cmdRENUMBER-$ ; &CC - RENUMBER +EQUW cmdSAVE-$ ; &CD - SAVE +EQUW cmdPUT-$ ; &CE - PUT +EQUW cmdPTR-$ ; &CF - PTR +EQUW cmdPAGE-$ ; &D0 - PAGE +EQUW cmdTIME-$ ; &D1 - TIME +EQUW cmdLOMEM-$ ; &D2 - LOMEM +EQUW cmdHIMEM-$ ; &D3 - HIMEM +EQUW cmdSOUND-$ ; &D4 - SOUND +EQUW cmdBPUT-$ ; &D5 - BPUT +EQUW cmdCALL-$ ; &D6 - CALL +EQUW cmdCHAIN-$ ; &D7 - CHAIN +EQUW cmdCLEAR-$ ; &D8 - CLEAR +EQUW cmdCLOSE-$ ; &D9 - CLOSE +EQUW cmdCLG-$ ; &DA - CLG +EQUW cmdCLS-$ ; &DB - CLS +EQUW cmdDATA-$ ; &DC - DATA +EQUW cmdDEF-$ ; &DD - DEF +EQUW cmdDIM-$ ; &DE - DIM +EQUW cmdDRAW-$ ; &DF - DRAW +EQUW cmdEND-$ ; &E0 - END +EQUW cmdENDPROC-$ ; &E1 - ENDPROC +EQUW cmdENVELOPE-$ ; &E2 - ENVELOPE +EQUW cmdFOR-$ ; &E3 - FOR +EQUW cmdGOSUB-$ ; &E4 - GOSUB +EQUW cmdGOTO-$ ; &E5 - GOTO +EQUW cmdGCOL-$ ; &E6 - GCOL +EQUW cmdIF-$ ; &E7 - IF +EQUW cmdINPUT-$ ; &E8 - INPUT +EQUW cmdLET-$ ; &E9 - LET +EQUW cmdLOCAL-$ ; &EA - LOCAL +EQUW cmdMODE-$ ; &EB - MODE +EQUW cmdMOVE-$ ; &EC - MOVE +EQUW cmdNEXT-$ ; &ED - NEXT +EQUW cmdON-$ ; &EE - ON +EQUW cmdVDU-$ ; &EF - VDU +EQUW cmdPLOT-$ ; &F0 - PLOT +EQUW cmdPRINT-$ ; &F1 - PRINT +EQUW cmdPROC-$ ; &F2 - PROC +EQUW cmdREAD-$ ; &F3 - READ +EQUW cmdREM-$ ; &F4 - REM +EQUW cmdREPEAT-$ ; &F5 - REPEAT +EQUW cmdREPORT-$ ; &F6 - REPORT +EQUW cmdRESTORE-$ ; &F7 - RESTORE +EQUW cmdRETURN-$ ; &F8 - RETURN +EQUW cmdRUN-$ ; &F9 - RUN +EQUW cmdSTOP-$ ; &FA - STOP +EQUW cmdCOLOUR-$ ; &FB - COLOUR +EQUW cmdTRACE-$ ; &FC - TRACE +EQUW cmdUNTIL-$ ; &FD - UNTIL +EQUW cmdWIDTH-$ ; &FE - WIDTH +EQUW cmdOSCLI-$ ; &FF - OSCLI +EQUW errMistake-$ ; &100 - Used for unsupported commands -> Mistake + +; Low numbered tokens and characters used as commands +EQUW cmdStar-$ ; &101 - &2A - * +EQUW cmdEquals-$ ; &102 - &3D - = +EQUW cmdAssem-$ ; &103 - &5B - [ +EQUW cmdERROR-$ ; &104 - &85 - ERROR +EQUW cmdOFF-$ ; &105 - &87 - OFF +EQUW cmdELSE-$ ; &106 - &8B - ELSE +EQUW cmdGOTO-$ ; &107 - &8C - THEN +EQUW cmdGOTO1-$ ; &108 - &8D - LINENUM +EQUW cmdEXT-$ ; &109 - &A2 - EXT + +.cmdPUT +.cmdRENUMBER +.errMistake +jsr pc,Error +equb 4,"Mistake",0 + +; Here to take advantage of alignment +.CommandBytes +EQUB ASC"*" -&C6,ASC"=" -&C6,ASC"[" -&C6,tknERROR-&C6,tknOFF-&C6 +EQUB tknELSE-&C6,tknTHEN-&C6,tknLINENUM-&C6,tknEXT -&C6 +ALIGN + +; Here to be near some branches +.EnsureEndStatement +jsr pc,CheckEndStatement +beq cmdREADok +.errSyntax +jsr pc,Error +equb 16,"Syntax error",0 +align + + +; READ var[,var...] +; ================= +.cmdREADlp1 +.cmdREAD +mov SV_DATA,r1 ; Get current DATA pointer +cmpb (r1),#ASC"," +beq cmdREAD1 ; Pointing to next item +movb #tknDATA,r0 +jsr pc,TokenFind ; Look for next DATA line +bcc errNoDATA ; No more DATA +dec r1 +.cmdREAD1 +inc r1 ; Step past comma in DATA +mov r1,-(sp) ; Save DATA pointer +jsr pc,VarFindCreate ; Parse and create variable +mov (sp)+,r1 ; Get DATA pointer back +mov r5,-(sp) ; Save LPTR +mov r1,r5 ; Point to DATA item +.cmdREADspc +cmpb (r5)+,#ASC" " ; Skip spaces in DATA +beq cmdREADspc +dec r5 +cmpb (r5),#34 ; Does DATA item starts with a quote? +beq cmdREAD2 ; Quoted string, evaluate it +tst r3 ; Check type of variable +bpl cmdREAD2 ; Not reading to a string variable + +; Read raw string from program code +; --------------------------------- +mov r4,r0 ; Move address of string block to r0 +mov r5,r1 ; r1=>source string +mov #&7FFF,r2 ; r2= string length-1 +.cmdREADlp2 +inc r2 ; Increment length +movb (r5)+,r3 ; Check character +cmpb r3,#13 +beq cmdREADraw +cmpb r3,#ASC"," +bne cmdREADlp2 ; Look for end of raw string +.cmdREADraw +dec r5 ; Point back to ',' or +jsr pc,cmdAssignString2 ; Assign raw string +br cmdREAD3 + +; Evaluate data item +; ------------------ +.cmdREAD2 +jsr pc,cmdAssign3 ; Evaluate and assign + +; Update DATA pointer and loop for next +; ------------------------------------- +.cmdREAD3 +mov r5,SV_DATA ; Update DATA pointer +mov (sp)+,r5 ; Get LPTR back +jsr pc,SkipSpaceNext +cmpb r0,#ASC"," +beq cmdREADlp1 ; Do next item +dec r5 ; Could all these decr5/rts be combined? +.cmdREADok +rts pc +.errNoDATA +jsr pc,Error +equb 42,"Out of ",tknDATA,0 +align + + +; Assign data to variable +; ----------------------- +; r0=data address +; r1=data size/type +; r2/r3/r4=data +; +.cmdAssignData +mov r0,-(sp) ; Stack destination address +mov r1,-(sp) ; Stack destination type +br cmdAssign4 + +; [LET] var=expression +; ==================== +.cmdLET +jsr pc,SkipSpaceThis +.cmdAssign +jsr pc,VarFindCreate1 ; Look for variable, create if nonexistant +;bcs errSyntax ; Bad variable name, give error (done in VarFindCreate) + ; r4=address, r3=type/data size +.cmdAssign2 +;jsr pc,SkipSpaceThis ; could be Next +jsr pc,SkipSpaceNext +cmpb r0,#ASC"=" +bne errMistake +;inc r5 +.cmdAssign3 +bit #&4000,r3 +bne errSyntax ; Can't do array()= +mov r4,-(sp) ; Stack destination address +mov r3,-(sp) ; Stack destination type +jsr pc,Evaluate ; Evalute following expression + ; r4/r3/r2=value + +; 0(sp)=%00000000x - number= +; 0(sp)=%01000000x - number()= +; 0(sp)=%10000000x - string= +; 0(sp)=%10000001x - $string= +; 0(sp)=%10000010x - $$string= +; 0(sp)=%11000000x - string()= +; +; r2=%0xxxx - =number +; r2=%1xxxx - =string + +.cmdAssign4 +mov (sp),r0 ; r0=%txxxxxxxx, type of destination +xor r2,r0 ; r0=%Txxxxxxxx, type of source +bmi jmpTypeMismatch ; Types don't match +mov (sp)+,r0 ; Destination Type/Size +bmi cmdAssignString ; b31=1, string +mov (sp)+,r1 ; Destination address + +.cmdAssignNumber +; r0=data size 1, 4 or 5 +; r1=>data block +; r2/r3/r4=value +; +cmp r0,#5 +beq cmdAssignNumber1 ; Integer and Real will fit into Real +jsr pc,EnsureInteger ; Reduce Real to fit into Integer +.cmdAssignNumber1 +movb r4,(r1)+ ; Store first byte +dec r0 +beq cmdAssignDone ; Byte store +swab r4 +movb r4,(r1)+ ; Store three more bytes +; add update here to be able to store arbitary number of bytes, eg 1, 2, 4, 5 +movb r3,(r1)+ +swab r3 +movb r3,(r1)+ +;swab r4 ; Restore r3 and r4 - these moved out to cmdNEXT as that's +;swab r3 ; the only place that needs r3/r4 preserved +cmp r0,#4 +bne cmdAssignDone ; Not float store +movb r2,(r1) ; Store fifth byte to float dest +.cmdAssignDone +rts pc +.jmpTypeMismatch +jmp errTypeMismatch + +; = +; -------------------- +; r0=%10000000(0) - string (sp)=>string info block r3=length r4=source address +; r0=%10000001(0) - $string (sp)=>string r3=length r4=source address +; r0=%10000010(0) - $$string (sp)=>string r3=length r4=source address +; r0=%11000000(0) - string() (sp)=>string info block r3=length r4=source address +.cmdAssignString +bis r0,r3 ; r3=(type.hi) OR (length.lo) +mov r3,r2 ; r2=(type.hi) OR (length.lo) +mov r4,r1 ; r1=>source +mov (sp)+,r0 ; r0=>destination +.cmdAssignString2 +; r0=destination address (string info block or absolute string base) +; r1=>source string +; r2=&8x00+string length +; r3=temp +; +bit r2,#&0300 +bne cmdAbsString ; $addr or $$addr +bic #&FF00,r2 ; r2=length +mov (r0),r4 ; r4=>string data + ; r3=temp + ; r2=string length + ; r1=>source string + ; r0=>string info block +cmpb 3(r0),r2 ; Compare length with allocated length +bcc cmdStringStore ; New length <= allocated length, store it +; +; We now leak memory here as we throw away the old string buried in the heap and add a new string +; to the end of the heap. We should examine the current string block to see if this string ends +; at VAREND, and so just extend it in place. Even better (but slower) is to keep the old string +; space in a list and look through it for space to reuse. +; +mov r2,-(sp) ; Save new length +add #8,r2 ; Add 8 to required length - should round to even number +cmp r2,#&100 +bcs cmdStringNot255 +mov #255,r2 ; Maximum 255 bytes +.cmdStringNot255 +mov SV_VAREND,r4 ; Location of new string data +mov r4,r3 +add r2,r3 ; r2=VAREND+required length +cmp r3,sp +bcs cmdStringNew +.jmpNoRoom +jmp errNoRoom +.cmdStringNew +inc r3 +bic #1,r3 ; Ensure aligned +mov r3,SV_VAREND ; Update end of heap +; r4=>new string data +; r3=new VAREND +; r2=max string length +; r1=source string +; r0=>string info block +mov r4,(r0) ; Store address of string data +movb r2,3(r0) ; Store max string length +mov (sp)+,r2 ; Get new length back +; +.cmdStringStore +movb r2,2(r0) ; Set string length +beq cmdStringDone ; Zero-length string, nothing to do +.cmdStringLp +movb (r1)+,(r4)+ ; Copy characters to string data +dec r2 +bne cmdStringLp ; Loop until all done +.cmdStringDone +rts pc +.cmdAbsString +bit r2,#&00FF +beq cmdAbsDone ; Zero-length string +movb (r1)+,(r0)+ ; Copy character +dec r2 +br cmdAbsString ; Loop for all characters +.cmdAbsDone +bit #&0100,r2 +beq cmdAbsZero +movb #13,(r0) ; $addr terminated with +rts pc +.cmdAbsZero +clrb (r0) ; $$addr terminated with <00> +rts pc + + +; DIM [variable [LOCAL] size][array(dimensions)]... +; ================================================= +.cmdDIMlp +.cmdDIM +jsr pc,VarFindCreate ; Look for variable, create if nonexistant +cmpb -1(r5),#ASC"(" ; Is it DIM var(... +beq cmdDIMarray ; Dimension an array + +; Reserve space in heap +; --------------------- +mov r4,-(sp) ; Stack destination address +mov r3,-(sp) ; Stack destination type +jsr pc,EvalInteger ; r3/r4=max reserved memory size +inc r4 +bne cmdDIM1 +inc r3 +.cmdDIM1 ; r3/r4=size to reserve +tst r3 +bne errDIMspace +inc r4 +bic #1,r4 ; Align number of bytes to reserve +mov SV_VAREND,r0 ; r0=>start of reserved space +add r4,r0 ; r0=>end of reserved space +bcs errDIMspace ; VAREND+size>&FFFF +add #256,r1 ; VAREND+size+256 +bcs errDIMspace ; VAREND+size+256>&FFFF +cmp sp,r1 ; Would this overlap stack? +bcs errDIMspace ; VAREND+size+256>sp +; +mov SV_VAREND,r0 ; r0=>start of reserved space +mov r0,r1 ; r1=>start of reserved space +add r4,r1 ; r1=>end of reserved space +mov r1,SV_VAREND ; Update VAREND +mov r0,r4 ; r2/r3/r4=>start of reserved space +clr r3 +clr r2 +mov (sp)+,r0 ; Type/Size +mov (sp)+,r1 ; Dest +jsr pc,cmdAssignNumber +.cmdDIMnext +;jsr pc,SkipSpaceThis ; could be Next, swap inc for dec +jsr pc,SkipSpaceNext +cmpb r0,#ASC"," +beq cmdDIMlp ; Another variable +dec r5 ; Balance SkipSpaceNext +;.cmdDIMdone +rts pc +.cmdDIMtooBig +; Should remove array entry from heap +.errDIMspace +jsr pc,Error +equb 11,tknDIM," space",0 +align + +; Dimension an array +; ------------------ +.cmdDIMarray +; r5=>m,n,o,p) +; r4=>pointer to array info +; r3=object type &8000, &0005, &0004 +; +; Need to build: +; r4=>dims, dim1, dim2, dim3, dim4 +; +mov r3,-(sp) ; Save object type +mov r4,-(sp) ; Save address of start of info block +clr -(sp) ; Save initial index to end of array +clr (r4)+ ; Zero number of dimensions +mov r4,-(sp) ; Save address of first dimension +br cmdDIMparse +.cmdDIMparseLp +inc r5 ; Step past "," +mov r3,-(sp) ; Put offset back onto stack +mov r1,-(sp) ; Put pointer to next dimension onto stack +.cmdDIMparse +jsr pc,EvalInteger ; Evaluate dimension +tst r3 +bne cmdDIMtooBig ; sub>65535 - too big +mov r4,r3 ; Move to R3 for multiply later +mov (sp)+,r1 ; r1=>current dimension +mov r3,(r1)+ ; Store current dimension +inc r3 ; Add one to get dimension size +mov (sp)+,r2 ; r2=current index +beq cmdDIMsize ; First dimension, nothing to multiply +; +; sp=>start of info block, type +; r4=dimension max +; r3=dimension size +; r2=current index +; r1=>next dimension +; +#ifndef NOMUL +mul r2,r3 ; r3=r2*r3 - offset=offset*size +#else +jsr pc,R2timesR3toR3 ; r3=r2*r3 - offset=offset*size +#endif +bcs cmdDIMtooBig ; offset>65535 +.cmdDIMsize +cmpb (r5),#ASC"," +beq cmdDIMparseLp ; Parse next dimension +jsr pc,CheckClose +; +; r3=offset to end of array +; r1=start of array data +; sp=>start of info block, type +; +mov (sp)+,r2 ; r2=>start of array info +mov r1,r0 +sub r2,r1 ; r1=2*(number of dimensions)+2 +asr r1 ; r1=number of dimensions+1 +dec r1 ; r1=number of dimensions +mov r1,(r2) ; Store number of dimensions +mov (sp)+,r2 ; Get object type +mov r3,r4 +asl r3 +bcs cmdDIMtooBig +asl r3 ; r3=index*4 +bcs cmdDIMtooBig +bit r2,#1 +beq cmdDIMword +add r4,r3 ; r3=index*5 +bcs cmdDIMtooBig +.cmdDIMword +add r0,r3 ; r0=start of data, r3=end of data +inc r3 +bic #1,r3 +mov r3,SV_VAREND ; Update end of heap +.cmdDIMclear +clr (r0)+ +cmp r0,r3 ; Clear array data +bcs cmdDIMclear +br cmdDIMnext ; Look for next dim +; +.errBadDIM +jsr pc,Error +equb 10,"Bad ",tknDIM,0 +align + + +; ERROR [EXT] errnum,errstr$ +; ========================== +.cmdERROR +jsr pc,SkipSpaceNext +sub #tknEXT+&FF00,r0 ; ERROR EXT? +beq cmdERROR1 +dec r5 ; Step back +.cmdERROR1 +mov r0,-(sp) ; Save EXT/noEXT +jsr pc,EvalInteger ; Get error number +jsr pc,CheckComma ; Step past comma +mov r4,-(sp) ; Save error number +jsr pc,EvalString ; Get error string +adr SV_INPUT+254,r0 ; Use command input buffer to hold error +sub r3,r0 ; Use top end of input buffer +bic #1,r0 ; Ensure even address +mov (sp)+,(r0) ; Pop error number to buffer +;cmpb (sp)+,#tknEXT ; Is it ERROR EXT +tst (sp)+ ; Is it ERROR EXT +beq cmdERRORext ; Jump to quit, returning error number +mov r0,-(sp) ; Save start of error block +inc r0 ; Step past error number +tst r3 ; Zero-length string? +beq cmdERRORdone ; Jump to finish +.cmdERRORlp +movb (r4)+,(r0)+ ; Copy character to error buffer +dec r3 ; Decrement string count +bne cmdERRORlp ; Loop to copy whole string +.cmdERRORdone +clrb (r0) ; Put terminating zero in +mov (sp)+,r0 ; Get start of error block back +jmp ErrorHandler ; Jump to error handler +.cmdERRORext +mov (r0),r0 ; Get error number +jmp IO_QUIT + +; STOP +; ==== +.cmdSTOP +#ifdef DEBUG + jmp IO_QUIT0 +#endif +jsr pc,Error +equb 0,tknSTOP,0 +align + + +; Program environment commands +; ============================ + +; PAGE= - Set default program start +; --------------------------------- +; Check for '=', evaluate integer +; Set PAGE +.cmdPAGE +jsr pc,EvalEqual ; Check for '=', get integer +bic #1,r4 ; Ensure word aligned +mov r4,SV_PAGE ; Set PAGE +rts pc + +; HIMEM= - Set top of BASIC memory, clearing stack +; ------------------------------------------------ +; Check for '=', evaluate integer +; Check enough space +; Set HIMEM +; Set machine stack = HIMEM +; Drops all subroutines +; +.cmdHIMEM +jsr pc,EvalEqual ; Check for '=', get integer +bic #1,r4 ; Ensure word aligned +;mov r4,r0 +;sub #256,r0 ; Check moving HIMEM will leave some free space +;jsr pc,CheckFreeMemR0 ; Check this will leave 256+256 bytes free +mov r4,r1 +jsr pc,CheckFreeMemR1 ; Check that this will leave 256 bytes free +mov (sp),r1 ; Get cmdret +mov r4,SV_HIMEM ; Set HIMEM +mov r4,sp ; Reset machine stack +clr -(sp) ; Put zero at top of stack +mov sp,SV_STACK ; Set error stack +jmp (r1) ; Return to execution loop + +; WIDTH - Set output width +; ------------------------ +; Evaluate integer +; Set WIDTH +.cmdWIDTH +jsr pc,EvalInteger ; Get integer +movb r4,SV_WIDTH ; Set WIDTH +rts pc + +; TRACE [ON|OFF|] +; ------------------------ +.cmdTRACE +;jsr pc,SkipSpaceThis ; could be Next +jsr pc,SkipSpaceNext +clr r4 ; TRACE OFF is same as TRACE 0 +cmpb r0,#tknOFF ; Is it TRACE OFF? +beq cmdTRACEset ; Yes, jump to turn TRACE OFF +;mov #&FFFF,r4 ; TRACE ON is same as TRACE 65535 +inc r4 ; TRACE ON is same as TRACE all lines from 1 +cmpb r0,#tknON ; Is it TRACE ON? +beq cmdTRACEset +dec r5 ; Step back +jsr pc,EvalInteger ; Get line number (might end up with decr5/evalint subroutine) +;dec r5 ; Balance following inc r5 +.cmdTRACEset +;inc r5 ; Step past ON or OFF +mov r4,SV_TRACE +rts pc + + +; Program Editing commands +; ======================== + +; Check for double-token editing commands +; Only needed if extended LOAD and SAVE implemented +; ------------------------------------------------- +#ifdef FILEEXTN + .cmdDELETE + movb (r5),r0 + sub #&8F,r0 ; Check for double token + bcs cmdDELETE1 ; <&8F, continue into DELETE + cmp r0,#&0C + bcc cmdDELETE1 ; >&9A, continue into DELETE + inc r5 ; Step past double token + adr CommandC7,r1 ; Point to replacement token bytes + add r0,r1 ; Index into table + movb (r1),r0 ; Get replacement token byte + jmp ExecByteCommand ; Return to dispatcher + .CommandC7 + EQUB &C6-&C6,&100-&C6,&C7-&C6, &CE-&C6 ; AUTO, xx, DELETE, EDIT/PUT + EQUB &100-&C6, &C9-&C6,&C8-&C6,&100-&C6 ; xx, LIST, LOAD, xx + EQUB &CA-&C6, &CB-&C6,&CC-&C6, &CD-&C6 ; NEW, OLD, RENUMBER, SAVE + ; Unsupported double tokens converted to tkn100 -> Syntax error +#endif + + +; AUTO - Prompt for auto line numbers +; ----------------------------------- +.cmdAUTO +;jsr pc,FindTOP ; Check program consistancy +jsr pc,ParseLines10 ; Get line number parameters, default to 10,10 +mov r4,SV_AUTO ; Set AUTO line +movb r3,SV_STEP ; Set AUTO step +jsr pc,FindTOP ; Check program consistancy, r5=>TOP-2 + ; Fall through to return to Immediate loop + +; DELETE - Delete lines from program +; ---------------------------------- +#ifndef FILEEXTN + .cmdDELETE +#endif +.cmdDELETE1 ; Unimplemented +.cmdLISTend +jmp ImmediateLoop + +; LISTO - set listing options +; --------------------------- +.cmdLISTO +jsr pc,EvalInteger1 ; Step past 'O' and Evaluate +movb r4,SV_OPTIONS +rts pc + +; LIST - List program in memory +; ----------------------------- +.cmdLIST +cmpb (r5),#ASC"O" ; Is it LISTO? +beq cmdLISTO +;jsr pc,FindTOP ; Ensure not a Bad Program +clr r4 ; Start line number +mov #&FFFF,r3 ; End line number +jsr pc,ParseLines ; Get line number parameters +bcs cmdLISTstart +mov r4,r3 ; One parameter, change to LIST r4,r4 +.cmdLISTstart +jsr pc,FindTOP ; Ensure not a Bad Program, r5=>TOP-2 +jsr pc,LineFind ; Find the line in R4, terminating line in R3 +mov r1,r5 ; Point to starting line +inc r5 ; Point to line number high byte +.cmdLISTlp +movb (r5)+,r4 ; Get line high/terminator +cmpb r4,#&FF +beq cmdLISTend ; End of program +swab r4 ; Put high byte right way around +movb (r5)+,r0 ; Get line number low byte +inc r5 ; Step past length byte +bic #&00FF,r4 +bic #&FF00,r0 +bis r0,r4 ; Merge each byte together +;cmp r4,r3 ; Compare with end line number +cmp r3,r4 ; Compare with end line number +bcs cmdLISTend ; Gone past final line +;bcs cmdLISTcont +;clr r3 ; This is final line +;.cmdLISTcont +mov r3,-(sp) ; Save final line number +mov #5,r1 ; Pad decimal with 5 spaces +.cmdLISTnumber +jsr pc,PrintLineNumber ; Output R4 as line number, corrupts r3,r2 +clr r3 ; R3=quote flag +.cmdLISTbyte +movb (r5)+,r0 ; Get character from line +cmpb r0,#13 ; End of line? +beq cmdLISTcr +cmpb r0,#tknLINENUM ; Inline line number? +beq cmdLISTline ; Keeping here shortens code +cmpb r0,#34 +bne cmdLISToutput ; Not a quote +xor r0,r3 ; Toggle quote flag - tested within PrintR0TokenChar +.cmdLISToutput +jsr pc,PrintR0TokenChar; Print character or token, corrupts r0,r1,r2 +br cmdLISTbyte ; Loop for next byte +.cmdLISTline +jsr pc,fnLineNum ; Get inline line number +clr r1 ; Decimal, no padding +br cmdLISTnumber +.cmdLISTcr +jsr pc,cmdPrintNewline ; Print newline +jsr pc,IO_EscapeFast ; Check for Escape bypassing any ticker +mov (sp)+,r3 ; Get end line number back +br cmdLISTlp ; Loop for next line if not at end +;bne cmdLISTlp ; Loop for next line if not at end +;.cmdLISTend +;jmp ImmediateLoop ; Jump to immediate mode + + +; Stacked program loops and subroutines +; ===================================== + +; FOR loop=start TO limit [STEP step] +; =================================== +; On entry, sp=>cmdret +; On exit, sp=>tknFOR, step r4/r3/r2, limit r4/r3/r2:type, ^variable, saved r5 +; We don't need to check for free memory, as VarFindCreate and Evaluate checks +; +.cmdFOR +jsr pc,VarFindCreate ; Look for and create variable +bit #&FF00,r3 +bne errBadFORVar ; FOR variable not a number +mov r4,-(sp) ; Stack address of variable's data block +;swab r3 +mov r3,-(sp) ; Stack variable's type 1/4/5 for byte/int/real +jsr pc,cmdAssign2 ; Do FOR loop=start by doing loop=start +cmpb (r5),#tknTO +bne errMissingTO ; Missing TO +inc r5 ; FOR loop=start TO +jsr pc,EvalNumeric ; FOR loop=start TO limit +;swab r2 ; Swap exponent into top byte +;bis r2,(sp) ; Stack exponent:variable type +movb r2,1(sp) ; Merge exponent with variable type +mov r3,-(sp) ; Stack b0-b31 of limit +mov r4,-(sp) +mov #1,r4 +clr r3 +clr r2 ; step=1 +cmpb (r5),#tknSTEP ; Is there a STEP? +bne cmdFOR2 ; No step, use default of 1 +inc r5 ; Step past STEP +jsr pc,EvalNumeric ; FOR loop=start TO limit STEP step +.cmdFOR2 +;mov r2,r0 +;bis r3,r0 +;bis r4,r0 +;beq errStepZero ; STEP cannot be zero - STEP is allowed to be zero +mov r2,-(sp) ; Stack step +mov r3,-(sp) +mov r4,-(sp) +;jsr pc,UpdateLPTRthis ; Skip to start of loop code, r5=>current char +jsr pc,UpdateLPTRnext ; Skip to start of loop code, r5=>next char +dec r5 ; r5=>current char +mov #tknFOR,-(sp) ; Stack FOR token +mov 16(sp),r1 ; Get cmdret +mov r5,16(sp) ; Store saved line pointer +mov sp,SV_STACK ; Set current stack context +jmp (r1) ; Return to execution loop + +.errNoFOR +jsr pc,Error +equb 32,"Not in a ",tknFOR," loop",0 +align +.errCantMatch +jsr pc,Error +equb 33,"Can't match ",tknFOR,0 +align +.errBadFORVar +jsr pc,Error +equb 34,"Bad ",tknFOR," variable",0 +align +;.errStepZero +;jsr pc,Error +;equb 35,"Bad ",tknSTEP,0 +;align +.errMissingTO +jsr pc,Error +equb 36,tknMissing,tknTO,0 +align +.jmpNoSuchVar3 +jmp errNoSuchVar + +; NEXT [var[,var[...]] +; ==================== +; On entry, sp=>cmdret, tknFOR, step r4/r3/r2, limit r4/r3/r2:type, ^variable, saved r5 +; +.cmdNEXTlp +;inc r5 ; Step past comma +.cmdNEXT +cmpb 2(sp),#tknFOR +bne errNoFOR ; Innermost loop is not a FOR/NEXT +mov 16(sp),r4 ; Get address of variable +;movb 15(sp),r3 ; Get variable type +movb 14(sp),r3 ; Get variable type 0/4/5 +;swab r3 +;bic #&FF00,r3 +jsr pc,CheckEndStatement ; Any parameters? +beq cmdNEXT2 ; Use the stacked variable +cmp r0,#ASC"," ; Is it NEXT ,,,, +beq cmdNEXT2 ; Use the stacked variable +jsr pc,VarFindExist ; Look for variable +beq jmpNoSuchVar3 +cmp r4,16(sp) ; Is it the current loop? +bne errCantMatch ; Badly nested loop +.cmdNEXT2 +; r4=>variable, r3=variable type/size +jsr pc,VarFindValNum ; Get the current value +mov 6(sp),-(sp) ; Stack step high +mov 6(sp),-(sp) ; Stack step low +mov 12(sp),-(sp) ; Stack step exponent +mov #&88,r0 ; r0='ADD' +jsr pc,fnAdd ; loop=loop+step +mov 16(sp),r1 ; Get address of variable +;movb 15(sp),r0 ; Get variable type +movb 14(sp),r0 ; Get variable type +;swab r0 +;bic #&FF00,r0 +jsr pc,cmdAssignNumber ; Update the loop variable +swab r4 ; cmdAssignNumber returns r4/r3 byte swapped +swab r3 +mov 12(sp),-(sp) ; Stack limit high +mov 12(sp),-(sp) ; Stack limit low +;mov 18(sp),r1 +;bic #&FF00,r1 +movb 19(sp),r1 ; Get limit exponent +bic #&FF00,r1 +mov r1,-(sp) ; Stack limit exponent +movb #&7B,r0 ; r0=">=" +tst 12(sp) ; Check sign of step - BUG? is this correct for floats? +bpl cmdNEXT3 ; Positive step, do ">=" compare +movb #&79,r0 ; Negative step, do "<=" compare +.cmdNEXT3 +jsr pc,fnCompare +bis r3,r4 +beq cmdNextDrop ; Loop completed +mov 18(sp),r5 ; Point back to start of loop +rts pc ; Return to execution loop +.cmdNextDrop +mov (sp),18(sp) ; Move return address to top of stack entry +add #18,sp ; Drop this FOR/NEXT +mov sp,SV_STACK +add #2,SV_STACK ; Set stack context to outside this loop +;jsr pc,SkipSpaceThis ; could be Next, swap inc for dec +jsr pc,SkipSpaceNext +cmpb r0,#ASC"," ; Is there another FOR/NEXT variable? +beq cmdNEXTlp ; Loop back to test this one +dec r5 +rts pc ; Drop out from FOR/NEXT loop + + +; REPEAT +; ====== +; On entry, sp=>cmdret +; On exit, sp=>tknREPEAT, saved r5 +; We don't need to check for free memory, as following code will end up calling Evaluate +; +.cmdREPEAT +;jsr pc,UpdateLPTRthis ; Skip to start of loop code, r5=>current char +jsr pc,UpdateLPTRnext ; Skip to start of loop code, r5=>next char +dec r5 ; r5=>current char +mov (sp),r1 ; Get cmdret +mov r5,(sp) ; Save line pointer +mov #tknREPEAT,-(sp) ; Stack REPEAT token +mov sp,SV_STACK ; Set current stack context +jmp (r1) ; Return to execution loop + +; UNTIL x +; ======= +; On entry, sp=> cmdret, tknREPEAT, saved r5 +; +.cmdUNTIL +cmpb 2(sp),#tknREPEAT +beq cmdUNTILtest +jsr pc,Error +equb 43,"No ",tknREPEAT,0 +align +.cmdUNTILtest +jsr pc,EvalInteger +bis r3,r4 ; Is it zero? +beq cmdUNTILfalse ; UNTIL FALSE, return to REPEAT routine +mov (sp)+,r1 ; Get cmdret +cmp (sp)+,(sp)+ ; Drop tknREPEAT, savedR5 +mov sp,SV_STACK ; Set context to outside loop +jmp (r1) ; Return to execution loop +.cmdUNTILfalse +mov 4(sp),r5 ; Get saved r5 +rts pc ; Return to continue executing + + +; RESTORE [DATA][ERROR]([+]) +; =================================== +; On entry, sp=> cmdret, tknFN/PROC, tknERROR/tknDATA, savedR5 +; +.cmdRESTORE +mov SV_PAGE,r1 ; Default to RESTORE +jsr pc,CheckEndStatement +beq cmdRestoreLine ; No parameter, restore to PAGE +adr SV_ONERR,r3 ; r3=>SV_ERROR +cmpb r0,#tknERROR +beq cmdRestore1 ; RESTORE ERROR +tst (r3)+ ; r3=>SV_DATA +cmpb r0,#tknDATA +beq cmdRestore1 ; RESTORE DATA +#if SV_ONERR+2<>SV_DATA + #error SV_ONERR+2 <> SV_DATA +#endif +clr r4 ; Restore from start of program +cmpb r0,#ASC"+" +bne cmdRESTOREline +mov SV_LINE,r4 ; Restore from current line +inc r5 ; Step past '+' +.cmdRESTOREline +jsr pc,GetLineNumOffset ; Evaluate and look for line offset from r4 +.cmdRestoreLine +mov r1,SV_DATA ; RESTORE linenum +rts pc + +; RESTORE [DATA][ERROR] +; --------------------- +; sp=>cmdret, PROC/FN, DATA/ERROR, data ... +; +.cmdRestore1 +tst 2(sp) +beq errNotLocal ; Nothing stacked +cmpb 4(sp),r0 ; Does token match stacked token? +bne errNotLocal ; Popping wrong way around +mov (sp)+,r1 ; Get return address +mov (sp)+,r2 ; Get PROC/FN token +tst (sp)+ ; Pop past DATA/ERROR token +; +mov (sp),(r3) ; Restore ONERR or DATA +mov r2,(sp) ; Restack PROC/FN token + +;cmpb r0,#tknERROR +;beq RestoreError +;.RestoreData +;mov (sp)+,SV_DATA ; Restore DATA +;br RestoreFinish +;.RestoreError +;mov (sp)+,SV_STACK ; Restore stack context +;mov (sp)+,SV_ONERR ; Restore ON ERROR pointer +;.RestoreFinish +;mov r2,-(sp) ; Restack PROC/FN token + +mov sp,SV_STACK ; Update stack context +jmp (r1) + +;.errNoRestore +;jsr pc,Error +;equb 54,tknERROR,"/",tknDATA," not ",tknLOCAL,0 +;align + +; LOCAL [DATA][ERROR] +; ================================= +; sp=> cmdret, &0000 +; sp=> cmdret, token, .... +; +.cmdLOCAL +mov (sp)+,r1 ; r1=return address +mov (sp),r2 ; Get stacked loop token +cmpb r2,#tknFN +beq cmdLocal1 ; Within a FN - ok +cmpb r2,#tknPROC +beq cmdLocal1 ; Within a PROC - ok +.errNotLocal +jsr pc,Error +equb 12,"Not ",tknLOCAL,0 +align +.cmdLocal1 +jsr pc,SkipSpaceNext +adr SV_ONERR,r3 ; r3=>SV_ERROR +cmpb r0,#tknERROR +beq cmdLocalError ; LOCAL ERROR +tst (r3)+ ; r3=>SV_DATA +cmpb r0,#tknDATA +beq cmdLocalData ; LOCAL DATA + +; LOCAL variables +; --------------- +dec r5 ; Balance forthcoming inc r5 +dec r5 ; Balance forthcoming inc r5 +mov r5,r4 ; Point to variable to localise +clr r0 ; r0=0 - not PROC/FN call +; ; r4=>variables +; ; sp=>PROC/FN, data... +br cmdSubLoop ; Jump to localise variables + +; LOCAL [ERROR][DATA] +; ------------------- +; sp=>PROC/FN, local data.... +; r1= return address +; +.cmdLocalData +;mov SV_DATA,(sp) ; Stack data pointer +;br cmdLocalExit +.cmdLocalError +;mov SV_ONERR,(sp) ; Stack error handler +;mov SV_STACK,-(sp) ; Stack error context + +mov (r3),(sp) ; Stack SVONERR or SVDATA + +.cmdLocalExit +bic #&FF00,r0 ; Ensure token = &00xx +mov r0,-(sp) ; Stack ERROR/DATA token +mov r2,-(sp) ; Stack FN/PROC token +mov sp,SV_STACK ; Update current stack context +jmp (r1) ; Return to caller + +; =FN[(parameters)] +; ================================= +.fnFN +mov #tknFN,r0 +br cmdSubroutine + +; PROC[()] +; ==================================== +.cmdPROC +mov #tknPROC,r0 + +; Call FN/PROC subroutine +; ----------------------- +; On entry, +; r0=FN or PROC token +; r5=>start of FN/PROC name +; sp=>fnret/cmdret +; On return to Execute loop, +; sp=>token, {local data}, &0000, savedSVSTACK, savedLPTR, fnret/cmdret +; +.cmdSubroutine +mov r0,-(sp) ; Save FN/PROC token +cmpb (r5),#ASC"(" ; PROC( or FN( ? +beq cmdSubIndir ; Indirect FN/PROC call +jsr pc,FindSubroutine ; Find subroutine in heap or program +br cmdSubFound ; Jump to execute it + +; Indirect subroutine call +; ------------------------ +; Syntax is A%=^PROCfred:PROC(A%) +; A%=^PROCfred sets A%=>PROCfred's data block +; PROC(A%) fetches destination address from location A% +; +.cmdSubIndir +;jsr pc,Evaluate ; Get indirect address, also parse ')' +jsr pc,EvalBracket1 ; Get indirect address within brackets + ; r4=>FN/PROC info block + +.cmdSubFound +mov (r4),r4 ; r4=>start of subroutine +mov (sp)+,r1 ; Get FN/PROC token back +mov r5,-(sp) ; Stack caller LPTR +mov sp,r0 ; r0=>caller LPTR on stack +mov SV_STACK,-(sp) ; Stack caller's stack context +clr -(sp) ; Stack 'no more local data' +mov r1,-(sp) ; Stack FN/PROC token +; +; r0=>caller LPTR on stack +; r1= FN/PROC token +; r4=>start of destination subroutine +; r5=>caller LPTR +; sp=> FN/PROC, &0000, caller LPTR, cmdret +; +; DEFPROCfred +; DEFPROCfred:... +; DEFPROCfred(... +; r4=>-----^ +; +; PROCfred +; PROCfred:... +; PROCfred(... +; r5=>-----^ +; +cmpb (r5),#ASC"(" +bne cmdSubCall ; No calling parameters +cmpb (r4),#ASC"(" +bne errArguments ; Calling params, but no dest params + +.cmdSubLoop +; r0= address of caller LPTR on stack or &0000 for LOCAL +; r4=>start of destination subroutine or variables for LOCAL +; r5=>caller LPTR +; sp=> FN/PROC, &0000, caller SVSTACK, caller LPTR, cmdret +; +mov r0,-(sp) ; sp=> addr(caller LPTR), FN/PROC, &0000, caller SVSTACK, callerLPTR, cmdret +mov r4,r5 ; Point to dest params +inc r5 ; Step past dest '(' or ',' +jsr pc,VarFindCreate ; Look for destination variable +; +; r4=address of data block +; r3=size/type of variable +; 0001 - byte +; 0004 - integer +; 0005 - real +; 8000 - dynamic string +; 8100 - $string +; 8200 - $$string +; 4xxx - array of number - error generated later +; Cxxx - array of string - error generated later +; +mov SV_VAREND,r0 ; Save data at top of heap +mov r4,(r0)+ ; Save data address +mov (sp)+,(r0)+ ; Save pointer to caller LPTR +mov (sp)+,(r0)+ ; Save FN/PROC +mov r3,-(sp) ; Stack data type/size +jsr pc,VarFindValFetch ; Fetch data value +mov (sp)+,r0 ; r0=data type/size +jsr pc,StackValAndOp ; Stack it and type/size + ; sp=> &0001, &0000, &lolo, &hihi, &0000, caller SVSTACK, caller LPTR, cmdret - byte + ; sp=> &0004, &0000, &lolo, &hihi, &0000, caller SVSTACK, caller LPTR, cmdret - integer + ; sp=> &0005, &00ee, &lolo, &hihi, &0000, caller SVSTACK, caller LPTR, cmdret - real + ; sp=> &8x00, &80nn, string, align, &0000, caller SVSTACK, caller LPTR, cmdret - string +mov (sp)+,r1 ; r1=type/size +mov (sp),r2 ; r2=type +bic #&00FF,r2 ; Remove length/exponent from type +bmi cmdSubSwap1 +swab r1 ; Move number size to top byte +.cmdSubSwap1 ; r1=&0100, &0400, &0500, &8000, &8100, &8200 +bis (sp),r1 ; r1=&0100, &0400, &05ee, &81nn, &81nn, &82nn +mov SV_VAREND,r0 +mov (r0)+,(sp) ; sp=> addr, &lolo, &hihi, &0000, caller LPTR, cmdret - integer +; ; sp=> addr, &lolo, &hihi, &0000, caller LPTR, cmdret - real +; ; sp=> addr, string, align, &0000, caller LPTR, cmdret - string +mov r1,-(sp) ; sp=> &0100, addr, &lolo, &hihi, &0000, caller LPTR, cmdret - byte +; ; sp=> &0400, addr, &lolo, &hihi, &0000, caller LPTR, cmdret - integer +; ; sp=> &05ee, addr, &lolo, &hihi, &0000, caller LPTR, cmdret - real +; ; sp=> &8xnn, addr, string, align, &0000, caller LPTR, cmdret - string +; ; sp=> &00xx - token +; +mov (r0)+,r1 ; r1=address of LPTR +mov (r0)+,-(sp) ; sp=>FN/PROC, type, addr, etc. +mov r5,-(sp) ; sp=>Dest LPTR, FN/PROC, type, addr, etc. +clr r4 +clr r3 ; Set value to null, r2 set eariler from stack +mov r1,-(sp) ; sp=>addr(caller LPTR), dest LPTR, FN/PROC, type, addr, etc. +tst r1 ; *BUGFIX* RT11EM doesn't set EQ/NE from mov r1,-(sp) +beq cmdSubLocalise1 ; addr(LPTR)=0 - LOCAL, set to null +mov (r1),r5 ; Get caller LPTR +;inc r5 ; Step past '(' or ',' +;jsr pc,Evaluate ; Evaluate caller's passed parameter +jsr pc,Evaluate1 ; Step past '(' or ',', then evaluate caller's passed parameter + ; r4/r3/r2=data +.cmdSubLocalise1 +mov 8(sp),r0 ; Get data address +mov 6(sp),r1 ; Get data size/type +bic #&00FF,r1 ; Remove len/exp from bottom of word +bmi cmdSubSwap2 ; Jump if string +swab r1 ; Move number size to bottom byte +.cmdSubSwap2 ; r1=&0001, &0004, &0005, &8000, &8100, &8200 +jsr pc,cmdAssignData ; Store data to destination variable +mov (sp)+,r0 ; Get pointer to caller LPTR +beq cmdSubLocalise2 ; addr(LPTR)=0 - LOCAL +mov r5,(r0) ; Update caller LPTR on stack + ; sp=> dest LPTR, FN/PROC, type, addr, data, &0000, caller SVSTACK, caller LPTR, cmdret +.cmdSubLocalise2 +mov (sp)+,r4 ; Get dest LPTR back + ; sp=> FN/PROC, type, addr, data, &0000, caller LPTR, cmdret +; +; r0=>caller LPTR on stack or &0000 for LOCAL +; r4= destination LPTR =>',' or ')' +; r5= caller LPTR =>',' or ')' +; sp=> FN/PROC, {data,} &0000, caller LPTR, cmdret +; +cmpb (r4),#ASC"," +bne cmdSubParams ; No more params +tst r0 +beq cmdSubLoop ; r0=&0000 - LOCAL +cmpb (r5),#ASC"," +beq cmdSubLoop ; Do another parameter +.errArguments +jsr pc,Error +equb 31,"Arguments",0 +align + +.cmdSubParams +tst r0 +beq cmdSubCallGo ; r0=&0000 - LOCAL, continue execution +inc (r0) ; Step caller's LPTR on stack past ')' +movb (r5),r0 ; Get caller char, ')' stepped past on stack +jsr pc,CheckClose1 ; Caller must end with ')' +movb (r4)+,r0 ; Get dest char and step past +jsr pc,CheckClose1 ; Dest must end with ')' +; +.cmdSubCall +; r4=>start of destination subroutine +; r5=>caller LPTR +; sp=> FN/PROC, {data,} &0000, caller SVSTACK, caller LPTR, cmdret +cmpb (r4),#ASC"(" +beq errArguments ; Calling params, but no dest params +.cmdSubCallGo +mov sp,SV_STACK ; Set current stack context +mov r4,r5 ; Set line pointer to start of subroutine +jmp Execute ; And start executing + +;.errBadCall +;jsr pc,Error +;equb 30,"Bad call",0 +;align + +; Pop stacked localised data and return from subroutine calls +; =========================================================== +; Stack holds +; cmdret, &0000 - empty +; cmdret, &00nn - token +; cmdret, &nnxx - data +; +; Bottom of stack, looping and subroutine structures +; cmdret, tknFOR, step[6], limit[5], vartype[1], ^variable, saved r5 +; cmdret, tknREPEAT, saved r5 +; cmdret, tkkGOSUB, saved r5 +; cmdret, tknERROR, saved SV_STACK, saved SV_ONERR (STSTACK already saved, can it be omitted here?) +; cmdret, tknDATA, saved SV_DATA +; +; Next up stack, subroutine structures +; cmdret, tknPROC, {type, addr, data...}, &0000, caller SVSTACK, saved r5 +; cmdret, tknFN, {type, addr, data...}, &0000, caller SVSTACK, saved r5 +; +; {type, addr, data} includes: +; tknDIM, aligned size, DIM LOCAL data - todo +; +; {type, addr, data} stacked local data: +; &0000 - end of stacked data +; &00nn - token +; Token will always be >&7F, so could use &00nn for byte/int size +; but we use &8nnn for string +; &0100, address, b0-b15, b16-b31 - byte +; &0400, address, b0-b15, b16-b31 - integer +; &05ee, address, mantis, mantis - real +; &80nn, address, string, align - string +; &81nn, address, string, align - $address +; &82nn, address, string, align - $$address +; (&2xxx, address, - RETURN variable - todo) +; +; = +; ======== +; On entry, sp=> cmdret, {stacked loops,} tknFN, {locals... } &0000, caller SVSTACK, saved r5, fnret, ... +; If empty, sp=> cmdret, &0000 +.cmdEquals +jsr pc,Evaluate ; r4/r3/r2=return value +bpl cmdEqualsNum ; Not string +; +; Copy string to string buffer to prevent eg =A$ being overwritten by deLOCALising A$ +; +mov r3,-(sp) ; Save length +;mov r3,r2 ; r2=length +;mov r4,r3 ; r3=string start +;jsr pc,CopyString ; Copy string to string buffer +jsr pc,EnsureString ; Copy string to string buffer +mov (sp)+,r3 ; Get length back +mov #&8000,r2 ; r2=&8000 - string +.cmdEqualsNum +mov r4,-(sp) +mov r3,-(sp) +mov r2,-(sp) ; Save return value +mov #tknFN,r0 ; Within FN call +br cmdFNENDPROC + + +; ENDPROC +; ======= +; On entry, sp=> cmdret, {stacked loops/data/error,} tknPROC, {locals... } &0000, saved SVSTACK, saved LPTR, cmdret, ... +; If empty, sp=> cmdret, &0000 +; +.cmdENDPROC +sub #6,sp ; Make space on stack to balance later restore +mov #tknPROC,r0 +.cmdFNENDPROC +mov sp,r1 ; r1=>rettype, retval, retval, cmdret, tknXX, ... +add #8,r1 ; r1=>tknXXX, any stacked data +mov r0,-(sp) ; (sp)=subroutine token +.cmdPopLoop +mov (r1)+,r0 ; Get token from bottom of stack +cmpb r0,(sp) +beq cmdPopCall ; Matching subroutine token +cmpb r0,#tknFOR +beq cmdPopFor +cmpb r0,#tknREPEAT +beq cmdPopRepeat +;cmpb r0,#tknGOSUB ; Error to try to ENDPROC out of a GOSUB +;beq cmdPopGosub +cmpb (sp)+,#tknFN +beq errNoFN +jsr pc,Error +equb 13,"Not in a ",tknPROC,0 +align +.errNoFN +jsr pc,Error +equb 7,"Not in a function",0 +align +.cmdPopFor +add #14,r1 ; Drop step, limit, type, variable +.cmdPopRepeat +.cmdPopGosub +tst (r1)+ ; Drop savedR5 +br cmdPopLoop ; Loop to pop any more data + +; Localised program loops popped off stack +; r1=>{size, addr, data}, &0000, savedSVSTACK, savedLPTR, cmdret +; +; {type, addr, data} stacked local data: +; &0000 - no more local data +; &0085, address, address - LOCAL ERROR +; &00DC, address - LOCAL DATA +; &00xx, size, space, align - DIM LOCAL +; &0100, address, b0-b15, b16-b31 - byte +; &0400, address, b0-b15, b16-b31 - integer +; &05ee, address, mantis, mantis - real +; &80nn, address, string, align - string +; &81nn, address, string, align - $address +; &82nn, address, string, align - $$address +; +; Localised ERROR and DATA pointers popped off stack +; ideally like to be able to access stack items with ?addr !addr |addr +; would require b0-b7 b8-b15 b16-b23 b24-b31 exp/type +; but for strings and bytes, bottom byte on stack needs to be data type +; +.cmdPopData +;mov (r1)+,SV_DATA ; Restore data handler +;br cmdPopCall ; Continue to pop any more data +.cmdPopError +;mov (r1)+,SV_STACK ; Restore stack context (already saved?) +;mov (r1)+,SV_ONERR ; Restore error handler +mov (r1)+,(r3) ; Restore ONERR or DATA + ; Continue to pop any more data + +.cmdPopCall +mov (r1)+,r0 ; r0=&0000 or variable size &0100,&0400,&05ee or token +beq cmdPopDone ; No more localised items +bmi cmdPopString ; &8xnn -> string +adr SV_ONERR,r3 ; r3=>SV_ERROR +cmp r0,#tknERROR ; Pop local ERROR state +beq cmdPopError +inc r3 ; r3=>SV_DATA +cmp r0,#tknDATA ; Pop local DATA pointer +beq cmdPopData +mov (r1)+,r3 ; r3=address of data +mov (r1)+,r4 ; r4=b0-b15 +mov r1,-(sp) ; save pointer into stack +mov (r1),-(sp) ; Copy b16-b31 to stack +mov r3,r1 ; r1=address of data +mov (sp)+,r3 ; r3=b16-b31 +mov r0,r2 ; r2=exponent +swab r0 ; Move data size to bottom byte +bic #&FF00,r0 ; Remove exponent from data size +bic #&FF00,r2 ; Remove size from exponent +; +; r0=data size 1, 4 or 5 - byte stored on stack as a word +; r1=>data block +; r2/r3/r4=value +jsr pc,cmdAssignNumber ; Restore numeric variable +; +mov (sp)+,r1 ; Get pointer to stacked data back +tst (r1)+ ; Step past b16-b31 on stack +br cmdPopCall ; Loop to unstack next item + +;bit #&0100,r2 ; Is it a byte? +;beq cmdPopNumber ; No, pop six bytes +;tst -(r1) ; Balance r1 for later +;mov r2,r4 +;bic #&FF00,r4 ; r4=byte value +;mov r1,-(sp) ; save pointer +;mov r3,r1 ; r1=address of data +;clr r3 +;clr r2 ; r2/r3/r4=byte value +;br cmdPopNumAssign ; Jump to assign it and loop for next + +; r0=&80nn, sp=>address, string, align - string +; r0=&81nn, sp=>address, string, align - $address +; r0=&82nn, sp=>address, string, align - $$address +.cmdPopString +mov r0,r2 ; r2=&8x00+string length +mov (r1)+,r0 ; r0=destination address +; +; r0=destination address (string info block or absolute string base) +; r1=>source string +; r2=&8x00+string length +; r3=temp +; +jsr pc,cmdAssignString2 +inc r1 +bic #1,r1 ; Ensure r1 evenly aligned +br cmdPopCall ; Loop for any more + +; All localised items popped from stack +; r1=>savedSVSTACK, savedLPTR, cmdret +; sp=>token, r2, r3, r4 +.cmdPopDone +;#ifdef DEBUG +; mov SV_STACK,r0 +; jsr pc,Debug_DumpRegsHex +; mov sp,r5 +; jsr pc,Debug_DumpMem +; mov r1,r5 +; jsr pc,Debug_DumpMem +;#endif +tst (sp)+ ; Drop token +mov (sp)+,r2 ; Fetch any return value +mov (sp)+,r3 +mov (sp)+,r4 +mov r1,sp ; Point to new stack top +mov (sp)+,SV_STACK ; Restore stack context +mov (sp)+,r5 ; Get stacked program pointer +;mov (sp)+,r1 ; Get return address +tst r2 ; Set return value flags +;jmp (r1) ; ...and return +rts pc ; ...and return + + +; IF [THEN ...] [ELSE ...] +; ================================== +.cmdIF +jsr pc,EvalInteger +bis r3,r4 ; Is it zero? +bne cmdIFexit ; Continue +.cmdIFelse +movb (r5)+,r0 +cmpb r0,#tknELSE +beq cmdIFexit ; ELSE found, continue from here +cmpb r0,#13 +beq cmdIFexit1 ; No ELSE found, step back to and continue on next line +cmpb r0,#34 +bne cmdIFelse ; Not a quote, keep looking for ELSE +.cmdIFquote +movb (r5)+,r0 ; Look for closing quote +cmpb r0,#34 +beq cmdIFelse ; Loop back to look for ELSE +cmpb r0,#13 +bne cmdIFquote ; Not , keep looping until closing quote found +; End of line found, step back to and continue on next line +; This can be moved to a convenient nearby dec r5/rts +.cmdIFexit1 +dec r5 +.cmdIFexit +rts pc + + +; ON, ON ERROR, ON x GOTO, ON x GOSUB, ON x PROC +; ============================================== +.cmdON +jsr pc,CheckEndStatement +bne cmdON1 +jmp cmdONvdu ; ON - turn on cursor +.cmdON1 +cmpb r0,#tknERROR ; Is it ON ERROR? +bne cmdONswitch ; No, jump to ON x [GOTO|PROC] +jsr pc,FetchNextChar +cmpb r0,#tknOFF ; Is it ON ERROR OFF? +beq cmdONErrorOff ; Yes, jump to turn ON ERROR OFF +mov r5,SV_ONERR ; Point ON ERROR to here +jmp SkipLine ; Skip rest of line and continue +.cmdONErrorOff +clr SV_ONERR ; ON ERROR OFF +inc r5 ; Step past OFF token +rts pc + +; ON [GOTO|GOSUB|PROC] +; -------------------------- +.cmdONswitch +jsr pc,EvalInteger ; Get +movb (r5)+,r0 ; Get following token +cmpb r0,#tknGOTO +beq cmdONswitch1 ; ON GOTO... +cmpb r0,#tknGOSUB +beq cmdONswitch1 ; ON GOSUB... +;cmpb r0,#tknPROC +;beq cmdONswitch1 ; ON PROC... +jsr pc,Error +equb 39,tknON," syntax",0 +align +; +.cmdONswitch1 +; r5=>switch token, r0=switch token +; r4/r3=index into switch +tst r3 +bne cmdONelse ; ON >65535 - out of range, look for an ELSE +dec r4 ; 0->65535, 1-65535->0-65534 +bit #&FF80,r4 +bne cmdONelse ; ON >127 or ON zero - out of range, look for an ELSE + ; Unrealistic to expect num>127 as max line length is 253 chars +tst r4 +beq cmdONfound ; First destination, use it +.cmdONsearch ; Look for a comma +movb (r5)+,r1 ; Get character from line, r0=GOTO/GOSUB +cmpb r1,#13 +beq errONrange ; - end of line, error +cmpb r1,#3A +beq errONrange ; Colon - end of statement, error +cmpb r1,#tknELSE +beq cmdONfound ; ELSE clause, end of clauses, fall through +cmpb r1,#ASC"," +bne cmdONsearch ; Otherwise, keep looking for a comma +dec r4 ; Decrease counter +bne cmdONsearch ; Loop until counter decremented to zero +.cmdONfound +cmpb r0,#tknGOTO +bne cmdONgosub ; Not GOTO, jump to do ON GOSUB +inc r5 ; Balance next dec r5, fall through into GOTO + + +; GOTO +; ============== +.cmdGOTO1 +dec r5 ; Step back to point to LINNUM token +.cmdGOTO +jsr pc,GetLineNumber ; Evaluate and look for line +mov r1,r5 ; Point to GOTO destination +.cmdGOTOok +rts pc ; Continue executing + +; ON GOSUB +; -------------- +.cmdONgosub +jsr pc,GetLineNumber ; Evaluate line number and find destination +.cmdONswitch3 +movb (r5)+,r0 ; Step past any more clauses to find RETURN point +cmpb r0,#&3A +beq cmdONswitch4 ; End of statement, RETURN to here +cmpb r0,#13 +bne cmdONswitch3 ; End of line, RETURN to here +dec r5 ; Step back to point to +.cmdONswitch4 +br cmdGOSUB1 ; Continue into GOSUB + +; ON out of range, look for an ELSE clause +; ---------------------------------------------- +.cmdONelse +movb (r5)+,r1 +cmpb r1,#tknELSE ; Look for ELSE clause +beq cmdONfound ; Found ELSE, use it for GOTO/GOSUB destination +cmpb r1,#13 ; Loop until end of line +bne cmdONelse ; If end of line found, no ELSE clause found +.errONrange +jsr pc,Error +equb 40,tknON," range",0 +align + +; GOSUB +; =============== +; On entry, sp=>cmdret +; On exit, sp=>tknGOSUB, saved r5 +; We don't need to check for free memory, as Evaluate checks +; +.cmdGOSUB +jsr pc,GetLineNumber ; Evaluate and look for line +.cmdGOSUB1 +mov (sp),r0 ; Get cmdret +mov r5,(sp) ; Save current program pointer +mov #tknGOSUB,-(sp) ; Stack GOSUB token +mov r1,r5 ; Point to GOSUB destination +jmp (r0) ; Return to execution code + +.GetLineNumber +clr r4 +.GetLineNumOffset +mov r4,-(sp) +jsr pc,EvalInteger ; r4/r3=destination line number +add (sp)+,r4 +adc r3 +bne errNoSuchLine +jsr pc,LineFind ; r1=> before destination line if found +beq cmdGOTOok ; EQ - line found +.errNoSuchLine +jsr pc,Error +equb 41,"No such line",0 +align + +; RETURN +; ====== +; On entry, sp=> cmdret, tknGOSUB, savedR5 +; +.cmdRETURN +cmpb 2(sp),#tknGOSUB +beq cmdRETURNok +jsr pc,Error +equb 38,"No ",tknGOSUB,0 +align +.cmdRETURNok +mov (sp)+,r1 ; Get cmdret +tst (sp)+ ; Drop tknGOSUB +mov (sp)+,r5 ; Pop line pointer +jmp (r1) ; Return to execution loop + + +; PRINT - Print to output stream or to file +; ========================================= +.cmdPRINT +jsr pc,SkipSpaceThis +cmp r0,#ASC"#" ; Is it PRINT # ? +bne cmdPrintLoop ; Jump for normal PRINT + +; PRINT#chn,{items...} - Output to open file +; ------------------------------------------ +.cmdPRINTchn +;jsr pc,EvalInteger1 ; Step past '#', get channel +jsr pc,EvalHashInt1 ; Step past '#', get channel +mov r4,-(sp) ; Save channel +.cmdPRINTchnLp +jsr pc,SkipSpaceThis ; Get current character +cmpb r0,#ASC"," ; r0=next character +bne cmdPRINTchnEnd +;inc r5 ; Step past comma +;jsr pc,Evaluate ; (all these 'inc r5's could be moved to before Evaluate) +jsr pc,Evaluate1 ; Step past comma and evaluate expression +bmi cmdPRINTchnStr ; MI - string +beq cmdPRINTchnInt ; EQ - integer +mov #&FF,r0 ; &FF to indicate Real +br cmdPRINTchnNum +; +.cmdPRINTchnInt +mov #&40,r0 ; &40 to indicate Integer +.cmdPRINTchnNum +mov (sp),r1 ; Get channel +jsr pc,IO_BPUT ; Output &40/Int or &FF/Real +mov r2,-(sp) ; Save exponent +mov #2,r2 ; Two passes for two*2 bytes +mov r3,r0 ; First two bytes from r3 +.cmdPRINTchnIntLp +swab r0 +jsr pc,IO_BPUT ; Output b24-b31, then b8-b15 +swab r0 +jsr pc,IO_BPUT ; Output b16-b23, then b0-b7 +mov r4,r0 ; Second two bytes from r4 +dec r2 +bne cmdPRINTchnIntLp ; Loop to do two sets of two bytes +mov (sp)+,r0 ; Get exponent back +beq cmdPRINTchnLp ; &00, integer, loop back for next item +inc r0 ; Acorn files use bias-&7F, so need to add 1 +jsr pc,IO_BPUT ; Output exponent +br cmdPRINTchnLp ; Jump back for next item +; +.cmdPRINTchnStr +mov (sp),r1 ; Get channel +clr r0 +jsr pc,IO_BPUT ; Output &00 to indicate string +add r3,r4 ; Point r4 to end of string +mov r3,r0 +.cmdPRINTchnStrLp +jsr pc,IO_BPUT ; Output string length then string characters +tst r3 +beq cmdPRINTchnLp +dec r3 ; Decrement string length +movb -(r4),r0 ; Get character +br cmdPRINTchnStrLp ; Loop back to output it +; +;.cmdPRINTchnEnd +;tst (sp)+ ; Drop channel +;rts pc + +; PRINT main code +; --------------- +.cmdPrintComma +movb SV_VARS,r0 ; Get field width +beq cmdPrintLoop ; Zero, no padding needed, return to main loop +bic #&FF00,r0 ; Remove any sign-extension +movb SV_COUNT,r1 ; Get field width +bic #&FF00,r1 ; Remove any sign-extension +.cmdPrintCommaLp +beq cmdPrintLoop ; Zero, start of new line or field, no padding needed, return to main loop +sub r0,r1 ; r1=COUNT-width +bcc cmdPrintCommaLp ; Loop until reduced below zero +mov #32,r0 +.cmdPrintCommaSpc +jsr pc,PrintR0 ; Print padding spaces +inc r1 +bne cmdPrintCommaSpc ; Loop until reached next field +; +.cmdPrintLoop +movb SV_VARS,r1 ; Get field width from @% +.cmdPrintNextReset +bic #&FF00,r1 ; b7=0 - decimal +.cmdPrintNext +jsr pc,CheckEndStatement +bne cmdPrintItem ; No, jump to process items +.cmdPrintNewline +clrb SV_COUNT ; Clear COUNT +jsr pc,IO_NEWL ; Finish with newline +clc ; Signal print item done +rts pc +; +.cmdPrintSemi +clr r1 ; Set field width=0, flag=dec +;jsr pc,SkipSpaceThis ; Get next char +;jsr pc,CheckEndToken ; End of statement? - could be CheckEndStatement +jsr pc,CheckEndStatement +beq cmdPrintDone ; Exit without printing newline +; +.cmdPrintItem +jsr pc,fnConversion ; Check for hex/oct/bin prefix +bcs cmdPrintNext ; Prefix found, check next item +inc r5 ; Step past current character +cmp r0,#ASC"," ; Print comma? +beq cmdPrintComma ; Jump to pad to next field +cmp r0,#&3B ; Semicolon? +beq cmdPrintSemi ; Jump to check for end of print statement +; +jsr pc,cmdPrintFormat ; Check for ' TAB SPC print formatting +bcc cmdPrintNextReset ; Formatting item printed, reset to Decimal, check next item +mov r1,-(sp) ; Save print flag (as Evaluate trashes all registers) +jsr pc,Evaluate ; Evalute current item +mov (sp)+,r1 ; Get print flag back +jsr pc,cmdPrintResult +br cmdPrintNext + +; Moved here to share code +.cmdPRINTchnEnd +.cmdINPUTchnEnd +tst (sp)+ ; Drop channel +rts pc + +.PrintLineNum +clr r1 ; No space padding +; +.PrintLineNumber +; On entry, r4=line number +; r1=max number of padding spaces +; +clr r3 ; 16-bit number +clr r2 ; type=integer +.cmdPrintResult +; On entry, r2/r3/r4=value +; r1=hex flag+field width +; r0=??? +; On exit, r0/r2/r3/r4 corrupted +; +tst r2 ; Check result type +bmi cmdPrintString ; String, print it +mov r1,-(sp) ; Save field width/hex flag +jsr pc,NumberToString ; Convert numeric to string + ; r4=>string, r3=length +mov (sp),r1 ; r1=field width +bic #&FF00,r1 ; Drop hex flag from top byte +sub r3,r1 ; r1=width-length +bcs cmdPrintStringPop ; Item wider than width, no padding +;beq cmdPrintStringPop ; Item same as width, no padding +jsr pc,PrintR1Spaces ; Print spaces to pad to number +.cmdPrintStringPop +mov (sp)+,r1 ; Get field width/hex flag back +.cmdPrintString +tst r3 ; Check string length +beq cmdPrintResultDone ; Null string, nothing to print +.cmdPrintStrLp +movb (r4)+,r0 ; Get a character +jsr pc,PrintR0 ; Print it +dec r3 +bne cmdPrintStrLp ; Loop for all characters +.cmdPrintResultDone +rts pc + +; PRINT formatting item - ', TAB, SPC +; ----------------------------------- +.cmdPrintFormat +cmpb r0,#ASC"'" ; It it single quote? +beq cmdPrintNewline ; Jump to print newline +cmpb r0,#tknTAB ; Is it TAB? +beq cmdPrintTAB ; Jump to do TAB(x) or TAB(x,y) +cmpb r0,#tknSPC ; Is it SPC? +beq cmdPrintSPC ; Jump to do SPC(x) +dec r5 ; Point back to current item +sec ; Signal 'not print item' +rts pc + +; PRINT TAB() +; ----------- +.cmdPrintTAB +jsr pc,EvalInteger ; Get first parameter +jsr pc,SkipSpaceThis ; Check next character +; Won't EvalInt return after skipping spaces anyway? +cmp r0,#ASC"," ; Is there a comma? +beq cmdPrintTABXY ; Jump to do TAB(x,y) +jsr pc,CheckClose1 ; Check for closing bracket +inc r5 +movb SV_COUNT,r0 ; Get COUNT +mov r4,r1 ; r1=required column +sub r0,r1 ; r1=r1-r0 - r1=tab-COUNT +;beq cmdPrintDone ; No spaces needed (not needed as BEQ in PrintR1Spaces) +bcc PrintR1Spaces ; Jump to output required spaces +jsr pc,cmdPrintNewline ; Output newline, zero count, signal done +mov r4,r1 ; R1=number of spaces +br PrintR1Spaces ; Jump to output required spaces + +; PRINT TAB(x,y) +; -------------- +.cmdPrintTABXY +inc r5 ; Step past comma +mov r4,-(sp) ; Save current value +jsr pc,EvalInteger ; Get next integer +jsr pc,CheckClose ; Step past ')' +mov #31,r0 +jsr pc,IO_WRCH ; Send TAB +mov (sp)+,r0 +jsr pc,IO_WRCH ; Send X +mov r4,r0 +jsr pc,IO_WRCH ; Send Y +.cmdPrintDone +clc ; Signal print formatting item +.cmdInputDone +rts pc + +; PRINT SPC(n) +; ------------ +.cmdPrintSPC +jsr pc,EvalInteger ; Get next integer +mov r4,r1 ; Move to R1 +.PrintR1Spaces +bic #&FF00,r1 ; Ensure 8-bit value +beq cmdPrintDone ; Zero - clear carry and return +mov #32,r0 +.PrintR1SpcLp +jsr pc,PrintR0 ; Print space +dec r1 +bne PrintR1SpcLp ; Loop until required spaces printed +br cmdPrintDone ; Clear carry and return + + +; INPUT - Input from input stream or file +; ======================================= +.cmdINPUT +jsr pc,SkipSpaceThis +cmp r0,#ASC"#" ; Is it INPUT # ? +bne cmdInputStart ; Jump for normal INPUT + +; INPUT#chn,{items...} - Input from open file +; ------------------------------------------- +.cmdINPUTchn +jsr pc,EvalHashInt1 ; Step past '#', get channel +mov r4,-(sp) ; Save channel +.cmdINPUTchnLp +jsr pc,SkipSpaceThis ; Get current character +cmpb r0,#ASC"," ; r0=next character +bne cmdINPUTchnEnd +jsr pc,cmdINPUTchnRead ; Read from file and assign +br cmdINPUTchnLp +;.cmdINPUTchnEnd +;tst (sp)+ ; Drop channel +;rts pc +; +.cmdINPUTchnRead +inc r5 ; Step past comma +jsr pc,VarFindCreate ; Parse and create variable +mov 2(sp),r1 ; Get channel +mov r4,-(sp) ; Save variable address +mov r3,-(sp) ; Save variable type/size, set flags +bmi cmdINPUTchnStr ; MI - string +jsr pc,IO_BGET ; &FF real, <>&FF int +mov r0,-(sp) ; Save int/real flag +mov #2,r2 ; Make two passes to get two words +.cmdINPUTchnIntLp +mov r4,r3 +jsr pc,IO_BGET ; b24-b31 then b8-b15 +movb r0,r4 +swab r4 +jsr pc,IO_BGET ; b16-b23 then b0-b7 +bis r0,r4 +dec r2 +bne cmdINPUTchnIntLp ; Loop to get two 16-bit words +bit #&80,(sp)+ ; Get int/real flag +beq cmdINPUTchnAssign ; b7=0, int; r2 already 0 for int +jsr pc,IO_BGET ; Get exponent +dec r0 ; Acorn files use bias-&7F, so need to sub 1 +mov r0,r2 +bic #&FF00,r2 +.cmdINPUTchnAssign +jmp cmdAssign4 +; +.cmdINPUTchnStr +jsr pc,IO_BGET ; Get string marker +jsr pc,IO_BGET ; Get string length +adr SV_STRING,r4 ; r4=string start +mov r0,r3 ; r3=string length +beq cmdINPUTchnStrAssign ; Null string +mov r0,r2 ; r2=string count +add r2,r4 ; r4=>end of string +inc r4 ; Balance pre-decrement +.cmdINPUTchnStrLp +jsr pc,IO_BGET ; Get character +movb r0,-(r4) ; Store it +dec r2 +bne cmdINPUTchnStrLp ; Loop until no more chars +.cmdINPUTchnStrAssign +mov #&8000,r2 ; Type=string +jmp cmdAssign4 + +; INPUT main code - always does INPUT LINE +; ---------------------------------------- +.cmdInputStart +;clr -(sp) ; (sp).31=0 - not LINE +cmpb r0,#tknLINE ; Is it INPUT LINE ? +bne cmdInputLoop +;dec (sp) ; (sp).31=1 - LINE +.cmdInputNext +inc r5 ; Step past LINE token +.cmdInputLoop +jsr pc,SkipSpaceNext +jsr pc,cmdPrintFormat ; Check for ' TAB SPC print formatting +bcc cmdInputLoop ; Keep printing formatting items +jsr pc,CheckEndStatement +beq cmdInputDone ; End of statement - finished +cmpb r0,#ASC"," +beq cmdInputNext ; Comma - step to next item +cmpb r0,#&3B +beq cmdInputNext ; Semicolon - step to next item +cmpb r0,#34 +bne cmdInputVariable ; Not quote, must be a variable name +jsr pc,Evaluate ; Evalute string +jsr pc,cmdPrintString ; Print it +br cmdInputLoop ; Loop for next item +.cmdInputVariable +jsr pc,cmdInputData ; Input data from user and assign it +br cmdInputLoop ; Loop for next item +;.cmdInputDone +;;tst (sp)+ ; Drop LINE flag +;rts pc + +; Must now be a variable, so get input from user +; ---------------------------------------------- +.cmdInputData +adr SV_STRING,r1 ; Point to string buffer +jsr pc,IO_ReadLine ; Read a line of input and zero COUNT +jsr pc,VarFindCreate ; Parse and create variable +mov r4,-(sp) ; Save variable address +adr SV_STRING,r4 ; Point to string buffer +mov r3,-(sp) ; Save variable type/size, set flags +bmi cmdInputString +jsr pc,fnVAL1 ; Convert to decimal +jmp cmdAssign4 +; +.cmdInputString +mov #&8100,r3 ; Type is -string +jsr pc,VarFindString ; Count length of string +jmp cmdAssign4 + diff --git a/src/CommonIO b/src/CommonIO new file mode 100644 index 0000000..c565e66 --- /dev/null +++ b/src/CommonIO @@ -0,0 +1,424 @@ +; > CommonIO +; Common host interface routines for hosts that do not implement BBC API functionality. +; 09-Apr-2024 Added *BASIC command + + +; OSCLI - Execute command +; ======================= + +; Built-in *commands +; ------------------ +.IO_CLIcmds +;.UX_CLIcmds +equb &FF +equb "basic",&8E +equb "chdir",&86 +equb "cd" ,&86 +equb "esc" ,&8C +equb "fx" ,&80 +equb "help" ,&82 +equb "load" ,&88 +equb "quit" ,&84 +equb "save" ,&8A +;"run",&90 +equb 0 +align + +.IO_CLIaddrs +equw IO_CLIhost ; *fx +equw CLIhelp ; *help +equw IO_QUIT0 ; *quit +equw CLIchdir ; *chdir, *cd +equw CLIload ; *load +equw CLIsave ; *save +equw CLIesc ; *esc +equw CLIbasic ; *basic + + +; OSCLI - Execute command +; ======================= +; On entry, r0=>command string +; On exit, r0=return status +; +.IO_OSCLI +mov r1,-(sp) ; Save R1 +.IO_CLIlp1 +movb (r0)+,r1 +cmpb r1,#ASC"*" ; Skip stars +beq IO_CLIlp1 +cmpb r1,#ASC" " ; Skip spaces +beq IO_CLIlp1 +cmpb r1,#13 +beq IO_CLInull ; Null string +cmpb r1,#ASC"|" +beq IO_CLInull ; Comment +cmpb r1,#ASC"/" +beq IO_CLIexternal ; */filename +dec r0 ; Point back to non-space non-star char +mov r0,-(sp) ; Save address after '*'s and ' 's +mov r2,-(sp) ; Save R2 +mov #IO_CLIcmds,r2 ; Point to command table + +.IO_CLIlp2 +tstb (r2)+ +bpl IO_CLIlp2 ; Look for start of table entry +tstb (r2) ; End of command table? +bne IO_CLIcmd ; Not end, check if matching command +mov (sp)+,r2 ; Restore R2 +mov (sp)+,r0 ; r0=>command string +.IO_CLIexternal +cmpb (r0)+,#ASC" " ; Skip any spaces after */ +beq IO_CLIexternal +dec r0 +jmp IO_CLIslash ; End of table or */, try passing to system() + +.IO_CLIcmd +mov 2(sp),r0 ; Get start of command line +.IO_CLIlp3 +movb (r0)+,r1 ; Get command line character +bis #&20,r1 ; Force to lower case +cmpb (r2)+,r1 ; Compare with table +beq IO_CLIlp3 ; Characters match, check next +dec r0 ; Point to non-matching command char +dec r2 ; Point to non-matching table char +cmpb (r0),#ASC"A" ; Check last character tested +bcc IO_CLIlp2 ; Not end of command string, try next command +movb (r2),r1 +bpl IO_CLIlp2 ; Not end of table entry, try next one +mov (sp)+,r2 ; Restore R2 +.IO_CLIlp4 +cmpb (r0)+,#ASC" " ; Skip trailing spaces +beq IO_CLIlp4 +dec r0 + +; Command matched +; r0=> or after command +; r1=&80+n command number +; sp=>R0, R1 + +bic #&FF80,r1 ; Drop bit 7 and bit 0 +mov IO_CLIaddrs(r1),r1 +jsr pc,(r1) ; Errors never return +;bvs IO_CLIerror ; Restore and return with error +tst (sp)+ ; Drop start of command +.IO_CLInull +mov (sp)+,r1 ; Restore R1 +clr r0 ; Return R0=Ok +rts pc +;.IO_CLIerror +;tst (sp)+ ; Drop start of command +;mov (sp)+,r1 ; Restore R1 +;setv ; Set V +;rts pc + + +; Common commands +; =============== + +; *help +; ----- +.CLIhelp +mov #StartupMessage,r1 +jsr pc,PrintR1 +#ifdef RT11VER + jsr pc,PrintInline + equs "RT11 Host v" + equb ((RT11VER >> 8) AND 15)+48 + equb "." + equb ((RT11VER >> 4) AND 15)+48 + equb (RT11VER AND 15)+48 + equb 13,0 + align +#endif +.IO_CLIhost +#if OSNAME$="Unix" +#ifndef NOEMT + mov 2(sp),r0 ; Get R0=>command + emt 1 ; Pass on to host +#endif +#endif +rts pc + +; *esc (on|off) +; ------------- +.CLIesc +cmpb (r0)+,#ASC"@" ; Check for 'O'... +bcs CLIescOn +movb (r0),r1 ; Check for 'oN'.. or 'oF'... + ; %1110 or %0110 +.CLIescOn +rol r1 ; Move to bit 4 +add #FLG_ESCAPE,r1 ; Toggle bit 4 +bic #-FLG_ESCAPE-1,r1 ; Keep bit 4, N/F +bicb #FLG_ESCAPE,SV_SYS ; Remove bit 4 from flags +bisb r1,SV_SYS ; Insert into system flags +rts pc + +; *basic +; ------ +.CLIbasic +adr SV_STRING,r1 +mov r0,r5 +jsr pc,InsAddLine ; Copy any command line +mov SV_MEMTOP,r1 ; Get memory limits +mov SV_MEMBOT,r0 +jmp Restart ; Restart + +; *quit +; ----- +;.CLIquit +;jmp IO_QUIT0 + +; *load +; ----- +.CLIload +jsr pc,ScanAddrsR0 +dec r0 +bmi CLILoad1 ; *load name +beq CLILoad1 ; *load name addr +.jmpBadAddress +jmp errBadAddress +.CLILoad1 +movb r0,MOS_BUF+6 ; &FF=use file's addr or &00=use supplied addr +mov #&FF,r0 ; R0=LOAD +.CLIFile +mov #MOS_BUF,r1 +jmp IO_FILE ; Error will be caught before return + +; *save +; ----- +.CLIsave +jsr pc,ScanAddrsR0 +cmp r0,#2 ; *save name +bcs jmpBadAddress ; *save name addr +cmp r0,#5 +bcc jmpBadAddress ; *save too many addresses +clr r0 ; R0=SAVE +br CLIFile + +; Scan a list of file addresses +; ----------------------------- +.ScanHex2 +mov #MOS_BUF+2,r1 +.ScanHex +; Would this be smaller to do manually? +mov r0,-(sp) +mov r1,-(sp) +jsr pc,CheckHexNext +bcs jmpBadAddress +; +;; Call BASIC's evaluator +;; R0= first hex digit +;; R1=4 -> 4 bits per digit +;; R3=0 -> accumulator +;; R4=0 -> accululator +;; R5=> first digit, already checked +;mov #4,r1 +;clr r3 +;clr r4 +;jsr pc,EvalHexGo +;; R3/R4=hex value +;; R5=>first non-hex character +; +; Call BASIC's evaluator +; R3=0 -> accumulator +; R4=0 -> accululator +; R5=> first digit, already checked +clr r3 ; Clear accumulator +clr r4 +dec r5 ; Back up R5 to first digit +jsr pc,EvalHexGo +; R0/R1/R2 corrupted +; R3/R4=hex value +; R5=>first non-hex character +; +mov (sp)+,r1 +mov r4,(r1)+ +mov r3,(r1) +mov (sp)+,r0 +.ScanHexSpc +cmpb (r5)+,#ASC" " +beq ScanHexSpc +dec r5 +cmpb (r5),#13 +rts pc + +.ScanAddrsR0 +mov r0,r1 ; r0=>command line +.ScanAddrs +mov r5,-(sp) +mov r4,-(sp) +mov r3,-(sp) +mov r2,-(sp) +mov r1,r5 ; r1=>command line +mov r1,MOS_BUF ; filename +jsr pc,SkipWord +clr r0 +cmpb (r5),#13 +beq ScanAddrsDone ; No addresses +inc r0 +jsr pc,ScanHex2 ; BUF+2 = load +mov r4,MOS_BUF+6 ; BUF+6 = exec +mov r3,MOS_BUF+8 +mov r4,MOS_BUF+10 ; BUF+10= start +mov r3,MOS_BUF+12 +cmpb (r5),#13 +beq ScanAddrsDone ; One address +inc r0 +mov #MOS_BUF+14,r1 +cmpb (r5),#ASC"+" +bne ScanHexEnd +inc r5 +jsr pc,ScanHexSpc +jsr pc,ScanHex ; BUF+14=length +add MOS_BUF+10,r4 +adc r3 +add MOS_BUF+12,r3 +mov r4,MOS_BUF+14 +mov r3,MOS_BUF+16 +cmpb (r5),#13 +br ScanHexEnd2 +.ScanHexEnd +jsr pc,ScanHex ; BUF+14=end +.ScanHexEnd2 +beq ScanAddrsDone ; Two address +inc r0 +mov #MOS_BUF+6,r1 +jsr pc,ScanHex ; BUF+6 = exec +beq ScanAddrsDone ; Three address +inc r0 +jsr pc,ScanHex2 ; BUF+2 = load +beq ScanAddrsDone ; Four address +inc r0 ; Five or more addresses +.ScanAddrsDone +mov (sp)+,r2 +mov (sp)+,r3 +mov (sp)+,r4 +mov (sp)+,r5 +rts pc + +.SkipWord +cmpb (r5)+,#ASC"!" +bcc SkipWord +dec r5 +br ScanHexSpc + + +; Support routines +; ================ + +; Get word from control block at r2 and add r3 to it, return r2=r2+4 +; ------------------------------------------------------------------ +.FetchAddStore +jsr pc,FetchWord +add r3,r1 +adc r0 ; Continue into StoreWord + +; Store &r0:r1 to unaligned buffer at r2, r1=lo r0=hi, corrupts r0/r1, return r2=r2+4 +; ----------------------------------------------------------------------------------- +.StoreWord +movb r1,(r2)+ +swab r1 +movb r1,(r2)+ +movb r0,(r2)+ +swab r0 +movb r0,(r2)+ +rts pc + +; Fetch &r0:r1 from unaligned buffer at r2, r1=lo r0=hi, return r2=r2+4 +; --------------------------------------------------------------------- +.FetchWord +jsr pc,FetchHalfWord +mov r0,-(sp) +jsr pc,FetchHalfWord +mov (sp)+,r1 +rts pc + +; Get 16-bit half-word from unaligned r2 to r0, return r2=r2+2 +; ------------------------------------------------------------ +.FetchHalfWord +movb (r2)+,r1 +bic #&FF00,r1 +movb (r2)+,r0 +bic #&FF00,r0 +swab r0 +bis r1,r0 +rts pc + +; Read line of text +; ----------------- +; On entry, R1=>address of memory to read string to +; On exit, R2=length of string +; CC=ok, CS=Escape pressed +; +; Could do in-line cursor movement +; +.IO_WORD0 +mov r1,-(sp) ; Save pointer to control block +mov r3,-(sp) ; Save R3 +mov r1,r2 ; r2=>control block +jsr pc,FetchWord ; Get pointer to text buffer to r1 +clr r2 ; Zero number of characters read +.RdLnLoop +jsr pc,IO_RDCH ; Get a character +bcs RdLnEsc ; Escape state +cmp r0,#13 +beq RdLnCR ; - End of line +cmp r0,#10 +beq RdLnCR ; - End of line +cmp r0,#21 +beq RdLnU ; Ctrl-U - delete line +cmp r0,#&C7 +beq RdLnDel ; - del a character +cmp r0,#127 +beq RdLnDel ; - del a character +cmp r0,#8 +beq RdLnDel ; - del a character +cmp r0,#ASC" " +;bcs RdLnLoop ; Ignore other control characters +bcs RdLnIgnore ; Just echo other control characters +cmp r2,#240 +bcc RdLnLoop ; No more room for characters +movb r0,(r1)+ ; Put character into memory +inc r2 ; Inc. number of characters +.RdLnIgnore +jsr pc,IO_WRCH ; Output the character +br RdLnLoop ; Go back for another +; +.RdLnU +mov r2,r3 ; We want to delete all characters +br RdLnDelete +.RdLnDel +mov #1,r3 ; We only want to delete one char +.RdLnDelete +mov #&2008,r0 ; Output by backspacing +.RdLnDeleteLp +tst r2 ; Check line length +beq RdLnLoop ; Length=0, jump back to main loop +jsr pc,IO_WRCH ; +swab r0 +jsr pc,IO_WRCH ; +swab r0 +jsr pc,IO_WRCH ; again +;mov #8,r0 ; Output by backspacing +;jsr pc,IO_WRCH +;mov #32,r0 +;jsr pc,IO_WRCH +;mov #8,r0 +;jsr pc,IO_WRCH +dec r1 ; Back address pointer +dec r2 ; Dec character counter +dec r3 ; Dec. number of DELs to do +bne RdLnDeleteLp ; Loop for each to delete +br RdLnLoop ; Go back into ReadLine loop +; +.RdLnCR +jsr pc,IO_NEWL ; Returns with r0= +movb r0,(r1) ; Put terminator in +clr r0 ; Restore R0, clear C +.RdLnEsc +.RdLnExit +mov (sp)+,r3 ; Restore R3 +mov (sp)+,r1 ; Get buffer address back, clear V +rts pc ; r0=0, r1=buffer, r2=length + diff --git a/src/Debug b/src/Debug new file mode 100644 index 0000000..9536c5d --- /dev/null +++ b/src/Debug @@ -0,0 +1,306 @@ +; > Debug +; Debug routines + +; All registers preserved (except flags) +; Debug_Byte Output byte in R0 in hex +; Debug_Hex Output R0 in hex +; Debug_Oct Output R0 in octal +; Debug_Char Output R0 as character or dot +; Debug_DumpRegsOct Dump all registers in octal +; Debug_DumpRegsHex Dump all registers in hex +; Debug_DumpRegsFlags Dump flags and registers in hex (preserves flags) +; Debug_DumpLine Dump line at R5 +; Debug_DumpMem Dump three lines of memory at R5 in hex +; Debug_DumpMemOne Dump one line of memory at R5 in hex +; Debug_DumpStack Dump one line of memory at SP in hex + +; Requires: +; IO_WRCH - output character in R0 +; IO_NEWL - output newline + + +; Print R0 as hex byte +; -------------------- +.Debug_Byte +mov r0,-(sp) +jsr pc,Debug_hex1 +br Debug_done + +; Print R0 as hex word +; -------------------- +.Debug_Hex +mov r0,-(sp) +jsr pc,Debug_hex2 +br Debug_done + +; Print R0 as octal word +; ---------------------- +.Debug_Oct +mov r0,-(sp) +jsr pc,Debug_oct +br Debug_done + +; Print R0 as character or dot +; ---------------------------- +.Debug_Char +mov r0,-(sp) +bic #&FF80,r0 +cmp r0,#127 +beq Debug_CharDot +cmp r0,#32 +bcc Debug_CharOk +.Debug_CharDot +mov #ASC".",r0 +.Debug_CharOk +jsr pc,IO_WRCH +.Debug_done +mov (sp)+,r0 +rts pc + +; Dump registers +; -------------- +.Debug_DumpRegsOct +mov r0,-(sp) +jsr pc,Debug_octSpc +mov r1,r0 +jsr pc,Debug_octSpc +mov r2,r0 +jsr pc,Debug_octSpc +mov r3,r0 +jsr pc,Debug_octSpc +mov r4,r0 +jsr pc,Debug_octSpc +mov r5,r0 +jsr pc,Debug_octSpc +mov r6,r0 +add #4,r0 +jsr pc,Debug_oct +.Debug_newl +jsr pc,IO_NEWL +mov (sp)+,r0 +rts pc + +; Dump registers and flags +; ------------------------ +.Debug_DumpRegsFlags +mfps -(sp) +mov r0,-(sp) +; +mov #ASC"M",r0 +bit #8,2(sp) +jsr pc,Debug_flag +; +mov #ASC"Z",r0 +bit #4,2(sp) +jsr pc,Debug_flag +; +mov #ASC"V",r0 +bit #2,2(sp) +jsr pc,Debug_flag +; +mov #ASC"C",r0 +bit #1,2(sp) +jsr pc,Debug_flag +; +jsr pc,Debug_spc +mov (sp)+,r0 +jsr pc,Debug_DumpRegsHex +mtps (sp)+ +rts pc + +.Debug_flag +bne Debug_flag2 +mov #ASC"-",r0 +.Debug_flag2 +jmp IO_WRCH + +; Dump registers +; -------------- +.Debug_DumpRegsHex +mov r0,-(sp) +jsr pc,Debug_hexSpc +mov r1,r0 +jsr pc,Debug_hexSpc +mov r2,r0 +jsr pc,Debug_hexSpc +mov r3,r0 +jsr pc,Debug_hexSpc +mov r4,r0 +jsr pc,Debug_hexSpc +mov r5,r0 +jsr pc,Debug_hexSpc +mov r6,r0 +add #4,r0 +jsr pc,Debug_hex2 +br Debug_newl + +; Dump line at R5 +; --------------- +.Debug_DumpLine +mov r0,-(sp) ; push r0 +mov r5,-(sp) ; push r5 +; +.Debug_LineLp1 +movb (r5)+,r0 +jsr pc,Debug_hex1 +jsr pc,Debug_spc +cmpb -3(r5),#13 +bne Debug_LineLp1 +jsr pc,IO_NEWL +; +mov (sp),r5 ; get r5 back +.Debug_LineLp2 +jsr pc,Debug_spc +movb (r5)+,r0 +jsr pc,Debug_Char +jsr pc,Debug_spc +cmpb -3(r5),#13 +bne Debug_LineLp2 +jsr pc,IO_NEWL +; +mov (sp)+,r5 ; restore R5 +mov (sp)+,r0 ; restore R0 +rts pc + +; Dump stack +; ---------- +.Debug_DumpStack +mov r5,-(sp) +mov sp,r5 +add #4,r5 +jsr pc,Debug_DumpMemOne +mov (sp)+,r5 +rts pc + +; Dump one line of memory at R5 +; ----------------------------- +.Debug_DumpMemOne +mov r0,-(sp) ; push r0 +mov r1,-(sp) ; push r1 +mov r2,-(sp) ; push r2 +mov r5,-(sp) ; push r5 +mov r5,-(sp) ; push r5 +mov #1,r2 ; Dump one line +br Debug_MemLp0 + +; Dump three lines of memory at R5 +; -------------------------------- +.Debug_DumpMem +mov r0,-(sp) ; push r0 +mov r1,-(sp) ; push r1 +mov r2,-(sp) ; push r2 +mov r5,-(sp) ; push r5 +mov r5,-(sp) ; push r5 +; +mov #3,r2 ; Dump three lines +.Debug_MemLp0 +mov r5,r0 +jsr pc,Debug_hexSpc +mov #16,r1 ; Dump 16 bytes +.Debug_MemLp1 +movb (r5)+,r0 +jsr pc,Debug_hex1 +jsr pc,Debug_spc +dec r1 +bne Debug_MemLp1 +jsr pc,IO_NEWL +; +jsr pc,Debug_spc +jsr pc,IO_WRCH +jsr pc,IO_WRCH +jsr pc,IO_WRCH +jsr pc,IO_WRCH +mov (sp),r5 ; get r5 back +mov #16,r1 +.Debug_MemLp2 +jsr pc,Debug_spc +movb (r5)+,r0 +jsr pc,Debug_Char +jsr pc,Debug_spc +dec r1 +bne Debug_MemLp2 +jsr pc,IO_NEWL +; +mov r5,(sp) +dec r2 +bne Debug_MemLp0 + +mov (sp)+,r5 ; pop R5 +mov (sp)+,r5 ; pop R5 +mov (sp)+,r2 ; pop R2 +mov (sp)+,r1 ; pop R1 +mov (sp)+,r0 ; pop R0 +rts pc + +; Print R0 in oct, followed by a space +; ------------------------------------ +.Debug_octSpc +jsr pc,Debug_oct +br Debug_spc + +; Print R0 in hex, followed by a space +; ------------------------------------ +.Debug_hexSpc +jsr pc,Debug_hex2 + +; Print a space +; ------------- +.Debug_spc +mov #32,r0 +jmp IO_WRCH + +.Debug_hex2 +mov r0,-(sp) +swab r0 +jsr pc,Debug_hex1 +mov (sp)+,r0 +.Debug_hex1 +mov r0,-(sp) +ror r0 +ror r0 +ror r0 +ror r0 +jsr pc,Debug_nybble +mov (sp)+,r0 +.Debug_nybble +bic #&FFF0,r0 +cmp #9,r0 +bcc Debug_digit +add #7,r0 +br Debug_digit + +.Debug_octdigit6 +ror r0 +ror r0 +.Debug_octdigit4 +ror r0 +.Debug_octdigit3 +ror r0 +ror r0 +.Debug_octdigit1 +ror r0 +.Debug_octdigit +bic #&FFF8,r0 +.Debug_digit +add #48,r0 +jmp IO_WRCH + +.Debug_oct +mov r0,-(sp) +bic #&8000,r0 +rol r0 +rol r0 +jsr pc,Debug_octdigit ; %Dxxxxxxxxxxxxxxx +mov (sp),r0 +swab r0 +jsr pc,Debug_octdigit4 ; %xDDDxxxxxxxxxxxx +mov (sp),r0 +swab r0 +jsr pc,Debug_octdigit1 ; %xxxxDDDxxxxxxxxx +mov (sp),r0 +jsr pc,Debug_octdigit6 ; %xxxxxxxDDDxxxxxx +mov (sp),r0 +jsr pc,Debug_octdigit3 ; %xxxxxxxxxxDDDxxx +mov (sp)+,r0 +br Debug_octdigit ; %xxxxxxxxxxxxxDDD + diff --git a/src/Errors b/src/Errors new file mode 100644 index 0000000..19345bf --- /dev/null +++ b/src/Errors @@ -0,0 +1,68 @@ +; > Errors +; Error numbers and messages +; Not used +; 0 No room +; 0 STOP +; 1 Branch out of range +; 2 Bad immediate/address/shift +; 3 Bad index/register/label +; 4 Mistake +; 4 Missing = +; 5 Missing , +; 6 Type mismatch +; 7 Not in a function +; 8 $ range +; 9 Missing " +; 10 Bad DIM +; 11 DIM space +; 12 Not LOCAL +; 13 Not in a PROC +; 14 Array +; 15 Subscript +; 16 Syntax error +; 17 Escape +; 18 Division by zero +; 19 String too long +; 20 Too big +; 21 -ve root +; 22 Log range +; 23 Accuracy lost +; 24 Exp range +; 25 Bad MODE +; 26 No such variable +; 27 Missing ) +; 28 Bad HEX, OCT or BIN +; 29 No such FN/PROC +; (30 Bad call) +; 31 Arguments +; 32 Not in a FOR loop +; 33 Can't match FOR +; 34 Bad FOR variable +; (35 Bad STEP) 35 Too many FORs +; 36 Missing TO +; 37 Too many GOSUBs, No room for FN/PROC call +; 38 No GOSUB +; 39 ON syntax +; 40 ON range +; 41 No such line +; 42 Out of DATA +; 43 No REPEAT +; 44 Too many REPEATs, Too many nested structures +; 45 Missing # +; (54 ERROR/DATA not LOCAL) + +; 192 C0 Can't save file +; 198 C6 Disk full +; 202 CA Data lost (Read error, Write error) +; 214 D6 File not found +; 223 DF End of file + +; 240 F0 Undefined instruction +; 241 F1 Breakpoint (Abort on instruction fetch) +; 242 F2 Bad memory access (Abort on data transfer) +; 243 F3 Bad word access (Address exception) +; 244 F4 Unknown IRQ +;(245 F5 Branch through zero) + +; 252 FC Bad address +; 254 FE Bad command diff --git a/src/Evaluate b/src/Evaluate new file mode 100644 index 0000000..84df1a4 --- /dev/null +++ b/src/Evaluate @@ -0,0 +1,869 @@ +; > Evaluate +; BASIC expression evaluator + +; 30-Aug-2008: Recursive Expression Evaluator and binary operator dispatch written +; 01-Sep-2008: Hex values, double quotes, octal values +; 03-Mar-2009: 31-bit decimal numbers working +; 15-Jun-2010: Parsing comparisons done +; 25-Jun-2013: FloatToInteger written, convert to &80000000 working. +; Bug: FloatToInt should round negative numbers down, INT(-PI) should be -4. +; 15-Aug-2013: ABS moved here with speeded up Negate +; 20-Nov-2013: Evaluate checks free memory before starting +; 09-Dec-2013: AddressOf skips any following () to allow ^PROCname(), ^FNname() +; 28-Jul-2016: Evaluator uses some (r5)+ instead of (r5)/inc, optimised bne/rts pairs +; 29-Jul-2016: INT(negative) rounds down, INT(-PI) is -4. +; 31-Jul-2016: Scanning fractional decimals and exponential decimals implemented. +; E scanned but fnPower only implements positive exponents. +; 07-Aug-2016: EnsureInt preserves r0/r1, -0 to -1 correctly rounds to -1. +; Bug: now causes A=-7/2:A%=A to round incorrectly. +; 09-Jul-2016: EnsureInteger truncates, INT rounds downwards. +; Bug: EvalDecimal fails with num>10e9 unless E format used. +; 16-Mar-2021: EvalDecimalVAL correctly returns 0 for non-numbers. +; EvalDecimalPrefix and EvalDecimalVAL can't merge as VAL allows spaces, E+num doesn't. +; 18-Mar-2024: EvalHash corrected to EvalHashVal. Added @octal. +; 10-May-2025: Optimised Bin/Oct/Hex constants. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; +;; Check for syntax character and evaluate following expression ;; +;; ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +; Check for and step past ')' +; =========================== +.CheckClose +jsr pc,SkipSpaceNext ; This ; Next +.CheckClose1 +cmpb r0,#ASC")" +beq CheckOk +.errMissingClose +jsr pc,Error +equb 27,tknMissing,")",0 +align + +; Check for and step past ',' +; =========================== +.CheckComma +jsr pc,SkipSpaceNext ; This ; Next +cmpb r0,#ASC"," +beq CheckOk +.errMissingComma +jsr pc,Error +equb 5,tknMissing,44,0 +align + +; Check for ',' evaluate and return following integer +; =================================================== +.EvalComma +jsr pc,CheckComma +br EvalInteger + +; Check for and step past '=' +; =========================== +.CheckEqual +jsr pc,SkipSpaceNext ; This ; Next +.CheckEqual1 +cmpb r0,#ASC"=" +beq CheckOk +;bne errMissingEqual +;.CheckOk +;inc r5 +;rts pc +.errMissingEqual +jsr pc,Error +equb 4,tknMissing,"=",0 +align + +; Fetch next and check for <,=,> +; ============================== +.CheckCompare +movb (r5),r0 +cmpb r0,#ASC"<" +beq ChkCmpOk +cmpb r0,#ASC"=" +beq ChkCmpOk +cmpb r0,#ASC">" +.ChkCmpOk +.CheckOk +rts pc + +; Check for '=', evaluate and return following integer +; ==================================================== +.EvalEqual +jsr pc,CheckEqual +br EvalInteger + +; Check for '#', evaluate and return following integer expression +; =============================================================== +;.EvalHash +;jsr pc,SkipSpaceNext +;cmpb r0,#ASC"#" +;beq EvalInteger +;.errMissingHash +;jsr pc,Error +;equb 45,tknMissing,"#",0 +;align + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; +;; Evaluate expression and check for expected returned type ;; +;; ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; INT - convert to integer, rounding down if negative +; =================================================== +.fnINT +jsr pc,EvalNumVal ; Evaluate numeric value +beq EnsureIntOk ; Already an integer +tst -(sp) ; Stack dummy value +mov #&7FFF,r1 ; r1=nothing to round yet +br EnsureInteger2 ; Convert and round down + + +; EvalInteger - Evaluate numeric expression and return integer +; ============================================================ +.EvalInteger1 +inc r5 ; Step past prefix character +.EvalInteger +jsr pc,EvalNumeric ; Call expression evaluator + ; Fall through to convert float to integer + + +; EnsureInteger - If float, denormalise into an integer +; ===================================================== +; On entry, r2/r3/r3=value +; On exit, r2/r3/r4=integer value, flags set from r2 +; r0/r1 preserved +; +; Conversion to integer truncates, so +3.5 -> +3, -3.5 -> -3 +; The INT function rounds downwards, so +3.5 -> +3, -3.5 -> -4 +; +.EnsureInteger +tst r2 ; Check if float +beq EnsureIntOk ; Already an integer +bmi errTypeMismatch ; Error if a string +mov r1,-(sp) ; Save R1 +clr r1 ; r1=fraction count, prevent rounding +.EnsureInteger2 +; +; To convert float to integer we repeatedly divide the mantissa by 2 +; while incrementing the exponent, which multiplies the number by 2, +; so the value remains the same. This loops until the mantissa is &9F, +; which is an exponent of +31. At this point the mantissa will be the +; binary value of the integer version of the float. +; +sub #&9F,r2 ; Reduce exponent +bcs EnsureIntNotBig ; Exponent<&9F, 2^31+x or smaller, ok +bne EnsureIntTooBig ; Exponent>&9F, 2^32 or bigger, too big to convert +tst r4 ; Exponent=&9F, check for mantissa=&80000000 +bne EnsureIntTooBig ; &9F,&....XXXX, too big +cmp r3,#&8000 +beq EnsureIntDone ; &9F,&80000000 is only convertable &9F value +.EnsureIntTooBig +jmp errTooBig ; ABS(float) is 2^32 or bigger, too big to convert +.EnsureIntNotBig +mov r3,-(sp) ; Save sign bit +bis #&8000,r3 ; Put top bit in +clc +.EnsureIntLp +ror r3 ; Will always divide at least once +ror r4 ; Divide mantissa by two +adc r1 ; Add fractional bits, clear carry +inc r2 ; Increment exponent to multiply by two +bne EnsureIntLp ; Loop until exp=+32 +tst (sp)+ ; Test sign bit +bpl EnsureIntDone ; Positive number, return it +jsr pc,NegateInteger ; Negate negative number +cmp #&8000,r1 ; Is there anything to round +sbc r4 ; Round negative number down for INT +sbc r3 +.EnsureIntDone +mov (sp)+,r1 ; Restore R1 +tst r2 ; Set flags from type=int +.EnsureIntOk +rts pc + + +; EvalFloatVal - Evaluate real value +; ================================== +.EvalFloatVal +jsr pc,EvalNumVal ; Call level 1 expression evaluator +;br EnsureFloat ; Fall through to convert to float + + +; EnsureFloat - If integer, normalise into a float +; ================================================ +; On entry, r2/r3/r3=value +; On exit, r2/r3/r4=float value, flags set from r2, EQ=zero, NE=non-zero +; r0/r1 preserved +; +.EnsureFloat +tst r2 +bne EnsureFloatDone ; Already a float +.IntegerToFloat +bis r3,r2 +bis r4,r2 +beq EnsureFloatDone ; Zero, no float representation, return +; +; int 00, 00 00 00 01 +; float 80, 80 00 00 00, then remove sign +; +; int 00, 00 00 01 00 +; float 88, 80 00 00 00, then remove sign +; +; int 00, 40 00 00 00 +; float 9F, 80 00 00 00, then remove sign +; +; int 00, FF FF FF FF +; float 80, 80 00 00 00, then remove sign +; +mov r3,-(sp) ; Test and stack sign +bpl EnsureFloatPlus ; Positive number, convert it +jsr pc,NegateInteger ; Negate negative number +.EnsureFloatPlus +mov #&9F,r2 ; Initial exponent +.EnsureFloatLp +;bit #&8000,r3 ; Has top bit moved to top? +;bne EnsureFloat2 +tst r3 ; Has top bit moved to top? +bmi EnsureFloat2 +clc ; previous TST clears Carry +rol r4 ; Double mantissa +rol r3 +dec r2 ; Decrement exponent +br EnsureFloatLp ; Loop until top bit set +.EnsureFloat2 +tst (sp)+ ; Unstack and test sign +bmi EnsureFloat3 ; Negative, leave top bit set +bic #&8000,r3 ; Remove implied top bit +.EnsureFloat3 +tst r2 ; Set flags +.EnsureFloatDone +rts pc + +; EvalNumeric - Evaluate numeric expression +; ========================================= +.EvalNumeric +jsr pc,Evaluate ; Call expression evaluator +bmi errTypeMismatch ; Returned string, we wanted a number +rts pc + +; EvalString - Evaluate string expression +; ======================================= +.EvalString +jsr pc,Evaluate ; Call expression evaluator +bpl errTypeMismatch ; Returned number, we wanted a string +rts pc + +; EvalStringCR - Evaluate string expression and return CR-terminated +; ================================================================== +; On exit, r4=>cr-string with leading spaces skipped +; r3=string length with +; +.EvalStringCR +jsr pc,EvalString ; Call expression evaluator +.EvalStoreCR +bit #&0100,r2 +bne EvalStringCRlp ; Already -string +.EvalStoreCRString +mov r3,-(sp) ; Save length +;mov r3,r2 ; r2=length +;mov r4,r3 ; r3=source string +;jsr pc,CopyString ; Copy to string buffer +jsr pc,EnsureString ; Copy to string buffer +mov (sp)+,r3 ; Get length back +add r4,r3 ; r3=>end of string +movb #13,(r3) ; Put terminating CR in +sub r4,r3 ; Restore r3=length +.EvalStringCRlp +dec r3 ; Decrement length for leading spaces +cmpb (r4)+,#ASC" " +beq EvalStringCRlp ; Skip leading spaces +dec r4 ; Point back to first non-space character +inc r3 ; Balance extra dec r3 +inc r3 ; Add to length +rts pc + +; EvalStrValCR - Evaluate string value and return CR-terminated +; ============================================================= +.EvalStrValCR +jsr pc,EvalLevel1 ; Call level 1 expression evaluator +bmi EvalStoreCR ; Returned string, put terminating CR in + +.errTypeMismatch +jsr pc,Error +equb 6,"Type mismatch",0 +align + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; +;; Evaluate value and check for expected returned type ;; +;; ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; Check for '#', evaluate and return following integer value +; ========================================================== +; Handles are a value, not an expression, so that PTR#n+1 is +; (PTR#n)+1 and not PTR#(n+1). +; +.EvalHashVal +jsr pc,SkipSpaceNext +cmpb r0,#ASC"#" +beq EvalIntVal +.errMissingHash +jsr pc,Error +equb 45,tknMissing,"#",0 +align + +; EvalIntVal - Evaluate integer value +; =================================== +.EvalHashInt1 +inc r5 ; Step past '#' +.EvalIntVal +jsr pc,EvalNumVal ; Call level 1 expression evaluator +br EnsureInteger ; If float, convert to integer + +; EvalNumVal - Evaluate numeric value +; ==================================== +.EvalNumVal +jsr pc,EvalLevel1 ; Call level 1 expression evaluator +bmi errTypeMismatch ; Returned string, we wanted a number +rts pc + +; EvalStrVal - Evaluate string value +; ================================== +.EvalStrVal +jsr pc,EvalLevel1 ; Call level 1 expression evaluator +bpl errTypeMismatch ; Returned number, we wanted a string +rts pc + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; +;; EXPRESSION EVALUATOR ;; +;; -------------------- ;; +;; Recursively calls seven expression levels, evaluating expressions at ;; +;; each level, looping within each level until all operators at that ;; +;; level are exhausted. ;; +;; ;; +;; On entry, r5=>start of expression to evaluate ;; +;; On exit, r5=>first character after evaluated expression ;; +;; r4/r3/r2=returned value, flags set from r2 ;; +;; MI, r2=&80xx - dynamic string, r3=length, r4=start ;; +;; MI, r2=&81xx - -string, r3=length, r4=start ;; +;; MI, r2=&82xx - -string, r3=length, r4=start ;; +;; PL, r2=&00xx - number ;; +;; PL, EQ, r2=&0000 - integer, r3=b31-b16, b4=b15-b0 ;; +;; PL, NE, r2=&00xx - real, r2=exponent, ;; +;; r3=mantissa b31-b16, r4=mantissa b15-b0 ;; +;; ;; +;; Within the evaluator, r0 and (r5)=next matched character ;; +;; ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +.Evaluate1 +inc r5 ; Step past current character +.Evaluate +jsr pc,CheckFreeMemory + +; Evaluator Level 7 - OR, EOR +; =========================== +.EvalLevel7 +jsr pc,EvalLevel6 ; Call level 6 - AND +.EvalLevel7More +movb (r5),r0 +cmpb r0,#tknOR +beq EvalOR +cmpb r0,#tknEOR +beq EvalEOR +tst r2 ; Set flags from result type +rts pc +.EvalOR +.EvalEOR +inc r5 ; Step past current character +jsr pc,StackIntAndOp +jsr pc,EvalLevel6 ; Evaluate RHS parameter +jsr pc,UnstackIntAndCallOp +;movb (r5),r0 +br EvalLevel7More ; Loop to check for more OR/EOR + + +; Evaluator Level 6 - AND +; ======================= +.EvalLevel6 +jsr pc,EvalLevel5 ; Call level 5 - < <= = >= > <> +.EvalLevel6More +;movb (r5),r0 +movb (r5)+,r0 +cmpb r0,#tknAND +;bne EvalDone +bne EvalDoneDec +;beq EvalAND +;rts pc +;.EvalAND +;inc r5 ; Step past current character +jsr pc,StackIntAndOp +jsr pc,EvalLevel5 ; Evaluate RHS parameter +jsr pc,UnstackIntAndCallOp +;movb (r5),r0 +br EvalLevel6More ; Loop to check for more AND + + +; Evaluator Level 5 - < <= = >= > <> +; ================================== +.EvalLevel5 +jsr pc,EvalLevel4 ; Check for +, - +jsr pc,CheckCompare ; Fetch character and check for <,=,> +bne EvalDone +;beq EvalCompare +;rts pc +;.EvalCompare +mov r0,r1 ; Save first character in R1 +inc r5 ; Step to next character +jsr pc,CheckCompare ; Fetch and check for <,=,> +bne EvalCompare1 ; Not <=, >=, <>, jump to to <,=,> +cmp r0,r1 ; Is it <<, ==, >> +beq errSyntax2 +inc r5 ; Step past second character +add r0,r1 ; Combine to form offset value +.EvalCompare1 +bis #&70,r1 ; r1=79..7E for <=..> +mov r1,r0 ; r0=operator +jsr pc,StackValAndOp +jsr pc,EvalLevel4 ; Evaluate RHS paraneter +jsr pc,UnstackValAndCallOp +rts pc +.errSyntax2 +jmp errSyntax + + +; Evaluator Level 4 - + - +; ======================= +.EvalLevel4 +jsr pc,EvalLevel3 ; Call level 3 - * / DIV MOD +.EvalLevel4More +;movb (r5),r0 ; Get current character +movb (r5)+,r0 ; Get current character +cmpb r0,#ASC"+" +beq EvalPlus +cmpb r0,#ASC"-" +;bne EvalDone +bne EvalDoneDec +;beq EvalMinus +;rts pc ; Return +.EvalPlus +.EvalMinus +;inc r5 ; Step past current character +jsr pc,StackValAndOp +jsr pc,EvalLevel3 ; Evaluate RHS parameter +jsr pc,UnstackValAndCallOp +;movb (r5),r0 ; Get current character +br EvalLevel4More ; Loop to check for more + - + + +; Evaluator Level 3 - * / DIV MOD +; =============================== +.EvalLevel3 +jsr pc,EvalLevel2 ; Call level 2 - ^ +.EvalLevel3More +;movb (r5),r0 ; Get current character +movb (r5)+,r0 ; Get current character +cmpb r0,#ASC"*" +beq EvalTimes +cmpb r0,#ASC"/" +beq EvalDivide +cmpb r0,#tknDIV +beq EvalDIV +cmpb r0,#tknMOD +bne EvalDoneDec +;bne EvalDone +;beq EvalMOD +;rts pc ; Return +.EvalTimes +.EvalDivide +.EvalDIV +.EvalMOD +;inc r5 ; Step past current character +jsr pc,StackValAndOp +jsr pc,EvalLevel2 ; Evaluate RHS parameter +jsr pc,UnstackValAndCallOp +;movb (r5),r0 ; Get current character +br EvalLevel3More ; Loop to check for more * / DIV MOD + + +; Evaluator Level 2 - ^ +; ===================== +.EvalLevel2 +jsr pc,EvalLevel1 ; Call level 1 - eveything else +.EvalLevel2More +movb (r5)+,r0 ; Get current character +cmpb r0,#32 +beq EvalLevel2More ; Skip spaces +cmpb r0,#ASC"^" +bne EvalDoneDec +;beq EvalPower +;dec r5 +;rts pc +.EvalPower +jsr pc,StackValAndOp +jsr pc,EvalLevel1 ; Evaluate RHS parameter +jsr pc,UnstackValAndCallOp +br EvalLevel2More ; Loop to check for more ^ +.EvalDoneDec +dec r5 +.EvalDone +rts pc + + +.errMissingQuote +jsr pc,Error +equb 9,tknMissing,34,0 +align + +; EvalBracket - bracketed expression +; ---------------------------------- +.EvalBracket1 +inc r5 ; Step past '(' +.EvalBracket +jsr pc,Evaluate ; Evalute everything within brackets +jsr pc,CheckClose ; Check closing bracket +tst r2 ; Set flags from returned type +rts pc + +; EvalUnaryMinus - - +; ------------------------- +.EvalUnaryMinus +jsr pc,EvalNumVal ; Get numeric value + +; Negate number +; ------------- +; Preserves r0/r1 as called from elsewhere +.NegateNumber +tst r2 ; Check if integer or float +beq NegateInteger +;mov r0,-(sp) ; Save r0 +;mov #&8000,r0 +;xor r0,r3 ; Toggle mantissa sign bit +;mov (sp)+,r0 ; Restore r0 +sub #&8000,r3 ; Toggle mantissa sign bit +tst r2 ; Set flags +rts pc + +.fnABS +jsr pc,EvalNumVal +beq fnABSint ; Jump if integer +bic #&8000,r3 ; Ensure float sign bit=0 +.fnABS1 +tst r2 ; Set flags +rts pc +.fnABSint +tst r3 ; Check integer b31 +bpl fnABS1 ; Positive, exit with flags set +.NegateInteger +sub #1,r4 ; Do abs=NOT(num-1) +sbc r3 +com r4 +com r3 +tst r2 ; Set flags +rts pc + +; EvalQuote - an immediate string +; ------------------------------- +.EvalQuote +adr SV_STRING,r4 ; Point to string buffer +clr r3 ; Length=0 +.EvalQuoteLp +movb (r5)+,r0 ; Get character +cmpb r0,#13 +beq errMissingQuote +movb r0,(r4)+ ; Store in string buffer +inc r3 ; Increment length +cmpb r0,#34 ; Is this a quote? +bne EvalQuoteLp ; Loop until terminating quote +movb (r5)+,r0 +cmpb r0,#34 ; Double quote? +beq EvalQuoteLp +dec r5 +adr SV_STRING,r4 ; Point to string buffer +dec r3 ; Balance final inc +mov #&8000,r2 ; Type=string, set flags +rts pc + +; ^ - address of identifier +; ----------------------------------- +.EvalAddrOf +jsr pc,SkipSpaceThis +jsr pc,VarFindCreateAddress ; Search for variable/FN/PROC, creating if nonexistant +clr r3 +cmpb (r5)+,#ASC"(" ; Is it ^PROCname() +bne EvalHexDone ; If no following (), jump to return +jsr pc,CheckClose ; Ensure closing bracket present +br EvalHexOk ; Jump to return + + +; Evaluator Level 1 - & - + () " ? ! | $ function variable +; ======================================================== +; Called by other functions, so must set flags on exit +; EvalLevel1 doesn't check free memory as uses very little stack +; Free memory checked on entry to Level7Eval +; +.EvalLevel1 +clr r4 ; Set initial accumulator to 0 +clr r3 +clr r2 + +; EvalUnaryPlus - + +; ------------------------ +.EvalUnaryPlus +.EvalLevel1Spc +movb (r5)+,r0 ; Get current character, step to next +cmp r0,#32 +beq EvalLevel1Spc ; Skip spaces +cmpb r0,#ASC"(" +beq EvalBracket +cmpb r0,#ASC"^" +beq EvalAddrOf +cmpb r0,#&22 +beq EvalQuote +;mov #&6F,r1 ; Highest hex digit+flags +cmpb r0,#ASC"&" +beq EvalHex +cmpb r0,#ASC"@" +beq EvalOct +mov #&31,r1 ; Highest binary digit+flags +cmpb r0,#ASC"%" +beq EvalBinary +cmpb r0,#&8D +bcc EvalFunction1 ; Token, jump via dispatch table +jsr pc,CheckDigit +bcc EvalDecimal ; '0'..'9', decimal digit +cmpb r0,#ASC"-" +beq EvalUnaryMinus +cmpb r0,#ASC"+" +beq EvalUnaryPlus +cmpb r0,#ASC"." +beq EvalFraction ; . + +; Must be !, $, ?, |, variable, variable!offset or variable?offset +; ---------------------------------------------------------------- +.EvalVariable +dec r5 ; Point to first character of variable +jmp VarFindVal ; Returns full value, including length with $addr, $$addr + +.EvalFunction1 +jmp EvalFunction ; Within 'Stack' module + +; EvalOct - @ +; ---------------------- +.EvalOct +movb (r5),r0 +jsr pc,CheckDigit +bcs EvalVariable ; @varname - not octal constant +br EvalOct2 + +; EvalHex - & +; also &o +; ---------------------- +.EvalHexGo ; Call here from OSCLI to scan addresses +.EvalHex +mov #&6F,r1 ; Highest hex digit+flags +movb (r5),r0 +bic #&20,r0 ; Force upper case +cmpb r0,#ASC"O" +bne EvalHexEtc ; Scan hex value +inc r5 ; Step past 'o' +.EvalOct2 +mov #&37,r1 ; Highest octal digit+flags +;asr r1 ; Becomes &37, highest octal digit+flags +; +; EvalBinary - %, r1 already set +; -------------------------------------- +.EvalBinary +.EvalHexEtc +jsr pc,GetHexOctBin ; Get and check first digit +bcc EvalHexEtc3 ; Starts with an valid digit +jsr pc,Error +equb 28,"Bad HEX, OCT or BIN",0 +align + +.EvalHexEtc1 +jsr pc,GetHexOctBin ; Get and check another digit +bcs EvalHexDone ; Not bin/oct/hex, exit all done +.EvalHexEtc3 +mov r1,r2 ; Use max valid char as bitcounter +br EvalHexEtc5 +.EvalEvalHexEtc4 +asl r4 ; Multiply current value by 2 +rol r3 +bcs jmpTooBig ; Overflowed out of b31 +.EvalHexEtc5 +ror r2 +bcs EvalEvalHexEtc4 ; Loop to multiply by 2, 8 or 16 +bic #&FFF0,r0 ; Reduce to binary +bis r0,r4 ; Add in current digit +br EvalHexEtc1 ; Loop for more + + +; EvalDecimalPrefix - read integer decimal exponent +; ------------------------------------------------- +; Called to read E from Decimal parser. +; Reads 31-bit decimal number checking for +/- prefix +; r5=>first character +; +.EvalDecimalNeg +jsr pc,EvalDecimalNext ; Step past '-' and evaluate +jmp NegateNumber ; Negate number and return +.EvalDecimalPrefix +movb (r5),r0 +cmpb r0,#ASC"-" +beq EvalDecimalNeg ; -number +cmpb r0,#ASC"+" ; +number +bne EvalDecimalInt +.EvalDecimalNext +inc r5 ; Step past '+' or '-' + +; EvalDecimalInt - read integer decimal number +; -------------------------------------------- +; Reads 31-bit decimal number to r4:r3 +; r5=>first character +; Generates error if number too big +; +.EvalDecimalInt +clr r4 +clr r3 ; Clear accumulator +.EvalDecimalLp +jsr pc,FetchCheckDigit +bcs EvalDecimalDone ; CS=no more digits +jsr pc,EvalTimes10 ; r3:r4=r3:r4*10 +.EvalDecimalDigit +bic #&FFF0,r0 +add r0,r4 +adc r3 ; r3:r4=r3:r4*10+n +bpl EvalDecimalLp ; Decimal number only up to b30 +.jmpTooBig +jmp errTooBig +;rts pc ; MI=Number too big +.EvalDecimalDone +.EvalHexDone +dec r5 ; Point to terminating non-digit +.EvalHexOk +clr r2 ; Type=integer, set flags, PL, VC, EQ, CC +rts pc + +; EvalDecimalVAL - called from VAL to deal with +/- prefix +; -------------------------------------------------------- +.EvalDecimalVALNeg +jsr pc,EvalDecimalVALNext +jmp NegateNumber +.EvalDecimalVAL +jsr pc,SkipSpaceThis ; Next ; Skip spaces and get character +cmpb r0,#ASC"-" +beq EvalDecimalVALNeg ; VAL"- number" +cmpb r0,#ASC"+" +bne EvalDecimal2 ; VAL"number" +.EvalDecimalVALNext +jsr pc,FetchNextChar ; Step past '-' or '+' +inc r5 ; Balance next dec + +; EvalDecimal - . E .E +; --------------------------------------------------------------- +; r5=>after first digit +; NB: E parsed correctly, but fnPower only does positive powers. +; +.EvalDecimal +dec r5 ; Point back to first digit +.EvalDecimal2 +jsr pc,EvalDecimalInt ; Evaluate decimal string +cmpb r0,#ASC"." +bne EvalCheckExponent ; Not '.', check for 'E' +inc r5 ; Step past '.' +jsr pc,EnsureFloat + +; Parse fractional digits +; ----------------------- +.EvalFraction +mov r3,-(sp) +mov r4,-(sp) +mov r2,-(sp) ; acc=num sp=>num +clr r4 +clr r3 +mov #&80,r2 ; acc=1 sp=>num +.EvalFractionLp ; acc=1 sp=>num +mov r3,-(sp) +mov r4,-(sp) +mov r2,-(sp) ; stack: acc=1 sp=>1, num +mov #&CCCD,r4 +mov #&4CCC,r3 +mov #&007C,r2 ; acc=1/10 sp=>1, num +jsr pc,fnMultiply ; multiply: acc=1/10 sp=>num +tst -(sp) ; acc=1/10 sp=>xxx, num +jsr pc,SwapStack ; swap: acc=num sp=>xxx, 1/10 +mov 6(sp),-(sp) +mov 6(sp),-(sp) +mov 6(sp),-(sp) +tst -(sp) ; dup: acc=num sp=>xxx, 1/10, xxx, 1/10 +jsr pc,SwapStack ; swap: acc=1/10 sp=>xxx, num, xxx, 1/10 +tst (sp)+ ; sp=>num, xxx, 1/10 +mov r3,-(sp) ; sp=>x, num, xxx, 1/10 +;mov r3,(sp) +mov r4,-(sp) ; sp=>xx, num, xxx, 1/10 +mov r2,-(sp) ; stack: acc=1/10 sp=>1/10, num, xxx, 1/10 +jsr pc,FetchCheckDigit ; Get next digit +bcs EvalFractionDone +bic #&FFF0,r0 +mov r0,r4 +clr r3 +clr r2 ; acc=d sp=>1/10, num, xxx, 1/10 +jsr pc,fnMultiply ; multiply: acc=d/10 sp=>num, xxx, 1/10 +mov #&80,r0 ; b7=1, not compare +jsr pc,fnAdd ; add: acc=num+d/10 sp=>xxx, 1/10 +jsr pc,SwapStack ; swap: acc=1/10 sp=>xxx, num+d/10 +tst (sp)+ ; acc=1/10 sp=>num+d/10 +br EvalFractionLp + +.EvalFractionDone ; acc=1/10 sp=>1/10, num, xxx, 1/10 +add #6,sp ; Drop 1/10 +mov (sp)+,r2 ; Pop stacked number +mov (sp)+,r4 +mov (sp)+,r3 +add #8,sp ; Drop xxx and 1/10 +dec r5 ; Point to terminating character +.EvalCheckExponent +bic #&20,r0 +cmpb r0,#ASC"E" ; Check for E +bne EvalExponentDone ; Return with +;.EvalExponent +inc r5 ; Step past 'E' +jsr pc,EnsureFloat ; Ensure floating point format +mov r3,-(sp) +mov r4,-(sp) +mov r2,-(sp) ; Stack number +jsr pc,EvalDecimalPrefix ; Evalute integer exponent +clr -(sp) +mov #10,-(sp) +clr -(sp) ; Stack 10 +jsr pc,fnPower ; Do 10^(exponent) - NB Power currently only does +ve powers +jsr pc,fnMultiply ; Do 10^(exponent) * +.EvalExponentDone +tst r2 ; Set flags +rts pc + +.EvalTimes10 ; r3:r4=r3:r4*10, corrupts r1,r2 +mov r4,r2 +mov r3,r1 +clc +rol r4 +rol r3 ; r3:r4=*2 +rol r4 +rol r3 ; r3:r4=*4 +add r2,r4 +adc r3 +add r1,r3 ; r3:r4=*5 +rol r4 +rol r3 ; r3:r4=*10 +;.EvalTimes10Over +rts pc ; CC=number ok, CS=too big + + diff --git a/src/Execute b/src/Execute new file mode 100644 index 0000000..de378f7 --- /dev/null +++ b/src/Execute @@ -0,0 +1,305 @@ +; > Execute +; Program execute dispatch loop + +; CHANGES +; ======= +; 17-Jan-2009: Line continuation character within SkipSpaces. +; 25-Oct-2009: Places zero word at top of stack so 2(sp) can be examined. +; 15-May-2010: End-Of-Program doesn't check for TOP. +; 21-Jan-2012: TRACE output works, END quits if run-quit flag set. +; 13-Dec-2013: Error scans program to find line where error occured. +; ON ERROR LOCAL works, continuing with local stack. +; 24-Dec-2013: On untrapped error, if QUIT=TRUE, jumps to IO_QUIT. +; 03-Jan-2013: Don't SkipSpace before jumping to VarAssign, fixes "a =1" bug. +; 31-Aug-2015: Low numbered commands use lookup table instead of loads of CMPs. +; Moved call to OSBYTE &7E to error handler. +; 29-Sep-2015: Low command token lookup made position independent. +; 25-Jul-2015: Speeded up SkipSpace by removing bic #&FF00. +; 12-Aug-2023: Optimised execution loop and line scanning. + + +; Generate inline error +; ===================== +; On entry, sp=>inline error address +; +.Error +.ErrorHandler1 +mov (sp)+,r0 ; Pop return address to inline error block +; +; Error handler +; ============= +; On entry, r0=>inline error +; LINE=BASIC line when error occured +; We have to use LINE as we will have lost r5 when going through BRKV +; +.ErrorHandler +mov SV_LINE,SV_ERL ; Save current error line +clr SV_TRACE ; TRACE OFF +mov r0,SV_FAULT ; Save current error +movb (r0),SV_ERR ; Save current error number +beq ErrorNotLocal ; If ERR=0, ignore ON ERROR (won't be Escape) +mov #126,r0 +jsr pc,IO_BYTE ; Acknowledge any Escape state +clrb SV_ESCFLG ; Clear local Escape flag +mov SV_ONERR,r5 ; Get ON ERROR handler +beq ErrorNotLocal ; No error handler +mov SV_STACK,sp ; Point to local stack +cmpb (r5)+,#tknLOCAL ; Is it ON ERROR LOCAL ? +beq Execute ; Jump to execute with local stack +dec r5 ; Step back to non-existant LOCAL +mov SV_HIMEM,sp ; Clear BASIC stack +clr -(sp) ; Put zero at top of stack +mov sp,SV_STACK ; Reset error stack +br Execute ; Jump to execute with empty stack +.ErrorNotLocal +mov SV_HIMEM,sp ; Clear machine stack +jsr pc,cmdREPORT ; Display error message +tstb SV_SYS ; Check run-quit flag +bmi ErrorNoErl ; QUIT=TRUE, don't print line number +mov SV_ERL,r4 ; Get error line +beq ErrorNoErl ; Avoid printing 'at line 0' +jsr pc,PrintInline +equb " at line ",0 +align +jsr pc,PrintLineNum ; Print line number with no space padding +.ErrorNoErl +jsr pc,IO_NEWL +movb SV_ERR,r0 ; r0=ERR if QUIT=TRUE +bic #&FF00,r0 +br cmdEND3 + +; END +; === +.cmdEND +jsr pc,FindTOP ; Check program, R5=>end +.cmdEND2 +clr r0 ; Return value=0 +.cmdEND3 +tstb SV_SYS ; Check run-quit flag +bmi cmdENDQuit +clr SV_AUTO ; Turn off AUTO +jmp ImmediateLoop ; Drop to immediate mode +.cmdENDQuit +jmp IO_QUIT ; Jump to QUIT + + +;tstb SV_SYS ; Check run-quit flag +;bmi cmdENDQuit ; QUIT=TRUE, exit +;.ErrorImmediate +;clr SV_AUTO ; Turn off AUTO +;jmp ImmediateLoop ; Drop to immediate mode +;;br cmdEND ; Check for TOP and drop to immediate mode +; ; Jumping to cmdEND causes repeated errors if +; ; FindTOP walks into invalid memory + + +; RUN [str$] +; ========== +; Run program in memory or chain program from file +.cmdRUN +jsr pc,CheckEndStatement ; Any parameters? +beq RunProgram ; No, RUN program + +; CHAIN str$ +; ========== +; Fetch CR-string +; Call LoadProgram +; Continue into RUN +.cmdCHAIN +jsr pc,EvalStringCR ; Get cr-string parameter + +; ChainStartup +; ------------ +; Chain program, name already at R4 +.ChainStartup +jsr pc,LoadProgram ; Load file as a program (should also clear heap) + +; RUN - Run program in memory +; =========================== +; LOMEM=TOP +; VAREND=TOP +; DATAPTR=PAGE +; STACK=HIMEM +; Clear dynamic variables +; Clear error handler +; LPTR=PAGE +; Enter Execution loop +.RunProgram +jsr pc,VarsHeapInit ; LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE, STACK=HIMEM, stack zero +clr SV_ONERR ; Clear error handler +mov SV_PAGE,r5 ; Point to at start of program +; +; Execute program code +; ===================== +; R5=BASIC program pointer +; R4/R3=32-bit accumulator +; R2=value type/exponent +; R1/R0=working +; +.Execute +jsr pc,UpdateLPTRnext ; R0=char, R5=>next char, skipping spc, colon, cr +cmpb r0,#tknTHEN +beq Execute ; Step past THEN +jsr pc,ExecByte ; Execute this byte +jsr pc,IO_Escape ; Check Escape state +br Execute ; Execute next statement + +; Execute command represented by the current byte +; ----------------------------------------------- +; This is a subroutine so command routines can end with RTS +; On entry, R0=&FFxx for tokens >&7F +; R0=&00xx for characters <&80 +; R5=>next byte +.ExecByte +sub #&FFC6,r0 ; Reduce range +bcs ExecLowCommand ; Not a command token, check for low numbered commands +.ExecByteCommand +asl r0 ; Offset into command table +adr CommandTable,r1 ; Point to command address table +add r0,r1 ; Index into command table +add (r1),r1 ; Calculate routine address +jmp (r1) ; Jump to command routine, (r5)=>current char + +.ExecLowCommand +mov r0,r1 ; Move byte-&FFC6 into R1 +mov #&101-&C6,r0 ; R0=effective token number &101+ +adr CommandBytes,r2 ; R2=>command translation table +.ExecLowCommandLp +cmpb (r2)+,r1 ; Byte compare, so ignores b8-b15 +beq ExecByteCommand ; Low token matches, use translated token +inc r0 +cmp r0,#&10A-&C6 +bne ExecLowCommandLp ; Loop through low numbered tokens +dec r5 ; Point to start of variable +jmp cmdAssign ; Must be variable assignment + +; Update LPTR to skip null code, spaces, colons, end of line +; ---------------------------------------------------------- +; On entry, r5=>current character +; On exit, r0= current character +; r5=>next character +; Flags corrupted +; +.UpdateLPTRnext +movb (r5)+,r0 +cmpb r0,#ASC" " +beq UpdateLPTRnext ; Step past spaces +cmpb r0,#&3A +beq UpdateLPTRnext ; Step past colons +cmpb r0,#13 +bne SkipLineDoneX ; Return with character +movb (r5)+,r0 ; Get byte after +cmpb r0,#&FF ; Program terminator? +beq cmdEND2 ; End of program, do END +movb r0,SV_LINE+1 ; Store current line number high byte +movb (r5)+,SV_LINE+0 ; Store current line number low byte +inc r5 ; Step past line length, r5=>line text +mov SV_TRACE,r1 ; Get TRACE status +beq UpdateLPTRnext ; TRACE OFF, do next line +mov SV_LINE,r4 +cmp r4,r1 ; Compare line number with trace line +bcs UpdateLPTRnext ; line +br SkipLineDone ; Point to + +; Fetch next non-space character +; ------------------------------ +.FetchNextChar +inc r5 ; Step past current character +; +.SkipSpaceThis +jsr pc,SkipSpaceNext +.SkipLineDone +dec r5 ; R0=this char, R5=>this char +.SkipLineDoneX +rts pc + +; Skip past any spaces, and return current character +; -------------------------------------------------- +; Returns r0=current char, r5=>next char +; +.SkipSpaceNext ; return r5=>this char +movb (r5)+,r0 +cmpb r0,#ASC" " +beq SkipSpaceNext ; Loop until non-space +rts pc + +; Check for end of statement, returns Z if end of statement +; --------------------------------------------------------- +.CheckEndStatement +movb (r5)+,r0 +cmpb r0,#ASC" " +beq CheckEndStatement ; Skip any spaces +dec r5 +.CheckEndToken +cmpb r0,#tknELSE +bcc CheckEndStRet +;.CheckColon +cmp r0,#&3A +bcc CheckEndStRet +cmp r0,#&0D +.CheckEndStRet +rts pc + +; Check for numeric characters +; ---------------------------- +; Needs optimising +; Returns CC=Ok digit, R0=&30-&3F +; CS=Not digit +.GetHexOctBin +movb (r5)+,r0 ; Get next digit +cmpb r0,#ASC"0" +bcs CheckDigitExit ; Exit with CS if <'0' +cmpb r0,r1 +bls CheckHexDigit ; Check digit +sec +rts pc + +.CheckHexNext +movb (r5)+,r0 ; Get next hex digit +.CheckHexDigit +jsr pc,CheckDigit ; Is it decimal digit? +bcc CheckDigitExit ; CC=digit +bic #&20,r0 +cmp r0,#ASC"A" +bcs CheckDigitExit +cmp #ASC"F",r0 +bcs CheckDigitExit ; CS=not digit +sub #7,r0 ; Reduce to &3A-&3F +rts pc ; CC=digit + +; Returns CC if digit, CS if nondigit +.FetchCheckDigit +movb (r5)+,r0 ; Get character +.CheckDigit +cmp r0,#ASC"0" ; r0<'0' C=1, r0>='0' C=0 +bcs CheckDigitExit ; Exit with CS if <'0' +cmp #ASC"9",r0 ; '9'=r0 C=0 + ; r0>'9' C=1, r0<='9' C=0 +.CheckDigitExit ; Exit with CS if >'9' +rts pc + diff --git a/src/Functions b/src/Functions new file mode 100644 index 0000000..792e63e --- /dev/null +++ b/src/Functions @@ -0,0 +1,2068 @@ +; > Functions 0.47 +; BASIC functions + +; *BUG* NumberToString sometimes adds decimal digits to integers, eg PRINT TIME -> 1234.01 +; FloatToString loses accuracy over 999999999. + +; 30-Jan-2008: Program functions done: PAGE, TOP, LOMEM, END, HIMEM +; ERL, ERR, COUNT, WIDTH, FALSE, TRUE, REPORT. +; 10-Feb-2008: Done simple functions, ASC, LEN, CHR$, PI, NOT, SGN, ABS. +; 30-Aug-2008: Added binary functions to dispatch table +; OR, EOR, AND, +, -, *, /, DIV. +; NumberToString does hex and integer decimal. +; 04-Sep-2008: STRING$, STR$, LEFT$, RIGHT$, VAL, EVAL, LineNum, USR, CALL. +; 12-Sep-2008: NumberToString does octal and binary conversions. +; NB! MID$ still not working properly yet, INSTR not done yet. +; 15-May-2010: CALL addr,params done. +; 15-Jun-2010: Comparisons done. +; 05-Feb-2012: =DIM array(), =DIM(array(),index). +; 25-Jun-2013: MID$ working, added integer SQR. +; 05-Jul-2013: Floating point ADD works - but only when both signs are the same. +; Integer multiply retries as floats if overflows. +; Floating point multiply works - dropping bottom few bits. +; 12-Jul-2013: FP multiply catches bottom bits - gives same results at 6502/ARM/x86. +; Floating point subtraction past zero gives correct results. +; Just floating point division needed now. +; 04-Aug-2013: Well roger me sideways with a tuba! Floating point division works! +; Possible rounding error in 33rd bit of division result. +; Integer division doesn't work with negative numbers. +; 05-Aug-2013: Division rounding works, 1/3+1/3+1/3 gives 1. Needs some tidying up. +; Integer multiply uses shifts, negative integers multiply as floats. +; Having seperate integer multiply adds 92 bytes, but increases integer +; multiply speed by 24%. May be able to combine integer and mantissa multiply +; code. +; 14 Aug 2013: DIV/MOD working, for positive and negative numbers, MOD gives correct sign. +; ABS moved to UnaryMinus/Negate. Function dispatch doesn't jump via SkipSpace +; so eg 'TIME $' doesn't match 'TIME$', also speeds up dispatch. +; 20 Nov 2013: INSTR works. +; 26 Dec 2013: String comparison done. +; 05-Jan-2014: (neg)*(num)+0 works, now discards zero and returns (neg)*(num) instead of +; attempting to add zero to (neg)*(num). +; 26-Aug-2015: EVAL copies string from buffer to stack to evaluate, as otherwise called +; functions that use the string buffer would overwrite the string being +; evaluated. +; 31-Aug-2015: fnREPORT moved to Variables to return via FindStringVal. +; 01-Sep-2015: High numbered functions use lookup table instead of long dispatch table. +; 08-Sep-2015: RND(n) works, correctly gives reals 0..1 and integers 1..n. Actual numbers +; generated slightly difference from 6502, but underlying RNG is identical, +; RND gives identical integer sequence. +; 13-Oct-2015: StringAdd copes with overlapping strings in string buffer. +; 25-Jul-2016: SQR gets int value, not int expression. VAL"+num", VAL"-num" works. +; fnAddFloat adds underflow back into mantissa to round up, fractional numbers work. +; 06-Aug-2016: fnPower does simple powers to integer exponent, some optimisation. +; 14-Aug-2016: Updated fnAddFloat - needs some more testing. +; 16-Aug-2016: fnAddFloat working, but bug in fnMultiplyFloat - rounding bit needs to be +; added into result as part of normalising, not before normalising. +; 21-Aug-2016: Rounding bits from Multiply correctly added in when normalising, 0.5=1/2. +; 11-Jul-2017: EVAL copes with EVAL($address). +; 14-Jul-2017: Tokeniser returns length, allows EVAL optimisation. +; 16-Jul-2018: FASTMUL uses Dennis Richie's fast 32-bit multiply code. +; 20-Jul-2018: Couldn't add overflow checks to Dennis' code, so wrote replacement from scratch. +; 06-Aug-2018: Bugfix for AddFloat from fnSubtract, need to keep Carry past ADC, also in MultFloat. +; 16-Aug-2018: TrigLog functions moved to TrigLog, power and SQR still here. +; Something following here broke fnAddFloatMinus +; 25-Aug-2018: Making progress on FloatToString, fixed at nine digits general format. +; 26-Aug-2018: FloatToString working, fixed at G9 for floats, G10 for integers. +; 09-May-2020: MultiplyInt only uses fast code for <&8000 x <&8000 as MUL is signed. +; 14-Mar-2021: Commented out code in fnAddFloatMinus - fixes accummulated errors in circles. +; 16-Mar-2021: Fixed 32-bit compare in DIV. Fixed lost Carry after SUB 0000->FFFF in DivideFloat. +; 25-Sep-2022: Rewritten and optimised DivideFloat. +; 18-Mar-2024: Added NOEXTRAFN option, many small optimisations, USR returns Carry. +; 30-Jul-2024: NumberToString uses IntegerToString again, FloatToString loses accuracy over +; 999999999. Uses fast/compact DIV-based routine. Some PDPs don't have DIV. + + +; Function address table +; ====================== +; On entry to function subroutines, +; r5=>character after function token, no spaces skipped +; r0=function token +; r1=dispatch address +; r2/r3/r4=current value, type already checked, flags irrelevant +; Binary operators have sp=> retaddr, previous value r2,r4,r3 or r2,length,string +; Unary functions have sp=> retaddr +; +; On exit from function subroutines, +; r4=b0-b15 or string start +; r3=b16-b31 or string length +; r2=type and real exponent +; b15=0 - numeric +; 0000 - integer +; 00xx - real, xx=exponent +; b15=1 - string +; 8000 - normal string +; 8100 - $address, -terminated +; 8200 - $$address, -terminated +; +; flags must be set from r2 on exit +; +; <&80 - comparisons, return TRUE/FALSE +EQUW fnCompare-$ ; &79 - <= +EQUW fnCompare-$ ; &7A - <> +EQUW fnCompare-$ ; &7B - >= +EQUW fnCompare-$ ; &7C - < +EQUW fnCompare-$ ; &7D - = +EQUW fnCompare-$ ; &7E - > +EQUW errNoSuchVar-$ ; &7F +; +; >&7F - functions and operators, return a value +.FunctionTable +EQUW fnAND-$ ; &80 - AND +EQUW fnDIV-$ ; &81 - DIV +EQUW fnEOR-$ ; &82 - EOR +EQUW fnMOD-$ ; &83 - MOD +EQUW fnOR-$ ; &84 - OR +EQUW errNoSuchVar-$ ; &28 - ( +EQUW errNoSuchVar-$ ; &29 - ) +EQUW fnMultiply-$ ; &2A - * +EQUW fnAdd-$ ; &2B - + +EQUW errNoSuchVar-$ ; &2C - , +EQUW fnSubtract-$ ; &2D - - +EQUW fnPower-$ ; &5E - ^ +EQUW fnDivide-$ ; &2F - / +; <&8D - binary operators +; >&8C - unary functions +; parameter +EQUW fnLineNum-$ ; &8D - linenum +EQUW fnOPENIN-$ ; &8E - OPENIN (Interface) string +EQUW fnPTR-$ ; &8F - PTR (Interface) #channel +EQUW fnPAGE-$ ; &90 - PAGE +EQUW fnTIME-$ ; &91 - TIME (Interface) [$] +EQUW fnLOMEM-$ ; &92 - LOMEM +EQUW fnHIMEM-$ ; &93 - HIMEM +EQUW fnABS-$ ; &94 - ABS (Evaluate) number +EQUW fnACS-$ ; &95 - ACS float +EQUW fnADVAL-$ ; &96 - ADVAL (Interface) integer +EQUW fnASC-$ ; &97 - ASC float +EQUW fnASN-$ ; &98 - ASN float +EQUW fnATN-$ ; &99 - ATN float +EQUW fnBGET-$ ; &9A - BGET (Interface) #channel +EQUW fnCOS-$ ; &9B - COS float +EQUW fnCOUNT-$ ; &9C - COUNT +EQUW fnDEG-$ ; &9D - DEG float +EQUW fnERL-$ ; &9E - ERL +EQUW fnERR-$ ; &9F - ERR +EQUW fnEVAL-$ ; &A0 - EVAL string +EQUW fnEXP-$ ; &A1 - EXP float +EQUW fnEXT-$ ; &A2 - EXT (Interface) #channel +EQUW fnFALSE-$ ; &A3 - FALSE +EQUW fnFN-$ ; &A4 - FN (Commands) name +EQUW fnGET-$ ; &A5 - GET (Interface) +EQUW fnINKEY-$ ; &A6 - INKEY (Interface) integer +EQUW fnINSTR-$ ; &A7 - INSTR( string +EQUW fnINT-$ ; &A8 - INT (Evaluate) number +EQUW fnLEN-$ ; &A9 - LEN string +EQUW fnLN-$ ; &AA - LN float +EQUW fnLOG-$ ; &AB - LOG float +EQUW fnNOT-$ ; &AC - NOT integer +EQUW fnOPENUP-$ ; &AD - OPENUP (Interface) string +EQUW fnOPENOUT-$ ; &AE - OPENOUT (Interface) string +EQUW fnPI-$ ; &AF - PI +EQUW fnPOINT-$ ; &B0 - POINT( (Interface) integer +EQUW fnPOS-$ ; &B1 - POS (Interface) +EQUW fnRAD-$ ; &B2 - RAD float +EQUW fnRND-$ ; &B3 - RND [(] +EQUW fnSGN-$ ; &B4 - SGN number +EQUW fnSIN-$ ; &B5 - SIN float +EQUW fnSQR-$ ; &B6 - SQR float +EQUW fnTAN-$ ; &B7 - TAN float +EQUW fnTO-$ ; &B8 - TO +EQUW fnTRUE-$ ; &B9 - TRUE +EQUW fnUSR-$ ; &BA - USR integer +EQUW fnVAL-$ ; &BB - VAL string +EQUW fnVPOS-$ ; &BC - VPOS (Interface) +EQUW fnCHRs-$ ; &BD - CHR$ integer +EQUW fnGETs-$ ; &BE - GET$ (Interface) [#] +EQUW fnINKEYs-$ ; &BF - INKEY$ (Interface) integer +EQUW fnLEFTs-$ ; &C0 - LEFT$( string +EQUW fnMIDs-$ ; &C1 - MID$( string +EQUW fnRIGHTs-$ ; &C2 - RIGHT$( string +EQUW fnSTRs-$ ; &C3 - STR$ [~] +EQUW fnSTRINGs-$ ; &C4 - STRING$( integer +EQUW fnEOF-$ ; &C5 - EOF (Interface) #channel + +; High numbered tokens used as functions +EQUW fnEND-$ ; &CC - &E0 - END +EQUW fnMODE-$ ; &CD - &EB - MODE (Interface) +EQUW fnVDU-$ ; &CE - &EF - VDU (Interface) integer +EQUW fnREPORT-$ ; &CF - &F6 - REPORT +#ifndef NOEXTRAFN + EQUW fnQUIT-$ ; &C6 - &C8 - LOAD, QUIT, SYS + EQUW fnPTR-$ ; &C7 - &CF - PTR (Interface) #channel + EQUW fnPAGE-$ ; &C8 - &D0 - PAGE + EQUW fnTIME-$ ; &C9 - &D1 - TIME (Interface) [$] + EQUW fnLOMEM-$ ; &CA - &D2 - LOMEM + EQUW fnHIMEM-$ ; &CB - &D3 - HIMEM + EQUW fnDIM-$ ; &D0 - &DE - DIM (Variables) + EQUW fnWIDTH-$ ; &D1 - &FE - WIDTH + EQUW fnOSCLI-$ ; &D2 - &FF - OSCLI (Interface) string +#endif + +.FunctionBytes +EQUB &E0,&EB,&EF,&F6 ; END, MODE, VDU, REPORT +#ifndef NOEXTRAFN + EQUB &C8,&CF,&D0,&D1,&D2,&D3 ; QUIT, cmdPTR, cmdPAGE, cmdTIME, cmdLOMEM, cmdHIMEM + EQUB &DE,&FE,&FF ; DIM, WIDTH, OSCLI as functions +#endif +EQUB &00 +ALIGN + + +; String functions +; ~~~~~~~~~~~~~~~~ + +; Test for conversion character +; ----------------------------- +; On exit: CC=no conversion character, r1 preserved +; CS=conversion character found +; r1=&84xx - ~hex - 4 bits per digit +; r1=&83xx - #octal - 3 bits per digit +; r1=&81xx - /binary - 1 bit per digit +.fnConversion +mov r1,-(sp) ; Save current flag +bic #&FF00,r1 ; Set flag to decimal +bis #&8400,r1 ; Set flag to hex +cmp r0,#ASC"~" +beq fnConvGo ; Convert to hex string +sub #&0100,r1 ; Set flag to octal +cmp r0,#ASC"=" +beq fnConvGo ; Convert to oct string +sub #&0200,r1 ; Set flag to binary +cmp r0,#ASC"/" +beq fnConvGo ; Convert to binary string +mov (sp)+,r1 ; Get saved flag +clc ; Set 'no conversion flag' +rts pc +.fnConvGo +tst (sp)+ ; Drop saved flag +inc r5 ; Step past conversion flag +rts pc + +.fnSTRs +jsr pc,SkipSpaceThis +clr r1 ; Set to decimal +jsr pc,fnConversion ; Check for ~/# character and set r1 to conversion flag +mov r1,-(sp) ; Save dec/hex flag +jsr pc,EvalNumVal +mov (sp)+,r1 ; Get dec/hex flag back +;mov SV_VARS+2,r0 ; R0=print format +;cmp r0,#&0100 +;bcc NumberToString ; @%=&nnxxxxxx, use @% format +;clr r0 ; @%=&00xxxxxx, use general format + ; Fall through into number conversion + + +; Convert a number to a string +; ---------------------------- +; On entry: r0=? +; r1=hex/oct/bin flag in b15-b8 +; r2=exponent +; r3,r4=integer/mantissa +; On exit: r5 preserved +; r4=>string +; r3=length +; r2='string' type, flags set +; r1 corrupted +; r0=>byte after end of string +.NumberToString +adr SV_STRING,r0 ; Point to string buffer +tst r1 +bpl DecimalToString ; b15 clear, convert to decimal + +; Output in hex, oct or bin +; ------------------------- +jsr pc,EnsureInteger ; If float, convert to integer, preserves R0,R1 +;.NumberToHexEtc +clr -(sp) ; 4(sp)=leading zero flag +swab r1 ; Get base to bottom byte +bic #&FFF0,r1 ; Reduce to 1,3,4 +mov r1,-(sp) ; 2(sp)=bits per digit +mov #31,-(sp) ; (sp)=number of bits-1 +mov r1,r2 ; r2=bits for this digit +bit #2,r2 +beq NumToStrLp1 ; Not octal, go ahead +dec r2 ; Only two bits in first octal digit +.NumToStrLp1 +clr r1 ; Clear digit accumulator +.NumToStrLp2 +rol r4 ; Rotate bits into r0 +rol r3 +rol r1 +dec (sp) ; Dec bit counter +dec r2 ; Dec bits for this digit +bne NumToStrLp2 +tst r1 +bne NumToStrDigit ; Not zero, output digit +mov 4(sp),r1 ; Check leading zero flag +beq NumToStrNxt ; Nothing output yet +.NumToStrDigit +bis #ASC"0",r1 ; Convert to digit +cmp r1,#ASC"9"+1 +bcs NumToStrOut +add #7,r1 ; Convert hex digit +.NumToStrOut +movb r1,(r0)+ ; Put character in string buffer +mov #ASC"0",4(sp) ; Output zeros from now on +.NumToStrNxt +mov 2(sp),r2 ; Set number of bits for next digit +tst (sp) ; All digits done yet? +bpl NumToStrLp1 ; Loop back for more +cmp (sp)+,(sp)+ ; Drop bit count and bits/digit +tst (sp)+ ; Still no leading zeros? +bne NumToStrDone +.NumToStrZero +movb #ASC"0",(r0)+ ; Output '0' for &0 +.NumToStrDone +adr SV_STRING,r4 ; r4=>string +mov r0,r3 ; r3=>end +sub r4,r3 ; r3=length +mov #&8000,r2 ; r2='string', flags set +rts pc ; r0=>end, r1 corrupted + +;#define FLOATPRINT ; Use FloatToString for integers, with saving of memory + +; Output in decimal +; ----------------- +.DecimalToString +tst r3 ; Check sign bit +bpl DecimalNotNeg +movb #ASC"-",(r0)+ ; Put '-' sign in string buffer +jsr pc,NegateNumber +.DecimalNotNeg +#ifdef FLOATPRINT + jsr pc,EnsureFloat ; Force to float, preserves r0,r1 + tst r2 ; Float with exp=0 must be zero + beq NumToStrZero ; to do: check format +#else + tst r2 + beq IntegerToString ; Integer, convert as integer +#endif + +; Output float in decimal +; ----------------------- +;bic #&8000,r3 ; Ensure positive +mov r0,-(sp) ; Save output pointer +clr -(sp) ; Decimal places +.FloatCheckLower +cmp r2,#&80 ; Check exponent +bcc FloatCheckUpper ; 2^0 or more, 1.0 or greater +mov #&2000,-(sp) +mov #&0000,-(sp) ; Stack 10.0 +mov #&0083,-(sp) +jsr pc,fnMultiplyFloat2 ; Multiply by ten; corrupts r0,r1 +dec (sp) ; Decrement decimal places - fractional digits +br FloatCheckLower ; Loop until 1.0 or greater +; +.FloatCheckUpper +cmp r2,#&83 ; Check exponent +bcs FloatWithinBounds ; Less than 2^3, less than 8, within 1-9.9999 range +bne FloatDivide10 ; 2^4 or greater, 16 or greater, reduce to get in range +cmp r3,#&2000 +bcs FloatWithinBounds ; Between 8 and 9.999, within range +.FloatDivide10 +mov #&4CCC,-(sp) +mov #&CCCD,-(sp) ; Stack 1/10 +mov #&007C,-(sp) ; +jsr pc,fnMultiplyFloat2 ; Multiply by 1/10 - divide by 10 +inc (sp) ; Increment number of decimal places +br FloatCheckLower ; Loop until within 1.0 to 9.9999 +; +.FloatWithinBounds +;cmp (sp),#9 ; Maxiumum of 9 digits +;bcs FloatWithinBounds2 +;jmp errTooBig ; Too many digits +.FloatWithinBounds2 +mov #&2BCC,-(sp) ; 9 digits add 0.000000005 +mov #&7712,-(sp) ; +mov #&0064,-(sp) ; +mov #&80,r0 ; b7=1, not compare +jsr pc,fnAddFloat1 ; Round final digit +bis #&8000,r3 ; Insert leading 1 +; +.FloatAdjustToBCD +cmp #&82,r2 ; Check exponent +bcs FloatOutput ; exp>&82, num=man*2^8, man b31-b28 is BCD of decimal number +ror r3 ; Divide mantissa by 2 +ror r4 +inc r2 ; Increment exponent by 2 to balance +br FloatAdjustToBCD ; Loop until exponent=&83, man*2^8 +; +.FloatOutputUnity +clr r4 +mov #&1000,r3 ; r3/4=1.0 +inc (sp) ; Increment number of decimal places +; +.FloatOutput +cmp r3,#&A000 +bcc FloatOutputUnity ; Jump back to output 1.000 +mov (sp)+,r2 ; Get decimal places counter to R2 +mov (sp)+,r0 ; Get output pointer back to R0 +mov #10,-(sp) ; Ten digits +mov r2,-(sp) ; Put decimal places counter back on stack +bpl FloatDigits ; num>=1.0, start outputting digits +movb #ASC"0",(r0)+ ; Output leading '0.' +movb #ASC".",(r0)+ +dec 2(sp) ; Decrement number of digits +br FloatSmall ; Small number, output leading zeros +.FloatSmallLp +movb #ASC"0",(r0)+ ; Output '0' after decimal point +.FloatSmall +dec 2(sp) ; Decrement number of digits +inc (sp) ; Increment decimal places counter +bmi FloatSmallLp ; Loop while still more after decimal point +mov #&80,(sp) ; We've already output the decimal point +; +.FloatDigits +inc (sp) +.FloatDigitsLoop +mov r3,r1 ; Get top of mantissa +swab r1 ; Move b31-b28 to b3-b0 of R1 +ror r1 +ror r1 +ror r1 +ror r1 +bic #&FFF0,r1 ; Reduce to 0-9 +bis #ASC"0",r1 ; Convert to ASCII +movb r1,(r0)+ ; Store in buffer +bic #&F000,r3 ; Drop top nybble from mantissa +jsr pc,EvalTimes10 ; mantissa=mantissa*10, corrupts r1,r2 +dec (sp) ; Decrement decimal places counter +bne FloatNoPoint +movb #ASC".",(r0)+ ; Passing decimal place zero, output decimal point +.FloatNoPoint +dec 2(sp) +bpl FloatDigitsLoop ; Loop for all significal digits +dec r0 ; Step back to last proper digit +dec r0 +.FloatDropZeros +movb -(r0),r1 +cmp r1,#ASC"." +beq FloatDropPoint ; Trailing decimal point, drop it +cmp r1,#ASC"0" +beq FloatDropZeros ; Trailing zero, drop it and check for another +inc r0 ; Keep this final digit +.FloatDropPoint +cmp (sp)+,(sp)+ ; Drop decimal places counter and digits counter +jmp NumToStrDone + +#ifndef FLOATPRINT +; Output integer in decimal +; ------------------------- +.IntegerToString +; +#ifdef NODIV +;jsr pc,EnsureInteger ; Force float to integer, preserves R0,R1 +clrb (r0) ; Flag 'no digits yet' +adr DecimalPowers,r2 ; Point to divisors +.IntegerNextDigit +clr r1 ; Set digit to zero +.IntegerLoop +cmp 2(r2),r3 +bcs IntegerSub ; eg, r3/r4 > &3B9Axxxx, must be &3B9B or higher +beq IntCheckLow ; eg, r3/r4 = &3B9Axxxx, check low word +bcc IntegerDigit ; eg, r3/r4 =< &3B9Axxxx, must be < &3B9A0000 +.IntCheckLow +cmp (r2),r4 +bcs IntegerSub ; eg, r3/r4 > &3B9ACA00 +beq IntegerSub ; eg, r3/r4 = &3B9ACA00 +bcc IntegerDigit ; eg, r3/r4 =< &3B9ACA00, must be <&3B9ACA00 +.IntegerSub +sub (r2),r4 +sbc r3 +sub 2(r2),r3 ; r3/r4=r3/r4-divisor +inc r1 ; Increment digit +br IntegerLoop +.IntegerDigit +tst r1 ; r0=digit +bne IntegerNotZero +tstb (r0) ; Any digits yet? +beq IntegerLeadingZero +.IntegerNotZero +bis #ASC"0",r1 +movb r1,(r0)+ ; Store digit +movb #13,(r0) ; Flag 'some digits done' +.IntegerLeadingZero +cmp (r2)+,(r2)+ ; r2=r2+4, point to next divisor +tst (r2) ; End of divisor table? +bne IntegerNextDigit ; Do more units +bis #ASC"0",r4 +movb r4,(r0)+ ; Store final digit +jmp NumToStrDone + +.DecimalPowers +equd 1000000000 +equd 100000000 +equd 10000000 +equd 1000000 +equd 100000 +equd 10000 +equd 1000 +equd 100 +equd 10 +equw 0 +#else +; 32-bit decimal printout +; ======================= +; *BUG* This gives Bad word access on some PDP11s. +; On entry: r0=>string buffer +; r1=hex/oct/bin flag in b15-b8 +; r2=exponent +; r3,r4=integer/mantissa +; On exit: r0=>byte after end of string +; r1 corrupted +; + MOV R4,R2 ; R2=number b0-b15 + ;MOV R3,R3 ; R3=number b16-b31 +.prdec32 MOV #-1,-(SP) ; Stack terminator +.prdec32lp1 MOV R2,-(SP) ; Save low order 16 bits of dividend + CLR R2 ; Divide high order 16 bits of dividend by the divisor + DIV #10,R2 ; R0=R0:R1 DIV R2, R1=R0:R1 MOD R2 + MOV R2,R1 ; Save high order 16 bits of quotient + MOV R3,R2 ; Divide the remainder + MOV (SP),R3 ; of the dividend by the divisor + DIV #10,R2 ; R0=R0:R1 DIV R2, R1=R0:R1 MOD R2 + BIS #ASC"0",R3 ; Convert remainder to ASCII digit + MOV R3,(SP) ; Stack it + MOV R1,R3 ; R1=result b16-b31, R0=result b0-b15 + BIS R2,R1 + BNE prdec32lp1 ; Loop until number is zero +.prdec32lp2 MOV (SP)+,R1 ; Pop digit off + BMI prdec32done; Terminator, all done + MOVB R1,(R0)+ ; Store in buffer + BR prdec32lp2 ; Loop for another +.prdec32done jmp NumToStrDone +#endif +#endif + + +.fnLEFTs +.fnRIGHTs +mov r0,-(sp) ; Save LEFT$/RIGHT$ token +jsr pc,EvalString +mov (sp)+,r0 +jsr pc,StackStringAndOp ; sp=> LEFT$/RIGHT$, &8xnn, string... +jsr pc,EvalComma +jsr pc,CheckClose +mov (sp),r0 ; r0=LEFT$/RIGHT$ token +mov r4,r1 +jsr pc,UnstackStringDropOp ; Get string from stack +; r0=LEFT$/RIGHT$ token ; This could be sped up by manipulating +; r1=wanted length ; the string directly on the stack, then +; r2=type &8xnn ; StackDrop-ing it. Still need to then +; r3=source length &00nn ; copy it to string buffer though. +; r4=>source string +mov r3,r2 +cmp r1,r3 +bcc fnLEFTall +cmpb r0,#tknLEFTs +beq fnLEFTdo +add r3,r4 +sub r1,r4 +.fnLEFTdo +mov r1,r2 +.fnLEFTall +mov r2,r3 +mov #&8000,r2 ; r2=string type, flags set +rts pc + +.fnMIDs +jsr pc,EvalString ; MID$(string +jsr pc,StackStringAndOp +jsr pc,EvalComma ; MID$(string,start +mov #255,r1 ; Prepare wanted=255 +cmpb r0,#ASC")" +beq fnMID2 ; MID$(string,start) +mov r4,-(sp) ; Save start +jsr pc,EvalComma ; MID$(string,start,length +mov r4,r1 ; r1=wanted length +mov (sp)+,r4 ; r4=start +.fnMID2 +jsr pc,CheckClose ; MID$(string,start[,length]) +mov r4,r0 +beq fnMID3 ; start position=0 same as =1 +dec r0 ; r0=start position, 0=first character +.fnMID3 +; r0=start position, 0=first character +; r1=wanted length +jsr pc,UnstackStringDropOp +; r0=start position, 0=first character +; r1=wanted length +; r2=type &80nn +; r3=source length &00nn +; r4=>source string in string buffer +mov r1,r2 +add r0,r2 ; r2=wanted length+start position +cmp r2,r3 ; is end position past end of source string? +bcs fnMIDshort ; endsource string +cmp r0,r3 +bcc fnMIDlong ; start>end +add r0,r4 ; r4=new string start +mov r1,r3 ; r3=new string length +mov #&8000,r2 ; r2=string type +rts pc +.fnMIDlong +clr r3 ; Null string +mov #&8000,r2 ; r2=string type, flags set +rts pc + +.fnSTRINGs +jsr pc,EvalInteger ; STRING$(num +bic #&FF00,r4 ; Ensure num is 0-255 only +mov r4,-(sp) ; Stack num +jsr pc,CheckComma ; STRING$(num, +jsr pc,EvalString ; STRING$(num,string +jsr pc,CheckClose ; STRING$(num,string) +mov r3,r0 ; r0= source length +jsr pc,EnsureString ; Ensure string is at start of string buffer +mov r4,r1 ; r1=>source string +mov (sp)+,r4 ; r4= multiplier +clr r3 ; r3= dest length +tst r4 +beq fnSTRINGdone ; zero length, use it +adr SV_STRING,r2 ; r2=>dest string +mov r1,-(sp) ; Save source start +mov r0,-(sp) ; Save source length +.fnSTRINGlp1 +mov (sp),r0 ; Get source start +mov 2(sp),r1 ; Get source length +.fnSTRINGlp2 +movb (r1)+,(r2)+ ; Copy characters +inc r3 +bit #&FF00,r3 +bne errStringTooLong +dec r0 +bne fnSTRINGlp2 ; Copy one copy +dec r4 ; Decrement number of multiples +bne fnSTRINGlp1 ; Loop to copy another copy +cmp (sp)+,(sp)+ ; Drop source start and length from stack +br fnSTRINGdone + +;.fnSTRINGzero +;adr SV_STRING,r4 ; r4=>output string +;mov #&8000,r2 ; r2=string type, flags set +;rts pc + +.fnCHRs +jsr pc,EvalIntVal +movb r4,SV_STRING ; Put char in string buffer +mov #1,r3 ; Length=1 +.fnSTRINGdone +adr SV_STRING,r4 ; Point to string +mov #&8000,r2 ; Type=String +rts pc + +.fnINSTR +jsr pc,EvalString ; Evaluate 'haystack' string +jsr pc,StackStringAndOp ; Stack string and dummy Op +jsr pc,CheckComma +jsr pc,EvalString ; Evaluate 'needle' string +mov #1,r1 ; Default start at 1st character +cmpb (r5),#ASC")" +beq fnINSTR1 ; INSTR(str1,str2) - use default start position +jsr pc,StackStringAndOp ; Stack 'needle' string +jsr pc,EvalComma ; Get start position +mov r4,r1 ; r0=start position +jsr pc,UnstackStringDropOp ; Get 'needle' string back +.fnINSTR1 +jsr pc,CheckClose ; Ensure closing bracket +mov r4,(sp) ; Save start of needle string +clr r4 ; Prepare for 'not found' +tst r3 +beq fnINSTRdone ; needle="" +bic #&FF00,2(sp) ; Remove type from haystack type+length +beq fnINSTRdone ; haystack="" +; +; r4=>step through needle string +; r3= length of needle string +; r2=>step through haystack string +; r1= search start position, 1=1st character +; r0= count of needle string +; sp=>start of needle string, length, 'haystack' string... +; +dec r1 ; Prepare for following increment +.fnINSTRlook +clr r4 ; Prepare for 'not found' +mov r1,r0 +add r3,r0 ; start+LEN(needle) +cmp 2(sp),r0 ; Compare with LEN(haystack) +bcs fnINSTRdone ; No more haystack to search, return r4=0 +inc r1 ; Step to next start position +mov sp,r2 +add #3,r2 ; r2=>haystack on stack-1 +add r1,r2 ; Add offset to current start +mov (sp),r4 ; Get start of needle +mov r3,r0 ; Get current needle count +.fnINSTRloop +cmpb (r2)+,(r4)+ ; Compare characters +bne fnINSTRlook ; Different, restart at next haystack char +dec r0 ; Decrement needle count +bne fnINSTRloop ; Loop through all needle chars +mov r1,r4 ; All match, retvalue=start +.fnINSTRdone +jsr pc,UnstackDropStringOp ; Drop haystack from stack +clr r3 +clr r2 ; Return integer, flags set +rts pc + +.errStringTooLong +jsr pc,Error +equb 19,"String too long",0 +align + + +; String operators +; ~~~~~~~~~~~~~~~~ + +; Addition - + +; ------------------------------ +.fnAddString ; + +; On entry, r4=>RHS string (which may be in the string buffer, not necc'ly at start) +; r3= RHS string length +; sp=>retaddr, LHS &8x00+length, LHS string on stack +mov 2(sp),r2 ; Get stacked string type+length +bic #&FF00,r2 ; Remove string type +mov r3,r0 +add r2,r0 ; Find combined string length +;bic #&FF00,2(sp) ; Remove type from stacked length +;mov r3,r0 +;add 2(sp),r0 ; Find combined string length +cmp r0,#256 ; String too long? +bcc errStringTooLong + +;;; +tst r3 +beq fnAddStr2 ; RHS string is zero length +adr SV_STRING,r1 ; Point to string buffer +add r2,r1 ; r1=>start of dest for RHS in string buffer +cmp r4,r1 ; Where is RHS compared to string buffer? +bcc fnAddStrLp2 ; RHS string in high memory, copy upwards +add r3,r1 ; Point to end of string destination +add r3,r4 ; Point to end of string source +.fnAddStrLp1 +movb -(r4),-(r1) ; Copy string downwards +dec r3 +bne fnAddStrLp1 +br fnAddStr2 +.fnAddStrLp2 +movb (r4)+,(r1)+ ; Copy string upwards +dec r3 +bne fnAddStrLp2 +;;; + +;adr SV_STRING,r1 ; Point to string buffer +;add r0,r1 ; Add length of joined string +;tst r3 +;beq fnAddStr2 ; Current string is zero length +;add r3,r4 ; Point to end of current string +;.fnAddStrLp2 +;movb -(r4),-(r1) ; Copy character to end of string buffer +;dec r3 +;bne fnAddStrLp2 ; Loop to copy current string + +.fnAddStr2 +mov (sp)+,r1 ; Pop return address +jsr pc,UnstackString ; Pop string from stack to start of string buffer +; r2=type &8xnn +; r3=length &00nn +; r4=>string +mov r0,r3 ; r3=combined string length +mov #&8000,r2 ; r2=string type, flags set +jmp (r1) ; Return via r1 + +; String comparisons - +; ------------------------------------------ +; On entry, r4=>RHS string +; r3= RHS string length +; r0 = operator token +; sp=>retaddr, LHS &8x00+length, LHS string +; +.fnCompareString +mov sp,r2 +;add #4,r2 ; r2=>LHS string +;mov 2(sp),r1 +tst (r2)+ ; r2=>length +mov (r2)+,r1 ; r2=>string, r1=length +bic #&FF00,r1 ; r1=LHS length +cmp r1,r3 +bcs fnCompareStr1 +mov r3,r1 ; r1=shortest string length +.fnCompareStr1 +inc r1 ; Balance next dec r1 +br fnCompareStrTest + +; r4=>RHS string +; r3= RHS string length +; r2=>LHS string +; r1= count of shortest string +; r0= operator token +; +.fnCompareStrLp +cmpb (r2)+,(r4)+ ; Compare characters +bne fnCompareStrDiff ; Different within shortest length +.fnCompareStrTest +dec r1 +bne fnCompareStrLp ; Loop while strings same for shortest length +mov 2(sp),r1 ; Compare length of strings +bic #&FF00,r1 ; r1=LHS length +clr r4 ; r4=0 - strings equal +cmp r1,r3 +beq fnCompareStrDone +;.fnCompareStrDiff ; flags set according to compare +;beq fnCompareStrEq +.fnCompareStrDiff ; flags set according to compare +mov #1,r4 ; r4=1 - LHS > RHS +bcc fnCompareStrDone +mov #-1,r4 ; r4=-1 - LHS < RHS +;br fnCompareStrDone +;.fnCompareStrEq +;clr r4 ; r4=0 - strings equal +.fnCompareStrDone +mov (sp),r1 ; Get return address +jsr pc,UnstackDropStringOp; r0/r1/r4 preserved +mov r1,-(sp) ; Restack return address +jmp fnCompareDoneR4 ; Convert R4 and R0 into TRUE/FALSE result + + +; Numeric operations +; ~~~~~~~~~~~~~~~~~~ +; On entry, LHS and RHS are either both numbers or both strings +; Comparisons and '+' allow strings and numbers +; All others pre-check to only allow numbers +; + +; Comparisons - +; =================================== +; On entry, r2/r3/r4 = RHS value +; r0 = operator token +; sp=>retaddr, r2/r4/r3 = LHS value +.fnCompare +tst r2 ; Check for +bmi fnCompareString ; Jump to compare strings + ; Fall through to subtract and check result afterwards + +; Subtraction - - +; ================================= +; On entry, r2/r3/r4 = RHS value +; r0 = operator token +; sp=>retaddr, r2/r4/r3 = LHS value +.fnSubtract +jsr pc,NegateNumber ; Change to + - + ; Fall through into Addition + +; Addition - + +; ============================ +; On entry, r2/r3/r4 = RHS value +; r0 = operator token +; sp=>retaddr, r2/r4/r3 = LHS value +.fnAdd +tst r2 +bmi fnAddString ; Jump with + +bne fnAddFloat ; Jump with + + ; We now have + +tst 2(sp) +bne fnAddFloat1 ; Jump with + +; +; Integer addition - + +; ---------------------------------------- +; Also: add zero to float +; Note what happens to &7FFFFFFF+1. As with 6502 BASIC wraps to &80000000. +; +.fnAddInt +mov (sp)+,r1 ; Pop return address +mov (sp)+,r2 ; Get exponent +add (sp)+,r4 ; Add b0-b15 +adc r3 ; Add carry from b0-b15 +add (sp)+,r3 ; Add b16-b31 +tstb r0 ; Check operator token +bpl fnCompareDoneR1 ; b7=0, jump to return result of comparison +tst r2 ; Set flags +jmp (r1) ; Return via r1 + +; Floating point addition +; ----------------------- +; ; stack registers +.fnAddFloat ; + +;tst 2(sp) +;bne fnAddFloat1 ; Value on stack is already a float +jsr pc,SwapStack ; + +.fnAddFloat1 ; + or + from above +jsr pc,EnsureFloat ; + +jsr pc,SwapStackMin ; Get smaller into r2/r3/r4, corrupts r1 +mov r2,r1 ; Test for zero +bis r3,r1 +bis r4,r1 +beq fnAddInt ; Use AddInt to add zero to float and test + +; r2/r3/r4 has smaller value, now denormalise it so exponents are same +; +; eg 82 80 00 00 00 1*2^2 4 (replacing sign with leading '1') +; plus 80 80 00 00 00 1*2^0 1 +; becomes +; 82 80 00 00 00 1*2^2 4 +; 82 20 00 00 00 0.25*2^2 1 plus +; 82 A0 00 00 00 1.25*2^2 5 equals +; +;#ifdef DEBUG +;jsr pc,Debug_DumpStack +;jsr pc,Debug_DumpRegsFlags +;#endif + +.fnAddFloat2 +mov 6(sp),r1 ; Get sign of stacked value +xor r3,r1 ; r1=signs are different +cmp 6(sp),#&8000 ; b31=NOT sign of stacked value, will be sign of result +ror r1 +sub #&8000,r1 ; b31=sign of result, b30=signs are different +bic #&3FFF,r1 ; Clear all except sign flags +bis r1,r0 ; b31=result, b30=subtract, b7=not comparison, b6-b0=operation +jsr pc,fnFloatMantissa ; Put leading '1's into mantissas +;#ifdef DEBUG +;jsr pc,Debug_DumpRegsFlags +;#endif +clr r1 ; r1=0 for underflow +.fnAddFloatLp +cmp r2,2(sp) +bcc fnAddSameExponents ; Both values now have same exponent +clc +ror r3 +ror r4 ; Divide mantissa by two +ror r1 ; Keep underflow +inc r2 ; Increment exponent to multiply by two +br fnAddFloatLp ; Loop to check again +; +.fnAddSameExponents ; Both exponents are now the same +asl r1 ; Add any underflow back into mantissa +adc r4 +adc r3 +; +; r0=.. +; r1= +; r2=updated exponent +; r3=updated mantissa +; r4=updated mantissa +; 2(sp)=stacked exponent +; 4(sp)=stacked mantissa +; 6(sp)=stacked mantissa +; +; if signs are the same, addition +; if signs are different, subtraction, need to two's complement number +; +;#ifdef DEBUG +;jsr pc,Debug_DumpRegsFlags +;#endif + +bit #&4000,r0 +beq fnAddFloatNotNeg ; Signs the same, addition +jsr pc,NegateInteger ; Negate r3/r4 mantissa, preserves r0/r1/r2 +.fnAddFloatNotNeg +;#ifdef DEBUG +;jsr pc,Debug_DumpRegsFlags +;#endif +; +; Add mantissas +; Have swapped so registers always hold smallest absolute value, so +; will never pass through zero, sign of result is sign of largest value +; Cannot underflow, only possible to remain in same exponent range +; (eg 5.xxx (2^2+1.xxx) + 2.xxx (2^2+0.xxx) => 7.xxx (2^2+3.xxx)) +; or overflow to next exponent range +; (eg 7.xxx (2^2+3.xxx) + 7.xxx (2^2+3.xxx) => 15.xxx (2^3+7xxx)) +; Not possible to overflow by two exponents +; (eg 7.999999999+7.99999999 => 15.99999999) +; +mov (sp)+,r1 ; Pop return address +mov (sp)+,r2 ; Pop exponent +add (sp)+,r4 ; Add b0-b15 +adc r3 ; Add carry from b0-b15 +bcc fnAddFloatNoCy ; Did not roll past &FFFFxxxx +add (sp)+,r3 ; Add b6-b31 +sec ; Set Cy again as rolled past &FFFFxxxx +br fnAddFloatCy +.fnAddFloatNoCy +add (sp)+,r3 ; Add b16-b31, Cy may or may not be set +.fnAddFloatCy +; +; Need to work out a test case where (sp) is &FFFF and correct case needs Cy set +;#ifdef DEBUG +;jsr pc,Debug_DumpRegsFlags +;#endif +; +; after ADD after SUB +; xxx- -> ok xxxC -> ok +; xxxC -> overflow xxx- -> passed zero, need to negate and flip sign +; +bit #&4000,r0 +; see fnAddFloatMinus +bne fnAddFloatMinus ; Check result after subtraction +; +mov r1,-(sp) ; Stack return address +bcc fnFloatNormalNoRound ; No overflow, insert sign and check comparison +ror r3 ; Rotate overflow into mantissa and divide by two +ror r4 +;adc r4 ; Add underflow back into mantissa +;adc r3 +inc r2 ; Increment exponent to multiply by two +br fnFloatNormalNoRound ; Insert sign and check comparison +; +.fnAddFloatMinus +;#ifdef DEBUG +;jsr pc,Debug_DumpRegsFlags +;#endif + +; +bcs fnFloatNormalise2 ; Not passed zero, normalise and insert sign +;;tst r0 ;;diff from v0.27 - this causes Circle to build errors +;;bpl fnFloatNormalise2 ;;diff from v0.27 - why was this put in? +jsr pc,NegateInteger ; Negate r3/r4 mantissa, preserves r0/r1/r2 +sub #&8000,r0 ; Toggle sign +br fnFloatNormalise2 ; Normalise and insert sign + + +; Normalise a result +; ------------------ +; r3:r4=mantissa +; r2 =exponent +; r1 =return address +; r0 = +; +.fnFloatNormalise ; Enter here from multiply/divide +bis #&80,r0 ; Set b7='not a compare' +.fnFloatNormalise2 ; Enter here from add/sub to follow with compare +;#ifdef DEBUG +;jsr pc,Debug_DumpRegsFlags +;#endif +mov r1,-(sp) ; Put return address back onto stack +clr r1 +.fnFloatNormaliseDiv ; Enter here from division +.fnFloatNormaliseLp +tst r3 ; Loop until mantissa has '1' in top bit +bmi fnFloatNormalised +clc ; Will already be clear from TST +rol r1 ; Rotate rounding bits into mantissa +rol r4 ; Rotate mantissa left to multiply by two +rol r3 +dec r2 ; Decrement exponent to divide by two +tst r4 +bne fnFloatNormaliseLp +tst r3 +bne fnFloatNormaliseLp +tst r2 +bne fnFloatNormaliseLp ; Keep looping if not normalised to zero +tst r1 +bne fnFloatNormaliseLp ; Keep looping if not normalised to zero +bic #&8000,r0 ; Normalised to zero, ensure sign is +0 +.fnFloatNormalised +bit #&FF00,r2 +beq fnFloatNormalOk ; exponent>+128, not too big +.fnFloatTooBig +jmp errTooBig +.fnFloatNormalOk +;tst r1 ; Check 33rd bit to see if mantissa needs rounding up +;bpl fnFloatNormalNoRound +;add #1,r4 +asl r1 ; Add 33rd bit into mantissa to round up +adc r4 +adc r3 +bcc fnFloatNormalNoRound +ror r3 ; Mantissa rolled over to 00000000, so denormalise back down +ror r4 +inc r2 +clr r1 +br fnFloatNormalised ; Check exponent still in range +.fnFloatNormalNoRound +tst r0 ; Check what sign of result is +bmi fnAddFloat4 ; Sign is negative, leave it negative +bic #&8000,r3 ; Make mantissa positive +.fnAddFloat4 +tstb r0 ; Check operator token +bpl fnCompareDone ; b7=0, jump to return result of comparison +tst r2 ; Set flags from result +rts pc + + +; Convert subtraction and operator token into comparison result +; ------------------------------------------------------------- +; r0 = operator token, 79-7E for <=,<>,>=,<,=,> +; r2/r3/r4 = subtraction result +.fnCompareDoneR1 +mov r1,-(sp) ; Stack return address +.fnCompareDone +bic #&FF00,r0 ; Remove saved flags from r0 +tst r2 ; Set flags for SGN +jsr pc,fnSGN1 ; Convert to -1,0,+1 +.fnCompareDoneR4 +tst r4 +beq fnCmpEQ ; = +bmi fnCmpNeg ; < + ; > +cmp r0,#&79 +beq fnCmpFALSE ; > , test is <= +cmp r0,#&7C +bcs fnCmpTRUE ; > , test is <>, >= +cmp r0,#&7E +beq fnCmpTRUE ; > , test is > +br fnCmpFALSE ; > , test is <, = +.fnCmpNeg +cmp r0,#&7B +bcs fnCmpTRUE ; < , test is <=, <> +cmp r0,#&7C +beq fnCmpTRUE ; < , test is < +br fnCmpFALSE ; < , test is >=, =, > +.fnCmpEQ +bit #1,r0 +bne fnCmpTRUE ; = , test is <=, >=, = + ; = , test is <>, <, > +.fnCmpFALSE +jmp fnFALSE +.fnCmpTRUE +jmp fnTRUE + + +; Prepare floating values for multiply/divide +; ------------------------------------------- +.fnFloatPrepare +mov r2,4(sp) ; Overwrite stacked exponent with result +mov 8(sp),r0 ; r0=mantissa sign +mov r3,r1 ; r1=register sign +xor r0,r1 ; r1=sign of result +.fnFloatMantissa +bis #&8000,r3 ; Insert top bit of LHS mantissa +bis #&8000,8(sp) ; Insert top bit of RHS mantissa +rts pc + + +; Multiplication - * +; ==================================== +; On entry, r2/r3/r4 = RHS value +; sp=>retaddr, r2/r4/r3 = LHS value +.fnMultiply +tst r2 +bne fnMultiplyFloat ; Jump with * + ; We now have * +tst 2(sp) +bne fnMultiplyFloat1 ; Jump with * + +; Integer multiplication - * +; ---------------------------------------------- +; Shame this code can't be merged with MultFloat. It is almost identical. +; +bis r2,r3 +bis r2,r4 +beq fnMultiplyZero ; * 0 -> 0 +#ifdef NOMUL +mov r5,-(sp) ; Save program pointer +mov r4,-(sp) +mov r3,-(sp) ; Save RHS in case of overflow +mov 10(sp),r2 ; r2=b0-b15 of LHS +mov 12(sp),r5 ; r5=b16-b31 of LHS +mov r4,r0 ; r0=b0-b15 of RHS +mov r3,r1 ; r3=b16-b31 of RHS +clr r3 +clr r4 ; Initial total=0 +mov #32,-(sp) ; 32 bits to shift and add +; +.fnMultiplyLp +ror r5 ; Rotate LHS through carry +ror r2 +bcc fnMultNoAdd ; No carry, no add needed +add r0,r4 ; total=total+RHS +adc r3 +add r1,r3 +bmi fnMultiplyOverflow ; Too big for 31-bit integer +.fnMultNoAdd +rol r0 ; Rotate LHS +rol r1 +dec (sp) ; Decrement counter +bne fnMultiplyLp ; Loop for all bits +add #6,sp ; Pop counter and RHS from stack +mov (sp)+,r5 ; Restore line pointer +; +#else +; r3 r4 +; 6(sp) 4(sp) x +; ----------- +; +; aaaa bbbb +; cccc dddd x +; --------- +; ( b * d ) +; ( a * d ) 0 +; ( b * c ) 0 +; ( a * c ) 0 0 + +; ----------------- +; +; r3=aaaa, r4=bbbb +; sp=>retaddr, exp, dddd, cccc + +#ifdef MUL16 +; Fast multiply only of 16-bit integers +; +mov r3,r2 ; r2=aaaa +bis 6(sp),r2 ; aaaa>0 or cccc>0, not 16-bit inputs +bne fnMultiplyBigInts ; Likely to be too big for 32-bit result +mov r4,r0 ; r0=bbbb +bmi fnMultiplyBigInts ; Likely to overflow into bit 31 + ; We now have a maximum of &FFFF*&7FFF = &7FFF8001 +mul 4(sp),r0 ; r0:r1=bbbb * dddd + ; a=0 and c=0, so a*d=0 and b*c=0 + ; So r0:r1 is the result. +bmi fnMultiplyBigInts ; Has become negative, should be positive +mov r1,r4 +mov r0,r3 +; +#else +; +mov r3,r0 +bic 6(sp),r0 ; r0=a AND a +bne fnMultiplyBigInts ; a*c>0, more than 32 bits +mov r3,r0 ; r0=a +mul 4(sp),r0 ; r0:r1=a*d +bcs fnMultiplyBigInts +mov r1,r2 ; r2=a*d +mov r4,r0 ; r0=b +mul 6(sp),r0 ; r0:r1=b*c +bcs fnMultiplyBigInts +add r1,r2 ; r2=(a*d)+(b*c) +bcs fnMultiplyBigInts +mov r4,r0 ; r0=b +mul 4(sp),r0 ; r0:r1=b*d +add r2,r0 +bcs fnMultiplyBigInts +bmi fnMultiplyBigInts +mov r1,r4 +mov r0,r3 +; +#endif +; +#endif +; +.fnMultiplyZero +mov (sp)+,r1 ; Pop return address +add #6,sp ; Pop LHS from stack +clr r2 ; Type=integer +jmp (r1) ; Return via r1 + +; Result won't fit in integer (or is negative), redo as float +; ----------------------------------------------------------- +.fnMultiplyOverflow +#ifdef NOMUL +tst (sp)+ ; Drop counter +mov (sp)+,r3 ; Get saved LHS back into registers +mov (sp)+,r4 +mov (sp)+,r5 ; Restore line pointer +#endif +.fnMultiplyBigInts +;clr r2 ; Set as integer +;jsr pc,EnsureFloat ; Convert registers to float +; ; (we know we are INT, so can speed this up by skipping tests) +jsr pc,IntegerToFloat ; Convert registers to float + ; Continue into float multiply + +; Floating point multiplication +; ----------------------------- +; ; stack registers +.fnMultiplyFloat ; * +jsr pc,SwapStack ; * +.fnMultiplyFloat1 ; * or + from above +jsr pc,EnsureFloat ; * +beq fnMultiplyZero ; 0*num = 0 +jsr pc,SwapStackMin ; Get smaller into r2/r3/r4 +tst r2 +beq fnMultiplyZero ; num*0 = 0 +; +; exp=exp1+exp2 +; man=man1*man2 +; then renormalise +; multiplication done by shifting right and adding +; See Spectrum and CPC disassemblies +; +.fnMultiplyFloat2 +add 2(sp),r2 ; Add exponents +sub #&7F,r2 ; Exponent biased from &80 +; ; Exponent is tested after normalisation as +; ; exponent may get inc/dec'd back into range +; ; by normalisation +jsr pc,fnFloatPrepare ; Stack exponent, get sign of result, add '1' to mantissas +mov r5,-(sp) ; Save program pointer +mov r1,-(sp) ; Save sign of result +mov 8(sp),r2 ; r2=b0-b15 of LHS +mov 10(sp),r5 ; r5=b16-b31 of LHS +mov r4,r0 ; r0=b0-b15 of RHS +mov r3,r1 ; r3=b16-b31 of RHS +clr r3 +clr r4 ; Initial total=0 +mov #32,-(sp) ; 32 bits to add +; +; we now have +; r3:r4=running total, starting at zero +; (sp)=32, number of bits to add/multiply +; r1:r0=RHS mantissa +; r5:r2=LHS mantissa +; sp=>counter, sign, saved r5, retaddr, exponent, r4, r3 = LHS value +; +.fnMultFloatLp +ror r5 ; Rotate top bit out of LHS +ror r2 +bcc fnMultFloatNoAdd ; Bit not set, no add +; +; Does this need the same workaround as AddFloat? +add r0,r4 ; total=total+RHS +adc r3 +bcc fnMultFloatAddNoCy +add r1,r3 ; Any carry carried on into total +sec +br fnMultFloatNoAdd +.fnMultFloatAddNoCy +add r1,r3 ; Any carry carried on into total +; +.fnMultFloatNoAdd +ror r3 ; Rotate total, taking in any carry +ror r4 ; This aligns total with next bit to test +dec (sp) +bne fnMultFloatLp ; Loop for 32 bits +;mov #0,r2 +;ror r2 ; r2=rounding bits +mov #0,r1 +ror r1 ; r1=rounding bits +tst (sp)+ ; Drop counter +br fnDivideFinish + +#ifdef NOMUL +.R2timesR3toR3 +;;; NB! UNIMPLEMENTED - needed for DIM and array lookup +rts pc +#endif + +; Division - / +; ============================== +; On entry, r2/r3/r4 = RHS value +; sp=>retaddr, r2/r4/r3 = LHS value +; +#define USEDIVIDE35 +.fnDivide +jsr pc,EnsureFloat +beq errDivideZero ; RHS=0, num/0 = divide by zero +jsr pc,SwapStack +.fnDivideSwap +jsr pc,EnsureFloat +beq fnMultiplyZero ; LHS=0, 0/num = 0 +; +; r2/r3/r4=LHS value +; sp=> RHS value +; +; to divide, +; exp=expL-expR +; man=manL/manR +; then renormalise +; +sub 2(sp),r2 ; Subtract exponents +add #&81,r2 ; Exponent biased from &80 +; ; Exponent is tested after normalisation as +; ; exponent may get inc/dec'd back into range +; ; by normalisation +jsr pc,fnFloatPrepare ; Stack exponent, get sign of result, add '1' to mantissas +mov r5,-(sp) ; Save program pointer +mov r1,-(sp) ; Save sign of result +; +#ifdef USEDIVIDE35 +mov #35,r5 ; r5=35, number of bits to divide +mov r4,r2 ; r0:r2=running total +mov r3,r0 +; +clr r4 ; Clear rounding bits +;clr r3 ; not needed +;clr r1 ; not needed +; we now have, weird order to optimise register usage +; r0:r2 =running total initialsed from r3:r4 +; r1:r3:r4=result rotated into +; r5 =35 number of bits to sub/divide +; sp=>sign, saved r5, retaddr, exponent, r4, r3 = RHS value +; +br fnDivideStart ; Jump into division loop +.fnDivideFloatLp +rol r4 ; Rotate carry bit into r1:r3:r4 result +rol r3 +rol r1 +asl r2 ; Rotate dividend +rol r0 +bcs fnDivideSubtract +.fnDivideStart +cmp 10(sp),r0 +bcs fnDivideSubtract ; hi(stk) < hi(reg) +bne fnDivideCount ; hi(stk) > hi(reg), with clc +cmp 8(sp),r2 +bcs fnDivideSubtract ; lo(stk) < lo(reg) +bne fnDivideCount ; lo(stk) > lo(reg), with clc +.fnDivideSubtract +sub 8(sp),r2 ; total=total-RHS divisor +sbc r0 +sub 10(sp),r0 +sec ; sec=did a divide +.fnDivideCount +dec r5 +bne fnDivideFloatLp ; Loop for all bits +; +; ; R1 R3 R4 + ; 00000HHH:HHHHHLLL:LLLLLRRR +mov #3,r5 +asr r1 ; 000000HH:H:HHHHHLLL:LLLLLRRR +.fnDivideRound +ror r3 ; 000000HH:HHHHHHLL:L:LLLLLRRR +ror r4 ; 000000HH:HHHHHHLL:LLLLLLRR:R +ror r1 ; R000000H:H:HHHHHHLL:LLLLLLRR +dec r5 +bne fnDivideRound +;ror r3 ; R000000H:HHHHHHHL:L:LLLLLLRR +;ror r4 ; R000000H:HHHHHHHL:LLLLLLLR:R +;ror r1 ; RR000000:H:HHHHHHHL:LLLLLLLR +;ror r3 ; RR000000:HHHHHHHH:L:LLLLLLLR +;ror r4 ; RR000000:HHHHHHHH:LLLLLLLL:R +;ror r1 ; RRR00000:HHHHHHHH:LLLLLLLL:0 +; +#else +; +mov #48,r5 ; r5=48, number of bits to divide +mov r4,r2 ; r0:r2=running total +mov r3,r0 +clr r1 ; Clear rounding bits +;clr r4 ; not needed +;clr r3 ; not needed +; we now have, weird order to optimise register usage +; r0:r2 =running total initialsed from r3:r4 +; r3:r4:r1=result rotated into +; r5 =number of bits to sub/divide +; sp=>sign, saved r5, retaddr, exponent, r4, r3 = RHS value +; +br fnDivideStart ; Jump into division loop +.fnDivideFloatLp +rol r1 ; Rotate carry bit into r3:r4:r1 result +rol r4 +rol r3 +;.fnDivide34 +asl r2 ; Rotate dividend +rol r0 +bcs fnDivideSubtract +.fnDivideStart +cmp 10(sp),r0 +bcs fnDivideSubtract ; hi(stk) < hi(reg) +bne fnDivideCount ; hi(stk) > hi(reg), with clc +cmp 8(sp),r2 +bcs fnDivideSubtract ; lo(stk) < lo(reg) +bne fnDivideCount ; lo(stk) > lo(reg), with clc +.fnDivideSubtract +sub 8(sp),r2 ; total=total-RHS divisor +sbc r0 +sub 10(sp),r0 +sec ; sec=did a divide +.fnDivideCount +dec r5 +bne fnDivideFloatLp ; Loop for all bits +#endif +; +;#ifdef DEBUG +;jsr pc,Debug_DumpRegsHex +;#endif +; +; We now have +; r3:r4:r1=mantissa, r1=rounding bits +; We also need +; r0 = +; r2 =exponent +; r5 =program pointer +; (sp) =return address +; +.fnDivideFinish +mov (sp)+,r0 ; Get sign of result +mov (sp)+,r5 ; Restore program pointer +mov (sp)+,r2 ; r2=return address +mov r2,4(sp) ; Store further up stack + ; r1=rounding bits +mov (sp)+,r2 ; r2=exponent of result +tst (sp)+ ; Drop part of RHS from stack +bis #&80,r0 ; Set +jmp fnFloatNormaliseDiv; Jump to normalise and insert sign bit + +.errDivideZero +jsr pc,Error +equb 18,"Division by zero",0 +align + +; Integer division - DIV +; Integer modulus - MOD +; ======================================== +; On entry, r2/r3/r4 = RHS value +; sp=>retaddr, r2/r4/r3 = LHS value +; r0=tknDIV or tknMOD +; sign of DIV result is LHS xor RHS +; sign of MOD result is LHS +; +.fnDIV +.fnMOD +jsr pc,EnsureInteger ; Ensure RHS is integer +mov r4,r1 +bis r3,r1 +beq errDivideZero ; RHS=0 (slightly faster) +cmpb r0,#tknMOD +beq fnDIV2a ; If MOD, result sign ignores RHS sign +mov r3,r1 ; r0=sign +bic #&7FFF,r1 ; Keep just sign bit +xor r1,r0 ; r0= +.fnDIV2a +jsr pc,fnABSint ; Ensure positive +mov r0,r2 ; Store token in 'exp' register +jsr pc,SwapStack ; Get LHS into registers +jsr pc,EnsureInteger ; Ensure LHS is integer +mov r4,r1 +bis r3,r1 +bne fnDIV3 ; LHS<>0 +jmp fnMultiplyZero ; LHS=0, 0/num = 0 +.fnDIV3 +mov r3,r1 ; r0=sign +bic #&7FFF,r1 ; Keep just sign bit +xor r1,2(sp) ; exp= +jsr pc,fnABSint ; Ensure positive + +; sp=>retaddr, sign:tkn, r4, r3 RHS +; 6(sp):4(sp)= RHS Z80 D +; r0:r1 = remainder Z80 A +; r2=32 = bit counter Z80 B +; r3:r4 = LHS and result Z80 C +; ; Zaks, C=C DIV D, A=C MOD D +mov #32,r2 ; LD B,8 - bit counter +clr r1 ; XOR A - remainder +clr r0 +.fnDIVlp +clc +rol r4 ; SLA C - rotate a bit out of LHS +rol r3 +rol r1 ; RLA - rotate the bit into remainder +rol r0 +cmp r0,6(sp) ; CP D b16-b31 +beq fnDIVagain +bcs fnDIVnoAdd +bcc fnDIVAdd +.fnDIVagain +cmp r1,4(sp) ; CP D b0-b15 +bcs fnDIVnoAdd ; JR C,noadd +.fnDIVAdd +add #1,r4 ; INC C +adc r3 +sub 4(sp),r1 ; SUB D +sbc r0 +sub 6(sp),r0 +.fnDIVnoAdd +dec r2 ; DJNZ loop - loop for each bit +bne fnDIVlp +mov 2(sp),r2 ; Get DIV/MOD token +bic #&8000,r2 +cmpb r2,#tknDIV +beq fnDIVsign ; DIV, use DIV result +mov r1,r4 ; MOD, get MOD result +mov r0,r3 +.fnDIVsign +mov 2(sp),r2 ; Get DIV/MOD token +bpl fnDIVdone +jsr pc,NegateInteger +.fnDIVdone +mov (sp)+,r1 ; Pop return address +add #6,sp ; Drop RHS from stack +clr r2 ; Type=integer +jmp (r1) ; Return via r1 + + +; Numeric functions +; ~~~~~~~~~~~~~~~~~ + +.fnVAL +jsr pc,EvalStrValCR +.fnVAL1 +mov r5,-(sp) ; Save program pointer +mov r4,r5 ; Point to string +jsr pc,EvalDecimalVAL +mov (sp)+,r5 ; Restore program pointer +tst r2 ; Set flags +rts pc + +.fnEVAL +jsr pc,EvalStrValCR ; Evaluate string and copy to string buffer with terminator +mov r5,-(sp) ; Save program pointer +mov r4,r5 ; r5=>source string +adr SV_STRING,r4 ; r4=>destination in string buffer +;jsr pc,TokeniseStrip ; Tokenise the string +jsr pc,TokeniseEVAL ; Tokenise the string +; R4=>start of tokenised line +; R3= length of tokenised line excluding +inc r3 ; Add to length of string +mov #&8000,r2 ; r2= type=string +jsr pc,StackStringAndOp ; Copy string to stack to evaluate it there +mov sp,r5 +add #4,r5 ; r5=>stacked string +jsr pc,Evaluate ; Call full evaluator +mov r3,r1 ; Move result to protect from DropString +mov r2,r0 +jsr pc,UnstackDropStringOp ; Drop string from stack +mov (sp)+,r5 ; Restore program pointer +mov r1,r3 +mov r0,r2 ; Get result back, setting flags +rts pc + +.fnSGN +jsr pc,EvalNumVal +.fnSGN1 +bne fnSGN2 ; Jump if float +tst r3 +bne fnSGN2 ; Integer<>&00xx, test sign +tst r4 +beq fnFALSE ; Integer=0, jump to return 0 +.fnSGN2 +tst r3 ; b15=integer b31 or float sign bit +bmi fnTRUE ; <0 - return -1 +mov #1,r4 ; >0 - return 1 +br fn16bit + + +; Simple power to integer exponent +; -------------------------------- +; Only does positive powers +; lhs^neg treated as lhs^verybig, will give Too big +; +.fnPower +jsr pc,EnsureInteger ; exp ret, num +clr r3 +tst r4 +bne fnPower1 ; exp>0 +mov #1,r4 ; num^0 = 1 +br fnPowerDone1 +.fnPower1 +jsr pc,SwapStack ; num ret, exp +mov r3,-(sp) +mov r4,-(sp) +mov r2,-(sp) ; num num, ret, exp +.fnPowerLp +dec 10(sp) ; num num, ret, exp-1 +beq fnPowerDone +mov 4(sp),-(sp) +mov 4(sp),-(sp) +mov 4(sp),-(sp) ; num num, num, ret, exp-1 +jsr pc,fnMultiply ; num^2 num, ret, exp-1 +br fnPowerLp +.fnPowerDone ; num^e num, ret, 0 +add #6,sp ; Drop num +.fnPowerDone1 +mov (sp)+,r1 ; r1=return address +add #6,sp ; Drop exp +tst r2 ; Set flags +jmp (r1) ; Return via r1 + + +; Simple 32-bit integer square root +; --------------------------------- +; SQR(<0) returns zero +.fnSQR +jsr pc,EvalIntVal +mov #-1,r2 ; Initial root will be 0*2+1 after adding 1 to it +.fnSQRlp +inc r2 ; Step to next root, next odd number is 2*r2+1 +sub r2,r4 ; r3:r4=r3:r4-r2 +sbc r3 +sub r2,r4 ; r3:r4=r3:r4-(2*r2) +sbc r3 +sub #1,r4 ; r3:r4=r3:r4-(2*r2+1) +sbc r3 +bpl fnSQRlp ; Loop to subtract next odd number +mov r2,r4 ; Move result into b0-b15 +br fn16bit ; Return 16-bit integer + + +; Program environment functions +; ============================= +.fnLineNum +movb (r5)+,r0 +asl r0 +asl r0 +mov r0,r3 +bic #&3F,r3 +movb (r5)+,r1 +xor r1,r3 +asl r0 +asl r0 +bic #&3F,r0 +movb (r5)+,r4 +xor r0,r4 +swab r4 +bic #&FF00,r3 +bic #&00FF,r4 +bis r3,r4 +clr r3 +clr r2 +rts pc + +.fnPAGE +mov SV_PAGE,r4 +br fn16bit + +.fnTO +cmpb (r5)+,#ASC"P" +beq fnTOP +.jmpNoSuchVar2 +jmp errNoSuchVar +.fnTOP +mov SV_TOP,r4 +br fn16bit + +.fnLOMEM +mov SV_LOMEM,r4 +br fn16bit + +.fnEND +mov SV_VAREND,r4 +br fn16bit + +.fnHIMEM +mov SV_HIMEM,r4 +br fn16bit + +.fnERL +mov SV_ERL,r4 +br fn16bit + +.fnERR +movb SV_ERR,r4 +br fn8bit + +.fnCOUNT +movb SV_COUNT,r4 +.fn8bit +bic #&FF00,r4 +br fn16bit + +#ifndef NOEXTRAFN + .fnWIDTH + movb SV_WIDTH,r4 + br fn8bit + + .fnQUIT + cmpb (r5)+,#tknQUIT + bne jmpNoSuchVar2 + tstb SV_SYS + bmi fnTRUE +#endif + +.fnFALSE +clr r4 +.fn16bit +clr r3 +clr r2 ; Set type=integer and set flags +rts pc + +; These are here to be near their branch destinations +; --------------------------------------------------- +.fnASC +jsr pc,EvalStrVal +movb (r4),r4 ; Get first byte +tst r3 ; Null string? +bne fn8bit ; Return character + +.fnTRUE +mov #&FFFF,r4 +mov r4,r3 +clr r2 +rts pc + +.fnLEN +jsr pc,EvalStrVal +mov r3,r4 ; Move length to value +br fn16bit + + +; Logical/bitwise operations +; ========================== +.fnOR +mov (sp)+,r1 ; Pop return address +tst (sp)+ ; Drop exponent +bis (sp)+,r4 +bis (sp)+,r3 +tst r2 +jmp (r1) ; Return via r1 + +.fnEOR +mov (sp)+,r1 ; Pop return address +tst (sp)+ ; Drop exponent +xor r4,(sp) +mov (sp)+,r4 +xor r3,(sp) +mov (sp)+,r3 +tst r2 +jmp (r1) ; Return via r1 + +.fnAND +mov (sp)+,r1 ; Pop return address +tst (sp)+ ; Drop exponent +com (sp) +bic (sp)+,r4 +com (sp) +bic (sp)+,r3 +tst r2 +jmp (r1) ; Return via r1 + +.fnNOT +jsr pc,EvalIntVal +com r4 +com r3 +tst r2 ; Set flags +rts pc + + +; Random Number functions +; ======================= +; =RND - return random integer 0..FFFFFFFF +; =RND(<0) - initialise seed, return n +; =RND(0) - return last RND(1) value +; =RND(1) - random real 0..1 +; =RND(>1) - random integer 1..n +; +.fnRND +cmpb (r5),#ASC"(" +beq fnRNDnum ; Jump to do RND(n) + ; Drop through with R2=0 to return integer +; +; =RND - update seed, return seed as type in R2 +; --------------------------------------------- +.fnRNDupdate +mov #&20,r3 +.fnRNDlp +movb SV_RAND+2,r0 +asrb r0 +asrb r0 +asrb r0 +movb SV_RAND+4,r1 +xor r1,r0 +rorb r0 +rol SV_RAND+0 +rol SV_RAND+2 +rolb SV_RAND+4 +dec r3 +bne fnRNDlp +; +; Return current seed, type in R2 +; ------------------------------- +.fnRNDreturn +mov SV_RAND+0,r4 +mov SV_RAND+2,r3 +tst r2 +beq fnRNDdone +bic #&8000,r3 ; Force to be positive +mov r3,-(sp) +mov r4,-(sp) +mov r2,-(sp) ; Stack result +jsr pc,fnTRUE ; Prepare to subtract 1 +mov r3,r0 ; R0.b7=1 to indicate 'not compare' +jsr pc,fnSubtract ; Change result from 1..2 to 0..1 +rts pc +; +; =RND(n) +; ------- +.fnRNDnum +;jsr pc,EvalInteger1 ; Step past bracket, evaluate integer +;jsr pc,CheckClose +jsr pc,EvalBracket1 ; Evaluate expression inside brackets +mov r3,r0 +bmi fnRNDminus ; RND(<0) - set seed +mov #&80,r2 ; Prepare for real return value between 1 and 2 +bis r4,r0 +beq fnRNDreturn ; RND(0) - return current seed as a real +tst r3 +bne fnRNDplus ; RND(>65535), do RND(>1) +cmp r4,#1 +beq fnRNDupdate ; RND(1) - jump to update seed and return as real +; +; =RND(>1) - update seed, use as real, multiply by n, return n as 32-bit int +; -------------------------------------------------------------------------- +.fnRNDplus +mov r3,-(sp) +mov r4,-(sp) +clr -(sp) ; stack n as an integer +jsr pc,fnRNDupdate ; Get next seed as a real, R2 set to &7F earlier +jsr pc,fnMultiply ; Multiply real seed by stacked integer +jsr pc,EnsureInteger +inc r4 ; Increment result to give 1..n +bne fnRNDdone +inc r3 +br fnRNDdone +; +; =RND(<0) - set seed, return n +; ----------------------------- +.fnRNDminus +mov r4,SV_RAND+0 +mov r3,SV_RAND+2 +clr SV_RAND+4 +.fnRNDdone +clr r2 ; R2=INTEGER, set flags +rts pc + + +; Calling machine code +; ==================== +.cmdCALL +jsr pc,EvalInteger +cmpb r0,#ASC"," +bne fnUSRgo ; CALL addr +; +; CALL addr,parameters +mov r4,r2 ; r2=call address +clr r1 ; Zero number of parameters +.cmdCALLlp +inc r1 ; Inc. number of parameters +mov r1,-(sp) ; Stack number of parameters +mov r2,-(sp) ; Stack call address +;inc r5 ; Step past comma +;jsr pc,SkipSpaceThis ; Step past any spaces +jsr pc,FetchNextChar +jsr pc,VarFindCreate ; Find address of parameter, create if nonexistant +;bcs errSyntax ; Not a valid variable - done in VarFindCreate +mov (sp)+,r2 ; Get call address off stack +mov (sp)+,r1 ; Get number of parameters off stack +mov r4,-(sp) ; Stack parameter address +mov r3,-(sp) ; Stack parameter type/size +movb (r5),r0 ; Get next character +cmpb r0,#ASC"," +beq cmdCALLlp ; Loop back if another parameter present +mov r1,-(sp) ; Stack number of parameters +mov r5,-(sp) ; Save program pointer +; +; r2=call address, sp=>num, type,addr, type,addr, etc. +mov r2,r4 ; r4=call address +;;mov SV_VARS+4,r0 ; r0=A% +;;jsr pc,CallCodeRaw ; Set up registers, call code +jsr pc,CallCode +;br cmdCallDone +;equw SV_VARS ; (sp) points to list of useful addresses +;equw 0 +;.cmdCallDone +mov (sp)+,r5 ; Restore program pointer +mov (sp)+,r0 ; Get number of parameters off stack +add r0,r0 +add r0,r0 ; 4 bytes per parameter +add r0,sp ; Drop parameters from stack +rts pc ; Return +; +.fnUSR +jsr pc,EvalIntVal +.fnUSRgo +mov r5,-(sp) ; Save program pointer +jsr pc,CallCode ; Call address at R4 +mov (sp)+,r5 ; Restore program pointer +mov r0,r4 ; Move result to accumulator +mov r1,r3 +clr r2 ; Result is an integer +rts pc + +.CallCode +mov SV_VARS+4,r0 ; r0=A% +;;tst r3 +;;bne CallCodeRaw ; dest>&FFFF +cmp r4,#&FFC0 +bcc CallCodeMOS ; dest>&FF00, dest<&10000 +.CallCodeRaw +mov r4,-(sp) ; Stack destination address +mov SV_VARS+8,r1 ; r1=B% +mov SV_VARS+12,r2 ; r2=C% +mov SV_VARS+16,r3 ; r3=D% +mov SV_VARS+20,r4 ; r4=E% +mov SV_VARS+24,r5 ; r5=F% +rts pc ; Jump to destination + +.CallCodeMOS +jsr pc,CallMOS +; r0->b0-b7 +; r1->b8-b15 +; r2->b16-b23 +; Cy->b24 +bic #&FF00,r2 ; R2 result Carry unchanged +bcc CallCodeMOS2 ; *CHECK* Does BIC clear carry? +bis #&0100,r2 ; R2.b8=Carry +.CallCodeMOS2 +swab r1 ; Carry cleared +bic #&00FF,r1 ; R1 b15-b8=result R1 b7-b0 +bic #&FF00,r0 ; R0 b7-b0=result R0 b7-b0 +bis r1,r0 ; b15-b8=result from R1, b7-b0=result from R0 +mov r2,r1 ; b23-b16=result from R2, b24=Carry +rts pc + +.CallMOS +mov SV_VARS+96,r1 ; r1=X% +mov SV_VARS+100,r2 ; r2=Y% +mov r2,r5 ; r5=Y% for OSARGS +cmp r1,#256 +bcc CallMOS2 ; X%>255, use as is +swab r2 +bis r2,r1 ; r1=X%+256*Y% +swab r2 +.CallMOS2 +sub #&FFCE,r4 ; R4=offset from MOS jump block +add r4,r4 ; Double offset to 2 bytes per address, 6 bytes per entry +adr MOSJumpBlock,r3 ; Point to MOS jump block +add r3,r4 ; Point to emulated entry point +jmp (r4) ; Jump to entry point + +; addr-&CE *2 space +; FFCE 0 0 6 OSFIND +; FFD1 3 6 6 OSGBPB +; FFD4 6 12 6 OSBPUT +; FFD7 9 18 6 OSBGET +; FFDA 12 24 6 OSARGS +; FFDD 15 30 6 OSFILE +; FFE0 18 36 6 OSRDCH +; FFE3 21 42 6 OSASCI +; FFE7 25 50 6 OSNEWL +; FFEC 30 60 4 OSWRCR +; FFEE 32 64 6 OSWRCH +; FFF1 35 70 6 OSWORD +; FFF4 38 76 6 OSBYTE +; FFF7 41 82 . OSCLI + +.MOSJumpBlock +JMP IO_FIND ; CE CF - r0=A%, r1=X%+256*Y%=>string +rts pc ; D0 +JMP IO_GBPB ; D1 D2 - r0=A%, r1=X%+256*Y%=>block +rts pc ; D3 +MOV R2,R1 ; D4 - r1=Y%=handle +JMP IO_BPUT ; D5 D6 - r0=A%, r1=Y%=handle +MOV R2,R1 ; D7 - r1=Y%=handle +JMP IO_BGET ; D8 D9 - r0=A%, r1=Y%=handle + ; DA - r0=A%, r1=X%, r2=Y%, r5=Y% +MOV R1,R2 ; DA - r0=A%, r1=X%, r2=X% +MOV R5,R1 ; DB - r0=A%, r1=Y%, r2=X% +br _ffda ; DC +JMP IO_FILE ; DD DE - r0=A%, r1=X%+256*Y%=>block +rts pc ; DF +JMP IO_RDCH ; E0 E1 - entry values ignored +rts pc ; E2 +JMP IO_ASCI ; E3 E4 - r0=A% +rts pc ; E5 +rts pc ; E6 +JMP IO_NEWL ; E7 E8 - entry values ignored +rts pc ; E9 +._ffda ; Squeeze in here +JMP IO_ARGS ; EA EB - r0=A%, r1=Y%, r2=X% +JMP IO_WRCR ; EC ED - entry values ignored +JMP IO_WRCH ; EE EF - r0=A% +rts pc ; F0 +JMP IO_WORD ; F1 F2 - r0=A%, r1=X%+256*Y%=>block +rts pc ; F3 +JMP IO_BYTE ; F4 F5 - r0=A%, r1=X%, r2=Y% +rts pc ; F6 +MOV R1,R0 ; F7 - r0=X%+256*Y%=>string +JMP IO_CLI ; F8 F9 - r0=>string + +;._ffda +;MOV SV_VARS+100,R1 +;JMP IO_ARGS ; r0=A%, r1=Y%, r2=X% + diff --git a/src/GeneralIO b/src/GeneralIO new file mode 100644 index 0000000..a6eb8c2 --- /dev/null +++ b/src/GeneralIO @@ -0,0 +1,81 @@ +; > GeneralIO +; General I/O routines +; 31-Aug-2015 v0.21a: cmdREPORT moved here to drop into PrintR1. +; 04-Jul-2018 v0.27: IO_ReadLine uses stack for control block. + + +; Print inline text +; ================= +; Corrupts r0,r1 +; +.PrintInline ; Print inline text +mov (sp)+,r1 ; Get return address to r1 +jsr pc,PrintR1 ; Print text at r1, corrupts r0,r2 +inc r1 ; increment return address +bic #1,r1 ; clear bit zero +mov r1,pc ; jump to return address + +; REPORT - Display current error message +; ====================================== +.cmdREPORT +jsr pc,IO_NEWL ; Print newline +mov SV_FAULT,r1 ; Get current error block +inc r1 ; Step past error number +; ; Continue to print via token expansion + +; Print text at R1 +; ================ +; On entry, R1=>zero-terminated string +; +.PrintR1 ; Print text pointed to by R1, term. by &00 +movb (r1)+,r0 ; Get byte from r1, inc r1 +beq PrintR1End ; Exit if final byte +jsr pc,PrintR0Token ; Print expandable character +br PrintR1 ; Loop back + +; Print character, checking COUNT and WIDTH +; ========================================= +; Preserves all registers, returns r0=13 if automatic NEWLINE output +; +.PrintAscii +jsr pc,IO_ASCI ; Output character +br PrintR0Check +.PrintR0 +jsr pc,IO_WRCH ; Output character +.PrintR0Check +cmp r0,#13 +beq PrintR0Clear ; If , clear COUNT +cmp r0,#32 +bcs PrintR0Ret ; Control codes, ignore count +incb SV_COUNT ; Increment COUNT +tstb SV_WIDTH ; Check WIDTH +beq PrintR0Ret ; WIDTH=0, ignore +cmpb SV_WIDTH,SV_COUNT ; Has COUNT reached WIDTH? +bne PrintR0Ret ; No, exit +jsr pc,IO_NEWL ; Print newline +.PrintR0Clear +clrb SV_COUNT ; Set COUNT to zero +.PrintR0Ret +.PrintR1End +rts pc + +; Read line of text +; ================= +; On entry, R1=>memory to read string to +; On exit, R2=length of string +; Other regs preserved +; If Escape state, Escape error generated +; +.IO_ReadLine +mov #&00FF,-(sp) ; Highest character, padding +mov #&20FF,-(sp) ; Max line length, lowest character +mov r1,-(sp) ; Address of text buffer +mov sp,r1 ; R1=>control block +clr r0 +jsr pc,IO_WORD ; OSWORD 0 - read a line of text +bcc IO_ReadLineOk +jmp errEscape +.IO_ReadLineOk +add #6,sp ; Drop control block from stack +br PrintR0Clear ; Zero COUNT, and clear Carry flag + diff --git a/src/Interface b/src/Interface new file mode 100644 index 0000000..e8de1da --- /dev/null +++ b/src/Interface @@ -0,0 +1,873 @@ +; > Interface +; Interface to host system +; IO commands/functions/queries/etc + +; Done, tested: +; CLS, CLG, COLOUR, MODE, =MODE, =POS, =VPOS, OSCLI, DRAW, MOVE, PLOT, GCOL, VDU +; =POINT, =VDU, TIME=, TIME$=, =TIME, =TIME$, SOUND ON|OFF, =TIME$ checks for null return +; GET$#chn, BPUT#chn,s$, GCOL c, COLOUR l,[p|r,g,b], PLOT x,y, SOUND, ENVELOPE, LOAD s$,n +; 09-Mar-2009 LoadProgram can load and tokenise text file +; 24-Jun-2010 SAVE name$,start,end[,exec[,load]] +; 02-Jul-2010 QUIT [retval] +; 16-Aug-2013 TextLoad calls LineTokeniser and LineInsert +; 07-Dec-2013 SAVE saves with inline filename +; 16-Aug-2015 v0.20a VDU(n) returns 8-bit value +; 26-Aug-2015 v0.20b Optimised some common OSBYTE-calling code +; 14-Jul-2017 Optimised TextLoad with modified Tokeniser API +; 04-Jul-2018 v0.27 Optimised various I/O calls by using token in R0 +; Merged a lot of common code in OSBYTE calls and some OSWRCH calls +; 15-Apr-2020 Optimised POINT by using stack for control block +; 18-Mar-2024 LOAD/SAVE checks for end-of-statement if immediate command, tweeked +; textload and FindTOP. + + +; On entry to command subroutines, +; r5=>character after command token, no spaces skipped +; r0=(token-&C6)*2 +; r1=dispatch address +; +; On entry to function subroutines, +; r5=>character after function token, no spaces skipped +; r0=function token +; r1=dispatch address +; +; On exit from function subroutines, +; r4=b0-b15 or string start +; r3=b16-b31 or string length +; r2=type with flags set + + +; VDU Commands +; ============ + +; CLS - Clear Text Window +; ======================= +.cmdCLS +clrb SV_COUNT +mov #36,r0 ; R0=12+24 + +; CLG - Clear graphics window +; =========================== +.cmdCLG +sub #24,r0 ; R0=16 or 12 +jmp IO_WRCH + +; DRAW x,y - Send DRAW command, entered with R0=&32 +; MOVE x,y - Send MOVE command, entered with R0=&4C +; ================================================= +.cmdDRAW +mov #5,r0 ; DRAW is PLOT 5 +.cmdMOVE +bic #&FFF8,r0 ; MOVE is PLOT 4 +mov r0,-(sp) +jsr pc,EvalInteger +mov r4,-(sp) ; Save X coord +br cmdPLOTetc + +; PLOT [k,]x,y - Send PLOT command +; ================================ +.cmdPLOT +mov #69,-(sp) ; PLOT is PLOT 69 +jsr pc,EvalInteger +mov r4,-(sp) ; Save X coord or PLOT command +jsr pc,EvalComma ; Get Y coord or X coord +jsr pc,CheckEndStatement +beq cmdPLOTxy ; Jump to do PLOT 69,x,y +mov (sp),2(sp) ; Move first param to command +mov r4,(sp) ; Save second param as X coord +.cmdPLOTetc +jsr pc,EvalComma ; Get Y coord +.cmdPLOTxy +mov #25,r0 +jsr pc,IO_WRCH ; PLOT +mov (sp)+,r3 ; R3=X coord +mov (sp)+,r0 ; R0=command +jsr pc,IO_WRCH ; k +mov r3,r0 +jsr pc,WrchWord ; X low byte, high byte +mov r4,r0 ; Y low byte, high byte +.WrchWord +jsr pc,IO_WRCH ; low byte +swab r0 +jmp IO_WRCH ; high byte + +; MODE m - Set screen mode +; ======================== +.cmdMODE +jsr pc,EvalInteger +clrb SV_COUNT +mov #22,r3 +br WrchR3R4 + +; GCOL [a,]c - Set graphics colour +; ================================ +.cmdGCOL +clr -(sp) ; Prepare for GCOL c +jsr pc,EvalInteger +jsr pc,CheckEndStatement +beq cmdGCOL2 +mov r4,(sp) ; Overwrite action on stack +jsr pc,EvalComma +.cmdGCOL2 +mov (sp)+,r3 ; r3=action, r4=colour +mov #18,r0 +jsr pc,IO_WRCH +.WrchR3R4 +mov r3,r0 +jsr pc,IO_WRCH +.WrchR4 +mov r4,r0 +jmp IO_WRCH + +; COLOUR l[,p|,r,g,b] - Set text or palette colour +; ================================================= +.cmdCOLOUR +jsr pc,EvalInteger +mov #17,r3 +jsr pc,CheckEndStatement +beq WrchR3R4 ; Jump with COLOUR l +mov r4,-(sp) ; Save logical colour +jsr pc,EvalComma ; Get p or r +mov r4,r1 ; R1=P +clr r2 ; R2=R=0 +clr r3 ; R3=G=0 +clr r4 ; R4=B=0 +jsr pc,CheckEndStatement +beq cmdCOLOURrgb ; Jump to do COLOUR l,p with VDU 19,l,p,0,0,0 +mov r1,-(sp) ; Save R, SP=>R,L +jsr pc,EvalComma +mov r4,-(sp) ; Save G, SP=>G,R,L +jsr pc,EvalComma ; R4=B, SP=>G,R,L +mov (sp)+,r3 ; R3=G +mov (sp)+,r2 ; R2=R +mov #16,r1 ; R1=P=16 for screen colour +tst (sp) ; Test logical colour +bpl cmdCOLOURrgb ; L>=0 - set screen colour +mov #24,r1 ; R1=P=24 for border colour +; +.cmdCOLOURrgb +; (sp)=LOGICAL, R1=PHYSICAL, R2=RED, R3=GREEN, R4=BLUE +mov (sp)+,r0 ; Get logical colour +swab r0 ; Move to top byte +bic #&00FF,r0 +bis #&0013,r0 ; Make bottom byte=19 +jsr pc,WrchWord ; VDU 19,L +mov r1,r0 +jsr pc,IO_WRCH ; VDU 19,L,P +mov r2,r0 +jsr pc,IO_WRCH ; VDU 19,L,P,R +br WrchR3R4 ; VDU 19,L,P,R,G,B + +; VDU n[,|;[n]] - Send to VDU stream +; ================================== +.cmdVDUsemi +mov r4,r0 +swab r0 +jsr pc,IO_WRCH ; Send top byte +.cmdVDU +jsr pc,CheckEndStatement +beq cmdVDUexit ; End of statement, exit +jsr pc,EvalInteger +jsr pc,WrchR4 ; Send low byte to output +;jsr pc,SkipSpaceThis ; Next +;inc r5 ; Step past comma, semi or bar +jsr pc,SkipSpaceNext +cmp r0,#ASC"," +beq cmdVDU ; Loop back if comma +cmp r0,#&3B ; Semicolon +beq cmdVDUsemi ; Loop back to send high byte for semi +mov #9,r1 ; Prepare to send 9 zeros +cmp r0,#ASC"|" +beq cmdOFFzero ; Jump to send zeros if bar +dec r5 ; Point back to current character +.cmdVDUexit +rts pc + +; OFF - turn cursor off +; ON - turn cursor on +; ===================== +; OFF entered with R0=&7E +.cmdONvdu +mov #1,r0 ; ON is VDU 23,1,1,... +.cmdOFF +bic #-2,r0 ; OFF is VDU 23,1,0,... +mov r0,r4 +;mov r0,r1 +mov #&0117,r0 +jsr pc,WrchWord ; VDU 23,1 +;mov r1,r0 +;jsr pc,IO_WRCH ; Send ON/OFF byte +jsr pc,WrchR4 ; Send ON/OFF byte +mov #7,r1 ; Finish VDU sequence with 7 NULLs +.cmdOFFzero +clr r0 +.cmdOFFlp +jsr pc,IO_WRCH +dec r1 +bne cmdOFFlp +rts pc + + +; Character Input Functions +; ========================= + +; =POINT(x,y) - read colour at point +; ================================== +.fnPOINT +jsr pc,EvalInteger ; Get X parameter +mov #-1,-(sp) ; Stack default result +mov r4,-(sp) ; Put X on the stack +jsr pc,EvalComma ; Step past ',', get Y parameter +jsr pc,CheckClose ; Step past ')' +mov (sp),-(sp) ; Copy X lower down on stack +mov r4,2(sp) ; Put Y on stack +mov sp,r1 ; r1=>control block on stack +mov #9,r0 +jsr pc,IO_WORD ; OSWORD 9 - call POINT routine +cmp (sp)+,(sp)+ ; Drop X and Y from stack +mov (sp)+,r4 ; Get pixel value from stack +br fnReturnExtendR4 ; Return value, extending &xx80+x to &FFFFFF80+x + +; =GET$[#chn] - wait for character from input or string from channel +; ================================================================== +; Also =GET$(x,y) - read char from screen +.fnGETs +CMPB (R5),#ASC"#" +BNE fnGETrdch +JSR PC,EvalHashVal ; Get channel number +MOV R4,R1 ; R1=channel +ADR SV_STRING,R4 ; Point to string buffer +CLR R3 ; String length=0 +.fnGETlp +JSR PC,IO_BGET +BCS fnGETend ; End of file +CMP R0,#10 +BEQ fnGETend ; LF - end of line +CMP R0,#13 +BEQ fnGETend ; CR - end of line +MOVB R0,(R4)+ ; Store in string buffer +INC R3 +CMP R3,#255 +BCS fnGETlp ; Loop for up to 255 characters +.fnGETend +ADR SV_STRING,R4 ; R4=string start, R3=length +MOV #&8000,R2 ; R2=string +RTS PC + +.fnGETrdch +JSR PC,IO_RDCH ; Wait for key +MOV #1,R3 ; R3=string length +.fnReadChar +ADR SV_STRING,R4 ; R4=>string buffer +MOV R0,(R4) ; Put character into buffer +MOV #&8000,R2 ; R2=string type +RTS PC + +; =INKEY$ time - wait specified time for character +; ================================================ +.fnINKEYs +JSR PC,fnINKEY ; call INKEY routine +MOV R4,R0 ; Move result to R0 +INC R3 ; Change -1/0 to 0/1 +BR fnReadChar ; Jump to store 0 or 1 characters + +; =INKEY time - wait specified time for character +; =============================================== +.fnINKEY +mov #&81,r0 +jsr pc,CallOsbyte16 ; Make OSBYTE call +tst r4 +.fnReturnExtend +sxt r3 ; Sign extend into r3 +clr r2 ; Type=Integer +rts pc + +; =MODE - read current screen mode +; ================================ +.fnMODE +jsr pc,fnMODEcall +.fnReturnExtendR4 +movb r4,r4 +br fnReturnExtend + +; =ADVAL device - read device status +; ================================== +.fnADVAL +mov #&80,r0 ; R0=ADVAL +; +.CallOsbyte16 +mov r0,-(sp) ; Save OSBYTE function +jsr pc,EvalIntVal ; Evaluate parameter +mov r4,r1 ; R1= of parameter +mov r4,r2 +swab r2 ; R2= of parameter +bic #&FF00,r2 ; R2=<00000> of parameter +mov (sp)+,r0 ; Get OSBYTE function back +jsr pc,IO_BYTE ; Make the OSBYTE call, returns: +; ; R1= of result +; ; R2= of result +mov r1,r4 ; Get b0-b15 from R1 +br fnReturnR4 ; Return 16-bit result + +; =VDU n - read VDU variable +; ========================== +.fnVDU +mov #&A0,r0 +jsr pc,CallOsbyte16 ; Returns flags from R4 +br fnReturn8bitR1 ; Reduce to 8-bit result + +; =POS - read horizontal cursor position +; ====================================== +.fnPOS +jsr pc,fnVPOS ; Read POS and VPOS +.fnReturn8bitR1 +mov r1,r0 +br fnReturn8bitR0 + +; =VPOS - read vertical cursor position +; ===================================== +.fnVPOS +mov #&86+&64,r0 ; R0=&86 for =VPOS +.fnMODEcall +sub #&64,r0 ; R0=&87 for =MODE +clr r1 ; Prepare R1=0 for default, R2 already 0 +jsr pc,IO_BYTE +mov r2,r0 +br fnReturn8bitR0 + +; =GET - wait for character from input +; ==================================== +; Also =GET(port), =GET(x,y) - read char from screen +.fnGET +JSR pc,IO_RDCH ; Wait for key +.fnReturn8bitR0 +bic #&FF00,r0 +.fnReturnR0 +mov r0,r4 ; R4=returned result from R0 +.fnReturnR4 +clr r3 ; R3=b16-b31=0 +clr r2 ; R2=integer type +rts pc + + +; Time Commands and Functions +; =========================== + +; TIME=val, TIME$=s$ - set TIME or TIME$ +; ====================================== +.cmdTIME +cmpb (r5),#ASC"$" ; Check for '$' +beq cmdTIMEs ; TIME$ +; +jsr pc,EvalEqual ; Step past '=', get integer +clr -(sp) ; Use control block on stack +mov r3,-(sp) ; Stack value to write +mov r4,-(sp) +mov sp,r1 ; R1=>control block +mov #2,r0 ; R0=2 - write TIME +jsr pc,IO_WORD +add #6,sp ; Drop control block +rts pc +; +.cmdTIMEs +inc r5 ; Step past '$' +jsr pc,CheckEqual ; Check for '=' +jsr pc,EvalString ; Get string +jsr pc,EvalStoreCRString ; Copy to string buffer +dec r4 ; R4=>byte before the string +dec r3 ; R3=string length minus +movb r3,(r4) ; Store string length +mov r4,r1 ; R4=>control block +mov #15,r0 ; TIME$ is OSWORD 15 +jmp IO_WORD ; Set TIME$ + +; =TIME, =TIME$ - read TIME or TIME$ +; ================================== +.fnTIME +cmpb (r5),#ASC"$" +beq fnTIMEs ; =TIME$ +; +sub #6,sp ; Use control block on stack +mov sp,r1 ; R1=>control block +mov #1,r0 ; R0=1 - read TIME +jsr pc,IO_WORD +br fnReturnArgs ; Pop from stack and return +; +.fnTIMEs +inc r5 ; Step past '$' +adr SV_STRING,r1 ; Point to control block +clr (r1) ; Read time as string +mov #14,r0 +jsr pc,IO_WORD ; Read TIME$ +adr SV_STRING,r4 ; Start=SV_STRING +mov (r4),r3 ; Check returned string +beq fnTIMEnull ; Still zero, nothing returned +mov #24,r3 ; Length=24 +.fnTIMEnull +mov #&8000,r2 ; Type=String +rts pc + + +; File Functions +; ============== + +; =EOF#chn - read end-of-file status +; ================================== +.fnEOF +jsr pc,EvalHashVal ; Step past '#', get handle +mov r4,r1 +mov #127,r0 ; OSBYTE 127,channel to read EOF +jsr pc,IO_BYTE +clr r4 ; Prepare R4=0 +cmp #1,r1 ; If R1=0, Cy=0 if R1>0, Cy=1 +sbc r4 ; R4=0-0=0 R4=0-1=FFFF +br fnReturnExtend ; Return 32-bit sign extended value + +; =BGET#chn - read byte from channel +; ================================== +.fnBGET +jsr pc,EvalHashVal ; Step past '#', get integer handle +mov r4,r1 ; R1=handle +jsr pc,IO_BGET ; Call MOS to read on this channel +br fnReturn8bitR0 + +; OSCLI - Execute command +; ======================= +#ifdef NOEXTRAFN + .cmdOSCLI + jsr pc,EvalStringCR + mov r4,r0 + jmp IO_CLI +#else + .cmdOSCLI + jsr pc,EvalStringCR + br fnOSCLI2 + .fnOSCLI + jsr pc,EvalStrValCR + .fnOSCLI2 + mov r4,r0 + jsr pc,IO_CLI + br fnReturnR0 +#endif + +; =OPEN(IN|OUT|UP) f$ - open file +; =============================== +; On entry, R0=AD - OPENUP +; R0=AE - OPENOUT +; R0=8E - OPENIN +.fnOPENUP +mov #&CE,r0 +.fnOPENIN +.fnOPENOUT +asl r0 ; R0=11C,15C,19C +sub #&DC,r0 ; R0=40,80,C0 +mov r0,-(sp) ; Save OPEN function +jsr pc,EvalStrValCR ; Get cr-string +mov r4,r1 ; r1=>filename +mov (sp)+,r0 ; r0=function +jsr pc,IO_FIND +br fnReturnR0 + +; Open file information +; ===================== + +; =PTR#chn - Read file pointer +; =EXT#chn - read file extent +; PTR#chn=val - Set file pointer +; EXT#chn=val - Set file extent +; ============================= +; On entry, R0=8F - =PTR +; R0=12 - PTR= +; R0=A2 - =EXT +; R0=86 - EXT= +.cmdPTR +clr r0 ; Becomes R0=1 for =PTR +.cmdEXT +.fnPTR +inc r0 ; Becomes R0=7 for EXT=, R0=0 for =PTR +.fnEXT +bic #&FFFC,r0 ; Reduce to OSARGS action 0-3 +mov r0,-(sp) ; Save OSARGS action +jsr pc,EvalHashVal ; Step past '#', get integer handle +mov (sp),r0 ; Get OSARGS action +mov r4,-(sp) ; Save handle +asr r0 ; Check bit 0 of action, read/write +bcc callARGS2 ; b0=0, read function +jsr pc,EvalEqual ; Step past '=', get integer +.callARGS2 +mov (sp)+,r1 ; R1=handle +mov (sp),r0 ; R0=function, leave on stack as padding +mov r3,-(sp) ; sp=>data word +mov r4,-(sp) +mov sp,r2 ; R2=>data word +jsr pc,IO_ARGS ; Make the OSARGS call +.fnReturnArgs +mov (sp)+,r4 ; R3/R3=returned data word +mov (sp)+,r3 +tst (sp)+ ; Drop padding/byte 5 +clr r2 ; R2=integer +.cmdBPUTend +rts pc + + +; File Commands +; ============= + +; CLOSE#chn - Close channel +; ========================= +.cmdCLOSE +jsr pc,EvalHashVal ; Step past '#', get integer +mov r4,r1 ; Pass handle to R1 +clr r0 +jmp IO_FIND + +; BPUT#chn,[byte|string(;)] - Write byte or string to channel +; =========================================================== +.cmdBPUT +jsr pc,EvalHashVal ; Step past '#', get integer handle +mov r4,-(sp) ; Save handle +jsr pc,CheckComma ; Step past ',' +jsr pc,Evaluate ; Get data to send +bmi cmdBPUTs ; Send string +jsr pc,EnsureInteger ; Convert float +mov (sp)+,r1 ; Get handle to R1 +mov r4,r0 ; Move byte to R0 +jmp IO_BPUT ; Call MOS to write byte + +.cmdBPUTs +mov (sp)+,r1 ; Get handle to R1 +tst r3 +beq cmdBPUTzero ; Zero-length string +.cmdBPUTlp +movb (r4)+,r0 +jsr pc,IO_BPUT ; Send character +dec r3 +bne cmdBPUTlp ; Loop until all sent +.cmdBPUTzero +;jsr pc,SkipSpaceThis ; Next +;inc r5 ; Step past ';' +jsr pc,SkipSpaceNext +cmp r0,#&3B ; Terminating ';'? +beq cmdBPUTend ; Don't output end-of-line +dec r5 ; No ';', step back again +mov #10,r0 +jmp IO_BPUT ; Write line-feed terminator + +; QUIT [num] - Quit interpreter +; ============================= +.cmdQUIT +clr r4 ; Prepare to use zero as return value +inc r5 ; Step past double token +jsr pc,CheckEndStatement +;jsr pc,FetchNextChar ; Step past second token byte +;jsr pc,CheckEndToken +beq cmdQUIT2 ; End of statement, use zero +jsr pc,EvalInteger ; Get return value +.cmdQUIT2 +mov r4,r0 ; Pass to R0 +jmp IO_QUIT + +; LOAD str$[,addr] - Load program/data +; ==================================== +; Fetch CR-string parameter +; Call LoadProgram (finding TOP) +; Jump to Immediate mode +.cmdLOAD +cmpb (r5),#tknQUIT +beq cmdQUIT ; C898 - QUIT +; cmpb r0,#tknSYS +; beq cmdSYS ; C899 - SYS +jsr pc,EvalStringCR ; Get filename to R4 +#ifdef FILEEXTN + jsr pc,SkipSpaceNext + cmp r0,#ASC"," + beq cmdLoadData + dec r5 +#endif +jsr pc,EnsureEndStatement +jsr pc,LoadProgram ; Load program, check TOP +jmp ImmediateClear ; Clear heap, drop to immediate mode + +#ifdef FILEEXTN + ; LOAD str$,addr - load data + ; -------------------------- + .cmdLoadData + jsr pc,StackStringAndOp + jsr pc,EvalInteger + mov r4,FILE_LOAD+0 + mov r3,FILE_LOAD+2 + jsr pc,UnstackStringDropOp + br LoadData +#endif + +; Load program named at R4 to memory at R1 +; ---------------------------------------- +.LoadProgFile +mov r1,FILE_LOAD+0 ; Address to load to +mov #&82,r0 +jsr pc,IO_BYTE +mov r1,FILE_LOAD+2 ; High word of address + +; Load data named at R4 to address in FILE_LOAD +; --------------------------------------------- +.LoadData +mov #255,r0 ; r0=&FF - LOAD +clr FILE_EXEC ; Load to specified address +.FileData +mov r4,FILE_NAME ; Point to filename +adr FILE_NAME,r1 ; r1=>control block +jmp IO_FILE ; Perform file action + +; Load program named at R4 +; ------------------------ +.LoadProgram +mov SV_PAGE,r1 +jsr pc,LoadProgFile +mov SV_PAGE,r1 +;movb (r1),r0 +;cmpb r0,#13 +cmpb (r1),#13 +beq FindTopLp ; Starts with , assume 6502 BASIC +; Should also check for Z80/8086 BASIC +; +; Check for loaded text and tokenise +; ---------------------------------- +; Need to reload higher up in memory to prevent overwriting itself +mov r4,FILE_NAME ; Don't rely on being preserved +mov #5,r0 +adr FILE_NAME,r1 +jsr pc,IO_FILE ; Get file length, can't depend on return from OSFILE_LOAD +mov FILE_LENGTH,r0 ; If OSFILE 5 not implemented, will use length left by initial LOAD +; Load text file to PAGE+256 +mov SV_PAGE,r1 +add #256,r1 +; +; Load text file to SP-length-256 +;mov sp,r1 +;sub r0,r1 ; r1=stack-length +;sub #256,r1 ; r1=stack-length-256 +;bic #1,r1 ; Ensure even address +; +mov r0,-(sp) ; Save length +mov r1,-(sp) ; Save start +jsr pc,LoadProgFile ; Load program file +mov (sp)+,r5 ; Point to start of loaded text source +mov (sp)+,r0 ; Get length +mov SV_PAGE,-(sp) ; Stack start of dest +add r5,r0 ; Point to end of loaded data +clrb (r0) ; Put zero terminator after loaded text +clr SV_LINE ; Start at line zero before incrementing +mov (r5),r0 ; Get first two characters +cmp r0,#ASC"#"+256*ASC"!" ; Program starts with #! +bne LoadText +.LoadTextSkip +movb (r5)+,r0 ; Skip past first line +cmp r0,#32 +bcc LoadTextSkip +.LoadText +add #10,SV_LINE ; Step to next line number +.LoadTextNext +; r5=>source +; (sp)=>dest +tstb (r5) ; r5=>source text +beq LoadTextEnd ; End of source text +jsr pc,TokeniseLine +; +; R5=>after end of untokenised line +; R4=>start of tokenised line +; R3= length of tokenised line excluding +; R2= linenum +; +tst r3 ; Check tokenised line length +beq LoadTextNext ; Zero-length line, skip to next +add #4,r3 ; r3=BASIC line length +mov (sp)+,r1 ; r1=>insertion point +movb #13,(r1)+ ; Insert +mov r5,-(sp) +mov r4,r5 ; R5=tokenised source +mov r2,r4 ; R4=linenum +jsr pc,InsertLine ; Insert the tokenised line +mov (sp)+,r5 +dec r1 ; Point dest to +mov r1,-(sp) ; Restack dest for next line +br LoadText ; Loop for another line +.LoadTextEnd +mov (sp)+,r1 ; Get insertion point back +movb #13,(r1)+ ; Put final in +movb #&FF,(r1) ; Put terminator in place +; +; Check program consistancy, set TOP, return R1=TOP, R0=corrupted +; --------------------------------------------------------------- +.FindTOP +mov SV_PAGE,r1 ; Start at PAGE +.FindTopLp +mov r1,r0 ; r0=>start of this line +cmpb (r1)+,#13 +bne BadProgram +cmpb (r1)+,#&FF +beq FindTopFound +inc r1 ; Step past line number +movb (r1),r1 ; Get length byte +bic #&FF00,r1 ; Ensure 8-bit value +cmp r1,#4 +bcs BadProgram ; If len<4, invalid +add r0,r1 ; Point to next CR +br FindTopLp ; Loop to check next line +;bcc FindTopLp ; Loop if not past end of memory +.BadProgram +jsr pc,PrintInline +equs "Bad program",13,0 +align +jmp ImmediateClearStop +.FindTopFound +mov r1,SV_TOP ; r1=>byte after end of program +rts pc + +; SAVE str$[,start,end[,exec[,load]] - Save program/data +; ====================================================== +.cmdSAVE +jsr pc,CheckEndStatement +bne cmdSAVE1 ; Not SAVE +mov r5,-(sp) ; Save LPTR +mov SV_PAGE,r5 +inc r5 +cmpb (r5)+,#&FF +bcc cmdSAVE0 ; Null program +inc r5 +jsr pc,FetchNextChar +cmpb r0,#tknREM +bne cmdSAVE0 ; First line not REM +jsr pc,FetchNextChar +cmpb r0,#ASC">" +bne cmdSAVE0 ; First line not REM > +inc r5 +mov r5,r4 ; Point to inline filename +mov (sp)+,r5 ; Restore LPTR +br cmdSAVEprog ; Save program +.cmdSAVE0 +mov (sp)+,r5 ; Restore LPTR +.cmdSAVE1 +jsr pc,EvalStringCR ; Get filename to R4 +#ifdef FILEEXTN + jsr pc,SkipSpaceNext + cmp r0,#ASC"," + beq cmdSaveData + dec r5 +#endif +jsr pc,EnsureEndStatement +.cmdSAVEprog +mov SV_PAGE,FILE_START+0 +mov SV_TOP,FILE_END+0 +mov #&82,r0 +jsr pc,IO_BYTE +mov r1,FILE_START+2 ; High word of address +mov r1,FILE_END+2 +mov #&FB00,FILE_LOAD+0 +mov #&FFFF,FILE_LOAD+2 +clr FILE_EXEC+0 +clr FILE_EXEC+2 +clr r0 +jsr pc,FileData ; Perform OSFILE with R0=action, R4=>filename +jmp ImmediateLoop + +#ifdef FILEEXTN + ; SAVE str$,start,end[,exec[,load]] - save data + ; --------------------------------------------- + .cmdSaveData + jsr pc,StackStringAndOp +; inc r5 ; Step past comma + jsr pc,EvalInteger + mov r3,-(sp) + mov r4,-(sp) ; Save start + jsr pc,EvalComma + mov r3,-(sp) + mov r4,-(sp) ; Save end + cmp r0,#ASC"," + bne cmdSave2 ; SAVE str$,start,end + inc r5 + jsr pc,EvalInteger + mov r3,-(sp) + mov r4,-(sp) ; Save exec + cmp r0,#ASC"," + bne cmdSave3 ; SAVE str$,start,end,exec + inc r5 + jsr pc,EvalInteger + br cmdSave4 + .cmdSave2 ; sp=>end, start + mov 6(sp),-(sp) ; sp=>start.hi, end, start + mov 6(sp),-(sp) ; sp=>start, end, start + .cmdSave3 ; sp=>exec, end, start + mov 8(sp),r4 + mov 10(sp),r3 ; r3/r4=load, sp=>exec, end, start + .cmdSave4 ; r3/r4=load, sp=>exec, end, start + mov r4,FILE_LOAD+0 + mov r3,FILE_LOAD+2 + mov (sp)+,FILE_EXEC+0 + mov (sp)+,FILE_EXEC+2 + mov (sp)+,FILE_END+0 + mov (sp)+,FILE_END+2 + mov (sp)+,FILE_START+0 + mov (sp)+,FILE_START+2 + jsr pc,UnstackStringDropOp + clr r0 ; OSFILE 0 - Save + jmp FileData ; Save data and return +#endif + + +; SOUND commands +; ============== + +; ENVELOPE a,b,c,d,e,f,g,h,i,j,k,l,m,n +; ==================================== +.cmdENVELOPE +jsr pc,EvalInteger ; Get first parameter +adr MOS_BUF,r1 +movb r4,(r1)+ +mov #13,-(sp) ; Stack remaining number of parameters +mov r1,-(sp) ; Stack pointer to paramter block +.cmdENVlp +jsr pc,EvalComma +mov (sp),r1 ; Get pointer to parameter block +movb r4,(r1)+ ; Store parameter +mov r1,(sp) ; Save updated pointer +dec 2(sp) ; Decrement number of remaining parameters +bne cmdENVlp +mov #8,r0 ; R0=8 for ENVELOPE +br cmdSOUNDdo + +; SOUND [ON|OFF|c,a,p,d] - Issue SOUND command +; ============================================ +.cmdSOUND +;jsr pc,SkipSpaceThis ; could be Next, swap inc for dec +jsr pc,SkipSpaceNext +clr r1 ; SOUND ON is *FX210,0 +cmpb r0,#tknON +beq cmdSOUNDon ; Jump to do SOUND ON +dec r1 ; SOUND OFF is *FX210,255 +cmpb r0,#tknOFF +bne cmdSOUND2 ; Not SOUND OFF, jump past +.cmdSOUNDon +;inc r5 ; Step past ON/OFF +mov #210,r0 +clr r2 +jmp IO_BYTE +.cmdSOUND2 ; SOUND c,a,p,d +dec r5 +jsr pc,EvalInteger ; Get first parameter +adr MOS_BUF,r1 +mov r4,(r1)+ +mov #3,-(sp) ; Stack remaining number of parameters +mov r1,-(sp) ; Stack pointer to parameter block +.cmdSOUNDlp +jsr pc,EvalComma ; If this evaluation calls something that uses MOS_BUF, +mov (sp),r1 ; MOS_BUF will get overwritten +mov r4,(r1)+ ; Store in parameter block +mov r1,(sp) ; Save updated pointer +dec 2(sp) ; Decrement number of remaining parameters +bne cmdSOUNDlp +mov #7,r0 ; R0=7 for SOUND +.cmdSOUNDdo +cmp (sp)+,(sp)+ ; Drop pointer and count from stack +adr MOS_BUF,r1 +jmp IO_WORD + diff --git a/src/MakeMain b/src/MakeMain new file mode 100644 index 0000000..731d25d --- /dev/null +++ b/src/MakeMain @@ -0,0 +1,27 @@ +; > MakeMain +; BBC BASIC for the PDP11 +; (C)J.G.Harston 1988-2022 + +; Global "insert" file +; +; Version ; Version information +; Header ; Host-specific header +#include "Startup" ; Program header, startup, immediate mode, etc. +#include "TokenEqus" ; Token values +#include "Tokens" ; Token table, errors, tokeniser, detokeniser +#include "GeneralIO" +#include "Execute" ; Program execution dispatch loop +#include "Commands" ; BASIC program commands +#include "Assembler" +#include "Evaluate" ; Expression evaluator +#include "Stack" ; BASIC stack manipulation +#include "Functions" ; BASIC program functions +#include "TrigLog" +#include "Variables" +#include "Interface" +#ifdef DEBUG +#include +#endif +; HostIO ; Host-specific I/O +; SysVars ; Workspace + diff --git a/src/MakeRT11 b/src/MakeRT11 new file mode 100644 index 0000000..39e97c4 --- /dev/null +++ b/src/MakeRT11 @@ -0,0 +1,15 @@ +; > MakeRT11 +; BBC BASIC for the PDP11 running RT11 +; (C)J.G.Harston 1988-2024 + +OSNAME$: EQU "RT11" ; Target platform +KBDEMT: EQU 224 ; KBD read with EMT 224 +#define NODIV ; Don't use DIV instruction +#include "Version" ; Version settings +#include "RT11Hdr" ; RT11 host header +#include "MakeMain" ; Main BASIC code +#include "CommonIO" ; Common non-Tube I/O interface code +#include "AnsiKBD" ; ANSI keyboard parsing +#include "RT11IO" ; Interface to RT11 host I/O system +#include "SysVars" ; System variables and data buffers + diff --git a/src/MakeTube b/src/MakeTube new file mode 100644 index 0000000..9d760de --- /dev/null +++ b/src/MakeTube @@ -0,0 +1,10 @@ +; > MakeTube +; BBC BASIC ROM for the PDP-11 Tube CoPro +; (C)J.G.Harston 1988-2020 + +#define NODIV ; Don't use DIV instruction +#include "Version" ; Version settings +#include "ROMHdr" ; ROM header +#include "MakeMain" ; Main BASIC code +#include "TubeIO" ; Interface to host I/O system +#include "SysVars" ; System variables and data buffers diff --git a/src/MakeUnix b/src/MakeUnix new file mode 100644 index 0000000..402c54a --- /dev/null +++ b/src/MakeUnix @@ -0,0 +1,18 @@ +; > MakeUnix +; PDP11 BBC BASIC on Unix +; (C)J.G.Harston 1988-2023 + +OSNAME$: EQU "Unix" +#define NODIV ; Don't use DIV instruction +#ifdef BSD211 + OSNAME$: EQU "BSD2.11" + #define APISTK ; API calls use stack (not inline) + #define NOEMT ; Remove all EMT calls +#endif +#include "Version" ; Version settings +#include "MakeMain" ; Main BASIC code +#include "CommonIO" ; Common non-Tube I/O interface code +#include "AnsiKBD" ; ANSI keyboard parsing +#include "UnixIO" ; Interface to Unix host I/O system +#include "SysVars" ; System variables and data buffers + diff --git a/src/ROMHdr b/src/ROMHdr new file mode 100644 index 0000000..ff4608c --- /dev/null +++ b/src/ROMHdr @@ -0,0 +1,61 @@ +; > ROMHdr +; -------- +; 18-Jan-2001 v0.01 Service code matches *help and *command with ROM title. +; *Help prints ROM title and whole version string. +; 15-Aug-2005 v0.02 *Help prints ROM title and version number only. +; 28-Nov-2008 v0.03 *Help optimised slightly. +; 15-Aug-2015 v0.04 Simple non-matched *Help, claims *BASIC command. +; 03-Oct-2015 v0.05 Watches for Tube being set up to disable other ROMs if +; not for this CPU and claim *BASIC, checks for Master +; giving 'Not a language' on Reset. +; 17-Oct-2015 v0.06 Checks the CPU on the other side of the Tube. +; 23-Aug-2025 v0.07 Check Electron Tube and ROM table. + +ORG &8000 +.HeaderStart +BR HeaderEnter ; Allows entry at first byte +EQUB 0 +EQUB &4C ; 6502 RTS for service entry +EQUW HeaderService +EQUB &E0+TUBECPU ; Service+Language+Tube+PDP11 +EQUB HeaderCopyright-HeaderStart +EQUB 4 ; Compatible with 6502 BASIC IV +EQUS "PDP11 BASIC",0 ; ROM title +EQUB ((VERSION >> 8) AND 15)+48 ; Version string +EQUS "." +EQUB ((VERSION >> 4) AND 15)+48 +EQUB (VERSION AND 15)+48 +#ifdef DEBUG +EQUS " (DEBUG ",YEAR$,")" ; Version date +#else +EQUS " (",DATE$,")" ; Version date +#endif +.HeaderCopyright +EQUB 0,"(C)J.G.Harston",0 ; Copyright message +EQUD &0000B000 ; Tube transfer address +EQUD HeaderCode-HeaderStart ; Offset to Tube execution address +ALIGN +.HeaderEnter +BR HeaderCode ; Allows entry at first byte +; +.TUBECPU EQU &07 +.TUBEMATCH EQU &77 +.HeaderService +EQUB &48,&C9,&01,&F0,&31,&C9,&11,&F0,&68,&C9,&27,&F0,&64,&C9,&06,&F0 +EQUB &40,&C9,&09,&D0,&3A,&B1,&F2,&C9,&0D,&D0,&34,&20,&E7,&FF,&A2,&00 +EQUB &BD,&09,&80,&D0,&02,&A9,&20,&C9,&28,&F0,&06,&20,&EE,&FF,&E8,&D0 +EQUB &EF,&20,&E7,&FF,&68,&60,&AD,&7A,&02,&30,&14,&98,&48,&A6,&F4,&2C +EQUB &B3,&FF,&30,&01,&E8,&BD,&A0,&02,&29,&BF,&9D,&A0,&02,&68,&A8,&68 +EQUB &60,&A6,&F0,&BD,&02,&01,&4A,&B0,&F6,&A0,&00,&B1,&FD,&D0,&F0,&71 +EQUB &FD,&C8,&C0,&17,&D0,&F9,&C9,&EA,&D0,&E5,&A6,&F4,&A9,&8E,&4C,&F4 +EQUB &FF,&AD,&03,&02,&D0,&D9,&98,&48,&A9,&FF,&20,&06,&04,&90,&F9,&A9 +EQUB &00,&48,&48,&A9,&F8,&48,&BA,&A0,&01,&A9,&00,&48,&20,&06,&04,&68 +EQUB &68,&68,&68,&A2,&07,&CA,&D0,&FD,&AE,&E5,&FE,&2C,&B3,&FF,&10,&03 +EQUB &AE,&E5,&FC,&A9,&BF,&20,&06,&04,&E0,TUBEMATCH,&D0,&91,&A0,&0F +EQUB &A2,&0F,&2C,&B3,&FF,&30,&01,&E8,&BD,&A0,&02,&29,&4F,&C9,&40+TUBECPU +EQUB &F0,&08,&BD,&A0,&02,&29,&BF,&9D,&A0,&02,&CA,&88,&10,&EB,&A4,&F4 +EQUB &AE,&8C,&02,&30,&0F,&2C,&B3,&FF,&30,&01,&E8,&BD,&A0,&02,&29,&4F +EQUB &C9,&47,&F0,&03,&8C,&8C,&02,&8C,&4B,&02,&68,&A8,&68,&60 +ALIGN +; +.HeaderCode diff --git a/src/RT11Hdr b/src/RT11Hdr new file mode 100644 index 0000000..7937c1b --- /dev/null +++ b/src/RT11Hdr @@ -0,0 +1,76 @@ +; > RT11Hdr +; RT11 header for BBC BASIC for the PDP-11 +; (C)J.G.Harston 2014-2023 + +; 01-Jan-2014 v0.19: Initial version. +; 29-Jul-2023 v0.40: Magic values replaced with EQUs. + + +; Machine test values +; ------------------- +.UKNCADDR equ &013E ; Are we running on UKNC? +;.UKNCOK equ &00E0 ; =&00E0 -> UKNC +.UKNCOK equ -1 ; TST NEQ -> UKNC +.VT52ADDR equ &0070 ; Are we using a VT52? +.VT52OK equ &0100 ; <&100 -> VT52 +.KBDCRLF equ 1 ; Keyboard always followed by + +ORG 0 +; The header overlaps the RT11 header, which is overwitten later +.word 0 ; 000000 VIR in Radix-50 +.word 0 ; 000002 Virtual high limit +.word 0 ; 000004 Job definition word ($JSX) +.word 0 ; 000006 Reserved +.word 0 ; 000010 Reserved +.word 0 ; 000012 Reserved +.word 0 ; 000014 BPT trap PC +.word 0 ; 000016 BPT trap PSW +.word 0 ; 000020 IOT trap PC +.word 0 ; 000022 IOT trap PSW +.word 0 ; 000024 Reserved +.word 0 ; 000026 Reserved +.word 0 ; 000030 Reserved +.word 0 ; 000032 Overlay definition word +.word 0 ; 000034 Trap vector PC (TRAP) +.word 0 ; 000036 Trap vector PSW (TRAP) + +; RT-11 startup info at &0020 (&o0040) +; ------------------------------------ +.word RtCode ; 000040 - RT-11 entry point +.word RtStackTop ; 000042 - RT-11 top of stack +.word (2^6)+(2^12)+(2^14) ; 000044 - Job Status Word: NOWAIT+NOECHO+NOUPPER +.word 0 ; 000046 - USR swap address +.word RtCode+BasicEnd ; 000050 - Loader sets to Initial program high memory limit +.word 0 ; 000052 - Reserved +.word 0 ; 000054 - Reserved +.word 0 ; 000056 - Reserved + +; Normally ignored by RT-11 +; ------------------------- +.word 0 ; 000060 - Reserved +.word 0 ; 000062 - Reserved +.word 0 ; 000064 - Overlay handler address +.word 0 ; 000066 - Window definition blocks +.blkb 240-$ ; 000070 + ; to - Reserved + ; 000356 + +; RT-11 code bitmap +; ----------------- +.byte %11111111 ; First 4K used +.byte %11111111 ; Second 4K used +.byte %11111111 ; Third 4K used +.byte %11111111 ; Fourth 4K used +.byte %11111111 ; Fifth 4K used +.blkb 256-$ ; Pad to end of bitmap + +; RT-11 initial stack space +; ------------------------- +.align &200 ; Pad to end of RT-11 header +.RtStackTop ; RT-11 usually has stack here + +; &o1000 : RT-11 loads code from here onwards into memory at &o1000 +; ----------------------------------------------------------------- +RtCode: +STARTADDR: ; Main code at this fixed address + diff --git a/src/RT11IO b/src/RT11IO new file mode 100644 index 0000000..be637db --- /dev/null +++ b/src/RT11IO @@ -0,0 +1,1564 @@ +; > RT11IO +; Interface to RT11 host system +; ------------------------------ +; Interfaces to any host that implements RT11 EMTs, such as RSTS and UKNC + +; To do: BGET, BPUT, PTR, EXT, EOF +; To do: trap Ctrl-C, Ctrl-P, Ctrl-Q, Ctrl-S. +; Found basic docs on UKNC graphics control. +; Graphics will need work-arounds for UKNC, maybe fork into seperate graphics version. +; BUG: *. still sometimes bombs out on UKNC when followed by LOAD/CHAIN. - seems not +; to be a problem now that memory area is aligned. + +; 01-Jan-2014 Initial RT11 host interface. +; 25-May-2020 OPENIN works. +; 27-May-2020 LOAD works calling OPENIN. +; 29-May-2020 OPENOUT works, SAVE works calling OPENOUT. +; 31-May-2020 ANSI VDU driver, UNKC VDU driver. +; To do: work out command line passing, QUIT passes line back to monitor. +; Note: [B (down) doesn't work after terminal has scrolled. Maybe keep track of +; last char and do raw LF if CR/LF or LF/CR sequence. +; 20-Jun-2020 Added *ESC (ON|OFF), merged ANSI and UKNC VDU driver code. +; 22-Jun-2020 RT11 and UKNC extended key handler working, initial INKEY() code. +; 30-Jun-2020 Optimised extended keypress reading. +; 12-Jul-2020 Added delay to TTYtest to cope with telnet delays. +; 12-Sep-2021 Added Escape ticker, fast TTYIN check for Escape testing. +; 28-Dec-2021 UKNC uses faster colour setting, MODE implemented. +; GETKEY swallows after , faster Escape check, tweeked GETtty. +; Tweeks to VDU 127,8,9,10,11. +; 31-Dec-2021 Cursor control select appropriate VT52 or VT100 control sequences. +; Avoids sending colours to VT52. Tweeking Escape polling. +; 05-Jan-2022 RT11 doesn't lose characters, sent via vduraw, tweeked Escape. +; 19-Jan-2022 UKNC reads 8-bit chars from CONIN. +; 28-Sep-2022 UKNC should be able to read POS/VPOS/MODE from VDU system, but can't +; work out how to, so in interim fakes via local variables. +; 01-Aug-2023 Optimised IO_RDCH, IO_WRCH entries, rewrote TTYIN routines. +; 02-Aug-2023 ANSI keyboard processing seperated out into seperate module. +; 15-Sep-2023 Munged VDU10 and VDU 11 to work on various terminals. +; 01-Mar-2024 shell() calls a command via EXIT and and returns, so *. works. +; NB: Odd dependencies in ShellCont - take care with modifying. +; Tweeked tests for VT52/UKNC for RT11v5.7 on UKNC. If started with +; drv:BASIC looks for BASIC on current drive. +; 18-Mar-2024 Padding to made data space multiple of 512 bytes for shell(). +; 27-Mar-2024 Optimise IO_xxx entries, all errors generate errors. + + +; Console Input settings +; ---------------------- +; May be delays between incoming characters so need to pause after +; receiving to tell apart and . +.KBD_TICK equ 000 ; Foreground Escape key ticker +;.KBD_DELAY equ 180 ; Delay loop to confirm after +;.KBD_DELAY equ 1 ; Delay loop to confirm after +.KBD_DELAY equ 180 ; Delay loop to confirm after +; Testing with puTTY needs at least 160 + +; SV_SYS flag settings +; -------------------- +.FLG_BIT3 equ &08 +.FLG_BIT2 equ &04 +.FLG_BIT1 equ &02 +.FLG_BIT0 equ &01 + +; Initialise Host I/O system +; ========================== +; On entry, &14A=command line, terminated with 0 +; r5=&0BBC for BBC environment or <>&0BBC otherwise +; not UKNC UKNC +; r0=&41A2 r0=&41A4 +; r1=&0044 r1=&005D +; r2=&0200 stack top r2=&0200 stack top +; r3=&8600 r3=&9200 +; r4=&BBA4 r4=&AFA4 +; r5=&B764 top of available memory r5=&CB12 +; r6=&01FE initial stack r6=&01FE initial stack +; +; On exit, r0=bottom of memory +; r1=top of memory +; +.IO_Init +clr SV_SYS ; No embedded code +mov #&014A,r1 ; R1=>parameter buffer +adr SV_STRING,r2 ; R2=>string buffer +.IO_InitLp1 +movb (r1)+,(r2)+ ; Copy characters +bne IO_InitLp1 ; Loop until &00 byte +movb #13,-1(r2) ; Store terminating +; +mov #8,r0 +mov #RT_HANDLES,r1 +.IO_InitLp2 +clr (r1)+ ; Clear all handles +dec r0 +bne IO_InitLp2 +clr vduQ ; Clear VDU and KBD queues +clr RT_POSVPOS +;mov #79+256*24,RT_WIDTH ; Display is 80x25 characters +mov #79+256*23,RT_WIDTH ; Display is 80x24 characters +#if UKNCOK<0 + tst @#UKNCADDR ; Look inside host's workspace + beq IO_Init3 ; EQ=not UKNC +#else + cmp @#UKNCADDR,#UKNCOK ; Look inside host's workspace + bne IO_Init3 ; NE=not UKNC +#endif +;decb RT_HEIGHT ; Set UKNC screen size +mov #UKNkeys,r0 ; Initialise function keys +emt &E9 +.IO_Init3 +#if KBD_TICK=0 + clrb SV_TICKER ; Reset Escape ticker +#else + movb #KBD_TICK,SV_TICKER; Reset Escape ticker +#endif +clr -(sp) +mov sp,-(sp) +mov #&o35*256+0,-(sp) +mov sp,r0 +emt &o375 ; Disable Ctrl-C +add #6,sp +mov #4*256+0,r0 ; SERR +emt &o374 ; Soft errors + +; Return memory limits +; -------------------- +mov #&FFFE,r0 ; Maximum possible value +emt &o354 ; SETTOP - Request memory up to &FFFE +mov r0,r1 ; r1=top of memory +bic #&00FF,r1 ; Round down to &xx00 for space for shell() +adr DefaultPAGE,r0 ; r0=bottom of memory +mov r1,SV_MEMTOP +mov r0,SV_MEMBOT +cmp SV_STRING,#ASC"$"+256*ASC"." +beq ShellCont ; Special return from shell() +rts pc + + +; IO entry points +; =============== +.IO_CLI EQU IO_OSCLI ; Execute command + +; OSQUIT - Quit execution +; ======================= +; On entry, R0=exit status +; +.IO_QUIT0 +.IO_QUIT ; RT11 requires R0=0 +CLR R0 ; Quit with status=0 +bisb #&o10,&o53 ; Signal 'failure/hard exit' - don't execute any command +;bisb #&o01,&o53 ; Signal 'success' - looks for command to execute +;clr &o510 +emt &o350 ; EXIT, NB RT11 requires R0=0 +rts pc ; In case returns + + +; Command doesn't match or */name, pass to shell() +; ------------------------------------------------ +; r0=>start of command name +; sp=>saved R1 +.IO_CLIslash +.IO_Shell +cmpb (r0),#ASC"." +bne CLIerrorR1 ; Not *. so bomb out +;bne Shell1 ; Not *. so skip +adr ShellCat,r0 ; r0=>"dir/vol/exc %.%" +.Shell1 +mov r5,-(sp) ; Save LPTR +mov sp,SV_SYSPTR ; Stack to restore +mov r2,-(sp) +mov r0,-(sp) ; Save =>command +; +; Need to work out how to save code image +mov #ShellRerun,FILE_NAME ; Save a copy of BASIC code +clr FILE_START+0 ; start=&0000 +clr FILE_START+2 +mov #DataEnd,FILE_END+0 ; end=end of init'd data +clr FILE_END+2 +adr MOS_BUF,r1 ; r1=>control block +mov #1,r0 ; r0=SAVE+1 for RT_FILE entry +;jsr pc,RT_FILE ; Call OSFILE to save +; +mov #ShellName,FILE_NAME ; Save a copy of live data +mov #SV_VARS,FILE_START+0 ; start=interpreter variables +clr FILE_START+2 +mov SV_MEMTOP,FILE_END+0 ; end=MEMTOP +clr FILE_END+2 +adr MOS_BUF,r1 ; r1=>control block +mov #1,r0 ; r0=SAVE+1 for RT_FILE entry +jsr pc,RT_FILE ; Call OSFILE to save +; +mov (sp)+,r0 ; r0=>command +mov #&o512,r1 ; r1=>command buffer +jsr pc,ShellCopy +adr ShellReturn,r0 ; r0=>"run x.x" +jsr pc,ShellCopy +sub #&o512,r1 +mov r1,&o510 ; Length of command buffer +clr &o52 ; USRERROR=0 +bisb #32,&o44 ; EXTCHAIN=TRUE +clr r0 ; Exit=Ok +emt &o350 ; EXIT + +; Return from EXIT, restore interpreter +; *NB* RAND will be set to zero +; *TODO* Delete $.$ file +.ShellCont +adr MOS_BUF,sp ; Temp'y stack under MOS_BUF +mov #ShellName,FILE_NAME +mov #SV_VARS,FILE_LOAD+0 ; load=interpreter variables +clr FILE_LOAD+2 +clr FILE_LOAD+4 ; load to supplied address +clr r0 ; r0=LOAD+1 for RT_FILE entry +adr MOS_BUF,r1 ; r1=>control block +;mov sp,r1 ; r1=>control block *NB* doesn't like this +jsr pc,RT_FILE ; Call OSFILE to load +;jsr pc,PrintInline ; *NB* Without this, bombs out with +;equs " ",11,13,0 ; HALT instruction. +;align ; Think this was because of unaligned code +mov SV_SYSPTR,sp ; Restore stack +mov (sp)+,r5 ; Restore LPTR +mov (sp)+,r1 ; Restore registers +rts pc ; And return +; +; +.CLIerrorR1 +mov (sp)+,r1 ; CS, error occured, restore R1 +.CLIchdir +.errBadCommand +;adr msgBadCommand,r0 +;jmp ErrorHandler +jsr pc,Error +;.msgBadCommand +equb 254,"Bad command",0 +align + +.ShellCopy +movb (r0)+,r2 ; Copy to command buffer +movb r2,(r1)+ +cmpb r2,#ASC" " +bcc ShellCopy ; *TODO* Check length +rts pc + +.ShellCat equs "dir/vol/exc %.%",0 +;.ShellReturn equs "run x.x " +.ShellReturn equs "run basic " +.ShellName equs "$.$",13 +.ShellRerun equs "x.x",13 +align + + +; OSBYTE - Host calls with byte parameters +; ======================================== +.IO_BYTE +tst r0 +beq IO_BYTE0 +cmp r0,#&87 +beq IO_MODE ; =MODE +cmp r0,#&86 +beq IO_POSVPOS ; =POS, =VPOS +cmp r0,#&81 +beq IO_INKEY ; =INKEY +cmp r0,#&80 +beq IO_ADVAL ; =ADVAL +cmp r0,#&7F +beq IO_EOF ; =EOF +.RT11_BYTEexit +clv +rts pc + +; Read host system type +; --------------------- +.IO_BYTE0 +mov #32+11,r1 ; 32=DOS-y filing system, 11=DEC PDP11 OS +rts pc + +.IO_POSVPOS +.IO_MODE +asl r0 ; Index into VDUvars +mov RT_POSVPOS-&86*2(r0),r1 +asr r0 ; Restore R0 +mov r1,r2 ; Return R1=word.lo, R2=word.hi +swab r2 +bic #&FF00,r1 +bic #&FF00,r2 +rts pc + +; OSINKEY - Timed wait for character from input stream +; ==================================================== +; On entry, R1=timeout +; On exit, R1=character +; CC=ok +; CS=escape or timeout +; R1=27 R1=-1 +; +.IO_INKEY +tst r1 ; Negative INKEY? +bmi IO_INKEYneg ; INKEY -num with R1=&FFxx +jsr pc,IO_GETKEY0 ; Should test for waiting key +;bvc IO_INKEYdone +; Should test timeout +;mov #&FFFF,r0 ; No key pressed +;sec ; No key pressed +.IO_INKEYdone +mov r0,r1 ; Return keypress in R1 +mov #&89,r0 ; Restore R0 +rts pc +; +; Read machine type +; ----------------- +.IO_INKEYneg +clr r0 ; Prepare 'key not pressed' +cmp r1,#&FF00 +bne IO_INKEYdone ; Not INKEY-256 +mov #&B0,r0 ; R0=&B0 - PDP11 generic +#if UKNCOK<0 + tst @#UKNCADDR ; Look inside host's workspace + beq IO_INKEYdone ; EQ=not UKNC +#else + cmp @#UKNCADDR,#UKNCOK ; Look inside host's workspace + bne IO_INKEYdone ; NE=not UKNC +#endif +inc r0 ; R0=&B1 - PDP11 UKNC +br IO_INKEYdone ; Should distinguish between DOS11/RSX11/RSTS/RT11/UKNC + +; =ADVAL +; ------ +.IO_ADVAL +;cmpb r1,#255 +;beq IO_ADVALkbd ; ADVAL(-1) +cmp r1,#127 +bne RT11_BYTEexit ; Not ADVAL(128-1), exit +.IO_ADVALlp +jsr pc,KBD_GETKEYBUF ; Wait for deep keypress +mov r0,r1 +rts pc + +; Read EOF status +; --------------- +.IO_EOF +tst r1 +bne IO_EOFdone ; Not EOF#0 +jsr pc,KBD_TestKey +clr r1 ; Prepare 'More input pending' +tst r0 ; How many keypresses pending? +bne IO_EOFdone ; If pend<>0, return EOF=FALSE +dec r1 ; If pend=0, return EOF=TRUE +.IO_EOFdone +rts pc + + +; OSWORD - Host calls with parameters in control block +; ==================================================== +; On entry, R0=action +; R1=>control block +; On exit, All registers undefined +; +; 0 - Read line +; 1 - Read TIME +; 2 - Write TIME +; 3 - Read SYSTIME +; 4 - Write SYSTIME +; 5 - Read from memory +; 6 - Write to memory +; 7 - SOUND +; 8 - ENVELOPE +; 9 - POINT +; 10 - Character definition +; 11 - Read palette +; 12 - Write palette +; 13 - Read graphics positions +; 14 - Read TIME$ +; 15 - Write TIME$ +.IO_WORD +cmp r0,#1 +beq RT_WORD1 ; OSWORD 1 - Read TIME +bcc RT_NOTWORD +JMP IO_WORD0 ; OSWORD 0 - Read line + +; Read TIME +; --------- +.RT_WORD1 +; On entry, R1=>block to read time to +; On exit, R1=>5-byte centisecond time +; +mov r4,-(sp) +mov r3,-(sp) +mov r2,-(sp) +mov r1,-(sp) ; Save registers +jsr pc,IO_ReadTime ; Get 1/50s count +clr r2 +asl r0 ; Multiply by 2, convert to 1/100s +rol r1 +;rol r2 ; b32 +clr r2 ; Reduce to 32-bit value +mov r1,r3 ; b16-b31 +mov r0,r4 ; b0-b15 +mov (sp),r1 ; r1=>control block +mov #5,r0 ; 5 bytes +jsr pc,cmdAssignNumber1 ; Store r4/r3/r2 in memory at r1 +mov (sp)+,r1 ; Restore registers +mov (sp)+,r2 +mov (sp)+,r3 +mov (sp)+,r4 +mov #1,r0 +.RT_NOTWORD +rts pc +; +.IO_ReadTime +mov #RT_STACK,r0 +mov sp,(r0) ; Save SP +mov r0,sp ; Use internal stack +cmp -(sp),-(sp) ; Make room on stack +mov sp,-(sp) ; Stack address of space on stack +mov #&o21*256+0,-(sp) ; GETTIM - Get Time +mov sp,r0 +emt &o375 +cmp (sp)+,(sp)+ ; Drop command and address +mov (sp)+,r1 ; Get 50Hz/60Hz tick to r1:r0 +mov (sp)+,r0 +mov (sp),sp ; Restore SP +rts pc + + +; OSASCI, OSNEWL, etc - Output with newline to output stream +; ========================================================== +.IO_ASCI +CMP R0,#13 ; Print ASCII character +BNE IO_WRCH ; Not , output it +.IO_NEWL +MOV #10,R0 ; Output +JSR PC,IO_WRCH +.IO_WRCR +MOV #13,R0 ; Output + ; Fall through to... + +; OSWRCH - Output character to output stream +; ========================================== +; On entry, R0=character +; On exit, all registers preserved +; +.IO_WRCH +mov r0,-(sp) +mov r1,-(sp) +jsr pc,wrch +mov (sp)+,r1 +mov (sp)+,r0 ; Also clears V +rts pc + + +; OSRDCH - Wait for character from input stream +; ============================================= +; On exit, R0=character +; CC=not escape, CS=escape +; +;.IO_RDCH +;jsr pc,IO_GETKEY0 ; Test for waiting key +;bvs IO_RDCH ; Loop until key pressed +;rts pc + +; Read from keyboard input +; ------------------------ +; On exit: VS=No keypress (not yet implemented) +; VC=Key press returned +; R0=16-bit character code +; CC=Not Escape +; CS=Escape and ESCFLG set +; +.IO_RDCH +.IO_GETKEY0 +tstb SV_ESCFLG ; Pending Escape state? ; V cleared, C cleared +bmi IO_GETKEYesc ; Escape pending +jsr pc,KBD_GETKEYBUF ; Read from keyboard +bic #&FF00,r0 ; Ensure 8-bit keycode ; V cleared, C unchanged +bitb #FLG_ESCAPE,SV_SYS ; Is Escape disabled? ; V cleared, C unchanged +bne IO_GETKEYdone ; If Escape disabled, return +cmp r0,#27 ; Check for CHR$27 ; V unknown, C unknown +clc ; ; V cleared, C cleared +bne IO_GETKEYdone ; Return CC if not CHR$27 +movb #&FF,SV_ESCFLG ; Set Escape flag +.IO_GETKEYesc +sec ; CS=Escape +jmp KBD_GETKEYesc ; Return R0=27 + + +; OSBGET - Read a single byte +; =========================== +; On entry, R1=handle +; On exit, R0=byte read +; +; We need to maintain a buffer and PTR/EXT +; +.RT11_BGET +cmp #16,r1 +bcs RT11_BGETexit ; Out or range, return EOF +mov sp,@#RT_STACK ; Save SP +mov #RT_STACK,sp ; Use local stack +; +;mov #-1,-(sp) ; Not BMODE +mov #1,-(sp) ; Not BMODE +mov #1,-(sp) ; One word +mov #RT_INFO,-(sp) ; Data buffer +mov #0,-(sp) ; PTR +bis #8*256,r1 ; R1=READ, +mov r1,-(sp) +mov sp,r0 ; R0=>parameters +emt &o375 +mov (sp)+,r0 ; Get READ, back +bic #&FF00,r0 ; R1=WAIT, +emt &o374 ; WAIT +tst (sp)+ ; Drop PTR +mov (sp)+,r0 ; Get BUF +movb (r0),r0 ; Get byte from buffer +; +mov #RT_STACK,sp ; Get old stack +mov (sp),sp +.RT11_BGETexit +clv +.IO_GETKEYdone +;rts pc + +.IO_GBPB +.IO_BPUT +.IO_BGET +.IO_ARGS +rts pc + + +; OSFIND - Open/close a file +; ========================== +; On entry, close: R0=0, R1=handle +; open: R0<>0, R1=>filename +; On exit, close: all preserved +; open: R0=handle +; R1 preserved +; +.IO_FIND +tst r0 +bne RT_OPEN ; R0<>0, open file +cmp r1,#16 +bcc RT_CLOSEexit ; Handle out of range +.RT11_CLOSE +mov r1,r0 +;beq UX_CLOSEall ; to do: close all +bis #6*256,r0 ; R0=CLOSE, +emt &o374 ; CLOSE +clrb RT_HANDLES(r1) ; Release the handle +clr r0 ; Restore R0 +.RT_CLOSEexit +rts pc + +.RT_OPEN +mov r2,-(sp) ; Save R2 +mov r1,-(sp) ; R1=>filename +mov r0,-(sp) ; Save OPEN action +mov #RT_FNAME,r2 ; R2=>buffer for file block +jsr pc,R50ScanFilename ; Convert filename at R1 to file block at R2 +bcs errBadFilename +mov (sp),r1 ; R1=OPEN action +; +mov #RT_STACK,r0 +mov sp,(r0) ; Save SP +mov r0,sp ; Use internal stack +; +mov #RT_INFO,r0 ; r0=>block to return file info +clr (r0) ; Clear info +mov r0,-(sp) ; (sp)=>returned info area +mov r2,r0 ; r0=>filename block +EMT &o342 ; DSTATUS +mov #RT_INFO,r0 ; r0=>file info +clc ; Prepare for later test +mov (r0),r0 ; Get device info +beq RT_FINDexit ; Device not found, return R0=0 +; +jsr pc,ChannelFind +bcs errTooManyOpen ; Run out of channels +bis #1*256,r0 ; R0=&01, - LOOKUP +clr -(sp) ; seqnum +bit #&40,r1 ; Is is OPENIN/OPENUP? +bne RT_OPEN2 ; Jump to do LOOKUP +clr -(sp) ; len +add #1*256,r0 ; R0=&02, - ENTER +.RT_OPEN2 +mov r2,-(sp) ; dblk +mov r0,-(sp) ; LOOKUP,channel +mov sp,r0 ; R0=>request block +emt &o375 ; LOOKUP area,chan,dblk,[seqnum] +; or ENTER area,chan,dblk,len,[seqnum] +bcs RT_FINDexit +mov (sp),r0 ; R0=channel +; +.RT_FINDexit +rol r0 ; Save Carry +mov #RT_STACK,sp ; Get old stack +mov (sp),sp +tst (sp)+ ; Drop R0 - clears Carry! +mov (sp)+,r1 ; Restore R1 +mov (sp)+,r2 ; Restore R2 +ror r0 ; Get Carry back +bcs RT_FINDfail ; CS+<>0 - already open, CS+0 - file not found +bic #&FFF0,r0 ; Reduce channel to 1-15 +movb r0,RT_HANDLES(r0) ; Claim the handle +.RT_FINDzero +rts pc ; Return R0=channel +; +.RT_FINDfail +tst r0 +beq RT_FINDzero ; R0=0, not found, return 0 +adr msgAlreadyOpen,r0 ; R0=>error block +jmp ErrorHandler + +.errTooManyOpen +mov #RT_STACK,sp ; Get old stack +mov (sp),sp +adr msgTooMany,r0 ; R0=>error block +jmp ErrorHandler + +.errBadFilename +adr msgBadFilename,r0 ; R0=>error block +jmp ErrorHandler + +; Find a free channel +; ------------------- +; On exit, CC, R0=channel +; CS, run out of channels +; +.ChannelFind +mov #4,r0 ; Start at channel 4 +.ChannelFindLp +inc r0 ; Step to next channel +cmp #15,r0 ; Run out of channels? +bcs ChannelFindExit ; Exit with CS +tstb RT_HANDLES(r0) ; Test if channel is closed +bne ChannelFindLp ; Not closed, loop to test next one +.ChannelFindExit +rts pc + +.errBadAddress +jsr pc,Error +.msgBadAddress +equb 252,"Bad address",0 +.msgBadFilename +equb 204,"Bad filename",0 +.msgAlreadyOpen +equb 194,"Already open",0 +.msgTooMany +equb 192,"Too many open",0 +.msgFileNotFound +equb 214,"File not found",0 +align + + +; OSFILE - Load/save/info on whole files +; ====================================== +; On entry, R0=action +; R1=>control block +; On exit, Control block updated +; +.IO_FILE +incb r0 +cmp r0,#2 +bcs RT_FILE ; 0/1 -> Load/Save +decb r0 ; Restore R0 +rts pc +; +; OSFILE &FF/&00 - Load/Save file +; ------------------------------- +.RT_FILE +#ifdef DEBUG + mov r5,-(sp) ; Save this if Debug called +#endif +mov r4,-(sp) +mov r3,-(sp) +mov r2,-(sp) +mov r1,-(sp) +mov r1,r2 ; r2=>control block +mov r0,r4 ; r4=0/1 -> Load/Save + +; Get filename and open file +; -------------------------- +bne RT_NotLoad +tstb 6(r2) +bne errBadAddress ; No address supplied, RT11 doesn't have file address, error +.RT_NotLoad +jsr pc,FetchWord ; r1=>fname, r0=corrupted, r2=r2+4 + ; R4=%00000000=Load %00000001=Save +dec r4 ; R4=%11111111 %00000000 +mov #&0080,r0 +xor r4,r0 ; R0=%01111111 %10000000 +bic #&FF3F,r0 ; R0=%01000000=OPENIN %10000000=OPENOUT +jsr pc,RT_OPEN ; Open file +tst r0 +beq RT_FILENotFound ; File not found +; +; Get start address and length, do read/write +; ------------------------------------------- +mov (sp),r2 ; r2=>control block +mov sp,@#RT_STACK ; Save SP +mov #RT_STACK,sp ; Use local stack +mov r0,-(sp) ; Save handle +; +add #2,r2 ; r2=>load address +inc r4 ; Restore r4=0/1 -> Load/Save +beq RT_File1 ; Load file +add #8,r2 ; r2=>start address +.RT_File1 +jsr pc,FetchWord ; Get load/start address from control block, r2=>next word +mov r1,r3 ; r3=start address +mov @#RT_STACK,r1 ; r1=end address, bottom of stack +sub r3,r1 ; r1=max length to load +tst r4 +beq RT_FileLoad ; R4=0, Load up to bottom of stack +jsr pc,FetchWord ; Get end address from control block +sub r3,r1 ; r1=length to save +.RT_FileLoad +mov (sp),r0 ; Get handle back +mov #1,-(sp) ; Not BMODE +inc r1 ; Deal with odd number of bytes +clc +ror r1 ; num=(num+1)/2, convert bytes to words +mov r1,-(sp) ; Number of words +mov r3,-(sp) ; Load or start address +mov #0,-(sp) ; PTR=0 +bis #8*256,r0 ; R0=READ, +tst r4 +beq RT_File2 ; R4=0, do Load +bis #9*256,r0 ; R0=WRITE, +.RT_File2 +mov r0,-(sp) +mov sp,r0 ; R0=>parameters +emt &o375 ; READ/WRITE channel,PTR=0,address,length,notBMODE +mov r0,r3 ; Return R0=count actually transfered +mov (sp)+,r0 ; Get READ/WRITE, back +bic #&FF00,r0 ; R0=WAIT, +emt &o374 ; WAIT +mov r0,r1 ; Get handle to r1 +jsr pc,RT11_CLOSE ; Close the file +; +; Update control block +; -------------------- +mov #RT_STACK,sp ; Get old stack +mov (sp),sp +; +mov r3,r1 ; r1=words transfers +asl r1 ; r1=bytes transfered +clr r0 ; &r0:r1=length of file +mov (sp),r2 ; Get address of control block back +add #10,r2 ; Point to 'length' in control block +jsr pc,StoreWord ; Store it in control block +mov (sp)+,r1 ; Restore all registers +mov (sp)+,r2 +mov (sp)+,r3 +mov (sp)+,r4 +#ifdef DEBUG + mov (sp)+,r5 ; Was protected against Debug calls +#endif +mov #1,r0 ; Return 'File found' +rts pc + +; Error occured during OSFILE +; --------------------------- +.RT_FILENotFound +adr msgFileNotFound,r0 ; R0=>error block +jmp ErrorHandler + + +; Convert Ascii filename to Radix50 name block +; -------------------------------------------- +; In: R1=>filename +; R2=>output buffer, word aligned +; Out: R2=>output buffer +; R1=>character after filename +; R0= character after filename +; R3-R6 preserved +; CS=filename valid +; CC=filename invalid +; +.R50ScanFilename +cmpb (r1)+,#ASC" " +beq R50ScanFilename ; Skip leading spaces +dec r1 ; R1=>first nonspace character +mov r3,-(sp) ; Save R3 +jsr pc,R50ScanThree ; Get up to 3 characters for device +cmpb r0,#&3A ; Device specifier? +beq R50ScanFilename2 ; Yes, continue by scanning filename +; +; Not a device prefix, we've scanned three chars of filename +mov -2(r2),(r2)+ ; Copy to start of filename +;clr -4(r2) ; Clear device name +mov #(ASC"D"-64)*40*40+(ASC"K"-64)*40,-4(r2) ; Set device name to 'DK:' +br R50ScanFilename3 ; Scan second half of filename +; +; Device name has been scanned, now scan filename +.R50ScanFilename2 +inc r1 ; Step past colon +jsr pc,R50ScanThree ; Get up to 3 characters of filename +cmp r0,#ASC"." +beq R50ScanFilename4 ; Dot, scan extension +.R50ScanFilename3 +jsr pc,R50ScanThree ; Get up to 3 more characters of filename +cmpb r0,#ASC"." ; Extension seperator? +beq R50ScanFilename4a ; Yes, step past dot +clr (r2)+ ; Set extension to spaces +br R50ScanFilename6 +; +.R50ScanFilename4 +clr (r2)+ ; Set second half of filename to spaces +.R50ScanFilename4a +inc r1 ; Step past dot +.R50ScanFilename5 +jsr pc,R50ScanThree ; Get up to 3 characters of extension +.R50ScanFilename6 +mov (sp)+,r3 ; Restore R3 +sub #8,r2 ; Point R2 back to start of output buffer +cmpb #ASC" ",r0 ; Are we at end of name? +rts pc ; CC=Ok, CS=Bad name + +; Scan up to three characters and convert to Radix50 +; -------------------------------------------------- +; In: R1=>character string +; R2=>output buffer +; Out: R0= next input character +; R1=>next input character +; R2=>next output buffer byte +; +.R50ScanThree +clr (r2) ; Set current word to three spaces +mov #3,r3 ; Prepare to scan three characters +.R50ScanThreeLoop +movb (r1)+,r0 ; Get character +jsr pc,R50NameChar ; Test it for valid R50 character +bcs R50ScanThreeEnd ; Invalid character, pad to end +jsr pc,R50Times40 ; Multiply by 40 and add +dec r3 +bne R50ScanThreeLoop ; Loop for up to three characters +inc r1 +br R50ScanThreeDone ; All three done +.R50ScanThreeEnd +jsr pc,R50Times40Zero ; Multiply by 40 to pad with spaces +dec r3 +bne R50ScanThreeEnd ; All three done +.R50ScanThreeDone +movb -(r1),r0 ; Get terminating character +tst (r2)+ ; Step to next output word +rts pc + +.R50Times40Zero +clr r0 +.R50Times40 +mov r0,-(sp) ; Save this index +mov (r2),r0 +asl r0 ; *2 +asl r0 ; *4 +add (r2),r0 ; +1 -> *5 +asl r0 ; *10 +asl r0 ; *20 +asl r0 ; *40 +add (sp)+,r0 ; num=num*40+this +mov r0,(r2) ; Store in output buffer +rts pc + +; Check for Valid R50 character +; ----------------------------- +; In: R0=character, case ignored +; Out: CC=valid character R0=R50 index +; CS=invalid character R0=preserved or upper case +; Valid characters are " abcdefghijklmnopqrstuvwxyz$%*0123456789" +; But filenames are terminated by space, so ' ' rejected. +; +.R50NameChar +cmpb r0,#ASC"$" +beq R50Char27 ; Convert '$' -> 27 +cmpb r0,#ASC"%" +beq R50Char28 ; Convert '%' -> 28 +cmpb r0,#ASC"*" +beq R50Char29 ; Convert '*' -> 29 +jsr pc,VarChkChar ; Check if 0-9,A-Z,_,`,a-z +bcs R50BadChar +.R50Dot +bic #&FFA0,r0 ; Force to A-Z,_,`,a-z to &40-&5F, 0-9 to &10-&19 +cmpb #ASC"Z",r0 +bcs R50BadChar +cmpb #ASC"@",r0 +bcs R50Alpha ; Reduce letters to 1-26 +sec +beq R50BadChar +add #&4E,r0 ; Offset for 0-9 -> 30-39 +.R50Alpha +sub #ASC"@",r0 ; A-Z -> 1-26, 0-9 -> 30-39 +.R50BadChar +rts pc +.R50Char29 +mov #38,r0 +.R50Char28 +.R50Char27 +sub #9,r0 ; Convert to 27,28,29 +rts pc + + +; CONSOLE INPUT +; ~~~~~~~~~~~~~ + +; Check for Escape state +; ---------------------- +;.IO_EscapeFast +;movb #1,SV_TICKER ; Bypass ticker +.IO_Escape +tstb SV_ESCFLG ; Check local Escape flag +bmi errEscape ; Background Escape pending +bitb #FLG_ESCAPE,SV_SYS ; Is Escape disabled? +bne IO_NoEscape ; Don't test for Escape +decb SV_TICKER ; Only test Escape every so often +bne IO_NoEscape +#if KBD_TICK=0 + clrb SV_TICKER ; Reset Escape ticker, clear Cy +#else + movb #KBD_TICK,SV_TICKER ; Reset Escape ticker +#endif +.IO_EscapeFast ; Bypass ticker +CMP #VT52OK,@#VT52ADDR ; CC=VT52, CS=VT100 +BCS IO_EscapeNotVT52 +CMPB @#&o177562,#27 ; Read TTYIN directly +BNE IO_NoEscape ; Mustn't read TTYSTAT first as that flushes TTYIN +.IO_EscapeFlushVT52 +emt KBDEMT +bcs IO_EscapeFlushVT52 ; Pull character from TTYIN +br errEscape ; Generate error + +.IO_EscapeNotVT52 +emt KBDEMT +bcs IO_NoEscape ; No key pressed +cmp r0,#27 +bne IO_NoEscape ; Not , lose the keypress +emt KBDEMT ; TTYIN - might need to be delayed TTYIN call +bcs errEscape ; -> Escape pressed +.IO_NoEscape ; - lose the keypresses +rts pc + +.errEscape +emt KBDEMT +bcc errEscape ; Flush TTYIN +clrb SV_KBDQ ; Clear pending keypresses +jsr pc,Error ; Generate Escape error +equb 17,"Escape",0 +align + +.KBD_TestKeyLp +movb r0,SV_KBDBUF ; Buffer the keypress +incb SV_KBDQ ; Inc. queue and continue to return NE +; +.KBD_TestKey +; On exit, EQ+R0=0 - no key waiting +; NE+R0>0 - keypress waiting +movb SV_KBDQ,r0 +bne KBD_TestKeyOk ; Buffered keypress +emt KBDEMT ; TTYIN +bcc KBD_TestKeyLp ; Pending keypress, buffer it +clr r0 ; No keypress, return R0=0+EQ +.KBD_TestKeyOk +rts pc + +.KBD_WaitKey +; On exit, R0=keypress +movb SV_KBDQ,r0 +beq KBD_WaitKeyLp ; No pending keypress +movb SV_KBDBUF-1(r0),r0 ; Get pending keypress +decb SV_KBDQ ; Clears Cy +rts pc +.KBD_WaitKeyLp +emt KBDEMT ; TTYIN +bcs KBD_WaitKeyLp +rts pc + +.KBD_TestKeyDelay +; On exit, EQ+R0=0 - no key waiting +; NE+R0>0 - keypress waiting +mov r1,-(sp) +mov #KBD_DELAY,r1 ; Loop to allow for typing delays +#if UKNCOK<0 + tst @#UKNCADDR ; Look inside host's workspace + beq KBD_SlowKeyLp ; EQ=not UKNC +#else + cmp @#UKNCADDR,#UKNCOK ; Look inside host's workspace + bne KBD_SlowKeyLp ; NE=not UKNC +#endif +mov #1,r1 ; Two passes for UKNC +.KBD_SlowKeyLp +jsr pc,KBD_TestKey +bne KBD_SlowKeyOk +dec r1 +bpl KBD_SlowKeyLp +clr r0 ; R0=0 - no key waiting +.KBD_SlowKeyOk +mov (sp)+,r1 +tst r0 ; Set EQ from R0 +rts pc + + +; CONSOLE OUTPUT +; ~~~~~~~~~~~~~~ + +; Process output character +; ------------------------ +.wrch +MOVB vduQ,R1 +BNE pending ; VDU queue pending +; +CMP R0,#127 ; Update local POS/VPOS +BEQ wrchLeft +CMP R0,#32 +BCC wrchRight +CMP R0,#13 +BEQ wrchCR +CMP R0,#11 +BEQ wrchUp +BCC wrchNext +CMP R0,#9 +BEQ wrchRight +BCC wrchDown +CMP R0,#8 +BCS wrchNext +.wrchLeft +DECB RT_POS +BPL wrchNext +MOVB RT_WIDTH,RT_POS +.wrchUp +TSTB RT_VPOS +BEQ wrchNext +DECB RT_VPOS +BR wrchNext +.wrchRight +INCB RT_POS +CMPB RT_POS,RT_WIDTH +BLS wrchNext +CLRB RT_POS +.wrchDown +CMPB RT_VPOS,RT_HEIGHT +BCC wrchNext +INCB RT_VPOS +BR wrchNext +.wrchCR +CLRB RT_POS +.wrchNext +; +CMP R0,#32 +BCS control ; Control character +CMP R0,#127 +;BEQ delete ; CHR$127 +BEQ vdu127 ; CHR$127 +BCC vdudirect ; CHR$>127, bypass 7-bit filter +BCS vduraw ; Fall through with CHR$32-CHR$126 + +; VDU 127 - Delete +; ---------------- +.vdu127 +MOV #32*256+8,R0 ; ASCII Delete sequence +JSR PC,vduraw ; Send 8 +SWAB R0 ; Send 32,8 +; +.vdutwice +JSR PC,vduraw ; Send bottom byte, usually ESC +.vduswap +SWAB R0 ; Swap to sent top byte + +; Send raw character to TTYOUT +; ---------------------------- +.vduraw +;.vdu10 ; Down +;.vdu08 ; Left +.vdu13 ; CR +.vdu27 ; Escape +.vduwait +EMT 225 ; TTYOUT +BCS vduwait ; loop until done +.vdureturn +.vdunull +RTS PC + +.vdu01 ; Print Next, write raw character +MOVB vduQueue-1,R0 ; Get character +BR vdudirect +.vduthree +JSR PC,vdudirect ; Send R0 bottom byte, usually ESC +SWAB R0 +JSR PC,vdudirect ; Sent R0 top byte, usually &80+nn +MOV R1,R0 ; Send R1 bottom byte +.vdudirect +TSTB @#&o177564 ; Write directly to bypass 7-bit filter +BPL vdudirect +MOV R0,@#&o177566 +RTS PC + +; VDU queue pending +; ----------------- +.pending +MOVB R0,vduQueue(R1) ; Store in VDU queue +INCB vduQ +BNE vdureturn ; Waiting for more parameters +MOVB vduChar,R0 ; Get current control character +ASL R0 +;.dispatch +MOV vduAddr(R0),R1 ; R1=dispatch address+parameters +.dispatch1 +BIC #&F000,R1 ; Mask off parameters +ADR wrch,R0 ; R0=base of routines +ADD R0,R1 ; Add offset to routine +MOVB vduChar,R0 ; Get control character +CMPB R0,#30 +BCC dispatch2 ; CHR$>29, Carry=VT type +CMPB R0,#16 +BCS dispatch2 ; CHR$<16, Carry=VT type +#if UKNCOK<0 + TST @#UKNCADDR ; Look inside host workspace for UKNC + BNE dispatch3 ; NE=UKNC, TST also sets CC +#else + CMP @#UKNCADDR,#UKNCOK ; Look inside host workspace for UKNC + BEQ dispatch3 ; CC=UKNC +#endif +SEC ; CS=not UKNC +.dispatch3 +JMP (R1) ; Jump to control routine +.dispatch2 +CMP #VT52OK,@#VT52ADDR ; CC=VT52, CS=VT100 +JMP (R1) ; Jump to control routine + +; Control characters +; ------------------ +;.delete +;MOV #32,R0 ; Convert VDU 127 to 32 +.control +MOVB R0,vduChar ; Save control character +ASL R0 +MOV vduAddr(R0),R1 ; R1=dispatch address+parameters +BIT R1,#&F000 +BEQ dispatch1 ; No parameters, dispatch +SWAB R1 +ASR R1 +ASR R1 +ASR R1 +ASR R1 ; Number of parameters in b0-b3 +BIS #&F0,R1 +MOVB R1,vduQ ; 256-(Number of params to wait for) +RTS PC + +;; VDU 127 - Delete +;; ---------------- +;.vdu127 +;MOV #32*256+8,R0 ; ASCII Delete sequence +;;BCS vdu127a +;;MOV #32*256+26,R0 ; UKNC Delete sequence +;;.vdu127a +;MOV R0,R1 +;BR vduthree + +;ADR ANSdelete,R0 ; ANSI Delete sequence +;BCS vdu127a +;ADR UKNdelete,R0 ; UKNC Delete sequence +;.vdu127a +;EMT &o351 ; PRINT +;RTS PC + +; VDU 8 - Left +; ------------- +.vdu08 +BCS vduraw ; CS=VT100 +MOV #27+256*ASC"D",R0 +BR vdutwice ; CC=VT52 + +; VDU 9 - Right +; ------------- +.vdu09 +MOV #27+256*ASC"C",R0 +BCC vdutwice ; CC=VT52 +ADR ANSright,R0 ; ANSI right +EMT &o351 ; PRINT +RTS PC + +; VDU 10 - Down +; ------------- +.vdu10 +BCS vdu10ansi ; VS=VT100 +#if UKNCOK<0 + TST @#UKNCADDR ; EQ=UKNC, NE=not UKNC + BNE vduraw ; UKNC, do VDU 10 for LF +#else + CMP @#UKNCADDR,#UKNCOK ; EQ=UKNC, NE=not UKNC + BEQ vduraw ; UKNC, do VDU 10 for LF +#endif +INC R0 +BR vduraw ; Not UKNC, do VDU 11 for LF +.vdu10ansi +ADR ANSdown,R0 ; ANSI down +EMT &o351 ; PRINT +RTS PC + +; VDU 11 - Up +; ----------- +.vdu11 +MOV #27+256*ASC"I",R0 +BCC vdutwice ; CC=VT52 +ADR ANSup,R0 ; ANSI up +EMT &o351 ; PRINT +RTS PC + +; VDU 22,n - MODE +; --------------- +.vdu22 +MOVB vduQueue-1,R1 ; Get MODE parameter +MOVB R1,RT_MODE ; Save MODE +;MOV #79+256*24,RT_WIDTH ; Display is 80x25 characters +MOV #79+256*23,RT_WIDTH ; Display is 80x24 characters +BCS vdu22ansi +BIC #&FFF8,R1 ; Reduce to 0-7 +CMP #2,R1 ; 0 1 2 3 4 5 6 7 +ADC R1 ; 0 1 2 4 5 6 7 8 +CMP #6,R1 +BCC vdu22a +MOV #1,R1 ; 0 1 2 4 5 6 1 1 +.vdu22a +BIC #&FFFC,R1 ; 0 1 2 0 1 2 1 1 +MOVB UKNwidth(R1),RT_WIDTH +;DECB RT_HEIGHT ; Set UKNC screen size +ADD #ASC"1",R1 ; 1 2 3 1 2 3 4 2, clears Carry +MOV #27+256*166,R0 +JSR PC,vduthree ; Carry preserved +.vdu22ansi +CMP #VT52OK,@#VT52ADDR ; CC=VT52, CS=VT100 +JSR PC,vdu20 ; Reset colours, Carry preserved +MOV #12,R0 ; Then clear screen + +; VDU 12 - CLS +; ------------ +.vdu12 +ROR R1 ; Save Carry +ADR VT52cls,R0 ; CC=VT52 cls (NB, ADR changes Carry) +TST R1 +BPL vdu12go +ADR ANScls,R0 ; CS=VT100 cls (NB, ADR changes Carry) +.vdu12go +EMT &o351 ; PRINT +ROL R1 ; Get Carry back +;BCC vduraw ; UKNC +;ADR ANScls,R0 ; ANSI cls +;EMT &o351 ; PRINT +;SEC ; Then HOME cursor for RT11 + +; VDU 30 - Home +; VDU 31,x,y - TAB +; ----------------- +.vdu30 +MOV #0,vduQueue-2 ; Preload TAB(0,0), preserve Carry +.vdu31 +MOV vduQueue-2,RT_POSVPOS +BCS ansi31 ; CS=VT100 +CMPB vduQueue-2,RT_WIDTH ; Can't send >95 as 96+128=128 +BHI ansi31done ; Limit the range by checking +CMPB vduQueue-1,RT_HEIGHT ; limits set from MODE +BHI ansi31done +ADD #&2020,vduQueue-2 ; VT52 starts from (32,32) +MOV #27+256*ASC"Y",R0 +JSR PC,vdutwice ; Send ESC,Y +MOV vduQueue-2,R0 ; X,Y coordinates +SWAB R0 +JMP vdutwice ; Send Y,X + +.ansi31 +ADD #&0101,vduQueue-2 ; ANSI starts from (1,1) +MOV #ANStab+2,R1 +MOVB vduQueue-1,R0 ; Y coordinate +JSR PC,vduDecimal ; Output as decimal +MOVB #59,(R1)+ +MOVB vduQueue-2,R0 ; X coordinate +JSR PC,vduDecimal ; Output as decimal +ADR ANStab,R0 ; ANSI tab +EMT &o351 ; PRINT +.ansi31done +RTS PC + +; VDU 17,n - COLOUR - ANSI output +; ------------------------------- +; PRINTCHR$27;"[0;"; +; IF (A AND 16):PRINT"5;"; :REM flash +; IF (A AND 32):PRINT"4;"; :REM underline +; IF (A AND 64):PRINT"7;"; :REM inverse +; IF (A AND 128)=0:PRINT;30+(A AND 7);";":IF (A AND 8):PRINT"1;"; :REM foreground colour +; IF (A AND 128) :PRINT;40+(A AND 7);:IF (A AND 8):PRINT";";100+(A AND 7); :REM background colour +; PRINT"m"; +; +.vdu17 +ROR R1 ; Save Carry in R1 +MOVB vduQueue-1,R0 ; Get COLOUR parameter +BISB #ASC"0",R0 ; Convert to digit, keeping b7-b6 +BPL vdu17_setfgd ; COLOUR &00+n, set foreground +CMPB R0,#&C0 +BCC vdu17exit ; COLOUR &C0+n, set border, unimplemented +MOVB R0,txtBGD ; Set as current background +BR vdu17_colour +.vdu17_setfgd +MOVB R0,txtFGD ; Set as current foreground +.vdu17_colour +TST R1 +BPL uknc17_write ; Jump to set UKNC colours +CMP #VT52OK,@#VT52ADDR ; CC=VT52, CS=VT100 +BCC vdu17exit ; CC=VT52, no colours +; +MOVB vduQueue-1,R0 ; Get COLOUR parameter again +MOV #ANScolour+3,R1 ; R1=>output string after initial [0 +MOVB #&3B,(R1)+ ; Insert semicolon, R1 is now aligned +BIT #64,R0 +BEQ vdu17_noinvert +MOV #&3B00+ASC"7",(R1)+; Invert on "7;" ALIGNED +.vdu17_noinvert +BIT #32,R0 +BEQ vdu17_nounderline +MOV #&3B00+ASC"4",(R1)+; Underline on "4;" ALIGNED +.vdu17_nounderline +BIT #16,R0 +BEQ vdu17_noflash +MOV #&3B00+ASC"5",(R1)+; Flash on "5;" ALIGNED +.vdu17_noflash +; +MOVB txtFGD,R0 ; Get current foreground +BIT #8,R0 +BEQ vdu17_nobright ; Not bright foreground +MOV #&3B00+ASC"1",(R1)+; Bright on "1;" ALIGNED +.vdu17_nobright +MOVB #ASC"3",(R1)+ ; Prefix for foreground ALIGNED +BIC #&FFC8,R0 ; Reduce to '0'-'7' +MOVB R0,(R1)+ ; Foreground colour +MOVB #&3B,(R1)+ ; ";" ALIGNED +; +MOVB txtBGD,R0 ; Get current background +MOVB #ASC"4",(R1)+ ; Prefix for foreground +BIC #&FFC8,R0 ; Reduce to '0'-'7' +MOVB R0,(R1)+ ; Background colour ALIGNED +BITB #8,txtBGD +BEQ vdu17_write ; Not bright background +MOVB #&3B,(R1)+ ; ";" +MOV #&3031,(R1)+ ; Prefix for bright background ALIGNED +MOVB R0,(R1)+ ; Bright background colour ALIGNED +; +.vdu17_write +MOVB #ASC"m",(R1)+ ; Terminator +MOVB #128,(R1)+ ; String terminator +ADR ANScolour,R0 +EMT &o351 ; PRINT +;SEC ; CS=ANSI +.vdu17exit +RTS PC + +; VDU 20 - Reset colours +; ---------------------- +.vdu20 +MOV #&3037,txtFGD ; Set current colours +BCC uknc20 ; UKNC +CMP #VT52OK,@#VT52ADDR ; CC=VT52, CS=VT100 +BCC vdu20exit ; CC=VT52, no colours +ADR ANSreset,R0 ; ANSI default colours +EMT &o351 ; PRINT +.vdu20exit +SEC ; SEC=ANSI +RTS PC + +; VDU 20 - Reset colours +; ---------------------- +.uknc20 +MOV #163,R1 ; Inverse off +.uknc20lp +MOV #27+256*191,R0 +JSR PC,vduthree ; Send ESC,191,nnn +INC R1 +CMP #165,R1 ; Underline off +BNE uknc20lp +MOVB #64,vduQueue-1 ; Set cursor +JSR PC,uknc17_write +ASLB vduQueue-1 ; Set background +JSR PC,uknc17_write ; Clears vduQueue-1 + ; fall through + +; VDU 17,n - COLOUR - UKNC output +; ------------------------------- +; COLOUR &00+fgd - PRINT CHR$27;CHR$160;CHR$('0'+fgd); +; COLOUR &40+cur - PRINT CHR$27;CHR$167;CHR$('0'+cur); +; COLOUR &80+bgd - PRINT CHR$27;CHR$161;CHR$('0'+bgd); +; COLOUR &80+bgd - PRINT CHR$27;CHR$162;CHR$('0'+bgd); +; +.uknc17_write +MOV #27+256*161,R0 ; R0=SetBGD +MOV txtFGD,R1 ; low=FGB, high=BGD +SWAB R1 ; high=FGD, low=BGD +TSTB vduQueue-1 ; Test COLOUR parameter +BMI uknc17_go ; COLOUR &80+n +SWAB R1 ; low=FGB, high=BGD +MOV #27+256*160,R0 ; R0=SetFGD +BITB #64,vduQueue-1 ; Test COLOUR parameter +BEQ uknc17_go ; COLOUR &00+n +MOV #27+256*167,R0 ; R0=SetCursor +.uknc17_go +BIC #&FFF8,R1 ; Reduce colour to &00-&07 +MOVB UKNcolourmap(R1),R1 ; Convert to encoded character +.uknc17_set +JSR PC,vduthree ; Send ESC,SetColour,colour +TSTB vduQueue-1 ; Test COLOUR parameter, also clears carry +BPL vduDecExit ; Exits with CC=UKNC +MOV #27+256*162,R0 ; R0=SetSCR +CLRB vduQueue-1 +BR uknc17_set + +; Output R0 as 8-bit decimal at (R1) +; ---------------------------------- +.vduDecimal +MOVB #ASC"0"-1,(R1) ; Start with '0'-1 for hundreds +.vduDecLp1 +INCB (R1) ; Increment hundreds digit +SUB #100,R0 ; Subtract 100 from R0 +BCC vduDecLp1 ; Loop until <0 +INC R1 ; Step past hundreds digit +ADD #100,R0 ; Balance last SUB #100 +MOVB #ASC"0"-1,(R1) ; Start with '0'-1 for tens +.vduDecLp2 +INCB (R1) ; Increment tens digit +SUB #10,R0 ; Subtract 10 from R0 +BCC vduDecLp2 ; Loop until <0 +INC R1 ; Step past tens digit +ADD #ASC"0"+10,R0 ; Convert back to units +MOVB R0,(R1)+ +.vduDecExit +RTS PC + +; Dispatch addresses and parameters +; --------------------------------- +.vduAddr +EQUW (vduraw -wrch) OR &0000 ; NULL +EQUW (vdu01 -wrch) OR &F000 ; Print Next +EQUW (vduraw -wrch) OR &0000 ; Printer On +EQUW (vduraw -wrch) OR &0000 ; Printer Off +EQUW (vduraw -wrch) OR &0000 ; Graphics +EQUW (vduraw -wrch) OR &0000 ; Graphics +EQUW (vduraw -wrch) OR &0000 ; Enable +EQUW (vduraw -wrch) OR &0000 ; BELL +EQUW (vdu08 -wrch) OR &0000 ; Left VT100/VT52 +EQUW (vdu09 -wrch) OR &0000 ; Right VT100/VT52 +EQUW (vdu10 -wrch) OR &0000 ; Down VT100/VT52 +EQUW (vdu11 -wrch) OR &0000 ; Up VT100/VT52 +EQUW (vdu12 -wrch) OR &0000 ; CLS VT100/VT52 +EQUW (vdu13 -wrch) OR &0000 ; CR VT100/VT52 +EQUW (vduraw -wrch) OR &0000 ; Page On -> Cyrillic characters +EQUW (vduraw -wrch) OR &0000 ; Page Off -> Latin characters +EQUW (vduraw -wrch) OR &0000 ; CLG VT/UKNC +EQUW (vdu17 -wrch) OR &F000 ; COLOUR VT/UKNC +EQUW (vdunull-wrch) OR &E000 ; GCOL VT/UKNC +EQUW (vdunull-wrch) OR &B000 ; Set Palette VT/UKNC +EQUW (vdu20 -wrch) OR &0000 ; Reset Colours VT/UKNC +EQUW (vduraw -wrch) OR &0000 ; Disable VDU +EQUW (vdu22 -wrch) OR &F000 ; MODE VT/UKNC +EQUW (vdunull-wrch) OR &7000 ; DEFCHR$ +EQUW (vdunull-wrch) OR &8000 ; Define Graphics Window +EQUW (vdunull-wrch) OR &B000 ; PLOT +EQUW (vdunull-wrch) OR &0000 ; Clear Windows +EQUW (vduraw -wrch) OR &0000 ; Escape +EQUW (vdunull-wrch) OR &C000 ; Define Text Window +EQUW (vdunull-wrch) OR &C000 ; ORIGIN +EQUW (vdu30 -wrch) OR &0000 ; HOME +EQUW (vdu31 -wrch) OR &E000 ; TAB VT100/VT52 +;EQUW (vdu127 -wrch) OR &0000 ; Delete + +.CodeEnd ; End of 'text/code' section + +; Initialised data +; ---------------- +;.ANSdelete EQUS 8,32,8,128 ; Delete +;.ANSleft EQUS 27,"[D",128 ; VT100 Left +.ANSright EQUS 27,"[C",128 ; VT100 Right +.ANSdown EQUS 27,"D",128 ; VT100 Down +;.ANSdown EQUS 27,"[B",128 ; Down, fails on bottom line +.ANSup EQUS 27,"M",128 ; Up +;.ANSup EQUS 27,"[A",128 ; Up, fails on top line +.ANScls EQUS 27,"[2J",128 ; CLS +.VT52cls EQUS 27,"H",27,"J",128 ; CLS +.ANSreset EQUS 27,"[0m",128 ; Default colours +align +.ANStab EQUS 27,"[000,000H",128 ; Home/TAB +align +.ANScolour EQUS 27,"[0,1,5,4,7,30,40,100m",128 ; COLOUR +; +;.UKNdelete EQUS 26,32,26,128 ; Delete +;.UKNreset EQUS 27,191,163,27,191,164,0 ; Inverse off, Underline off +;.UKNleft EQUS 27,"D",128 ; Left +;.UKNright EQUS 27,"C",128 ; Right +;.UKNdown EQUS 27,"B",128 ; Down +;.UKNup EQUS 27,"A",128 ; Up +;.UKNcolour EQUS 27,"%!0",27,"LI@@" +;.UKNfgd EQUS "@@@" +;.UKNbgd EQUS "@@@" +;.UKNcls EQUS "@",27,"%!3",128 +;.UKNtab EQUS 27,"Y",128 +.UKNcolourmap EQUS "04261537" +.UKNwidth EQUB 79,39,19,09 +.UKNkeys EQUS 27,"%!1",27,"P",59,"1|" + EQUS "1/1B50",59 + EQUS "2/1B51",59 + EQUS "3/1B52",59 + EQUS "4/1B53",59 + EQUS "5/1B54",59 + EQUS "6/1B50",59 + EQUS "7/1B51",59 + EQUS "8/1B52",59 + EQUS "9/1B53",59 + EQUS "10/1B54",59 +; EQUS "1/81",59 +; EQUS "2/82",59 +; EQUS "3/83",59 +; EQUS "4/84",59 +; EQUS "5/85",59 +; EQUS "6/91",59 +; EQUS "7/92",59 +; EQUS "8/93",59 +; EQUS "9/94",59 +; EQUS "10/95",59 + EQUS 27,"\",27,"%!3",128 +; +align +.txtFGD EQUS "7" +.txtBGD EQUS "0" + +.SV_EMBED +EQUW 0 ; No embedded program + +.DataEnd ; End of 'initialised data' section +BSS ; End of saved portion + +; Workspace in low non-swapped memory +; ----------------------------------- +.RT_HANDLES EQU &0100 ; 16 handles +.RT_FNAME EQU &0110 ; Radix50 filename +.RT_INFO EQU &0118 ; File/device status +.RT_POSVPOS EQU &0120 ; POS and VPOS +.RT_POS EQU RT_POSVPOS+0 +.RT_VPOS EQU RT_POSVPOS+1 +.RT_MODEINF EQU &0122 ; pad +.RT_MODE EQU RT_MODEINF+1 ; MODE +.RT_WIDTH EQU &0124 +.RT_HEIGHT EQU RT_WIDTH+1 +;.RT_EMTBUF EQU &0120 ; Up to 8 EMT parameters +; +.RT_STACK EQU &01FE ; Stack for calling RT11 + +; Uninitialised data +; ------------------ +.vduChar EQUB 0 + EQUB 0,0,0,0,0,0,0,0,0 +align +.vduQueue +.SV_TICKER EQUB 0 ; Escape test ticker +align +.vduQ EQUB 0 +.SV_KBDQ EQUB 0 ; Keypresses pending +.SV_KBDBUF EQUW 0 ; Buffer for pending keypress +ALIGN + +; Memory size +; ----------- +.SV_MEMBOT EQUW 0 ; Bottom of memory +.SV_MEMTOP EQUW 0 ; Top of memory + + EQUM (506-$) AND 511 ; Pad so shell() saving works diff --git a/src/Stack b/src/Stack new file mode 100644 index 0000000..d666436 --- /dev/null +++ b/src/Stack @@ -0,0 +1,254 @@ +; > Stack +; BASIC stack manipulation and function dispatch +; +; 20-Nov-2013: Added UnstackDropStringOp. +; 23-Dec-2013: String type and length compressed to one word on stack. +; 25-Dec-2013: EvalStringCR copied to string buffer if not CR-string. +; 01-Sep-2015: High numbered functions use lookup table instead of long dispatch table. +; 29-Sep-2015: High Function lookup made postition independent. +; 28-Jul-2016: Squeezed some instructions out of Function Dispatch. +; 07-Apr-2024: Stacking strings checks for 256 bytes free space. + + +; StackValAndOp - Push a value and operator onto stack +; ==================================================== +.StackValAndOp +tst r2 +bpl StackNumAndOp ; Jump to stack number + + +; StackStringAndOp - Push a string and operator onto stack +; ======================================================== +; On entry, sp=> retaddr +; r4=string start, r3=string length, r2=8nxx, r0=operation +; On exit, sp=> operation, type+length, string... +; +.StackStringAndOp +jsr pc,CheckFreeMemory ; Check 256 bytes available on stack, corrupts R1 +mov (sp)+,r1 ; Get return address +mov r3,r2 ; Copy string length to byte count +inc r2 +bic #1,r2 ; Pad to ensure even number +sub r2,sp ; Drop stack to fit string +mov sp,r2 ; Point to string space on stack +mov r3,-(sp) ; Stack length +; should this be whatever r2 on entry was to stack defprocfred($addr, etc.) +; merge with type done in cmdSub - faster as cmdSub is only place that needs it +bis #&8000,(sp) ; Merge stacked length with type, is now &8xnn +mov r0,-(sp) ; Stack operation +tst r3 +beq StackStrDone ; Zero-length string +.StackStrLp +movb (r4)+,(r2)+ ; Copy byte to stack +dec r3 +bne StackStrLp ; Loop to 'push' all characters +.StackStrDone +jmp (r1) ; Return via r1 + + +; StackIntAndOp - Push integer and operator onto stack +; ==================================================== +; On entry, r2/r3/r4=current value +; sp=> +; On exit, r2/r3/r4 may be corruputed +; sp=> operator, exponent, b0-b15, b16-b31 +; r0 r2 r4 r3 +; We stack this way around so arithmetic is easier, pop&add b0-b15, pop&add b16-b31, etc. +; +.StackIntAndOp +jsr pc,EnsureInteger ; If float, convert to integer +.StackNumAndOp ; sp=> retaddr +mov r4,-(sp) ; sp=> r4, retaddr +mov 2(sp),r4 ; sp=> r4, retaddr r4=retaddr +mov r3,2(sp) ; sp=> r4, r3 r4=retaddr +mov r2,-(sp) ; sp=> r2, r4, r3 r4=retaddr +mov r0,-(sp) ; sp=> r0, r2, r4, r3 r4=retaddr +jmp (r4) ; Return via r4 + + +; UnstackIntAndCallOp +; =================== +.UnstackIntAndCallOp +; On entry, r2/r3/r4=RHS value +; sp=> retaddr, operator, type, b0-b15, b16-b31 +; sp=> retaddr, operator, type+length, string... +; +jsr pc,EnsureInteger ; If RHS value float, convert to integer + + +; UnstackValAndCallOp +; =================== +; Name is slightly wrong, doesn't actually unstack, the called function does the unstacking +; +.UnstackValAndCallOp + ; sp=> retaddr, operator, type, b0-b15, b16-b31 + ; sp=> retaddr, operator, type+length, string... +;mov 2(sp),r0 ; Get operator to r0 +;mov (sp)+,r1 ; sp=> operator, type, b0-b15, b16-b31 r1=retaddr +mov (sp)+,r1 ; sp=> operator, type, b0-b15, b16-b31 r1=retaddr +mov (sp),r0 ; Get operator to r0 +mov r1,(sp) ; sp=> retaddr, type, b0-b15, b16-b31 + ; sp=> retaddr, type+length, string +mov 2(sp),r1 ; r1=LHS type +bic #&7FFF,r1 ; Keep string/number bit +xor r2,r1 ; Is it same as RHS type +bmi errTypeMis2 ; Error if different types +;bit #&80,r0 +;bne EvalChkNums ; b7 operators must be +tstb r0 +bmi EvalChkNums ; b7 operators must be +cmp r0,#&79 +bcc EvalFuncPlus ; Comparisons allowed to operate on strings +cmp r0,#ASC"+" +beq EvalFuncPlus ; '+' allowed to operate on strings +.EvalChkNums +tst r2 ; Test RHS type, will be same as LHS type +bmi errTypeMis2 ; Other operations must be +.EvalFuncPlus +cmp r0,#&79 +bcc EvalFunctionX ; Dispatch comparisons and AND/DIV/EOR/MOD/OR +;sub #3,r0 ; Reduce range for '*+,-^/' +;bic #&FFF0,r0 ; Reduce to 7..12 +;bis #&80,r0 ; Move to &87..&8C +add #&5D,r0 ; Convert '*+,-^/' to &87/88/89/8a/bb/8c +bic #&70,r0 ; Convert '*+,-^/' to &87/88/89/8a/8b/8c +.EvalFunctionX + +; EvalFunction - dispatch a function token +; ---------------------------------------- +; r0=&FF80-&FFFF from Evaluate +; or r0=&0070-&007F from binary-op +; or r0=&FF80-&FF8F from binary-op +; +; r2/r3/r4 will be 0 if called from evaluator for tail functions +; r2/r3/r4 will be RHS for binary functions +; +.EvalFunction +bic #&FF00,r0 ; Wish I could get rid of this +mov r0,-(sp) ; Save token +cmp r0,#&C6 +bcc EvalHighFunction +.EvalFunctionByte +;add r0,r0 ; Offset into command table +asl r0 ; Offset into command table +adr FunctionTable-256,r1 ; Point to command address table +add r0,r1 ; Index into command table +add (r1),r1 ; Calculate routine address +mov (sp)+,r0 ; r0=function/operator token +jmp (r1) ; Jump to routine, r0=token, (r5)=>next char +; Mustn't skipspaces, as that means 'TO P'='TOP' and 'LOAD ATN'='LOADATN'='QUIT' + +.EvalHighFunction +adr FunctionBytes,r1 ; R1=>translation table +mov #&C6,r0 ; R0=effective token number &C6+ +.EvalHighFunctionLp +cmpb (r1)+,(sp) ; Compare with stacked token byte +beq EvalFunctionByte ; High token matches, use translated token +inc r0 +tstb (r1) ; Look for zero terminator +bne EvalHighFunctionLp ; Loop through high numbered tokens +jmp errNoSuchVar + + +; UnstackStringDropOp - Pop a stacked string +; ========================================== +.UnstackStringDropOp +; On entry, sp=> retaddr, op, type+length, string... +mov (sp)+,(sp) ; Overwrite op with return address + + +; UnstackString - Pop a stacked string +; ==================================== +; On entry, sp=> retaddr, type+length, string... +; On exit, r4=string start +; r3=string length +; r2=type+length +; r1=preserved +; r0=preserved +; +.UnstackString +mov sp,r3 ; Point to stack +add #4,r3 ; Point to stacked string + ; Must prevent SP from being odd +mov 2(sp),r2 ; Get type+length +jsr pc,CopyString ; Copy string from r3 to string buffer +mov 2(sp),r2 ; r2=string type+length +mov (sp)+,-(r3) ; Get return address and restack it +mov r3,sp ; Update SP +mov r2,r3 ; Copy type+length to r3 +bic #&FF00,r3 ; r3=length of string +rts pc ; r1=preserved, r0=preserved + +; Ensure string R4=>string R3=length is in string buffer +; ------------------------------------------------------ +.EnsureString +mov r3,r2 ; r2=length +mov r4,r3 ; r3=string start + +; Copy string to string buffer +; ---------------------------- +.CopyString +adr SV_STRING,r4 ; Point to string buffer +bic #&FF00,r2 ; Remove type from type+length +beq CopyStringDone ; Zero-length string +.CopyStringLp +movb (r3)+,(r4)+ ; Copy bytes from stack +dec r2 +bne CopyStringLp ; Loop to 'pop' all characters +inc r3 +bic #1,r3 ; Align stack pointer +.CopyStringDone +adr SV_STRING,r4 ; r4=start of string +rts pc + + +; UnstackDropStringOp - Drop a stacked string +; =========================================== +; On entry, sp=> retaddr, dummy, type+length, string... +; On exit, r4=preserved +; r3=corrupted +; r2=corrupted +; r1=preserved +; r0=preserved +; +.UnstackDropStringOp +mov (sp)+,r2 ; Get return address +mov 2(sp),r3 ; Get stack string type+length +bic #&FF00,r3 ; Remove type +add #5,r3 ; Point past stacked data +bic #1,r3 ; Ensure even address +add r3,sp ; Point stack past stacked string +jmp (r2) ; Return to caller + + +; SwapStack/SwapStackMin +; ====================== +; On entry, sp=>retadr, retadr, r2, r4, r3 +; r2/r3/r4=value +; r0=token +; On exit, r2/r3/r4 and stacked values swapped +; +.SwapStackInt +cmp r3,8(sp) +bcs SwapStack ; Swap smallest integer into registers +rts pc +.SwapStackMin +cmp r2,4(sp) ; Compare exponents +bcs SwapStackDone ; r2/r3/r4 value already smallest +.SwapStack +mov 4(sp),r1 +mov r2,4(sp) +mov r1,r2 ; Swap r2 and stacked r2 +mov 8(sp),r1 +mov r3,8(sp) +mov r1,r3 ; Swap r3 and stacked r3 +mov 6(sp),r1 +mov r4,6(sp) +mov r1,r4 ; Swap r4 and stacked r4 +.SwapStackDone +rts pc + + +.errTypeMis2 +jmp errTypeMismatch + diff --git a/src/Startup b/src/Startup new file mode 100644 index 0000000..6027e63 --- /dev/null +++ b/src/Startup @@ -0,0 +1,322 @@ +; > Startup +; BBC BASIC for the pdp11 +; (C)J.G.Harston 1988, 1989, 2005-2018 +; Program header and BASIC startup, etc. +; 18-Mar-2024 Restructured ImmLineNum and InsLine to use new return from Tokeniser. + + +#ifdef STARTADDR +ORG STARTADDR ; If start address specified, use it +#else +ORG 0 ; Otherwise, position independent code + +EQUW &0107 ; Magic number &o000407, also branch to Startup +EQUW CodeEnd-Startup ; size of text +EQUW DataEnd-CodeEnd ; size of initialised data +EQUW BasicEnd-DataEnd ; size of uninitialised data +EQUW &0000 ; size of symbol data +EQUW Startup-Startup ; entry point +EQUW &0000 ; not used +EQUW &0001 ; no relocation info +; +ORG 0 ; Position independent code +#endif + +#ifdef UNIXBASE +ORG UNIXBASE ; If start address specified, use it +#endif + +._TEXT% +._ENTRY% +.Startup +; On entry, SP=>initial stack, R7=Startup +; Unix: R0-R5=0 +; R6=>pointers to command line strings, terminated with 0, +; then command line strings +; R5= Environment flag +; Normally, header will not have been loaded and memory will +; be mapped so Startup=&0000 +; RT11: R2=stack top? +; R5=top of memory? +; +; When run in BBC environment, +; R5=&0BBC +; R0=1 if entered as a language +; If R0=1, CC=RESET, CS=OSCLI +; +; Unix Loader clears system variables. Not strictly needed as all system +; variables are initialised at some point (eg CLEAR, etc.). +; CALL 0 will not re-enter BASIC, as it will look for another filename on +; the stack. +; +jsr pc,IO_Init ; Initialise I/O, find memory limits, command line, etc. +.Restart +mov r0,SV_PAGE ; Put initial PAGE at bottom of memory +mov r1,SV_HIMEM ; Put initial HIMEM at top of memory +mov r1,sp ; Put stack at top of memory +mov #&090A,SV_VARS ; @%=&90A +adr StartupCopyright-1,r0 ; Get location of (C) message +mov r0,SV_FAULT ; Point REPORT to it +;jsr pc,IO_ReadTime ; Read raw system time to R0:R1 +;mov r0,SV_RAND+0 ; Set RND seed +;mov r1,SV_RAND+2 +mov #1,r0 ; R0=1 - Read TIME +adr SV_RAND,r1 +jsr pc,IO_WORD ; Set RND seed from system time +clr SV_WIDTH ; Clear WIDTH and COUNT +clr SV_OPTIONS ; Clear OPTIONS and ERR +clr SV_TRACE ; Turn TRACE off +tstb SV_SYS ; Test QUIT flag +bmi jmpRunProgram ; QUIT set, run embedded program +adr SV_STRING,r4 +cmpb (r4),#13 ; Get first character from string buffer +beq StartupNull ; Command line="", nothing to chain +bisb #&80,SV_SYS ; Set QUIT flag +jmp ChainStartup ; Jump to do CHAIN "filename" +; *NB* need to ensure R5=> for endofstatement check to work when added +.jmpRunProgram +jsr pc,FindTOP ; Set program pointers, R5=>end of program +jmp RunProgram ; Run program + +.StartupNull +jsr pc,PrintInline +.StartupMessage +EQUS "PDP11 BBC BASIC IV Version " +EQUB ((VERSION >> 8) AND 15)+48 +EQUS "." +EQUB ((VERSION >> 4) AND 15)+48 +EQUB (VERSION AND 15)+48 +#ifdef BUILD + #if BUILD + EQUB 96+BUILD + #endif +#endif +#ifdef OSNAME$ + EQUS " (",OSNAME$,")" +#endif +#ifdef DEBUG + EQUS " debug" +#endif +EQUB 13 +.StartupCopyright +EQUS "(C) Copyright J.G.Harston 1989-",YEAR$,13 +EQUB 0 +ALIGN + +; NEW - Terminate program in memory +; --------------------------------- +; PAGE?0=13 +; PAGE?1=255 +; TOP=PAGE+2 +; Clear heap: LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE +; Clear dynamic variables +; STACK=HIMEM +; Continue into immediate mode +.cmdNEW +mov SV_PAGE,r0 ; Get start of program +mov #&FF0D,(r0)+ ; Put in program terminator +mov r0,SV_TOP ; Set TOP + +; Immediate mode +; -------------- +.ImmediateClearStop +clr SV_AUTO ; Clear AUTO line +.ImmediateClear ; Clear heap and initialise variable addresses +jsr pc,VarsHeapInit ; LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE, STACK=HIMEM +.ImmediateLoop +mov SV_HIMEM,sp ; Put system stack at top of memory +clr SV_ONERR ; Cancel ON ERROR, before OSWRCH in case it errors +clr SV_LINE ; Clear current line +mov #ASC">",r0 +;jsr pc,IO_WRCH ; Print ">" prompt +mov SV_AUTO,r4 ; Get current line +beq ImmNotAuto ; No AUTO line +mov r4,-(sp) ; Save line number +movb SV_STEP,r1 ; Get AUTO STEP +bic #&FF00,r1 ; Ensure 8-bit value +add r1,r4 ; Add STEP to AUTO line +cmp #&FF00,r4 +bcs ImmediateClearStop ; Run out of line numbers +;bcs errTooBig ; Run out of line numbers +mov r4,SV_AUTO ; Store updated AUTO line +mov (sp)+,r4 ; Get line number back +mov r4,SV_LINE ; Set current line number +mov #5,r1 ; Print 5 digits +jsr pc,PrintLineNumber ; Output r4 as line number +mov #ASC" ",r0 +.ImmNotAuto +jsr pc,IO_WRCH ; Print a space or ">" prompt +;.ImmNotAuto +adr SV_STRING,r1 ; Point to string buffer +mov r1,r5 ; Prepare r5=>input line in case error occurs +; above prob. no longer needed as Error doesn't use R5 +jsr pc,IO_ReadLine ; Read a line of input and zero COUNT +;adr SV_STRING,r5 ; Point to entered string in buffer +jsr pc,TokeniseLine ; Tokenise entered line +bne ImmLineNum ; Line number, enter line +mov r4,r5 ; Get start of tokenised line to line pointer +clr -(sp) ; Push zero word at top of stack +jmp Execute ; Execute immediate line + +; OLD - Attempt to recover program in memory +; ------------------------------------------ +; PAGE?0=13 +; PAGE?1=0 +; Find TOP +; Clear heap: LOMEM=TOP, VAREND=TOP, DATAPTR=PAGE +; Clear dynamic variables +; STACK=HIMEM +; Continue into immediate mode +.cmdOLD +mov SV_PAGE,r0 ; Get start of program +mov #&000D,(r0) ; Remove program terminator +jsr pc,FindTOP ; Check program, R5=>end of program +br ImmediateClear ; Clear heap, jump to immediate mode + +; Check amount of free memory +; --------------------------- +; CheckFreeMemory - check for more than 256 bytes between heap and stack +; CheckFreeMemR1 - check for more than 256 bytes between heap and R1 +; +.CheckFreeMemory +;mov sp,r0 +mov sp,r1 +;.CheckFreeMemR0 +;sub #256,r0 +;sub SV_VAREND,r0 +.CheckFreeMemR1 +sub #256,r1 +sub SV_VAREND,r1 +bcc InsAddDone +.errNoRoom +jsr pc,Error +equb 0,"No room",0 +align + +; Enter line into program +; ----------------------- +.ImmLineNum +; R4=>start of tokenised line +; R3= length of tokenised line excluding +; R2= linenum +; +mov r4,r5 +mov r2,r4 ; R5=>source, R4=linenum, R3=length +jsr pc,FindTOP ; Ensure program consistancy, R1=TOP, R0=corrupted +add r3,r1 ; R1=TOP+linelength +add #64,r1 ; Plus a bit of overhead +sub sp,r1 ; Enough space to add line? +bcc errNoRoom ; No, generate error +jsr pc,LineFind ; Find line number, R1=insert point, R5/4/3=preserved +bne InsNewLine ; No existing line to be removed +; +; Remove existing line +; R5=>start of tokenised line to insert +; R4=line number +; R3=line length +; R2=corrupted +; R1=>insert point +; R0=corrupted +; +mov r1,-(sp) ; Save insertion point +movb 3(r1),r2 ; r2=line length +bic #&FF00,r2 +add r1,r2 ; r2=start of next line +br InsRemLineLp2 ; Branch to start by copying +.InsRemLineLp1 +movb (r2)+,(r1)+ ; Copy line number low byte +movb (r2)+,(r1)+ ; Copy line length +.InsRemLineLp2 +movb (r2)+,r0 ; Copy character from line +movb r0,(r1)+ +cmpb r0,#13 +bne InsRemLineLp2 ; Copy until byte +movb (r2)+,r0 ; Copy line number high byte +movb r0,(r1)+ +cmpb r0,#&FF ; Is it end-of-prog marker? +bne InsRemLineLp1 ; Not end of program, loop to copy more +mov r1,SV_TOP ; Update TOP, byte after &FF terminator +mov (sp)+,r1 ; Get insertion point back +; +; R5=>start of tokenised line to insert +; R4=line number +; R3=line length +; R2=xxxx +; R1=>insert point +; R0=xxxx +.InsNewLine +tst r3 +beq InsLineDone ; No new line, done +add #4,r3 ; R3=number of bytes needed to insert +mov SV_TOP,r2 +mov r2,r0 ; R0=TOP +add r3,r2 ; R2=TOP+length +mov r2,SV_TOP ; New TOP +.InsInsLine +movb -(r0),-(r2) ; Move bytes upwards +cmp r0,r1 +bne InsInsLine ; Loop until insertion point +inc r1 ; Step past initial +jsr pc,InsertLine ; Copy line at R5 into program at R1 +.InsLineDone +br ImmediateClear ; Clear heap as program modified + +; R5=>start of tokenised line to insert +; R4=line number +; R3=line length +; R2=xxxx +; R1=>insert point - return updated +; R0=xxxx +.InsertLine +swab r4 +movb r4,(r1)+ ; Line number high byte +swab r4 +movb r4,(r1)+ ; Line number low byte +movb r3,(r1)+ ; Line length +.InsAddLine +movb (r5)+,r0 ; Copy byte from input line +movb r0,(r1)+ ; to program space +cmpb r0,#13 +bne InsAddLine ; Loop until +.InsAddDone +rts pc + +.errTooBig +jsr pc,Error +equb 20,"Too big",0 +align + +; Parse line number parameters +; ---------------------------- +; On entry, r4=default first parameter +; r3=default second parameter +; On exit, r4=first parameter +; r3=second parameter +; CC=only one parameter +; CS=zero or two parameters +; +.ParseLines10 +mov #10,r4 +mov r4,r3 ; Default to 10,10 +.ParseLines +jsr pc,CheckEndStatement ; Any parameters? +beq ParseLinesDone ; No, use defaults +mov r3,-(sp) ; Save second default +jsr pc,ReadLineNumber ; r4/r3=start line number +bcs errTooBig ; *NB* 6502 BASIC gives Syntax error here +mov (sp)+,r3 ; Get second default back +jsr pc,SkipSpaceThis +cmpb r0,#ASC"," +clc ; CC=one parameter +bne ParseLinesOne ; No second parameter +inc r5 ; Step past comma +mov r4,-(sp) +jsr pc,ReadLineNumber ; r4/r3=end line number/step +bcs errTooBig ; *NB* 6502 BASIC gives Syntax error here +mov r4,r3 +mov (sp)+,r4 +.ParseLinesDone +sec ; CS=zero or two parameters +.ParseLinesOne +rts pc + diff --git a/src/SysVars b/src/SysVars new file mode 100644 index 0000000..fc57320 --- /dev/null +++ b/src/SysVars @@ -0,0 +1,112 @@ +; > SysVars +; System Variables +; +; 10-Feb-2013: Unix vectors moved to UnixIO +; 15-Aug 2018: MOS_BUF moved to fix alignment + + +.SV_PAD equm 256-((SV_PAD+6)AND255) ; 6=SV_STRING-SV_PAD, forward reference + + +; Misc. put here to align PAGE-SV_VARS +; ------------------------------------ +.SV_RAND equd &00000000 ; RND seed Startup +.SV_RAND4 equb &00 ; Fifth byte of RND seed Startup +.SV_STEP equb &00 ; AUTO step, SV_STRING-1 used for TIME$= call AUTO + +; String buffers +; -------------- +.SV_STRING equm 256 ; String accumulator, immediate entry buffer, fixed at PAGE-&300 +.SV_INPUT equm 256 ; Command buffer, tokenised immediate entry written here + +.MOS_BUF equ SV_INPUT+256-18 ; Put at top of command buffer +.FILE_NAME equ MOS_BUF+0 +.FILE_LOAD equ MOS_BUF+2 +.FILE_EXEC equ MOS_BUF+6 +.FILE_LENGTH equ MOS_BUF+10 +.FILE_START equ MOS_BUF+10 +.FILE_ATTR equ MOS_BUF+14 +.FILE_END equ MOS_BUF+14 + +; Static variables and heap pointers +; ---------------------------------- +.SV_VARS equd &00000000 ; @% + equm 26*4 ; A%-Z% +.SV_INT_O equ SV_VARS+&3C ; O% +.SV_INT_P equ SV_VARS+&40 ; P% +.SV_VARPTR equm 26*2 ; A-Z pointers +.SV_PROCPTR equw &0000 ; [ -> PROC pointer +.SV_FNPTR equw &0000 ; \ -> FN pointer +.SV_STRPTR equw &0000 ; ] -> Unused strings pointer +.SV_SYSPTR equw &0000 ; ^ -> unused pointer - could point to something + equw &0000 ; _ pointer + equw &0000 ; ` pointer + equm 26*2 ; a-z pointers +.SV_ENDPTR + +; Memory structure Initialised by +; ---------------- +.SV_PAGE equw &0000 ; PAGE - start of BASIC program Startup +.SV_TOP equw &0000 ; End of BASIC program VarHeapInit +.SV_LOMEM equw &0000 ; Start of BASIC variable area VarHeapInit +.SV_VAREND equw &0000 ; End of BASIC variable area VarHeapInit +.SV_STACK equw &0000 ; Bottom of BASIC stack - restored SP on local error Immediate +.SV_HIMEM equw &0000 ; Top of BASIC stack/memory Startup + +; Program lines +; ------------- +.SV_LINE equw &0000 ; Current line number Immediate +.SV_TRACE equw &0000 ; TRACE line number ErrorHandler +.SV_AUTO equw &0000 ; AUTO line number Startup +.SV_ERL equw &0000 ; Line number error occured in ErrorHandler + +; Program pointers +; ---------------- +.SV_FAULT equw &0000 ; Last error Startup +.SV_ONERR equw &0000 ; Points to after ON ERROR Immediate +.SV_DATA equw &0000 ; DATA pointer NEW/RUN + +; Misc. +; ----- +.SV_WIDTH equb &00 ; WIDTH Startup +.SV_COUNT equb &00 ; COUNT Startup +.SV_OPTIONS equb &00 ; LISTO and OPT options Startup +.SV_ERR equb &00 ; ERR Startup +.SV_SYS equb &00 ; System flags IO_Init + ; b7-b4 generic flags + ; b7=quit after running program + ; b6=embedded program + ; b5=BBC EMT calls available + ; b4=Escape disabled + ; b3-b0 platform specific flags + ; Unix RT11 + ; b3 \ b3= + ; b2 } (Unix version)-5 b2= + ; b1 / b1= + ; b0=fd0 stdin not a tty b0= + ; b3-b1=00x - no Unix v7 calls: + ; 16-bit seek(), no ioctl() use stty(), one-second timer + ; <>00x - Unix v7 calls: + ; 32-bit seek(), ioctl() available, millisecond timer + ; <>11x - Bell Unix API (inline parameters) + ; 11x - BSD Unix API (stacked parameters) +; 00x - inline API, 16-bit seek, stty, raw, one-second time, polled escape +; 01x - inline API, 24-bit seek, ioctrl, cooked, millisecond timer, background escape +; 10x - inline API, 24-bit seek, ioctrl, cooked, millisecond timer, background escape +; 11x - stacked API, 24-bit seek, ioctrl, cooked, millisecond timer, background escape +; +.FLG_QUIT equ &80 +.FLG_EMBED equ &40 +.FLG_BBCEMT equ &20 +.FLG_ESCAPE equ &10 +.SV_ESCFLG equb &00 ; Escape flag IO_Init +ALIGN + +; end of 'bss' section +.BasicEnd ; End of 'uninitialised data' section +._END% + +.DefaultPAGE +#if DefaultPAGE-SV_VARS<>&100 #error PAGE must be SV_VARS+&100 +#if DefaultPAGE-SV_STRING<>&300 #error PAGE must be SV_STRING+&300 +#ifdef SV_PAD #if (DefaultPAGE AND &FF)<>0 #error PAGE not page aligned diff --git a/src/TokenEqus b/src/TokenEqus new file mode 100644 index 0000000..f0a7e25 --- /dev/null +++ b/src/TokenEqus @@ -0,0 +1,148 @@ +; > TokenEqus +; Token Value Equates + +; Binary operators +.tknAND equ &80 +.tknDIV equ &81 +.tknEOR equ &82 +.tknMOD equ &83 +.tknOR equ &84 +; Punctuation +.tknERROR equ &85 +.tknLINE equ &86 +.tknOFF equ &87 +.tknSTEP equ &88 +.tknSPC equ &89 +.tknTAB equ &8A +.tknELSE equ &8B +.tknTHEN equ &8C +.tknMissing equ &8D +; Numeric Functions +.tknLINENUM equ &8D +.tknOPENIN equ &8E +; Pseudo-variable functions +.tknPTRfn equ &8F +.tknPAGEfn equ &90 +.tknTIMEfn equ &91 +.tknLOMEMfn equ &92 +.tknHIMEMfn equ &93 +; Numeric functions +.tknABS equ &94 +.tknACS equ &95 +.tknADVAL equ &96 +.tknASC equ &97 +.tknASN equ &98 +.tknATN equ &99 +.tknBGET equ &9A +.tknCOS equ &9B +.tknCOUNT equ &9C +.tknDEG equ &9D +.tknERL equ &9E +.tknERR equ &9F +.tknEVAL equ &A0 +.tknEXP equ &A1 +.tknEXT equ &A2 +.tknFALSE equ &A3 +.tknFN equ &A4 +.tknGET equ &A5 +.tknINKEY equ &A6 +.tknINSTR equ &A7 +.tknINT equ &A8 +.tknLEN equ &A9 +.tknLN equ &AA +.tknLOG equ &AB +.tknNOT equ &AC +.tknOPENUP equ &AD +.tknOPENOUT equ &AE +.tknPI equ &AF +.tknPOINT equ &B0 +.tknPOS equ &B1 +.tknRAD equ &B2 +.tknRND equ &B3 +.tknSGN equ &B4 +.tknSIN equ &B5 +.tknSQR equ &B6 +.tknTAN equ &B7 +.tknTO equ &B8 +.tknTRUE equ &B9 +.tknUSR equ &BA +.tknVAL equ &BB +.tknVPOS equ &BC +; String functions +.tknCHRs equ &BD +.tknGETs equ &BE +.tknINKEYs equ &BF +.tknLEFTs equ &C0 +.tknMIDs equ &C1 +.tknRIGHTs equ &C2 +.tknSTRs equ &C3 +.tknSTRINGs equ &C4 +; +.tknEOF equ &C5 +; Immediate commands +.tknAUTO equ &C6 +.tknDELETE equ &C7 +.tknLOAD equ &C8 +.tknLIST equ &C9 +.tknNEW equ &CA +.tknOLD equ &CB +.tknRENUMBER equ &CC +.tknSAVE equ &CD +.tknEDIT equ &CE +; Pseudo variable commands +.tknPTRcmd equ &CF +.tknPAGEcmd equ &D0 +.tknTIMEcmd equ &D1 +.tknLOMEMcmd equ &D2 +.tknHIMEMcmd equ &D3 +; Commands +.tknSOUND equ &D4 +.tknBPUT equ &D5 +.tknCALL equ &D6 +.tknCHAIN equ &D7 +.tknCLEAR equ &D8 +.tknCLOSE equ &D9 +.tknCLG equ &DA +.tknCLS equ &DB +.tknDATA equ &DC +.tknDEF equ &DD +.tknDIM equ &DE +.tknDRAW equ &DF +.tknEND equ &E0 +.tknENDPROC equ &E1 +.tknENVELOPE equ &E2 +.tknFOR equ &E3 +.tknGOSUB equ &E4 +.tknGOTO equ &E5 +.tknGCOL equ &E6 +.tknIF equ &E7 +.tknINPUT equ &E8 +.tknLET equ &E9 +.tknLOCAL equ &EA +.tknMODE equ &EB +.tknMOVE equ &EC +.tknNEXT equ &ED +.tknON equ &EE +.tknVDU equ &EF +.tknPLOT equ &F0 +.tknPRINT equ &F1 +.tknPROC equ &F2 +.tknREAD equ &F3 +.tknREM equ &F4 +.tknREPEAT equ &F5 +.tknREPORT equ &F6 +.tknRESTORE equ &F7 +.tknRETURN equ &F8 +.tknRUN equ &F9 +.tknSTOP equ &FA +.tknCOLOUR equ &FB +.tknCOLOR equ &FB +.tknTRACE equ &FC +.tknUNTIL equ &FD +.tknWIDTH equ &FE +.tknOSCLI equ &FF + +; &C8,&xx double-byte tokens +.tknQUIT equ &98 +.tknSYS equ &99 + diff --git a/src/Tokens b/src/Tokens new file mode 100644 index 0000000..a7181b2 --- /dev/null +++ b/src/Tokens @@ -0,0 +1,626 @@ +; > Tokens +; Token table - ok +; Tokeniser - ok +; Detokeniser - ok +; 08-Mar-2009: Tokeniser sped up using offsets for each initial letter, linenums tokenised. +; 09-Mar-2009: LineFind written. +; Tokeniser can be sped up if search terminates when initial letter no longer matches +; 24-Jul-2013: Fixed bug where '*' turned off tokenising in middle of statement +; 07-Dec-2013: TokenFind written. +; 14-Jul-2017: Tokeniser optimised, returns R3=length, R4=>string to match rest of interpreter +; 08-May-2020: TokenFind doesn't skip at end of zero-length lines. +; 09-May-2020: PROC@LOAD, FN@SAVE allowed - @ is valid identifier character. +; IF thing THEN var=1:IF thing THEN =1 doesn't tokenise the number +; Tokeniser optimised by calling EvalCheckDigit and VarCheckChar. +; 18-Mar-2024: Added SLOWTOKEN option, spaces don't reset tokeniser so ON ERROR PAGE= works. +; 27-Apr-2025: End of hex string steps back so, eg &12OR3 tokenises correctly. +; 25-Nov-2025: Bit of optimisation of tokeniser when token matched. +; REM/DATA only turn tokeniser off at start of statement, allows LOCAL DATA:... +; Two-byte tokens possible. + +; Acorn-style token table +; ======================= +; string, token, flag +; +; Token flag: +; Bit 0 - Conditional tokenisation (don't tokenise if followed by an alphabetic character). +; Bit 1 - Not start of statement. +; Bit 2 - Now middle of statement (command with parameters) +; Bit 3 - Expect a line number (after a GOTO, etc...). +; Bit 4 - Pseudo variable - add &40 token if at start of statement (external: hex number). +; Bit 5 - FN/PROC keyword - don't tokenise name of the subroutine. +; Bit 6 - Don't tokenise rest of line (REM, DATA, etc...) +; Bit 7 - 2-byte token (external: quote toggle) + +.TokenTable +.tknA EQUB "AND" ,&80,&02 ; 00000010 + EQUB "ABS" ,&94,&02 ; 00000010 + EQUB "ACS" ,&95,&02 ; 00000010 + EQUB "ADVAL" ,&96,&02 ; 00000010 + EQUB "ASC" ,&97,&02 ; 00000010 + EQUB "ASN" ,&98,&02 ; 00000010 + EQUB "ATN" ,&99,&02 ; 00000010 + EQUB "AUTO" ,&C6,&02 ; 00000010 ; was &0A +.tknB EQUB "BGET" ,&9A,&03 ; 00000011 + EQUB "BPUT" ,&D5,&07 ; 00000111 +.tknC EQUB "COLOUR" ,&FB,&06 ; 00000110 + EQUB "CALL" ,&D6,&06 ; 00000110 + EQUB "CHAIN" ,&D7,&06 ; 00000110 + EQUB "CHR$" ,&BD,&02 ; 00000010 + EQUB "CLEAR" ,&D8,&03 ; 00000011 + EQUB "CLOSE" ,&D9,&07 ; 00000111 + EQUB "CLG" ,&DA,&03 ; 00000011 + EQUB "CLS" ,&DB,&03 ; 00000011 + EQUB "COS" ,&9B,&02 ; 00000010 + EQUB "COUNT" ,&9C,&03 ; 00000011 + EQUB "COLOR" ,&FB,&06 ; 00000110 +.tknD EQUB "DATA" ,&DC,&42 ; 01000010 + EQUB "DEG" ,&9D,&02 ; 00000010 + EQUB "DEF" ,&DD,&02 ; 00000010 + EQUB "DELETE" ,&C7,&02 ; 00000010 ; was &0A + EQUB "DIV" ,&81,&02 ; 00000010 + EQUB "DIM" ,&DE,&06 ; 00000110 + EQUB "DRAW" ,&DF,&06 ; 00000110 +.tknE EQUB "ENDPROC" ,&E1,&03 ; 00000011 + EQUB "END" ,&E0,&03 ; 00000011 + EQUB "ENVELOPE",&E2,&06 ; 00000110 + EQUB "ELSE" ,&8B,&08 ; 00001000 + EQUB "EVAL" ,&A0,&02 ; 00000010 + EQUB "ERL" ,&9E,&03 ; 00000011 + EQUB "ERROR" ,&85,&00 ; 00000000 + EQUB "EOF" ,&C5,&03 ; 00000011 + EQUB "EOR" ,&82,&02 ; 00000010 + EQUB "ERR" ,&9F,&03 ; 00000011 + EQUB "EXP" ,&A1,&02 ; 00000010 + EQUB "EXT" ,&A2,&03 ; 00000011 +; EQUB "EDIT" ,&CE,&02 ; 00000010 ; was &0A +.tknF EQUB "FOR" ,&E3,&06 ; 00000110 + EQUB "FALSE" ,&A3,&03 ; 00000011 + EQUB "FN" ,&A4,&22 ; 00100010 +.tknG EQUB "GOTO" ,&E5,&0E ; 00001110 + EQUB "GET$" ,&BE,&02 ; 00000010 + EQUB "GET" ,&A5,&02 ; 00000010 + EQUB "GOSUB" ,&E4,&0E ; 00001110 + EQUB "GCOL" ,&E6,&06 ; 00000110 +.tknH EQUB "HIMEM" ,&93,&17 ; 00010111 +.tknI EQUB "INPUT" ,&E8,&06 ; 00000110 + EQUB "IF" ,&E7,&06 ; 00000110 + EQUB "INKEY$" ,&BF,&02 ; 00000010 + EQUB "INKEY" ,&A6,&02 ; 00000010 + EQUB "INT" ,&A8,&02 ; 00000010 + EQUB "INSTR(" ,&A7,&02 ; 00000010 +.tknJ +.tknK +.tknL EQUB "LIST" ,&C9,&02 ; 00000010 ; was &0A + EQUB "LINE" ,&86,&02 ; 00000010 + EQUB "LOAD" ,&C8,&06 ; 00000110 + EQUB "LOMEM" ,&92,&17 ; 00010111 + EQUB "LOCAL" ,&EA,&06 ; 00000110 + EQUB "LEFT$(" ,&C0,&02 ; 00000010 + EQUB "LEN" ,&A9,&02 ; 00000010 + EQUB "LET" ,&E9,&00 ; 00000000 + EQUB "LOG" ,&AB,&02 ; 00000010 + EQUB "LN" ,&AA,&02 ; 00000010 +.tknM EQUB "MID$(" ,&C1,&02 ; 00000010 + EQUB "MODE" ,&EB,&06 ; 00000110 + EQUB "MOD" ,&83,&02 ; 00000010 + EQUB "MOVE" ,&EC,&06 ; 00000110 +.tknN EQUB "NEXT" ,&ED,&06 ; 00000110 + EQUB "NEW" ,&CA,&03 ; 00000011 + EQUB "NOT" ,&AC,&02 ; 00000010 +.tknO EQUB "OLD" ,&CB,&03 ; 00000011 + EQUB "ON" ,&EE,&06 ; 00000110 + EQUB "OFF" ,&87,&02 ; 00000010 + EQUB "OR" ,&84,&02 ; 00000010 + EQUB "OPENIN" ,&8E,&02 ; 00000010 + EQUB "OPENOUT" ,&AE,&02 ; 00000010 + EQUB "OPENUP" ,&AD,&02 ; 00000010 + EQUB "OSCLI" ,&FF,&06 ; 00000110 +.tknP EQUB "PRINT" ,&F1,&06 ; 00000110 + EQUB "PAGE" ,&90,&17 ; 00010111 + EQUB "PTR" ,&8F,&17 ; 00010111 + EQUB "PI" ,&AF,&03 ; 00000011 + EQUB "PLOT" ,&F0,&06 ; 00000110 + EQUB "POINT(" ,&B0,&02 ; 00000010 + EQUB "PROC" ,&F2,&26 ; 00100110 + EQUB "POS" ,&B1,&03 ; 00000011 + EQUB "PUT" ,&CE,&02 ; 00000010 +.tknQ +; EQUB "QUIT" ,&98,&86 ; 10000110 +.tknR EQUB "RETURN" ,&F8,&03 ; 00000011 + EQUB "REPEAT" ,&F5,&02 ; 00000010 + EQUB "REPORT" ,&F6,&03 ; 00000011 + EQUB "READ" ,&F3,&06 ; 00000110 + EQUB "REM" ,&F4,&42 ; 01000010 + EQUB "RUN" ,&F9,&03 ; 00000011 + EQUB "RAD" ,&B2,&02 ; 00000010 + EQUB "RESTORE" ,&F7,&0E ; 00001110 + EQUB "RIGHT$(" ,&C2,&02 ; 00000010 + EQUB "RND" ,&B3,&03 ; 00000011 + EQUB "RENUMBER",&CC,&02 ; 00000010 ; was &0A +.tknS EQUB "STEP" ,&88,&02 ; 00000010 + EQUB "SAVE" ,&CD,&06 ; 00000110 + EQUB "SGN" ,&B4,&02 ; 00000010 + EQUB "SIN" ,&B5,&02 ; 00000010 + EQUB "SQR" ,&B6,&02 ; 00000010 + EQUB "SPC" ,&89,&02 ; 00000010 + EQUB "STR$" ,&C3,&02 ; 00000010 + EQUB "STRING$(",&C4,&02 ; 00000010 + EQUB "SOUND" ,&D4,&06 ; 00000110 + EQUB "STOP" ,&FA,&03 ; 00000011 +; EQUB "SYS" ,&99,&86 ; 10000110 +.tknT EQUB "TAN" ,&B7,&02 ; 00000010 + EQUB "THEN" ,&8C,&08 ; 00001000 + EQUB "TO" ,&B8,&02 ; 00000010 + EQUB "TAB(" ,&8A,&02 ; 00000010 + EQUB "TRACE" ,&FC,&0E ; 00001110 + EQUB "TIME" ,&91,&17 ; 00010111 + EQUB "TRUE" ,&B9,&03 ; 00000011 +.tknU EQUB "UNTIL" ,&FD,&06 ; 00000110 + EQUB "USR" ,&BA,&02 ; 00000010 +.tknV EQUB "VDU" ,&EF,&06 ; 00000110 + EQUB "VAL" ,&BB,&02 ; 00000010 + EQUB "VPOS" ,&BC,&03 ; 00000011 +.tknW EQUB "WIDTH" ,&FE,&06 ; 00000110 + EQUB "PAGE" ,&D0,&02 ; 00000010 + EQUB "PTR" ,&CF,&02 ; 00000010 + EQUB "TIME" ,&D1,&02 ; 00000010 + EQUB "LOMEM" ,&D2,&02 ; 00000010 + EQUB "HIMEM" ,&D3,&02 ; 00000010 + EQUB "Missing ",&8D,&00 ; 00000000 + EQUB &00 + ALIGN +#ifndef SLOWTOKEN +.TokenOffsets +EQUW tknA-TokenTable +EQUW tknB-TokenTable +EQUW tknC-TokenTable +EQUW tknD-TokenTable +EQUW tknE-TokenTable +EQUW tknF-TokenTable +EQUW tknG-TokenTable +EQUW tknH-TokenTable +EQUW tknI-TokenTable +EQUW tknJ-TokenTable +EQUW tknK-TokenTable +EQUW tknL-TokenTable +EQUW tknM-TokenTable +EQUW tknN-TokenTable +EQUW tknO-TokenTable +EQUW tknP-TokenTable +EQUW tknQ-TokenTable +EQUW tknR-TokenTable +EQUW tknS-TokenTable +EQUW tknT-TokenTable +EQUW tknU-TokenTable +EQUW tknV-TokenTable +EQUW tknW-TokenTable +#endif + +.TokeniseEVAL +mov r4,-(sp) ; Save destination +mov #2,r2 ; Set flags to 'within statement' +br TokenLoop + +; Tokenise entered line and line number +; ------------------------------------- +; On entry, r5=>untokenised source, may have leading spaces +; On exit, R5=>after at end of input line +; R4=>start of tokenised line +; R3= length of tokenised line excluding +; R2= line number, EQ/NE set +; +.TokeniseLine +jsr pc,ReadLineNumber ; r4=line number (CC) or zero (CS) +bcs TokeniseLineNoNum ; No line number entered +mov r4,SV_LINE ; Set current input line number +.TokeniseLineNoNum ; r5=>start or line or after line number +adr SV_INPUT,r4 ; r4=>dest in input buffer + ; Fall through into tokeniser + +; Tokeniser +; ========= +; On entry, R5=>untokenised text +; R4=>destination buffer +; Enter at Tokenise - use LISTO options +; TokenStrip - strip leading spaces +; TokenNoStrip - keep leading spaces +; Uses R3=>token table address +; R2= current tokeniser flags +; R1= new tokeniser flags +; R0= character +; On exit, R5=>after at end of input line +; R4=>start of tokenised line +; R3= length of tokenised line excluding +; R2= line number, EQ/NE +; +.Tokenise +movb SV_OPTIONS,r0 +beq TokenNoStrip ; LISTO=0, don't strip leading spaces +.TokeniseStrip +cmpb (r5)+,#ASC" " +beq TokeniseStrip ; Skip leading spaces +dec r5 +.TokenNoStrip +mov r4,-(sp) ; Save destination +.TokenZero +clr r2 ; Clear tokeniser flags +.TokenNext +.TokenLoop +movb (r5)+,r0 ; Get current character +cmp r0,#9 +beq TokenNext ; Skip any embedded TABs +dec r5 ; Point to current character +bit #&F0,r2 ; Any skip flags set? +bne TokenByte ; Inside quote/REM/PROCFN/hex +bit #&08,r2 ; Is a line number expected? +beq TokenNotLine ; No, try to tokenise +jsr pc,TokeniseNumber ; Tokenise line number +; CC=not a number, r5=>this character, r0=character +; CS=number entered, r5=>next character +bcs TokenLoop +.TokenNotLine +cmp r0,#ASC"A" ; Tokens start with a letter +bcs TokenByte ; <'A', enter character +cmp r0,#ASC"X" +bcc TokenByte ; >'W', enter character +jsr pc,TokenSearch ; Search token table + ; Returns r5=>before next character + ; r4= unchanged, output pointer + ; r2= unchanged, current tokeniser flags + ; r1= new tokeniser flag + ; r0= byte to enter, token or char +;bpl TokenWord0 ; Not a two-byte token +;movb #&C8,(r4)+ ; Insert prefix byte +;bic #128,r1 +;.TokenWord0 +bit #2,r2 ; Are we at the start of statement? +bne TokenWord1 ; No, enter token/char +bit #16,r1 ; Is this a pseudo-variable? +beq TokenWord2 ; No, enter unchanged +add #&40,r0 ; Convert token to command token +.TokenWord1 +bic #&40,r2 ; Middle of statement, don't turn tokeniser off +.TokenWord2 +mov r1,r2 ; Copy new flags to current flags +.TokenByte +inc r5 ; Increment input pointer +movb r0,(r4)+ ; Enter byte in output buffer +bmi TokenLoop ; Token entered, loop back +cmp r0,#ASC" " ; At end of line? +beq TokenSpace ; Terminate PROC/FN, hex, LineNum +bcc TokenNotCR ; Not end of line, jump to check character +;movb SV_OPTIONS,r0 +;beq TokenLineEnd ; LISTO=0, don't strip trailing spaces +;strip trailing spaces +; +.TokenLineEnd +movb #&FF,(r4) ; Put &FF after +movb #13,-(r4) ; Ensure terminator + ; R5=>after at end of source, for textload +mov r4,r3 ; R3=>end of string +mov (sp)+,r4 ; R4=>start of string +sub r4,r3 ; R3=length of string +mov SV_LINE,r2 ; R2=line number, EQ/NE set +rts pc + +.TokenNotCR +cmp r0,#34 ; Is char quote? +bne TokenNotQuote ; No, jump to next check +add #128,r2 ; Toggle quote flag +br TokenLoop ; Loop back to continue tokenising + +.TokenNotQuote +bit #&C0,r2 ; Inside quotes or REM/DATA/*cmd? +bne TokenLoop ; Loop back, ignoring character +cmp r0,#&3A ; Is char colon? +beq TokenZero ; Loop back to reset to start of statement + +cmp r0,#ASC"*" ; Is char star? +bne TokenNotStar ; No, jump to next check +bit #&02,r2 ; At start of statement? +bne TokenLoop ; No, treat as normal character +mov #&40,r2 ; Treat rest of line as comment +br TokenLoop ; Jump back to continue scanning line + +.TokenNotStar +bis #&02,r2 ; Set 'not at start of statement' +cmp r0,#ASC"&" ; Is char hex number? +bne TokenNotHex ; No, jump to next check +mov #&10,r2 ; Set 'scanning hex number' +br TokenLoop ; Continue scanning line + +.TokenNotHex +bit #&20,r2 ; Scanning PROC/FN? +bne TokenPROCFN +bit #&10,r2 ; Scanning hex? +bne TokenHex +cmp #ASC"@",r0 ; Digits and punctuation, continue scanning +br TokenCheckEnd +.TokenHex +jsr pc,CheckHexDigit ; Keep going through hex digits +bcc TokenLoop ; Still a hex character +dec r5 ; Step back so eg &12OR3 tokenises +dec r4 +br TokenSpace +.TokenPROCFN +jsr pc,VarChkChar ; Still identifier, continue scanning +.TokenCheckEnd +bcc TokenLoop ; Loop for next PROC/FN, Hex, LineNum character +.TokenSpace +bic #&30,r2 ; Clear PROC/FN, Hex flags +br TokenLoop + +.TokeniseNumber +mov r4,-(sp) ; Save output pointer +jsr pc,ReadLineNumberHere ; Read number to R3/R4, already skipped spaces +mov r4,r1 ; R1=line number +mov (sp)+,r4 ; Get output pointer back +bcs TokenNotNumber ; Not a valid line number, not a digit or too big +mov r1,r2 +movb #&8D,(r4)+ ; Line number marker +swab r2 +ror r2 +ror r2 +bic #&FFCF,r2 +mov r1,r0 +bic #&FF3F,r0 +bis r0,r2 +ror r2 +ror r2 +mov #&14,r0 +xor r0,r2 +mov #3,r0 +swab r1 +br TokenNumLp2 +.TokenNumLp1 +mov r1,r2 +bic #&FFC0,r2 +.TokenNumLp2 +bis #&40,r2 +movb r2,(r4)+ +swab r1 +dec r0 +bne TokenNumLp1 +;mov r4,r4 ; Update output pointer +mov #8,r2 ; Still expecting numbers +sec ; CS=line number returned +rts pc +.TokenNotNumber +clc ; CC=no line number +rts pc + +; Search token table +; ================== +; On entry, R5=>input string to match +; R4=>dest +; R2= current flags +; R0= current char +; On exit, R5=>last char +; R4=unchanged +; R3 corrupted +; R2=old flags +; R1=new flags +; R0=token or character +; if token matched, R0=token, R5=>end of matched string, MI/EQ from new flags +; if not matched, R0=byte, R5=>current char, MI/EQ from current flags +; Caller doesn't check C/NC or other flags +.TokenSearch +#ifndef SLOWTOKEN + adr TokenOffsets-2*ASC"A",r3 + asl r0 + add r0,r3 ; r3=>offset for initial character + mov (r3),r0 + adr TokenTable,r3 + add r0,r3 ; r3=>start of tokens for this character +#else + adr TokenTable,r3 ; r3=>start of token table +#endif +; +.SearchTable +mov r5,r1 ; Save source pointer +.SearchLoop +movb (r5),r0 ; Get source character +cmpb r0,(r3) ; Compare with token character +beq SearchMatch ; Match, check if full match +cmp r0,#ASC"." ; Abbreviation? +beq SearchDot ; Jump to match abbreviation +.SearchNext +inc r3 ; Step past this token +movb (r3),r0 +bpl SearchNext ; Loop until token byte +inc r3 ; Step past token byte +.SearchNextBack +mov r1,r5 ; Restore source pointer +inc r3 ; Step past flag to next token +cmpb (r5),(r3) ; Do initial characters still match? +#ifndef SLOWTOKEN + beq SearchLoop ; Yes, search next token +#else + bcc SearchLoop ; Yes, search next token +#endif +movb (r5),r0 ; Get first char back +mov r2,r1 ; new flags=old flags +rts pc +; R0=char, R1=old flag, R2=old flag, R3=corrupted, R4=preserved, R5=>current char +; flags=set from token flags + +.SearchFound +dec r5 ; Point to last character of source +.SearchDot +;inc r3 ; Step to end of token +;movb (r3),r0 +movb (r3)+,r0 ; Step to end of token +bpl SearchDot ; Loop until token byte fetched +;inc r3 ; Step to flag byte +movb (r3),r1 ; Get new flags +;sec ; Caller never checks C/NC +rts pc +; R0=token, R1=new flag, R2=old flag, R3=corrupted, R4=preserved, R5=>last char +; flags=CS, flags set from token flag + +.SearchMatch +inc r5 ; Step to next source char +inc r3 ; Step to next token char +;movb (r3),r0 ; Get next byte +tstb (r3) ; Test next byte +bpl SearchLoop ; Not a token, loop to check next character +;inc r3 ; Point to flag +;bitb #1,(r3) ; Needs nonalpha terminator? +bitb #1,1(r3) ; Needs nonalpha terminator? +beq SearchFound ; No nonalpha needed, token matched +movb (r5),r0 ; Get following source character +cmp r0,#ASC"A" +bcs SearchFound ; <'A', matched +cmp r0,#ASC"Z"+1 +bcc SearchFound ; >'Z', matched +; copy source to dest + +; r4=>dest +; r5=>last source char+1 +; r1=>first source char +.SearchAlpha +movb (r1)+,(r4)+ +cmp r1,r5 +bne SearchAlpha +dec r4 +movb (r4),r0 ; is this needed? +dec r5 +mov r2,r1 +clc +rts pc + +;.SearchFound +;dec r5 ; Point to last character of source +;movb (r3),r1 ; Get new token flag +;dec r3 ; Point to token byte +;movb (r3),r0 ; Get token byte +;sec +;rts pc +; R0=token, R1=new flag, R5=last matched char +; flags=CS + +; Print character or token +; ======================== +; On entry, r0=character +; On exit, r0,r2 corrupted +; +.PrintR0TokenChar +tstb r3 ; Within a string? +bne PrintAscii ; Print via OSASCI +.PrintR0Token +tstb r0 ; Is it a token? +bpl PrintAscii ; No, print via OSASCI +mov r1,-(sp) +adr TokenTable,r2 +.DetokeniseLp1 +mov r2,r1 ; Save start of this token string +.DetokeniseLp2 +tstb (r2)+ ; Loop to find b7=1 +bpl DetokeniseLp2 +inc r2 ; Step past tokeniser flags +cmpb r0,-2(r2) +bne DetokeniseLp1 ; No match, loop back +.DetokeniseLp3 +movb (r1)+,r0 +bmi DetokeniseDone ; Exit if b7 set +jsr pc,PrintR0 ; Print character +br DetokeniseLp3 +.DetokeniseDone +mov (sp)+,r1 +rts pc + +; Read line number +; ================ +; On entry, r5=>start of number +; +.ReadLineNumber ; r5=>may be leading spaces +jsr pc,SkipSpaceThis +; +.ReadLineNumberHere +; On entry, r5=>start of number +; r0= first character, not yet checked +; On exit, CS: not a line number +; r5=>unchanged, first character, not a digit +; r0= character at (R5) +; CC: a line number +; r4=line number +; r5=>first non-digit character +; r0= character at (R5) +jsr pc,CheckDigit +bcs ReadLineNotNum2 ; Not a decimal number +mov r5,-(sp) ; Save line pointer +jsr pc,EvalDecimalInt ; Read integer number to R3/R4, r5=>non-digit, r0=(R5) +tst r3 +sec +bne ReadLineNotNum1 ; Number>65535 +cmp #&FF00,r4 ; SC if number>&FF00 +bcs ReadLineNotNum1 +tst (sp)+ ; Drop saved line pointer, clear Carry +rts pc ; CC=valid line number +.ReadLineNotNum1 +mov (sp)+,r5 ; Restore line pointer +movb (r5),r0 ; R0=character at (R5) +.ReadLineNotNum2 +rts pc ; CS=invalid line number + +; Find line in program +; ==================== +; On entry, r4=line number +; On exit, r1=> just before line to execute, to pass to r5 +; CC+EQ, line found +; CC+NE, line not found +; MI+CS+NE, end of program +; Corrupts r0, r2 +; +.LineFind +mov SV_PAGE,r1 +.LineFindLp +movb 1(r1),r0 ; Get line number high +cmpb r0,#&FF +beq LineFindEnd ; End of program +movb 2(r1),r2 ; Get line number low +swab r0 +bic #&00FF,r0 +bic #&FF00,r2 +bis r2,r0 ; r0=line number +cmp r0,r4 ; Got to matching or higher line number? +bcc LineFindFound ; r1=> before matching line +movb 3(r1),r0 +bic #&FF00,r0 +add r0,r1 ; Step to next line +br LineFindLp +.LineFindEnd +tst r0 ; NE +sec +.LineFindFound +; If line found, CC+EQ, r1=> before matching line +; If line not found, CC+NE, r1=> before next line +; If end of program, MI+CS+NE, r1=> before &FF end marker +rts pc + +; TokenFind - Look for a line starting with a token +; ================================================= +; On entry, r0= token to look for, eg DEF, DATA +; r1=>current search point +; On exit, r1=>after matching token +; CC= Line not found +; CS= Line found +.TokenFindLp1 +dec r1 ; Step back to current character +.TokenFind +cmpb (r1)+,#13 ; Skip until +bne TokenFind +cmpb (r1)+,#&FF +beq TokenFindEnd ; CC=End of program +inc r1 ; Step past +.TokenFindLp2 +inc r1 ; Step past +cmpb (r1),#ASC" " +beq TokenFindLp2 ; Skip any leading spaces +cmpb (r1)+,r0 ; Check if matching token +bne TokenFindLp1 ; No match, skip this line +sec ; CS=Line found +.TokenFindEnd +rts pc + diff --git a/src/TrigLog b/src/TrigLog new file mode 100644 index 0000000..f8aca95 --- /dev/null +++ b/src/TrigLog @@ -0,0 +1,46 @@ +; > TrigLog +; Trigonometric and logarithmic functions + +; 16-Aug-2018: DEG and RAD done, PI moved here. + + +; Trigonometrical functions +; ========================= + +.fnPI +mov #&DAA2,r4 ; mantissa=&xxxxDAA2 +mov #&490F,r3 ; mantissa=&490Fxxxx +mov #&0081,r2 ; real exponent=&81 +rts pc + +.fnDEG +jsr pc,Eval180PI ; Stack 180/PI and evaluate float +jsr pc,fnMultiplyFloat ; DEG=(180/PI)*RAD +rts pc ; Note, stack adjusted so can't JMP + +.fnRAD +jsr pc,Eval180PI ; Stack 180/PI and evaluate float +jsr pc,fnDivideSwap ; RAD=(180/PI)/DEG +rts pc ; Note, stack adjusted so can't JMP + +.Eval180PI +mov (sp),r1 ; Get return address +mov #&652E,(sp) ; Push 180/PI +mov #&E0D3,-(sp) +mov #&0085,-(sp) +mov r1,-(sp) ; Push return address back +jmp EvalFloatVal ; Evaluate parameter as a float + +.fnACS +.fnASN +.fnATN +.fnCOS +.fnSIN +.fnTAN + +; Logarithmic functions +; ===================== +.fnEXP +.fnLN +.fnLOG +jmp EvalFloatVal ; Get float, return it diff --git a/src/TubeIO b/src/TubeIO new file mode 100644 index 0000000..aaa8d1a --- /dev/null +++ b/src/TubeIO @@ -0,0 +1,154 @@ +; > TubeIO +; Minimal interface to Tube system + +; 26-Jan-2014 v0.19b IO_CommandLine combined with IO_Init +; 11-Aug-2015 v0.20a IO_Init doesn't look for Unix stack frame in BBC environment +; 31-Aug-2015 v0.21a IO_Init tidied up, assumes caller sets default handlers +; 16-Jul-2017 v0.26c Bugfix for bug in Tube Client v0.25 +;TUBEBUG: EQU 1 ; Bug in Tube Client + +; Initialise Host I/O system +; ========================== +; On entry, r6=>top of memory-2, bottom of stack, startup parameters +; stacked parameters end with -1 or 0 (documented as 0, actually -1) +; r5=&0BBC for BBC environment or <>&0BBC otherwise +; r1=>command line if r0=1 +; r0=1 entered as a language +; r0=0 entered as raw code or Unix code that has had header stripped +; CC=entered from RESET, CS=entered from OSCLI +; On exit, r0=bottom of memory +; r1=top of memory +; +.IO_Init +bcs IO_Init1 ; Not Cy=0 on entry, not RESET entry +asr r0 +bne IO_Init2 ; Not R0=0 or R0=1 on entry, not language entry +mov #11,r0 ; If RESET, move up two lines to overwrite ROM title +emt 4 +emt 4 + +; Copy any command line to string buffer +; -------------------------------------- +.IO_Init1 +.IO_Init2 +;movb #13,SV_STRING ; Store null string as command line +adr SV_STRING,r2 ; Point to string buffer +.IO_CommandLine +movb (r1)+,r0 ; Copy command line to string buffer +movb r0,(r2)+ +cmpb r0,#13 +bne IO_CommandLine ; Loop until copied + +; Set BBC handlers +; ---------------- +mov #1,r0 +emt 13 ; Create new program environment +mov #-2,r0 ; r0=-2 = Escape handler +clr r1 ; r1=Keep default handler routine +adr SV_ESCFLG,r2 ; r2=New handler address +emt 14 ; Set Escape flag +dec r0 ; r0=-3 = Error handler +adr ErrorHandler,r1 ; r1=New handler routine +clr r2 ; r2=Keep default buffer address +emt 14 ; Set Error handler +mov #&20,SV_SYS ; Clear SYS and ESCFLG, set BBC EMTs available +#ifdef TUBEBUG + mov #-10,r0 ; Bugfix for broken Tube Client + adr Startup,r1 ; Set PROG to me + clr r2 + emt 14 +#endif +; Return memory limits +; -------------------- +mov #&84,r0 +jsr pc,IO_BYTE ; r1=top of memory +mov r1,-(sp) +dec r0 ; r0=&83 +jsr pc,IO_BYTE ; r1=bottom of memory +adr DefaultPAGE,r0 ; r0=end of code +cmp r1,r0 +bcs IO_Init4 ; End of code is higher than bottom of memory, use it instead +mov r1,r0 ; Bottom of memory is higher than end of code, use it +.IO_Init4 +mov (sp)+,r1 +.IO_NoError +.IO_NoEscape +rts pc + + +; Check for Escape state +; ====================== +.IO_EscapeFast +.IO_Escape +tstb SV_ESCFLG ; Check local Escape flag +bpl IO_NoEscape ; Return with no Escape state +.errEscape +jsr pc,Error ; Generate Escape error +equb 17,"Escape",0 +align + + +; Direct calls to BBC MOS I/O calls +; ================================= +.IO_QUIT0 clr r0 +.IO_QUIT mov r0,-(sp) ; Save return value + mov #2,r0 + emt 13 ; Set default handlers + mov (sp)+,r0 ; Get return value back + emt 0 ; Won't actually get back! + BR IO_Return ; But just in case +.IO_CLI emt 1 ; r0=>command string + BR IO_Return +.IO_BYTE emt 2 ; Osbyte r0,r1,r2 + BR IO_Return +.IO_WORD emt 3 ; Osword r0,r1=>block + BR IO_Return +.IO_WRCR mov #13,r0 + br IO_WRCH +.IO_ASCI cmp r0,#13 + beq IO_NEWL +.IO_WRCH emt 4 ; Oswrch r0=char + BR IO_Return +.IO_NEWL emt 5 ; Print NEWLINE + BR IO_Return +.IO_RDCH emt 6 ; Osrdch r0=char + BR IO_Return +.IO_FILE emt 7 ; Osfile r0=action, r1=>block + BR IO_Return +.IO_ARGS emt 8 ; Osargs r0=action, r1=>block, r2=handle + BR IO_Return +.IO_BGET emt 9 ; Osbget r1=handle + BR IO_Return +.IO_BPUT emt 10 ; Osbput r0=byte, r1=handle + BR IO_Return +.IO_GBPB emt 11 ; Osgbpb r0=action, r1=>block + BR IO_Return +.IO_FIND emt 12 ; Osfind r0=action, r1=>filename or handle +; BR IO_Return +;.IO_SYST emt 13 +; BR IO_Return +;.IO_CTRL emt 14 +; BR IO_Return +;.IO_ERROR emt 15 ; Generate inline error +.IO_Return BVC IO_NoError +; BVS IO_Error +;.IO_ReadTime rts pc ; Dummy read system time to R1:R0 +.IO_Error jmp ErrorHandler; R0=>error block byte,string,zero byte + +EQUW 0 ; No extra embedded data +.CodeEnd ; End of 'text/code' section + +; end of 'text' section +; +++++++++++++++++++++++ + +; +++++++++++++++++++++++ +; start of 'data' section + +.DataEnd ; End of 'data' section +; end of 'data' section +; +++++++++++++++++++++++ + +; +++++++++++++++++++++++ +; start of 'bss' section +BSS ; End of saved portion + diff --git a/src/UnixIO b/src/UnixIO new file mode 100644 index 0000000..5d057b8 --- /dev/null +++ b/src/UnixIO @@ -0,0 +1,2002 @@ +; > UnixIO +; Interface to Unix host system +; ----------------------------- +;#define ESCPOLL ; Always used Escape polling + +; NOTE: This module uses a lot of absolute addresses, whereas BASIC itself +; is carefully written to be position independant. When this module is +; executing it knows it's running on UNIX, which uses TRAP calls with +; absolute address parameters, so by definition, the code is always loaded +; into memory at &0000, so absolute addresses are usable. +; +; A lot of the code is very messy to provide a clean interface to the Unix +; system where a lot of the calls are inconsistant and broken in various ways. +; +; All TRAP calls modify R0 (specified in Unix7, implied in Unix6) +; On return from TRAP +; Carry is unchanged if there is no TRAP handler (eg an emulator) +; Carry is clear if Ok, set if error in R0 +; So, setting Carry before TRAP will leave Carry set after TRAP if no TRAP handler. +; +; Same state implemented on EMT calls +; On return from EMT +; Carry is unchanged if there is null EMT handler (eg on hardware Unix) +; Carry is clear if Ok, set if error +; So, setting Carry before EMT will leave Carry set after EMT if no EMT action. +; +; NOTE: On pre-Unix7 the INTR key cannot be changed, it is fixed at CHR$127. +; Consequently, Escape keypress is polled directly by IO_CheckEscape routine +; with STD set to raw input. Uses a ticker to only test every few calls to +; avoid thrashing the fileio code, currently set to every 256 calls. + +; BSD2.9: after IO_CLI, waits for keypress. stty issue? +; To do: OSFILE 5 +; To do: optimise reading TIME. +; To do: read EXT# directly to bypass pre-V7 issues. +; To do: command line could remove trailing space. +; To do: SIGEMT could be set to IGNORE, which will return CS. + +; 08-Feb-2008: RDCH/WRCH use direct TRAP calls +; 09-Feb-2008: CLI checks for *Quit, seperate ostty and mytty settings +; 10-Feb-2008: Vectors explicity set on startup, calls chain through to +; BBC calls if BBC environment available. +; 22-Aug-2008: Set up unix handlers, ESCFLG set on SIGINT. +; 25-Feb-2009: Working on SIGINT handler and cooked/raw tty settings +; 27-Feb-2009: Some problems with read() vs SIGINT/SIGQUIT. If RDCH is +; wrapped in tty_raw/tty_mine calls, A%=GET never returns; +; if RDCH is not wrapped in tty_raw/tty_mine calls, SIGINT +; and SIGQUIT don't terminate RDCH. Will need to investigate +; deeper. +; QUIT has to send some output before calling tty_host. Is +; this generic? Is there a flush() call usable instead? +; Using ioctl() fixes the problem, but ioctl() isn't available +; on v6. +; All output delays turned off, crmod turned off, INT/QUIT +; keys restored on quit +; Try to call ioctrl() via indir to catch unsupported calls on v6 +; 16-May-2010: OSFILE &FF (load) implemented. +; 02-Jun-2010: OSFILE &FF load count is SP-(load address) +; If running on Unix, PAGE=(SP AND &FC00), data at bottom of +; stack memory. +; 23-Jun-2010: OSFILE &00 (save) implemented, SAVE opens with creat(), +; LOAD opens with open(). OPENOUT calls creat(). SIGSEG and +; SIGBUS trapped and generate local error. +; 26-Jun-2010: OSARGS implemented - PTR, EXT, EOF, Alloc. +; 01-Jul-2010: OSCLI implemented. +; 20-Jan-2012: IO_InitMem uses sbrk() to claim memory from PAGE upwards. +; ARGS &FF calls sync(), *cd . +; 10-Feb-2013: Unix vectors moved here from SysVars. +; 30-Dec-2013: Tidied up TTY settings, gets istty() state of stdin and stdout +; OSCLI uses generalised command table, added */ command. +; Reads centisecond TIME on Unix 7. +; 26-Jan-2014: Combined IO_ReadCommand into IO_Init, checks for embedded program +; 28-Jan-2014: UNIX_GBPB checks #3 not #2 for write, GBPB, ARGS, FILE control block +; word access optimised. +; 22-Jul-2016: Signal handlers set up from a table, removed double-vectoring. +; Trimmed stty() calls on startup, tweeked CmdLine scanning. +; INKEY-256 returns &Bx for machine type. +; v5/v6 uses 16-bit seek, v7 uses 32-bit seek +; v5/6 doesn't return PTR from seek(), v7 does return PTR from lseek(). +; Consequently, =PTR, =EXT and =EOF don't work on v5/v6. Grrr. +; 07-May-2020: OSARGS checks for Unix version to adjust call to seek()/lseek(). +; Prevents 'Bad word access' error, but results in =PTR/=EXT/=EOF giving +; wrong values. No API to read PTR, only able to set PTR. +; 12-Jun-2020: *ESC ON/OFF works, OSRDCH returns R0=ESC if ESC OFF. +; 28-Jun-2020: Unix v6,v7 recognise extended keypresses, Unix v6 fakes background +; Escape polling. +; 30-Jun-2020: Optimised extended keypress reading. Unix v5 not working properly. +; InitTTY recognises Unix v5, allows Unix v5 extended keypresses to work. +; 12-Jul-2020: Added delay to TTYtest to cope with telnet delays. +; TTYtest only needs a delay when already fetched . +; TTYInit scans memory to find kbdQ location. +; 21-Jan-2022: Started working on BSD code. +; 24-Jan-2022: Worked out BSD2.11 ioctl() parameters. +; 24-Jul-2022: Started working out BSD2.9 API. +; 29-Jul-2022: Switches stack out of stack segment for BSD. +; 01-Aug-2022: Detects and runs on BSD2.9 - can't find kbdQ at the moment. +; Added ADVAL(-1). +; 04-Aug-2022: BSD2.11: load/save, =TIME. +; 07-Aug-2022: Added *load/*save. +; 01-Aug-2023: Optimised IO_RDCH, IO_WRCH entries, rewrote TTY test routines. +; 02-Aug-2023: ANSI keyboard processing seperated out into seperate module. +; 08-Aug-2023: OSCLI calling external works on BSD211. Some tidying. +; 12-Aug-2023: BSD *chdir. +; 19-Aug-2023: Combined fopen and data transfer from OSGBPB and OSFILE. +; 20-Aug-2023: BSD OSARGS and EOF done. +; 15-Sep-2023: Calling shell process wrapped in VDU0 to send signal to LF piper. +; Testing Unix7 with SIGINT=IGN and polling Escape. -> Ok in SIMH, but E11 doesn't like it. +; 07-Apr-2024: Moved IO_xxxx entries to actual routines and generate errors. +; 12-Apr-2024: BGET/BPUT merged code, BGET checks for EOF, better EOF routine. +; 19-Apr-2024: BSD211 signals work, tidied up and optimised. +; 30-Apr-2024: BSD2.9 tests keyboard buffer so function keys work. +; 31-Dec-2024: Fixed EOF handling on BGET never resetting EOF flag. Also fixed BSD clearing +; EOF flag on BPUT/WRCH. +; 01-Jan-2026: Some fiddling with startup system checking. + + +; Console Input settings +; ---------------------- +; There is no API to test for pending key input, so the code has to bypass the API +; and reach into kernel memory. May be delays between incoming characters so need +; to pause after receiving to tell apart and . +.KBD_TICK equ 000 ; Foreground Escape key ticker +.KBD_DELAY equ 100 ; Delay loop to confirm after + +; SV_SYS flag settings +; -------------------- +.FLG_UNIXVER equ &0E +.FLG_UNIXNEW equ &0C ; 00: seek(), stty(), 1sec; <>00: lseek(), ioctl(), milliseconds +.FLG_UNIXBSD equ &0C ; <>11: inline parameters; 11: stacked parameters +.FLG_UNIXV9 equ &08 ; 0xx: read kbdQ manually; 1xx: FIONREAD available +.FLG_UNIXV7 equ &04 +.FLG_UNIXV6 equ &02 +.FLG_UNIXV5 equ &00 + +;.FLG_NOTTY1 equ &02 +.FLG_NOTTY0 equ &01 + + +; Initialise Host I/O system +; ========================== +; On entry, r5=&0BBC for BBC environment or <>&0BBC otherwise +; r6=>top of memory-2, bottom of stack, startup parameters +; stacked parameters end with -1 or 0 (documented as 0, actually -1) +; On exit, r0=bottom of memory +; r1=top of memory +; string buffer holds command line, SV_SYS holds environment flags +; +; BBC: r0=0000, r1=0000, r2=0000, r3=0000, r4=0000, r5=0BBC, r6=FFxx stack +; or r1=>cmdline +; Bell: r0=0000, r1=0000, r2=0000, r3=0000, r4=0000, r5=0000, r6=FFxx stack +; Unix7: r0=0A72, r1=39E2, r2=0000, r3=0000, r4=0000, r5=0000, r6=FFxx stack +; BSD2.9 su: r0=0A72, r1=39E2, r2=0000, r3=0000, r4=0000, r5=0000, r6=FFxx stack +; BSD2.9 mu: r0=0001, r1=4E48, r2=0000, r3=0000, r4=0000, r5=0000, r6=FF98 stack +; BSD2.11: r0=0000, r1=0A8E, r2=0000, r3=0D82, r4=0D02, r5=FEFA, r6=FF7C infile +; varies varies +; about 0D00/0D80+6*len(cmdline) +.IO_Init +;mov r0,r4 ; Move BSD2.9 flag into R4 +; Not needed if setpgrp() test used instead + +; Look for embedded BASIC program +; ------------------------------- +; Should be done after memory claimed, otherwise will be moving to unclaimed memory. +; No longer a problem, as is already at the correct address in memory. +; +clr -(sp) ; Clear and stack SV_SYS +mov SV_EMBED,r0 ; Look for any embedded BASIC program +beq IO_Init0 ; Nothing embedded +bis #FLG_QUIT+FLG_EMBED,(sp) ; Set QUIT+EMBED in stacked SYS flag +.IO_Init0 + +; Set BBC handlers +; ---------------- +#ifndef NOEMT + cmp r5,#&0BBC ; Is BBC environment available? + bne IO_InitSignals ; No, jump to set up signals + bis #FLG_BBCEMT,(sp) ; Flag that BBC calls available + mov #-2,r0 ; -2 = Escape handler + clr r1 ; Keep default handler routine + ;adr SV_ESCFLG,r2 ; Set handler buffer address + mov #SV_ESCFLG,r2 ; Set handler buffer address + emt 14 ; Set Escape flag + dec r0 ; -3 = Error handler + ;adr ErrorHandler,r1 ; Set handler routine + mov #ErrorHandler,r1 ; Set handler routine + clr r2 ; Keep default buffer address + emt 14 ; Set Error handler +#endif + +; Catch system signals +; -------------------- +.IO_InitSignals +#ifndef BSD211 + mov #14,r0 ; 14 signals to catch + .IO_InitSigLp + mov r0,-(sp) + jsr pc,sig_Catch ; Catch this signal + mov (sp)+,r0 + dec r0 + bne IO_InitSigLp ; Loop down to signal 1 + ; We have a bit of a race condition here. We've set the signals, + ; but we haven't moved the stack yet. If INTR happens before we + ; get to MemInit, we will bomb out. +#else + clr -(sp) ; mov #0,-(sp) + clr -(sp) + clr -(sp) + clr -(sp) ; sigdest,0,0,0 + mov sp,r0 ; r0=>newvec + clr -(sp) ; oldvec=0 + mov r0,-(sp) ; newvec=>vector on stack + clr -(sp) ; signum + mov #sigtramp,-(sp) ; trampoline + mov #sig_Handlers,-(sp) ; pad,tramp,signum,newvev,oldvec, sigdest,0,0,1 + .IO_InitSigLp + mov (sp),r0 ; Get =>siginfo + mov (r0)+,4(sp) ; Get signum + beq IO_InitSigOk ; End of table + mov (r0)+,10(sp) ; Get sigdest + mov r0,(sp) + trap 31 ; sigaction() + br IO_InitSigLp + .IO_InitSigOk + add #18,sp +#endif + + +; Set up TTY settings +; ------------------- +mov (sp)+,SV_SYS ; Set SYS and clear ESCFLG +#ifndef BSD211 +jsr pc,UNIX_WRCH0 ; 'Kick' tty - but puts 00 in output stream +#endif +jsr pc,tty_Init + +; Read command line to string buffer +; ---------------------------------- +; Bell, BSD29: +; sp=>retaddr, argn, &arg[0], &arg[1], ... 0, &env[0], ... 0 +; +; BSD211: +; sp=>retaddr, envn, argn, &arg[0], &arg[1], ... 0, &env[0], ... 0 +; +mov #SV_STRING,r2 ; Point to string buffer +mov sp,r0 ; Point to stack frame +#ifdef BSD211 +; mov (r0),SV_ENVPTR +#endif BSD211 +cmp (r0)+,(r0)+ ; Point to before 1st parameter +.IO_CmdNext +tst (r0)+ ; Step to next parameter +mov (r0),r1 ; Get address of parameter +beq IO_CmdEnd ; 0 - end of parameters +inc r1 +beq IO_CmdEnd ; -1 - end of parameters +dec r1 +cmp r2,#SV_STRING +bne IO_CmdCopy ; Options have been stepped past +cmpb (r1),#ASC"-" ; Is it an option to BASIC +beq IO_CmdNext ; Skip BASIC options +.IO_CmdCopy +movb (r1)+,(r2)+ ; Copy bytes from parameter to string buffer +bne IO_CmdCopy ; Loop until zero byte +movb #ASC" ",-1(r2) ; Replace zero byte with space +br IO_CmdNext ; Jump back for next parameter +.IO_CmdEnd +movb #13,(r2) ; Store terminating + +; Return memory limits +; -------------------- +#ifdef BSD211 + clr -(sp) ; Start at &10000 + clr -(sp) ; Padding + .IO_InitMemLp + sub #256,2(sp) ; Step down 256 bytes + trap 69 ; SYS brk,addr + bcs IO_InitMemLp ; Not claimable, try a bit less + tst (sp)+ ; Drop padding + mov (sp)+,r1 ; r1=top of memory +; + mov (sp),r0 ; Pick up return address + mov r1,sp ; BSD: move stack into data segment + mov r0,-(sp) ; Restack return address + trap 152 ; nostk() - release stack +; + +; bis #(11-5)*2,SV_SYS ; Set to UnixV11 +#else + clr r1 ; r1=top of memory, start at &10000 + mov #&8911,TRAP_BUF ; SYS brk + .IO_InitMemLp + sub #256,r1 ; Step down 256 bytes + mov r1,TRAP_BUF+2 + TRAP 0 ; SYS brk,addr + EQUW TRAP_BUF + bcs IO_InitMemLp ; Memory not claimable, try a bit less + +; R4 still has R0 entry value: +; BBC: r0=0000, r1=0000, r2=0000, r3=0000, r4=0000, r5=0BBC, r6=FFxx stack +; Unix5: r0=0000, r1=0000, r2=0000, r3=0000, r4=0000, r5=0000, r6=FFxx stack +; Unix6: r0=0000, r1=0000, r2=0000, r3=0000, r4=0000, r5=0000, r6=FFxx stack +; Unix7: r0=0A72, r1=39E2, r2=0000, r3=0000, r4=0000, r5=0000, r6=FFxx stack +; BSD2.9 su: r0=0A72, r1=39E2, r2=0000, r3=0000, r4=0000, r5=0000, r6=FFxx stack +; BSD2.9 mu: r0=0001, r1=4E48, r2=0000, r3=0000, r4=0000, r5=0000, r6=FF98 stack +; tst r4 +; beq IO_InitMemOk ; Not BSD2.9 + +;#ifndef NEWTEST +; cmp r4,#1 +; bne IO_InitMemOk ; Not BSD2.9 +; mov (sp),r0 ; Pick up return address +; mov r1,sp ; BSD: move stack into data segment +; mov r0,-(sp) +;#else + mov (sp),r0 ; Pick up return address + mov r1,sp ; Move stack into data segment + mov r0,-(sp) + clr r0 + trap 0 ; indir() + equw trap39 ; setpgrp(-1) + tst r0 + beq IO_InitMemOk ; R0 unchanged, v7 +;#endif + +; Really fiddly here, as if TRAP 58 doesn't exist, program executes +; the inline address, so that address has to be a harmless instruction +; Needs setpgrp() or R4 check to avoid using TRAP 58 + trap 58 ; SYS local,nostk + equw IO_InitNoStk ; Turn stack segment off + add #&04,SV_SYS ; Change UnixV7 to UnixV9 +; clr SV_KBDFETCH+4 ; BSD2.9, will use IONREAD, so don't need to set here + .IO_InitMemOk +#endif +mov #DefaultPAGE,r0 ; r0=bottom of memory +mov r1,SV_MEMTOP +mov r0,SV_MEMBOT +rts pc + +#ifndef BSD211 +.trap39 +trap 39 ; setpgrp +equw -1 ; -1=read + .IO_InitNoStk + TRAP 4 ; LOCAL nostck +#endif + + +; Set TTY settings +; ================ +; Set ioctl() to change Interupt character to Escape +; -------------------------------------------------- +; Also determine version of Unix running on and set specific settings +; +; ; v2.9 kbdQ is IONREAD ioctrl() exists centisecond counter nostk() needed +.TTY_KBDQ7 equ &A263 ; v7 kbdQ at &A263 ioctrl() exists centisecond counter +;.TTY_KBDQ6 equ &4308 ; v6 kbdQ at &4308 no ioctrl() seconds counter +;.TTY_KBDQ5 equ &93CA ; v5 kbdQ at &93CA no ioctrl() seconds counter +; ; v4 kbdQ unknown no ioctrl() seconds counter +; +.tty_Init +#if KBD_TICK=0 + clrb SV_TICKER ; Reset Escape ticker +#else + movb #KBD_TICK,SV_TICKER ; Reset Escape ticker +#endif +#ifndef BSD211 + ; Pre-BSD211 we need to find TTYRDY status + mov #&8913,SV_KBDFETCH+0 ; Store trap seek()/lseek() + clr r0 ; R0=STDIN + sec ; Set carry to prepare for ioctrl() support + trap 0 ; Indirect system call + equw tty_rdctrl ; Point to ioctrl(stdin,TIOCGETP,SV_OSIOCTL) + ; This will return: + ; CC - Unix7, R0=??? STDIN is a tty + ; CS - Unix7, R0=&19 STDIN is not a tty + ; CS - Unix6, R0=&00 STDIN unknown call + ; CS - Unix5, R0=&00 STDIN unknown call + ; + bcc tty_InitV7 ; ioctl() exists, STDIN is a tty + tst r0 + bne tty_InitV7 ; R0<>0, ioctrl() does exist, STD isn't a tty, UnixV7 or BSD2.9 + ; + ; Unix V5 or V6 + clr r2 ; R2=&00, UnixV5 + clr r1 ; Prepare result=0 + trap 5 ; open() + equw IO_TTYmem ; =>"/dev/mem" + equw 0 ; 0=read + bcs tty_Init1 ; Failed to open, leave offset as zero + ; + mov #&0030,r1 + jsr pc,IO_TTYfetchR1 ; seek(&30), fetch !&30 to R1, eg &AC + jsr pc,IO_TTYfetch4 ; PTR=R1+4, seek(&B0), fetch !&B0, eg &554E + jsr pc,IO_TTYfetch4 ; PTR=R1+4, seek(&5552), fetch !&5552 + bic #&00FF,r1 ; &00xx = v5, offset=0, <>&00xx = v6, offset=&16 + beq tty_InitV5 + mov #&0016,r1 ; offset for v6 + ;add #-4,SV_KBDFETCH+2 ; Step back four bytes + ;;asr r2 ; R2=&04, UnixV6 + mov #FLG_UNIXV6,r2 ; R2=&02, UnixV6 + .tty_InitV5 + mov r1,-(sp) ; Save offset + + .tty_InitLp + jsr pc,IO_TTYfetch1 + cmp r1,#&65C2 + bne tty_InitLp ; Search for ADD #nnnn,R2 instruction + jsr pc,IO_TTYfetch1 + cmp r1,#&0100 + bcs tty_InitLp ; Seach for offset>&00FF + add (sp)+,r1 ; Add saved offset from base + trap 6 ; close() + + ;add #18-4,SV_KBDFETCH+2 ; Step forward 18 or 14 bytes + ;jsr pc,IO_TTYfetch ; seek(), fetch !word, final offset + ;trap 6 ; close() + ;add (sp)+,r1 ; add saved offset from base + ;bcc tty_InitDone + ;mov #TTY_KBDQ6,r1 ; Hard-wired + + .tty_InitDone + mov r1,SV_KBDFETCH+2 ; Store offset to kbdQ +; bisb r2,SV_SYS ; Set Unix version in flags, indicate ioctrl()/lseek()/etc Unix v7 available + br tty_Init1 + ; + .tty_InitV7 +; bisb #FLG_UNIXV7,SV_SYS ; &04, UnixV7 + ;clr SV_KBDFETCH+2 + mov #TTY_KBDQ7,SV_KBDFETCH+4 ; Hard-wired, offset to v7 keyboard buffer + mov SV_IOCTL+0,SV_OSIOCTL+0 ; Save host's Interupt/Quit characters + ;mov #&1F1B,SV_IOCTL+0 ; Change SIGINT to CHR$27, SIGQUIT to CHR$31 + movb #27,SV_IOCTL+0 ; Change SIGINT to CHR$27, leave SIGQUIT as CHR$28 + trap 54 ; ioctrl() + equw 0 ; stdin + equb 17,"t" ; TIOCSETP + equw SV_IOCTL ; Write settings on stdin + mov #FLG_UNIXV7,r2 ; &04, UnixV7 +#endif + +; Get TTY settings and set to raw input +; ------------------------------------- +.tty_Init1 +bisb r2,SV_SYS ; Set Unix version in flags, indicate ioctrl()/lseek()/etc Unix v7+ available +#if FLG_NOTTY0<>1 + #error FLG_NOTTY0 must be &01 +#endif +#ifdef BSD211 + mov #SV_TTY,-(sp) ; =>argbuf + mov #ASC"t"*256+8,-(sp) ; TIOCGETP + mov #&o40006,-(sp) ; b14=get, b7-b0=6 bytes to read + clr -(sp) ; 0=STDIN + clr -(sp) ; Padding + trap 54 ; ioctrl() + add #10,sp ; Drop from stack +#else + rorb SV_SYS ; Move bit 0 out of flags + clr r0 ; R0=STDIN + trap 32 ; gtty() + equw SV_TTY ; Read host's TTY setting + rolb SV_SYS ; Move NotTTY flag into bit 0 of flags +#endif +mov SV_TTY+4,SV_OSTTY ; Save host's TTY flags + ; Continue to set raw TTY + +; Set TTY to raw for input within BASIC +; ------------------------------------- +.tty_raw +mov SV_OSTTY,r0 +#ifndef ESCPOLL + bis #2,r0 ; CBreak on -- raw, but with INT and QUIT working + bic #&FF00+32+16+8,r0 ; NoDelay+Raw+CRMod+Echo off + bitb #FLG_UNIXNEW,SV_SYS ; Are we running on Unix7 or later? + bne tty_set ; Jump to set 'Cooked' for v7+ + bic #2,r0 ; Remove 'Cooked' + bis #32,r0 ; Set 'Raw' + br tty_set ; Jump to set 'Raw' for pre-v7 +#else + bic #&FF00+16+8+2,r0 ; NoDelay+Raw+CRMod+Echo off + bis #32,r0 ; Set 'Raw' + br tty_set ; Jump to set it +#endif + +;.tty_quit +; trap 36 ; sync(), update open files +; bitb #FLG_UNIXVER,SV_SYS ; Does ioctl() need setting? +; bne UNIX_QUITtty ; Skip if not Unix7 +; mov SV_OSIOCTL,SV_IOCTL ; Get host's TTY chars +; trap 54 ; ioctrl() +; equw 0 ; stdin +; equb 17,"t" ; TIOCSETP +; equw SV_IOCTL ; Restore host TTY characters +; .UNIX_QUITtty + + +; Set TTY to host's saved setting for host calls +; ----------------------------------------------- +.tty_host +mov SV_OSTTY,r0 ; Get hosts' TTY flags +.tty_set +#ifdef BSD211 + mov r0,SV_TTY+4 + mov #SV_TTY,-(sp) ; =>argbuf + mov #ASC"t"*256+9,-(sp) ; TIOCSETP + mov #&o100006,-(sp) ; b15=set,b14=get,b13=none, b7-b0=size + clr -(sp) ; 0=STDIN + clr -(sp) ; Padding + trap 54 ; ioctrl() + add #10,sp ; Drop from stack +#else + mov r0,SV_TTY+4 + clr r0 ; 0=STDIN + trap 31 ; stty() + equw SV_TTY ; Set TTY setting +#endif +rts pc + +#ifndef BSD211 + .tty_rdctrl + trap 54 ; ioctrl() + equw 0 ; stdin + equb 18,"t" ; TIOCGETP + equw SV_IOCTL ; Read settings on stdin +#endif + +; Signal handlers +; =============== +; On entry to signal handler, all registers are exposed, except PS which is stacked +; 0=Quit, 1=Ignore, else=handler +; +.sig_Handlers +#ifndef BSD211 +equw 0 ;Catch_SIGHUP ; SIGHUP 1 hangup QUIT + #ifdef ESCPOLL + equw 1 ;Catch_SIGINT ; SIGINT 2 interrupt (escape) IGNORE + #else + equw Catch_SIGINT ; SIGINT 2 interrupt (escape) Set ESCFLG + #endif + equw Catch_SIGQUIT ; SIGQIT 3 quit (FS) QUIT cleanly + equw 0 ;Catch_SIGINS ; SIGINS 4 illegal instruction QUIT/Error &F0,Undefined instruction + equw 0 ;Catch_SIGTRC ; SIGTRC 5 trace or breakpoint QUIT/Error &F1,Breakpoint + equw 0 ;Catch_SIGIOT ; SIGIOT 6 iot QUIT/Error &F4,Unknown IRQ + equw Catch_SIGEMT ; SIGEMT 7 emt Return CS + equw 0 ;Catch_SIGFPT ; SIGFPT 8 floating point error QUIT + equw Catch_SIGKILL ; SIGKIL 9 kill QUIT (uncatchable) + equw Catch_SIGBUS ; SIGBUS 10 bus error Error &F3,Bad word access + equw Catch_SIGSEG ; SIGSEG 11 segmentation violation Error &F2,Bad memory access + equw Catch_SIGSYS ; SIGSYS 12 bad sys (trap) call Return CS + equw 0 ;Catch_SIGPIPE ; SIGPIPE 13 end of pipe QUIT + equw 0 ;Catch_SIGALRM ; SIGALRM 14 alarm QUIT +#else + equw 1,Catch_SIGHUP ; SIGHUP 1 hangup QUIT cleanly + equw 2,1 ; SIGINT 2 interrupt (escape) IGNORE + equw 3,Catch_SIGQUIT ; SIGQIT 3 quit (FS) QUIT cleanly + equw 7,1 ; SIGEMT 7 emt IGNORE + equw 9,Catch_SIGKILL ; SIGKIL 9 kill QUIT cleanly (uncatchable) + equw 10,errSIGBUS ; SIGBUS 10 bus error Error &F3,Bad word access + equw 11,errSIGSEG ; SIGSEG 11 segmentation violation Error &F2,Bad memory access + equw 12,1 ; SIGSYS 12 bad sys (trap) call IGNORE + equw 0 +#endif + +; Catch signal +; ------------ +; R0=signal number, action found from sig_Handler table +#ifdef BSD211 +sigtramp: + mov sp,r1 + add #6,r1 + mov r1,-(sp) + tst -(sp) + mov r0,14(r1) ; Redirect return to an error + trap 103 ; sigreturn() + halt +#else + .sig_Catch + mov #&8930,TRAP_BUF+0 ; SYS signal + mov r0,TRAP_BUF+2 ; signal number + asl r0 + mov sig_Handlers-2(r0),TRAP_BUF+4 + trap 0 + equw TRAP_BUF + rts pc +#endif + +; Unknown TRAP (Unix SYS) call +; ---------------------------- +; Don't need to preserve R0,R1 as they are corrupted by a SYS call anyway +; BSD211 must return via sigreturn(), stack doesn't have return info. +#ifndef BSD211 + .Catch_SIGSYS + mov #12,r0 + jsr pc,sig_Catch ; Reconnect handler + bis #1,2(sp) ; Set returned carry flag + rti + + ; EMT call + ; -------- + ; If these translate into IO_xxxx calls, need to check to prevent looping + .Catch_SIGEMT + mov r0,-(sp) + mov #7,r0 + br Catch_SIGRestore + + ; Escape pressed + ; -------------- + ; On pre-Unix7, in RAW mode, this will NEVER get called! + ; + #ifndef ESCPOLL + .Catch_SIGINT + mov r0,-(sp) + bitb #FLG_ESCAPE,SV_SYS ; Is Escape disabled? + bne Catch_SIGINTchar ; Push into keyboard buffer + jsr pc,KBD_TestKeyDelay ; r0=0 if nothing pending + bne Catch_SIGINTchar ; Push into keyboard buffer + movb #&FF,SV_ESCFLG ; Set local Escape flag + br Catch_SIGINTpush ; Reclaim SIGINT + .Catch_SIGINTchar + mov #27*256+1,r0 ; Prepare key=CHR$27, queue=1 + .Catch_SIGINTpush + mov r0,SV_KBDQ ; Set or clear keyqueue and pending keypress + mov #2,r0 ; R0=SIGINT + #endif + ; + .Catch_SIGRestore + mov r1,-(sp) + jsr pc,sig_Catch ; Reconnect handler + mov (sp)+,r1 + mov (sp)+,r0 + rti +#endif + +; Don't need to preserve any registers for the following as they just +; jump to the error handler. +; Does BSD need to adjust return block to cause return to error handler? + +; Access to nonexistent memory +; ---------------------------- +#ifndef BSD211 + .Catch_SIGSEG + mov #11,r0 + jsr pc,sig_Catch ; Reconnect handler +#endif +.errSIGSEG +jsr pc,ErrorHandler1 +equb &F2,"Bad memory access",0 +align + +; Word access to odd address +; -------------------------- +#ifndef BSD211 + .Catch_SIGBUS + mov #10,r0 + jsr pc,sig_Catch ; Reconnect handler +#endif +.errSIGBUS +jsr pc,ErrorHandler1 +equb &F3,"Bad word access",0 +align + +; IOT interupt +; ------------ +;.Catch_SIGIOT +;mov #6,r0 +;jsr pc,sig_Catch ; Reconnect handler +;jsr pc,CatchSaveRegs +;.errSIGIOT +;jsr pc,ErrorHandler1 +;equb &F4,"Unknown IRQ",0 +;align + +; Breakpoint +; ---------- +;.Catch_SIGTRC +;mov #5,r0 +;jsr pc,sig_Catch ; Reconnect handler +;jsr pc,CatchSaveRegs +;.errSIGTRC +;jsr pc,ErrorHandler1 +;equb &F1,"Breakpoint",0 +;align + +; Illegal instruction +; ------------------- +;.Catch_SIGINS +;mov #4,r0 +;jsr pc,sig_Catch ; Reconnect handler +;jsr pc,CatchSaveRegs +;.errSIGINS +;jsr pc,ErrorHandler1 +;equb &F0,"Undefined instruction",0 +;align + + +; IO calls translated to UNIX TRAPs +; ================================= + +; OSCLI - Execute a command +; ========================= +; On entry, R0=>command string +; +.IO_CLI EQU IO_OSCLI ; Execute command + + +; OSQUIT - Quit execution +; ======================= +; On entry, R0=exit status +; +.Catch_SIGQUIT +JSR PC,IO_NEWL +.Catch_SIGKILL +.Catch_SIGPIPE +.Catch_SIGFPT +.Catch_SIGHUP +.Catch_SIGTRC +.Catch_SIGINS +.Catch_SIGIOT +.IO_QUIT0 +CLR R0 ; Quit with status=0 +.IO_QUIT +mov r0,-(sp) ; Save exit status +trap 36 ; sync(), update open files +#ifdef BSD211 + jsr pc,tty_host ; Restore host TTY settings + mov (sp),r0 ; Get exit status back + trap 1 ; exit() + tst (sp)+ ; Drop padding +#else + bitb #FLG_UNIXNEW,SV_SYS ; Does ioctl() need setting? + beq UNIX_QUITtty ; Skip if not Unix7 + mov SV_OSIOCTL,SV_IOCTL ; Get host's TTY chars + trap 54 ; ioctrl() + equw 0 ; stdin + equb 17,"t" ; TIOCSETP + equw SV_IOCTL ; Restore host TTY characters + .UNIX_QUITtty + jsr pc,tty_host ; Restore host TTY settings + mov (sp)+,r0 ; Get exit status back + trap 1 ; exit(r0) +#endif +rts pc ; In case returns + + +; Host-specific commands +; ====================== + +; *cd +; --------------- +.CLIchdir +jsr pc,UX_StringCopy ; Convert whole string at R0 to null-string at R1 (could be space-terminated) +#ifdef BSD211 + mov r1,-(sp) ; dirname + clr -(sp) ; padding + trap 12 ; chdir(dirname) + mov (sp)+,r1 ; Drop padding without changing Carry (tst clears Cy) +#else + mov r1,TRAP_BUF+2 ; dirname + mov #&890C,TRAP_BUF ; chdir() + trap 0 ; indir() + EQUW TRAP_BUF ; chdir(dirname) +#endif +bcc CLIchdirok ; No error +mov #msgFileNotFound,r0 ; Must have been dir not found +jmp ErrorHandler + +; Command doesn't match or */name, pass to system() +; ------------------------------------------------- +; r0=>start of command name +; sp=>saved R1 +.IO_CLIslash +mov r0,r1 +trap 2 ; fork() +br UX_CLIchild ; Child process returns here +bcs errBadCommand ; Parent process returns here, R0=child PID +#ifdef BSD211 + clr -(sp) ; status + mov sp,r1 ; r1=>status + clr -(sp) ; 0 + clr -(sp) ; 0 + mov r1,-(sp) ; =>status + mov #-1,-(sp) ; -1 +#endif +mov r0,-(sp) ; Save child's PID +.UX_CLIwait +trap 7 ; wait(-1,&status,0,0) +cmp r0,(sp) +beq UX_CLIfinished +cmp r0,#&FFFF ; Could be 'inc' as R0 not later used +bne UX_CLIwait ; Loop until child finished +.UX_CLIfinished +#ifdef BSD211 + add #2*6,sp ; Drop from stack +#else + tst (sp)+ ; Drop child's PID +#endif +.UX_CLIreturn +jsr pc,tty_raw ; Restore to BASIC's TTY settings +swab r1 ; Move return value to bottom byte +mov r1,r0 ; R0=return value +mov (sp)+,r1 ; Restore R1 +.CLIchdirok +rts pc + +; CLI child process +; ----------------- +.UX_CLIchild +jsr pc,UX_StringCopyR1 ; Convert whole string at R1 to null-string at R1 +cmpb (r1),#ASC"." +bne UX_CLIchild2 ; Not *. +mov #UXsh4,r1 ; Replace *. with *ls -l or *ls +.UX_CLIchild2 +jsr pc,tty_host ; Use host's TTY settings, corrupts R0 +jsr pc,UNIX_WRCH0 ; Output VDU 0 to toggle LineFeed flag +; *NOTE* Output from exec() call will go through BASIC's output. +; So if bbcbasic | ansi, output will go through ansi. This means +; will only be if ansi translates to pure without . +; GRRRR +; Need to send a signal to ansi driver without changing display +; output. Eg OSCLI "rm "+n$ must normally not create any output. +; +clr -(sp) ; end of string array +mov r1,-(sp) ; => command string +mov #UXsh3,-(sp) ; => "-c" +mov #UXsh2,-(sp) ; => "sh" +#ifdef BSD211 + mov sp,r1 ; r1=>list of string pointers + mov r1,-(sp) ; =>list of string pointers + mov #UXsh1,-(sp) ; =>"/bin/sh" + clr -(sp) ; padding + trap 11 ; execv("/bin/sh", =>parameters) + add #2*7,sp ; Drop parameters +#else + mov #&890B,TRAP_BUF+0 ; exec + mov #UXsh1,TRAP_BUF+2 ; => "/bin/sh" + mov sp,TRAP_BUF+4 ; => pointers to command strings + ;mov SV_ENVPTR,TRAP_BUF+6 ; => "PATH=etc" - not used in exec() call, + ; used in exece() which is not present in v6 + trap 0 ; indir() + EQUW TRAP_BUF ; exec(shell, parameters) + mov r0,r1 ; If we get back, we didn't fork, we spawned + add #2*4,sp ; Drop parameters +#endif +jsr pc,UNIX_WRCH0 ; Output VDU 0 to toggle LineFeed flag back +br UX_CLIreturn ; So, restore registers and tty, and return + +.UXsh1 EQUS "/bin/sh",0 +.UXsh2 EQUS "sh",0 +.UXsh3 EQUS "-c",0 +#ifdef BSD211 +.UXsh4 EQUS "ls 1>&2",0 +#else +.UXsh4 EQUS "ls -l",0 +#endif +.errBadCommand +jsr pc,Error +equb 254,"Bad command",0 +ALIGN + + +; OSBYTE - Host calls with byte parameters +; ======================================== +.IO_BYTE +mov r0,-(sp) ; Save R0 +jsr pc,IO_BYTEgo ; Returns R0=return value +mov r0,r1 ; Place it in correct register +mov (sp)+,r0 +rts pc +.IO_BYTEgo +cmp r0,#&81 +beq IO_INKEY ; =INKEY +cmp r0,#&80 +beq IO_ADVAL ; =ADVAL +cmp r0,#&7F +beq IO_EOF ; =EOF +tst r0 +bne IO_BYTEbbc ; Not OSBYTE 0, try to pass to BBC host + +; Read host system type +; --------------------- +.IO_BYTE0 +mov #8,r1 ; r1=8 for Unix +.IO_BYTEbbc +#ifndef NOEMT + emt 2 ; Pass call to BBC host +#endif +.IO_BYTEok +mov r1,r0 ; Return it in R0 for caller +rts pc + +; OSINKEY - Timed wait for character from input stream +; ==================================================== +; On entry, R1=timeout +; On exit, R1=character +; CC=ok +; CS=escape or timeout +; R1=27 R1=-1 +; +.IO_INKEY +tst r1 ; Negative INKEY? +bmi IO_INKEYneg ; INKEY -num with R1=&FFxx +jsr pc,IO_GETKEY0 +;bvc IO_INKEYdone ; Should test for keypress +; Should test timeout +;mov #&FFFF,r0 ; No key pressed +;sec ; No key pressed +rts pc ; Return R0 and restore +; +; Read machine type +; ----------------- +.IO_INKEYneg +#ifndef NOEMT + sec + emt 2 ; First try BBC host + bcc IO_BYTEok ; It responded, return what it returned +#endif +; NB, INKEY is allowed to return Cy set (eg timeout), this treats Cy=1 as 'unsupported' +clr r0 ; Prepare 'key not pressed' +cmp r1,#&FF00 +bne IO_INKEYdone ; Not INKEY-256, return R1=0 +#ifdef BSD211 + mov #&00BB,r0 ; &BB = BSD2.11 +#else + movb SV_SYS,r0 + bic #-FLG_UNIXVER-1,r0 ; Keep Unix version flags + ror r0 ; Move to b0-b1 + bne IO_INKEY4 ; Not Unix v4/v5 + trap 20 ; getpid + mov #0,r0 ; R0=0, don't change Carry + sbc r0 ; R0=-1 if getpid() call failed, UnixV4 +.IO_INKEY4 + add #&B5,r0 +#endif +.IO_INKEYdone +rts pc ; Return R0 and restore + +; =ADVAL +; ------ +.IO_ADVAL +cmpb r1,#255 +beq IO_ADVALkbd ; ADVAL(-1) +cmpb r1,#127 +bne IO_BYTEok ; Not ADVAL(128-1), exit +jmp KBD_GETKEYBUF ; Wait for deep keypress +;.IO_ADVALlp +;jsr pc,KBD_GETKEYBUF ; Wait for deep keypress +;bvs IO_ADVALlp ; Current version always waits +;rts pc ; Restore R0 and return +.IO_ADVALkbd +jmp KBD_TestKeyDelay ; R0=keys pending + +; Read EOF status +; --------------- +.IO_EOF +mov r3,-(sp) ; Save R3 +mov r2,-(sp) ; Save R2 +mov r1,r3 ; R3=channel +jsr pc,UX_ArgsRdEof ; Read EOF to r0/r1 +mov (sp)+,r2 ; Restore R2 +mov (sp)+,r3 ; Restore R3 +rts pc ; Return R0 and restore + + +; OSWORD - Host calls with parameters in control block +; ==================================================== +; On entry, R0=action +; R1=>control block +; On exit, All registers undefined +; +; 0 - Read line +; 1 - Read TIME +; 2 - Write TIME +; 3 - Read SYSTIME +; 4 - Write SYSTIME +; 5 - Read from memory +; 6 - Write to memory +; 7 - SOUND +; 8 - ENVELOPE +; 9 - POINT +; 10 - Character definition +; 11 - Read palette +; 12 - Write palette +; 13 - Read graphics positions +; 14 - Read TIME$ +; 15 - Write TIME$ +.IO_WORD +cmp r0,#1 +beq UNIX_WORD1 ; OSWORD 1 - Read TIME +bcc UNIX_NOTWORD +JMP IO_WORD0 ; OSWORD 0 - Read line + +#ifndef NOEMT + .UNIX_NOTWORD + emt 3 ; Ask host to do OSWORD call + rts pc +#endif + +; Read TIME +; --------- +.UNIX_WORD1 +; On entry, R1=>5-byte block to read time to +; On exit, R1=>centisecond time +; +mov r0,-(sp) ; Save registers +mov r2,-(sp) +mov r3,-(sp) +mov r4,-(sp) +mov r1,-(sp) ; Save buffer pointer at top of stack +#ifdef BSD211 +; mov #SV_KBDFETCH+8,-(sp) ; timezone[4], overlaps TRAP_BUF + clr -(sp) ; Don't fetch timezone + mov #SV_KBDFETCH+0,-(sp) ; tv_sec[4], tv_usec[4] + clr -(sp) ; Padding + trap 116 ; SYS gettimeofday + add #6,sp ; Drop from stack + mov SV_KBDFETCH+4,r0 ; Close to 1/16th of a second + mov r0,r1 + add r0,r0 ; r0=us*2 + add r1,r0 ; r0=us*3 + add r0,r0 ; r0=us*6 - close enough to centiseconds + mov SV_KBDFETCH+2,r4 ; r4=seconds + ; Continue to do r4*100+r0 +#else + bitb #FLG_UNIXNEW,SV_SYS; Are we running on Unix7 or later? + beq UX_WORD1b ; No, read one-second time + ;sec + TRAP 35 ; Read millisecond time + EQUW TRAP_BUF ; This is sleep() on Unix6 + ;bcs UX_WORD1b ; Not supported, read one-second time + adr TRAP_BUF+2,r0 + mov (r0)+,r4 ; One-second count + mov (r0),r2 ; Millisecond count + clr r0 + .UX_WORD1lp + inc r0 ; Convert millseconds into centiseconds + sub #10,r2 ; Divide by 10 + bcc UX_WORD1lp ; r0=r2/10 + dec r0 + br UX_WORD1c ; Calculate add seconds and centiseconds + .UX_WORD1b + TRAP 13 ; Read one-second time to r1:r0 + mov r1,r4 + ;mov r0,r3 + clr r0 ; Centisecond count = 0 +#endif +.UX_WORD1c +clr r3 ; Restrict range to prevent overflows, wraps at 45.5days +jsr pc,EvalTimes10 ; Multiply one-second count by 100 +jsr pc,EvalTimes10 ; r3:r4=r3:r4*10, corrupts r1,r2 +add r0,r4 ; Add centisecond count +adc r3 +mov (sp),r1 ; Get buffer pointer back +clr r2 ; b32-b39=zero +mov #5,r0 ; 5 bytes +jsr pc,cmdAssignNumber1 ; Store r4/r3/r2 in memory at r1 +mov (sp)+,r1 ; Restore buffer pointer +mov (sp)+,r4 ; Restore registers +mov (sp)+,r3 +mov (sp)+,r2 +mov (sp)+,r0 +#ifdef NOEMT + .UNIX_NOTWORD +#endif +rts pc + + +; OSRDCH - Wait for character from input stream +; ============================================= +; On exit, R0=character +; CC=not escape, CS=escape +; +;.IO_RDCH +;jsr pc,IO_GETKEY0 ; Test for waiting keypress +;bvs IO_RDCH ; Loop until key pressed +;rts pc + +; Read from keyboard input +; ------------------------ +; On exit: VS=No keypress +; VC=Key press returned +; R0=8-bit character code +; CC=Not Escape +; CS=Escape and ESCFLG set if enabled +; +.IO_RDCH +.IO_GETKEY0 +tstb SV_ESCFLG ; Pending Escape state? ; V cleared, C cleared +bmi IO_GETKEYesc ; Escape pending +jsr pc,KBD_GETKEYBUF ; Read from keyboard +tstb SV_ESCFLG +bmi IO_GETKEYesc ; Pending Escape +bic #&FF00,r0 ; Ensure 8-bit keycode ; V cleared, C unchanged +cmp r0,#27 ; Check for CHR$27 ; V cleared, C unknown +clc ; ; V cleared, C cleared +bne IO_GETKEYdone ; Return with CC if not CHR$27 +bitb #FLG_NOTTY0+FLG_ESCAPE,SV_SYS ; V cleared, C unchanged +bne IO_GETKEYdone ; If not a TTY, or Escape disabled, return with CC +movb #&FF,SV_ESCFLG ; Set Escape flag +.IO_GETKEYesc +sec ; CS=Escape +jmp KBD_GETKEYesc ; Return R0=27 + +;clc +;;bvs IO_GETKEYdone ; No keypress, exit - current version always waits +;bic #&FF00,r0 ; Ensure 8-bit keycode ; V cleared, C unchanged +;bitb #FLG_NOTTY0+FLG_ESCAPE,SV_SYS ; V cleared, C unchanged +;bne IO_GETKEYdone ; If not a TTY, or Escape disabled, return +;cmp r0,#27 ; Check for CHR$27 ; V cleared, C unknown +;clc ; ; V cleared, C cleared +;bne IO_GETKEYdone ; Return CC if not CHR$27 +;movb #&FF,SV_ESCFLG ; Set Escape flag +;.IO_GETKEYesc +;jmp KBD_GETKEYesc + + +; OSASCI, OSNEWL - Output newline to output stream +; ================================================ +.UNIX_WRCH0 +clr r0 ; Output VDU 0 +.IO_ASCI +CMP R0,#13 ; Print ASCII character +BNE IO_WRCH ; Not , output it +.IO_NEWL +MOV #10,R0 ; Output +JSR PC,IO_WRCH +.IO_WRCR +MOV #13,R0 ; Output + ; Fall through to... + +; OSWRCH - Output character to output stream +; ========================================== +; On entry, R0=character +; On exit, all registers preserved +; +.IO_WRCH +mov r1,-(sp) ; Save R1 +mov #1,r1 ; Output to channel 1 for VDU +br UNIX_BPUT1 ; Continue into BPUT + + +; OSBPUT - Write a single byte +; ============================ +; On entry, R0=byte to write +; R1=handle +; On exit, All preserved +; +.IO_BPUT +#ifdef BSD211 + mov r1,-(sp) ; Save channel + .UNIX_BPUT1 + sec + br IO_RDWR +#else + mov r1,-(sp) ; Save channel + .UNIX_BPUT1 + mov r0,-(sp) ; Save character + movb r0,CHAR_BUF ; Store char in buffer + mov r1,r0 ; r0=handle + trap 4 ; write() + equw CHAR_BUF ; address=buffer + equw 1 ; count=1 + mov (sp)+,r0 ; Restore r0 + mov (sp)+,r1 ; Restore r1 + rts pc +#endif + + +; OSBGET - Read a single byte +; =========================== +; On entry, R1=handle +; On exit, R0=byte read +; +#ifdef BSD211 +.UNIX_BGET0 + mov r1,-(sp) ; Save R1 + clr r1 ; Read from STDIN + br UNIX_BGET1 +.IO_BGET + mov r1,-(sp) ; Save handle +.UNIX_BGET1 + clr r0 ; Clear Carry and prepare character=&0000 +.IO_RDWR ; CLC=BGET, SEC=BPUT + mov r0,-(sp) ; Save character or make space + mov sp,r0 ; r0=>character space + mov #1,-(sp) ; length + mov r0,-(sp) ; =>character + mov r1,-(sp) ; channel + mov r1,-(sp) ; padding, don't change Carry + bcc IO_READ ; CLC=read + trap 4 ; write() + cmp (sp)+,(sp)+ ; Drop padding and channel + cmp (sp)+,(sp)+ ; Drop pointer and length + br IO_NOTEOF3 ; Skip EOF processing for writing +.IO_READ + trap 3 ; read() + mov (sp)+,r1 ; Remove padding + mov (sp)+,r1 ; R1=channel used + cmp (sp)+,(sp)+ ; Drop pointer and length + tst r0 ; Test count of bytes returned, clears Carry + bne IO_NOTEOF2 ; Not EOF, return with CLC + mov #254,(sp) ; Replace with -2=EOF + movb SV_RDWRFLAGS,r0 ; Get last channel used + movb r1,SV_RDWRFLAGS ; Set last channel used + cmpb r1,r0 ; Was last call on this channel? + sec + bne IO_NOTEOF3 ; Not yet reported EOF, return with R0=-2, SEC + jsr pc,Error + equb &DF,"EOF",0 + align +.IO_NOTEOF2 + clrb SV_RDWRFLAGS ; Clear 'already returned EOF' flag, clear carry +.IO_NOTEOF3 + mov (sp)+,r0 ; Get or restore character + mov (sp)+,r1 ; Restore r1 +#else +.UNIX_BGET0 + clr r0 ; Read from STDIN + br UNIX_BGET1 +.IO_BGET + mov r1,r0 ; R0=handle +.UNIX_BGET1 + clr CHAR_BUF + mov r1,-(sp) ; Save channel + trap 3 ; read() + equw CHAR_BUF ; address=buffer + equw 1 ; count=1 +;;; + tst r0 ; Test count of bytes returned, clears Carry + bne IO_NOTEOF2 ; Byte returned, return it with CLC + mov #254,r0 ; Replace with -2=EOF + movb SV_RDWRFLAGS,r1 ; Get 'already returned EOF' flag + movb (sp),SV_RDWRFLAGS ; Set 'already returned EOF' flag + cmpb (sp),r1 ; Have we already returned EOF on this channel? + sec + bne IO_NOTEOF3 ; Not yet returned EOF, return with R0=-2, SEC + jsr pc,Error + equb &DF,"EOF",0 + align +.IO_NOTEOF2 + clrb SV_RDWRFLAGS ; Clear 'already returned EOF' flag, clear carry + mov CHAR_BUF,r0 ; Fetch char from buffer, b8-b15 already cleared +.IO_NOTEOF3 + mov (sp)+,r1 ; Restore channel +;;; 18 +; tst r0 ; Test count of bytes returned, clears Carry +; bne IO_NOTEOF2 ; Not at EOF, return with CLC +; mov #254,CHAR_BUF ; Replace with -2=EOF +; cmpb (sp),SV_RDWRFLAGS +; sec +; bne IO_NOTEOF1 ; At EOF, return with R0=-2, SEC +; jsr pc,Error +; equb &DF,"EOF",0 +; align +;.IO_NOTEOF1 +; movb (sp),SV_RDWRFLAGS ; Last channel used +;.IO_NOTEOF2 +; mov (sp)+,r1 ; Restore channel +; mov CHAR_BUF,r0 ; Fetch char from buffer, b8-b15 already cleared +;;; 16 +#endif +.IO_GETKEYdone +rts pc + + +; OSFIND - Open/close a file +; ========================== +; On entry, close: R0=0, R1=handle +; open: R0<>0, R1=>filename +; On exit, close: all preserved +; open: R0=handle +; R1 preserved +; +.IO_FIND +tst r0 +bne UX_OPEN +mov r1,r0 ; r0=handle +;beq UX_CLOSEall ; to do: close all +; Fall through to close R0 + +.UX_CloseR0 +cmp r0,#3 +bcs UX_CloseExit ; Don't close STDIN/STDOUT/STERR +#ifdef BSD211 + mov r0,-(sp) ; handle + clr -(sp) ; padding + trap 6 ; close(handle) + cmp (sp)+,(sp)+ ; drop parameters +#else + trap 6 ; close(handle) +#endif +.UX_CloseExit +clr r0 ; R0=0 for CLOSE +rts pc + +.UX_OPEN +rol r0 +rol r0 +swab r0 +bic #&FFFC,r0 ; r0=1/2/3 +dec r0 ; r0=0/1/2 +.UX_OPEN2 +jsr pc,UX_StringSpc ; Convert to null-string terminated by space or control, R0 preserved +#ifdef BSD211 + ; O_RDONLY=&o00000 + ; O_WRONLY=&o00001 + ; O_RDWR =&o00002 + ; O_CREAT =&o01000 + mov #&o666,-(sp) ; mode wr-wr-wr- + mov r0,-(sp) ; flags, 0=openin, 1=openout, 2=openup + dec r0 ; r0=-1/0/1 + bne UX_Open3 ; Jump to do openin/openup + mov #&o01001,(sp) ; Replace with O_CREATE+O_WRONLY for openout + .UX_Open3 + mov r1,-(sp) ; filename + clr -(sp) ; padding + trap 5 ; open(filename,flags,mode) + rol r0 ; save Carry + add #8,sp ; drop parameters, clear carry + ror r0 ; get Carry and handle back +#else + mov #&8905,TRAP_BUF ; trap 5 - open() + mov r1,TRAP_BUF+2 ; filename + mov r0,TRAP_BUF+4 ; action + dec r0 ; r0=-1/0/1 + bne UX_Open3 ; Jump to do openin/openup + mov #&8908,TRAP_BUF+0 ; Change to trap 8 - creat() for openout + mov #&o666,TRAP_BUF+4 ; mode wr-wr-wr- + .UX_Open3 + trap 0 ; indir() + equw TRAP_BUF ; r0=open(filename,input) or r0=creat(filename,mode) +#endif +bcc UX_OpenOk +clr r0 ; Nothing opened, return R0=0 +.UX_OpenOk +tst r0 ; Set EQ from R0 +rts pc + + +; OSARGS - Read/write open file information +; ========================================= +; On entry, R0=action +; R1=channel +; R2=>data word +; On exit, R0=filing system number (for R0=0,R1=0) +; R0<>0 if function doesn't exist (returns R0 preserved) +; R0=0 if function supported +; R1=preserved +; R2=preserved +; r2=>updated data word +; +; When called from BASIC, there will be at least 224 bytes available +; on the stack due to the 256-byte check on entry to Evaluator +; +.IO_ARGS +cmpb r0,#255 +beq UX_ArgsFF ; ARGS &FF - Update files +tst r1 +bne UX_ARGS ; Handle<>0, open file information +tst r0 +bne UX_ARGSbbc ; Not read FS number, pass on to BBC vector +#ifndef BSD211 + #ifndef NOEMT + sec ; Prepare SEC for EMT call + emt 8 ; Check for BBC host + bcc UX_FSok ; BBC responded, use it + #endif +#endif +mov #24,r0 ; R0=24 for UnixFS +.UX_FSok +rts pc + +.UX_ArgsFF +trap 36 ; sync() +clr r0 ; R0=0 - call actioned +.UX_ARGSbbc +rts pc + +.UX_ARGS +; 0 - =PTR +; 1 - PTR= +; 2 - =EXT +; 3 - EXT= +; 4 - =Alloc -> =EXT +; 5 - =EOF +; 6 - Alloc= -> EXT= +cmp r0,#7 +bcc UX_ARGSbbc ; Unrecognised, pass to BBC vector +mov r3,-(sp) ; Save R3 +mov r1,r3 ; R3=handle +mov r2,-(sp) ; Save R2=>data +mov r0,-(sp) ; Save R0=action +jsr pc,FetchWord ; R0/R1=[R2], fetch data word, r2=r2+4, R1=lo, R0=hi +mov (sp)+,r2 ; Get action back to R2 +jsr pc,UX_ArgsDispatch +mov (sp),r2 ; Get R2=>data +jsr pc,StoreWord ; [R2]=R0/R1, store data word, r2=r2+4, R1=lo, R0=hi +mov (sp)+,r2 ; Restore R2=>data +mov r3,r1 ; Restore R1 +mov (sp)+,r3 ; Restore R3 +clr r0 ; R0=0 - call actioned +rts pc + +; R0/R1=data word, R2=action, R3=channel +; -------------------------------------- +.UX_ArgsDispatch +cmp r2,#5 +beq UX_ArgsRdEof ; 5 - =EOF +bcc UX_ArgsWrExt ; 6 - Alloc= +cmp r2,#3 +beq UX_ArgsWrExt ; 3 - EXT= +bcc UX_ArgsRdExt ; 4 - =Alloc +cmp r2,#1 +beq UX_ArgsWrPtr ; 1 - PTR= +bcc UX_ArgsRdExt ; 2 - =EXT +; +; Read/Write PTR +; -------------- +.UX_ArgsRdPtr ; data=PTR, R2=0 +mov #2,r2 +.UX_ArgsRdPtr2 +clr r0 +clr r1 +.UX_ArgsWrPtr ; PTR=data, R2=1 +dec r2 ; R2=0 - PTR=data, R2=1 - data=PTR, R2=2 - data=EXT +#ifdef BSD211 + mov r2,-(sp) ; whence + mov r1,-(sp) ; lo + mov r0,-(sp) ; hi + mov r3,-(sp) ; fd + clr -(sp) ; padding + trap 19 ; lseek(fd, offset, whence) + add #10,sp ; Drop parameters +#else + bitb #FLG_UNIXNEW,SV_SYS; Are we running on Unix7 or later? + bne UX_ArgsSeek ; Unix7, use 24-bit pointer + mov r1,r0 ; Move 'offset.lo' to BUF+2 + mov r2,r1 ; Move 'whence' to BUF+4, only 16-bit pointer + .UX_ArgsSeek + ; ; r3 r0 r1 r2 r3 r0 r1 + mov r2,TRAP_BUF+6 ; Set up lseek(fd, hi, lo, 0) or seek(fd, lo, 0) - PTR=0+hi.lo + mov r1,TRAP_BUF+4 ; or lseek(fd, 0, 0, 1) or seek(fd, lo, 1) - PTR=PTR+0 + mov r0,TRAP_BUF+2 ; or lseek(fd, 0, 0, 2) or seek(fd, lo, 2) - PTR=EXT+0 + mov #&8913,TRAP_BUF ; trap 19 - lseek() + mov r3,r0 ; R0=handle + trap 0 + equw TRAP_BUF +#endif +rts pc +; +; Read EXT/Alloc +; -------------- +.UX_ArgsRdExt ; =EXT +jsr pc,UX_ArgsRdPtr ; Read PTR, R1=lo R0=hi +mov r1,-(sp) ; Save PTR +mov r0,-(sp) +mov #3,r2 ; 3-1=2 -> Read PTR from end of file +jsr pc,UX_ArgsRdPtr2 ; Set PTR to end of file, returning EXT +mov r1,-(sp) ; Save this PTR which is the EXT +mov r0,-(sp) +mov 6(sp),r1 ; Get old PTR back +mov 4(sp),r0 +dec r2 ; 1-1=0 -> Read PTR from end of file +jsr pc,UX_ArgsWrPtr ; Restore PTR to where it was +mov (sp)+,r0 ; Get saved EXT back, R1=lo R0=hi +mov (sp)+,r1 +cmp r0,(sp)+ ; CC+NE: PTRhiEXThi (impossible) +bne UX_ArgsWrExtNE ; Not at EOF, drop PTRlo and return CLC +cmp r1,(sp)+ ; CC+NE: PTRloEXTlo (impossible) +bne UX_ArgsWrExt ; Not at EOF, return CLC +sec ; At EOF, return SEC +rts pc +.UX_ArgsWrExtNE +tst (sp)+ ; Drop PTRlo, also CLC +.UX_ArgsWrExt +rts pc +; +; Read EOF +; -------- +.UX_ArgsRdEof ; =EOF +tst r3 +beq UX_ArgsRdEofKBD ; EOF#0 - test keyboard +jsr pc,UX_ArgsRdExt ; Read EXT and compare with PTR, SEC=at EOF +bcs UX_ArgsAtEof ; At EOF, return TRUE +.UX_ArgsAtEof0 +clr r1 +clr r0 +rts pc +.UX_ArgsRdEofKBD +jsr pc,KBD_TestKeyDelay ; R0=0 at EOF, R0<>0, not EOF +tst r0 +bne UX_ArgsAtEof0 ; Return FALSE +.UX_ArgsAtEof +mov #-1,r1 ; Return TRUE +mov r1,r0 +rts pc + + +; OSGBPB - Read/write multiple bytes +; ================================== +; On entry, R0=action +; R1=>control block +; On exit, Control block updated +; +.IO_GBPB +tst r0 +beq UX_GBPBbbc +cmp r0,#5 +bcc UX_GBPBbbc +tstb 4(r1) ; Check top bit of address +bmi UX_GBPBbbc ; Using I/O memory, pass to BBC vector +mov r3,-(sp) ; Save registers +mov r2,-(sp) +mov r1,r2 ; r2=>control block +movb (r1),r1 +bic #&FF00,r1 ; r1=channel +mov r2,-(sp) ; Stack address of control block +mov r1,-(sp) ; Stack channel +mov r0,-(sp) ; Save action +add #9,r2 ; r2=>PTR field +mov r1,r3 ; r3=channel +bit #1,r0 +beq UX_NoPtr ; Even numbered call, use existing PTR +jsr pc,FetchWord ; Get PTR from control block to r0/r1, r2=>next word +mov #1,r2 ; R2=1 for Write PTR +jsr pc,UX_ArgsWrPtr ; Set PTR +br UX_PtrReady +.UX_NoPtr +jsr pc,UX_ArgsRdPtr ; Get PTR to r0/r1 +jsr pc,StoreWord ; and store in control block, r2=>next word +; +.UX_PtrReady +mov 4(sp),r2 ; r2=>control block +inc r2 ; Point to address +jsr pc,FetchWord ; r1=address, r2=>count +mov r1,r3 ; r3=address +jsr pc,FetchWord ; r1=count +cmp (sp)+,#3 ; CC=read, CS=write +mov (sp)+,r0 ; Get handle +jsr pc,UX_DataTrans ; Transfer data, r0=handle, r3=address, r1=count + ; On return, r0=actual count done +mov r0,r3 ; r3=count actually done +mov (sp),r2 ; Get control block address +inc r2 ; Point to address +jsr pc,FetchAddStore ; Update address, r2=>count +jsr pc,FetchWord ; Get count, r2=>ptr +sub r3,r1 +sbc r0 +sub #4,r2 ; r2=>count +jsr pc,StoreWord ; Update count, r2=>ptr +jsr pc,FetchAddStore ; Update PTR +mov (sp)+,r1 ; Restore registers +mov (sp)+,r2 +mov (sp)+,r3 +clr r0 ; R0=0 for action completed +.UX_GBPBbbc +rts pc + +; Transfer data, r0=handle, r3=address, r1=count, CC=read, CS=write +; On return, r0=actual count done +.UX_DataTrans +#ifdef BSD211 + mov r1,-(sp) ; count + mov r3,-(sp) ; start + mov r0,-(sp) ; channel + mov r0,-(sp) ; padding, don't change Carry + bcs UX_TransWR ; CS=write + trap 3 ; read() + br UX_Trans4 + .UX_TransWR + trap 4 ; write() + .UX_Trans4 + rol r0 ; Save Carry + add #8,sp ; Drop parameters + ror r0 ; Get Carry back +#else + mov #&8903,r2 ; r2=trap 3 - read() + bcc UX_DataTrans2 + inc r2 ; r2=trap 4 - write() + .UX_DataTrans2 + mov r2,TRAP_BUF+0 ; trap 3/4 + mov r3,TRAP_BUF+2 ; Store address + mov r1,TRAP_BUF+4 ; Store count + trap 0 ; indir() + equw TRAP_BUF ; read/write(buffer,count) +#endif +rts pc + + +; OSFILE - Load/save/info on whole files +; ====================================== +; On entry, R0=action +; R1=>control block +; On exit, Control block updated +; +.IO_FILE +incb r0 +cmp r0,#2 +bcs UX_FILE ; 0/1 -> Load/Save +decb r0 +rts pc + +; OSFILE &FF/&00 - Load/Save file +; ------------------------------- +.UX_FILE +mov r5,-(sp) ; All registers used +mov r4,-(sp) +mov r3,-(sp) +mov r2,-(sp) +mov r1,-(sp) +mov r0,r4 ; r4=0/1 -> Load/Save +mov r1,r2 ; r2=>control block + +; Get filename and open file +; -------------------------- +jsr pc,FetchWord ; r1=>fname, r0=corrupted, r2=r2+4 +tst r4 +bne UX_File1 ; Jump for Save File +dec r4 ; Prepare error=-1 +tstb 2(r2) ; Test for 'load to specified address' +bne errBadAddress ; No address supplied, Unix doesn't have file address, error +inc r4 ; Restore R4=LOAD +sub #8,r2 ; Prepare to point r2=>control block load address +.UX_File1 +mov r4,r0 +jsr pc,UX_OPEN2 ; Open file with R0 0=LOAD, 1=SAVE +beq UX_FileError ; r4=0/1, error occured in load/save (not found, can't save, insuf. access) +add #6,r2 ; r2=>control block start address or load address +mov r0,r5 ; r5=channel + +; Get start address and length, do read/write +; ------------------------------------------- +jsr pc,FetchWord ; Get load/start address from control block, r2=>next word +mov r1,r3 ; r3=start address +mov sp,r1 ; r1=end address, bottom of stack +tst r4 +beq UX_File2 ; Load up to bottom of stack +jsr pc,FetchWord ; Get end address from control block +.UX_File2 +sub r3,r1 ; r1=length to load/save +mov r5,r0 ; r0=channel +cmp #0,r4 ; CC=load, CS=save +jsr pc,UX_DataTrans +bcs UX_FileErrorClose ; r4=2/3, error occured in load/save + +; Update control block +; -------------------- +mov r0,r1 +clr r0 ; &r0:r1=length of file +mov (sp),r2 ; Get address of control block back +add #10,r2 ; Point to 'length' in control block +jsr pc,StoreWord +mov r5,r0 ; r0=handle +jsr pc,UX_CloseR0 ; close(handle) +mov (sp)+,r1 +mov (sp)+,r2 +mov (sp)+,r3 +mov (sp)+,r4 +mov (sp)+,r5 +mov #1,r0 ; Return 'File found' +rts pc + +; Error occured during OSFILE +; --------------------------- +; *BUG* Should check returned error +.UX_FileErrorClose +mov r5,r0 ; r0=handle +jsr pc,UX_CloseR0 ; close(handle) +.UX_FileError +movb r0,SV_STEP ; *TEST* Somewhere to store UXERRNUM +mov #msgFileNotFound,r0 +dec r4 +bmi UX_FileErrRet ; r4=0, Load -> File not found (or insufficient access) +mov #msgCantOpen,r0 +dec r4 +bmi UX_FileErrRet ; r4=1, Save -> Can't save file (or insufficient access) +mov #msgReadError,r0 +dec r4 +bmi UX_FileErrRet ; r4=2, Load -> Read error, usually invalid memory +adr msgWriteError,r0 ; r4=3, Save -> Write error, usually Disk full +.UX_FileErrRet +JMP ErrorHandler ; Generate error with R0=>block +; +.errBadAddress +jsr pc,Error +equb 252,"Bad address",0 +.msgFileNotFound +equb 214,"File not found",0 +.msgCantOpen +equb 192,"Can't save file",0 +.msgReadError +equb 202,"Read error",0 +.msgWriteError +equb 198,"Disk full",0 +;equb 202,"Write error",0 +;equb 202,"Data lost",0 +align + + +; Convert cr-string to nul-string for Unix calls +; ============================================== +; On entry, r1=>string +; On exit, r1=>string + +; Copy only first space-terminated string to null-string +; ------------------------------------------------------ +.UX_String +.UX_StringSpc +jsr pc,UX_StringCopyR1 +mov r1,-(sp) ; Save pointer to string +.UX_StringLp +cmpb (r1)+,#33 ; Loop until CtrlChar or Space +bcc UX_StringLp +clrb -(r1) ; Store terminating zero +mov (sp)+,r1 +rts pc + +; Copy cr-string to null-string +; ----------------------------- +; On entry, r0=>source string +; On exit, r1=>converted string +; +.UX_StringCopy +mov r0,r1 +.UX_StringCopyR1 +mov r0,-(sp) ; Save R0 +;adr SV_INPUT,r0 +mov #SV_INPUT,r0 +.UX_StrCpyPre +cmpb (r1)+,#32 +beq UX_StrCpyPre ; Skip any leading spaces +dec r1 ; Balance increments +.UX_StrCpyLp +cmpb (r1),#32 ; Terminate at first CtrlChar +bcs UX_StrCpyDone +movb (r1)+,(r0)+ +#ifdef KBDUPPER + cmpb -1(r0),#ASC"@" + bcs UX_StrCpyLp ; Not a letter + bisb #32,-1(r0) ; Force to lower case +#endif +br UX_StrCpyLp +.UX_StrCpyDone +clrb (r0) +;adr SV_INPUT,r1 +mov #SV_INPUT,r1 +mov (sp)+,r0 ; Restore R0 +rts pc + + +; CONSOLE INPUT +; ~~~~~~~~~~~~~ + +; Check for Escape state +; ---------------------- +;.IO_EscapeFast +;movb #1,SV_TICKER ; Bypass ticker +.IO_Escape +tstb SV_ESCFLG ; Check local Escape flag +bmi errEscape ; Background Escape pending +bitb #FLG_ESCAPE,SV_SYS ; Is Escape disabled? +bne IO_NoEscape ; Don't test for Escape +#ifndef BSD211 + ; BSD2.11 uses polling + #ifndef ESCPOLL + bitb #FLG_UNIXNEW,SV_SYS ; Test for Unix v7+ + bne IO_NoEscape ; Escape being tested for in background + #endif +#endif +decb SV_TICKER ; Only test Escape every so often +bne IO_NoEscape +#if KBD_TICK=0 + clrb SV_TICKER ; Reset Unix v6/v5 Escape ticker +#else + movb #KBD_TICK,SV_TICKER ; Reset Unix v6/v5 Escape ticker +#endif +.IO_EscapeFast ; Bypass ticker +.IO_Escape2 +jsr pc,KBD_TestKey ; r0=0 if nothing pending +beq IO_NoEscape +jsr pc,KBD_WaitKey ; Get next character from STDIN +cmpb r0,#27 +bne IO_EscapePushback ; Not , push it back +jsr pc,KBD_TestKeyDelay ; r0=0 if nothing pending +beq errEscape ; - Escape key +.IO_EscapePushbackLp +jsr pc,KBD_WaitKey ; Swallow keypress +.IO_EscapePushback +jsr pc,KBD_TestKey ; r0=0 if nothing pending +bne IO_EscapePushbackLp ; Flush keyboard buffer +;movb r0,SV_KBDBUF +;incb SV_KBDQ +.IO_NoEscape +rts pc +.errEscape +clrb SV_KBDQ ; Clear keyboard queue +jsr pc,Error ; Generate Escape error +equb 17,"Escape",0 +align + +#ifndef BSD211 + .IO_TTYfetch4 + add #4,r1 ; PTR=R1+4 + .IO_TTYfetchR1 + mov r1,SV_KBDFETCH+2 ; Set PTR + .IO_TTYfetch + mov r0,-(sp) ; Save handle + trap 0 + equw SV_KBDFETCH ; seek() + mov (sp)+,r0 ; Get handle + .IO_TTYfetch1 + mov r0,-(sp) ; Save handle + trap 3 ; read() + equw SV_KBDTEST ; =>buffer + equw 2 ; read two bytes + mov (sp)+,r0 ; Get handle back + mov SV_KBDTEST,r1 + rts pc + + .IO_TTYmem + equs "/dev/mem",0 + align +#endif + +.KBD_TestKeyDelay +.KBD_WaitKeyDelay +; On exit, EQ=no key waiting, R0=0 +; NE=keypress present, R0=non-zero +#ifdef BSD211 +.BSDKBDWAIT EQU 8 ; 8 * 1/16th sec to wait + clr -(sp) ; Timer workspace + clr -(sp) ; Don't fetch timezone + mov #SV_KBDFETCH+0,-(sp) ; tv_sec[4], tv_usec[4] + mov #BSDKBDWAIT,-(sp) ; Wait up to 16*1/16 sec + trap 116 ; SYS gettimeofday, SV_KBDFETCH+4=1/16th sec counter + mov SV_KBDFETCH+4,6(sp) ; 6(sp)=start time + .KBD_WaitKeyDelayLp + jsr pc,KBD_TestKey + bne KBD_WaitKeyDelayPressed ; Key pressed + .KBD_WaitKeyDelayLp2 + trap 116 ; SYS gettimeofday + cmp SV_KBDFETCH+4,6(sp) + beq KBD_WaitKeyDelayLp2 ; Wait until 1/16s counter changes + dec (sp) + bne KBD_WaitKeyDelayLp ; Loop for number of 1/16ths seconds + clr r0 ; Nothing pressed + .KBD_WaitKeyDelayPressed + add #8,sp ; Drop parameters + tst r0 ; Set flags + rts pc +#else + mov r1,-(sp) ; time() modifies R1 + mov #KBD_DELAY,-(sp) ; Fiddled by experimentation + .KBD_WaitKeyDelayLp + trap 13 ; Pause a mo and allow delays to pass, corrupts R0,R1 + dec (sp) + bne KBD_WaitKeyDelayLp + tst (sp)+ + mov (sp)+,r1 ; Restore R1 for caller +#endif +; ; Continue into TestKey +; +.KBD_TestKey +; On exit, EQ=no key waiting, R0=0 +; NE=keypress present, R0=non-zero +movb SV_KBDQ,r0 +bne KBD_TestKeyOk +mov r1,-(sp) ; seek() and ioctl() modifies R1 +#ifdef BSD211 + mov #SV_KBDTEST-2,-(sp) ; addr=SV_KBDTEST-2, low word in SV_KBDTEST + mov #ASC"f"*256+127,-(sp) ; FIONREAD + mov #&4004,-(sp) ; b14=get, 4 bytes to read + clr -(sp) ; fd=STDIN + clr -(sp) ; Padding + trap 54 + add #10,sp ; Drop from stack +#else + clrb SV_KBDTEST ; Prepare 'none' + bitb #FLG_UNIXV9,SV_SYS ; Is FIONREAD available? + beq KBD_TestFetch ; Read kbdQ manually + trap 54 ; ioctrl() + equw 0 ; stdin + equb 127,"f" ; FIONREAD + equw SV_KBDTEST-2 ; Read number of keys pending + br KBD_TestKeyExit + ; + .KBD_TestFetch + mov SV_KBDFETCH+2,r0 ; If offset=0, no kbdQ found + bis SV_KBDFETCH+4,r0 + beq KBD_TestKeyExit + trap 5 ; open() + equw IO_TTYmem ; =>"/dev/mem" + equw 0 ; 0=read + bcs KBD_TestKeyExit ; Failed to open, return prepared 0 + jsr pc,IO_TTYfetch ; Seek to kbdQ and fetch + trap 6 ; close() + .KBD_TestKeyExit +#endif +mov (sp)+,r1 ; Restore R1 for caller +movb SV_KBDTEST,r0 ; Get the word read, setting EQ +.KBD_TestKeyOk +rts pc + +.KBD_WaitKey +; On exit, CC=keypress returned, R0=keypress +; CS=Escape, R0=undefined +;movb SV_KBDQ,r0 +;beq KBD_WaitKeyRead ; Nothing pending +;.KBD_WaitKeyPend +;movb SV_KBDBUF,r0 ; Get pending keypress +;br KBD_WaitKeyOk +;.KBD_WaitKeyRead +;jsr pc,UNIX_BGET0 ; Read from STDIN +;tstb SV_KBDQ +;bne KBD_WaitKeyPend +;;bcc KBD_WaitKeyOk ; Not +;;mov #27,r0 ; Return ESCAPE +;.KBD_WaitKeyOk +;clrb SV_KBDQ ; Clear queue, clear C +;rts pc + +movb SV_KBDQ,r0 +bne KBD_WaitKeyPend ; Get pending keypress +jsr pc,UNIX_BGET0 ; Read from STDIN +tstb SV_KBDQ +beq KBD_WaitKeyOk ; Not , return it +.KBD_WaitKeyPend +movb SV_KBDBUF,r0 ; Get pending keypress +.KBD_WaitKeyOk +clrb SV_KBDQ ; Clear queue, clear C +rts pc + + +; Link to embedded code +; --------------------- +.SV_EMBED +EQUW 0 ; No embedded program + +; End of saved program code +; ------------------------- +.CodeEnd ; End of 'text/code' section +.DataEnd ; End of 'data' section +BSS ; End of saved portion + +; TTY settings +; ------------ +.SV_TTY ; TTY settings + EQUB 0 ; ispeed + EQUB 0 ; ospeed + EQUB 0 ; erase # + EQUB 0 ; kill @ + EQUB 0 ; flags + ; 1 Automatic flow control + ; 2 v6=Expand TABs v7=Half-Raw input + ; 4 Map upper to lower on input + ; 8 Echo + ; 16 Map input CR->LF, output LF or CR -> CR-LF + ; 32 Raw, 8-bit characters + ; 64 Odd parity allowed on input + ; 128 Even parity allowed on input + EQUB 0 ; delays +#ifdef BSD211 + EQUW 0 ; BSD has 32-bit settings +#endif +.SV_OSTTY EQUW 0 ; Host's flags+delay settings + +.SV_IOCTL ; IOCTL characters + EQUB 0 ; interupt DEL + EQUB 0 ; quit Ctrl-\ + EQUB 0 ; start output Ctrl-Q + EQUB 0 ; stop output Ctrl-S + EQUB 0 ; end-of-file Ctrl-D + EQUB 0 ; input delimiter -1 +.SV_OSIOCTL EQUW 0 ; Host's interupt+quit characters + +; Use by background calls, so can't use foreground workspace +.SV_KBDFETCH EQUW 0 ; trap seek() or lseek() + EQUW 0 ; offset.lo or offset.hi + EQUW 0 ; whence=0 or offset.lo + EQUW 0 ; unused or whence=0 +.SV_KBDTEST EQUW 0 ; word read from kernel workspace +.SV_RDWRFLAGS EQUW 0 ; BGET EOF flags, etc. + +; TRAP buffer +; ----------- +;.SV_ERRNO EQUW 0 ; Unix error number +.TRAP_BUF EQUM 8 ; TRAP + three parameters +.CHAR_BUF EQUB 0 ; Seperate buffer so Debug functions work +.SV_TICKER EQUB 0 ; Escape test ticker +ALIGN +.SV_KBDQ EQUB 0 ; Keyboard queue +.SV_KBDBUF EQUB 0 ; Keyboard buffer +ALIGN + +; Memory size +; ----------- +.SV_MEMBOT EQUW 0 ; Bottom of memory +.SV_MEMTOP EQUW 0 ; Top of memory +;.SV_ENVPTR EQUW &0000 ; External environment pointer, only needed if system() needs it. + ; Usually at &FFxx, separated from BASIC memory below &E000 + ; Unix gives us a block of memory at &FC00-&FFFF, initial stack + ; descends from &FFFF with parameters passed. Could this memory + ; be used for anything? It is a handy extra 1K of memory space. + ; On BSD we have to switch it out of memory for stack to work. + diff --git a/src/Variables b/src/Variables new file mode 100644 index 0000000..8587ea7 --- /dev/null +++ b/src/Variables @@ -0,0 +1,743 @@ +; > Variables +; Handle BASIC variables +; 24-Feb-2009: Static integer variables and indirection +; 25-Feb-2009: Reading $ and $$ +; 15-May-2010: VarFind returns combined type/size in r3, works +; 31-Jan-2012: Finds and creates dynamic variables, all heap items now word aligned +; cmdCLEAR now here, VarFind now never returns "invalid name", always gives an error +; 23-Nov-2012: address|offset allowed +; 09-Dec-2013: FindSubroutine moved to here so callable by AddrOf, VarFind tweeked to not +; store terminating bracket with PROCname(, FNname( +; 02-Feb-2014: Array variables returned +; 31-Aug-2015: fnREPORT moved here to return via FindStringVal + + +; CLEAR - Clear heap +; ================== +; LOMEM=TOP +; VAREND=TOP +; DATAPTR=PAGE +; STACK=HIMEM +; Clear dynamic variables +.cmdCLEAR ; Fall through +.VarsHeapInit +mov SV_PAGE,SV_DATA ; DATAPTR=PAGE, start of program +mov (sp),r1 ; Get return address +mov SV_HIMEM,sp ; Clear BASIC stack +clr -(sp) ; Put zero at top of stack +mov sp,SV_STACK ; Clear error stack +mov r1,-(sp) ; Stack return address +mov SV_TOP,r4 ; r4=TOP +br VarsClear + +; LOMEM= - Set heap start, clearing heap +; ====================================== +; Check for '=', evaluate integer +; Set LOMEM +; Set VAREND=LOMEM +; Clear dynamic variables +.cmdLOMEM +jsr pc,EvalEqual ; Check for '=', get integer + +.VarsClear +inc r4 ; Pad upwards, if LOMEM=TOP and TOP is odd +bic #1,r4 ; Ensure word aligned +mov r4,SV_LOMEM ; Set new LOMEM, start of heap +mov r4,SV_VAREND ; Set new VAREND, end of heap +adr SV_VARPTR,r1 ; Point to variables pointers +mov #(SV_ENDPTR-SV_VARPTR)/2,r0 ; Number of pointers +.VarsClearLp +clr (r1)+ ; Clear this pointer +dec r0 +bne VarsClearLp ; Loop for all pointers +.VarFindExit1 +rts pc + + +; VarFindCreateAddress +; ==================== +; Called from AddrOf function +; r0= first character +; r5=>first character +; +.VarFindCreateAddress +tstb r0 +bpl VarFindCreate ; Not FN/PROC, scan for variable + +; VarFindSubroutine - Find a FN/PROC in the heap, or in the program +; ================================================================= +; On entry, r0= FN/PROC token +; r5=>FN/PROC at start of name +; On exit, Error if doesn't exist +; r5=>after end of variable name +; r4=address of data block +; r3/r2/r1/r0=corrupted +; +.VarFindSubroutine +inc r5 ; r5=>FN/PROC name + +; FindSubroutine - called here from FN/PROC dispatch +; -------------------------------------------------- +; On entry, r0= FN/PROC token +; r5=>first character of name +; +.FindSubroutine +mov r0,-(sp) ; Save FN/PROC token +jsr pc,VarFindPROC ; Look for FN/PROC in heap +bne FindSubFound ; In heap, jump to call it + +; Look for DEFPROC/DEFFN in program +; r4=>heap pointer to add to +; r5=>1st char of name +; +mov SV_PAGE,r1 +.FindSubSearch +mov #tknDEF,r0 +jsr pc,TokenFind ; Look for a line starting with DEF +bcc errNoSuchPROC ; End of program with no match found +.FindSubSpace +movb (r1)+,r0 +cmpb r0,#ASC" " +beq FindSubSpace ; Skip spaces after DEF +cmpb r0,(sp) ; Is it a FN/PROC +bne FindSubSearch ; No, keep looking + +; We've now found a DEFPROC or a DEFFN +; r5=>start of FN/PROC name in call +; r4=>heap pointer to add to +; r1=>start of FN/PROC name in definition + +mov r5,r3 +mov r1,r2 +.FindSubLp +movb (r1)+,r0 ; Get character from definition name +jsr pc,VarChkChar ; End of definition name? +bcs FindSubMatch ; Yes, check for end of calling name +cmpb r0,(r3)+ ; Does it match call name? +beq FindSubLp ; Yes, loop to check more characters +bne FindSubSearch ; No match, look for another DEF +.FindSubMatch +movb (r3)+,r0 ; Get character from call name +jsr pc,VarChkChar ; End of name calling name? +bcc FindSubSearch ; Not end of calling name, look for another +dec r3 +dec r1 + +; We've now found a matching DEFPROC or a DEFFN +; r5=>start of FN/PROC name in call +; r4=>heap pointer to add to +; r3=>end of FN/PROC name in call +; r1=>end of FN/PROC name in definition + +mov (sp),r2 ; r2=FN/PROC token +mov r1,-(sp) ; Save destination address +jsr pc,VarCreate ; Create entry in heap + +; r0= terminating calling character +; r2= FN/PROC token +; r3= corrupted +; r4=>data block +; r5=>just after calling FN/PROC name +; (sp)= destination address + +mov (sp)+,(r4) ; Store dest address in heap +.FindSubFound +mov (sp)+,r0 +rts pc + +.errNoSuchPROC +jsr pc,Error +equb 29,"No such ",tknFN,"/",tknPROC,0 +align + + +; VarFindCreate - Find a variable, and create it if non-existant +; ============================================================== +; On entry, r5=>first character of name +; On exit, CS=bad variable name - error generated +; CC=valid variable name +; NE=variable found +; r5=>after end of variable name +; r4=address of data block +; r3=size/type of variable +; 0001 - byte +; 0004 - integer +; 0005 - real +; 8000 - dynamic string +; 8100 - $string +; 8200 - $$string +; 4xxx - array of number +; Cxxx - array of string +; r2/r1/r0=corrupted +; +.VarFindCreate +jsr pc,SkipSpaceThis +.VarFindCreate1 +jsr pc,VarFindExist ; Look for variable +bne VarFindExit1 ; NE - Variable found +clr r2 ; r2=0 - not FN/PROC +; Valid variable name, but doesn't exist +; r4=>last link, aligned +; r5=>second character of variable name +; r2=0 - not FN/PROC or array - don't create entry ending with '(' +; r2<>0 - FN/PROC or array - ok to create entry ending with '(' +; r2<&80 - array - include '(' in entry name +; r2>&7F - FN/PROC - don't include '(' in entry name + +; Variable info block layout: +; <00>
+; %<00>
+; $<00> +; (<00> +; %(<00> +; $(<00> +; <00> +; <00> + +.VarCreate +mov r5,-(sp) ; Save pointer to variable name +mov #16+256,r1 ; Size of info block plus some overhead +.VarCreateLp1 +inc r1 ; Count length of variable name +movb (r5)+,r0 ; Get variable name character +jsr pc,VarChkChar +bcc VarCreateLp1 ; Loop for valid characters + +;This is wrong place for this test +;tst r2 +;bne VarCreate0 ; PROC/FN, terminating '(' allowed +;cmpb r0,#ASC"(" +;bne VarCreate0 +;jmp errArray ; Arrays must already exist +;.VarCreate0 + +mov SV_VAREND,r0 ; End of heap, will be aligned if not manually messed with +add r0,r1 ; Add length of variable name and info block +cmp r1,sp ; Would this overlap stack? +bcs VarCreate1 +jmp errNoRoom +.VarCreate1 +mov (sp)+,r5 ; Get pointer to variable name +mov r0,(r4) ; Point current link to new info block at VAREND +mov r0,r4 ; r4=>new variable info block +clr (r4)+ ; Set next link to zero +.VarCreateLp2 +movb (r5)+,r0 ; Get variable name character +movb r0,(r4)+ ; Store in info block +jsr pc,VarChkChar +bcc VarCreateLp2 ; Loop to end of variable name +; +; r5=v +; a +; a( +; a% +; a$ +; a%( +; a$( +; ab +; ab% +; ab$ +; ab( +; ab%( +; ab$( + +mov #&4000,r3 ; r3=&4000 - FN/PROC +tstb r2 +bmi VarCreatePROC ; FN/PROC, don't add '(' to name +;mov #&8000,r3 ; r3=&8000 - dynamic string +asl r3 ; r3=&8000 - dynamic string +cmpb r0,#ASC"$" +beq VarCreateIntStr +mov #&0004,r3 ; r3=&0004 - integer +cmpb r0,#ASC"%" +beq VarCreateIntStr +inc r3 ; r3=&0005 - real +cmpb r0,#ASC"(" +beq VarCreateArray ; Array or PROC(/FN( +.VarCreatePROC +dec r5 ; Point program back to terminating character +dec r4 ; Step back to terminator +br VarCreateInfo +.VarCreateIntStr +movb (r5),r0 +cmpb r0,#ASC"(" +bne VarCreateInfo +inc r5 ; Step past '(' +movb r0,(r4)+ ; Store '(' in info block +.VarCreateArray +bis #&4000,r3 ; Array +.VarCreateInfo +clrb (r4)+ ; Store terminator +clrb (r4)+ ; Pad to align +bic #1,r4 ; Ensure aligned +mov r4,r1 ; r4=>data block +clr (r1)+ ; Clear first two bytes for array +bit #&4000,r3 +bne VarCreateDone ; Array +clr (r1)+ ; Clear two more bytes for String or Integer +bit #&0001,r3 +beq VarCreateDone ; Not real +clr (r1)+ ; Clear two more bytes for real +.VarCreateDone +mov r1,SV_VAREND ; Update end of heap +rts pc ; r4=>data block + ; r3= data type/size + + +; VarFindExist - Find an existing variable +; ======================================== +; On entry, r5=>first character of name +; On exit, CS=bad variable name - error generated +; r5=preserved +; CC=valid variable name +; EQ=variable not found +; r5=>first character of variable name +; r4=address of previous linked list +; NE=variable found +; r5=>after end of variable name +; r4=address of data block +; r3=size/type of variable +; 0001 - byte +; 0004 - integer +; 0005 - real +; 8000 - dynamic string +; 8100 - $string +; 8200 - $$string +; 4xxx - array of number +; Cxxx - array of string +; r2/r1/r0=corrupted +; +.VarFindExist +movb (r5),r0 ; Get first character +clr r4 ; Zero base for !x, ?x, |x +cmpb r0,#ASC"!" +beq VarFindIndirect ; Evaluate !x as 0!x +cmpb r0,#ASC"?" +beq VarFindIndirect ; Evaluate ?x as 0?x +cmpb r0,#ASC"|" +beq VarFindIndirect ; Evaluate |x as 0|x +cmpb r0,#ASC"$" +beq VarFindChkDol ; Evaluate $ and $$ +cmpb r0,#ASC"@" +bcs VarBadName ; Bad variable name, r5 preserved + +; VarFindVariable - Find a variable ignoring indirections +; ------------------------------------------------------- +.VarFindVariable +movb (r5)+,r0 ; Get first character +cmp r0,#ASC"[" +bcc VarFindDyn ; --> needs to call, then check for |?! +cmpb (r5),#ASC"%" ; Is it % ? +bne VarFindDyn ; No, look for dynamic variable --> indir +cmpb 1(r5),#ASC"(" ; Is it %( ? +beq VarFindDyn ; Yes, look for dynamic array entry --> indir +inc r5 ; Step past % +add r0,r0 +add r0,r0 ; r0=ASC""*4 +adr SV_VARS-4*ASC"@",r4 +add r0,r4 ; r4=> +mov #4,r3 ; r3=&0004, integer - number, four bytes +.VarFindCheckIndir +movb (r5),r0 +cmpb r0,#ASC"!" ; Is it var!offset ? +beq VarFindIndir +cmpb r0,#ASC"?" ; Is it var?offset ? +beq VarFindIndir +cmpb r0,#ASC"|" ; Is it var|offset ? +;;clc +bne VarFindExit ; NE=found +mov r5,r1 ; Save program pointer in R1 +inc r5 ; Step past | +jsr pc,CheckEndStatement +bne VarFindIndirReal ; Not expression| +mov r1,r5 ; Restore program pointer, also NE=found +;;clc ; CC=ok, NE=found +;;.VarBadName +.VarFindExit +rts pc +.VarBadName +jmp errSyntax +; +.VarFindIndirReal +movb #ASC"|",r0 ; Restore r0="|" +mov r1,r5 ; Point back to indir operator +.VarFindIndir ; A%?num or A%!num +mov r0,-(sp) ; Stack indirection operator +jsr pc,VarFindValNum ; Get value of % to r4 +br VarFindInd2 +.VarFindChkDol +cmpb 1(r5),#ASC"$" ; Is it $$ ? +bne VarFindIndirect ; No, jump for $ +inc r5 ; Step past first '$' +inc r0 ; Make operator '%' +.VarFindIndirect +mov r0,-(sp) ; Stack indirection operator +.VarFindInd2 +mov r4,-(sp) ; Stack base address +inc r5 ; Step past indirection operator +jsr pc,EvalIntVal ; Evaluate following numeric +add (sp)+,r4 ; Add stacked base to numeric +mov (sp)+,r3 ; Get indirection operator back +cmpb r3,#ASC"!" +beq VarFindPling ; Return with size=4 +cmpb r3,#ASC"$" +beq VarFindDollar ; Return fixed cr-string +cmpb r3,#ASC"%" +beq VarFindDouble ; Return fixed null-string +cmpb r3,#ASC"?" +beq VarFindQuery ; CC=ok, return with size=1 +mov #5,r3 ; |offset, float - number, five bytes +;;clc ; CC=ok, NE=found (clc not needed) +rts pc +.VarFindPling +mov #4,r3 ; name?offset - four bytes, sets NE=found +rts pc +.VarFindQuery +mov #1,r3 ; name?offset - single byte, sets NE=found +rts pc +.VarFindDollar +mov #&8100,r3 ; type=cr-string, sets NE=found +rts pc +.VarFindDouble +mov #&8200,r3 ; type=null-string, sets NE=found +rts pc + +; Look for a FN/PROC in the heap +; ------------------------------ +; On entry, r0= first character of name, FN/PROC +; r5=>second character +; +.VarFindPROC +mov #SV_PROCPTR-SV_VARPTR,r1 +cmpb r0,#tknPROC +beq VarFindDyn1 ; Look through PROC list +mov #SV_FNPTR-SV_VARPTR,r1 +br VarFindDyn1 ; Look through FN list + +; Look for a variable in the heap +; ------------------------------- +; On entry, r0= first character of variable +; r5=>second character +; +.VarFindDyn +jsr pc,VarChkLetter +bcs VarBadName ; Starts with invalid character +add r0,r0 ; r0=initial letter * 2 +.VarFindDyn1 +adr SV_VARPTR-2*ASC"A",r4 +add r0,r4 ; r4=pointer to linked list +; +.VarFindNext +;;clc +mov (r4),r0 ; Get pointer to next item +beq VarFindExit ; End of linked list, exit with EQ, r4=>pointer, r5=>2nd char of name +mov r0,r4 ; r4=>current information block +mov r5,r3 ; r3=>second character of variable name +mov r4,r2 +add #2,r2 ; r2=>start of stored variable name +.VarFindLp +movb (r2)+,r0 ; Get character from stored variable name +cmpb r0,(r3)+ ; Does it match program variable name +beq VarFindLp ; Yes, loop to check more characters +tst r0 ; End of stored variable name? +bne VarFindNext ; No, look for another name +; +dec r3 ; Point back to nonmatching character +dec r3 ; Point back to last matching character +movb (r3),r1 ; Get last matching character +cmpb r1,#ASC"(" +beq VarFindArray ; It's an array +inc r3 +movb (r3),r0 ; Get nonmatching character +jsr pc,VarChkType ; Check if valid variable name or suffix character +bcs VarFindArray ; No more characters, check for array +tstb -1(r5) ; Check first character of name +bpl VarFindNext ; Not a FN/PROC, look for another name +jsr pc,VarChkChar ; Test for middle character +bcc VarFindNext ; More characters in FN/PROC name, look for another name +br VarProcFound ; FN/PROC name found +.VarFindArray +dec r3 ; Step back to type character +movb (r3)+,r0 ; Get type character, step past character +inc r3 ; Step past '(' +sbc r3 ; Step back if not '(' +.VarProcFound +mov r3,r5 ; r5=>character after end of name +mov r2,r4 ; r4=>variable data block +inc r4 +bic #1,r4 ; Align data block +mov #&8000,r3 ; Type=string +cmpb r0,#ASC"$" +beq VarFound +mov #&0004,r3 ; Type=integer +cmpb r0,#ASC"%" +beq VarFound +inc r3 ; Type=real +.VarFound +cmpb r1,#ASC"(" +beq VarArrayFound ; Check for array references +tst r3 ; NE=found, MI=string, PL=number +bmi VarFindExit3 ; Exit with string +jmp VarFindCheckIndir ; Number - test for indirection +; matching variable name found +; name<00> +; name%<00> +; name$<00> + +.VarArrayFound +cmpb (r5),#ASC")" ; Is it array() +bne VarArrayIndex +inc r5 ; Step past ')' +bis #&4000,r3 ; NE=found, &40=array, MI=string, PL=number +.VarFindExit3 +;;clc ; CC=ok +rts pc +; name(<00> +; name%(<00> +; name$(<00> + +.VarArrayIndex +; r5=>m,n,o,p) +; r4=>pointer to array info +;mov (r4),r4 ; r4=>array info +;beq errArray ; Array undefined +; +; r4=>dims, dim1, dim2, dim3, dim4 +; r3=object type &8000, &0005, &0004 +; +mov r3,-(sp) ; Save object type +mov (r4)+,-(sp) ; Save number of dimensions +clr -(sp) ; Save initial index into array +mov r4,-(sp) ; Save address of dimensions list +br VarArrayParse +.VarArrayLp +cmpb (r5)+,#ASC"," +bne errBadSubscript +mov r3,-(sp) ; Stack current index +mov r1,-(sp) ; Stack pointer to current dimension +.VarArrayParse +jsr pc,EvalInteger ; Evaluate dimension +tst r3 +bne errBadSubscript ; sub>65535 - too big +mov (sp)+,r1 ; r1=>current dimension +mov (r1)+,r3 ; r3= current dimension +inc r3 ; Add one to get dimension size +cmp r4,r3 ; Is subscript larger than dimension? +bcc errBadSubscript +mov (sp)+,r2 ; r2=current index +; +; sp=>num, type +; r4=subscript +; r3=current dimension max +; r2=current index +; r1=>next dimension +; +#ifndef NOMUL +mul r2,r3 ; r3=r2*r3 - offset=offset*size +#else +jsr pc,R2timesR3toR3 ; r3=r2*r3 - offset=offset*size +#endif +add r4,r3 ; offset=offset*size+subscript +dec (sp) ; Decrement number of dimensions +bne VarArrayLp ; Parse next subscript +jsr pc,CheckClose +tst (sp)+ ; Pop num +; +mov (sp)+,r2 ; Get object type +mov r3,r4 +asl r4 +asl r4 ; r4=index*4 +bit r2,#1 +beq VarArrayAdd +add r3,r4 ; r4=index*5 +.VarArrayAdd +add r1,r4 ; r4=>data item +mov r2,r3 ; r3=object size, NE=variable found +rts pc + +.errArray +jsr pc,Error +equb 14,"Array",0 +align +.errBadSubscript +jsr pc,Error +equb 15,"Subscript",0 +align + + +; VarFindVal - Find a variable and return its value +; ================================================= +; On entry, r5=>first character of name +; On exit, r4/r3/r2=value +; r1/r0=corrupted +; +.VarFindVal +jsr pc,VarFindExist ; Find existing variable +;;bcs jmpNoSuchVar ; Bad variable name +; test here for OPT 2 in assembler +beq errNoSuchVar ; Variable not found +.VarFindValFetch +bit #&4000,r3 +bne errArray ; Can't do =array() like this +tst r3 ; r3=1/4/5 int/byte/float, r3=8xxx string +bmi VarFindString ; If string, pointing to string descriptor +.VarFindValNum +clr r2 ; Prepare for integer +movb (r4)+,r0 ; Get first byte +bic #&FF00,r0 +dec r3 +beq VarFindByte ; Single byte +movb (r4)+,r1 ; Get second byte +bic #&FF00,r1 +swab r1 +bis r1,r0 ; r0=1st/2nd bytes +movb (r4)+,r1 ; Get third byte +movb (r4)+,r2 ; Get fourth byte +bic #&FF00,r1 +bic #&FF00,r2 +swab r2 +bis r2,r1 ; r1=3rd/4th bytes +clr r2 ; Prepare for word +cmp r3,#3 +beq VarFindWord +movb (r4),r2 ; Get fifth byte for float +bic #&FF00,r2 +.VarFindWord +mov r1,r3 +.VarFindByte +mov r0,r4 +;;clc +tst r2 +rts pc + +.fnREPORT +cmpb (r5)+,#ASC"$" ; Check for '$' +bne errNoSuchVar +mov SV_FAULT,r4 +inc r4 ; r4=>error string +mov #&8200,r3 ; r3=null-string + ; Fall through to find length of null-string + +; VarFindString - convert string description into full string +; ----------------------------------------------------------- +; If a string found, registers will hold: +; r3=&8000, r4=>aligned string descriptor block = addr.lo, addr.hi, length, allocated +; r3=&8100, r4=>start of cr-string +; r3=&8200, r4=>start of null-string +.VarFindString +mov r3,r2 ; r2=string type +clr r3 ; Set length to zero +clr r0 ; Look for CHR$0 +bit #&0200,r2 ; A null-string? +bne VarFindStrCount +mov #13,r0 ; Look for CHR$13 +bit #&0100,r2 ; A cr-string? +bne VarFindStrCount +movb 2(r4),r3 ; Get string length +bic #&FF00,r3 ; 8-bit length +mov (r4),r4 ; Get string start address +clc ; CLC=OK +tst r2 ; Set flags from string type, also clears Carry +rts pc +.VarFindStrCount +mov r4,r1 ; Copy start address to r1 +.VarFindStrLp +inc r3 ; Increment length +cmp r3,#256 ; String too long? +bcc VarFindStrZero ; No terminator, return null +cmpb (r1)+,r0 ; Terminator found? +bne VarFindStrLp ; No, loop until found or too long +dec r3 ; Remove terminator from count +clc ; CLC=OK +tst r2 ; Set flags from string type, also clears Carry +rts pc +.VarFindStrZero +clr r3 ; Return zero-length string +;;clc ; CLC=OK +tst r2 ; Set flags from string type, also clears Carry +rts pc +.errNoSuchVar +jsr pc,Error +equb 26,"No such variable",0 +align + + +; Array function +; ============== +; =DIM(array()) - returns number of dimensions +; =DIM(array(),n) - return size of dimension n +; +#ifndef NOEXTRAFN +.fnDIM +cmpb (r5)+,#ASC"(" ; Check for opening bracket +bne errArray +jsr pc,VarFindExist ; Look up array +beq errNoSuchVar ; Array doesn't exist +bit #&4000,r3 +beq errArray ; Not an array variable +;mov (r4),r4 ; Get start of array data +;beq errArray ; Array Undimensioned +jsr pc,SkipSpaceThis +cmpb r0,#ASC"," +bne fnDIM2 ; Jump with DIM(array()) to return number of dimensions + +; =DIM(array(),n) +; --------------- +mov r4,-(sp) ; Save address of array info +jsr pc,EvalComma +tst r3 +bne errBadSubscript ; =DIM(array(),>65535) +tst r4 +beq errBadSubscript ; =DIM(array(),0) +mov (sp)+,r3 ; r3=>array info +cmp (r3),r4 +bcs errBadSubscript ; =DIM(array(),n) where n is too large +add r4,r4 ; Double r4 +add r3,r4 ; Add to base of array info +.fnDIM2 +jsr pc,CheckClose +;.fnDIM3 +mov (r4),r4 ; Get number of dimensions or dimension size +clr r3 +clr r2 +;.fnDIMexit +rts pc +#endif + + +; Check if char is valid for a variable name +; ------------------------------------------ +; CS - invalid variable name character +; CC - valid variable name character +; CC EQ - valid terminating character $ % ( +; +.VarChkType ; Test for any character +cmpb r0,#ASC"(" +beq VarChkCharOk ; '(' - exit with CC, EQ +cmpb r0,#ASC"$" +beq VarChkCharOk ; '$' - exit with CC, EQ +cmpb r0,#ASC"%" +beq VarChkCharOk ; '%' - exit with CC, EQ +; +.VarChkChar ; Test for middle character +cmpb r0,#ASC"0" +bcs VarChkCharOk ; <'0' - exit with CS +cmpb #ASC"9",r0 +bcc VarChkCharCC ; '0'-'9' - exit with CC, NE +; +.VarChkLetter ; Test for starting character +cmpb r0,#ASC"A" +bcs VarChkCharOk ; ':'-'@' - exit with CS +cmpb #ASC"Z",r0 +bcc VarChkCharCC ; 'A'-'[' - exit with CC, NE +cmpb r0,#ASC"_" +bcs VarChkCharOk ; '['-'^' - exit with CS +cmpb #ASC"z",r0 +bcs VarChkCharOk ; >'z' - exit with CS + ; '_'-'z' - exit with CC, NE +.VarChkCharCC +tst r0 ; NE, also clears carry +clc ; CC +.VarChkCharOk +rts pc + diff --git a/src/Version b/src/Version new file mode 100644 index 0000000..16ce9bf --- /dev/null +++ b/src/Version @@ -0,0 +1,150 @@ +; > Version +; BBC BASIC for the PDP11 +; (C)J.G.Harston 1988-2023 +; +; Set version information +; ----------------------- +; 24-May-2006 v0.10 Added skeleton error handler +; 28-Jan-2008 v0.11 +; 25-Feb-2009 v0.13 +; 25-Oct-2009 v0.14 Places zero word at top of stack so 2(sp) can be examined +; 25-Jan-2012 v0.15 Program can be edited from immediate mode +; 12-Jul-2013 v0.16 Floating point addition, multiplication, division +; 16-Aug-2013 Tokenising and inserting lines into program callable from TextLoad +; 20-Nov-2013 FOR/NEXT, INSTR() +; 07-Dec-2013 READ, SAVE (noname), PROC/FN (no params), ENDPROC/=. +; 09-Dec-2013 v0.17 AddrOf PROC/FN, PROC/FN(params). +; 25-Dec-2013 v0.18 LOCAL ERROR/DATA/variables, ON ERROR LOCAL, RESTORE + +; 30-Dec-2013 v0.19 Tidied up TTY settings in UnixIO, notes istty() on stdin/stdout, +; fixed Unix6 problems, generalised OSCLI command table. +; INPUT, INPUT# implemented, Unix7 reads centisecond TIME. +; Remove Line doesn't match OSCLI token as end-of-prog marker. +; 05-Feb-2014 v0.20 DIM array() implemented, DEFFNname(A$):A$=something:=A$ works. +; 16-Aug-2015 VDU(n) returns 8-bit values. +; 26-Aug-2015 EVAL evaluates string on stack to protect string buffer. +; 31-Aug-2015 v0.21 Low numbered commands and high numbered functons use +; lookup table instead of dispatch table. +; 09-Sep-2015 v0.22 ON GOTO/GOSUB implemented. Bug where FN(addr)+num called +; '(addr)+num' instead of '(addr)' fixed. Real DIMs now +; work. RND(n) works, correctly giving reals 0..1 and +; integers 1..n. RND seed updated as per 6502 BASIC, conversion +; to user value matches BASIC 2, different from BASIC 4. +; 18-Oct-2015 v0.23 ROMHeader checks if Tube CPU is a PDP11. +; 22-Jul-2016 v0.24 Signal handlers set up from a table, removed double-vectoring. +; Trimmed stty() calls on startup, tweeked CmdLine scanning. +; 31-Jul-2016 Scanning fractional and exponential decimals implemented. +; 21-Aug-2016 v0.25 Multiplication rounding corrected, 0.5 = 1/2. +; 09-Jul-2016 v0.26 EnsureInteger truncates, INT rounds downwards. +; 04-Jul-2018 v0.27 Various optimisations to Interface routines. +; 19-Aug-2018 v0.30 Anchored @% at PAGE-&100 to ensure ProgEnv can read command string. +; 26-Aug-2018 v0.31 NumberToString float support, currently fixed at 9 digits General +; format. ScanDecimal generates error if numbers larger than 10^9 +; unless E format. +; 09-May-2020 v0.32 MultiplyInt checks for <&8000 x <&8000, TokenFind doesn't skip +; zero-length lines. PROC@LOAD, FN@SAVE allowed, IF x THEN var=1 +; doesn't tokenise the number, STRING$(n,MID$(...)) works. +; 11-May-2020 Various work to UnixIO and RT11IO. +; 20-Jun-2020 Added *ESC (ON|OFF), merged ANSI and UKNC VDU driver code. +; 22-Jun-2020 v0.33 RT11 and UKNC extended key handler working, initial INKEY() code. +; 28-Jun-2020 v0.34 Unix v6,v7 keyboard interface recognises function/editing keys. +; Unix v6 does pseudo-background Escape polling. +; 30-Jun-2020 Optimised extended keypress reading. InitTTY recognises Unix v5, +; Unix v5 extended keypresses and pseudo-background Escape work. +; 30-Jun-2020 Optimised RT11 extended keypress reading. +; 12-Jul-2020 v0.35 Added delay to TTYtest to cope with telnet delays. Searches for kbdQ. +; 13-Mar-2021 LIST doesn't detokenise within strings. +; 16-Mar-2021 v0.36 DIV 32bit corrected, VAL"nonnum" fixed, error within EVAL fixed. +; 16-Sep-2021 RT11 polls Escape on a ticker as with Unix pre v7. +; 28-Dec-2021 UKNC reworked COLOUR to use shorter sequences, implemented MODE. +; RT11 GETKEY swallows after , faster Escape check, tweeked +; GETtty, tweeks to VDU 127,8,9,10,11. +; 31-Dec-2021 Cursor control selects appropriate VT52 or VT100 control sequences. +; Avoids sending colours to VT52. +; 05-Jan-2022 v0.37 RT11 doesn't lose characters, sent via vduraw, tweeked Escape. +; 07-Jan-2022 Bugfix added to LOCAL to avoid bug in RT11Em. +; 19-Jan-2022 UKNC reads 8-bit chars from CONIN. Looking for POS/VPOS. +; 27-Jul-2002 Starting to work out BSD2.9 API. +; 29-Jul-2022 Switches stack out of stack segment for BSD. +; 01-Aug-2022 v0.38 Detects and runs on BSD2.9 - can't find kbdQ at the moment. +; Added ADVAL(-1). BSD2.11: load/save, =TIME. +; FloatDivide uses fixed 32-bit SUB, NumToString checks for overflow +; to 1.0. Optimised by using FloatToString for IntToString. +; 25-Sep-2022 v0.39 Rewritten and optimised DivideFloat. +; 28-Sep-2022 v0.40 UKNC should be able to read POS/VPOS/MODE from VDU system, but can't +; work out how to, so in interim fakes via local variables. +; 14-Apr-2023 v0.41 Common API code moved to IOCommon from IOUnix and IORT11. +; 02-Aug-2023 v0.42 Moved common keyboard code from IOUnix and IORT11 to AnsiKBD. +; 08-Aug-2023 v0.43 OSCLI calling external works on BSD211, *chdir works. +; 14-Aug-2023 Optimised and refactored execution loop and line scanning. +; 16-Aug-2023 Working on BSD211 KBD_Wait, etc. +; 19-Aug-2023 Combined fopen and data transfer from OSGBPB and OSFILE. +; 20-Aug-2023 BSD211 OSARGS and EOF done. +; 15-Sep-2023 v0.44 Shell command wrapped in VDU0 to signal LF conversion, RT11 munged +; VDU10 and VDU 11 to work on various terminals. +; 03-Oct-2023 Unwinding FN drops subroutines addresses when resetting SV_STACK. +; 01-Mar-2024 v0.45 RT11 shell() calls a command via EXIT and and returns, so *. works. +; If command generates an error, drops to KMON. Tweeked tests for +; VT52/UKNC for RT11v5.7 on UKNC. +; 10-Mar-2024 Tweeks for oddities in various PuTTY setttings and fkey overlaps. +; 12-Mar-2024 CallSub/RetSub pushes/pops SV_STACK - optimised code and fixed +; FN unwinding bug. +; 18-Mar-2024 LOAD/SAVE checks for end-of-statement if immediate command, tweeked +; textload and FindTOP. Restructured ImmLineNum and InsLine to use new +; return from Tokeniser. HIMEM= sets SV_STACK, lots of small misc. +; optimisations. Channels use HashVal instead of HashExpression. +; 27-Mar-2024 v0.46 RT11IO optimised IO_xxx entries, all errors generate errors. +; 07-Apr-2024 Stacking strings checks for free memory. +; 09-Apr-2024 UnixIO optimised IO_xxx entries, all errors generate errors. +; 12-Apr-2024 BGET/BPUT merged code, BGET checks for EOF, better EOF routine. +; 19-Apr-2024 BSD211 signals now working, tidied up and optimised. +; 30-Apr-2024 BSD2.9 tests keyboard buffer so function keys work. +; 30 Jul 2024 v0.47 NumberToString uses IntegerToString again, FloatToString loses +; accuracy over 999999999. Uses fast/compact DIV-based routine. +; 31-Dec-2024 Fixed EOF handling on BGET never resetting EOF flag, also BSD clearing +; EOF flag on BPUT/WRCH. +; 27-Apr-2025 Tweeked tokeniser to correctly tokenise eg &123OR5. +; 10-May-2025 Optimised Bin/Oct/Hex constants. +; 23-Aug-2025 ROMHdr checks for Electron Tube and ROM table. REM/DATA only stops +; tokenising at start of statement, 2-byte tokenising possible. +; 01 Jan 2026 v0.48 Some tweeking with initial startup system checking. + + +; Notes +; ----- +; This source uses the 'ADR label,dst' pseudo-opcode. The assembler needs to implement this +; or expand this in the manner of this macro, or uncomment this macro: +;.MACRO ADR label,dst +; MOV pc,dst +; ADD #label-$,dst +;.ENDM + + +; Build options +; ------------- +; DEBUG Include Debug module +; VERSION Major build version in hex +; BUILD Minor build number, 1/2/3/etc becomes eg v0.00a/b/c/etc +; SKIPLINE Allows \ line continuation character +; VECTORS Calls to &FFxx use vectors in BASIC workspace +; NOMUL Assume MUL instruction absent, multiply manually (needs MulR2byR3toR3) +; NODIV Assume DIV instruction absent, IntToString manually divides. +; MUL16 Use fast checks and restrict hardware MUL to 16-bit ints +; TUBEBUG Bypasses bug in early Tube code +; FILEEXTN Include LOAD "file",addr and SAVE "file",start,end,exec,load +; NOEXTRAFN Omit =DIM, =WIDTH, =OSCLI +; SLOWTOKEN Slower but smaller tokeniser + +MUL16: EQU 1 ; Restrict fast hardware MUL to 16-bit ints +NOEXTRAFN: EQU 1 ; Omit function extensions +SLOWTOKEN: EQU 1 ; Smaller tokeniser + + +; Version information +; ------------------- +; Strings have to be defined before the first pass so their length is correct +;DATE$: EQU MID$(TIME$,5,11) +DATE$: EQU "01 Jan 2026" +YEAR$: EQU RIGHT$(DATE$,4) +VERSION: EQU &0048 +BUILD: EQU 0 + diff --git a/src/ansi.mac b/src/ansi.mac new file mode 100644 index 0000000..c9090a2 --- /dev/null +++ b/src/ansi.mac @@ -0,0 +1,505 @@ +; > ansi.mac +; ANSI BBC VDU driver for PDP11 Unix +; Implements BBC VDU text control codes +; +; 14-Sep-2015 v0.01 Initial version +; 25-Dec-2015 v0.02 Optimised MOV #STDOUT,R0 and COLOUR +; 20-Jun-2020 v0.03 COLOUR &C0+n filtered out, COLOUR &88+n sets ANSI bright background +; 15-Jan-2022 CHR$127 jumps directly to vdu127. +; 06-Aug-2022 Added build options for BSD stack API. +; 15-Sep-2023 v0.04 Toggle VDU 10 between DOWN and NEWL. +; +; Notes: +; Some platforms support seperate bright foreground and bright background +; Some platforms only set both background and foreground bright +; Some platforms only set foreground bright +; User should set background before foreground to be most compatible, using: +; COLOUR &80+bg:COLOUR &00+fg + + +VERSION: EQU &0004 +BUILD: EQU 0 + +ORG 0 ; position independent code +HOSTIO: EQU 1 ; HOSTIO=1 for Unix +EQUW &0107 ; magic number, also branch to Startup +EQUW _DATA%-_TEXT% ; size of text +EQUW _BSS%-_DATA% ; size of initialised data +EQUW _END%-_BSS% ; size of uninitialised data +EQUW &0000 ; size of symbol data +EQUW _ENTRY%-_TEXT% ; entry point (v7 only, must be zero for pre-v7) +EQUW &0000 ; not used +EQUW &0001 ; no relocation info +ORG 0 ; position independent code +._TEXT% +; + +._ENTRY% +#ifndef BSD + TRAP 48 ; signal() + EQUW 2 ; SIGINT - User interupt (Escape) + EQUW 1 ; SIGIGNORE - only terminate when read() ends +#endif + +.loop +#ifdef BSD + mov #1,-(sp) ; 1 byte + mov #charbuf,-(sp) ; data buffer + clr -(sp) ; fd=STDIN + clr -(sp) ; padding + TRAP 3 ; SYS read + rol r0 ; Save Carry flag + add #8,sp ; Drop from stack + ror r0 ; Get Carry back +#else + CLR R0 ; fd=STDIN + TRAP 3 ; SYS read + EQUW charbuf ; data buffer + EQUW 1 ; 1 byte +#endif +BCS exit ; End of file, exit +TST R0 +BEQ exit ; Nothing read, exit +JSR PC,wrch +BR loop +.exit +JSR PC,vdu20reset ; Reset colours +CLR R0 +#ifdef BSD + CLR -(SP) +#endif +TRAP 1 ; SYS exit +HALT + +; Process output character +; ------------------------ +.wrch +MOVB charbuf,R0 +MOVB vduQ,R1 +BNE pending ; VDU queue pending +CMP R0,#32 +BCS control ; Control character +CMP R0,#127 +;BEQ delete ; VDU 127 +BEQ vdu127 ; VDU 127 + +; Send raw character in buffer to STDOUT +; -------------------------------------- +.vduraw +MOV #1,R0 ; fd=STDOUT +.vdu02 ; Printer On +.vdu03 ; Printer Off +.vdu04 ; Text +.vdu05 ; Graphics +.vdu06 ; Enable +.vdu07 ; Bell +.vdu08 ; Left +.vdu13 ; CR +.vdu14 ; Page On +.vdu15 ; Page Off +.vdu16 ; CLG +.vdu21 ; Disable +.vdu27 ; Escape +#ifdef BSD + mov #1,-(sp) ; 1 byte + mov #charbuf,-(sp) ; data buffer + jmp bsd_output +#else + TRAP 4 ; SYS write + EQUW charbuf ; data buffer + EQUW 1 ; 1 byte +#endif + +;.vdu00 ; NULL +.vdu18 ; GCOL +.vdu19 ; Palette +.vdu23 ; DEFCHR +.vdu24 ; Graphics window +.vdu25 ; PLOT +.vdu26 ; Reset windows +.vdu28 ; Text window +.vdu29 ; Origin +.return +RTS PC + +; VDU queue pending +; ----------------- +.pending +MOVB R0,vduQueue(R1) ; Store in VDU queue +INCB vduQ +BNE return ; Waiting for more parameters +MOVB vduChar,R0 ; Get current control character +ASL R0 +MOV vduAddrs(R0),R1 ; R1=dispatch address+parameters +BIC #&F000,R1 ; Mask off parameters +.dispatch +MOV #1,R0 ; Prepare R0 handle=STDOUT +JMP (R1) ; Jump to control routine + +; Control characters +; ------------------ +;.delete +;MOV #32,R0 ; Convert VDU 127 to 32 +.control +MOVB R0,vduChar +ASL R0 ; R0 will be <128, so Cy will become 0 +RORB vduflags ; Use CC to also clear VDU10 flag +MOV vduAddrs(R0),R1 ; R1=dispatch address+parameters +BIT R1,#&F000 +BEQ dispatch ; No parameters, dispatch +SWAB R1 +ASR R1 +ASR R1 +ASR R1 +ASR R1 ; Number of parameters in b0-b3 +BIS #&F0,R1 +MOVB R1,vduQ ; 256-(Number of params to wait for) +RTS PC + +; VDU 127 - Delete +; ---------------- +.vdu127 +#ifdef BSD + mov #3,-(sp) ; 3 bytes + mov #ANSdelete,-(sp) ; ANSI delete + jmp bsd_output +#else + TRAP 4 ; SYS write + EQUW ANSdelete ; ANSI delete + EQUW 3 ; 3 bytes + RTS PC +#endif + +; VDU 0 - NULL, but toggle VDU 10 flag +; ------------------------------------ +.vdu00 +ROLB vduflags ; Move flag back to b7 +ADD #&80,vduflags ; And toggle it +RTS PC + +; VDU 1 - Next as raw character +; ----------------------------- +.vdu01 +#ifdef BSD + mov #1,-(sp) ; 1 byte + mov #vduQueue-1,-(sp) ; data buffer + jmp bsd_output +#else + TRAP 4 ; SYS write + EQUW vduQueue-1 ; The byte in the queue + EQUW 1 ; 1 byte + rts pc +#endif + +; VDU 9 - Right +; ------------- +.vdu09 +#ifdef BSD + mov #ANSdown-ANSright,-(sp) ; length of sequence + mov #ANSright,-(sp) ; ANSI right + jmp bsd_output +#else + TRAP 4 ; SYS write + EQUW ANSright ; ANSI right + EQUW ANSdown-ANSright ; length of sequence + rts pc +#endif + +; VDU 10 - Down +; ------------- +; Must translate to newline, otherwise OSCLI("command") doesn't newline properly. +.vdu10 +ROLB vduflags ; Restore and test VDU10 flag +#ifdef BSD + bmi vdu10newl ; Force VDU10 to NEWLINE + mov #ANSup-ANSdown,-(sp) ; length of sequence + mov #ANSdown,-(sp) ; ANSI down + jmp bsd_output + .vdu10newl + mov #2,-(sp) ; 2 bytes + mov #RAWnewl,-(sp) ; NEWLINE + jmp bsd_output +#else + BMI vdu10newl ; Force VDU10 to NEWLINE + TRAP 4 ; SYS write + EQUW ANSdown ; ANSI down + EQUW ANSup-ANSdown ; length of sequence + RTS PC + .vdu10newl + TRAP 4 ; SYS write + EQUW RAWnewl ; NEWLINE + EQUW 2 ; 2 bytes + RTS PC +#endif + +; VDU 11 - Up +; ----------- +.vdu11 +#ifdef BSD + mov #ANScls-ANSup,-(sp) ; length of sequence + mov #ANSup,-(sp) ; ANSI up + jmp bsd_output +#else + TRAP 4 ; SYS write + EQUW ANSup ; ANSI up + EQUW ANScls-ANSup ; length of sequence + rts pc +#endif + +; VDU 22,n - MODE +; --------------- +.vdu22 +JSR PC,vdu20 ; Reset colours +MOV #1,R0 ; handle=STDOUT + ; Then clear screen + +; VDU 12 - CLS +; ------------ +.vdu12 +#ifdef BSD + mov #4,-(sp) ; 4 bytes + mov #ANScls,-(sp) ; ANSI cls + jsr pc,bsd_callout +#else + TRAP 4 ; SYS write + EQUW ANScls ; ANSI cls + EQUW 4 ; 4 bytes +#endif + ; Then HOME cursor + +; VDU 30 - Home +; VDU 31,x,y - TAB +; ----------------- +.vdu30 +CLR vduQueue-2 ; Preload TAB(0,0) +.vdu31 +ADD #&0101,vduQueue-2 ; ANSI starts from (1,1) +MOV #ANStab+2,R1 +MOVB vduQueue-1,R0 ; Y coordinate +JSR PC,vduDecimal ; Output as decimal +MOVB #59,(R1)+ +MOVB vduQueue-2,R0 ; X coordinate +JSR PC,vduDecimal ; Output as decimal +#ifdef BSD + mov #10,-(sp) ; 10 bytes + mov #ANStab,-(sp) ; ANSI tab + jmp bsd_output +#else + MOV #1,R0 ; fd=STDOUT + TRAP 4 ; SYS write + EQUW ANStab ; ANSI tab + EQUW 10 ; 10 bytes + RTS PC +#endif + +.vduDecimal +MOVB #ASC"0"-1,(R1) ; Start with '0'-1 for hundreds +.vduDecLp1 +INCB (R1) ; Increment hundreds digit +SUB #100,R0 ; Subtract 100 from R0 +BCC vduDecLp1 ; Loop until <0 +INC R1 ; Step past hundreds digit + +ADD #100,R0 ; Balance last SUB #100 +MOVB #ASC"0"-1,(R1) ; Start with '0'-1 for tens +.vduDecLp2 +INCB (R1) ; Increment tens digit +SUB #10,R0 ; Subtract 10 from R0 +BCC vduDecLp2 ; Loop until <0 +INC R1 ; Step past tens digit + +ADD #ASC"0"+10,R0 ; Convert back to units +MOVB R0,(R1)+ +RTS PC + +; VDU 20 - Reset colours +; ---------------------- +.vdu20reset +MOV #1,R0 ; handle=STDOUT +.vdu20 +MOV #&3037,txtFGD ; Set current colours +#ifdef BSD + mov #4,-(sp) ; 4 bytes + mov #ANSreset,-(sp) ; ANSI default colours + jmp bsd_output +#else + TRAP 4 ; SYS write + EQUW ANSreset ; ANSI default colours + EQUW 4 ; 4 bytes + RTS PC +#endif + +; VDU 17,n - COLOUR +; ----------------- +; PRINTCHR$27;"[0"; +; IF (A AND 16):PRINT";5"; :REM flash +; IF (A AND 32):PRINT";4"; :REM underline +; IF (A AND 64):PRINT";7"; :REM inverse +; IF (A AND 128)=0:PRINT";";30+(A AND 7);:IF (A AND 8):PRINT";1"; :REM foreground colour +; IF (A AND 128) :PRINT";";40+(A AND 7);:IF (A AND 8):PRINT";";100+(A AND 7); :REM background colour +; PRINT"m"; +; NB: Some platforms [21m is not the opposite of [1m so cannot optimise further. The consistant way to +; turn bright off is [0m, so need to remember colours and reselect them. On some platforms even [22m +; does not turn bright off. +; +.vdu17 +MOVB vduQueue-1,R0 ; Get COLOUR parameter +BISB #ASC"0",R0 ; Convert to digit +BPL vdu17_setfgd ; COLOUR &00+n, set foreground +CMPB R0,#&C0 +BCC vdu17_exit ; COLOUR &C0+n, set border, unimplemented +MOVB R0,txtBGD ; Set as current background +BR vdu17_colour +.vdu17_setfgd +MOVB R0,txtFGD ; Set as current foreground +.vdu17_colour +; +MOVB vduQueue-1,R0 ; Get COLOUR parameter again +MOV #ANScolour+3,R1 ; R1=>output string after initial [0 +MOVB #&3B,(R1)+ ; Insert semicolon, R1 is now aligned +BIT #64,R0 +BEQ vdu17_noinvert +MOV #&3B00+ASC"7",(R1)+; Invert on "7;" ALIGNED +.vdu17_noinvert +BIT #32,R0 +BEQ vdu17_nounderline +MOV #&3B00+ASC"4",(R1)+; Underline on "4;" ALIGNED +.vdu17_nounderline +BIT #16,R0 +BEQ vdu17_noflash +MOV #&3B00+ASC"5",(R1)+; Flash on "5;" ALIGNED +.vdu17_noflash +; +MOVB txtFGD,R0 ; Get current foreground +BIT #8,R0 +BEQ vdu17_nobright ; Not bright foreground +MOV #&3B00+ASC"1",(R1)+; Bright on "1;" ALIGNED +.vdu17_nobright +MOVB #ASC"3",(R1)+ ; Prefix for foreground ALIGNED +BIC #&FFC8,R0 ; Reduce to '0'-'7' +MOVB R0,(R1)+ ; Foreground colour +MOVB #&3B,(R1)+ ; ";" ALIGNED +; +MOVB txtBGD,R0 ; Get current background +MOVB #ASC"4",(R1)+ ; Prefix for foreground +BIC #&FFC8,R0 ; Reduce to '0'-'7' +MOVB R0,(R1)+ ; Background colour ALIGNED +BITB #8,txtBGD +BEQ vdu17_write ; Not bright background +MOVB #&3B,(R1)+ ; ";" +MOV #&3031,(R1)+ ; Prefix for bright background ALIGNED +MOVB R0,(R1)+ ; Bright background colour ALIGNED +; +.vdu17_write +MOVB #ASC"m",(R1)+ ; Terminator +MOV #ANScolour,R0 +SUB R0,R1 ; R1=length of character stream +MOV R1,trapColour+4 +#ifdef BSD + mov trapColour+4,-(sp) ; count + mov trapColour+2,-(sp) ; address + jmp bsd_output +#else + MOV #1,R0 ; handle=STDOUT + TRAP 0 ; SYS indirect + EQUW trapColour +#endif +.vdu17_exit +RTS PC + +#ifdef BSD + .bsd_callout +; On entry: SP=>ret, address, length + mov (sp)+,r0 ; SP=>address, length + mov (sp),-(sp) ; SP=>address, address, length + mov 4(sp),2(sp) ; SP=>address, length, length + mov r0,4(sp) ; SP=>address, length, ret +; + .bsd_output +; On entry: SP=>address, length, ret + mov #1,-(sp) ; SP=>stdout, address, length, ret + clr -(sp) ; SP=>padding, stdout, address, length, ret + TRAP 4 ; SYS write + add #8,sp ; Drop from stack + rts pc +#endif + +; Dispatch addresses and parameters +; --------------------------------- +.vduAddrs +EQUW (vdu00 AND &FFF) OR &0000 ; NULL +EQUW (vdu01 AND &FFF) OR &F000 ; Printer +EQUW (vdu02 AND &FFF) OR &0000 ; Printer On +EQUW (vdu03 AND &FFF) OR &0000 ; Printer Off +EQUW (vdu04 AND &FFF) OR &0000 ; Graphics +EQUW (vdu05 AND &FFF) OR &0000 ; Graphics +EQUW (vdu06 AND &FFF) OR &0000 ; Enable +EQUW (vdu07 AND &FFF) OR &0000 ; BELL +EQUW (vdu08 AND &FFF) OR &0000 ; Left +EQUW (vdu09 AND &FFF) OR &0000 ; Right +EQUW (vdu10 AND &FFF) OR &0000 ; Down +EQUW (vdu11 AND &FFF) OR &0000 ; Up +EQUW (vdu12 AND &FFF) OR &0000 ; CLS +EQUW (vdu13 AND &FFF) OR &0000 ; CR +EQUW (vdu14 AND &FFF) OR &0000 ; Page On +EQUW (vdu15 AND &FFF) OR &0000 ; Page Off +EQUW (vdu16 AND &FFF) OR &0000 ; CLG +EQUW (vdu17 AND &FFF) OR &F000 ; COLOUR +EQUW (vdu18 AND &FFF) OR &E000 ; GCOL +EQUW (vdu19 AND &FFF) OR &B000 ; Set Palette +EQUW (vdu20 AND &FFF) OR &0000 ; Reset Colours +EQUW (vdu21 AND &FFF) OR &0000 ; Disable VDU +EQUW (vdu22 AND &FFF) OR &F000 ; MODE +EQUW (vdu23 AND &FFF) OR &7000 ; DEFCHR$ +EQUW (vdu24 AND &FFF) OR &8000 ; Define Graphics Window +EQUW (vdu25 AND &FFF) OR &B000 ; PLOT +EQUW (vdu26 AND &FFF) OR &0000 ; Clear Windows +EQUW (vdu27 AND &FFF) OR &0000 ; Escape +EQUW (vdu28 AND &FFF) OR &C000 ; Define Text Window +EQUW (vdu29 AND &FFF) OR &C000 ; ORIGIN +EQUW (vdu30 AND &FFF) OR &0000 ; HOME +EQUW (vdu31 AND &FFF) OR &E000 ; TAB +; EQUW (vdu127 AND &FFF) OR &0000 ; Delete + +; Initialised data +; ---------------- +._DATA% +.RAWnewl EQUS 10,13 ; Newline +.ANSdelete EQUS 8,32,8 ; Delete +;.ANSleft EQUS 27,"[D" ; Left +.ANSright EQUS 27,"[C" ; Right +;.ANSdown EQUS 27,"[B" ; Down, fails on bottom line +.ANSdown EQUS 27,"D" ; Down, works on bottom line +;.ANSup EQUS 27,"[A" ; Up, fails on top line +.ANSup EQUS 27,"M" ; Up, works on top line +.ANScls EQUS 27,"[2J" ; CLS +.ANSreset EQUS 27,"[0m" ; Default colours +; EQUS 27,"[000,000H" ; Home/TAB +.ANStab EQUS 27,"[Ver" + EQUB ASC"0"+((VERSION AND &F00) DIV 256) + EQUB "." + EQUB ASC"0"+((VERSION AND &0F0) DIV 16) + EQUB ASC"0"+((VERSION AND &00F) DIV 1) + EQUS "H" ; Home/TAB + ALIGN +.ANScolour EQUS 27,"[0,5,4,7,30,1,40,100m" ; COLOUR +; 0 101010101010101010101 + ALIGN +.trapColour TRAP 4 + EQUW ANScolour + EQUW 18 +.txtFGD EQUS "7" +.txtBGD EQUS "0" + +; Uninitialised data +; ------------------ +._BSS% BSS +.vduChar EQUB 0 + EQUB 0,0,0,0,0,0,0,0,0 +ALIGN +.vduQueue +.vduQ EQUB 0 +ALIGN +.vduflags EQUB 0 +.charbuf EQUB 0 +._END%