From a73580e949f12bc15b8c7868bfb693df84af5b62 Mon Sep 17 00:00:00 2001 From: rajames Date: Thu, 15 Oct 2026 14:26:02 -0400 Subject: [PATCH] feat(v4): the machine boots from its ROM; the prebuilt nucleus is gone The host node starts in its ROM (entry 12), and the boot feeds it the system's source through the console: capsules/v4/sys/map-64.f18, the fourteen .f18 blobs and end.f18, each found, hash-checked and signature-checked as any capsule, then EOT. The ROM assembles the system and starts it at (IDLE); the host reads the image record (v4_image_from_node) for what only the assembled system knows. A ROM error is reported with its blob, line and meaning, then PARITY:FAIL. Deleted: v4/tools/mkimage.c, capsules/v4/nucleus-64.f18, v4/capsule/*.v4, v4/tools/v4tof18.py. The .f18 files are the source now. - text.c speaks the rest of the ROM's language (set, here, store, start; v4_text_value, v4_text_start), so the oracle reads the same source: test_host_rom_nucleus compares the ROM against text.c on the .f18 files, word for word, image record included. Host tests load the .f18 files. - mkmap image writes v4_map_image (the map's description of the system); hosted and the kernel link the ROM and the map instead of v4_image_64.c. - Hera (Captain Bob's ruling, option 1): births stream the system the ROM assembled, as assembled code; hera.4th is unchanged. test_host_unit's host builds the system with the ROM. - New parity lines: PARITY:V4_F18 per blob, PARITY:V4_ROM words=2049 rom_hash=0xa6c792b5821010b7 instructions=60725216. Acceptance: amd64, aarch64, riscv64 boot to ok> with PARITY:V4_POST tests=538 pass=538 fail=0, POST: PASSED, and PARITY:V4_SYSTEM word_count=317 dict_hash=0xe5a57f3eb72ff94a on all three -- the same hash as the prebuilt nucleus gave. make -C v4 test test-32 hosted-check: all pass. Logs: logs/20261015-141648, -141938, -142350. Startup cost under QEMU TCG, the ROM's assembly (last V4_F18 line to V4_ROM): amd64 26.7 s of 132 s to ok>; aarch64 41.0 s of 195 s; riscv64 20.5 s of 101 s. Hosted native: +0.85 s. Co-Authored-By: Claude Opus 5.5 --- capsules/v4/nucleus-64.f18 | Bin 57448 -> 0 bytes capsules/v4/rom/dir.f18 | 3 +- capsules/v4/sys/acl.f18 | 4 +- capsules/v4/sys/blocks.f18 | 4 +- capsules/v4/sys/codegen.f18 | 4 +- capsules/v4/sys/compile.f18 | 12 +- capsules/v4/sys/core.f18 | 12 +- capsules/v4/sys/dict.f18 | 8 +- capsules/v4/sys/end.f18 | 3 +- capsules/v4/sys/forth.f18 | 6 +- capsules/v4/sys/input.f18 | 6 +- capsules/v4/sys/log.f18 | 4 +- capsules/v4/sys/numout.f18 | 6 +- capsules/v4/sys/qmath.f18 | 6 +- capsules/v4/sys/quit.f18 | 18 +- capsules/v4/sys/system.f18 | 8 +- capsules/v4/sys/words.f18 | 4 +- docs/v4.0.0/DATASHEET-F18.md | 9 +- .../runs/doe-aarch64-20261015-141938.csv | 0 .../runs/doe-amd64-20261015-141648.csv | 0 .../runs/doe-riscv64-20261015-142350.csv | 0 kernel/Makefile | 52 +- kernel/src/v4/sk_v4.c | 9 +- .../amd64/qemu-amd64-20261015-141648.log | 153 +++++ .../aarch64/qemu-aarch64-20261015-141938.log | 126 ++++ .../riscv64/qemu-riscv64-20261015-142350.log | 196 ++++++ v4/Makefile | 68 +- v4/README.md | 18 +- v4/capsule/acl.v4 | 83 --- v4/capsule/blocks.v4 | 127 ---- v4/capsule/codegen.v4 | 119 ---- v4/capsule/compile.v4 | 466 -------------- v4/capsule/core.v4 | 479 -------------- v4/capsule/dict.v4 | 233 ------- v4/capsule/forth.v4 | 229 ------- v4/capsule/input.v4 | 217 ------- v4/capsule/log.v4 | 72 --- v4/capsule/numout.v4 | 153 ----- v4/capsule/qmath.v4 | 247 -------- v4/capsule/quit.v4 | 585 ------------------ v4/capsule/system.v4 | 170 ----- v4/capsule/words.v4 | 201 ------ v4/include/v4/boot.h | 17 +- v4/include/v4/capsule.h | 5 +- v4/include/v4/image.h | 67 +- v4/include/v4/manage.h | 2 +- v4/include/v4/message.h | 2 +- v4/include/v4/node.h | 2 +- v4/include/v4/text.h | 24 +- v4/src/image.c | 17 +- v4/src/manage.c | 2 +- v4/src/text.c | 83 ++- v4/system/boot.c | 239 ++++--- v4/tests/host_map.h | 34 +- v4/tests/rom_harness.h | 62 ++ v4/tests/test_host_codegen.c | 6 +- v4/tests/test_host_compile.c | 4 +- v4/tests/test_host_depth.c | 6 +- v4/tests/test_host_dict.c | 4 +- v4/tests/test_host_input.c | 6 +- v4/tests/test_host_mesh.c | 8 +- v4/tests/test_host_quit.c | 16 +- v4/tests/test_host_rom_nucleus.c | 125 +--- v4/tests/test_host_unit.c | 42 +- v4/tests/test_text.c | 32 +- v4/tools/hosted.c | 12 +- v4/tools/mkimage.c | 122 ---- v4/tools/mkmap.c | 20 + v4/tools/v4tof18.py | 110 ---- 69 files changed, 1164 insertions(+), 4025 deletions(-) delete mode 100644 capsules/v4/nucleus-64.f18 create mode 100644 experiments/bare_metal/runs/doe-aarch64-20261015-141938.csv create mode 100644 experiments/bare_metal/runs/doe-amd64-20261015-141648.csv create mode 100644 experiments/bare_metal/runs/doe-riscv64-20261015-142350.csv create mode 100644 logs/20261015-141648/amd64/qemu-amd64-20261015-141648.log create mode 100644 logs/20261015-141938/aarch64/qemu-aarch64-20261015-141938.log create mode 100644 logs/20261015-142350/riscv64/qemu-riscv64-20261015-142350.log delete mode 100644 v4/capsule/acl.v4 delete mode 100644 v4/capsule/blocks.v4 delete mode 100644 v4/capsule/codegen.v4 delete mode 100644 v4/capsule/compile.v4 delete mode 100644 v4/capsule/core.v4 delete mode 100644 v4/capsule/dict.v4 delete mode 100644 v4/capsule/forth.v4 delete mode 100644 v4/capsule/input.v4 delete mode 100644 v4/capsule/log.v4 delete mode 100644 v4/capsule/numout.v4 delete mode 100644 v4/capsule/qmath.v4 delete mode 100644 v4/capsule/quit.v4 delete mode 100644 v4/capsule/system.v4 delete mode 100644 v4/capsule/words.v4 delete mode 100644 v4/tools/mkimage.c delete mode 100644 v4/tools/v4tof18.py diff --git a/capsules/v4/nucleus-64.f18 b/capsules/v4/nucleus-64.f18 deleted file mode 100644 index d8daa971c528b3e9923fdc8cf8bd014afb6fb5e5..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 57448 zcmb__34B$>_5aPwOCW$D$ST;k)nb`#I+g$alw_=SW!_^f#M4PIdi_>`*H_fqwW8G^2xlJIs2SBGk0e0 zz5e@~M|$SUkbmZSNE6R*D9Dzd$zw+KL6J=e$Fh=>j@u%?lTg64ZsmhprD!VbFRhKhj(Dg``J&(WfLebE?6Vk?ao>YDf54|Bpzw*3+ zk`D3G*GW1Ud|vI?-jCVBs&wBn&cxl0%`f~dp63?WaQ8Dy#Dg@Y_FY_V?VCboqT@p zk1U`3-uK)n@NVjtEV1SLrP5r9;QfXy<)dH$T=~&Tm-vBxC7Uf@mPfLW0H!9Bkt;;% z>US0NyTZ}uQYXK$+oZKZ!lVlimKLt+vj8k8icS6WpW80v;@5$W=PCHm37a1f{QdjQ zpSh?X@m4H2&+-Mh=QmA-owPy9SM>?mL8%Cxr|%ZJDcPfnB^?{`CeOP@3e7cD6K@Ip zH@5f->!16EYeh4^@}=Zf*sajJ+WP-guYQx1PhK$Cav(fY)30BWdX;wne#1xmW4iM3 z8{V{WXUZUf^1MHRe$&1VswWV;q26zpzCqwt0?u!!vijd8A;4V5ewLp6maA#cW~(-9sMgdFU)5%0Gq&weBQnMORIm))`QcH)1MLI>-)-Y*4AO43QTL*|3aiEZLKbo za_bBx^*5E+aYo9TU)y&MwfNt8#Q(FGS}jFvua5)&)A8cZUVWz2N9CWnzKz$fkv#cTfFJvZDW5I%BT)W5 z{H}kJ>eD|d9Dmy)9}y&T&4C`7z#oa!e@f|QA)k??rY1bgU3k**pB!dgkL`67>P@-e z52WAMp?fjlX?N1C-K+k>@6ovr<~E8r(P?L+_H z2mLNZ{iO%kA?(L4|21Cyc#)fSF9Scu-zv~OD*@eE=ugzg?f;FLw?kc@jDd^j2`RdC+WNJe&bLZ@7Vun5ArkP zOgF)Q5_}DRJJhj#iO2Z*bkf4J1b$Fbz3p$00-o){c6=25k@1ppk?%c8wX=i{+hHx* zjrOOVOgmWlX=l>c{xf9_8#$v?t@s@zA4J zBs?$Tyq)~~hlkqu$N19^cJia?*(1Vn4()KAj*AySo*m`}U#{yw$IR0$ zeJwrkf8(OT2d!VRxYEv_NSF5^q~FpwJr444oE{m`ak?OoU)NC>$2m^ZuEh5nKCtnb z?O^O+ zFWd3&u)}<`PYL{)^IFPBy%{&6xuXh%Pr3YSb}fW~bfYD&FaAXg;2l%#C>An4o^(5=ms3f||Xl$B&jKHJWo<(FQM0)C}~ z7ejqYcJUbbS>zaa4d7QJE%fT^1|cj!JNT7G(olsjy_df=@?`cg#iCk8g^dI0+o z{l~Po9WpkHXw8fcrb)IG=XlQ_Iw@rA~u<2zxw>l=n5Yr;4_o_ixDa zMVx*pKGROAx#QLD+2Mx!5_ESU{dYh|?Q>YNj<0j(X*i{#=cPr*nZ60#xYd}-ukcK z6qa`{>`OVnK%R7r|JMoSezYh02j_*w8o^%m-B>idgcv?J-$4~vrZzJ&KbtS5gn4?0Ki>GvFPCxLH8GUsO+ z=V<3SyLFw4e)t*mG4lr7-&j8W2cd4)yVY;d{|J8>Y3gd_jc*x#N|eSYZq%=VS9g$ zI7R<^9d?dH5%(X_^Wumcctq-TwJ2?uhgP3qoia+Zuq_>3ky3&etUI^ zsvZS_yc%b`YxF*d_XUh!Nxc-0dKQ9S9@1Nq>oWzSw}KfzP)KR;c%bd*DA_t=5=0 zaEJV&+?D7*lcGBRjV<_v?I+$_3QxEh(fYfjgm7M?+LQFzp3!`5piuBNc$dH~F1F)J_+jj$&9FWYabS6e4^sdr>R znEoT6dmmEH`wTy8H>Q+3wJ^(CJhv=t_%*;^g|v2$u3tUPd22(GwHxh|GEDuU=roZo zemxERbx2Kov3S%cxiBv)4()j_0PeYXnj!Tmg$35rP8-%7+Vfrk+{*#|r>#9xh80=5 zqb#>L&TD|%f^_4WVHTp<{Kd9sa#2{WcL4uZJXN`hvTWSTb>!L(xDSwW+{rJ{`>&o5 z3DsWg)_ZnJQL}zlXY<)%Id%f!BcyD{Av6SoE)y zVI%ChoE+zV_HHP`=c%QFi?*XJnXD2I#j&YW&aoe|OMdk9_SEwFk$WfNp+4j>waf8xC+i zK(Dhy_ZJS`t@pchpZ<%`BYmz1P9G$tp4S)nCT?0e*>4TJy$^TsE&|>F;Kku|9fS8> zAELjqy&31sxw{91Z#(&CF0<~lLDGK!z7X@W;VBvixz3QCqW8C4=ViMPkN15XUs+Ci zGXr^b{fY9K_-^$+F-6lU$kzb=#1zg~dfzH?(hmrCc~tAU?ywztkiLnBmOkZT`9#oP zu~^4<#wE(_?+ed|sR!weO$o1$G$k1Crh(6WQQhwr9ppL>_)DE~%1J#Kx9P{s(_fnQ zhU4?GakyaA0&XI~o0=w(| z9PQ22%)@d8j^hja=k>&cJiNaq9^?3&P9NHFfc7)<;Mqct^0FPxeBSb*KhZB}f94+m zUw7Rlpx^L`eWc?|WlKxa#&K2wUu z6rE-REc3Ewg^DIC-b^83}};(2X=cz(Z~hj5))rS!Z_ zXeZ`3BhT|FEZ>51t~(!&iuX{yv77oO>CM?ab)kTep5N4Kg5=pR=x40&k*edg@w4>; z=fh7~|1AuhMmU@UBmcdK^GT^{S2GWLLg-K)#y9so&AX7F>vYUh-|nf}uVQPJ9_y*c zief#_^cv`pPkYF*ll_qUIv5wX0iJTx9xU$-J$t8y{ekhxwF}|dPk#X4l6l%L)Q57{ z?d@&j7v*j(#xhqRPXha&Li^7#Sw=lEgdu>Q8`THT+ayqu3_rs_O^@?@pzJm3e6 z%cQenv7Q4bzG=Tdikxq|_H)ij(Jzc#wx117#dw{r@(|x|IBtW`v%;G61L#qAyw0EB z0iUgl{$lrihfbJsw!l-rATHxv0pW|#{)y@Xd9WT&d5AY5wKh}uMC6~jn5X^b%+qo1 zZ;(%+JZ~5BJ5%asNg2n_I+TBfl;KP7x&ihv<6LMQe+K0OBNxw+Jcsg)^R=H5-`}TxdoBEKRnTvAfAeby{t(Nt zAKZxYzo7i^RGo*Oi~dM{fjt|vA2U8a0KA*fpSWH}`4_{^+p&(x@}@mKL;CiC+;;>1 z?o?ebVtlFFqk3>Y#ddrmwf26o&tmYOL^$n_N-ZJU^{sa;$m&Sjm{{ zOUR#SzVhzQ)guM&U+~u%f&RL_d64;!jhn4<$6GsQj|o4Q^%W-k8&ia;ZHFC_nstdx zNjZ-?wUv(Rj8|MY78tp>{%-o)Y{}EFxgITLaMN`8a+m*6@t^(Nn=TGi@`NX};a z+!gH*=Mz59$@oe>g!hYdK0^D`4%}zy2RR0}(sA+Sr}RFZ_VXK#eMR&!QFNfBuDpb+ zYLD~g7>}t>SJ0(h{PcsL7fe*1R-h+`a!X6>!hddf8PUtcK)o0K=gzaaE>;7-n}zwr z1<1Soo8#r_t$0r1I2(Ux&#}OJ9&y<4we$Eq=*jZOoN_a-uykxEGIpE-I$x$fXX6d~ z_u$y1DzP*3)BR}|HP2V{tqS%3i!PJe_U}ZF`v8u5<)NQE zpQ7^42;#V|2PK`Ma?nmQ(JltxUc67xTzp=VbQViAodfvG96b6x^DeIAFdlA1eGH_` zKDhPULC`CJuhe-9;r|MI#n5kd0-pCxoR4w-W$bSCrGF$1QHHeB8pypIshQ7YLL{3| z4z8azjnnl5j{n9lEd92p={{3YZed?R%L|m-ts9a(D@GK`zPprfYgnXX5GZv=c}N9Xx_}%GDTh!&+PR){DAG7c1E^c zzaM273P3LWntXSI-)AlGHLDT*1>f+o?d$R}{qzN?_tW2a)uzt<-AnLq+U^cT`MmS;0xL(2g{jq5GNI{;ZNI52e-zcP~K@M~` zZzkpuj7MD|&rHb2I1tS(ER!m$tVv0~0(8$tS_^ukTWkCyKFir}UVy(w!0$BRQ6BmS z;l{RBy%WhvI??icE24FhW^&Gkd>1%!@>~`B)iv;g(XDl#gLEmsk;BH1TFk5df9vD& zNg0tlQcR?))p5Ju2tDQ^WxG;d-oMa(zjEyB+A&^VUoZR)uz!GGn<@2N7fKnU^Jk6D zary3pT(>y(re6@B`qpATIKlBx_7nPLO4dj_zPa{T4L%S3NPZKc5BW3Bq>RhA<1g># z>E|0j_sJIM&xHKckL~hf`y1nZYH4nX*g02^Hw69dHSm8vfgHq->!tgY^aGYBYKH^t zf^~1=$NQoB0o%o#gR$q(qS;vojT4_j-nWp_PNJh+j5myXk>YS1+XcKY6X;F6#jyV; zfOGBd_E*Y(IQ)U|>_mM|`%Q+rNWyoG*Q` zrTB{VJ;E_gx1=xip}oy{SgVg|b{luuUwT2Gjz}pV{f_u7XS+}yw_O;ISbu67_iuC^ zk@1`K=%**AX}o6t_I*7^?x(MKLo9Bd2eRWk^{*}5^}H=_xYC~AXx#RgP0e_}9OduX zG=27ZP4)dM^t<8EmwrS&X;;E!J8<;3MD0p_h@S&|+QsdkEPoz;a4zg+)?@8FW@6kf zRu9_EZ3oKF@tO7HHxhD?F6l6iP!7VodgN0N#~;5#gU(|+<6I-#pYe1w<^{C(Pqkyf zANTRi$PPDMtDrN^8BNyeVgB-tig2-x+5IAdC0qTUA|m*3DynpoRYh4Fbn58*w6XAEuWJ;b6!TZ=)(5_JqP|rAF3Mi zJv}_1+#l=k-0x!i;q$@;*mv0GrA`nEoDXn6oZ~c~gQXl}f%kXsxo-t;8~mU9P<;NE zdVG_n&-<8kjlll{@Y~aL9h!2jPQ!g>T5YDlv7f9<)B7#bV_sn7`a@gw-_O_&v3|q% z+U#UGp4(6?nLiG)p`!-<_I&8Y^^iFyOGU=_9~5zc)so! z&^Z+RGVr`)Zh zS=i5*^8GPB-k;+`k37h6HtfK2gPe~M-x$;S!DRt_xc_lqgK`j$=ek&)NRDv@v&U&7QU^(r{IK_F>RM5K#{BLpEk>iXR7dHqWzQ2L} z;7+F>&@P;3^8E&X1YO2Kp(PjNsOCJ6&zmrgQcpgw>EiR82l08nBd^ufyQGZgh*|y^ z^n4rR65D}!#+8&(eLme?=l*LO<@5;W6PQ;{fgSl?uNT2*#bVv3=eR_;Rr`7`5K4R> zV%?t6f0I1xDTlc)xLeBI_c^wcLUWmM%9k{)D7Qe;k@)C7$D`-K*yo2GZZ0_er|^56Q{3H`G~U3hmNq-vsu15By(4T8ncjw9onA z*Se_K?u!^Qx=$8Y#s2yj_>D;E&$QpyuzySMpZo@JeE;OGHo^NRO{f$5>N;)RZ+5Md zJjYSfUVoB2`LVpDQ_p*)ob9^f&T)30wd(e&FQweHmyKh$d8uDWKCP{eBXzgwb7}Nb zzCVR_-u8UXxmTL`Uj# zlJ;g?6u{NJt^P3cCwnEgt<97lydOz(+taS%SWx@#2;lcbN<9ccJ2Ou|;X1jQ2Y)Jc z>^CRFuCr>i-2%HdT$wF!v}^yiT#wiDKl^cGcoN%XuRga#JB~j^u+95#7wCDlj<7H1 z-xs#6T_W|q^Ik#j_bpMjUeo8A`l zjiB5XA6Tx%LAmiqT^~XEcQ4PzAGXiskaMQP-+hkqP|)T4(Vbr!_}KzN|LF+$pg)x9 z128!#XEFzVd@R!2@P3$U0>5CXq;N8$R9MAj0 z&+G6WSnA`(8OBleuRCBzzTb**+ML6;A%Nq9v4_1MBR=O9e*}I|kMsMSSClx}*UoGw@MHXQ;n<#Tc_-kfWR1&`pL$vYg(g`8yZ;U;=R4%{68bgg zUo5A7?mEMvh$DQT8STjOmtlwHZS{Vd@!>_xZ+V~Ctz9^tyZ4FjfX+W)KRyrgm1ED8 zcHw@^`SvUDuVroZexL6T;r-Ee(BB3)%FFn|`90xjkB{5x{Wc$(C#LXs7Y$n06Z9 zk7*Z{slPez zb%S936YJY;ii&NB&+V({c1qO@!TY=ifqy@wCf;QVKI3e(mp*Ar>3QFo1^D3(9^WUL z)=ST)6qOYh3cXwqAbvjZ@*I4|-_%~ZPFhy3h{P)ae3664`CnQuJ=c*pM(v*C@Er%d zF%CZcJ-ydByFOc*(^u_==b>^zh;p0*{IeW7eC{(NPREY##ib)H-SToBcU^l<1)cL9 zdVC%ycYLp<*{pm!r&FNkktGc9lzM}g4i<;-FE|uJWLw9DS;F0fSL%4bVA`os#-qMPina%O4D`PX7 z=Z!iSHqRS%tR2YLs8iLv9_qAcr=QGsX65AOe157OIUnG9$!m!3JooLsACmpJ$$5__ z*TMK+RmP{c+Ub2L*FoqP(L=)Xfc8$lo0C7v$@g>egPi;bCtv2|Cp-BWPW}off31_h z*~#DIZ*|4Dkjy0+IMp7($M%&ZMAFJt~t{#3Ac}N zz~=20JMXekd(W<@wtQOho2=?7A-|Yj5%!~)F-(Y0)%hVl)n+2lyxuBn3R>bj;-V^d zUJ#O_CRP<{znEdvoR7{vTIN$!6$`}~!!|sAPYcg`&a0Rf<`WB#=MyJa*cNL^znqHm zL+xH&t$6I8#tlOKZ*r_Mz}DicJak&mY?_3M#|#qPlu!NY9!U>^vX$$4imcA$<_(6G&e~%IDJE=MqhO<%*qn z-%x{f6DgC6>r*pP&iN$adZz2Tk^7z(!k6sswL$2RzWY2L-}lln9s9somreA(mt(=t zecwwgj<5R-z4{#~e0iUjAsKV^O4szaxUcdTO?p{M3bF3?E712Bh2M+KdcHTC=kK}R zcs%%<_rt0zSM4sZ(@`Ku=0Q`p`9Sc6QI!&_sM7)n(7t#Anz7K@`&)CuO@efyc+KKPY zckPfG-0!NUtUm+%i+`j&raJZ@9_>+?Ui-M{eGt2Jlkx-P=RQ@hvV+>G3UZx`)b*QK z@B8h!P3kjw!R$W?ALau;Q1U_f<)BydBlW(<(VKYG+h3&5nezGH`@R+_;?E(oeHOys z3%#iI4;L;uXH1FUalPew$TyezHw>zm`e;sRv7{E*q=a7zxEtf}+AoXsON6C@WG=$r z2Dn?}@SCJQTBhshF8#XzSBI3(o6ye5rTWH0(!URI_Yxl8?|k?DnGM3ne1FoWQL_Op z`EvPZF5<5Q-U{O5z0dLQfC7Jb&KSX?yz*PFzXER+(x=dlM&5dL*vsvdq~JxqcOaNL=r_73*lXAsyJbBwIi>VjcDllmpG% z`R}D8dCVN*crO|7LvOjrRIDo%_DJug!BJq`MDrD?p$4UY!vBXkn1SOWzvvbN4j$1eKF*p zST40U=4MH%Q4&Gg<4cR7odNtR(n;@itH3A8KXXM+ zP(=to8*sA-kN3C6;Z-5R*8=Ve2cGdIG9XOd1H$wd0&al=&wbv=05u%t zxdCw32k?XDTRjIHZ}lbIO{o7v9PWAnNIaf|?+*vZazf+CCDUev@>P}L`~J&fvqSf1 zx;he{@44g5+Qs_3%}r=%v%kJY(m2|1nT@0LmwMo> zYrklbz#04}BxU@o47{fahn1 z-}7SZu}0)bE*q93DX;DDpWBdr++O#Ic`l#*fO+CY!k?}8J^_9sQn&rTqFhdU?`dEE ziO_WYpcBr|@xGY)eG57xJlb3J8vl@<$Ge68hVhShkqjNzT|OxpKaGD|(Bb>&+hv6B zuPHC(cnIwkJ$_WN=ovD;$+yptQqTJwcI%p<<9cKJ`W;gKQ2W{!B=r~RcNOHfT!x$_ zbvx)M9k1p5-ve|zAwB8gr7hV}qmN8KwchkHce zBF?#pvr&H*;m-YRtA*>2iN9pbH3{|SA-w>4xN(4a#)(M(p-KS%F9QA)q%(qk7=GUr z=@2=&NbfV5p9y?FPS5^I3XAQ{M*U?0TjrGs8v%EN z3vWkB13yfkj3@l9fVH~IYu@b@@){7zkR zNtW%Jgnt-tD;#*Plcbmzeu!v1=TE#2RK~IjHBjrSpWXq?cfxur9-$C+NA($k3zEf|_iD zT^^@>w(ED4Gxloz$87(6z29WKB$4gFdyn{dZz&Jh??nH1zbg?10prK5;A-BhJHFOuv57Gnikz*{h#Y%X9e~R-$%Wd5%yoxzLwt) z89MJX?PK$W^t(m3hv?FFCLUNg;=6dRJe81#_irwKBL0znT)9@xGhpWe+WQNQXOxR} z8V~uC`msjS%Yk<(@$oz${fzj;BAw(hVL|2re=g}HkYf_$h>QsfvJiOliQj@8q?4Qz zmSZXKuP2=Za$G<;a>8=l0lZs?-+~;Zlf(fPhPoH{cOjkIVWS;)BmKg0;6cJ{u%TevuC*0$pXJ|mNWVkzl|Jb(O+Hk|$Bp3c#y#r6l<|vll8&oq zyq$Vi3x7UG+U8K5SL}k`tMObs^_>I7eyX0G4^=(;IQp1*!UiF^9fm&~{P~_}_VOcv z$L}&;3HTV`k35v)h>q{X7VI)hXOxY6W;eNnTYYVnc>=*A1-PY2vMq|}r9uLeF-WFh=HfIAE6?uT{1 zmh)T2CvzWeEz5b%`GB8<)WB^Qy3z7dyFY6ub0$yt3judQ96nRv8Anp`bf(3xs}ir8 z@Jw-^EVy!|78Id<)Y8Pe4Dgr6@opCQ$bd{qf@?17uOM9dSRKa(91+0Ck9nxS3aRm< zeNyhHpZzyUBYng03jjAC>89Mx-wRwkp6K(&$^D0Nh?8n>3E&qYy_xYF?^&U}*e;R& zA$0E+;4MX37sLr&XR%Dozq?za8y3r34tjS4^lKjxT9Kg`kU;o;)Zd5HtZ!IXGwVJX z7JgV5ekI@@LVA@8KZY{}W$+l_{(_Y2HS4J7va0n0Y1W4C5EntY@=*l1F8YSIPDNE5LgZ=~Wq5+xxVwY>(?9Kb~(-9>q5v zD*o%h+w9=KOMKw@pp!aIpODNClkwgI{x+n3!(YA-4z&MO8M^N5r(dv4%2Nx=@+B?E z3rDnn0{+PHD=!0=_fSpF@6wZ}DiKNCYi{0b$4yk5`2E#W@;fpL8{w!J0r=ra&3=}Zo9z%86>hhD zz~wpcZu{+6aryJY;>?Z)x zwDSv+-@WL|b&~oI&b0AmBK;Zh@jTd%@v#E+Q(EA&`(d3g)!Z?|+ReXS+dq;Maue?Y z*r5<jkbPBKQ(kT{*Zs3zA@MyQfVf`O7LBdl;bex>rZwp zvUFRr&jz+Y7Jlkz?3$d`ieC~zK15ubrvtAeyPlXa4&j3~^KwCFVX zAHQA#{0k0V3?ONJ%S+{FRsp_4Y**h`gtJNpio@e{jjdnJc?n#Z_v20 zD*^nh#-SU8$0L9zo_QbZSSkOeW5aSuzeSw%5zpFn(($>_yV|z9IfuVV;P_pfRMaPT z(s7^f^`YJzA6ZU6VY%^ls~5|ey8iwx?AHtLWuhL9+w|Nd_37A2_27Od<>&%ASsw7= zIkYl8zgC)Ur(>d`y}EYN^i#A)Pv~jn548u^nJ5S4J0<~q>~n38zo0$-9JJ%(yM*J* z4{JT?@w+|)K#z6^@M?8kjr3G%v+w!Q5<8wyo;bb7zY>_-1noP#Q|+TtzZ>sqO4QGL zcT&IpvF&&Y;Qd-17uY`0vg|D3S0w+MT_a)t!;$(8m+O2MFryRLcS4|-`m0|##KyVP zQC?R#+KzMd1IjVFQ*E7)HtmaX@ab11A1yo0j(;VRX?C3fxe61=SCK%z$^`OVfbz;t zx}KCs&Wb=zl`kbP*P1TdS|`3fPzAZp4dm1PaK7ik#374Uo;$u=)M^dgE&+UvgU9dH zw93{uu9fEM`|64J8^B-g;PHDmDS3Keg6Ftt|9OD_E%ET)S-!u5eB0u^YXwDm|5Z?2 zRMxCHyoJEO7AfC@L43-=_+$3BUJ`uPw;5Y(_rv8azvq0a+NB<_i-!SP+ zQEVOd37?JRSkLJRZMptwnyXxj+;j7clC)zAzRT;b=dFibmLcUi`?89O)k?QMQ_@LO z!_U)In-?TBuOA$foavW~^gJHhYh@=Lhq=!DdZ&d}587d6Cw=aS`8ODU(7(B!O1ZLU zR)_eS$4v(dU)IMYV=kUUqd!p&L(h)$Ddq!50+$o=PV>EK*kL15zVBFI<>K>c)X(ra zN6K4u)^XVV{#isS&GoNNwf9RJ?W}QQMX|oejqSZIlDAOmS1k5J?M#0DzFvQndiF+@rLw$qy9^(6zl#g`$efz!@2{Jm9ulBoC z#Iupkhwgq3c@IH)OS1ZTOx5uC{ibsupLyS^wF}#e@wp`DW6PIvo&bBh>owe;XMfy? z_xMp?fA_Ej!kX{>VSh;Pto?`n%(#-Dz;44GyJf@Qj9=RM5alGDUv=JS&)Jh+dguCj zk%N9f_-xpf?{A|22l6l2VdE9yi(!XS@HgLWxBRIW@%ddx_S1k~QHMK34$?av^v+B` zkNC6`>GZ?*iTV92#^biX8e|tT_x6orcQtt2dKt1zkIQaoi{?|@EF@9~PfO6c5 znh(25ew6%cb}fZG*En{LkAvEe^ZWj4kf2fj*tl>zOpldWd$4|@^ZYl<%PyM{f~%Mw z3${qeg8ea*| zIK}rD6OR3l?=@vP`w_(U7$=C&IL3WQ;uHP~$P+=q4BHCwKIlz0&Jd2@DZc(N#5YH7 z({Drm+hY4>S6w8uY4^$hefv&pPN#BOO(<_3Kb+mXzGAYru-m>S4!tUHO^DN`zwMB` z`(DTPw$QAjVBYM`&vwBNRwL!O{Wup@)`=r{!&Te@-l(!k(FHe4!7V82xK9h@D&pQhAJ0q=IIPBA)ve}R0@!PbwU2kvv z&5$dli1D`d=zisrFYc=wQ#K<7xcY;BZ=^LhhS%-sFMMt+d33)M1eN!9gMoJnQnQ|7 z$BFnzs*DVt9cPG_1^8hH;6X4Xtw!rXr|hgkJ7f?)A9%S3;IoATzM&0=62Ol_YQ_&c zZ#44R@tNGmpuQZb*-x=>DWm&k2~2pm((@(&?sTMPpNH^v+}5Y8AEjnOCv zBAUXUkNOIvX1|7Tp^bnGQGWqavz|}5VR5d;FHm2F)SRQRagXp(v{Oh3L*Np?*C6G- zlCg&!GQ+#C<~!4XyBw+651>6Pyt7T}{T6UnA~oy$l)q1N`RAkl8l+sm_OTA#3G1*; zD|FxD_g(aUgm8c8qI8)z{lv}_$%FelX20fDDf5@5<%zDvs4#MUDL)&RYTP58N1>;=Pqy*!TF{Tz=UpLqn-RC05TB<$ zr03+X1N?hkbUpJe_{W=F8rBJ36Z|8stNO{i@9VzdrlGnY_imT^TLdnxtBx9a4aXBS@*U68PJ{g3+sO(gIsLKwve}N*V;^5fqzDC zYbWCGF4(nGswm%g;LG*>Z;(&w8uk_Yg@ z&$?<{F>%}WyPjQ(tiLkvH(YG}|47gq0)O$(*7bMuW?Z|Z@C&DY`$F!w4zcalPsKF* z%O_teKl_63@mtkW>{G*^sK-FUr|bJx1h?5$>!Y0OA4un} zLqFs>SklW1>{7o*=$LkEh1BM!J_I=$rr#muMbQ7(UG+I0_qj!ZF<0%+&@Wl<%ES7f zppI!*(asYBeYBnZMc2Qfw0M$IC1E`GaZclQ z;O$tv%8mz%L66_TFy%H*{mv=(8#>tee!OQZH_~UET>`uq;%o#8-iUI)LHCX3tlDDx z4f&Jb!Y(9nMHm&(#iPe|*YyW`$@RZV}9Es%PI6(Y)U0=3*7j)J0 z7gwX*7odM!+f~=$8qmNuu-{;Pmgi_5g1Q{o28w1$$6#w)1UW>qo0S zblu3cKj%rtE_PmG{M!06_uWY6kK}vs{$$2W?Psq4dcpIr)JUW;=fN=l9qqhW`9An> zInqCO#dG8V9mVJW82ZoF`*l3~ysM6XQ>QZ?DPJG`@(c6_`tMT5PwN+6F_*L@ZTt=P z;Z(7?X1-!Vp}8{c|KK0}_a?`GIj_GZf&Y>}@j7>f|H2PhPCtw}=Z|3TxjWWYtrTIJ zmg@Tvh{w21{B2IZe+TyX5Ptg}{Psim*FWI5eC}*H_N7VR_{(_VYf?L|xOSL@ejMn3 zP47~Hr=NTV{x5)E?b2a(UeJub^+)=piGPKHUmO}WJ?~5S%R@;24Zo@Frt=y4$J}n} zA0{4#=Et|AeSYX#`?Szc0-igrrFGMBl=>!Wk2G~s=d}Zm%KXZK-^tW%;N#5sk zlCVrV_#6s3VjqoOD{!Po`?cvd?`|nC!MTT9p$9EIYo0zAavRE11=w77AaC@zRPwXt z;k`^KUxswx;$GEK&$w|X@q*`uG(y**eAYbOpC`WJn)f}SeqonX+x{$%eH3m7(qTR0 z^|=_oNH;c8<)u7~t0#A>ze{jWh28iZX`C+NLD7Pryb~b^xq4+ zEwt^>J%QaR5B>g9@?8|RYqdSa;d#8j^ozppEtw5_nETaC(Vg(@$G_>8ZtwSaZiezP zPkRxb^EH+;<#=SC+u0yxcfs%HLvF_7Co?dP0P%`^?U|EcMScXeD4LF$GR=Fan)__)s8(FFO~z3__G@CwfLlK z=36#CalBg(`#kUXG4+VR0OosJ){l2Xq33{iX9B;b9BkJHwu95IuR3~c>GtE^t7FDV zy8!L3M{TvUUvu6Ga#b2{8RC~Dhbg3%rERxpUK~n zx^gp;Q-8|Ma@xb-nXYcmh08y4QO^VQn`iYl>%sPpuGCpDZ*!R9?}C1eD-XbrJ02Fk zU!OHk$D{jEe;-ow{9Cn9;(pVgP;UB_EpMZ2f_i+$&CE-NJRntkKSON9q>Yj%yorZ) zeZbt`Es=6wd@eKv`=>3XJcq+|0rS2Bt1-u4>Os9G@78nh+yaM)59#Lpd z{1UzZa3dY~xqu&kn9e`P9M;apPoAT2_rnf>9o+H`C^vGfk)LOR9@nXg57YUwpMIX5 zZ>EkIlP7R_&W74qkZ%;_#C(wQ@cU1vAExsVbH2G)=;+%j<(FRP1OGgS4*Q8qCv{9o zj$rcrejwvj0slgW4!>_rI>nHuU0K#x!OiVEVvMADP|yi4-Yn3oap(r$EgLAHAH2&V==e;s^U9`yJ0u3jLJryO%~CM^__ z#52!FoF#epIqGK-e;L1G0%Weg!5`e`s9yy9-`LL@^f~I7#WK%t;+*2S_J>MfmIPxdFd0)P@kHE@B zd=6l9=BeDI^DgAM5_;sds-Gozb>HiGS<)x`+Qnbl^B1JcbG78}##_eW@Na|E(6QtA zrbWB#_};U-b8gVzwNB8@e88^z8o6z}F#h+Xb}G-;0v4f`?&C& z+g;~19RC+M`K3<2&dER6UFG8UKzf{U;t4{R`#}&#`f7i)QAIfG^$`4c0@8}^wVAAwv>oX%p7d3H9Wvf(;IDG% zFs=l27*`U|Sr7bm4jsmqfDYqJ0y-}M|2c;a+0asZ;t8_?1$L>@YprF&cpM9^dpFC<`24WZoWfr=QX@P%LD-HTW4k4eV)Gg z#WvpAn`8sS@$;9ErzcW_XG!opY#Q-0H2e9Hvs7oJ=CA_9}mlw-}{~$1;xDo z#>%@N_iRH)jmp0TROTVX3JTA;>6zJzUd|dm+AlQVU zy~6Kv;W{_R-L~XgqAQ3+xjDnBo1|xgUzx+V7wkC2;X}G?-&PKN(w+)>=Q(tzCi0i2 zi|!EI1KRrtQq;5>^rky>Des&>-ly$6cVoBXo)Ap7_lj9sm!&C; z`dL_$TOt273G`SV$fNfAQxBcb)sEY2?f3y4VC(&wkEt@IUp@U7`5E|IK~cWsb4&HP zNBJ$+1K?Zd@aMV}`>*TwY(T=f^=x0Z>z$DES?JTNM}58UuSb4E51n5&L9d=tX)ZqJ z1N8lCO0ck%>$j1FYjAoryd2P@O4(7I zegGYur+R<0y;HgX^8@1g4f@?3eh=9PTovFr9ubau65mZZev%IF^9e^fv2V15aC{zw z^aZ~i|~9t#D!-&G9^5pGjZkcVp>ADuMmxO*HFeMwND+&iBEYbAIq6?9iQKi F{(rn(<4OPk diff --git a/capsules/v4/rom/dir.f18 b/capsules/v4/rom/dir.f18 index f299db09..0d281be0 100644 --- a/capsules/v4/rom/dir.f18 +++ b/capsules/v4/rom/dir.f18 @@ -1,6 +1,7 @@ \ dir.f18 -- the ROM's directives, and the end of the system's source. \ -\ What mkimage.c and text.c's header did in C is said in the source with +\ What the prebuilt nucleus's mkimage.c (gone) and text.c's header did in C +\ is said in the source with \ these (MACHINE.md, the ROM's language). Each is a machine notion -- an \ address, a cell, a value -- and none is FORTH. \ constant NAME VALUE NAME is the number VALUE diff --git a/capsules/v4/sys/acl.f18 b/capsules/v4/sys/acl.f18 index 7c09c2d5..65e11120 100644 --- a/capsules/v4/sys/acl.f18 +++ b/capsules/v4/sys/acl.f18 @@ -1,11 +1,11 @@ -\ acl.v4 -- word-level access control: the fields of an entry. +\ acl.f18 -- word-level access control: the fields of an entry. \ \ DECOMPOSITION.md 5.20, as v3: ACL-MODE@ ACL-MODE! ACL-TTL@ ACL-TTL! ACL-ALLOW@ \ ACL-ALLOW! ACL-PINNED? ACL-PIN ACL-INHERIT ACL-INIT-PRIMITIVES ACL-HEAT@ \ ACL-WORD-ID. These are all the capsule does itself; the policy -- what is \ strict, how long a TTL is, what is pinned -- is FORTH source, ACL.fth, as \ it is ACL.4th in v3. The fields and the check are described in -\ compile.v4. Rests on compile.v4, quit.v4 and system.v4. +\ compile.f18. Rests on compile.f18, quit.f18 and system.f18. \ \ An xt of 0 is an error (code 16, "Not a word"). A pinned word's fields are \ not changed by the ! words: they do nothing, as in v3. diff --git a/capsules/v4/sys/blocks.f18 b/capsules/v4/sys/blocks.f18 index 656f72b6..2bf8be65 100644 --- a/capsules/v4/sys/blocks.f18 +++ b/capsules/v4/sys/blocks.f18 @@ -1,4 +1,4 @@ -\ blocks.v4 -- mass storage: blocks of 1024 characters, and text loaded from them. +\ blocks.f18 -- mass storage: blocks of 1024 characters, and text loaded from them. \ \ DECOMPOSITION.md 5.11, FORTH-79: BLOCK BUFFER UPDATE SAVE-BUFFERS \ EMPTY-BUFFERS LIST LOAD SCR BLK, and v3's FLUSH THRU and --> . Part of the @@ -23,7 +23,7 @@ \ Constants the loader supplies: \ BLOCK# BUFFER# UPDATE# SAVE-BUFFERS# EMPTY-BUFFERS# the requests' numbers \ SCR word address of the variable: the block LIST showed last -\ BLK (SRC) (SRC-HOOK) see input.v4 +\ BLK (SRC) (SRC-HOOK) see input.f18 set HDR-NFA here ", SCR #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : SCR' SCR ; set HDR-NFA here ", BLK #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : BLK' BLK ; diff --git a/capsules/v4/sys/codegen.f18 b/capsules/v4/sys/codegen.f18 index de601a0c..2ee2e8a5 100644 --- a/capsules/v4/sys/codegen.f18 +++ b/capsules/v4/sys/codegen.f18 @@ -1,4 +1,4 @@ -\ codegen.v4 -- the code generator: opcodes, literals and branches packed into +\ codegen.f18 -- the code generator: opcodes, literals and branches packed into \ instruction words at HERE. \ \ This is what the compiling words ( : ; IF LOOP LITERAL ... ) are built on. @@ -18,7 +18,7 @@ \ An instruction word is 32 bits at every cell width (D-9): slot k is the five \ bits whose lowest is bit 27 - 5k, and a branch there has 27 - 5k address bits. \ -\ Rests on core.v4 and dict.v4. Constants the loader supplies: +\ Rests on core.f18 and dict.f18. Constants the loader supplies: \ (CG) word address of fourteen cells of scratch for this file \ CG-BSLOTS how many slots, counted from slot 0, may hold a branch diff --git a/capsules/v4/sys/compile.f18 b/capsules/v4/sys/compile.f18 index 066439a0..8f4ba668 100644 --- a/capsules/v4/sys/compile.f18 +++ b/capsules/v4/sys/compile.f18 @@ -1,15 +1,15 @@ -\ compile.v4 -- the interpreter's inner loop, and the defining and compiling +\ compile.f18 -- the interpreter's inner loop, and the defining and compiling \ words. \ \ DECOMPOSITION.md 5.17 and 5.18: STATE [ ] : ; EXIT IMMEDIATE LITERAL COMPILE \ [COMPILE] ' EXECUTE CREATE VARIABLE CONSTANT DOES>, the control structures \ IF ELSE THEN BEGIN UNTIL AGAIN WHILE REPEAT DO ?DO LOOP +LOOP, and INTERPRET, \ which they cannot be run without. Part of the compiler capsule. Rests on -\ core.v4, input.v4, dict.v4 and codegen.v4. +\ core.f18, input.f18, dict.f18 and codegen.f18. \ \ HOW A WORD IS COMPILED. v4 code is native: a colon definition is \ instruction words, and compiling a word into one lays down a call to it. -\ Two flags on an entry (dict.v4) change that: +\ Two flags on an entry (dict.f18) change that: \ inline its code is a straight run of opcodes and literals ending \ in ; -- that run is copied in place of a call. Everything \ that touches the return stack must be, since a call would @@ -46,9 +46,9 @@ macro ROT push SWAP pop SWAP endmacro \ ( -- ) give up the line: stop compiling, forget the word being built and \ whatever control structures were open, skip the rest of the input, and set \ NODE-ERROR. A definition that was under way stays hidden. It returns to -\ whatever called INTERPRET, which is QUIT (quit.v4): QUIT sees NODE-ERROR +\ whatever called INTERPRET, which is QUIT (quit.f18): QUIT sees NODE-ERROR \ and prints ERROR. -\ (ABANDON-AS) is the same with an error code (core.v4) for the prompt to +\ (ABANDON-AS) is the same with an error code (core.f18) for the prompt to \ print the message of. : (ABANDON-AS) ( code -- ) (C)+9 a! ! @@ -150,7 +150,7 @@ set HDR-NFA here ", EXECUTE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ ( -- n flag ) the word WORD has just left, as a single-cell number in the \ current BASE, and -1; or 0 0 if it is not one. A leading minus sign is -\ allowed. This is what the interpreter uses: NUMBER (input.v4) makes a +\ allowed. This is what the interpreter uses: NUMBER (input.f18) makes a \ double and needs more of the stack than can be spared here. \ (P)+2 the number so far, (P)+3 where it is in the word, (P)+4 the word's \ length, (P)+5 the sign, (P)+6 the base. diff --git a/capsules/v4/sys/core.f18 b/capsules/v4/sys/core.f18 index 4e04d5f5..73a41915 100644 --- a/capsules/v4/sys/core.f18 +++ b/capsules/v4/sys/core.f18 @@ -1,5 +1,5 @@ set HDR-LINK 0 \ the newest dictionary entry: none yet -\ core.v4 -- the core words the host-node capsules rest on. +\ core.f18 -- the core words the host-node capsules rest on. \ \ Each is the definition DECOMPOSITION.md gives and the golden-model tests \ execute (test_foundation.c, test_strings.c, test_terminal.c, test_pictured.c), @@ -13,7 +13,7 @@ set HDR-LINK 0 \ the newest dictionary entry: none yet \ ERRORS (D-18). A word that finds an error takes its arguments off the stack \ and stores a code in NODE-ERROR. On a node with a prompt that store is a \ trap: the word goes no further, and the prompt prints the message for the -\ code and ERROR (quit.v4, (RAISED)). The codes: +\ code and ERROR (quit.f18, (RAISED)). The codes: \ 1 Negative count 2 Not a number 3 Number too long \ 4 Not a character 5 Dictionary full 6 Name missing \ 7 Control structure mismatch 8 Control structures too deep @@ -110,7 +110,7 @@ set HDR-NFA here ", CMOVE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ is the port it came on, by its number; (ME) is this node's number. \ \ Characters are kept in (OUT), 256 of them, a character to a cell, and sent -\ when it is full and when the text has been done with (quit.v4). (OUT^) +\ when it is full and when the text has been done with (quit.f18). (OUT^) \ is where the next goes. \ \ THE STACK. What prints may be run with the data stack all but full: EMIT @@ -154,7 +154,7 @@ set HDR-NFA here ", CMOVE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ list of refusals owed, and messages written and read a word at a time \ (MESH.md 7a, 7b, 7c.6). The ports themselves are still written a word at \ a time for the two things that are not messages: a newborn node's -\ nucleus (PORT!, quit.v4) and a node's requests to its kernel. +\ nucleus (PORT!, quit.f18) and a node's requests to its kernel. \ \ THE STACKS. All of this runs on the stacks the node's text is using. \ (SERVE) and what it calls keep to four cells of the data stack and four @@ -228,7 +228,7 @@ set HDR-NFA here ", CMOVE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ words are in (IN), is refused. A refusal for this node itself -- its own \ message came back to it -- is counted in (REFUSED) as one that came by a \ wire would be; or, if it is about the node this one is waiting on, -\ (A-SELF) is set for AWAIT to find (quit.v4). +\ (A-SELF) is set for AWAIT to find (quit.f18). \ (WIRE) is not what it was afterwards: the NACK went by another. \ If the drop does not drop -- the wire was cut after the message was looked \ at, which let it go already -- nothing is counted and no one is told. @@ -392,7 +392,7 @@ set HDR-NFA here ", CMOVE #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ ( -- ) send what has been printed, to where (PRINT-TO) says, by the port \ (PRINT-PORT): a message of type 2, its characters four to a word, the -\ first lowest. quit.v4 sets those two when text for this node arrives. +\ first lowest. quit.f18 sets those two when text for this node arrives. \ It waits for room on the wire, and for the 8 cells kept as well when the \ wire is the one the answer goes by. The characters are made ready in \ (OUT-TEXT), not where they are: until the message is on the wire the diff --git a/capsules/v4/sys/dict.f18 b/capsules/v4/sys/dict.f18 index e4bcde13..5c3e3165 100644 --- a/capsules/v4/sys/dict.f18 +++ b/capsules/v4/sys/dict.f18 @@ -1,9 +1,9 @@ -\ dict.v4 -- the dictionary: its space, its entries, and looking a name up. +\ dict.f18 -- the dictionary: its space, its entries, and looking a name up. \ \ DECOMPOSITION.md 5.12 and 5.13: HERE ALIGN ALLOT , C, 2, PAD LATEST, FIND ' , \ and the entry-field words >LINK LFA LINK> >NAME NFA NAME> CFA PFA >BODY \ TRAVERSE SMUDGE HIDDEN. Part of the compiler capsule: it runs on the host -\ node. Rests on core.v4 and input.v4. +\ node. Rests on core.f18 and input.f18. \ \ AN ENTRY. A word's execution address (xt) is the address of its code, and \ everything else is found from it: @@ -129,7 +129,7 @@ set HDR-NFA here ", HIDDEN #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ A word's code is here on the node; its accounts are a record its kernel \ keeps. So the kernel has to be told of every entry that is made and of \ every entry that goes. An entry is made in one place, (HEADER); entries go -\ in two, FORGET and COLD (system.v4). Each tells through a variable that +\ in two, FORGET and COLD (system.f18). Each tells through a variable that \ holds the xt of a word to run, or 0 for a node whose host keeps no records: \ (WORD-DEFINED) ( xt -- ) an entry has been made; its code will be at xt \ (WORD-FORGOTTEN) ( w -- ) every entry at word address w or above is gone @@ -221,7 +221,7 @@ set HDR-NFA here ", FIND #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ ( -- addr ) FORTH-79: the parameter field address of the next word in the \ input stream. Not found is an error: 0, and NODE-ERROR is set. This is ' -\ when interpreting; compile.v4 adds what ' does when compiling. +\ when interpreting; compile.f18 adds what ' does when compiling. \ ( -- 0 ) say that the word WORD has just left is not known, as v3 does: \ UNKNOWN WORD: 'xxx' : (UNKNOWN) diff --git a/capsules/v4/sys/end.f18 b/capsules/v4/sys/end.f18 index f573dd8c..27b07514 100644 --- a/capsules/v4/sys/end.f18 +++ b/capsules/v4/sys/end.f18 @@ -1,6 +1,7 @@ \ end.f18 -- the end of the system's source: the state it is switched on in. \ -\ What v4/tools/mkimage.c set in C when it built the nucleus, said with the +\ What was set in C when the nucleus was prebuilt (v4/tools/mkimage.c, gone +\ since the machine's ROM assembles the system), said with the \ ROM's directives (MACHINE.md, the ROM's language). RAM is all zeroes \ when the machine starts, so only what is not zero is stored. Then the \ image record (map: (IMG)), the addresses a host needs (v4/image.h), and diff --git a/capsules/v4/sys/forth.f18 b/capsules/v4/sys/forth.f18 index 90b7f3b0..8c98d4c6 100644 --- a/capsules/v4/sys/forth.f18 +++ b/capsules/v4/sys/forth.f18 @@ -1,10 +1,10 @@ -\ forth.v4 -- the first words of the FORTH vocabulary: the ones that are +\ forth.f18 -- the first words of the FORTH vocabulary: the ones that are \ opcodes or short runs of them, and the variables that are in-line addresses. \ \ Each is the definition DECOMPOSITION.md gives (sections 4, 5.1 - 5.5, 5.18). \ A word flagged inline is copied into a definition in place of a call; the -\ ones that touch the return stack are compile-only as well. Rests on core.v4, -\ compile.v4's loader constants, and quit.v4, which the division words leave +\ ones that touch the return stack are compile-only as well. Rests on core.f18, +\ compile.f18's loader constants, and quit.f18, which the division words leave \ through when the divisor is zero. (F) is seven cells of scratch for \ this file. diff --git a/capsules/v4/sys/input.f18 b/capsules/v4/sys/input.f18 index be674ce6..ed782c49 100644 --- a/capsules/v4/sys/input.f18 +++ b/capsules/v4/sys/input.f18 @@ -1,10 +1,10 @@ -\ input.v4 -- reading a line and splitting it into words and numbers. +\ input.f18 -- reading a line and splitting it into words and numbers. \ \ DECOMPOSITION.md 5.9: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD ENCLOSE \ CONVERT NUMBER, and the comment words ( and \ of 5.15 (named PAREN and \ BACKSLASH here, since the text assembler reads those two characters as its \ own comments; the dictionary will give them their names). Part of the compiler -\ capsule: it runs on the host node. Rests on core.v4. +\ capsule: it runs on the host node. Rests on core.f18. \ \ Constants the loader supplies: \ TIB byte address of the text input buffer; QUERY fills at most 81 bytes @@ -14,7 +14,7 @@ \ WBUF byte address of WORD's buffer, 257 bytes \ (P) word address of eight cells of scratch for this file \ (SRC) word address of the variable: the byte address of the text being -\ interpreted. QUERY makes it TIB; LOAD (blocks.v4) makes it a +\ interpreted. QUERY makes it TIB; LOAD (blocks.f18) makes it a \ block buffer. >IN is an offset from it and SPAN its length. \ (SRC-HOOK) word address of a variable: 0, or the address of a word \ that WORD calls before it looks at the text, to make sure (SRC) diff --git a/capsules/v4/sys/log.f18 b/capsules/v4/sys/log.f18 index 3aebffec..e4065878 100644 --- a/capsules/v4/sys/log.f18 +++ b/capsules/v4/sys/log.f18 @@ -1,10 +1,10 @@ -\ log.v4 -- logging, as v3: a message has a level, and is printed if the +\ log.f18 -- logging, as v3: a message has a level, and is printed if the \ level is at or below LOG-LEVEL. \ \ DECOMPOSITION.md 5.25: the level constants LOG-ERROR LOG-WARN LOG-INFO \ LOG-TEST LOG-DEBUG (0 .. 4), LOG-LEVEL! LOG-LEVEL@, LOG-ERROR" ... LOG-DEBUG" \ and LOG-ERROR-STR ... LOG-DEBUG-STR. Part of the compiler capsule; rests -\ on core.v4, codegen.v4 and quit.v4. +\ on core.f18, codegen.f18 and quit.f18. \ \ WHAT IS PRINTED is v3's line without its time of day, which a node has \ not got: the level's colour, the level's name and a colon, the colour off, diff --git a/capsules/v4/sys/numout.f18 b/capsules/v4/sys/numout.f18 index 57fb23f4..b7e9d6fd 100644 --- a/capsules/v4/sys/numout.f18 +++ b/capsules/v4/sys/numout.f18 @@ -1,10 +1,10 @@ -\ numout.v4 -- printing numbers: pictured output, the . words, and .S +\ numout.f18 -- printing numbers: pictured output, the . words, and .S \ \ DECOMPOSITION.md 5.8: <# # #S HOLD SIGN #> . .R U. U.R D. D.R ? SPACES \ DECIMAL HEX OCTAL, each the definition given there and executed on the mesh \ node by test_pictured.c, test_numout.c and test_printing.c; and .S, which -\ D-16 makes possible again. Part of the compiler capsule. Rests on core.v4 -\ and forth.v4. +\ D-16 makes possible again. Part of the compiler capsule. Rests on core.f18 +\ and forth.f18. \ \ Constants the loader supplies: \ HEND byte address just past the hold buffer, which is 64 bytes diff --git a/capsules/v4/sys/qmath.f18 b/capsules/v4/sys/qmath.f18 index 9bc02251..b947fdf9 100644 --- a/capsules/v4/sys/qmath.f18 +++ b/capsules/v4/sys/qmath.f18 @@ -1,10 +1,10 @@ -\ qmath.v4 -- Q48.16 fixed point: a signed double with sixteen bits of +\ qmath.f18 -- Q48.16 fixed point: a signed double with sixteen bits of \ fraction (D-8, D-10). \ \ DECOMPOSITION.md 5.26. Each word is the definition given there and \ executed on the mesh node by test_foundation.c and test_printing.c, here in -\ the host node's vocabulary. Rests on core.v4, forth.v4, numout.v4 and -\ words.v4. +\ the host node's vocabulary. Rests on core.f18, forth.f18, numout.f18 and +\ words.f18. \ \ ERRORS. Q./ by zero, and Q.SQRT and Q.LOG outside their domain, leave the \ result D-11 and D-12 give and then raise an error (D-18): codes 11, diff --git a/capsules/v4/sys/quit.f18 b/capsules/v4/sys/quit.f18 index 161d2c01..3ac73ea1 100644 --- a/capsules/v4/sys/quit.f18 +++ b/capsules/v4/sys/quit.f18 @@ -1,4 +1,4 @@ -\ quit.v4 -- a line of text, interpreted; how it ends; and the words that +\ quit.f18 -- a line of text, interpreted; how it ends; and the words that \ print text written in the source. \ \ DECOMPOSITION.md 5.15 and 5.10: QUIT ABORT ABORT" (ABORT") ." (."). Part of @@ -32,10 +32,10 @@ \ \ Constants the loader supplies: \ (LINE-STATUS) word address of the variable: how the last text ended -\ (MSG) (REPLY) (ME) (OUT) (OUT^) see core.v4, "what a node prints" +\ (MSG) (REPLY) (ME) (OUT) (OUT^) see core.f18, "what a node prints" \ (PORT) word address of the node's port 0 -\ (Q) word address of four cells of scratch, which system.v4 and -\ blocks.v4 use too +\ (Q) word address of four cells of scratch, which system.f18 and +\ blocks.f18 use too \ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers \ ( -- ) empty the return stack. `a` is only something to store: any @@ -356,7 +356,7 @@ set HDR-NFA here ", SEND-ON #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ WHAT HAS COME ALREADY is on the wires and is found the first time \ through: the node looks before it sleeps. A message it left on a wire \ does not keep it awake. -\ The stack what it does needs is tried first, (ROOM), core.v4: text that +\ The stack what it does needs is tried first, (ROOM), core.f18: text that \ has left too little ends "Stack overflow" with nothing taken off a wire. set HDR-NFA here ", AWAIT #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : AWAIT @@ -399,7 +399,7 @@ set HDR-NFA here ", PORT! #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ ( -- ) WHAT IS IN THE DICTIONARY NOW IS THE SYSTEM: COLD comes back to \ it and FORGET will not go below it. Whoever has loaded a node's capsules -\ has it do this (system.v4, (BOOT) and FENCE). +\ has it do this (system.f18, (BOOT) and FENCE). set HDR-NFA here ", (SEAL) #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here : (SEAL) DP a! @ (BOOT) a! ! @@ -411,7 +411,7 @@ set HDR-NFA here ", (SEAL) #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ NODE-ERROR, by name: how a definition written in FORTH raises an error. \ A store of a code that is not zero is the trap of D-18 -- the word goes no \ further, the message for the code is printed (-1: the word has printed -\ its own) and the line ends with ERROR. The codes are listed in core.v4. +\ its own) and the line ends with ERROR. The codes are listed in core.f18. set HDR-NFA here ", NODE-ERROR #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : NODE-ERROR' NODE-ERROR ; set HDR-NFA here ", (ME) #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : (ME)' (ME) ; set HDR-NFA here ", (CONSOLE) #, 8 #, HDR-NFA #, HDR-LINK set HDR-LINK here : (CONSOLE)' (CONSOLE) ; @@ -453,7 +453,7 @@ set HDR-NFA here ", ABORT #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here 2 jump (DONE) \ A word has stored an error code in NODE-ERROR (D-18; the codes are listed -\ in core.v4). Print its message -- a negative code means the word printed +\ in core.f18). Print its message -- a negative code means the word printed \ its own -- and end the line with ERROR. The return stack has been \ emptied; the data stack is as the word left it. \ (QUIET) is 1 while the node is doing something that is no text's doing: @@ -508,7 +508,7 @@ set HDR-NFA here ", ABORT #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here \ The three run-time words have names, as v3's have, so that SEE can tell a \ string in a definition from code; they cannot be used from the prompt. \ ." and ABORT" take the text up to the next " , which may be none at all -\ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay +\ (input.f18's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay \ down a call to their run-time word and, after it, the text as a counted \ string: the count byte and the characters, four to a cell, the last cell \ filled with zeros. The run-time word finds the string by the return diff --git a/capsules/v4/sys/system.f18 b/capsules/v4/sys/system.f18 index 14f698a4..1a4f6488 100644 --- a/capsules/v4/sys/system.f18 +++ b/capsules/v4/sys/system.f18 @@ -1,7 +1,7 @@ -\ system.v4 -- words about the dictionary as a whole: WORDS, FORGET, FENCE. +\ system.f18 -- words about the dictionary as a whole: WORDS, FORGET, FENCE. \ \ DECOMPOSITION.md 5.13 and 5.15. Part of the compiler capsule; rests on -\ dict.v4, quit.v4 and forth.v4. +\ dict.f18, quit.f18 and forth.f18. \ \ Constants the loader supplies: \ FENCE word address of the variable: FORGET will not remove an entry @@ -104,7 +104,7 @@ set HDR-NFA here ", FORGET #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here C1: drop (LATEST) CONTEXT a! ! C2: CURRENT a! @ (Q) a! @ inv + 1 + -if C3 drop jump TOLD C3: drop (LATEST) CURRENT a! ! - TOLD: (Q) a! @ jump (FORGOTTEN) \ the kernel's records of them go too (dict.v4) + TOLD: (Q) a! @ jump (FORGOTTEN) \ the kernel's records of them go too (dict.f18) MISSING: drop (UNKNOWN) drop ; \ ---- the system as a whole ------------------------------------------------------- @@ -143,7 +143,7 @@ set HDR-NFA here ", COLD #, 0 #, HDR-NFA #, HDR-LINK set HDR-LINK here (BOOT) a! @ 2/ 2/ FENCE a! ! (LATEST) CONTEXT a! ! (LATEST) CURRENT a! ! 0 VOC-LINK a! ! 10 BASE a! ! 0 SCR a! ! 2 (LOG-LEVEL) a! ! 0 (ACL-HOOK) a! ! EMPTY-BUFFERS - (BOOT) a! @ 2/ 2/ (FORGOTTEN) \ the kernel's records of what has gone go too (dict.v4) + (BOOT) a! @ 2/ 2/ (FORGOTTEN) \ the kernel's records of what has gone go too (dict.f18) $54524F46 (EMIT4) $39372D48 (EMIT4) $6C6F4320 (EMIT4) $74532064 (EMIT4) $747261 (EMIT4) CR $74737953 (EMIT4) $69206D65 (EMIT4) $6974696E (EMIT4) $7A696C61 (EMIT4) $2E6465 (EMIT4) CR jump ABORT diff --git a/capsules/v4/sys/words.f18 b/capsules/v4/sys/words.f18 index 78330e72..08a8abdb 100644 --- a/capsules/v4/sys/words.f18 +++ b/capsules/v4/sys/words.f18 @@ -1,10 +1,10 @@ -\ words.v4 -- more of the FORTH vocabulary: the stack, comparison, double, +\ words.f18 -- more of the FORTH vocabulary: the stack, comparison, double, \ mixed, shift and string words that are short runs of opcodes or small loops. \ \ Each is the definition DECOMPOSITION.md gives (sections 4, 5.1 - 5.7, 5.9) \ and the mesh-node tests execute (test_cells.c, test_foundation.c, \ test_strings.c), here as words of the host node's vocabulary. Rests on -\ core.v4, forth.v4 and numout.v4. +\ core.f18, forth.f18 and numout.f18. \ \ Constants the loader supplies: \ MAX-INT the largest positive number: every bit but the top one diff --git a/docs/v4.0.0/DATASHEET-F18.md b/docs/v4.0.0/DATASHEET-F18.md index 44ff8a43..ecf42f52 100644 --- a/docs/v4.0.0/DATASHEET-F18.md +++ b/docs/v4.0.0/DATASHEET-F18.md @@ -96,7 +96,9 @@ registers (§10.3). - **I/O addresses** (§10) sit inside the address space. A fetch from or store to one goes to the device, not to RAM. The exceptions are NODE-ERROR, which writes RAM and then traps, and the console receive addresses, where a store goes to RAM. -- **ROM.** Designed, not built: `MACHINE.md` §2, and plan Task 1. It is a read-only range at +- **ROM.** Built (2026-10-15; `MACHINE.md` §2): 2049 words of F18 code, `capsules/v4/rom`, + assembled by `v4/tools/mkrom.c`. The machine starts at its entry 12 and assembles the + system's source (`capsules/v4/sys`) from the console. It is a read-only range at `V4_NODE_WORDS` and above. It can be fetched and executed. A store there is an address fault. In the model it is attached by the owner, as every device is, and a reset detaches it. - Its routines are shared code, GA144-style (`MACHINE.md` 2.1). Payloads call them through @@ -307,7 +309,10 @@ These are reported, not hidden: and it is not to be extended. 2. **Device addresses are attached by the owner, not fixed.** D-4 (the memory map) is deferred. The FPGA needs fixed addresses. -3. **The ROM range** is designed (`MACHINE.md`) and not built. +3. **The ROM** is built and the host node boots from it (2026-10-15). The ROM is the full + assembler, about 2000 words, so it is the host node's. A mesh node's small loader ROM + (the agreed correction, `JUSTIFICATION.md` §9) is not built yet. Until it is, a node that + is born is sent the host's assembled system through its port. 4. **`stack.h`'s opening comment** still says there is no overflow detection "and there never will be". D-16 revised that, and the header carries a revision note above it. The code counts and guards (§4). The comment's first paragraph is out of date. diff --git a/experiments/bare_metal/runs/doe-aarch64-20261015-141938.csv b/experiments/bare_metal/runs/doe-aarch64-20261015-141938.csv new file mode 100644 index 00000000..e69de29b diff --git a/experiments/bare_metal/runs/doe-amd64-20261015-141648.csv b/experiments/bare_metal/runs/doe-amd64-20261015-141648.csv new file mode 100644 index 00000000..e69de29b diff --git a/experiments/bare_metal/runs/doe-riscv64-20261015-142350.csv b/experiments/bare_metal/runs/doe-riscv64-20261015-142350.csv new file mode 100644 index 00000000..e69de29b diff --git a/kernel/Makefile b/kernel/Makefile index 5c05aae4..bcfdc320 100644 --- a/kernel/Makefile +++ b/kernel/Makefile @@ -617,10 +617,12 @@ endif # ------------------------------------------------------------------------------ # StarForth v4 (STARFORTH_V4=1): the golden model of the F18-derived engine, -# v4/src, and the nucleus image v4's own Makefile builds on this machine from -# v4/capsule (docs/v4.0.0/NUCLEUS.md). The node is the host node's size, with 64-bit cells, as every -# ISA this kernel boots on has (DECOMPOSITION.md D-5), so the image is the -# same file for all three. +# v4/src, with its ROM and the memory map's description of the system, which +# v4's own Makefile builds on this machine (docs/v4.0.0/MACHINE.md). The ROM +# assembles the system's source, capsules/v4/sys, from this kernel's capsule +# directory when the machine starts. The node is the host node's size, with +# 64-bit cells, as every ISA this kernel boots on has (DECOMPOSITION.md D-5), +# so the ROM and the map are the same files for all three. # ------------------------------------------------------------------------------ # V4_DEFAULT: with v4 built in, whether it runs when the boot arguments # name no system (A6, 2026-10-14). 1 -- v4 -- for every build: QEMU and the @@ -630,19 +632,21 @@ endif V4_DEFAULT ?= 1 ifeq ($(STARFORTH_V4),1) V4_DEFS := -DSTARFORTH_V4=1 -DSK_V4_DEFAULT=$(V4_DEFAULT) -Iv4/include \ - -DV4_CELL_BITS=64 -DV4_NODE_WORDS=16384 -DV4_DATA_RING=30 -DV4_RET_RING=31 + -DV4_CELL_BITS=64 -DV4_NODE_WORDS=16384 -DV4_DATA_RING=30 -DV4_RET_RING=31 -DV4_ROM_WORDS=4096 KERNEL_CFLAGS += $(V4_DEFS) LOADER_CFLAGS += $(V4_DEFS) V4_ENGINE_SRCS := $(addprefix v4/src/,node.c exec.c stack.c iword.c heat.c guard.c image.c fabric.c capsule.c message.c wire.c) -V4_IMAGE_C := $(BUILD_DIR)/v4_image_64.c +V4_ROM_C := $(BUILD_DIR)/v4_rom_64.c +V4_MAP_C := $(BUILD_DIR)/v4_map_64.c LOADER_EXTRA_SRCS += $(KERNEL_SRC)/v4/sk_v4.c KERNEL_EXTRA_SRCS += $(KERNEL_SRC)/v4/sk_v4.c -# v4/system/boot.c is the boot the hosted v4 system runs too: nucleus, then -# the capsules from this kernel's own capsule directory, then the prompt. -LOADER_V4_OBJS := $(patsubst v4/src/%.c,$(LOADER_OBJ_DIR)/v4engine/%.o,$(V4_ENGINE_SRCS)) $(LOADER_OBJ_DIR)/v4engine/v4_image.o $(LOADER_OBJ_DIR)/v4system/boot.o $(LOADER_OBJ_DIR)/v4system/blocks.o $(LOADER_OBJ_DIR)/v4system/post.o $(LOADER_OBJ_DIR)/v4system/post_cases.o -KERNEL_V4_OBJS := $(patsubst v4/src/%.c,$(KERNEL_OBJ_DIR)/v4engine/%.o,$(V4_ENGINE_SRCS)) $(KERNEL_OBJ_DIR)/v4engine/v4_image.o $(KERNEL_OBJ_DIR)/v4system/boot.o $(KERNEL_OBJ_DIR)/v4system/blocks.o $(KERNEL_OBJ_DIR)/v4system/post.o $(KERNEL_OBJ_DIR)/v4system/post_cases.o +# v4/system/boot.c is the boot the hosted v4 system runs too: the ROM +# assembles the system, then the capsules from this kernel's own capsule +# directory, then the prompt. +LOADER_V4_OBJS := $(patsubst v4/src/%.c,$(LOADER_OBJ_DIR)/v4engine/%.o,$(V4_ENGINE_SRCS)) $(LOADER_OBJ_DIR)/v4engine/v4_rom.o $(LOADER_OBJ_DIR)/v4engine/v4_map.o $(LOADER_OBJ_DIR)/v4system/boot.o $(LOADER_OBJ_DIR)/v4system/blocks.o $(LOADER_OBJ_DIR)/v4system/post.o $(LOADER_OBJ_DIR)/v4system/post_cases.o +KERNEL_V4_OBJS := $(patsubst v4/src/%.c,$(KERNEL_OBJ_DIR)/v4engine/%.o,$(V4_ENGINE_SRCS)) $(KERNEL_OBJ_DIR)/v4engine/v4_rom.o $(KERNEL_OBJ_DIR)/v4engine/v4_map.o $(KERNEL_OBJ_DIR)/v4system/boot.o $(KERNEL_OBJ_DIR)/v4system/blocks.o $(KERNEL_OBJ_DIR)/v4system/post.o $(KERNEL_OBJ_DIR)/v4system/post_cases.o endif LOADER_SRCS := $(LOADER_SRCS_BASE) $(LOADER_EXTRA_SRCS) @@ -783,23 +787,29 @@ else @$(LOADER_CC) $(VMCORE_CFLAGS_COMMON) $(filter-out -I$(KERNEL_INC),$(LOADER_CFLAGS)) -c $< -o $@ endif -# StarForth v4: the capsule image, built on this machine by v4's Makefile, and -# the engine, compiled like any other kernel source. +# StarForth v4: the ROM and the map, built on this machine by v4's Makefile, +# and the engine, compiled like any other kernel source. ifeq ($(STARFORTH_V4),1) -# The nucleus is a capsule (capsules/v4/nucleus-64.f18), written by the same -# step that writes its description, so the capsule directory waits for it. -$(CAPSULE_GENERATED): $(V4_IMAGE_C) -$(V4_IMAGE_C): FORCE +$(V4_ROM_C) $(V4_MAP_C): FORCE @mkdir -p $(dir $@) - @echo " V4IMG v4/capsule -> $@" - @$(MAKE) --no-print-directory -C v4 CC=cc build/v4_image_64.c - @cmp -s v4/build/v4_image_64.c $@ || cp v4/build/v4_image_64.c $@ + @echo " V4ROM capsules/v4/rom -> $@" + @$(MAKE) --no-print-directory -C v4 CC=cc $(CURDIR)/v4/build/rom-64.c $(CURDIR)/v4/build/v4_map_64.c + @cmp -s v4/build/rom-64.c $(V4_ROM_C) || cp v4/build/rom-64.c $(V4_ROM_C) + @cmp -s v4/build/v4_map_64.c $(V4_MAP_C) || cp v4/build/v4_map_64.c $(V4_MAP_C) -$(LOADER_OBJ_DIR)/v4engine/v4_image.o: $(V4_IMAGE_C) | $(LOADER_OBJ_DIR) +$(LOADER_OBJ_DIR)/v4engine/v4_rom.o: $(V4_ROM_C) | $(LOADER_OBJ_DIR) @mkdir -p $(dir $@) @echo "CC (loader) $<" @$(LOADER_CC) $(LOADER_CFLAGS) -c $< -o $@ -$(KERNEL_OBJ_DIR)/v4engine/v4_image.o: $(V4_IMAGE_C) | $(KERNEL_OBJ_DIR) +$(KERNEL_OBJ_DIR)/v4engine/v4_rom.o: $(V4_ROM_C) | $(KERNEL_OBJ_DIR) + @mkdir -p $(dir $@) + @echo "CC (kernel) $<" + @$(CC) $(KERNEL_CFLAGS) -c $< -o $@ +$(LOADER_OBJ_DIR)/v4engine/v4_map.o: $(V4_MAP_C) | $(LOADER_OBJ_DIR) + @mkdir -p $(dir $@) + @echo "CC (loader) $<" + @$(LOADER_CC) $(LOADER_CFLAGS) -c $< -o $@ +$(KERNEL_OBJ_DIR)/v4engine/v4_map.o: $(V4_MAP_C) | $(KERNEL_OBJ_DIR) @mkdir -p $(dir $@) @echo "CC (kernel) $<" @$(CC) $(KERNEL_CFLAGS) -c $< -o $@ diff --git a/kernel/src/v4/sk_v4.c b/kernel/src/v4/sk_v4.c index e5d98e77..e7dddb3c 100644 --- a/kernel/src/v4/sk_v4.c +++ b/kernel/src/v4/sk_v4.c @@ -2,8 +2,9 @@ * * The node is the golden model of the F18-derived engine (v4/src). It comes * up as the hosted v4 system does, by v4_boot_run (v4/include/v4/boot.h): - * the nucleus image, then the capsules from the directory baked into this - * kernel, each checked and its parity line printed, then the prompt. + * the machine's ROM assembles the system from its source, then the capsules + * from the directory baked into this kernel are loaded, each checked and its + * parity line printed, then the prompt. * docs/v4.0.0/NUCLEUS.md. This file is all the kernel adds: * * - what the node prints goes to the kernel's console; @@ -27,6 +28,7 @@ static v4_node sk_v4_node; static v4_exec_state sk_v4_es; static v4_heat sk_v4_heat; +static v4_image sk_v4_image; static char sk_v4_text[SK_V4_LINE + 1u]; @@ -87,7 +89,8 @@ void sk_v4_run(void (*chain)(void)) v4_boot boot; console_println("StarForth v4: one host node, the F18-derived engine"); - boot.n = &sk_v4_node; boot.es = &sk_v4_es; boot.h = &sk_v4_heat; boot.im = &v4_capsule_image; + sk_v4_image = v4_map_image; + boot.n = &sk_v4_node; boot.es = &sk_v4_es; boot.h = &sk_v4_heat; boot.im = &sk_v4_image; boot.out = sk_v4_out; boot.key = sk_v4_key; boot.words = sk_v4_words; boot.word_count = sizeof sk_v4_words / sizeof sk_v4_words[0]; boot.serve = sk_v4_serve; blk_subsys_init(sk_v4_post_blk_ram, sizeof(sk_v4_post_blk_ram)); diff --git a/logs/20261015-141648/amd64/qemu-amd64-20261015-141648.log b/logs/20261015-141648/amd64/qemu-amd64-20261015-141648.log new file mode 100644 index 00000000..ee881b83 --- /dev/null +++ b/logs/20261015-141648/amd64/qemu-amd64-20261015-141648.log @@ -0,0 +1,153 @@ +[=3hBdsDxe: loading Boot0002 "UEFI QEMU DVD-ROM QM00005 " from PciRoot(0x0)/Pci(0x1F,0x2)/Sata(0x2,0xFFFF,0x0) +BdsDxe: starting Boot0002 "UEFI QEMU DVD-ROM QM00005 " from PciRoot(0x0)/Pci(0x1F,0x2)/Sata(0x2,0xFFFF,0x0) +[=3hStarKernel UEFI Loader +Loading kernel from ESP... +[CKPT 001] Entered efi_main - ConOut live +RAW SERIAL UP +[CKPT 002] Serial (COM1) initialized +Monolithic build - kernel linked directly +Collecting boot information... +CmdLine: parsed OK +[CKPT 004] Command line parsed +[CKPT 005] Kernel stack allocation decided +[CKPT 006] Boot info collected (ACPI table located) +GOP: linear framebuffer found +[CKPT 007] GOP: linear framebuffer found +[CKPT 008] About to enter ExitBootServices retry loop +EBS... +EBS OK +Calling kernel_main (monolithic)... + + + _____ _ _ __ _ + / ____| | | |/ / | | + | (___ | |_ __ _ _ __| ' / ___ _ __ _ __ ___| | + \___ \| __/ _` | '__| < / _ \ '__| '_ \ / _ \ | + ____) | || (_| | | | . \ __/ | | | | | __/ | + |_____/ \__\__,_|_| |_|\_\___|_| |_| |_|\___|_| + +LithosAnanke v2.1.0 amd64 +Architecture: amd64 +Build: Oct 15 2026 14:16:21 + +UEFI BootServices: EXITED +Console: serial line is a 16550 at port 0x00000000000003f8 (COM1, probed) + +=== StarKernel Boot Information === +Memory map entries: 131 +Total memory: 1023 MB +Usable memory: 966 MB +=================================== + +PMM initialized. +PMM statistics: + Total pages: 248682 + Free pages : 247159 + Used pages : 1523 + Total MB : 971 + Free MB : 965 + Used MB : 5 + +VMM initialized (mapped RAM, CR3 switched) +VMM initialized (mapped RAM, CR3 switched) +VMM self-test: mapped OK at 0xffff800000000000 +VMM self-test complete. + +IDT installed. + +APIC: init... +APIC: IA32_APIC_BASE MSR=0x00000000fee00900 +APIC: stale-ISR drain: 0 EOI(s) issued +APIC: initialized (xAPIC MMIO, TPR=0, SIVR=0x1FF, EOI-clear) +APIC: init done + +I/O APIC: init... +I/O APIC: base=0xfec00000, gsi_base=0, overrides=5 + override: source=00 gsi=2 flags=0x0000 + override: source=05 gsi=5 flags=0x000d + override: source=09 gsi=9 flags=0x000d + override: source=0a gsi=10 flags=0x000d + override: source=0b gsi=11 flags=0x000d +i8042: keyboard ACKed enable-scanning +i8042: IRQ1 enabled in controller config byte +I/O APIC: keyboard IRQ1 routed (masked) + +Timer: init... +Timer: init start +Timer: PM_TMR_BLK discovered from FADT at port 1544 +Timer: VM mode detected (hypervisor present). +Timer: HPET calibration disabled (VM-exit MMIO would poison timing). +Timer: WARNING: invariant TSC not present under hypervisor. +Timer: continuing in RELATIVE mode (no determinism guarantees). +Timer: RDTSCP not present; using RDTSC (less serialized). +Timer: CPUID frequency unavailable; trying PM Timer... +Timer: trust=1 (0=NONE,1=REL,2=ABS), TSC=2104923666 Hz +Timer: init done + +Kernel heap initialized. +Heap statistics: + Total bytes: 536870872 + Free bytes: 536870872 + Used bytes: 0 + Peak bytes: 0 + Heap base addr: 24641536 + Heap end addr: 561512448 + +Heartbeat: init... +APIC Timer: calibrating... +APIC Timer: apic_hz=1009697831, tick_hz=100, initial_count=10096978 +APIC Timer: configured (masked, ready to start) +Heartbeat: init done +Kernel initialization complete. +Boot successful! + +System: StarForth v4 (this build's default) +StarForth v4: one host node, the F18-derived engine +V4: capsule v4:sys:map-64.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:map-64.f18 capsule_hash=0xaa70e1dee90f9000 +V4: capsule v4:sys:core.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:core.f18 capsule_hash=0x5282537f9cc6d053 +V4: capsule v4:sys:input.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:input.f18 capsule_hash=0x85d3ec486d929a79 +V4: capsule v4:sys:dict.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:dict.f18 capsule_hash=0x1379bd3b5de811dc +V4: capsule v4:sys:codegen.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:codegen.f18 capsule_hash=0x36d2ae84d2911b90 +V4: capsule v4:sys:compile.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:compile.f18 capsule_hash=0x11145c4c2ab819d8 +V4: capsule v4:sys:quit.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:quit.f18 capsule_hash=0x0278d4bcbd206dba +V4: capsule v4:sys:forth.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:forth.f18 capsule_hash=0x16cab4a1268b85da +V4: capsule v4:sys:numout.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:numout.f18 capsule_hash=0x01297cd8e8018acd +V4: capsule v4:sys:words.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:words.f18 capsule_hash=0xb1d381f927d9f14e +V4: capsule v4:sys:system.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:system.f18 capsule_hash=0xd92203664c2915bd +V4: capsule v4:sys:qmath.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:qmath.f18 capsule_hash=0x7117595eb17ace99 +V4: capsule v4:sys:blocks.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:blocks.f18 capsule_hash=0x76307ef48678dc2a +V4: capsule v4:sys:log.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:log.f18 capsule_hash=0xfc6540e6b824a52b +V4: capsule v4:sys:acl.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:acl.f18 capsule_hash=0x6845aa048db7eb22 +V4: capsule v4:sys:end.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:end.f18 capsule_hash=0x5ef01312c07b79cc +PARITY:V4_ROM words=2049 rom_hash=0xa6c792b5821010b7 instructions=60725216 +V4: capsule v4:forth79.4th signature: missing (unsigned) +PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x4055641ee17d176b capsule_hash=0x4055641ee17d176b dict_hash=0x6b56e15226ee3719 +PARITY:V4_POST tests=538 pass=538 fail=0 +PARITY:V4_SYSTEM word_count=317 dict_hash=0xe5a57f3eb72ff94a +PARITY:OK +POST: PASSED +[HADES][INFO ] [KRELTSC: 0] blk: raw device LBN 2048..3071 (1024 blocks) +PCI: init... +PCI: ECAM mapped (amd64) +virtio-blk: found device +[HADES][INFO ] [KRELTSC: 77147238] blk: disk 'StarForth Volume' v2 LBN 3072..789009 (785938 user b +Artemis: virtio-blk attached +ok> 1 2 + . +3 ok +ok> \ No newline at end of file diff --git a/logs/20261015-141938/aarch64/qemu-aarch64-20261015-141938.log b/logs/20261015-141938/aarch64/qemu-aarch64-20261015-141938.log new file mode 100644 index 00000000..98fa57e9 --- /dev/null +++ b/logs/20261015-141938/aarch64/qemu-aarch64-20261015-141938.log @@ -0,0 +1,126 @@ +UEFI firmware (version 2025.11-3ubuntu7.3 built at 15:40:26 on Sep 23 2026) +[=3hBdsDxe: failed to load Boot0002 "UEFI Misc Device" from PciRoot(0x0)/Pci(0x2,0x0): Not Found +BdsDxe: failed to load Boot0003 "UEFI QEMU QEMU USB HARDDRIVE 1-0000:00:04.0-1" from PciRoot(0x0)/Pci(0x4,0x0)/USB(0x0,0x0): Not Found +BdsDxe: loading Boot0004 "UEFI Misc Device 2" from PciRoot(0x0)/Pci(0x6,0x0) +BdsDxe: starting Boot0004 "UEFI Misc Device 2" from PciRoot(0x0)/Pci(0x6,0x0) +[=3hStarKernel UEFI Loader +Loading kernel from ESP... +[CKPT 001] Entered efi_main - ConOut live +Collecting boot information... +[CKPT 004] Command line parsed +[CKPT 005] Kernel stack allocation decided +[CKPT 006] Boot info collected (ACPI table located) +[CKPT 007] GOP: linear framebuffer found +[CKPT 008] About to enter ExitBootServices retry loop + + + _____ _ _ __ _ + / ____| | | |/ / | | + | (___ | |_ __ _ _ __| ' / ___ _ __ _ __ ___| | + \___ \| __/ _` | '__| < / _ \ '__| '_ \ / _ \ | + ____) | || (_| | | | . \ __/ | | | | | __/ | + |_____/ \__\__,_|_| |_|\_\___|_| |_| |_|\___|_| + +LithosAnanke v2.1.0 aarch64 +Architecture: aarch64 +Build: Oct 15 2026 14:19:12 + +UEFI BootServices: EXITED +Console: serial line is a PL011 at 0x0000000009000000 (no devicetree: QEMU's) + +=== StarKernel Boot Information === +Memory map entries: 108 +Total memory: 4093 MB +Usable memory: 4054 MB +=================================== + +PMM initialized. +PMM statistics: + Total pages: 1039293 + Free pages : 1037882 + Used pages : 1411 + Total MB : 4059 + Free MB : 4054 + Used MB : 5 + +VMM initialized (mapped RAM, CR3 switched) +VMM initialized (mapped RAM, CR3 switched) +VMM self-test: mapped OK at 0xffff800000000000 +VMM self-test complete. + +AArch64: running at EL1 +IDT installed. + +APIC: init... +PSCI: no DTB -- using HVC (QEMU virt-machine default) +GICv2: no DTB GIC node -- using QEMU virt-machine defaults +GICv2: distributor+CPU interface enabled, PPI 30 +APIC: init done + +Timer: init... +Timer: AArch64 generic timer initialised. +Timer: init done + +Kernel heap initialized. +Heap statistics: + Total bytes: 2147483608 + Free bytes: 2147483608 + Used bytes: 0 + Peak bytes: 0 + Heap base addr: 1207959552 + Heap end addr: 3355443200 + +Heartbeat: init... +Heartbeat: init done +Kernel initialization complete. +Boot successful! + +System: StarForth v4 (this build's default) +StarForth v4: one host node, the F18-derived engine +V4: capsule v4:sys:map-64.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:map-64.f18 capsule_hash=0xaa70e1dee90f9000 +V4: capsule v4:sys:core.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:core.f18 capsule_hash=0x5282537f9cc6d053 +V4: capsule v4:sys:input.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:input.f18 capsule_hash=0x85d3ec486d929a79 +V4: capsule v4:sys:dict.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:dict.f18 capsule_hash=0x1379bd3b5de811dc +V4: capsule v4:sys:codegen.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:codegen.f18 capsule_hash=0x36d2ae84d2911b90 +V4: capsule v4:sys:compile.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:compile.f18 capsule_hash=0x11145c4c2ab819d8 +V4: capsule v4:sys:quit.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:quit.f18 capsule_hash=0x0278d4bcbd206dba +V4: capsule v4:sys:forth.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:forth.f18 capsule_hash=0x16cab4a1268b85da +V4: capsule v4:sys:numout.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:numout.f18 capsule_hash=0x01297cd8e8018acd +V4: capsule v4:sys:words.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:words.f18 capsule_hash=0xb1d381f927d9f14e +V4: capsule v4:sys:system.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:system.f18 capsule_hash=0xd92203664c2915bd +V4: capsule v4:sys:qmath.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:qmath.f18 capsule_hash=0x7117595eb17ace99 +V4: capsule v4:sys:blocks.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:blocks.f18 capsule_hash=0x76307ef48678dc2a +V4: capsule v4:sys:log.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:log.f18 capsule_hash=0xfc6540e6b824a52b +V4: capsule v4:sys:acl.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:acl.f18 capsule_hash=0x6845aa048db7eb22 +V4: capsule v4:sys:end.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:end.f18 capsule_hash=0x5ef01312c07b79cc +PARITY:V4_ROM words=2049 rom_hash=0xa6c792b5821010b7 instructions=60725216 +V4: capsule v4:forth79.4th signature: missing (unsigned) +PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x4055641ee17d176b capsule_hash=0x4055641ee17d176b dict_hash=0x6b56e15226ee3719 +PARITY:V4_POST tests=538 pass=538 fail=0 +PARITY:V4_SYSTEM word_count=317 dict_hash=0xe5a57f3eb72ff94a +PARITY:OK +POST: PASSED +[HADES][INFO ] [KRELTSC: 0] blk: raw device LBN 2048..3071 (1024 blocks) +PCI: init... +virtio-blk: found device +[HADES][INFO ] [KRELTSC: 1198604] blk: disk 'StarForth Volume' v2 LBN 3072..789009 (785938 user b +Artemis: virtio-blk attached +ok> 1 2 + . +3 ok +ok> \ No newline at end of file diff --git a/logs/20261015-142350/riscv64/qemu-riscv64-20261015-142350.log b/logs/20261015-142350/riscv64/qemu-riscv64-20261015-142350.log new file mode 100644 index 00000000..0cef6d02 --- /dev/null +++ b/logs/20261015-142350/riscv64/qemu-riscv64-20261015-142350.log @@ -0,0 +1,196 @@ + +OpenSBI v1.8 + ____ _____ ____ _____ + / __ \ / ____| _ \_ _| + | | | |_ __ ___ _ __ | (___ | |_) || | + | | | | '_ \ / _ \ '_ \ \___ \| _ < | | + | |__| | |_) | __/ | | |____) | |_) || |_ + \____/| .__/ \___|_| |_|_____/|____/_____| + | | + |_| + +Platform Name : riscv-virtio,qemu +Platform Features : medeleg +Platform HART Count : 1 +Platform HART Protection : pmp +Platform IPI Device : aclint-mswi +Platform Timer Device : aclint-mtimer @ 10000000Hz +Platform Console Device : uart8250 +Platform HSM Device : --- +Platform PMU Device : --- +Platform Reboot Device : syscon-reboot +Platform Shutdown Device : syscon-poweroff +Platform Suspend Device : --- +Platform CPPC Device : --- +Firmware Base : 0x80000000 +Firmware Size : 321 KB +Firmware RW Offset : 0x40000 +Firmware RW Size : 65 KB +Firmware Heap Offset : 0x47000 +Firmware Heap Size : 37 KB (total), 0 KB (reserved), 12 KB (used), 23 KB (free) +Firmware Scratch Size : 4096 B (total), 1464 B (used), 2632 B (free) +Runtime SBI Version : 3.0 +Standard SBI Extensions : ipi,pmu,srst,sse,hsm,rfnc,fwft,time,base,legacy,dbcn,dbtr +Experimental SBI Extensions : none + +Domain0 Name : root +Domain0 Boot HART : 0 +Domain0 HARTs : 0* +Domain0 Region00 : 0x0000000080040000-0x000000008005ffff M: (F,R,W) S/U: () +Domain0 Region01 : 0x0000000080000000-0x000000008003ffff M: (F,R,X) S/U: () +Domain0 Region02 : 0x0000000000100000-0x0000000000100fff M: (I,R,W) S/U: (R,W) +Domain0 Region03 : 0x0000000010000000-0x0000000010000fff M: (I,R,W) S/U: (R,W) +Domain0 Region04 : 0x0000000002000000-0x000000000200ffff M: (I,R,W) S/U: () +Domain0 Region05 : 0x000000000c400000-0x000000000c5fffff M: (I,R,W) S/U: (R,W) +Domain0 Region06 : 0x000000000c000000-0x000000000c3fffff M: (I,R,W) S/U: (R,W) +Domain0 Region07 : 0x0000000000000000-0xffffffffffffffff M: () S/U: (R,W,X) +Domain0 Next Address : 0x0000000020000000 +Domain0 Next Arg1 : 0x00000000bfe00000 +Domain0 Next Mode : S-mode +Domain0 SysReset : yes +Domain0 SysSuspend : yes + +Boot HART ID : 0 +Boot HART Domain : root +Boot HART Priv Version : v1.12 +Boot HART Base ISA : rv64imafdch +Boot HART ISA Extensions : sstc,zicntr,zihpm,zicboz,zicbom,sdtrig,svadu +Boot HART PMP Count : 16 +Boot HART PMP Granularity : 2 bits +Boot HART PMP Address Bits : 54 +Boot HART MHPM Info : 16 (0x0007fff8) +Boot HART Debug Triggers : 2 triggers +Boot HART MIDELEG : 0x0000000000001666 +Boot HART MEDELEG : 0x0000000000f4b509 +[=3hRISC-V EDK2 firmware version 2025.11-3ubuntu7.3 +Press ESCAPE within 5 seconds for boot options ERROR: C40000002:V03051002 I0 6D33944A-EC75-4855-A54D-809C75241F6C 83FFF850 +BdsDxe: failed to load Boot0001 "UEFI Misc Device" fr +om PciRoot(0x0)/Pci(0x1,0x0): Not Found +[=3hStarKernel UEFI Loader +Loading kernel from ESP... +[CKPT 001] Entered efi_main - ConOut live +Monolithic build - kernel linked directly +Collecting boot information... +CmdLine: parsed OK +[CKPT 004] Command line parsed +[CKPT 005] Kernel stack allocation decided +[CKPT 006] Boot info collected (ACPI table located) +GOP: linear framebuffer found +[CKPT 007] GOP: linear framebuffer found +[CKPT 008] About to enter ExitBootServices retry loop +Calling kernel_main (monolithic)... +riscv64 item 4.3.5a: satp state at kernel entry (before switch) + satp.MODE = 0x000000000000000a + satp.PPN = 0x00000000000bf868 + __kernel_start = 0x00000000bdc340aa +riscv64: satp cleared -- Bare mode, explicit (item 4.3.5a) + + + _____ _ _ __ _ + / ____| | | |/ / | | + | (___ | |_ __ _ _ __| ' / ___ _ __ _ __ ___| | + \___ \| __/ _` | '__| < / _ \ '__| '_ \ / _ \ | + ____) | || (_| | | | . \ __/ | | | | | __/ | + |_____/ \__\__,_|_| |_|\_\___|_| |_| |_|\___|_| + +LithosAnanke v2.1.0 riscv64 +Architecture: riscv64 +Build: Oct 15 2026 14:23:10 + +UEFI BootServices: EXITED +Console: serial line is a 16550 at 0x0000000010000000 (no devicetree: QEMU's) + +=== StarKernel Boot Information === +Memory map entries: 100 +Total memory: 1020 MB +Usable memory: 974 MB +=================================== + +PMM initialized. +PMM statistics: + Total pages: 250212 + Free pages : 249560 + Used pages : 652 + Total MB : 977 + Free MB : 974 + Used MB : 2 + +VMM initialized (mapped RAM, CR3 switched) +VMM initialized (mapped RAM, CR3 switched) +VMM self-test: mapped OK at 0xffff800000000000 +VMM self-test complete. + +IDT installed. + +APIC: init... +PLIC: no DTB PLIC node -- using QEMU virt-machine default (base=0x0c000000) +PLIC: init (S-mode context 1, threshold=0) +APIC: init done + +Timer: init... +Timer: RISC-V time CSR @ 10000000 Hz (FALLBACK, no devicetree) +Timer: init done + +Kernel heap initialized. +Heap statistics: + Total bytes: 536870872 + Free bytes: 536870872 + Used bytes: 0 + Peak bytes: 0 + Heap base addr: 2214588416 + Heap end addr: 2751459328 + +Heartbeat: init... +Heartbeat: init done +Kernel initialization complete. +Boot successful! + +System: StarForth v4 (this build's default) +StarForth v4: one host node, the F18-derived engine +V4: capsule v4:sys:map-64.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:map-64.f18 capsule_hash=0xaa70e1dee90f9000 +V4: capsule v4:sys:core.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:core.f18 capsule_hash=0x5282537f9cc6d053 +V4: capsule v4:sys:input.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:input.f18 capsule_hash=0x85d3ec486d929a79 +V4: capsule v4:sys:dict.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:dict.f18 capsule_hash=0x1379bd3b5de811dc +V4: capsule v4:sys:codegen.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:codegen.f18 capsule_hash=0x36d2ae84d2911b90 +V4: capsule v4:sys:compile.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:compile.f18 capsule_hash=0x11145c4c2ab819d8 +V4: capsule v4:sys:quit.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:quit.f18 capsule_hash=0x0278d4bcbd206dba +V4: capsule v4:sys:forth.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:forth.f18 capsule_hash=0x16cab4a1268b85da +V4: capsule v4:sys:numout.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:numout.f18 capsule_hash=0x01297cd8e8018acd +V4: capsule v4:sys:words.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:words.f18 capsule_hash=0xb1d381f927d9f14e +V4: capsule v4:sys:system.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:system.f18 capsule_hash=0xd92203664c2915bd +V4: capsule v4:sys:qmath.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:qmath.f18 capsule_hash=0x7117595eb17ace99 +V4: capsule v4:sys:blocks.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:blocks.f18 capsule_hash=0x76307ef48678dc2a +V4: capsule v4:sys:log.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:log.f18 capsule_hash=0xfc6540e6b824a52b +V4: capsule v4:sys:acl.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:acl.f18 capsule_hash=0x6845aa048db7eb22 +V4: capsule v4:sys:end.f18 signature: missing (unsigned) +PARITY:V4_F18 name=v4:sys:end.f18 capsule_hash=0x5ef01312c07b79cc +PARITY:V4_ROM words=2049 rom_hash=0xa6c792b5821010b7 instructions=60725216 +V4: capsule v4:forth79.4th signature: missing (unsigned) +PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x4055641ee17d176b capsule_hash=0x4055641ee17d176b dict_hash=0x6b56e15226ee3719 +PARITY:V4_POST tests=538 pass=538 fail=0 +PARITY:V4_SYSTEM word_count=317 dict_hash=0xe5a57f3eb72ff94a +PARITY:OK +POST: PASSED +[HADES][INFO ] [KRELTSC: 0] blk: raw device LBN 2048..3071 (1024 blocks) +PCI: init... +virtio-blk: found device +[HADES][INFO ] [KRELTSC: 20295513] blk: disk 'StarForth Volume' v2 LBN 3072..789009 (785938 user b +Artemis: virtio-blk attached +ok> 1 2 + . +3 ok +ok> \ No newline at end of file diff --git a/v4/Makefile b/v4/Makefile index 81bcdaae..78b18ec2 100644 --- a/v4/Makefile +++ b/v4/Makefile @@ -82,25 +82,16 @@ blocks_src = $(if $(call uses_blocks,$(1)),$(BLOCKS_SRC) $(HERE)/system/pos blocks_objs = $(if $(call uses_blocks,$(1)),$(BINDIR)/v3blocks.o) san_blocks_objs = $(if $(call uses_blocks,$(1)),$(BINDIR)/san-v3blocks.o) -# The capsule sources: definitions as text (include/v4/text.h), which tests -# assemble onto a node. The directory is passed to the tests so that they -# find the files whatever directory make was run from. -CAPSULES := $(wildcard $(HERE)/capsule/*.v4) -capsule_dir := -DV4_CAPSULE_DIR='"$(HERE)/capsule"' - -# THE NUCLEUS IMAGE. tools/mkimage.c, built for the host node (HOST_WORDS -# and the host stack sizes) at one cell width, assembles the nucleus -- -# capsule/*.v4 -- and writes it as a C file, $(BINDIR)/v4_image_.c. -# The hosted system below and the bare-metal kernel (kernel/Makefile, -# STARFORTH_V4=1) link the 64-bit one. docs/v4.0.0/NUCLEUS.md. -# The nucleus as a capsule of F18 code (include/v4/capsule.h). The 64-bit one -# is a product's: it goes into the capsule directory, ../capsules/v4, where -# the repository's mkcapsule finds it, hashes it and signs it with every -# other capsule. It is a built file kept in the tree, as -# ../capsules/BLOCK_MAP.md is, and is to be committed when it changes. +# The system's source, capsules/v4/sys (MACHINE.md 3): F18 assembler as text +# (include/v4/text.h), which the ROM assembles when the machine starts and +# tests assemble onto a node with text.c. capsule/ holds the FORTH source +# tests compile (*.fth). Both directories are passed to the tests so that +# they find the files whatever directory make was run from. ROOT := $(abspath $(HERE)/..) -NUCLEUS_64 := $(ROOT)/capsules/v4/nucleus-64.f18 -NUCLEUS_32 := $(BINDIR)/nucleus-32.f18 +SYS_DIR := $(ROOT)/capsules/v4/sys +CAPSULES := $(wildcard $(SYS_DIR)/*.f18) $(wildcard $(HERE)/capsule/*.fth) +capsule_dir := -DV4_CAPSULE_DIR='"$(HERE)/capsule"' -DV4_SYS_DIR='"$(SYS_DIR)"' + HOST_DEFS := -DV4_NODE_WORDS=$(HOST_WORDS) -DV4_DATA_RING=$(HOST_DATA_RING) -DV4_RET_RING=$(HOST_RET_RING) -DV4_ROM_WORDS=$(HOST_ROM_WORDS) ENGINE_SRCS := $(addprefix $(HERE)/src/,node.c exec.c stack.c iword.c heat.c guard.c image.c fabric.c capsule.c message.c wire.c) @@ -108,17 +99,18 @@ ENGINE_SRCS := $(addprefix $(HERE)/src/,node.c exec.c stack.c iword.c heat.c gua # code in capsules/v4/rom, assembled off the node by tools/mkrom.c, as a # bitstream is built. tools/mkmap.c writes the memory map's constants it is # assembled with, from tests/host_map.h. main.f18 comes first: the ROM's -# entry table is at its base. Tests named test_host_rom_*.c link the ROM of +# entry table is at its base. Tests named test_host_rom_*.c, and +# test_host_unit.c, whose host builds the system with it, link the ROM of # their width and read its symbols. ROM_DIR := $(ROOT)/capsules/v4/rom ROM_FILES := $(wildcard $(addprefix $(ROM_DIR)/,main.f18 in.f18 num.f18 sym.f18 pack.f18 word.f18 dir.f18)) MKROM_WORDS := $(shell expr $(HOST_WORDS) + $(HOST_ROM_WORDS)) -rom_src = $(if $(findstring /test_host_rom_,$(1)),$(BINDIR)/rom-$(2).c) -rom_sym = $(if $(findstring /test_host_rom_,$(1)),-DV4_ROM_SYM='"$(BINDIR)/rom-$(2).sym"' -DV4_SYS_DIR='"$(SYS_DIR)"') +uses_rom = $(or $(findstring /test_host_rom_,$(1)),$(findstring /test_host_unit,$(1))) +rom_src = $(if $(call uses_rom,$(1)),$(BINDIR)/rom-$(2).c) +rom_sym = $(if $(call uses_rom,$(1)),-DV4_ROM_SYM='"$(BINDIR)/rom-$(2).sym"') # THE SYSTEM'S SOURCE as the ROM reads it (MACHINE.md 3): capsules/v4/sys. Its # map, map-.f18, is written by tools/mkmap.c from tests/host_map.h # (`make sysmap`) and kept in the tree, as capsules/BLOCK_MAP.md is. -SYS_DIR := $(ROOT)/capsules/v4/sys define ROM_RULE $(BINDIR)/mkmap-$(1): $(HERE)/tools/mkmap.c $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/tests/host_map.h $(HERE)/Makefile @@ -131,6 +123,9 @@ $(BINDIR)/rom-map-$(1).f18: $(BINDIR)/mkmap-$(1) $(SYS_DIR)/map-$(1).f18: $(BINDIR)/mkmap-$(1) $(BINDIR)/mkmap-$(1) sys > $$@ +$(BINDIR)/v4_map_$(1).c: $(BINDIR)/mkmap-$(1) + $(BINDIR)/mkmap-$(1) image > $$@ + $(BINDIR)/mkrom-$(1): $(HERE)/tools/mkrom.c $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile @mkdir -p $(BINDIR) $$(CC) $$(CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=$(1) -DV4_NODE_WORDS=$(MKROM_WORDS) -DV4_DATA_RING=$(HOST_DATA_RING) -DV4_RET_RING=$(HOST_RET_RING) \ @@ -147,23 +142,17 @@ rom: $(foreach w,$(WIDTHS),$(BINDIR)/rom-$(w).c) .PHONY: sysmap sysmap: $(foreach w,$(WIDTHS),$(SYS_DIR)/map-$(w).f18) -define IMAGE_RULE -$(BINDIR)/mkimage-$(1): $(HERE)/tools/mkimage.c $$(SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/tests/host_map.h $(HERE)/Makefile - @mkdir -p $(BINDIR) - $$(CC) $$(CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=$(1) $(HOST_DEFS) $(capsule_dir) $(HERE)/tools/mkimage.c $$(SRCS) -o $$@ - -$(BINDIR)/v4_image_$(1).c: $(BINDIR)/mkimage-$(1) $$(CAPSULES) - $(BINDIR)/mkimage-$(1) $$@ $$(NUCLEUS_$(1)) -endef -$(foreach w,$(WIDTHS),$(eval $(call IMAGE_RULE,$(w)))) - +# The machine as a host links it (the hosted system below, the bare-metal +# kernel): the ROM, and the map's description of the system (include/v4/ +# image.h, v4_map_image). .PHONY: image -image: $(foreach w,$(WIDTHS),$(BINDIR)/v4_image_$(w).c) +image: $(foreach w,$(WIDTHS),$(BINDIR)/rom-$(w).c $(BINDIR)/v4_map_$(w).c) # THE HOSTED SYSTEM: StarForth v4 as a Linux program, a product, for amd64, # aarch64 and riscv64 -- $(BINDIR)/starforth4-. It is the engine, the -# 64-bit nucleus image, the capsule directory and the boot (system/boot.c) -# that loads the capsules from it: the same four the kernel links. The +# 64-bit ROM and map, the capsule directory and the boot (system/boot.c) +# that has the ROM assemble the system's source from it and loads the +# capsules: the same the kernel links. The # directory is made by the repository's own tools/mkcapsule.c from # ../capsules, signed if the key is on this machine (kernel/Makefile, # SIGN_KEY), and the code that reads it is the kernel's, compiled here as it @@ -183,6 +172,7 @@ CRYPTO_SRCS := $(addprefix $(ROOT)/kernel/src/crypto/,ed25519.c fe25519.c scal MKCAPSULE_SRCS := $(ROOT)/tools/mkcapsule.c $(ROOT)/tools/pkcs8_ed25519.c $(CRYPTO_SRCS) CAPSULE_FILES := $(shell find $(ROOT)/capsules -type f ! -name '.*' 2>/dev/null) CAPSULE_DIR_C := $(BINDIR)/capsule_generated.c +MACHINE_64 := $(BINDIR)/rom-64.c $(BINDIR)/v4_map_64.c # the kernel's capsule code: find, check the hash, verify the signature, # split a payload into blocks @@ -197,15 +187,15 @@ $(BINDIR)/mkcapsule: $(MKCAPSULE_SRCS) @mkdir -p $(BINDIR) cc -std=c99 -Wall -Wextra -O2 -I$(ROOT)/v3/include -I$(ROOT)/kernel/include -I$(ROOT)/tools -o $@ $(MKCAPSULE_SRCS) -$(CAPSULE_DIR_C): $(BINDIR)/mkcapsule $(CAPSULE_FILES) $(BINDIR)/v4_image_64.c +$(CAPSULE_DIR_C): $(BINDIR)/mkcapsule $(CAPSULE_FILES) $(BINDIR)/mkcapsule $(SIGN_KEY_ARGS) $(ROOT)/capsules $@ define HOSTED_RULE -$(BINDIR)/starforth4-$(1): $(HERE)/tools/hosted.c $(BINDIR)/v4_image_64.c $(CAPSULE_DIR_C) $$(ENGINE_SRCS) $$(SYSTEM_SRCS) $(BLOCKS_SRC) $(V3_BLOCK_SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile +$(BINDIR)/starforth4-$(1): $(HERE)/tools/hosted.c $(MACHINE_64) $(CAPSULE_DIR_C) $$(ENGINE_SRCS) $$(SYSTEM_SRCS) $(BLOCKS_SRC) $(V3_BLOCK_SRCS) $$(wildcard $(HERE)/include/v4/*.h) $(HERE)/Makefile $$(CC_$(1)) $$(CFLAGS) -D_POSIX_C_SOURCE=200809L -I$(HERE)/include $(V3_INC) -DV4_CELL_BITS=64 $(HOST_DEFS) -c $(HERE)/tools/hosted.c -o $(BINDIR)/hosted-$(1).o @rm -rf $(BINDIR)/v3o-$(1) && mkdir -p $(BINDIR)/v3o-$(1) cd $(BINDIR)/v3o-$(1) && $$(CC_$(1)) $(V3_CFLAGS) -I$(HERE)/include -DV4_CELL_BITS=64 $(HOST_DEFS) -c $(V3_BLOCK_SRCS) $(BLOCKS_SRC) - $$(CC_$(1)) $$(SYSTEM_CFLAGS) -static $(BINDIR)/hosted-$(1).o $(BINDIR)/v4_image_64.c $(CAPSULE_DIR_C) $$(ENGINE_SRCS) $$(SYSTEM_SRCS) $(BINDIR)/v3o-$(1)/*.o -o $$@ + $$(CC_$(1)) $$(SYSTEM_CFLAGS) -static $(BINDIR)/hosted-$(1).o $(MACHINE_64) $(CAPSULE_DIR_C) $$(ENGINE_SRCS) $$(SYSTEM_SRCS) $(BINDIR)/v3o-$(1)/*.o -o $$@ $(BINDIR)/boot-$(1).txt: $(BINDIR)/starforth4-$(1) @echo " [hosted $(1)]" @@ -272,7 +262,7 @@ hosted-check: $(foreach i,$(HOSTED_ISAS),$(BINDIR)/boot-$(i).txt) $(BINDIR)/star # in the place of system/post_cases.c): hosted-check boots it and requires # that the boot stops there. docs/v4.0.0/MESH.md step 6b, acceptance 4. $(BINDIR)/starforth4-postfail: $(BINDIR)/starforth4-amd64 $(HERE)/tests/post_cases_fail.c - $(CC) $(SYSTEM_CFLAGS) -static $(BINDIR)/hosted-amd64.o $(BINDIR)/v4_image_64.c $(CAPSULE_DIR_C) $(ENGINE_SRCS) $(filter-out %/post_cases.c,$(SYSTEM_SRCS)) $(HERE)/tests/post_cases_fail.c $(BINDIR)/v3o-amd64/*.o -o $@ + $(CC) $(SYSTEM_CFLAGS) -static $(BINDIR)/hosted-amd64.o $(MACHINE_64) $(CAPSULE_DIR_C) $(ENGINE_SRCS) $(filter-out %/post_cases.c,$(SYSTEM_SRCS)) $(HERE)/tests/post_cases_fail.c $(BINDIR)/v3o-amd64/*.o -o $@ .PHONY: all test sanitize clean $(addprefix test-,$(WIDTHS)) diff --git a/v4/README.md b/v4/README.md index 9560decc..d131caf1 100644 --- a/v4/README.md +++ b/v4/README.md @@ -22,18 +22,23 @@ uses (`v4/include/v4/text.h`). `make -C v4 test` builds and runs the tests at both cell widths; `make -C v4 sanitize` repeats them under ASan and UBSan. There is no POST and no K measurement yet. -## The system: nucleus, capsules, prompt +## The system: ROM, source, capsules, prompt -`docs/v4.0.0/NUCLEUS.md` is the design. A v4 system is four things: +`docs/v4.0.0/MACHINE.md` and `docs/v4.0.0/NUCLEUS.md` are the design. A v4 +system is five things: | Part | Where | What it is | |---|---|---| | Engine | `v4/src` | The golden model of the 32-opcode node | -| Nucleus | `v4/capsule/*.v4`, built by `v4/tools/mkimage.c` into `capsules/v4/nucleus-64.f18` | The assembled words, as a capsule of F18 code: sent through its port to a node born empty | +| ROM | `capsules/v4/rom/*.f18`, assembled by `v4/tools/mkrom.c` | The machine's one binary: F18 code that assembles F18 source when the machine starts | +| System's source | `capsules/v4/sys/*.f18` | The system as F18 assembler text: the memory map, the fourteen, and `end.f18` (the switch-on state and `start`). No prebuilt nucleus: the ROM assembles it at every boot | | Capsules | `capsules/v4/*.4th`, baked by `tools/mkcapsule.c` | FORTH source, loaded when the system comes up | -| Boot | `v4/system/boot.c` | Starts the nucleus, checks and loads each capsule, prints the parity lines, gives the prompt | +| Boot | `v4/system/boot.c` | Feeds the system's source to the ROM, checks and loads each capsule, prints the parity lines, gives the prompt | -Two products link the same four and differ only in the console: +A node that is born is sent the system as assembled code, never source +(Captain Bob, 2026-10-15): the host's machine assembles it once. + +Two products link the same five and differ only in the console: - **Hosted Linux**, `v4/tools/hosted.c`: `make -C v4 hosted` builds `v4/build/starforth4-amd64`, `-aarch64` and `-riscv64`, static, 64-bit cells. @@ -42,7 +47,8 @@ Two products link the same four and differ only in the console: A boot prints: ``` -PARITY:V4_NUCLEUS words=292 image_hash=0x... +PARITY:V4_F18 name=v4:sys:map-64.f18 capsule_hash=0x... (one line for each blob of the system's source) +PARITY:V4_ROM words=2049 rom_hash=0x... instructions=60719827 PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x... capsule_hash=0x... dict_hash=0x... PARITY:OK ok> diff --git a/v4/capsule/acl.v4 b/v4/capsule/acl.v4 deleted file mode 100644 index 1f685001..00000000 --- a/v4/capsule/acl.v4 +++ /dev/null @@ -1,83 +0,0 @@ -\ acl.v4 -- word-level access control: the fields of an entry. -\ -\ DECOMPOSITION.md 5.20, as v3: ACL-MODE@ ACL-MODE! ACL-TTL@ ACL-TTL! ACL-ALLOW@ -\ ACL-ALLOW! ACL-PINNED? ACL-PIN ACL-INHERIT ACL-INIT-PRIMITIVES ACL-HEAT@ -\ ACL-WORD-ID. These are all the capsule does itself; the policy -- what is -\ strict, how long a TTL is, what is pinned -- is FORTH source, ACL.fth, as -\ it is ACL.4th in v3. The fields and the check are described in -\ compile.v4. Rests on compile.v4, quit.v4 and system.v4. -\ -\ An xt of 0 is an error (code 16, "Not a word"). A pinned word's fields are -\ not changed by the ! words: they do nothing, as in v3. -\ -\ Constants the loader supplies: -\ (ACL-HOOK) word address of the variable: the xt of the recheck word, or 0 - -\ ( xt -- xt ) refuse 0 -: (ACL-XT) if NULL ; NULL: drop NODE-ERROR b! 16 !b 0 ; -\ ( xt -- flag ) non-zero if it is pinned. A holds the flags' address. -: (PINNED) -3 + a! @ 64 and ; - -header ACL-HOOK inline : ACL-HOOK' (ACL-HOOK) ; - -header ACL-MODE@ -: ACL-MODE@ ( xt -- mode ) (ACL-XT) -3 + a! @ 8/ 255 and ; -header ACL-TTL@ -: ACL-TTL@ ( xt -- n ) (ACL-XT) -3 + a! @ 8/ 8/ 65535 and ; -header ACL-ALLOW@ -: ACL-ALLOW@ ( xt -- flag ) (ACL-XT) -3 + a! @ 32 and if YES drop 0 ; YES: drop -1 ; -header ACL-PINNED? -: ACL-PINNED? ( xt -- flag ) (ACL-XT) (PINNED) if NO drop -1 ; NO: ; -header ACL-PIN -: ACL-PIN ( xt -- ) (ACL-XT) -3 + a! @ 64 OR ! ; - -header ACL-MODE! -: ACL-MODE! ( mode xt -- ) - (ACL-XT) (PINNED) if FREE drop drop ; - FREE: drop 255 and 8* @ -65281 and + ! ; -\ as v3: below 0 is 0. The TTL is sixteen bits here: above 65535 is 65535. -header ACL-TTL! -: ACL-TTL! ( n xt -- ) - (ACL-XT) (PINNED) if FREE drop drop ; - FREE: drop - -if POS drop 0 jump SET - POS: dup -65536 and if SMALL drop drop 65535 jump SET - SMALL: drop - SET: 8* 8* @ 65535 and + ! ; -header ACL-ALLOW! -: ACL-ALLOW! ( flag xt -- ) - (ACL-XT) (PINNED) if FREE drop drop ; - FREE: drop if DENY drop @ -33 and ! ; - DENY: drop @ 32 OR ! ; - -\ ( src dst -- ) as v3: dst takes src's mode; it is not pinned, its TTL -\ is 0 and it is allowed. This is the one word that unpins. -header ACL-INHERIT -: ACL-INHERIT - (ACL-XT) SWAP (ACL-XT) \ dst src - -3 + a! @ $FF00 and \ dst mode - SWAP -3 + a! @ 255 and -97 and + ! ; \ the five flags, nothing else - -\ ( xt -- ) every entry from xt back that is not pinned: TTL mode, TTL 0, -\ allowed -: (ACL-INIT) - L: if DONE - dup (PINNED) if FREE drop jump NXT - FREE: drop @ 31 and ! - NXT: -1 + a! @ jump L - DONE: drop ; -\ ( -- ) as v3: do that to every word in the dictionary, in every vocabulary -header ACL-INIT-PRIMITIVES -: ACL-INIT-PRIMITIVES - (LATEST) a! @ (ACL-INIT) - VOC-LINK a! @ - V: if DONE dup a! @ (ACL-INIT) 1 + a! @ jump V - DONE: drop ; - -\ ( xt -- heat ) how often the word has been used. The node's heat -\ counters are not readable from a programme yet (D-6): 0. -header ACL-HEAT@ -: ACL-HEAT@ (ACL-XT) drop 0 ; -\ ( xt -- n ) a number for the word that never changes: its address -header ACL-WORD-ID -: ACL-WORD-ID (ACL-XT) ; diff --git a/v4/capsule/blocks.v4 b/v4/capsule/blocks.v4 deleted file mode 100644 index ef99b8ef..00000000 --- a/v4/capsule/blocks.v4 +++ /dev/null @@ -1,127 +0,0 @@ -\ blocks.v4 -- mass storage: blocks of 1024 characters, and text loaded from them. -\ -\ DECOMPOSITION.md 5.11, FORTH-79: BLOCK BUFFER UPDATE SAVE-BUFFERS -\ EMPTY-BUFFERS LIST LOAD SCR BLK, and v3's FLUSH THRU and --> . Part of the -\ compiler capsule; rests on everything before it. -\ -\ STORAGE IS THE KERNEL'S (docs/v4.0.0/MESH.md section 8, ENGINE.md 3.3), as -\ it is for a v3 VM. A node only ever asks for a block by number, and it -\ asks its kernel: it writes a request to port 0, where its kernel is, and -\ when the write has been served the answer is on the data stack. The -\ node has a window in its memory, four slots of 256 cells; the kernel -\ keeps the record of which block is in which slot, does the copying, and -\ decides when a block is written. The requests (v4/include/v4/blocks.h): -\ BLOCK# ( n -- waddr status ) the slot holding block n -\ BUFFER# ( n -- waddr status ) a slot for block n, not read -\ UPDATE# ( -- status ) the block last asked for is changed -\ SAVE-BUFFERS# ( -- status ) every changed block is written -\ EMPTY-BUFFERS# ( -- ) every slot is let go -\ The status is 0, or 2 storage refused (error 17), or 3 there is no such -\ block (error 13). BLOCK and BUFFER give a byte address, as PAD and TIB -\ are: what C@ CMOVE and TYPE take. -\ -\ Constants the loader supplies: -\ BLOCK# BUFFER# UPDATE# SAVE-BUFFERS# EMPTY-BUFFERS# the requests' numbers -\ SCR word address of the variable: the block LIST showed last -\ BLK (SRC) (SRC-HOOK) see input.v4 - -header SCR inline : SCR' SCR ; -header BLK inline : BLK' BLK ; - -\ ( status -- ) a request that did not work is an error -: (B-ERR) - if FINE -2 + if E17 drop NODE-ERROR b! 13 !b ; - E17: drop NODE-ERROR b! 17 !b ; - FINE: drop ; - -\ ( waddr status -- baddr ) the slot's byte address, or the error -: (B-GOT) - if OK SWAP drop jump (B-ERR) - OK: drop 2* 2* ; - -\ ( n -- baddr ) FORTH-79: the address of a buffer assigned to block n. -\ What the buffer holds is not read from storage. -header BUFFER -: BUFFER BUFFER# (PORT) b! !b jump (B-GOT) - -\ ( n -- baddr ) FORTH-79: the address of a buffer that holds block n, -\ read from storage if it is not already in one. -header BLOCK -: BLOCK BLOCK# (PORT) b! !b jump (B-GOT) - -\ FORTH-79: mark the block most recently asked for as changed, so that it is -\ written before its buffer is used for another. -header UPDATE -: UPDATE UPDATE# (PORT) b! !b jump (B-ERR) - -\ FORTH-79: write every block that has been UPDATEd. -header SAVE-BUFFERS -: SAVE-BUFFERS SAVE-BUFFERS# (PORT) b! !b jump (B-ERR) -\ As v3: the same. -header FLUSH -: FLUSH jump SAVE-BUFFERS -\ FORTH-79: forget what is in the buffers; nothing is written. -header EMPTY-BUFFERS -: EMPTY-BUFFERS EMPTY-BUFFERS# (PORT) b! !b ; - -\ ---- LIST ---------------------------------------------------------------------- -\ ( n -- ) as v3: a new line, "Block n", then sixteen lines of 64 -\ characters, each after its number, and an empty line. SCR is left holding n. A character -\ that is not printable is shown as a blank. (Q)+0 is the line, (Q)+1 the -\ column, (Q)+2 the block's number. -header LIST -: LIST - dup (Q)+2 a! ! BLOCK drop \ an error here leaves nothing behind - (Q)+2 a! @ dup SCR a! ! - CR $636F6C42 (EMIT4) $206B (EMIT4) 0 DOT-R CR \ "Block " - 0 (Q) a! ! - LN: (Q) a! @ 0 <# # # #> TYPE 58 EMIT SPACE - 0 (Q)+1 a! ! - CH: SCR a! @ BLOCK (Q) a! @ 2* 2* 2* 2* 2* 2* + (Q)+1 a! @ + C@ - dup -32 + -if GE drop drop 32 jump EM - GE: drop dup -127 + -if BIG drop jump EM - BIG: drop drop 32 - EM: EMIT - (Q)+1 a! @ 1 + dup ! -64 + if EOL drop jump CH - EOL: drop CR - (Q) a! @ 1 + dup ! -16 + if DONE drop jump LN - DONE: drop jump CR - -\ ---- LOAD ---------------------------------------------------------------------- -\ The text being interpreted is at (SRC), SPAN characters of it, >IN the -\ place in it. LOAD saves those and BLK on the return stack, points them at -\ the block, interprets it, and puts them back; so a block may LOAD another, -\ and the rest of the line LOAD was on is interpreted afterwards. (v3's -\ LOAD loses the rest of its line.) - -\ ( -- ) what WORD calls before it reads: while a block is being loaded, -\ make sure it is in a buffer and (SRC) is that buffer. -: (BLK-SRC) - BLK a! @ if TERM BLOCK (SRC) a! ! ; - TERM: drop ; - -\ ( n -- ) FORTH-79: interpret block n, then go on with what follows. -header LOAD -: LOAD - -if POS jump BAD - POS: if BAD - BLK a! @ push >IN a! @ push SPAN a! @ push (SRC) a! @ push - BLK a! ! 0 >IN a! ! 1024 SPAN a! ! - &(BLK-SRC) (SRC-HOOK) a! ! - INTERPRET - pop (SRC) a! ! pop SPAN a! ! pop >IN a! ! pop BLK a! ! ; - BAD: drop NODE-ERROR b! 13 !b ; - -\ ( -- ) go on with the next block. Only in a block being loaded: at the -\ terminal it is an error (code 14). -header --> immediate -: NEXT-BLOCK - BLK a! @ if TERM 1 + ! 0 >IN a! ! ; - TERM: drop NODE-ERROR b! 14 !b ; - -\ ( first last -- ) as v3: LOAD each block from first to last. -header THRU -: THRU - push - L: dup inv pop dup push + 1 + -if GO drop drop pop drop ; \ last - first - GO: drop dup push LOAD pop 1 + jump L diff --git a/v4/capsule/codegen.v4 b/v4/capsule/codegen.v4 deleted file mode 100644 index de601a0c..00000000 --- a/v4/capsule/codegen.v4 +++ /dev/null @@ -1,119 +0,0 @@ -\ codegen.v4 -- the code generator: opcodes, literals and branches packed into -\ instruction words at HERE. -\ -\ This is what the compiling words ( : ; IF LOOP LITERAL ... ) are built on. -\ It lays code down exactly as DECOMPOSITION.md 1.2 and 2 require and as the -\ test harness's own packers do (v4/include/v4/asm.h, text.h): -\ -\ - opcodes fill slots 0 .. 5 of a word left to right; a full word is -\ appended to the dictionary and a new one started; unused slots are nop -\ - a literal is @p in a slot and its value in the cell after the word; -\ several in one word follow it in order -\ - ; and ex close the word, since nothing after them runs -\ - a branch closes the word: the bits to its right are its address -\ - a branch goes only in a slot whose address field reaches all of the -\ node's memory; otherwise the word is closed first and the branch starts -\ the next one. So no branch ever needs a reach check. -\ -\ An instruction word is 32 bits at every cell width (D-9): slot k is the five -\ bits whose lowest is bit 27 - 5k, and a branch there has 27 - 5k address bits. -\ -\ Rests on core.v4 and dict.v4. Constants the loader supplies: -\ (CG) word address of fourteen cells of scratch for this file -\ CG-BSLOTS how many slots, counted from slot 0, may hold a branch - -\ Like WORD, these run under whatever the user has on the stacks, so what they -\ work on is in (CG), they keep at most three cells of their own on the data -\ stack, and they call each other as little as they can (D-2): -\ (CG)+0 the word being built (CG)+1 its next free slot -\ (CG)+2 how many literals it owes, and (CG)+3 .. (CG)+8 the literals -\ (CG)+9 the opcode (OP,) was given (CG)+10 the ref (BRANCH0) made -\ (CG)+11 the target a branch is to reach (CG)+12 which literal (FLUSH) is at -\ (CG)+13 what (FLUSH) fills unused slots with: nop, or 0 after a branch -\ -\ The word being built is kept right-justified: each opcode is shifted in -\ below the ones before it, and (FLUSH) shifts in what fills the rest and the -\ two spare bits. So nothing is ever shifted by a counted loop, which would -\ want a return-stack entry for its count. - -\ ( k -- mask ) the address bits of a branch in slot k: 2^(27-5k) - 1 -: (MASK) - if K0 -1 + if K1 -1 + if K2 - drop 4095 ; - K2: drop 131071 ; - K1: drop 4194303 ; - K0: drop 134217727 ; - -\ ( -- ) forget the word being built -: (CG-RESET) 0 (CG) a! ! 0 (CG)+1 a! ! 0 (CG)+2 a! ! 28 (CG)+13 a! ! ; - -\ ( x -- ) five bits into the next free slot, which must be free -: (PUT) - (CG) a! @ 2* 2* 2* 2* 2* + ! - (CG)+1 a! @ 1 + ! ; - -\ ( -- ) append the word being built, its unused slots filled, then the -\ literals it owes; nothing if no slot is in use -: (FLUSH) - (CG)+1 a! @ if EMPTY drop - P: (CG)+1 a! @ -6 + if FULL drop (CG)+13 a! @ (PUT) jump P - FULL: drop - (CG) a! @ 2* 2* , \ the two spare bits - 0 (CG)+12 a! ! - L: (CG)+12 a! @ (CG)+2 a! @ xor if DONE - drop (CG)+12 a! @ dup 1 + ! (CG)+3 + a! @ , - jump L - DONE: drop - jump (CG-RESET) - EMPTY: drop ; - -\ ( op -- ) any opcode that is neither a branch nor @p -: (OP,) - dup (CG)+9 a! ! (PUT) - (CG)+9 a! @ if ENDS -1 + if ENDS \ ; and ex end the word - drop (CG)+1 a! @ -6 + if ENDS drop ; \ and so does its last slot - ENDS: drop jump (FLUSH) - -\ ( x -- ) @p and its value -: (LIT,) - (CG)+2 a! @ dup 1 + ! \ x n - (CG)+3 + a! ! - 8 (PUT) - (CG)+1 a! @ -6 + if FULL drop ; - FULL: drop jump (FLUSH) - -\ ( -- addr ) where the next word will go: a branch target -: (LABEL) (FLUSH) HERE ; - -\ ( op -- ) a branch (jump 2, call 3, next 5, if 6, -if 7) whose address is -\ not filled in yet. Its ref -- the branch's word address times 8, plus its -\ slot -- is left in (CG)+10. The rest of its word is filled with 0, which -\ is its address field. It ends by jumping to (FLUSH), so that the chain of -\ calls under it is one shorter. -: (BRANCH0) - (CG)+1 a! @ CG-BSLOTS inv + 1 + -if MOVE drop jump PLACED \ slot - CG-BSLOTS - MOVE: drop (FLUSH) - PLACED: - \ the word will be appended at HERE; its literals, if any, come after it - HERE 2* 2* 2* (CG)+1 a! @ + (CG)+10 a! ! - (PUT) - 0 (CG)+13 a! ! jump (FLUSH) - -\ ( op -- ref ) the same, leaving the ref, for (RESOLVE) to fill in later -: (BRANCH>) (BRANCH0) (CG)+10 a! @ ; - -\ ( ref -- ) put the address in (CG)+11 into the branch at ref -: (RESOLVE1) - dup 7 and (MASK) push \ ref R: mask - 2/ 2/ 2/ a! \ A: the branch's word - (CG)+11 b! @b pop dup push and \ the address bits - @ pop inv and + ! ; - -\ ( target ref -- ) put the address into the branch at ref -: (RESOLVE) SWAP (CG)+11 a! ! jump (RESOLVE1) - -\ ( target op -- ) a branch to a known address -: (BRANCH,) SWAP (CG)+11 a! ! (BRANCH0) (CG)+10 a! @ jump (RESOLVE1) - -: (JUMP,) ( addr -- ) 2 jump (BRANCH,) -: (CALL,) ( addr -- ) 3 jump (BRANCH,) diff --git a/v4/capsule/compile.v4 b/v4/capsule/compile.v4 deleted file mode 100644 index 7c8fd0c9..00000000 --- a/v4/capsule/compile.v4 +++ /dev/null @@ -1,466 +0,0 @@ -\ compile.v4 -- the interpreter's inner loop, and the defining and compiling -\ words. -\ -\ DECOMPOSITION.md 5.17 and 5.18: STATE [ ] : ; EXIT IMMEDIATE LITERAL COMPILE -\ [COMPILE] ' EXECUTE CREATE VARIABLE CONSTANT DOES>, the control structures -\ IF ELSE THEN BEGIN UNTIL AGAIN WHILE REPEAT DO ?DO LOOP +LOOP, and INTERPRET, -\ which they cannot be run without. Part of the compiler capsule. Rests on -\ core.v4, input.v4, dict.v4 and codegen.v4. -\ -\ HOW A WORD IS COMPILED. v4 code is native: a colon definition is -\ instruction words, and compiling a word into one lays down a call to it. -\ Two flags on an entry (dict.v4) change that: -\ inline its code is a straight run of opcodes and literals ending -\ in ; -- that run is copied in place of a call. Everything -\ that touches the return stack must be, since a call would -\ bury what it works on (DECOMPOSITION.md 0, fate IN). -\ compile-only it may not be executed by the interpreter. -\ An immediate word is executed even when compiling. -\ -\ THE STACKS ARE SHORT: written for ten cells of data and nine return entries -\ (D-2; the host node now has 32 of each, D-17), and one more of either is a -\ fault (D-16). The interpreter and compiler run on the same -\ stacks as the user's words, with the user's values beneath them, so: -\ - every word here keeps what it works on in (C), and has at most three -\ cells of its own on the data stack at any moment; -\ - what an IF or a DO leaves for its THEN or LOOP goes on a control-flow -\ stack in memory, not on the data stack, so structures may nest as -\ deep as that stack (32 cells) allows whatever the user has stacked. -\ -\ Constants the loader supplies: -\ STATE word address of the variable: non-zero while compiling -\ (C) word address of ten cells of scratch for this file: -\ (C)+0 (C)+1 (C)+4 the in-liner's word, literal pointer and slot -\ (C)+2 LATEST before a header is made (C)+3 a data word's routine -\ (C)+5 what a loop's end lays after its test -\ (C)+6 (C)+7 a branch and a tag a control word is holding -\ (C)+8 whether a data word's entry was made -\ (C)+9 the error code a line is being abandoned with -\ (CFP) word address of the control-flow stack's pointer -\ CFBASE CFEND word addresses of its first cell and of the cell past its last - -macro ROT push SWAP pop SWAP endmacro - -\ ---- errors ------------------------------------------------------------------ - -\ ( -- ) give up the line: stop compiling, forget the word being built and -\ whatever control structures were open, skip the rest of the input, and set -\ NODE-ERROR. A definition that was under way stays hidden. It returns to -\ whatever called INTERPRET, which is QUIT (quit.v4): QUIT sees NODE-ERROR -\ and prints ERROR. -\ (ABANDON-AS) is the same with an error code (core.v4) for the prompt to -\ print the message of. -: (ABANDON-AS) ( code -- ) - (C)+9 a! ! - 0 STATE a! ! (CG-RESET) - CFBASE (CFP) a! ! - SPAN a! @ >IN a! ! - (C)+9 a! @ NODE-ERROR b! !b ; -: (ABANDON) -1 jump (ABANDON-AS) - -\ ---- the control-flow stack ---------------------------------------------------- - -\ ( x -- ) push; a full stack abandons the line -: >CF - (CFP) a! @ CFEND xor if FULL - drop (CFP) a! @ dup 1 + ! a! ! ; - FULL: drop drop 8 jump (ABANDON-AS) \ control structures too deep - -\ ( -- x ) pop; 0 from an empty stack, which no opening word leaves -: CF> - (CFP) a! @ CFBASE xor if EMPTY - drop (CFP) a! @ -1 + dup ! a! @ ; - EMPTY: ; - -\ ---- compiling one word ------------------------------------------------------ - -\ ( w -- op ) the opcode in slot 0 of the instruction word w -: (TOP5) 8/ 8/ 8/ 2/ 2/ 2/ 31 and ; - -\ ( xt -- ) copy the in-line word at xt into the definition being built. -\ Each slot is read from the top of the word in (C)+0, which is then moved -\ up five bits for the next. -: (INLINE,) - W: dup a! @ (C) a! ! 1 + (C)+1 a! ! \ the word, and its literals after it - 0 (C)+4 a! ! \ slot - S: (C) a! @ dup 2* 2* 2* 2* 2* ! (TOP5) \ op - if END \ ; ends the copy - dup -8 + if LIT - drop dup -28 + if NOP \ nop is padding - drop (OP,) - NXT: (C)+4 a! @ 1 + dup ! -6 + if NEXTW drop jump S - NEXTW: drop (C)+1 a! @ jump W \ the next instruction word follows the literals - LIT: drop drop (C)+1 a! @ dup 1 + ! a! @ (LIT,) jump NXT - NOP: drop drop jump NXT - END: drop ; - -\ ( xt -- ) compile the word at xt: in line if it is flagged so, else a call -: (COMPILE,) - dup -3 + a! @ 8 and if CALL drop jump (INLINE,) - CALL: drop jump (CALL,) - -\ ---- access control (5.20) ------------------------------------------------------- -\ Each entry's flags cell also holds its access control fields: -\ bit 5 (32) denied: the word may not be used -\ bit 6 (64) pinned: the fields cannot be changed -\ bits 8 .. 15 the mode: 0 TTL, 1 STRICT -\ bits 16 .. 31 the TTL, a count of uses left before the next recheck -\ A new entry has all of them zero: allowed, not pinned, TTL mode, TTL 0. -\ -\ (ACL?) is run by INTERPRET for every word it is about to execute or -\ compile. As v3: if the TTL is 0 the word is rechecked, otherwise the TTL -\ is counted down; then a denied word is refused. The recheck is the word -\ whose address is in (ACL-HOOK) -- ACL-RECHECK, once ACL.fth has loaded -- -\ and with none there the word is allowed and given the longest TTL. -\ -\ v3 checks every execution, inside definitions too. v4 code is native: a -\ compiled call goes straight to its word. So v4 checks a word when it is -\ compiled as well as when it is interpreted -- a denied word cannot be -\ built into anything new -- but a call compiled while the word was allowed -\ is not checked again. - -\ ( xt -- ) recheck -: (ACL-RECHECK) - (ACL-HOOK) a! @ if NONE push ex \ call it with the xt - ; - NONE: drop -3 + a! @ 65535 and -33 and $FFFF0000 + ! ; - -\ ( xt -- xt ) as above; a denied word ends the line -: (ACL?) - dup -3 + a! @ \ xt flags - dup $FFFF0000 and if ZERO - drop -65536 + ! jump TEST \ one use fewer - ZERO: drop drop dup (ACL-RECHECK) - TEST: dup -3 + a! @ 32 and if OK - drop drop - $33335B1B (EMIT4) $6D (EMIT4) $4E524157 (EMIT4) $203A (EMIT4) $6D305B1B (EMIT4) \ v3's line: WARN: in yellow - $3A4C4341 (EMIT4) $6E656420 (EMIT4) $20646569 (EMIT4) $27 (EMIT4) - (.WORD) 39 EMIT CR - DSTACK-DEPTH b! a !b \ as v3, the stack is emptied - pop drop jump (ABANDON) - OK: drop ; - -\ ( -- ) print the word WORD has just left -: (.WORD) WBUF COUNT jump TYPE - -header EXECUTE -: EXECUTE ( xt -- ) push ; - -\ ---- the interpreter's inner loop --------------------------------------------- - -\ ( -- n flag ) the word WORD has just left, as a single-cell number in the -\ current BASE, and -1; or 0 0 if it is not one. A leading minus sign is -\ allowed. This is what the interpreter uses: NUMBER (input.v4) makes a -\ double and needs more of the stack than can be spared here. -\ (P)+2 the number so far, (P)+3 where it is in the word, (P)+4 the word's -\ length, (P)+5 the sign, (P)+6 the base. -: (NUM?) - WBUF C@ if EMPTY - (P)+4 a! ! 0 (P)+2 a! ! 1 (P)+3 a! ! 0 (P)+5 a! ! - (BASE) (P)+6 a! ! - WBUF+1 C@ -45 + if NEG drop jump DIGITS - NEG: drop -1 (P)+5 a! ! 2 (P)+3 a! ! - (P)+4 a! @ -1 + if EMPTY drop \ a sign alone - DIGITS: - L: (P)+4 a! @ (P)+3 a! @ - -if MORE - drop (P)+2 a! @ (P)+5 a! @ if POS drop NEGATE -1 ; - POS: drop -1 ; - MORE: drop - (P)+3 a! @ dup 1 + ! WBUF + C@ (DIGIT) \ d - -if DIGIT jump BAD1 - DIGIT: dup (P)+6 a! @ - -if BAD2 drop - (P)+2 a! @ (P)+6 a! @ STAR + (P)+2 a! ! - jump L - BAD2: drop - BAD1: drop 0 0 ; - EMPTY: drop 0 0 ; - -\ ( -- ) FORTH-79: take words from the input stream until it is exhausted. -\ A word in the dictionary is executed, or, when compiling and not immediate, -\ compiled. Anything else must be a number in the current BASE: it is left -\ on the stack, or compiled as a literal. What is neither, or a compile-only -\ word met while interpreting, abandons the line, with v3's message: -\ UNKNOWN WORD: 'xxx' xxx: compile-only -header INTERPRET -: INTERPRET - L: 32 WORD dup C@ if EOL - drop (LOOKUP) if NUM - dup -3 + a! @ \ xt flags - STATE a! @ if INTERP - drop 1 and if COMP \ compiling: immediate words still run - drop (ACL?) EXECUTE jump L - COMP: drop (ACL?) (COMPILE,) jump L - INTERP: drop 16 and if RUN - drop drop (.WORD) \ ": compile-only" - $6F63203A (EMIT4) $6C69706D (EMIT4) $6E6F2D65 (EMIT4) $796C (EMIT4) CR - jump (ABANDON) - RUN: drop (ACL?) EXECUTE jump L - NUM: drop (NUM?) if BAD - drop - STATE a! @ if KEEP drop (LIT,) jump L - KEEP: drop jump L - BAD: drop drop (UNKNOWN) drop jump (ABANDON) - EOL: drop drop ; - -\ ---- state --------------------------------------------------------------------- - -header [ immediate -: LEFT-BRACKET 0 STATE a! ! ; -header ] -: RIGHT-BRACKET -1 STATE a! ! ; - -\ ( x -- ) FORTH-79: if compiling, compile x as a literal -header LITERAL immediate -: LITERAL STATE a! @ if NO drop jump (LIT,) NO: drop ; - -\ ( -- addr ) FORTH-79: the next word's parameter field address; if -\ compiling, compiled as a literal -header ' immediate -: TICK (') jump LITERAL - -\ ['] xxx the same inside a definition, whatever STATE is; and [LITERAL], -\ which v3 has as another name for LITERAL. -header ['] immediate compile-only -: BRACKET-TICK (') jump (LIT,) -header [LITERAL] immediate -: BRACKET-LITERAL jump LITERAL - -\ ---- colon definitions ----------------------------------------------------------- - -\ FORTH-79: start a definition; it cannot be found until ; ends it. The -\ CONTEXT vocabulary is set to the CURRENT one. -\ (C)+2 holds LATEST while the entry is made, to tell whether one was. -header : -: COLON - CURRENT a! @ CONTEXT a! ! - LATEST (C)+2 a! ! - 32 WORD (HEADER) - LATEST (C)+2 a! @ xor if NONE drop - HIDDEN (CG-RESET) CFBASE (CFP) a! ! jump RIGHT-BRACKET - NONE: drop jump (ABANDON) \ no entry: the rest of the line is not a definition - -\ FORTH-79: compile the return, let the word be found, stop compiling -header ; immediate compile-only -: SEMICOLON - 0 (OP,) - LATEST (FLAGS) a! @ -3 and ! - jump LEFT-BRACKET - -\ ( n -- ) KERNEL-WORD xxx A WORD THAT ASKS THE KERNEL (docs/v4.0.0/ -\ ENGINE.md 3.3). xxx is made a word whose whole body is "write n to the -\ port": n is the number of a request, the port is the node's way to its -\ kernel, and the write blocks the node until the kernel has served it -\ (DECOMPOSITION.md section 6). xxx's arguments are whatever it finds on -\ the data stack and its results are what the kernel leaves there. This is -\ what a word that is a C function in v3 -- BIRTH, BLOCK, BYE -- is on a -\ node. Not FORTH-79 and not in v3, where such a word is registered from C. -\ The constant (PORT) is the port's word address. -header KERNEL-WORD -: KERNEL-WORD - COLON (LIT,) (PORT) (LIT,) 30 (OP,) 14 (OP,) \ n port b! !b - jump SEMICOLON - -\ FORTH-79: return from the definition at this point -header EXIT immediate compile-only -: EXIT 0 jump (OP,) - -header IMMEDIATE -: IMMEDIATE LATEST if NONE (FLAGS) a! @ 1 OR ! ; NONE: drop ; - -\ COMPILE xxx FORTH-79: when the word this is in runs, xxx is compiled -header COMPILE immediate compile-only -: COMPILE - 32 WORD (LOOKUP) if MISSING - (LIT,) &(COMPILE,) jump (CALL,) - MISSING: drop (UNKNOWN) drop jump (ABANDON) - -\ [COMPILE] xxx FORTH-79: compile xxx even though it is immediate -header [COMPILE] immediate compile-only -: BRACKET-COMPILE - 32 WORD (LOOKUP) if MISSING jump (COMPILE,) - MISSING: drop (UNKNOWN) drop jump (ABANDON) - -\ ---- data words --------------------------------------------------------------------- -\ A data word's code is one call to its run-time routine; the call leaves the -\ address of the cell after it -- the parameter field -- on the return stack. - -: (DOVAR) pop ; \ leave the parameter field address -: (DOCON) pop a! @ ; \ leave what it holds - -\ ( -- ) an entry for the next word, flagged data, its code a call to the -\ routine whose address is in (C)+3. (C)+8 is left -1 if one was made, else -\ 0. It ends by jumping, and CREATE jumps to it, so that a defining word -\ has as few return entries under it as can be. -: (DATA) - 0 (C)+8 a! ! - LATEST (C)+2 a! ! - 32 WORD (HEADER) - LATEST (C)+2 a! @ xor if NONE drop - (CG-RESET) - LATEST (FLAGS) a! @ 4 OR ! - -1 (C)+8 a! ! - (C)+3 a! @ jump (CALL,) - NONE: drop ; - -\ FORTH-79: an entry whose word leaves the address of its parameter field -header CREATE -: CREATE &(DOVAR) (C)+3 a! ! jump (DATA) - -\ FORTH-79: CREATE and one cell. The standard leaves its first value to the -\ programme; here it is 0. -header VARIABLE -: VARIABLE &(DOVAR) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ; - -\ ( n -- ) FORTH-79: an entry whose word leaves n -header CONSTANT -: CONSTANT &(DOCON) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop jump , NONE: drop drop ; - -\ FORTH-79: in : DEFINER CREATE ... DOES> ... ; the words after DOES> become -\ what each word DEFINER makes does, starting with its parameter field address -\ on the stack. (DOES), run by DEFINER, turns the newest entry's code into a -\ call to the code after it and leaves DEFINER; that code starts with pop, -\ which fetches the parameter field address the call left. -: (DOES) pop 402653184 + LATEST a! ! ; \ 402653184 is `call` in slot 0 -header DOES> immediate compile-only -: DOES> &(DOES) (CALL,) 25 jump (OP,) - -\ ---- control structures (5.18, section 2) --------------------------------------------- -\ All immediate and compile-only. Each puts what the word that closes it -\ needs on the control-flow stack, with a number on top saying which word put -\ it there: 1 IF, 2 ELSE, 3 BEGIN, 4 WHILE, 5 DO, 6 ?DO, 7 CASE, 8 OF. A closing word that -\ finds the wrong number abandons the line. - -\ ( tag wanted -- ) if they differ, abandon the line and leave the control -\ word that called this as well: its return address is dropped, so the -\ abandoning returns to the interpreter and nothing more is laid down. -: (PAIR) xor if OK drop pop drop 7 jump (ABANDON-AS) OK: drop ; - -\ ( ref -- ) the branch at ref lands here -: (HERE!) (FLUSH) HERE SWAP jump (RESOLVE) - -\ Native if leaves the flag, so both ways out of it drop it (section 2): -\ IF a THEN if L1 drop a jump L2 L1: drop L2: -\ IF a ELSE b THEN if L1 drop a jump L2 L1: drop b L2: -header IF immediate compile-only -: IF 6 (BRANCH>) >CF 23 (OP,) 1 jump >CF -header ELSE immediate compile-only -: ELSE - CF> 1 (PAIR) CF> (C)+6 a! ! \ the if - 2 (BRANCH>) >CF \ the jump over the else part - (C)+6 a! @ (HERE!) 23 (OP,) - 2 jump >CF -header THEN immediate compile-only -: THEN - CF> dup -1 + if PLAIN - drop 2 (PAIR) CF> jump (HERE!) - PLAIN: drop drop - CF> (C)+6 a! ! \ the if - 2 (BRANCH>) >CF - (C)+6 a! @ (HERE!) 23 (OP,) - CF> jump (HERE!) - -\ A loop that tests at its end jumps back with the flag still there, so it -\ jumps back to a drop laid just ahead of the body: -\ BEGIN a UNTIL jump L0 Ld: drop L0: a if Ld drop -\ BEGIN a WHILE b REPEAT jump L0 Ld: drop L0: a if Lx drop b jump L0 Lx: drop -\ BEGIN a AGAIN jump L0 Ld: drop L0: a jump L0 -\ The control-flow stack holds Ld, L0 and 3. -header BEGIN immediate compile-only -: BEGIN - 2 (BRANCH>) (C)+6 a! ! - (LABEL) >CF 23 (OP,) - (LABEL) dup >CF (C)+6 a! @ (RESOLVE) - 3 jump >CF -header UNTIL immediate compile-only -: UNTIL CF> 3 (PAIR) CF> drop CF> 6 (BRANCH,) 23 jump (OP,) -header AGAIN immediate compile-only -: AGAIN CF> 3 (PAIR) CF> (JUMP,) CF> drop ; -header WHILE immediate compile-only -: WHILE CF> 3 (PAIR) 3 >CF 6 (BRANCH>) >CF 23 (OP,) 4 jump >CF -header REPEAT immediate compile-only -: REPEAT - CF> 4 (PAIR) CF> (C)+6 a! ! \ the while - CF> 3 (PAIR) CF> (JUMP,) CF> drop - (C)+6 a! @ (HERE!) 23 jump (OP,) - -\ CASE: the value being chosen on stays on the stack through the clauses. -\ CASE x1 OF a ENDOF x2 OF b ENDOF c ENDCASE -\ lays, for each clause, -\ over xor if M drop jump N M: drop drop a jump END N: -\ and ENDCASE lays the drop that the part after the last ENDOF leaves the -\ value for, with END after it. The control-flow stack holds the jumps to -\ END, how many there are, and 7; inside a clause, the jump to N and 8. -: (of) over xor ; -header CASE immediate compile-only -: CASE 0 >CF 7 jump >CF -header OF immediate compile-only -: OF - CF> 7 (PAIR) - &(of) (INLINE,) 6 (BRANCH>) (C)+6 a! ! \ if M - 23 (OP,) 2 (BRANCH>) >CF \ drop, jump N - (C)+6 a! @ (HERE!) 23 (OP,) 23 (OP,) \ M: drop drop - 8 jump >CF -header ENDOF immediate compile-only -: ENDOF - CF> 8 (PAIR) CF> (C)+6 a! ! \ the jump to N - CF> (C)+7 a! ! \ how many jumps to END so far - 2 (BRANCH>) >CF \ one more - (C)+7 a! @ 1 + >CF - (C)+6 a! @ (HERE!) \ N: - 7 jump >CF -header ENDCASE immediate compile-only -: ENDCASE - CF> 7 (PAIR) CF> (C)+7 a! ! - 23 (OP,) - L: (C)+7 a! @ if DONE -1 + ! - CF> (HERE!) jump L - DONE: drop ; - -\ DO loops: the limit and index are on the return stack, limit below (5.18). -: (do) over push push drop ; -: (?do) over over xor ; -: (inc) pop 1 + pop ; \ index' limit -: (+inc) dup a! pop + pop ; \ index' limit A: the step -: (differ) drop over ; -: (same) drop over over - ; -: (a-xor) a xor ; -: (again) drop push push ; -: (3drop) drop drop drop ; - -\ The end of a loop. The control-flow stack holds the body's address and 5, -\ or for ?DO its skip, the body and 6; (C)+5 holds the xt of in-line code to -\ lay after the test, or 0. Laid down, in order: -\ ( i' lim -- i' lim s ), the top bit of s set when i' < lim: -\ over over xor -if SAME drop over jump T SAME: drop over over - T: -\ the code in (C)+5, if any -\ -if EXIT drop push push jump BODY EXIT: drop drop drop -\ and for ?DO the landing of its skip: jump PAST SKIP: drop drop drop PAST: -\ It is one word, jumped to by LOOP and +LOOP, so that laying a loop's end -\ takes as few return entries as laying anything else. -: (LOOPS) - &(?do) (INLINE,) 7 (BRANCH>) >CF - &(differ) (INLINE,) 2 (BRANCH>) (C)+6 a! ! - CF> (HERE!) &(same) (INLINE,) - (C)+6 a! @ (HERE!) - (C)+5 a! @ if NOMORE (INLINE,) jump TESTED - NOMORE: drop - TESTED: - CF> (C)+7 a! ! \ the tag - 7 (BRANCH>) (C)+6 a! ! - &(again) (INLINE,) CF> (JUMP,) - (C)+6 a! @ (HERE!) &(3drop) (INLINE,) - (C)+7 a! @ -5 + if PLAIN - drop (C)+7 a! @ 6 (PAIR) - 2 (BRANCH>) (C)+6 a! ! - CF> (HERE!) &(3drop) (INLINE,) - (C)+6 a! @ jump (HERE!) - PLAIN: drop ; - -header DO immediate compile-only -: DO &(do) (INLINE,) (LABEL) >CF 5 jump >CF -header ?DO immediate compile-only -: ?DO &(?do) (INLINE,) 6 (BRANCH>) >CF 23 (OP,) &(do) (INLINE,) (LABEL) >CF 6 jump >CF -header LOOP immediate compile-only -: LOOP &(inc) (INLINE,) 0 (C)+5 a! ! jump (LOOPS) -header +LOOP immediate compile-only -: +LOOP &(+inc) (INLINE,) &(a-xor) (C)+5 a! ! jump (LOOPS) diff --git a/v4/capsule/core.v4 b/v4/capsule/core.v4 deleted file mode 100644 index f53ca385..00000000 --- a/v4/capsule/core.v4 +++ /dev/null @@ -1,479 +0,0 @@ -\ core.v4 -- the core words the host-node capsules rest on. -\ -\ Each is the definition DECOMPOSITION.md gives and the golden-model tests -\ execute (test_foundation.c, test_strings.c, test_terminal.c, test_pictured.c), -\ written here as text for the text assembler (v4/include/v4/text.h). -\ -\ Constants the loader supplies: N-1 (cell bits - 1), NODE-ERROR, CONSOLE-TX, -\ CONSOLE-RX, CONSOLE-STATUS, BASE, (MSG), (REPLY), (ME), (OUT), -\ (OUT^), (CONSOLE), (ROUTES), (ROUTE#), (ROUTE-DEFAULT), (PRINT-TO), -\ (PRINT-PORT). -\ -\ ERRORS (D-18). A word that finds an error takes its arguments off the stack -\ and stores a code in NODE-ERROR. On a node with a prompt that store is a -\ trap: the word goes no further, and the prompt prints the message for the -\ code and ERROR (quit.v4, (RAISED)). The codes: -\ 1 Negative count 2 Not a number 3 Number too long -\ 4 Not a character 5 Dictionary full 6 Name missing -\ 7 Control structure mismatch 8 Control structures too deep -\ 9 Shift count out of range 10 Protected word -\ 11 Division by zero (Q./) 12 Argument out of range -\ 13 Block out of range 14 No block is being loaded -\ 15 Deferred word not set 16 Not a word -\ 17 Storage refused 18 No one on that port -\ 19 Message refused 20 Node gone -\ 21 Interrupted -\ -1 the word has printed its own message - -macro SWAP over push push drop pop pop endmacro -macro - push inv pop + inv endmacro \ x y -- x-y -macro NEGATE inv 1 + endmacro -macro NIP push drop pop endmacro - -\ ---- section 4: multiply ------------------------------------------------ -header UM* -: UM* ( u1 u2 -- ulo uhi ) - over 1 and inv 1 + over 2/ and \ u1 u2 t0 t0 = u2 2/ if u1 odd - over a! N-1 push \ A: u2 R: loop count - push over 2/ pop \ u1 u2 s t0 s = u1 2/ - L: +* unext \ u1 u2 s hi A: lo - push drop pop \ u1 u2 hi - 2* a -if L0 drop 1 + jump L1 L0: drop L1: push - over -if L2 drop dup jump L3 L2: drop 0 L3: push - dup -if L4 drop over 1 and jump L5 L4: drop 0 L5: - pop + pop + push - and 1 and a 2* + pop ; - -\ ---- section 5.7: doubles ------------------------------------------------ -header D+ -: D+ ( d1 d2 -- d3 ) - push over push push drop pop \ al bl R: bh ah - over over xor -if L1 - drop + -if C1 jump C0 - L1: drop over -if L2 - drop + jump C1 - L2: drop + - C0: pop pop + ; - C1: pop pop + 1 + ; - -header DNEGATE -: DNEGATE ( d -- -d ) - inv over if L1 drop push inv 1 + pop ; - L1: drop 1 + ; - -\ ---- section 5.3: bytes -------------------------------------------------- -\ The shifts are written out, eight to a line, where DECOMPOSITION.md 5.3 has -\ a FOR ... UNEXT loop: a loop keeps its count on the return stack, and C@ and -\ C! are at the bottom of every chain of calls in the compiler capsule, where -\ there is not an entry to spare (D-2). The result is the same. -macro 8/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ 2/ endmacro -macro 8* 2* 2* 2* 2* 2* 2* 2* 2* endmacro - -header C@ -: C@ ( baddr -- c ) - dup 2/ 2/ a! 3 and - if K0 -1 + if K1 -1 + if K2 - drop @ 8/ 8/ 8/ 255 and ; - K2: drop @ 8/ 8/ 255 and ; - K1: drop @ 8/ 255 and ; - K0: drop @ 255 and ; - -header C! -: C! ( c baddr -- ) - dup 2/ 2/ a! 3 and - if K0 -1 + if K1 -1 + if K2 - drop 8* 8* 8* 4278190080 and @ 4278190080 inv and + ! ; - K2: drop 8* 8* 16711680 and @ -16711681 and + ! ; - K1: drop 8* 65280 and @ -65281 and + ! ; - K0: drop 255 and @ -256 and + ! ; - -\ ---- section 5.9: strings ------------------------------------------------ -header CMOVE -: CMOVE ( src dst u -- ) - -if OK drop drop drop NODE-ERROR b! 1 !b ; - OK: if DONE push - over C@ over C! 1 + push 1 + pop pop -1 + jump OK - DONE: drop drop drop ; - -\ ---- section 5.10: the console ------------------------------------------- -\ ---- what a node prints (docs/v4.0.0/MESH.md section 6) ------------------------ -\ A node has no console of its own. It does what a message asks, and what -\ it prints while doing it is sent as a message: to the node in (CONSOLE), or -\ if that is 0 to whoever sent the text; by the port that leads there, or if -\ this node knows of none, by the port the text came on. A message is seven words and then its text, four -\ characters to a word: -\ to, from, type, heat and TTL, ACL tag, sequence, length in characters -\ The types: 1 text to be interpreted 2 what a node printed 3 how the -\ text ended (one word of text: 0 QUIT, 1 completed, 2 an error). -\ The header of the text being served is in the seven cells (MSG); (REPLY) -\ is the port it came on, by its number; (ME) is this node's number. -\ -\ Characters are kept in (OUT), 256 of them, a character to a cell, and sent -\ when it is full and when the text has been done with (quit.v4). (OUT^) -\ is where the next goes. -\ -\ THE STACK. What prints may be run with the data stack all but full: EMIT -\ has always needed one free cell and no more, and still does -- it keeps -\ the character and A on the return stack while it works. Sending needs -\ three. - -\ FINDING THE WAY (MESH.md section 7). A node knows its ports and nothing of -\ the shape they are wired in. Whoever wires it tells it, for a node, which -\ port leads toward that node: the table (ROUTES), (ROUTE#) entries of a -\ node's number and a port's address; and (ROUTE-DEFAULT), the port for any -\ node that is not in the table, or 0. - -\ ( node -- port | -1 ) the port, by its number, that leads toward the node -: (WAY) - (ROUTE#) a! @ if NONE -1 + (ROUTES) a! - FOR dup @+ xor if HIT drop @+ drop NEXT - 0 - NONE: drop drop (ROUTE-DEFAULT) a! @ if NOWAY (PORT) - ; - NOWAY: drop -1 ; - HIT: drop drop @+ pop drop (PORT) - ; - -\ WHOLE MESSAGES (MESH.md section 7d). A message waits on a wire, in the -\ fabric, and not in a node: each wire has a queue of whole messages each -\ way. A node asks the fabric to look at one, take it, move it to another -\ wire, drop it, or put one on, by the six addresses after its ports: -\ (WIRE) the port, by its number, that what follows is about -\ (WIRE-A) (WIRE-B) what the operation needs -\ (WIRE-DO) the operation: a store here is the asking -\ (WIRE-HOW) how it went: 0 done, 1 no room, 2 no one on that port, -\ 3 no such message, 4 not a message -\ (WIRE-HAVE) which wires have a message waiting, a bit to a port -\ The operations: 1 look 2 take 3 move 4 drop 5 put 6 first 7 next -\ 8 sleep 9 sleep for room 10 room. Each is whole: all of a message -\ moves or none of it. So a fault or an error in the middle of anything -\ here leaves no message half moved; and nothing here keeps, from one -\ operation to the next, anything a later pass does not set again for -\ itself: every pass over a wire begins by naming the wire and putting its -\ mark at its first message. -\ This replaced a ring of messages waiting in the node's own memory, a -\ list of refusals owed, and messages written and read a word at a time -\ (MESH.md 7a, 7b, 7c.6). The ports themselves are still written a word at -\ a time for the two things that are not messages: a newborn node's -\ nucleus (PORT!, quit.v4) and a node's requests to its kernel. -\ -\ THE STACKS. All of this runs on the stacks the node's text is using. -\ (SERVE) and what it calls keep to four cells of the data stack and four -\ entries of the return stack, its own call among them; what they need -\ from one operation to the next is in cells. (ROOM-SERVE) tries that much. - -\ ( op -- how ) ask the fabric for the operation, and say how it went -: (DO) (WIRE-DO) b! !b (WIRE-HOW) b! @b ; - -\ ( port -- ) what is asked next is about that port's wire, by its number. -\ A number that is no port's is no wire: every operation then answers 2. -: (WIRE!) (WIRE) b! !b ; - -\ ( cells port -- how ) has the port's wire that many cells free? 0: it -\ has; 1: it has not; 2: no one is on that port. Only this node puts -\ messages on the wires that lead from it, so room found stays until it -\ uses it. -: (ROOM?) (WIRE!) (WIRE-A) b! !b 10 jump (DO) - -\ ( -- ) ROOM FOR WHAT A WAIT DOES. A node that waits within text -- for -\ an answer, or for room to print -- passes on meanwhile what comes for -\ other nodes, on the stacks the text has left it: four cells of the data -\ stack and four entries of the return stack, (SERVE)'s. They are tried -\ before anything is taken off a wire or put on one: if they are not there -\ the fault comes here, and the text ends "Stack overflow" with nothing -\ half done (MESH.md 7c.7, 7d.4). -\ (ROOM-SERVE) tries just those, and is what a wait for room does each time -\ a message wakes it. (ROOM), which AWAIT does once before it waits, tries -\ six cells, as it did when a message was read a word at a time: the wait -\ ends in an error that leaves the stack as it is, and the line from the -\ console that broke it is then done on that stack, where printing needs -\ six (MESH.md 7c.7). -: (ROOM-SERVE) - 0 0 0 0 drop drop drop drop - 0 push 0 push 0 push 0 push pop drop pop drop pop drop pop drop ; -: (ROOM) - 0 0 0 0 0 0 drop drop drop drop drop drop - 0 push 0 push 0 push 0 push pop drop pop drop pop drop pop drop ; - -\ ( to type -- ) the first six words of a message this node puts, in -\ (OUT-HDR): to, from, type, and the three that are carried: how many nodes -\ may pass it on, sixteen (the TTL: MESH.md 7b.3); ACL tag; sequence. -: (HDR) - push (OUT-HDR) a! !+ (ME) b! @b !+ pop !+ 16 !+ 0 !+ 0 !+ ; - -\ ( text port -- how ) put the message whose seven words are in (OUT-HDR) -\ and whose text is at the word address given on the wire of the port, by -\ its number. How it went is the fabric's answer: 0 it is on the wire. -\ THE ROOM KEPT FOR AN ANSWER. While this node does text, (KEEP) is the -\ port its word of how the text ended will go by, and nothing else it puts -\ on that wire may take the last 8 cells: a message that would is refused -\ here, 1, as if the wire were full. With no text being done (KEEP) is -1. -: (PUT-ON) - push (WIRE-B) b! !b pop - dup (WIRE!) - (KEEP) a! @ xor if KEPT - GO: drop (OUT-HDR) (WIRE-A) b! !b 5 jump (DO) - KEPT: drop (OUT-HDR)+6 a! @ 3 + 2/ 2/ 15 + (WIRE-A) b! !b 10 (DO) if GO ; - -\ REFUSALS (MESH.md 7b, 7d.4). A message this node cannot pass on is -\ dropped and counted in (LOST), and whoever waits on it is told, by a -\ message of type 4, a NACK, whose one word is the node the refused message -\ was for: its sender; or, for a node's answer (type 3), the node the -\ answer was for, which is the one that waits, about the node that -\ answered. The NACK is put at once. If it cannot go -- no way, no one on -\ the port, no room -- it is counted in (LOST) too, and that is the end of -\ it. Nothing is told for a NACK or for a GONE, type 5: there is no NACK -\ for a NACK. - -\ ( -- ) the message the mark of the wire in (WIRE) is at, whose seven -\ words are in (IN), is refused. A refusal for this node itself -- its own -\ message came back to it -- is counted in (REFUSED) as one that came by a -\ wire would be; or, if it is about the node this one is waiting on, -\ (A-SELF) is set for AWAIT to find (quit.v4). -\ (WIRE) is not what it was afterwards: the NACK went by another. -\ If the drop does not drop -- the wire was cut after the message was looked -\ at, which let it go already -- nothing is counted and no one is told. -: (REFUSE) - 4 (DO) if DROPPED drop ; \ it was not there to drop -- its wire has been cut: nothing is counted or told - DROPPED: drop - (LOST) a! @ 1 + ! - (IN)+2 a! @ -4 + if NOT -1 + if NOT 2 + if ANSWER - drop (IN) a! @ (ONE) a! ! (IN)+1 a! @ jump TELL \ about whom it was for; to its sender - ANSWER: drop (IN)+1 a! @ (ONE) a! ! (IN) a! @ \ about the node that answered; to whom the answer was for - TELL: dup (ME) a! @ xor if SELF drop - dup 4 (HDR) 4 (OUT-HDR)+6 a! ! - (WAY) (ONE) SWAP (PUT-ON) if SENT - drop (LOST) a! @ 1 + ! ; - SENT: drop ; - SELF: drop drop - (AWAIT-FROM) a! @ if COUNT (ONE) a! @ xor if MINE - COUNT: drop (REFUSED) a! @ 1 + ! ; - MINE: drop 1 (A-SELF) a! ! ; - NOT: drop ; - -\ ( port -- bit ) the bit for a port, by its number, in a word of a bit to a port -: (WBIT) - push 1 pop if Z -1 + FOR 2* NEXT ; - Z: drop ; - -\ ( -- ) A MESSAGE FOR ANOTHER NODE is passed on (MESH.md section 7): the -\ one the mark of the wire in (WIRE) is at, whose seven words are in (IN), -\ is moved, whole, to the wire that leads toward that node. It is refused -\ instead if it has been passed on as often as a message may be; or if -\ there is no way, or no one on the port. -\ WITH NO ROOM on that wire -- or none but the room kept on it, (KEEP) -- -\ text, a NACK and a GONE are refused, at once. But what a node printed -\ (type 2) and its word of how text ended (type 3) are NOT let go for want -\ of room: the message is left where it is, on the wire it came by, and -\ gone past; what is behind it is served; and it is moved on a later pass, -\ when there is room. Printing waits; it is not lost (MESH.md 7d.1, -\ ruling 3). (H-PORT) and (H-NEED) are the port of the first message left -\ so on this pass and the cells it needs there: a node that then sleeps, -\ sleeps for that room, (SLEEP), and is woken by room on any wire. -\ (H-MASK) has a bit for each port something was left for: what is behind -\ it for the same port is left too, though it be shorter and would fit, so -\ that what a node printed goes on in the order it came. -\ HOW OFTEN. A message's fourth word is how many more nodes may pass it -\ on; a node sends it with 16, and a move takes one off. The node that -\ finds 1 there refuses it. A device sends it with 0, which is taken for -\ 16: so 0 down to -14 are passed on and -15 is refused. Anything else is -\ nothing a node or a device sent, and is refused. -: (PASS) - (IN)+3 a! @ -if POS - 14 + -if OK jump SPENT - POS: if OK -1 + if SPENT -16 + -if SPENT - OK: drop - (IN) a! @ (WAY) (P-WAY) a! ! - (IN)+6 a! @ 3 + 2/ 2/ 7 + \ the cells it takes, - (P-WAY) a! @ (KEEP) a! @ xor if KEPT drop jump NEED - KEPT: drop 8 + \ and the room kept, if it is that wire - NEED: (P-NEED) a! ! - (P-WAY) a! @ -if WAY \ no way: refused - SPENT: drop jump (REFUSE) - WAY: (WBIT) (H-MASK) a! @ and if CLEAR \ something is left for that port already? - FULL: drop (IN)+2 a! @ -2 + if HOLD -1 + if HOLD jump SPENT \ no room: only output and answers wait - CLEAR: drop - (P-NEED) a! @ (P-WAY) a! @ (ROOM?) (S-WIRE) a! @ (WIRE!) - if GO -1 + if FULL jump SPENT \ no one on that port: refused - GO: drop (P-WAY) a! @ (WIRE-A) b! !b 3 (DO) if MOVED jump SPENT - MOVED: drop ; - HOLD: drop - (P-WAY) a! @ (WBIT) dup inv (H-MASK) a! @ and + ! - (H-PORT) a! @ -if HELD drop (P-WAY) a! @ (H-PORT) a! ! (P-NEED) a! @ (H-NEED) a! ! 7 (DO) drop ; - HELD: drop 7 (DO) drop ; - -\ ( -- ) SLEEP until a message comes -- or, if (SERVE) left a message -\ on a wire for want of room, until there is that room or a message comes -\ or any wire of this node's gains room (operation 9, MESH.md 7d.3). -: (SLEEP) - (H-PORT) a! @ -if ROOM drop 8 (DO) drop ; - ROOM: (WIRE!) (H-NEED) a! @ (WIRE-A) b! !b 9 (DO) drop ; - -\ ( -- ) ONE PASS OVER EVERY WIRE THAT HAS A MESSAGE. What is for another -\ node is passed on, or refused; what is for this node is left where it -\ is. Fetching (WIRE-HAVE) is what tells the fabric this node has seen -\ what had come: a sleep after this is woken only by what comes later -\ (MESH.md 7d.3). (S-HAVE) keeps which wires they were, for whoever then -\ looks for what is this node's own, (MINE). -: (SERVE) - (WIRE-HAVE) b! @b dup (S-HAVE) a! ! (S-MASK) a! ! - 0 (S-WIRE) a! ! -1 (H-PORT) a! ! 0 (H-MASK) a! ! - W: (S-MASK) a! @ if END - dup 2/ ! 1 and if NEXTW - drop (S-WIRE) a! @ (WIRE!) 6 (DO) drop - M: (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b 1 (DO) if LOOKED jump NEXTW - LOOKED: drop - (IN) a! @ (ME) a! @ xor if MINE drop (PASS) jump M - MINE: drop 7 (DO) drop jump M - NEXTW: drop (S-WIRE) a! @ 1 + ! jump W - END: drop ; - -\ WHAT IS FOR THIS NODE is gone through after (SERVE), a message at a time: -\ (MINE0) begins, and each (MINE) puts the mark of a wire at the next -\ message for this node and its seven words in (IN). Whoever asked then -\ takes or drops that message -- the mark is then at the one that followed -\ -- or leaves it and goes past it, (SKIP). The wire is (S-WIRE). - -\ ( -- ) begin with the wires (SERVE) found a message on -: (MINE0) (S-HAVE) a! @ (S-MASK) a! ! -1 (S-WIRE) a! ! 0 (S-ON) a! ! ; - -\ ( -- flag ) the next message for this node; 0: there are no more -: (MINE) - L: (S-ON) a! @ if WIRE - drop (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b 1 (DO) if LOOKED - drop 0 (S-ON) a! ! jump L \ this wire has no more - LOOKED: drop (IN) a! @ (ME) a! @ xor if HIT - drop 7 (DO) drop jump L - HIT: drop -1 ; - WIRE: drop (S-WIRE) a! @ 1 + ! \ the next wire that had one - (S-MASK) a! @ if NONE - dup 2/ ! 1 and if NOT - drop (S-WIRE) a! @ (WIRE!) 6 (DO) drop 1 (S-ON) a! ! jump L - NOT: drop jump L - NONE: ; - -\ ( -- ) go past the message (MINE) found: it stays on its wire -: (SKIP) (S-WIRE) a! @ (WIRE!) 7 (DO) drop ; - -\ ( -- ) A TAKE DID NOT TAKE the message (MINE) found. The fabric takes -\ only the message last looked at (MESH.md 7d.3), so either the wire has -\ been cut -- and there is nothing there, or another message that has not -\ been looked at -- or the message cannot be taken at all. It is dropped, -\ and counted in (LOST); if it cannot be dropped either it is gone past. -\ Either way whoever goes through the messages next is at another one: -\ nothing goes round on one that will not be taken. -: (UNTAKEN) - (S-WIRE) a! @ (WIRE!) 4 (DO) if GONE drop jump (SKIP) - GONE: drop (LOST) a! @ 1 + ! ; - -\ ( -- how ) take the message (MINE) found, which has one word of text: -\ its seven words stay in (IN), and its word goes to (ONE). 0: it is -\ taken. Anything else: it is not -- the wire was cut after the message -\ was looked at -- and (ONE) is not its word: nothing is to be done for it. -: (TAKE1) (S-WIRE) a! @ (WIRE!) (IN) (WIRE-A) b! !b (ONE) (WIRE-B) b! !b 2 jump (DO) - -\ ( -- how ) WAIT UNTIL THE WIRE of the port (W-PORT) has (W-NEED) cells -\ free. 0: it has. 2: no one is on that port. The node sleeps until -\ there is room, or a message comes, or another wire of its own gains -\ room; woken with no room yet, it passes on what is for other nodes, -\ (SERVE), and sleeps again. It is the one thing a node waits to put: -\ what a text prints (MESH.md 7d.1, ruling 3). -\ NOTHING BREAKS THIS WAIT but the room coming or the wire being cut -\ (ruled 2026-10-08): text for this node that comes meanwhile, from its -\ console or anyone, stays on its wire and is done when this text has been -\ finished with. A text whose printing can never go, because a stuck node -\ is on the way, waits until that node is killed (MESH.md 7d.6). -: (WAIT-ROOM) - L: (W-PORT) a! @ (WIRE!) (W-NEED) a! @ (WIRE-A) b! !b 9 (DO) - if DONE -1 + if WOKEN drop 2 ; - WOKEN: drop (WIRE-HAVE) b! @b if QUIET \ no wire has a message: there is nothing to pass on, - drop (ROOM-SERVE) (SERVE) jump L \ and no more of the stacks is asked for than a wait needs - QUIET: drop jump L - DONE: ; - -\ ( -- ) send what has been printed, to where (PRINT-TO) says, by the port -\ (PRINT-PORT): a message of type 2, its characters four to a word, the -\ first lowest. quit.v4 sets those two when text for this node arrives. -\ It waits for room on the wire, and for the 8 cells kept as well when the -\ wire is the one the answer goes by. The characters are made ready in -\ (OUT-TEXT), not where they are: until the message is on the wire the -\ buffer is as it was, and a fault on the way leaves it to be sent again. -\ The three cells after the last character are made zero first, so that -\ nothing printed earlier goes on the wire in the last word (they are in -\ the buffer, or the four free cells after it). -\ The three cells and two return entries this needs are tried first. -\ WITH NO ONE ON THE PORT -- when it waits for room, or when it comes to -\ put -- what was printed cannot be sent. While the text is being done -\ that is its error, 18; and the data stack is emptied first, as a fault -\ empties it. A word that raises an error has taken its own arguments -\ off; this one comes from under whatever word was printing, in the -\ middle of its work, and what that word had on the stack is nothing its -\ caller can use (as first built those values were left there). Once it has been finished with, what it printed -\ is let go and counted in (LOST), and the text is said to have ended in -\ an error: (LINE-STATUS), which is the word then sent of how it ended. -: (FLUSH-OUT) - (OUT^) a! @ (OUT) xor if NONE drop - 0 0 0 drop drop drop 0 push 0 push pop drop pop drop - (OUT^) a! @ (OUT) - 3 + 2/ 2/ 7 + - (PRINT-PORT) a! @ (KEEP) a! @ xor if SAME drop jump NEED - SAME: drop 8 + - NEED: (W-NEED) a! ! (PRINT-PORT) a! @ (W-PORT) a! ! - (WAIT-ROOM) if ROOM - NOONE: drop (QUIET) a! @ if TELL - drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! 2 (LINE-STATUS) a! ! ; - TELL: drop DSTACK-DEPTH b! a !b NODE-ERROR b! 18 !b ; \ the data stack is emptied, as by a fault: see below - ROOM: drop - (PRINT-TO) a! @ 2 (HDR) - (OUT^) a! @ a! 0 !+ 0 !+ 0 ! - (OUT^) a! @ (OUT) - dup (OUT-HDR)+6 a! ! - 3 + 2/ 2/ -1 + push (OUT-TEXT) pop (OUT) a! - FOR @+ @+ 8* + @+ 8* 8* + @+ 8* 8* 8* + over b! !b 1 + NEXT - drop - (OUT-TEXT) (PRINT-PORT) a! @ (PUT-ON) if SENT jump NOONE - SENT: drop (OUT) (OUT^) a! ! ; - NONE: drop ; - -\ EMIT puts the character with what has been printed. Everything the node -\ prints goes through EMIT. A is kept: the words that print have always -\ been free to use it across an EMIT. As v3, only the low 8 bits of the -\ character are printed. -\ A BUFFER FOUND FULL is sent first. It is full when a flush of it ended -\ in a fault -- the stack too deep to begin a message -- and what is printed -\ next is that fault's own message: put where (OUT^) points, it would go -\ past the buffer's end, and (OUT^) would never again be at the end to be -\ flushed (MESH.md 7c.6). -header EMIT -: EMIT ( c -- ) - 255 and a push push \ A, and then the character, to the return stack - (OUT^) b! @b (OUT)+256 xor if STALE drop jump PUT - STALE: drop (FLUSH-OUT) - PUT: - (OUT^) b! @b a! pop !+ a !b \ the character goes where (OUT^) points, which moves on - a (OUT)+256 xor if FULL drop pop a! ; - FULL: drop (FLUSH-OUT) pop a! ; -header KEY -: KEY ( -- c ) - L: CONSOLE-STATUS b! @b if WAIT drop CONSOLE-RX b! @b ; - WAIT: drop jump L - -header CR -: CR ( -- ) 10 jump EMIT -header SPACE -: SPACE ( -- ) 32 jump EMIT -header COUNT -: COUNT ( baddr -- baddr+1 c ) dup C@ push 1 + pop ; -header TYPE -: TYPE ( baddr u -- ) - -if OK drop drop NODE-ERROR b! 1 !b ; - OK: if DONE over C@ EMIT push 1 + pop -1 + jump OK - DONE: drop drop ; - -\ ( x -- ) up to four characters packed in one cell, the first in the low -\ byte: how the capsule prints its own short messages, a literal at a time. -: (EMIT4) - L: if DONE dup EMIT 8/ jump L - DONE: drop ; - -\ ---- section 5.8: the number base ---------------------------------------- -: (BASE) ( -- b ) \ BASE, or 10 when it is outside 2 .. 36 - BASE b! @b dup -2 + -if L1 drop drop 10 ; - L1: drop dup -37 + -if L2 drop ; - L2: drop drop 10 ; diff --git a/v4/capsule/dict.v4 b/v4/capsule/dict.v4 deleted file mode 100644 index 7f35bbf8..00000000 --- a/v4/capsule/dict.v4 +++ /dev/null @@ -1,233 +0,0 @@ -\ dict.v4 -- the dictionary: its space, its entries, and looking a name up. -\ -\ DECOMPOSITION.md 5.12 and 5.13: HERE ALIGN ALLOT , C, 2, PAD LATEST, FIND ' , -\ and the entry-field words >LINK LFA LINK> >NAME NFA NAME> CFA PFA >BODY -\ TRAVERSE SMUDGE HIDDEN. Part of the compiler capsule: it runs on the host -\ node. Rests on core.v4 and input.v4. -\ -\ AN ENTRY. A word's execution address (xt) is the address of its code, and -\ everything else is found from it: -\ -\ name the count byte, then the characters, four bytes to a cell, -\ padded with zeros to a whole cell -\ xt - 3 flags: 1 immediate, 2 hidden, 4 data -\ xt - 2 the word address of the name -\ xt - 1 the link: the xt of the entry before this one, 0 for the first -\ xt the code -\ -\ A name holds at most 31 characters; longer ones are cut to 31 both when -\ defined and when looked up, so 31 characters are significant (FORTH-79). -\ A "data" word is one whose code is a single call to its run-time routine, -\ with its parameter field in the cell after it: xt + 1. For any other word -\ the parameter field is the code itself. -\ -\ THE SPACE. DP is a byte address, so that C, can pack characters; HERE is -\ the next whole cell. An address unit is a cell (D-1): ALLOT counts cells. -\ -\ Constants the loader supplies: -\ DP word address of the variable: the next free byte -\ (LATEST) word address of the variable: the xt of the newest entry of the -\ FORTH vocabulary, or 0 -\ CONTEXT CURRENT word addresses of the variables: each holds the address -\ of a vocabulary's head cell -- the cell that holds the xt of -\ that vocabulary's newest entry. FORTH's head cell is (LATEST). -\ -\ VOCABULARIES (FORTH-79). A name is looked up in the CONTEXT vocabulary and -\ then, if that is not FORTH, in FORTH. A new entry goes into the CURRENT -\ vocabulary: it is linked to that vocabulary's newest entry and becomes it. -\ DBASE DLIMIT byte addresses of the start and end of dictionary space -\ PAD byte address of the scratch area for strings, 84 bytes or more -\ (D) word address of five cells of scratch for this file -\ (WORD-DEFINED) (WORD-FORGOTTEN) word addresses of two variables: see -\ "telling the kernel" below -\ PAD is in line. - -macro 4* 2* 2* endmacro -macro 4/ 2/ 2/ endmacro -macro OR over inv and xor endmacro - -\ ---- the space (5.12) ------------------------------------------------------ -\ These reach DP through B and leave A alone, so that , and C, can keep what -\ they are storing in A while the space is taken: nothing of theirs is then -\ on the data stack under (DP+), which itself needs three cells (D-2). - -: (DERR) ( -- 0 ) NODE-ERROR b! 5 !b 0 ; \ dictionary full - -\ ( n -- flag ) move DP by n bytes if it stays inside the dictionary space -\ and say -1; otherwise leave it, set NODE-ERROR and say 0. The two -\ subtractions are x + ~y + 1, which unlike the in-line - needs no return -\ entry: these words are called at the bottom of long chains of calls. -: (DP+) - DP b! @b + - dup DBASE inv + 1 + -if LOW drop drop jump (DERR) \ new - DBASE - LOW: drop dup inv DLIMIT + 1 + -if HIGH drop drop jump (DERR) \ DLIMIT - new - HIGH: drop DP b! !b -1 ; - -header HERE -: HERE ( -- addr ) DP b! @b 3 + 4/ ; -header ALIGN -: ALIGN ( -- ) DP b! @b 3 + -4 and !b ; -header ALLOT -: ALLOT ( n -- ) ALIGN 4* (DP+) drop ; - -\ , calls nothing: the code generator calls it from as deep as anything goes. -header , -: , ( x -- ) - a! - DP b! @b 3 + -4 and \ the next whole cell, as a byte address - dup inv DLIMIT + -3 + -if ROOM \ DLIMIT - (it + 4) - drop drop NODE-ERROR b! 5 !b ; - ROOM: drop dup 4 + !b \ DP is past it - 4/ b! a !b ; -header C, -: C, ( c -- ) - a! 1 (DP+) if FULL - drop a DP b! @b -1 + jump C! - FULL: drop ; -header 2, -: 2, ( lo hi -- ) SWAP , , ; \ the low cell first, as v3 - -header LATEST -: LATEST ( -- xt ) CURRENT a! @ a! @ ; \ the newest entry of the CURRENT vocabulary - -\ ---- the fields of an entry (5.13) ----------------------------------------- - -: (FLAGS) ( xt -- addr ) -3 + ; -header >LINK -: >LINK ( xt -- addr ) -1 + ; -header LFA -: LFA ( xt -- addr ) jump >LINK -header LINK> -: LINK> ( addr -- xt ) a! @ ; -header >NAME -: >NAME ( xt -- baddr ) -2 + a! @ 4* ; -header NFA -: NFA ( xt -- baddr ) jump >NAME -header NAME> -: NAME> ( baddr -- xt ) dup C@ 31 and 4 + 4/ push 4/ pop + 3 + ; -header CFA -: CFA ( xt -- xt ) ; -header PFA -: PFA ( xt -- addr ) dup (FLAGS) a! @ 4 and if CODE drop 1 + ; CODE: drop ; -header >BODY -: >BODY ( xt -- addr ) jump PFA - -\ ( baddr n -- baddr' ) as v3: for n > 0, from a name's count byte to the -\ byte after its last character; otherwise the address unchanged. -header TRAVERSE -: TRAVERSE - -if NN drop ; - NN: if ZERO drop dup C@ 31 and + 1 + ; - ZERO: drop ; - -header SMUDGE -: SMUDGE ( -- ) LATEST if NONE (FLAGS) a! @ 2 xor ! ; NONE: drop ; -header HIDDEN -: HIDDEN ( -- ) LATEST if NONE (FLAGS) a! @ 2 OR ! ; NONE: drop ; - -\ ---- telling the kernel (docs/v4.0.0/ENGINE.md 3b) ------------------------------ -\ A word's code is here on the node; its accounts are a record its kernel -\ keeps. So the kernel has to be told of every entry that is made and of -\ every entry that goes. An entry is made in one place, (HEADER); entries go -\ in two, FORGET and COLD (system.v4). Each tells through a variable that -\ holds the xt of a word to run, or 0 for a node whose host keeps no records: -\ (WORD-DEFINED) ( xt -- ) an entry has been made; its code will be at xt -\ (WORD-FORGOTTEN) ( w -- ) every entry at word address w or above is gone -\ On the bare-metal system the kernel puts words of its own there. - -\ ( -- ) tell of the entry just made, whose code starts at HERE -: (DEFINED) - (WORD-DEFINED) b! @b if NONE HERE SWAP push ; - NONE: drop ; - -\ ( w -- ) tell that the entries from word address w up have gone -: (FORGOTTEN) - (WORD-FORGOTTEN) b! @b if NONE push ; - NONE: drop drop ; - -\ ---- making an entry ------------------------------------------------------- -\ (D)+0 where the name starts (D)+1 the name being looked up -\ (D)+2 the name being copied, or the entry being looked at -\ (D)+3 a count (D)+4 whether a lookup has gone on to FORTH - -\ ( -- bytes ) what an entry for a name of (D)+3 characters takes: its name -\ cells and three more -: (NEED) (D)+3 a! @ 4 + -4 and 12 + ; - -\ ( baddr -- ) an entry for the counted string at baddr; its code starts at -\ HERE afterwards. An empty name, or no room, makes nothing and sets -\ NODE-ERROR. -: (HEADER) - dup (D)+2 a! ! \ (CLIP), in line - C@ -32 + -if LONG drop jump CLIPPED - LONG: drop 31 (D)+2 a! @ C! - CLIPPED: - (D)+2 a! @ C@ if EMPTY \ len - (D)+3 a! ! - ALIGN - (NEED) (DP+) if FULL drop \ there is room; - (NEED) NEGATE (DP+) drop \ DP back where it was - HERE (D) a! ! \ where the name starts - (D)+3 a! @ C, - L: (D)+3 a! @ if DONE -1 + ! - (D)+2 a! @ 1 + dup ! C@ C, - jump L - DONE: drop - P: DP b! @b 3 and if ALIGNED drop 0 C, jump P - ALIGNED: drop - 0 , (D) a! @ , LATEST , - HERE CURRENT a! @ a! ! - jump (DEFINED) - FULL: drop ; \ (DP+) has set NODE-ERROR - EMPTY: drop NODE-ERROR b! 6 !b ; \ name missing - -\ ---- looking a name up ----------------------------------------------------- - -\ ( baddr -- xt | 0 ) the newest visible entry named by the counted string. -\ Written out in one piece -- the string cut to 31, each entry's flags and -\ name fetched, the two names compared byte by byte -- so that the only call -\ it makes is C@: it is called from the interpreter for every word of every -\ line, with the user's return stack beneath it. -: (LOOKUP) - dup (D)+1 a! ! \ cut the string to 31 characters - C@ -32 + -if LONG drop jump CUT - LONG: drop 31 (D)+1 a! @ C! - CUT: - 0 (D)+4 a! ! \ not yet on to FORTH - CONTEXT a! @ a! @ - L: if END - (D)+2 a! ! - (D)+2 a! @ -3 + a! @ 2 and if VISIBLE drop jump OLDER - VISIBLE: drop - (D)+2 a! @ -2 + a! @ 4* (D) a! ! \ its name - (D)+1 a! @ C@ 1 + (D)+3 a! ! \ the count byte and the characters - C: (D)+3 a! @ if SAME -1 + dup ! \ k - dup (D) a! @ + C@ \ k c1 - SWAP (D)+1 a! @ + C@ \ c1 c2 - xor if EQ drop jump OLDER - EQ: drop jump C - SAME: drop (D)+2 a! @ ; - OLDER: (D)+2 a! @ -1 + a! @ jump L - END: (D)+4 a! @ if FIRST drop ; \ FORTH has been searched: not found - FIRST: drop -1 (D)+4 a! ! - CONTEXT a! @ (LATEST) xor if ISFORTH \ CONTEXT is FORTH: that was it - drop drop (LATEST) a! @ jump L - ISFORTH: drop ; - -\ ( -- xt | 0 ) FORTH-79: the compilation address of the next word in the -\ input stream, or 0 if it is not in the dictionary. -header FIND -: FIND 32 WORD jump (LOOKUP) - -\ ( -- addr ) FORTH-79: the parameter field address of the next word in the -\ input stream. Not found is an error: 0, and NODE-ERROR is set. This is ' -\ when interpreting; compile.v4 adds what ' does when compiling. -\ ( -- 0 ) say that the word WORD has just left is not known, as v3 does: -\ UNKNOWN WORD: 'xxx' -: (UNKNOWN) - $4E4B4E55 (EMIT4) $204E574F (EMIT4) $44524F57 (EMIT4) $27203A (EMIT4) - WBUF COUNT TYPE 39 EMIT CR - NODE-ERROR b! -1 !b 0 ; - -: (') 32 WORD (LOOKUP) if MISSING jump PFA - MISSING: drop jump (UNKNOWN) diff --git a/v4/capsule/forth.v4 b/v4/capsule/forth.v4 deleted file mode 100644 index c4c0422f..00000000 --- a/v4/capsule/forth.v4 +++ /dev/null @@ -1,229 +0,0 @@ -\ forth.v4 -- the first words of the FORTH vocabulary: the ones that are -\ opcodes or short runs of them, and the variables that are in-line addresses. -\ -\ Each is the definition DECOMPOSITION.md gives (sections 4, 5.1 - 5.5, 5.18). -\ A word flagged inline is copied into a definition in place of a call; the -\ ones that touch the return stack are compile-only as well. Rests on core.v4, -\ compile.v4's loader constants, and quit.v4, which the division words leave -\ through when the divisor is zero. (F) is seven cells of scratch for -\ this file. - -\ ---- stack ---- -header DUP inline : DUP dup ; -header DROP inline : DROP drop ; -header OVER inline : OVER over ; -header SWAP inline : SWAP' SWAP ; -header ROT inline : ROT' ROT ; -header -ROT inline : -ROT SWAP push SWAP pop ; -header ?DUP : ?DUP if Z dup ; Z: ; -header 2DUP inline : 2DUP over over ; -header 2DROP inline : 2DROP drop drop ; - -\ ---- the stack as a whole (D-16) ---- -\ DEPTH reads the stack register. PICK and ROLL reach under the top of a -\ stack that has no addresses: the values above the one wanted are set aside -\ in (S), and put back. (F)+3 how many are still to set aside, (F)+4 where -\ the next goes, (F)+5 the value wanted, (F)+6 how many are set aside. With n on top of a stack that is -\ otherwise one short of full there is no room at all, so until a value has been set aside nothing here pushes -\ anything while n is still there, and never more than one cell after. - -\ FORTH-79: how many values were on the stack before DEPTH -header DEPTH -: DEPTH DSTACK-DEPTH b! @b ; - -\ ( name -- ) "xxxx: Invalid index", and the line ends with ERROR -: (INDEX) - R-CLEAR (EMIT4) $6E49203A (EMIT4) $696C6176 (EMIT4) $6E692064 (EMIT4) $786564 (EMIT4) CR - 2 jump (DONE) - -\ ( x1 .. xn-1 -- ) A: n, which is 2 or more. Set the n-1 values above -\ the n-th aside. If there are not that many, the pop that finds the stack -\ empty is a fault: "Stack underflow". The count is taken down only after a -\ value has been set aside, when there is room to do the arithmetic. -: (DIG) - (F)+3 b! a !b - (F)+4 b! (S) !b - (F)+6 b! 0 !b - L: (F)+4 b! @b a! !+ - a (F)+4 b! !b - (F)+6 b! @b 1 + !b - (F)+3 b! @b -1 + dup !b - -1 + if DONE drop jump L - DONE: drop ; -\ ( -- x1 .. xk ) put them back. The test that ends it pushes one cell: -\ after the last value is back the stack may be one short of full. -: (BURY) - L: (F)+6 b! @b if DONE -1 + !b - (F)+4 a! @ -1 + dup ! a! @ - jump L - DONE: drop ; - -\ ( n -- x ) FORTH-79: a copy of the n-th value, not counting n itself. -\ 1 PICK is DUP, 2 PICK is OVER. n less than one is an error. -header PICK -: PICK - -if POS jump BAD - POS: if BAD - a! a 2/ if ONE drop \ n is 1 when half of it is 0 - (DIG) dup (F)+5 a! ! (BURY) (F)+5 a! @ ; - ONE: drop dup ; - BAD: drop $4B434950 jump (INDEX) - -\ ( n -- ) FORTH-79: the n-th value, not counting n itself, is taken out -\ and put on top. 3 ROLL is ROT, 2 ROLL is SWAP, 1 ROLL does nothing. n -\ less than one is an error. -header ROLL -: ROLL - -if POS jump BAD - POS: if BAD - a! a 2/ if ONE drop - (DIG) (F)+5 a! ! (BURY) (F)+5 a! @ ; - ONE: drop ; - BAD: drop $4C4C4F52 jump (INDEX) - -\ ---- return stack: in line, and only inside a definition ---- -header >R inline compile-only : >R push ; -header R> inline compile-only : R> pop ; -header R@ inline compile-only : R@ pop dup push ; -header I inline compile-only : I pop dup push ; -header J inline compile-only : J pop pop pop dup push a! push push a ; -header LEAVE inline compile-only : LEAVE pop pop drop dup push push ; -header UNLOOP inline compile-only : UNLOOP pop drop pop drop ; - -\ ---- memory ---- -header @ inline : FETCH a! @ ; -header ! inline : STORE a! ! ; -header +! inline : +! a! @ + ! ; -header CELLS inline : CELLS ; \ an address unit is a cell (D-1) - -\ ---- arithmetic ---- -header + inline : PLUS + ; -header - inline : MINUS - ; -\ The low cell of the product, by N steps of +* with nothing but the count on -\ the return stack. UM* drop gives the same cell but needs two more return -\ entries, which a word inside two DO loops does not have (D-2). The low -\ cell is exact: what +* loses at the top of T (D-3) takes N shifts to reach -\ the bit that moves into A, and the loop ends first. -header * : STAR a! 0 N-1 FOR +* UNEXT drop drop a ; -header NEGATE inline : NEGATE' NEGATE ; -header 1+ inline : 1+ 1 + ; -header 1- inline : 1- -1 + ; -header 2+ inline : 2+ 2 + ; -header 2- inline : 2- -2 + ; -header 2* inline : TWO* 2* ; -header 2/ inline : TWO/ 2/ ; - -\ ---- division (sections 4 and 5.6) ---- -\ Division by zero is guarded (D-15): each word tests its divisor before it -\ does anything else, and a zero divisor prints v3's message -- -\ /: Division by zero -\ -- and ends the line with ERROR, from however deep, as an address fault -\ does. The word's operands are taken off the stack, as v3 takes them, and -\ its caller is not returned to. - -\ ( name2 name1 -- ) the word's name: its first four characters, and the -\ rest or 0 (EMIT4). The return stack is emptied before anything is called: -\ the word may have been run with it full. -: (DIV0) - R-CLEAR (EMIT4) (EMIT4) $6944203A (EMIT4) $69736976 (EMIT4) $62206E6F (EMIT4) \ ": Division b" - $657A2079 (EMIT4) $6F72 (EMIT4) CR \ "y zero" - 2 jump (DONE) - -\ ( d n -- rem quot ) truncating toward zero: the quotient has the sign of -\ d xor n, the remainder the sign of d. This is section 4's SM/REM with its -\ UM/MOD -- restoring division, one step a bit, the divisor in A -- written -\ into it, and the two signs kept in (F) where section 4 has them on the -\ return stack. A word that divides is then four return entries deep, not -\ eight, so division can be used inside words that other words call (D-2). -\ The answer is the same. Exact when the quotient fits a cell; its callers -\ have seen to it that n is not zero. -: SM/REM - over over xor (F) a! ! \ the quotient's sign, in its top bit - over (F)+1 a! ! \ the remainder's - -if L0 inv 1 + L0: a! \ A: |n| - -if L1 DNEGATE L1: \ |d| - N-1 FOR - -if S0 - 2* over -if S1 drop 1 + jump S2 - S1: drop S2: push 2* pop - jump SUB - S0: - 2* over -if S3 drop 1 + jump S4 - S3: drop S4: push 2* pop - dup a xor -if S5 - drop -if NOSUB jump SUB - S5: drop dup inv a + inv -if S6 - drop jump NOSUB - S6: push drop pop jump SETBIT - SUB: inv a + inv - SETBIT: push 1 + pop - NOSUB: - NEXT - over push push drop pop pop \ urem uquot - (F)+1 a! @ -if L2 drop push inv 1 + pop jump L3 L2: drop L3: - (F) a! @ -if L4 drop inv 1 + ; L4: drop ; - -header S>D -: S>D ( n -- d ) dup -if P drop -1 ; P: drop 0 ; -\ The product's sign waits in (F), not on the return stack, for the same -\ reason as SM/REM's. -header M* -: M* ( n1 n2 -- d ) - over over xor (F) a! ! -if A inv 1 + A: push -if B inv 1 + B: pop UM* - (F) a! @ -if P drop jump DNEGATE P: drop ; - -\ ( n1 n2 n3 -- rem quot ) n1 * n2 as a double, divided by n3, which is -\ not zero. M* is written in, and n3 waits in (F)+2, so that the multiply -\ is as few return entries down as it can be. -: (*/MOD) - (F)+2 a! ! - over over xor (F) a! ! -if A inv 1 + A: push -if B inv 1 + B: pop UM* - (F) a! @ -if P drop DNEGATE jump Q P: drop Q: - (F)+2 a! @ jump SM/REM - -header /MOD -: /MOD ( n1 n2 -- rem quot ) - if Z push S>D pop jump SM/REM - Z: drop drop 0 $444F4D2F jump (DIV0) -header / -: / ( n1 n2 -- quot ) - if Z push S>D pop SM/REM NIP ; - Z: drop drop 0 $2F jump (DIV0) -header MOD -: MOD ( n1 n2 -- rem ) - if Z push S>D pop SM/REM drop ; - Z: drop drop 0 $444F4D jump (DIV0) -header */MOD -: */MOD ( n1 n2 n3 -- rem quot ) - if Z jump (*/MOD) - Z: drop drop drop $44 $4F4D2F2A jump (DIV0) -header */ -: */ ( n1 n2 n3 -- quot ) - if Z (*/MOD) NIP ; - Z: drop drop drop 0 $2F2A jump (DIV0) -header M/MOD -: M/MOD ( d n -- rem quot ) - if Z jump SM/REM - Z: drop drop drop $44 $4F4D2F4D jump (DIV0) - -\ ---- logic and comparison ---- -header AND inline : AND and ; -header XOR inline : XOR xor ; -header OR inline : OR' OR ; -header 0= : 0= if L1 drop 0 ; L1: drop -1 ; -header 0< : 0< -if L1 drop -1 ; L1: drop 0 ; -header NOT : NOT jump 0= -header = : EQUALS xor jump 0= -header < : LESS - over over xor -if SAME drop drop jump 0< - SAME: drop - jump 0< -header > : GREATER SWAP jump LESS - -\ ---- in-line addresses and constants ---- -header BL inline : BL' BL ; -header TIB inline : TIB' TIB ; -header >IN inline : >IN' >IN ; -header SPAN inline : SPAN' SPAN ; -header BASE inline : BASE' BASE ; -header PAD inline : PAD' PAD ; -header STATE inline : STATE' STATE ; diff --git a/v4/capsule/input.v4 b/v4/capsule/input.v4 deleted file mode 100644 index 6ceb43a7..00000000 --- a/v4/capsule/input.v4 +++ /dev/null @@ -1,217 +0,0 @@ -\ input.v4 -- reading a line and splitting it into words and numbers. -\ -\ DECOMPOSITION.md 5.9: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD ENCLOSE -\ CONVERT NUMBER, and the comment words ( and \ of 5.15 (named PAREN and -\ BACKSLASH here, since the text assembler reads those two characters as its -\ own comments; the dictionary will give them their names). Part of the compiler -\ capsule: it runs on the host node. Rests on core.v4. -\ -\ Constants the loader supplies: -\ TIB byte address of the text input buffer; QUERY fills at most 81 bytes -\ >IN word address of the variable: offset in TIB of the next character -\ SPAN word address of the variable: how many characters the last -\ EXPECT or QUERY read -\ WBUF byte address of WORD's buffer, 257 bytes -\ (P) word address of eight cells of scratch for this file -\ (SRC) word address of the variable: the byte address of the text being -\ interpreted. QUERY makes it TIB; LOAD (blocks.v4) makes it a -\ block buffer. >IN is an offset from it and SPAN its length. -\ (SRC-HOOK) word address of a variable: 0, or the address of a word -\ that WORD calls before it looks at the text, to make sure (SRC) -\ is right. LOAD puts one there: a block buffer can be given to -\ another block between one word of the text and the next. -\ BLK word address of the variable: the block being interpreted, or -\ 0 for the terminal (FORTH-79) -\ TIB >IN SPAN and BL are in-line: written in a definition they are literals. - -macro BL 32 endmacro - -\ ( -- baddr u ) the input buffer and how much of it is in use -header SOURCE -: SOURCE (SRC) a! @ SPAN a! @ -if P drop 0 P: ; - -\ ( baddr n -- ) FORTH-79: characters from the terminal are stored from -\ baddr upward until a new-line or until n have been received; the new-line -\ is taken but not stored. A zero is added after the text, so the buffer -\ must hold n + 1 bytes. No action for n <= 0. SPAN is how many characters -\ were stored (SPAN is not FORTH-79; v3 has it). A line longer than n leaves -\ the rest, its new-line included, to be read next. -\ It is what the prompt reads every line with, with whatever the user has left -\ on the stack beneath it, so it works in (P) -- (P)+0 where the next -\ character goes, (P)+1 how many more may come, (P)+2 where the first went -- -\ and has at most three cells of its own on the data stack (D-2). -header EXPECT -: EXPECT - -if NN drop drop ; \ n < 0 - NN: if ZERO - (P)+1 a! ! dup (P)+2 a! ! (P) a! ! - L: (P)+1 a! @ if END drop - KEY dup -10 + if NL drop \ c - (P) a! @ C! - (P) a! @ 1 + ! (P)+1 a! @ -1 + ! - jump L - NL: drop drop jump FIN - END: drop - FIN: 0 (P) a! @ C! - (P) a! @ (P)+2 a! @ - SPAN a! ! ; - ZERO: drop drop ; - -\ ( -- ) FORTH-79: up to 80 characters, or a line, into TIB; >IN to 0. -header QUERY -: QUERY TIB (SRC) a! ! TIB 80 EXPECT 0 >IN a! ! ; - -\ ---- WORD ------------------------------------------------------------------ -\ WORD is called from deep inside the interpreter and compiler, with whatever -\ the user has on the stacks beneath it, and the stacks are ten and nine deep -\ (D-2). So everything it works on is in (P), and it never has more than -\ three cells of its own on the data stack: -\ (P)+0 the delimiter (P)+1 the length of the text in TIB -\ (P)+2 the word's length (P)+3 how much of it is still to be copied -\ (P)+6 where it is in TIB (P)+7 where the word starts -\ (CONVERT and NUMBER use (P)+2 .. (P)+5; they and WORD never run inside -\ each other.) - -\ ( -- c ) the character WORD is at. A zero reads as a blank when words -\ are being split at blanks: a block that has never been written is all -\ zeros, and so is the end of one whose lines were put there one at a time. -: (SRC@) - (P)+6 a! @ (SRC) a! @ + C@ if Z ; - Z: drop (P) a! @ -32 + if B drop 0 ; - B: drop 32 ; - -\ In line, not called: WORD may have only a few return entries to spare. -macro (LEFT) (P)+6 a! @ (P)+1 a! @ - endmacro \ ( -- d ) d < 0 while inside the text -macro (CH) (SRC@) (P) a! @ xor endmacro \ ( -- x ) x = 0 at a delimiter -macro (STEP) (P)+6 a! @ 1 + ! endmacro - -\ ( c -- baddr ) FORTH-79: characters are taken from TIB until the -\ delimiter c or the end of the text, leading delimiters ignored, and stored -\ in WBUF as a counted string. The delimiter met -- c, or a zero if the text -\ ran out -- is stored after them and is not counted. >IN is left just past -\ that delimiter. With nothing left the count is 0. The count is a byte, -\ so a word longer than 255 characters is cut to 255. -\ The three parts of WORD. The first is called and returns before anything -\ else is; the last is jumped to; so WORD's calls of C@ and C! are no deeper -\ than if it were written in one piece. -: (WORD-SET) ( c -- ) - 255 and (P) a! ! - (SRC-HOOK) a! @ if NONE push ex \ call it: ex comes back to the next word - jump HOOKED - NONE: drop - HOOKED: - SPAN a! @ -if A drop 0 A: (P)+1 a! ! - >IN a! @ -if B drop 0 B: (P)+6 a! ! ; - -: (WORD-TAKE) ( -- baddr ) - (P)+6 a! @ (P)+7 a! ! \ where it starts - SC: (LEFT) -if SCE drop (CH) if SCE drop (STEP) jump SC \ up to a delimiter - SCE: drop - (P)+6 a! @ (P)+7 a! @ - \ its length - dup -256 + -if CAP drop jump FITS CAP: drop drop 255 FITS: - dup (P)+2 a! ! (P)+3 a! ! - (P)+2 a! @ WBUF C! - \ copy it, last character first - CP: (P)+3 a! @ if COPIED -1 + dup ! \ k - dup (P)+7 a! @ + (SRC) a! @ + C@ \ k c - SWAP WBUF+1 + C! - jump CP - COPIED: drop - (LEFT) -if RANOUT - drop (P) a! @ (P)+2 a! @ WBUF+1 + C! \ the delimiter after the text - (P)+6 a! @ 1 + >IN a! ! WBUF ; - RANOUT: drop 0 (P)+2 a! @ WBUF+1 + C! - (P)+6 a! @ >IN a! ! WBUF ; - -header WORD -: WORD - (WORD-SET) - SK: (LEFT) -if SKE drop (CH) if SKS drop jump (WORD-TAKE) \ past delimiters - SKS: drop (STEP) jump SK - SKE: drop jump (WORD-TAKE) - -\ ( c -- baddr ) as WORD, but leading delimiters are not ignored: the text -\ starts at >IN, and may be empty. This is what ." needs: ." " is an -\ empty string, where WORD would step over its closing quote. -: (PARSE) (WORD-SET) jump (WORD-TAKE) - -\ ---- ENCLOSE --------------------------------------------------------------- -\ (P)+0 the delimiter, (P)+1 the string's address. -: (E?) ( i -- i k ) \ k: 0 at the end of the string, 1 at a delimiter, else 2 - dup (P)+1 a! @ + C@ if END (P) a! @ xor if DEL drop 2 ; - DEL: drop 1 ; - END: drop 0 ; -: (ESKIP) ( i -- i' ) L: (E?) -1 + if S drop ; S: drop 1 + jump L -: (ESCAN) ( i -- i' ) L: (E?) -2 + if S drop ; S: drop 1 + jump L - -\ ( baddr c -- baddr n1 n2 n3 ) in the zero-terminated string at baddr: -\ n1 the offset of the first character that is not c, n2 the offset of the -\ first c after it, n3 the offset of the first character after that run of c. -header ENCLOSE -: ENCLOSE - 255 and (P) a! ! dup (P)+1 a! ! - 0 (ESKIP) dup (ESCAN) dup (ESKIP) ; - -\ ---- CONVERT and NUMBER ---------------------------------------------------- -\ ( c -- n ) the value of the digit c, 0 .. 35, in either case; -1 if none -: (DIGIT) - dup -48 + -if GE0 drop drop -1 ; - GE0: drop dup -58 + -if GT9 drop -48 + ; - GT9: drop dup -65 + -if GEA drop drop -1 ; - GEA: drop dup -91 + -if GTZ drop -55 + ; - GTZ: drop dup -97 + -if GEa drop drop -1 ; - GEa: drop dup -123 + -if GTz drop -87 + ; - GTz: drop drop -1 ; - -\ ( d1 baddr1 -- d2 baddr2 ) FORTH-79: the characters from baddr1 + 1 on are -\ taken as digits in the current BASE, each accumulated into the double after -\ it is multiplied by BASE, until one is not a digit; baddr2 is its address. -\ (P)+2 holds the digit while the double is multiplied and (P)+5 the address, -\ so nothing waits on the return stack across the calls. -header CONVERT -: CONVERT - L: 1 + dup (P)+5 a! ! C@ (DIGIT) \ lo hi n - -if DIG drop (P)+5 a! @ ; - DIG: dup (BASE) - -if BIG - drop (P)+2 a! ! \ lo hi - (BASE) UM* drop \ lo hi*base - SWAP (BASE) UM* \ hi*base plo phi - push SWAP pop + \ plo hi' - (P)+2 a! @ 0 D+ - (P)+5 a! @ jump L - BIG: drop drop (P)+5 a! @ ; - -\ ( baddr -- d flag ) the counted string at baddr as a signed double in the -\ current BASE, and -1; it may begin with a minus sign. If it is empty, is -\ only a sign, or holds anything that is not a digit: 0 0 and 0. The character after the string must not be a digit -\ (WORD puts the delimiter or a zero there); if it is, that too is reported -\ as an error. (P)+3 the address of its last character, (P)+4 the sign. -: (NUMBER?) - dup C@ if ERR2 - over + (P)+3 a! ! \ baddr - dup 1 + C@ -45 + if NEG - drop 0 (P)+4 a! ! jump GO - NEG: drop -1 (P)+4 a! ! 1 + - dup (P)+3 a! @ xor if ERR2 drop - GO: push 0 0 pop CONVERT \ lo hi baddr2 - (P)+3 a! @ 1 + xor if FINE - drop drop drop jump ERR0 - FINE: drop (P)+4 a! @ if POS drop DNEGATE -1 ; - POS: drop -1 ; - ERR2: drop drop - ERR0: 0 0 0 ; - -\ ( baddr -- d ) FORTH-79. What is not a number gives 0 and sets NODE-ERROR. -header NUMBER -: NUMBER - (NUMBER?) if BAD drop ; - BAD: drop NODE-ERROR b! 2 !b ; - -\ ---- comments (5.15) ------------------------------------------------------- -\ PAREN skips to the closing parenthesis; BACKSLASH skips the rest of the line. -header ( immediate -: PAREN 41 WORD drop ; -header \ immediate -\ In a block a line is 64 characters: skip to the start of the next. -: BACKSLASH - BLK a! @ if TERM drop >IN a! @ -64 and 64 + ! ; - TERM: drop SPAN a! @ >IN a! ! ; diff --git a/v4/capsule/log.v4 b/v4/capsule/log.v4 deleted file mode 100644 index 56f5b986..00000000 --- a/v4/capsule/log.v4 +++ /dev/null @@ -1,72 +0,0 @@ -\ log.v4 -- logging, as v3: a message has a level, and is printed if the -\ level is at or below LOG-LEVEL. -\ -\ DECOMPOSITION.md 5.25: the level constants LOG-ERROR LOG-WARN LOG-INFO -\ LOG-TEST LOG-DEBUG (0 .. 4), LOG-LEVEL! LOG-LEVEL@, LOG-ERROR" ... LOG-DEBUG" -\ and LOG-ERROR-STR ... LOG-DEBUG-STR. Part of the compiler capsule; rests -\ on core.v4, codegen.v4 and quit.v4. -\ -\ WHAT IS PRINTED is v3's line without its time of day, which a node has -\ not got: the level's colour, the level's name and a colon, the colour off, -\ the text, a new line -- -\ ESC [32m INFO: ESC [0m text -\ On the mesh a message will go to the recorder's log ring (5.25); until -\ then it goes to the console. -\ -\ Constants the loader supplies: -\ (LOG-LEVEL) word address of the variable: 2, LOG-INFO, at switch-on - -header LOG-ERROR inline : LOG-ERROR 0 ; -header LOG-WARN inline : LOG-WARN 1 ; -header LOG-INFO inline : LOG-INFO 2 ; -header LOG-TEST inline : LOG-TEST 3 ; -header LOG-DEBUG inline : LOG-DEBUG 4 ; - -header LOG-LEVEL@ -: LOG-LEVEL@ ( -- n ) (LOG-LEVEL) a! @ ; -\ ( n -- ) as v3: a level below 0 is 0, one above 4 is 4 -header LOG-LEVEL! -: LOG-LEVEL! - -if POS drop 0 jump SET - POS: dup -5 + -if BIG drop jump SET - BIG: drop drop 4 - SET: (LOG-LEVEL) a! ! ; - -\ ( baddr u level -- ) the message, if the level is at or below LOG-LEVEL -: (LOG) - dup inv (LOG-LEVEL) a! @ + 1 + -if SHOW drop drop drop drop ; \ LOG-LEVEL - level - SHOW: drop - if P0 -1 + if P1 -1 + if P2 -1 + if P3 -1 + if P4 - drop jump OUT - P0: drop $31335B1B (EMIT4) $6D (EMIT4) $4F525245 (EMIT4) $203A52 (EMIT4) $6D305B1B (EMIT4) jump OUT - P1: drop $33335B1B (EMIT4) $6D (EMIT4) $4E524157 (EMIT4) $203A (EMIT4) $6D305B1B (EMIT4) jump OUT - P2: drop $32335B1B (EMIT4) $6D (EMIT4) $4F464E49 (EMIT4) $203A (EMIT4) $6D305B1B (EMIT4) jump OUT - P3: drop $35335B1B (EMIT4) $6D (EMIT4) $54534554 (EMIT4) $203A (EMIT4) $6D305B1B (EMIT4) jump OUT - P4: drop $34335B1B (EMIT4) $6D (EMIT4) $55424544 (EMIT4) $203A47 (EMIT4) $6D305B1B (EMIT4) jump OUT - OUT: TYPE jump CR - -header LOG-ERROR-STR : LOG-ERROR-STR ( baddr u -- ) 0 jump (LOG) -header LOG-WARN-STR : LOG-WARN-STR ( baddr u -- ) 1 jump (LOG) -header LOG-INFO-STR : LOG-INFO-STR ( baddr u -- ) 2 jump (LOG) -header LOG-TEST-STR : LOG-TEST-STR ( baddr u -- ) 3 jump (LOG) -header LOG-DEBUG-STR : LOG-DEBUG-STR ( baddr u -- ) 4 jump (LOG) - -\ ( level -- ) the run time of LOG-xxx" : the text is after the call, as -\ for ." ; log it at that level and go on after it. -header (LOG") compile-only -: (LOG") - pop 4* dup C@ over + 4/ 1 + push \ level baddr R: the cell after the text - COUNT ROT jump (LOG) - -\ ( level -- ) LOG-xxx" text" logs the text -- now, if interpreting; when -\ the word it is compiled into runs, if compiling. (Q)+3 holds the level. -: (LOG-QUOTE) - (Q)+3 a! ! 34 (PARSE) drop - STATE a! @ if NOW - drop (Q)+3 a! @ (LIT,) &(LOG") (CALL,) jump (STRING,) - NOW: drop WBUF COUNT (Q)+3 a! @ jump (LOG) -header LOG-ERROR" immediate : LOG-ERROR-QUOTE 0 jump (LOG-QUOTE) -header LOG-WARN" immediate : LOG-WARN-QUOTE 1 jump (LOG-QUOTE) -header LOG-INFO" immediate : LOG-INFO-QUOTE 2 jump (LOG-QUOTE) -header LOG-TEST" immediate : LOG-TEST-QUOTE 3 jump (LOG-QUOTE) -header LOG-DEBUG" immediate : LOG-DEBUG-QUOTE 4 jump (LOG-QUOTE) diff --git a/v4/capsule/numout.v4 b/v4/capsule/numout.v4 deleted file mode 100644 index e6958023..00000000 --- a/v4/capsule/numout.v4 +++ /dev/null @@ -1,153 +0,0 @@ -\ numout.v4 -- printing numbers: pictured output, the . words, and .S -\ -\ DECOMPOSITION.md 5.8: <# # #S HOLD SIGN #> . .R U. U.R D. D.R ? SPACES -\ DECIMAL HEX OCTAL, each the definition given there and executed on the mesh -\ node by test_pictured.c, test_numout.c and test_printing.c; and .S, which -\ D-16 makes possible again. Part of the compiler capsule. Rests on core.v4 -\ and forth.v4. -\ -\ Constants the loader supplies: -\ HEND byte address just past the hold buffer, which is 64 bytes -\ -HFLOOR minus the lowest address HOLD may store at: -(HEND - 62) -\ HLD word address of the variable: where the picture has got to -\ (W) word address of three cells of scratch for this file: -\ (W)+0 the width a number is to be printed in -\ (W)+1 whether a blank follows it (W)+2 .S's count - -macro (-ROT) SWAP push SWAP pop endmacro - -\ ---- unsigned division (section 4) ---- -\ One step a bit, the divisor in A. Exact for uhi < ud. -: UM/MOD ( ulo uhi ud -- urem uquot ) - a! N-1 FOR - -if L0 - 2* over -if L1 drop 1 + jump L2 - L1: drop L2: push 2* pop - jump SUB - L0: - 2* over -if L3 drop 1 + jump L4 - L3: drop L4: push 2* pop - dup a xor -if L5 - drop -if NOSUB jump SUB - L5: drop dup inv a + inv -if L6 - drop jump NOSUB - L6: push drop pop jump SETBIT - SUB: inv a + inv - SETBIT: push 1 + pop - NOSUB: - NEXT - over push push drop pop pop ; - -\ ---- pictured output ---- -header <# -: <# ( -- ) HEND HLD b! !b ; -header HOLD -: HOLD ( c -- ) - dup -256 and if OKC drop drop NODE-ERROR b! 4 !b ; \ not a character - OKC: drop HLD b! @b -HFLOOR + -if ROOM - drop drop NODE-ERROR b! 3 !b ; \ the buffer is full - ROOM: drop HLD b! @b -1 + dup !b jump C! -header SIGN -: SIGN ( n -- ) -if L1 drop 45 jump HOLD L1: drop ; -header # -: # ( ud1 -- ud2 ) - 0 (BASE) UM/MOD (-ROT) \ qhi lo rem1 - (BASE) UM/MOD (-ROT) \ qlo qhi rem - dup -10 + -if L1 drop 48 + jump L2 L1: drop 55 + L2: jump HOLD -header #S -: #S ( ud -- 0 0 ) L: # over over OR if L1 drop jump L L1: drop ; -header #> -: #> ( ud -- baddr u ) drop drop HLD b! @b HEND over push inv pop + inv ; - -\ ---- spaces and the number base ---- -header SPACES -: SPACES ( n -- ) -if L drop ; L: if DONE SPACE -1 + jump L DONE: drop ; -header DECIMAL -: DECIMAL 10 BASE a! ! ; -header HEX -: HEX 16 BASE a! ! ; -header OCTAL -: OCTAL 8 BASE a! ! ; - -\ ---- numbers ---- -\ One picture for signed singles, one for unsigned, one for doubles. Each -\ plain word is its .R word with a width of 0 and the blank flag set, and all -\ six share one tail, which prints the blank only when the flag is set. - -\ ( baddr u -- ) right-justified in the width, then the blank if wanted -: (.TAIL) - (W) b! @b -if POS drop jump OUT \ width < 0 - POS: over - SPACES \ width - u spaces - OUT: TYPE (W)+1 b! @b if DONE drop jump SPACE - DONE: drop ; -: (.BODY) ( n width -- ) - (W) b! !b dup push -if A inv 1 + A: 0 <# #S pop SIGN #> jump (.TAIL) -: (U.BODY) ( u width -- ) - (W) b! !b 0 <# #S #> jump (.TAIL) -: (D.BODY) ( d width -- ) - (W) b! !b dup push -if A DNEGATE A: <# #S pop SIGN #> jump (.TAIL) - -header .R -: DOT-R ( n width -- ) 0 (W)+1 b! !b jump (.BODY) -header . -: DOT ( n -- ) -1 (W)+1 b! !b 0 jump (.BODY) -header U.R -: U-DOT-R ( u width -- ) 0 (W)+1 b! !b jump (U.BODY) -header U. -: U-DOT ( u -- ) -1 (W)+1 b! !b 0 jump (U.BODY) -header D.R -: D-DOT-R ( d width -- ) 0 (W)+1 b! !b jump (D.BODY) -header D. -: D-DOT ( d -- ) -1 (W)+1 b! !b 0 jump (D.BODY) - -\ ( addr -- ) print what the cell holds -header ? -: QUESTION a! @ jump DOT - -\ ( -- ) as v3: the depth between < and >, then every value on the stack, -\ the deepest first, each followed by a blank; then a new line. The stack is -\ left as it was. It reads each value with PICK, so it needs a few cells of -\ the stack free to work in. -header .S -: DOT-S - 60 EMIT DEPTH 0 U-DOT-R 62 EMIT SPACE - DEPTH (W)+2 b! !b - L: (W)+2 b! @b if DONE - PICK DOT - (W)+2 b! @b -1 + !b jump L - DONE: drop jump CR - -\ ---- DUMP ---- -\ ( baddr u -- ) u bytes from the byte address baddr, sixteen to a line: the -\ address, the bytes in hex, and the bytes as characters between bars. -\ Everything it keeps between words is in (DP): the saved BASE, the address, -\ the count and the column. ADDR-DIGITS is two for each byte of a cell. -: (DB) ( -- c ) (DP)+1 b! @b (DP)+3 b! @b + jump C@ -header DUMP -: DUMP - -if OK drop drop NODE-ERROR b! 1 !b ; - OK: (DP)+2 b! !b (DP)+1 b! !b - BASE b! @b (DP) b! !b 16 BASE b! !b - LINE: (DP)+2 b! @b if DONE drop - (DP)+1 b! @b 0 <# ADDR-DIGITS (DP)+3 b! !b - AD: # (DP)+3 b! @b -1 + dup !b if ADX drop jump AD - ADX: drop #> TYPE 58 EMIT SPACE - 0 (DP)+3 b! !b - HX: (DP)+2 b! @b (DP)+3 b! @b inv + -if HAVE - drop SPACE SPACE SPACE jump HN - HAVE: drop (DB) 0 <# # # #> TYPE SPACE - HN: (DP)+3 b! @b 1 + dup !b -16 + -if HXX drop jump HX - HXX: drop SPACE 124 EMIT - 0 (DP)+3 b! !b - CH: (DP)+2 b! @b (DP)+3 b! @b inv + -if HAVC jump CHX - HAVC: drop (DB) - dup -32 + -if GE drop drop 46 jump EM - GE: drop dup -127 + -if BIG drop jump EM - BIG: drop drop 46 - EM: EMIT - (DP)+3 b! @b 1 + dup !b -16 + -if CHX drop jump CH - CHX: drop 124 EMIT CR - (DP)+1 b! @b 16 + !b - (DP)+2 b! @b -16 + -if MORE jump DONE - MORE: !b jump LINE - DONE: drop (DP) b! @b BASE b! !b ; diff --git a/v4/capsule/qmath.v4 b/v4/capsule/qmath.v4 deleted file mode 100644 index 5267e29b..00000000 --- a/v4/capsule/qmath.v4 +++ /dev/null @@ -1,247 +0,0 @@ -\ qmath.v4 -- Q48.16 fixed point: a signed double with sixteen bits of -\ fraction (D-8, D-10). -\ -\ DECOMPOSITION.md 5.26. Each word is the definition given there and -\ executed on the mesh node by test_foundation.c and test_printing.c, here in -\ the host node's vocabulary. Rests on core.v4, forth.v4, numout.v4 and -\ words.v4. -\ -\ ERRORS. Q./ by zero, and Q.SQRT and Q.LOG outside their domain, leave the -\ result D-11 and D-12 give and then raise an error (D-18): codes 11, -\ "Division by zero", and 12, "Argument out of range". -\ -\ Constants the loader supplies: -\ MSB MAXHI the high cells of Q min and Q max -\ HIMASK every bit but the top sixteen -\ 2N+15 N-18 N-17 loop counts, N the cell width in bits -\ (Q/) (QE) (QR) (QL) (QT) (QP) word addresses of the words' scratch -\ cells: 5, 8, 5, 7, 6 and 4 of them - -\ the logical double shift right: one +* step with S = 0, the top bit cleared -macro (UD2/) push a! 0 pop +* MAXHI and push drop a pop endmacro - -: (QERR11) NODE-ERROR b! 11 !b ; -: (QERR12) NODE-ERROR b! 12 !b ; - -\ ---- conversion and constants ---- -header Q.FROM-INT -: Q.FROM-INT ( n -- q ) push 0 a! 0 pop N-17 FOR +* UNEXT push drop a pop ; -header Q.TO-INT -: Q.TO-INT ( q -- n ) push a! 0 pop 15 FOR +* UNEXT drop drop a ; -header Q.1 inline : Q.1 65536 0 ; -header Q.0 inline : Q.0 0 0 ; -header Q.SCALE inline : Q.SCALE 65536 0 ; - -\ ---- the double words under other names ---- -header Q.+ : Q.+ jump D+ -header Q.- : Q.- jump D- -header Q.ABS : Q.ABS jump DABS -header Q.NEG : Q.NEG jump DNEGATE -header Q.= : Q.= jump D= -header Q.< : Q.< jump D< -header Q.> : Q.> 2SWAP jump D< -header Q.0= : Q.0= jump D0= -header Q.MAX : Q.MAX jump DMAX -header Q.MIN : Q.MIN jump DMIN - -\ ---- multiply ---- -header Q.* -: Q.* ( a b -- c ) - SWAP push over over UM* drop - push push over pop - -if L1 SWAP jump L2 L1: SWAP drop 0 L2: - pop SWAP - push - push over pop UM* pop + - ROT pop dup push - over -if L3 drop dup jump L4 L3: drop 0 L4: - push UM* pop - D+ - ROT pop UM* - SWAP push 0 D+ pop - push over pop SWAP Q.TO-INT push Q.TO-INT pop SWAP ; - -\ ---- divide ---- -: D2*C ( lo hi cin -- lo' hi' cout ) - a! dup -if L1 drop 1 jump L2 L1: drop 0 L2: push - over -if L3 drop 1 jump L4 L3: drop 0 L4: - over + + - push 2* a + pop pop ; - -: (UQ/) ( a0 a1 b0 b1 -- q0 q1 ) - (Q/)+2 a! SWAP !+ ! (Q/) a! SWAP !+ ! 0 0 0 - 2N+15 FOR - push (Q/) a! @+ @ pop D2*C - push (Q/)+1 a! ! (Q/) a! ! pop D2*C - if CMP drop jump TAKE - CMP: drop (Q/)+3 b! @b - over over xor if EQH -if SAMEH - drop drop -if NT1 jump TAKE NT1: jump NOTAKE - SAMEH: drop over SWAP push inv pop + inv - -if T2 drop jump NOTAKE T2: drop jump TAKE - EQH: drop drop over (Q/)+2 b! @b - over over xor -if SAMEL - drop drop -if NT3 drop jump TAKEL NT3: drop jump NOTAKEL - SAMEL: drop push inv pop + inv - -if T4 drop jump NOTAKEL T4: drop jump TAKEL - TAKEL: drop (Q/)+2 b! @b push inv pop + inv 0 1 jump END - NOTAKEL: 0 jump END - TAKE: push (Q/)+2 b! @b over over push inv pop + inv push - over over xor -if SB drop NIP -if NB drop 1 jump BD NB: drop 0 jump BD - SB: drop push inv pop + inv -if NB2 drop 1 jump BD NB2: drop 0 - BD: pop pop (Q/)+3 b! @b push inv pop + inv - push SWAP pop SWAP - 1 jump END - NOTAKE: 0 - END: - NEXT - push (Q/) a! @+ @ pop D2*C drop push push drop drop pop pop ; - -header Q./ -: Q./ ( a b -- q ) - over over OR if ZERO drop - push over pop SWAP over xor (Q/)+4 b! !b - -if L1 DNEGATE L1: push push -if L2 DNEGATE L2: pop pop - dup if CHK drop jump DIV - CHK: drop over -131072 and if CHK2 drop jump DIV - CHK2: drop push push dup pop dup push N-18 FOR 2* UNEXT - over over xor -if SAME drop drop -if NOOV jump OV - SAME: drop push inv pop + inv -if OV - NOOV: drop pop pop jump DIV - OV: drop drop drop pop pop drop drop - (Q/)+4 b! @b -if OVP drop 0 MSB ; OVP: drop -1 MAXHI ; - DIV: (UQ/) (Q/)+4 b! @b -if L3 drop DNEGATE ; L3: drop ; - ZERO: drop drop drop - over over OR if Z0 drop -if ZP drop drop 0 MSB jump (QERR11) - ZP: drop drop -1 MAXHI jump (QERR11) - Z0: drop jump (QERR11) - -\ ---- e to the x ---- -header Q.EXP -: Q.EXP ( q -- e ) - over over OR if ONE drop - dup (QE)+6 b! !b -if L1 DNEGATE L1: - over over -1048576 -1 D+ push drop pop -if BIG drop - over over (QE)+2 a! SWAP !+ ! over over (QE) a! SWAP !+ ! - 65536 0 D+ (QE)+4 a! SWAP !+ ! - 2 (QE)+7 b! !b - LOOP: - (QE)+2 a! @+ @ (QE) a! @+ @ Q.* - (QE)+7 b! @b Q.FROM-INT Q./ - over over (QE)+2 a! SWAP !+ ! - (QE)+4 a! @+ @ D+ (QE)+4 a! SWAP !+ ! - (QE)+2 a! @+ @ if HI0 drop drop jump CONT - HI0: drop -if SM drop jump CONT - SM: -50 + -if CONT1 drop jump DONE - CONT1: drop - CONT: (QE)+7 b! @b 1 + dup !b -11 + -if DONE1 drop jump LOOP - DONE1: drop - DONE: (QE)+4 a! @+ @ (QE)+6 b! @b -if POS drop 65536 0 2SWAP jump Q./ - POS: drop ; - BIG: drop drop drop (QE)+6 b! @b -if BIGP drop 0 0 ; BIGP: drop -1 MAXHI ; - ONE: drop drop drop 65536 0 ; - -\ ---- square root ---- -header Q.SQRT -: Q.SQRT ( q -- r ) - dup -if POS drop drop drop 0 0 jump (QERR12) - POS: drop over over OR if ZERO drop - over 65536 xor over OR if ONE drop - over over (QR) a! SWAP !+ ! (UD2/) 16384 0 D+ (QR)+2 a! SWAP !+ ! - 8 (QR)+4 b! !b - LOOP: (QR) a! @+ @ (QR)+2 a! @+ @ Q./ (QR)+2 a! @+ @ D+ (UD2/) - over over (QR)+2 a! @+ @ DNEGATE D+ -if L1 DNEGATE L1: - if HI0 drop drop jump NXT - HI0: drop -if SM drop jump NXT - SM: -10 + -if NXT1 drop drop drop (QR)+2 a! @+ @ ; - NXT1: drop - NXT: (QR)+2 a! SWAP !+ ! - (QR)+4 b! @b -1 + dup !b if DONE drop jump LOOP - DONE: drop (QR)+2 a! @+ @ ; - ZERO: drop ; - ONE: drop ; - -\ ---- natural logarithm ---- -header Q.LOG -: Q.LOG ( x -- ln x ) - dup -if POS drop jump ERR - POS: drop over over OR if ZERO drop 0 (QL)+2 b! !b - DOWN: dup if CHKLO drop jump SHR - CHKLO: drop over -131072 and if DOWNDONE drop - SHR: (UD2/) (QL)+2 b! @b 1 + !b jump DOWN - DOWNDONE: drop drop - UP: dup -65536 and if UPSHIFT drop jump NORM - UPSHIFT: drop 2* (QL)+2 b! @b -1 + !b jump UP - NORM: dup (QL) b! !b -65536 + (QL)+1 b! !b 6 (QL)+3 b! !b - NEWTON: (QL)+1 b! @b dup (QL)+4 b! !b 65536 + (QL)+5 b! !b - 131072 (QL)+6 b! !b - EXPL: (QL)+4 b! @b 0 (QL)+1 b! @b 0 Q.* drop - 0 (QL)+6 b! @b 0 Q./ drop dup (QL)+4 b! !b - dup (QL)+5 b! @b + !b - -50 + -if EXPC drop jump EXPD - EXPC: drop (QL)+6 b! @b 65536 + dup !b -720896 + -if EXPD2 drop jump EXPL - EXPD2: drop - EXPD: (QL) b! @b (QL)+5 b! @b push inv pop + inv - dup (QL)+4 b! !b - if DZ -if DPOS - inv 1 + 0 (QL)+5 b! @b 0 Q./ drop - (QL)+1 b! @b SWAP push inv pop + inv -if KEEP drop 0 KEEP: (QL)+1 b! !b - jump TEST - DPOS: 0 (QL)+5 b! @b 0 Q./ drop (QL)+1 b! @b + !b jump TEST - DZ: drop - TEST: (QL)+4 b! @b -if AP inv 1 + AP: -100 + -if CONT drop jump FIN - CONT: drop (QL)+3 b! @b -1 + dup !b if FIN0 drop jump NEWTON - FIN0: drop - FIN: (QL)+1 b! @b (QL)+2 b! @b - -if KP inv 1 + 45426 UM* drop inv 1 + jump KS KP: 45426 UM* drop - KS: + dup -if SP drop -1 ; SP: drop 0 ; - ZERO: drop - ERR: drop drop 0 0 jump (QERR12) - -\ ---- sine and cosine ---- -: (Q.REDUCE) ( x -- r ) - dup (QT) b! !b -if L1 DNEGATE L1: - 0 411774 UM/MOD drop 411774 UM/MOD drop - (QT) b! @b -if P1 drop inv 1 + jump J1 P1: drop J1: - dup -205888 + -if BIG drop - dup 205887 + -if OK drop 411774 + ; - OK: drop ; - BIG: drop -411774 + ; - -\ The Taylor loop both use; each sets (QT) up and jumps here. -: (TRIG) - T: (QT)+2 b! @b 0 (QT)+1 b! @b 0 Q.* drop - 0 (QT)+4 b! @b dup -1 + UM* drop 65536 UM* drop 0 Q./ drop - dup (QT)+2 b! !b - (QT)+5 b! @b if ADDT drop inv 1 + jump ACC ADDT: drop - ACC: (QT)+3 b! @b + !b (QT)+5 b! @b inv !b - (QT)+2 b! @b -10 + -if CONT drop jump END - CONT: drop (QT)+4 b! @b 2 + dup !b -12 + -if END2 drop jump T - END2: drop - END: (QT)+3 b! @b (QT) b! @b -if PR drop inv 1 + jump SD PR: drop - SD: dup -if SP drop -1 ; SP: drop 0 ; - -header Q.SIN -: Q.SIN ( x -- sin x ) - (Q.REDUCE) dup (QT) b! !b -if A1 inv 1 + A1: - dup (QT)+2 b! !b dup (QT)+3 b! !b - 0 over 0 Q.* drop (QT)+1 b! !b - 3 (QT)+4 b! !b -1 (QT)+5 b! !b jump (TRIG) -header Q.COS -: Q.COS ( x -- cos x ) - (Q.REDUCE) -if A1 inv 1 + A1: - 0 (QT) b! !b 0 over 0 Q.* drop (QT)+1 b! !b - 65536 (QT)+2 b! !b 65536 (QT)+3 b! !b - 2 (QT)+4 b! !b -1 (QT)+5 b! !b jump (TRIG) - -\ ---- printing ---- -\ The integer part, a point, five digits, a blank; always in decimal. -header Q.PRINT -: Q.PRINT ( q -- ) - dup (QP)+3 b! !b -if A DNEGATE A: (QP)+2 b! !b dup (QP)+1 b! !b - BASE b! @b (QP) b! !b 10 BASE b! !b - 65535 and 4 FOR dup 2* 2* + UNEXT 10 FOR 2/ UNEXT - 0 <# # # # # # drop drop 46 HOLD - (QP)+1 b! @b (QP)+2 b! @b dup push - push a! 0 pop 15 FOR +* UNEXT drop drop a - pop 15 FOR 2/ UNEXT HIMASK and - #S (QP)+3 b! @b SIGN #> - (QP) b! @b BASE b! !b - TYPE jump SPACE diff --git a/v4/capsule/quit.v4 b/v4/capsule/quit.v4 deleted file mode 100644 index 3760e124..00000000 --- a/v4/capsule/quit.v4 +++ /dev/null @@ -1,585 +0,0 @@ -\ quit.v4 -- a line of text, interpreted; how it ends; and the words that -\ print text written in the source. -\ -\ DECOMPOSITION.md 5.15 and 5.10: QUIT ABORT ABORT" (ABORT") ." (."). Part of -\ the compiler capsule. Rests on all the files before it. -\ -\ A NODE IS SENT TEXT (docs/v4.0.0/MESH.md section 6). It does not read its -\ own command line and prints no prompt. A node with nothing to do sleeps; -\ a message comes to one of its wires; if that is text for this node it is -\ taken and interpreted; what it printed goes back as a message, and then -\ a message saying how the text ended: -\ 1 it completed a console says " ok" -\ 2 it ended in an error the message is already printed; " ERROR" -\ 0 QUIT nothing is said -\ What a console then shows is v3's: -\ ok> 65 EMIT the console's prompt, and the line -\ A ok what the line printed, then " ok" -\ ok> NOSUCH -\ UNKNOWN WORD: 'NOSUCH' -\ ERROR -\ ok> -1 @ -\ Address out of range an address fault (D-14), from any depth -\ ERROR -\ KEY, EXPECT and QUERY are FORTH-79 words that read characters, as before; -\ they are not how text reaches the node. They still read the console's -\ registers, CONSOLE-RX and CONSOLE-STATUS, and not a message. -\ -\ THE STACKS are guarded (D-16): each counts what it holds, and a push onto -\ a full one or a pop from an empty one is a fault. So QUIT and ABORT, which -\ never return to whatever ran them, must empty the return stack, and ABORT -\ the data stack too. A store to RSTACK-DEPTH or DSTACK-DEPTH does that. -\ -\ Constants the loader supplies: -\ (LINE-STATUS) word address of the variable: how the last text ended -\ (MSG) (REPLY) (ME) (OUT) (OUT^) see core.v4, "what a node prints" -\ (PORT) word address of the node's port 0 -\ (Q) word address of four cells of scratch, which system.v4 and -\ blocks.v4 use too -\ DSTACK-DEPTH RSTACK-DEPTH word addresses of the stack registers - -\ ( -- ) empty the return stack. `a` is only something to store: any -\ store to the register empties the stack, and `a` needs nothing to be on -\ the data stack. One cell of the data stack is used for a moment. -macro R-CLEAR RSTACK-DEPTH b! a !b endmacro - -\ ( -- ) stop compiling; forget the word being built and any open control -\ structures. A definition that was under way stays hidden. -: (RESET) 0 STATE a! ! (CG-RESET) CFBASE (CFP) a! ! ; - -\ ( s -- ) the text is done with. What it printed is sent, then a message -\ saying how it ended -- 0 QUIT, 1 completed, 2 an error -- and the node waits -\ for the next. (DONE) is entered with the same number and, for an error, -\ stops compiling first; it is always jumped to, never called, by -\ something that has emptied the return stack (or by a fault, which empties -\ it). (LINE-STATUS) keeps how the last text ended, and is the one word of -\ the message's text. -\ THE ANSWER IS NOT REFUSED HERE: the text was not begun until the wire it -\ goes by had room for it, and that room has been kept, (KEEP), which is -\ let go only now (MESH.md 7d.4). If no one is on that port any more it -\ is counted in (LOST). -\ FOUR CELLS OF THE DATA STACK are tried first: what a node does between -\ texts -- this, passing messages on, taking the next text in -- and the -\ interpreter need that many, so text may leave 28 values on a stack of 32 -\ and no more. Text that leaves more ends here, "Stack overflow", with -\ the stack emptied, and not later, in the middle of the text after it. -: (FINISH) ( s -- ) - 1 (QUIET) a! ! \ from here nothing is this text's doing - (LINE-STATUS) b! !b - 0 0 0 0 drop drop drop drop - (FLUSH-OUT) - -1 (KEEP) a! ! - (MSG)+1 a! @ 3 (HDR) 4 (OUT-HDR)+6 a! ! \ to whoever sent the text: type 3, four characters - (LINE-STATUS) (DONE-PORT) a! @ (PUT-ON) if SENT - drop (LOST) a! @ 1 + ! jump (IDLE) - SENT: drop jump (IDLE) - -: (DONE) - if GO -1 + if OK - drop (RESET) 2 jump (FINISH) - OK: drop 1 jump (FINISH) - GO: drop 0 jump (FINISH) - -\ ( -- flag ) A GONE has been taken: its seven words are in (IN), the -\ node it is about in (ONE), and (S-WIRE) is the wire it came by. It is -\ believed only if it came by the port that leads to this node's centre -\ and says it is from the centre (MESH.md 7b.4): the way to the node is -\ then forgotten, and the flag is -1. Otherwise nothing is done, and 0. -\ (As first built only what it said it was from was looked at, and one -\ that came by another port was believed.) -: (GONE?) - (CENTRE) if NOT (IN)+1 a! @ xor if FROM drop 0 ; - NOT: ; - FROM: drop (ROUTE-DEFAULT) a! @ (PORT) - (S-WIRE) a! @ xor if YES drop 0 ; - YES: drop (ONE) a! @ NO-ROUTE -1 ; - -\ ( -- ) WAITING (MESH.md 7d.4). A node with nothing to do passes on -\ what has come for other nodes, (SERVE), and then goes through what has -\ come for itself, the lowest port first and each wire from its front: -\ text is taken, into TIB, and done: (LINE), and then (FINISH) says -\ how it ended. But not unless the wire its answer goes by -- -\ the way to whoever sent it; with none known, or no one on -\ that port, the wire it came on -- has room for the answer, -\ 8 cells. If it has not, the text stays on its wire and the -\ node looks further: there may be several such, on wires -\ whose answers go different ways, and each is begun when -\ its own has the room. That room is kept from then until -\ the answer has gone. -\ TEXTS WHOSE ANSWERS GO THE SAME WAY ARE BEGUN IN THE ORDER -\ THEY CAME. Once one has been left for want of room, every -\ text behind it on this pass whose answer goes by that port -\ is left too, though the room has come since: (D-MASK) has -\ a bit for each such port. (As first built only the room -\ was asked, each time; room that came between the look at -\ one text and at the next began the second first. Found -\ by the final review of step 6e.) -\ a NACK is taken and counted in (REFUSED) -\ a GONE is taken, and believed if this node's centre sent it -\ an answer no one is waiting for is dropped: a SEND that is not waited -\ on is ordinary use, and its answer is not a loss. -\ any other is dropped, and counted in (LOST): what a node printed -\ that came here, a type there is none of, or a NACK or GONE -\ that is not as long as one is. (LOST) counts what should -\ have been delivered or acted on and was not. -\ A TAKE THAT DOES NOT TAKE -- the wire was cut after the message was -\ looked at -- leaves nothing to act on: no text is done and nothing is -\ believed for it, (UNTAKEN). The same for a drop that does not drop. -\ With nothing to begin it sleeps, executing nothing, until a message -\ comes; or, if text is waiting for room for its answer, or (SERVE) left a -\ message for want of room, until there is room on any wire that leads -\ from it or a message comes. Then it does all of this again. -\ It has fetched which wires have a message before it looks at any, and -\ sleeps after: a message that comes while it looks wakes it at once, and -\ one it left on a wire does not keep it awake (MESH.md 7d.3). -\ (KEEP) and (AWAIT-FROM) are put back here every time: whatever was -\ abandoned on the way, a node with nothing to do keeps no room and waits -\ for no one. -: (IDLE) - L: 1 (QUIET) a! ! \ nothing here is any text's doing: see (RAISED) - -1 (KEEP) a! ! 0 (AWAIT-FROM) a! ! -1 (DEFER) a! ! 0 (D-MASK) a! ! - (SERVE) (MINE0) - M: (MINE) if REST - drop (IN)+2 a! @ -1 + if TEXT -3 + if NACK -1 + if GONE - OTHER: drop 4 (DO) if LETGO drop (SKIP) jump M \ it was not there to drop: nothing is counted - LETGO: drop (IN)+2 a! @ -3 + if ANSWER \ let go. An answer no one waits for is ordinary: - drop (LOST) a! @ 1 + ! jump M \ anything else should not have come here, and is counted - ANSWER: drop jump M - NACK: drop (IN)+6 a! @ -4 + if N1 jump OTHER - N1: drop (TAKE1) if N2 drop (UNTAKEN) jump M \ not taken: nothing is done for it - N2: drop (REFUSED) a! @ 1 + ! jump M \ a message of this node's was refused: counted - GONE: drop (IN)+6 a! @ -4 + if G1 jump OTHER - G1: drop (TAKE1) if G2 drop (UNTAKEN) jump M - G2: drop (GONE?) drop jump M - TEXT: drop - (IN)+1 a! @ (WAY) -if T1 drop (S-WIRE) a! @ \ the way back; with none known, the wire it came on - T1: (DONE-PORT) a! ! - (DONE-PORT) a! @ (WBIT) (D-MASK) a! @ and if FREE1 jump FULL \ text ahead of it waits for room on that wire - FREE1: drop - 8 (DONE-PORT) a! @ (ROOM?) if START -1 + if FULL - drop (S-WIRE) a! @ (DONE-PORT) a! ! \ no one is on that port: back by the wire it came on, - (S-WIRE) a! @ (WBIT) (D-MASK) a! @ and if FREE2 jump FULL - FREE2: drop - 8 (S-WIRE) a! @ (ROOM?) -1 + if FULL jump START \ if that has the room -- or has no one on it either - FULL: drop (DONE-PORT) a! @ (WBIT) dup inv (D-MASK) a! @ and + ! - (DEFER) a! @ -if LATER drop (DONE-PORT) a! @ (DEFER) a! ! (SKIP) jump M - LATER: drop (SKIP) jump M - REST: drop - (DEFER) a! @ -if ROOM drop (SLEEP) jump L - ROOM: (WIRE!) 8 (WIRE-A) b! !b 9 (DO) drop jump L - START: drop - (S-WIRE) a! @ dup (REPLY) a! ! (WIRE!) - (MSG) (WIRE-A) b! !b TIB 2/ 2/ (WIRE-B) b! !b 2 (DO) \ its seven words, and its text - if TAKEN drop (UNTAKEN) jump M \ not taken: the wire was cut since it was looked at - TAKEN: drop - 0 (MSG)+6 a! @ TIB + C! \ a zero after the text - (MSG)+6 a! @ SPAN a! ! - (DONE-PORT) a! @ (KEEP) a! ! \ the room for its answer is kept from here - (CONSOLE) a! @ if P0 jump P1 \ where what it prints goes: the console, - P0: drop (MSG)+1 a! @ \ or whoever sent it; - P1: dup (PRINT-TO) a! ! - (WAY) -if Q1 drop (REPLY) a! @ \ by the way there, or the wire the text came on - Q1: (PRINT-PORT) a! ! - jump (LINE) - -\ ( -- ) THE TEXT, INTERPRETED. It is in TIB with a zero after it and its -\ length in SPAN, and the return stack is empty. It is interpreted with one -\ return entry under it, this word's call of INTERPRET; whatever is on the -\ data stack stays there. -: (LINE) - 0 (QUIET) a! ! \ an error from here on is this text's - 0 BLK a! ! \ the terminal, whatever was being loaded - TIB (SRC) a! ! 0 >IN a! ! - 0 NODE-ERROR b! !b - INTERPRET - NODE-ERROR b! @b if GOOD - drop 2 jump (DONE) - GOOD: drop 1 jump (DONE) - -\ ---- the node among others (MESH.md sections 6 and 7) --------------------------- -\ Not FORTH-79 and not in v3: v3's VMs are sent to through the kernel. - -\ ( node port -- ) the port, by its number, leads toward that node -header ROUTE -: ROUTE - (ROUTE#) a! @ -16 + if FULL drop - (PORT) + (ROUTE#) a! @ 2* (ROUTES) + a! - push !+ pop !+ - (ROUTE#) a! @ 1 + ! ; - FULL: drop drop drop NODE-ERROR b! 12 !b ; - -\ ( node port -- ) the node on the other end of the port, by its number; -\ 0: none, or a device. Whoever wires the node tells it, and tells it again -\ when the wiring changes. It is how a node knows who its centre is, the -\ one node whose GONE it believes: (CENTRE). -header NEIGHBOUR -: NEIGHBOUR - dup -if POS jump BAD - POS: -PORTS + -if BAD drop (NEAR) + a! ! ; - BAD: drop drop drop NODE-ERROR b! 12 !b ; - -\ ( port -- ) the port, by its number, leads toward every node not told of -header DEFAULT-ROUTE -: DEFAULT-ROUTE (PORT) + (ROUTE-DEFAULT) a! ! ; - -\ ( node -- ) forget the way to that node, if one is known: what is for it -\ then goes by the way for every node not told of, if there is one. The -\ last way in the table takes its place. -header NO-ROUTE -: NO-ROUTE - (ROUTE#) a! @ if NONE -1 + (ROUTES) a! - FOR dup @+ xor if HIT drop @+ drop NEXT - drop ; - NONE: drop drop ; - HIT: drop drop pop drop - a -1 + push \ where its entry is - (ROUTE#) a! @ -1 + dup ! \ one way fewer - 2* (ROUTES) + a! @+ @ \ the last entry: node port - pop a! SWAP !+ ! ; - -\ ( about node type -- ) send the node a message of one word, `about`: -\ a GONE is type 5 (MESH.md 7b). With no way to the node it is error 12. -\ It goes or is refused at once; refused -- no one on the port, or no room -\ on the wire -- it is counted in (LOST) (MESH.md 7d.4). -: (SEND1) - push dup (WAY) -if GO - drop drop drop pop drop NODE-ERROR b! 12 !b ; - GO: (W-PORT) a! ! SWAP (ONE) a! ! - pop (HDR) 4 (OUT-HDR)+6 a! ! - (ONE) (W-PORT) a! @ (PUT-ON) if SENT - drop (LOST) a! @ 1 + ! ; - SENT: drop ; - -\ ( n node -- ) tell the node that node n is gone. It acts on that only -\ if this node is its centre: it forgets the way to n, and if it is waiting -\ for n's answer the wait ends. -header GONE -: GONE 5 jump (SEND1) - -\ ( -- ) forget every way: for when the wiring has changed -header NO-ROUTES -: NO-ROUTES 0 (ROUTE#) a! ! 0 (ROUTE-DEFAULT) a! ! ; - -\ ( baddr u node port -- ) send the node u characters of text to -\ interpret, by the port given, by its number. The text is made ready in -\ (SEND-TEXT), four characters to a word, the message is put on the wire -\ whole, and it is on its way when this returns. IT GOES OR IS REFUSED AT -\ ONCE (MESH.md 7d.1, ruling 3): with no room on the wire it is counted in -\ (REFUSED), as a refusal that came back would be, and is error 19, Message -\ refused; with no one on the port, error 18. Nothing is on a -\ wire until the put, the last thing done. More characters than a message -\ carries, or fewer than none, is error 12. What lies after the text in -\ this node's memory does not go with it: the last word is made zero past -\ the last character. -: (SEND-ON) - push 1 (HDR) - -if POS - BAD: drop drop pop drop NODE-ERROR b! 12 !b ; - LONG: drop jump BAD - POS: dup -1025 + -if LONG - drop dup (OUT-HDR)+6 a! ! - (SEND-TEXT) (SEND^) a! ! - 3 + 2/ 2/ if NONE -1 + - FOR dup C@ over 1 + C@ 8* + over 2 + C@ 8* 8* + over 3 + C@ 8* 8* 8* + - (SEND^) b! @b a! !+ a !b 4 + NEXT - drop - (OUT-HDR)+6 a! @ 3 and if PUT \ the last word: nothing in it past the last character - (SEND^) b! @b -1 + a! - -1 + if M1 -1 + if M2 - drop @ 16777215 and ! jump PUT0 - M2: drop @ 65535 and ! jump PUT0 - M1: drop @ 255 and ! jump PUT0 - NONE: drop - PUT: drop - PUT0: (SEND-TEXT) pop (PUT-ON) - if SENT -1 + if FULL drop NODE-ERROR b! 18 !b ; - FULL: drop (REFUSED) a! @ 1 + ! NODE-ERROR b! 19 !b ; - SENT: drop ; - -\ ( baddr u node -- ) send the node u characters of text to interpret, -\ by the way this node knows to it. What it prints there goes to that -\ node's console. With no way to the node it is error 12. -header SEND -: SEND - dup (WAY) -if GO drop drop drop drop NODE-ERROR b! 12 !b ; - GO: jump (SEND-ON) - -\ ( baddr u node port -- ) the same by a port this node names, by its -\ number, whatever ways it knows: for a neighbour that has no number of -\ its own yet, to which text is sent as to node 0. -header SEND-ON -: SEND-ON - dup -if POS jump BAD - POS: -PORTS + -if BAD drop jump (SEND-ON) - BAD: drop drop drop drop drop NODE-ERROR b! 12 !b ; - -\ ( -- n ) the number of this node's centre: the node on the port that -\ leads to everything it has no other way to. 0: it has none, or has not -\ been told who is there (NEIGHBOUR). -: (CENTRE) - (ROUTE-DEFAULT) a! @ if NONE (PORT) - (NEAR) + a! @ ; - NONE: ; - -\ ( -- n ) the number of this node's console: the one it was told of, or -\ with none told of, whoever sent the text it is doing -: (A-CONSOLE) - (CONSOLE) a! @ if C0 ; - C0: drop (MSG)+1 a! @ ; - -\ ( what -- how | ) the wait is over: 1 the answer has come, and its -\ word, in (ONE), is left; 2 refused, error 19; 3 the node is gone, error -\ 20; 4 a line from the console, error 21 -: (A-END) - 0 (AWAIT-FROM) a! ! - -1 + if ANS -1 + if REF -1 + if LEFT drop NODE-ERROR b! 21 !b ; - ANS: drop (ONE) a! @ ; - REF: drop NODE-ERROR b! 19 !b ; - LEFT: drop NODE-ERROR b! 20 !b ; - -\ ( node -- how ) WAIT FOR THE NODE'S WORD OF HOW TEXT ENDED: 0 QUIT, -\ 1 completed, 2 an error. (AWAIT-FROM) holds the node while this node -\ waits, and 0 otherwise. It sleeps, executing nothing, until a message -\ comes; then it passes on what is for other nodes, (SERVE), and goes -\ through what is for itself (MESH.md 7d.4): -\ the answer -- a message of type 3 from that node -- is taken, and the -\ wait is over; -\ a NACK is taken: about that node, the wait ends in error 19, Message -\ refused; about another it is counted, as at any time; -\ a GONE is taken: believed (its centre sent it: (GONE?)) and about that -\ node, the wait ends in error 20, Node gone; -\ text from its console ends the wait in error 21, Interrupted (7b.6). -\ The text is not taken: it stays on its wire and is done when this -\ text has been finished with. It is the one way to end a wait on -\ a node that is alive and never answers, short of Hera's killing -\ that node; -\ anything else stays on its wire, in its order, for when this node has -\ nothing to do. -\ WHAT HAS COME ALREADY is on the wires and is found the first time -\ through: the node looks before it sleeps. A message it left on a wire -\ does not keep it awake. -\ The stack what it does needs is tried first, (ROOM), core.v4: text that -\ has left too little ends "Stack overflow" with nothing taken off a wire. -header AWAIT -: AWAIT - (ONE) a! ! (ROOM) \ if this faults, no one is waited for: - (ONE) a! @ (AWAIT-FROM) a! ! 0 (A-SELF) a! ! \ (AWAIT-FROM) is set only when the stack has been tried - L: (SERVE) - (A-SELF) a! @ if SCAN drop 2 jump (A-END) \ this node's own message for that node came back to it - SCAN: drop (MINE0) - M: (MINE) if SLEEP - drop (IN)+2 a! @ -1 + if TEXT -2 + if ANSWER -1 + if NACK -1 + if GONE - KEEP: drop (SKIP) jump M - TEXT: drop (A-CONSOLE) (IN)+1 a! @ xor if BREAK jump KEEP \ text: from the console? - BREAK: drop 4 jump (A-END) - ANSWER: drop (IN)+1 a! @ (AWAIT-FROM) a! @ xor if A1 jump KEEP - A1: drop (IN)+6 a! @ -4 + if A2 jump KEEP - A2: drop (TAKE1) if A3 drop (UNTAKEN) jump M \ not taken: nothing is done for it - A3: drop 1 jump (A-END) - NACK: drop (IN)+6 a! @ -4 + if N1 jump KEEP - N1: drop (TAKE1) if N0 drop (UNTAKEN) jump M - N0: drop (ONE) a! @ (AWAIT-FROM) a! @ xor if N2 \ about the node waited for? - drop (REFUSED) a! @ 1 + ! jump M \ another: counted - N2: drop 2 jump (A-END) - GONE: drop (IN)+6 a! @ -4 + if G1 jump KEEP - G1: drop (TAKE1) if G0 drop (UNTAKEN) jump M - G0: drop (GONE?) if M0 \ only its centre is believed - drop (ONE) a! @ (AWAIT-FROM) a! @ xor if G2 drop jump M - G2: drop 3 jump (A-END) - M0: drop jump M - SLEEP: drop (SLEEP) jump L - -\ ( w port -- ) write a cell to the port, by its number. It waits until -\ the neighbour has taken it. This is how a node is sent a capsule of F18 -\ code (docs/v4.0.0/MESH.md section 5): the cells go as they are, not as a -\ message, to a node that is executing from its ports. -header PORT! -: PORT! - dup -if POS jump BAD - POS: -PORTS + -if BAD drop (PORT) + b! !b ; - BAD: drop drop drop NODE-ERROR b! 12 !b ; - -\ ( -- ) WHAT IS IN THE DICTIONARY NOW IS THE SYSTEM: COLD comes back to -\ it and FORGET will not go below it. Whoever has loaded a node's capsules -\ has it do this (system.v4, (BOOT) and FENCE). -header (SEAL) -: (SEAL) - DP a! @ (BOOT) a! ! - (LATEST) a! @ (BOOT)+1 a! ! - DP a! @ 3 + 2/ 2/ FENCE a! ! ; - -\ FORTH-79: clear the return stack, set execution mode, return control to -\ the terminal; no message is given. The data stack is left as it is. -\ NODE-ERROR, by name: how a definition written in FORTH raises an error. -\ A store of a code that is not zero is the trap of D-18 -- the word goes no -\ further, the message for the code is printed (-1: the word has printed -\ its own) and the line ends with ERROR. The codes are listed in core.v4. -header NODE-ERROR inline : NODE-ERROR' NODE-ERROR ; -header (ME) inline : (ME)' (ME) ; -header (CONSOLE) inline : (CONSOLE)' (CONSOLE) ; -header (LOST) inline : (LOST)' (LOST) ; -header (REFUSED) inline : (REFUSED)' (REFUSED) ; -header (WORD-DEFINED) inline : (WORD-DEFINED)' (WORD-DEFINED) ; -header (WORD-FORGOTTEN) inline : (WORD-FORGOTTEN)' (WORD-FORGOTTEN) ; - -header QUIT -: QUIT R-CLEAR (RESET) CR 0 jump (DONE) - -\ FORTH-79: clear the data and return stacks, set execution mode, return -\ control to the terminal. As v3, the line it stops ends with " ok". -\ Both are emptied before anything is called: ABORT may be run with the -\ return stack full. -header ABORT -: ABORT R-CLEAR DSTACK-DEPTH b! a !b (RESET) 1 jump (DONE) - -\ ---- faults (D-14, D-16) ------------------------------------------------------- -\ Where the node goes when a programme uses an address outside its memory, -\ pushes onto a full stack or pops an empty one. The opcode that faulted did -\ nothing, and both stacks have been emptied. Each handler says what happened; -\ whatever was running is abandoned, as by ABORT, and the line ends with -\ ERROR. -: (FAULT) \ "Address out of range" - $72646441 (EMIT4) $20737365 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR - 2 jump (DONE) -: (D-OVER) \ "Stack overflow" - $63617453 (EMIT4) $766F206B (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR - 2 jump (DONE) -: (D-UNDER) \ "Stack underflow" - $63617453 (EMIT4) $6E75206B (EMIT4) $66726564 (EMIT4) $776F6C (EMIT4) CR - 2 jump (DONE) -: (R-OVER) \ "Return stack overflow" - $75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $65766F20 (EMIT4) $6F6C6672 (EMIT4) $77 (EMIT4) CR - 2 jump (DONE) -: (R-UNDER) \ "Return stack underflow" - $75746552 (EMIT4) $73206E72 (EMIT4) $6B636174 (EMIT4) $646E7520 (EMIT4) $6C667265 (EMIT4) $776F (EMIT4) CR - 2 jump (DONE) - -\ A word has stored an error code in NODE-ERROR (D-18; the codes are listed -\ in core.v4). Print its message -- a negative code means the word printed -\ its own -- and end the line with ERROR. The return stack has been -\ emptied; the data stack is as the word left it. -\ (QUIET) is 1 while the node is doing something that is no text's doing: -\ passing a message on, or sending what a text printed and word of how it -\ ended. An error then has nobody to be told to, and telling it would -\ begin another message for a text that is over. Nothing the nucleus does -\ there raises one as it stands -- with no one on a port it counts what it -\ could not send, and goes on -- so this is a guard: if one is raised, what -\ was being sent is let go and counted, and the node goes back to waiting. -: (RAISED) - (QUIET) a! @ if SPEAK - drop (OUT) (OUT^) a! ! (LOST) a! @ 1 + ! jump (IDLE) - SPEAK: drop - NODE-ERROR b! @b - -if POS drop 2 jump (DONE) - POS: -1 + if M1 -1 + if M2 -1 + if M3 -1 + if M4 - -1 + if M5 -1 + if M6 -1 + if M7 -1 + if M8 -1 + if M9 - -1 + if M10 -1 + if M11 -1 + if M12 -1 + if M13 -1 + if M14 - -1 + if M15 -1 + if M16 -1 + if M17 -1 + if M18 - -1 + if M19 -1 + if M20 -1 + if M21 - drop 2 jump (DONE) - M1: drop $6167654E (EMIT4) $65766974 (EMIT4) $756F6320 (EMIT4) $746E (EMIT4) CR 2 jump (DONE) - M2: drop $20746F4E (EMIT4) $756E2061 (EMIT4) $7265626D (EMIT4) CR 2 jump (DONE) - M3: drop $626D754E (EMIT4) $74207265 (EMIT4) $6C206F6F (EMIT4) $676E6F (EMIT4) CR 2 jump (DONE) - M4: drop $20746F4E (EMIT4) $68632061 (EMIT4) $63617261 (EMIT4) $726574 (EMIT4) CR 2 jump (DONE) - M5: drop $74636944 (EMIT4) $616E6F69 (EMIT4) $66207972 (EMIT4) $6C6C75 (EMIT4) CR 2 jump (DONE) - M6: drop $656D614E (EMIT4) $73696D20 (EMIT4) $676E6973 (EMIT4) CR 2 jump (DONE) - M7: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $696D2065 (EMIT4) $74616D73 (EMIT4) $6863 (EMIT4) CR 2 jump (DONE) - M8: drop $746E6F43 (EMIT4) $206C6F72 (EMIT4) $75727473 (EMIT4) $72757463 (EMIT4) $74207365 (EMIT4) $64206F6F (EMIT4) $706565 (EMIT4) CR 2 jump (DONE) - M9: drop $66696853 (EMIT4) $6F632074 (EMIT4) $20746E75 (EMIT4) $2074756F (EMIT4) $7220666F (EMIT4) $65676E61 (EMIT4) CR 2 jump (DONE) - M10: drop $746F7250 (EMIT4) $65746365 (EMIT4) $6F772064 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE) - M11: drop $69766944 (EMIT4) $6E6F6973 (EMIT4) $20796220 (EMIT4) $6F72657A (EMIT4) CR 2 jump (DONE) - M12: drop $75677241 (EMIT4) $746E656D (EMIT4) $74756F20 (EMIT4) $20666F20 (EMIT4) $676E6172 (EMIT4) $65 (EMIT4) CR 2 jump (DONE) - M13: drop $636F6C42 (EMIT4) $756F206B (EMIT4) $666F2074 (EMIT4) $6E617220 (EMIT4) $6567 (EMIT4) CR 2 jump (DONE) - M14: drop $62206F4E (EMIT4) $6B636F6C (EMIT4) $20736920 (EMIT4) $6E696562 (EMIT4) $6F6C2067 (EMIT4) $64656461 (EMIT4) CR 2 jump (DONE) - M15: drop $65666544 (EMIT4) $64657272 (EMIT4) $726F7720 (EMIT4) $6F6E2064 (EMIT4) $65732074 (EMIT4) $74 (EMIT4) CR 2 jump (DONE) - M16: drop $20746F4E (EMIT4) $6F772061 (EMIT4) $6472 (EMIT4) CR 2 jump (DONE) - M17: drop $726F7453 (EMIT4) $20656761 (EMIT4) $75666572 (EMIT4) $646573 (EMIT4) CR 2 jump (DONE) - M18: drop (OUT) (OUT^) a! ! \ what was printed and not sent cannot be sent: it is let go - $6F206F4E (EMIT4) $6F20656E (EMIT4) $6874206E (EMIT4) $70207461 (EMIT4) $74726F (EMIT4) CR 2 jump (DONE) - M19: drop $7373654D (EMIT4) $20656761 (EMIT4) $75666572 (EMIT4) $646573 (EMIT4) CR 2 jump (DONE) - M20: drop $65646F4E (EMIT4) $6E6F6720 (EMIT4) $65 (EMIT4) CR 2 jump (DONE) - M21: drop $65746E49 (EMIT4) $70757272 (EMIT4) $646574 (EMIT4) CR 2 jump (DONE) - -\ The table the loader gives the node: six words, one for each kind of -\ fault in the node's order, each a jump. A jump fills its word, so they -\ are one after another. -: (FAULTS) - jump (FAULT) jump (D-OVER) jump (D-UNDER) jump (R-OVER) jump (R-UNDER) jump (RAISED) - -\ ---- text in the source --------------------------------------------------------- -\ The three run-time words have names, as v3's have, so that SEE can tell a -\ string in a definition from code; they cannot be used from the prompt. -\ ." and ABORT" take the text up to the next " , which may be none at all -\ (input.v4's (PARSE)); with no closing " it is the rest of the line. Inside a definition they lay -\ down a call to their run-time word and, after it, the text as a counted -\ string: the count byte and the characters, four to a cell, the last cell -\ filled with zeros. The run-time word finds the string by the return -\ address the call left, and returns to the cell after the string. - -\ ( -- ) lay the counted string in WBUF into the dictionary, as above. -\ (Q)+0 how many bytes are still to go, (Q)+1 which is next. -: (STRING,) - (FLUSH) - WBUF C@ 1 + (Q) a! ! 0 (Q)+1 a! ! - L: (Q) a! @ if DONE -1 + ! - (Q)+1 a! @ dup 1 + ! WBUF + C@ C, - jump L - DONE: drop - P: DP b! @b 3 and if ALIGNED drop 0 C, jump P - ALIGNED: drop ; - -\ The run time of ." : print the string after the call, go on after it. -\ It takes the return address off before it calls anything and keeps the -\ count there instead, so a word that prints text goes no deeper than one -\ that calls any other word. -header (.") compile-only -: (.") - pop 4* dup C@ \ baddr n - L: if DONE - push 1 + dup C@ EMIT pop -1 + jump L - DONE: drop 4/ 1 + push ; \ the cell after the last character - -\ FORTH-79: ." text" prints the text -- now, if interpreting; when the word -\ it is compiled into runs, if compiling. -header ." immediate -: DOT-QUOTE - 34 (PARSE) drop - STATE a! @ if NOW - drop &(.") (CALL,) jump (STRING,) - NOW: drop WBUF COUNT jump TYPE - -\ ( flag -- ) the run time of ABORT" : if the flag is not zero print the -\ string after the call, start a new line and ABORT; otherwise go on after -\ the string. -header (ABORT") compile-only -: (ABORT") - if NO - drop pop 4* R-CLEAR COUNT TYPE CR jump ABORT - NO: drop pop 4* dup C@ + 4/ 1 + push ; - -\ ( flag -- ) ABORT" text" as v3 (it is FORTH-83's, not FORTH-79's): if -\ the flag is not zero, print the text and ABORT. -header ABORT" immediate -: ABORT-QUOTE - 34 (PARSE) drop - STATE a! @ if NOW - drop &(ABORT") (CALL,) jump (STRING,) - NOW: drop if NO - drop WBUF COUNT TYPE CR jump ABORT - NO: drop ; - -\ The run time of S" : leave the address and length of the string after the -\ call, and go on after it. -header (S") compile-only -: (S") - pop 4* dup C@ \ baddr n - over over + 4/ 1 + push \ the cell after the last character - push 1 + pop ; \ baddr+1 n - -\ ( -- baddr u ) S" text" as v3. In a definition the text is compiled -\ into it. At the prompt it is copied to PAD, where it stays until PAD is -\ used again: WORD's buffer is overwritten by the very next word of the line. -header S" immediate -: S-QUOTE - 34 (PARSE) drop - STATE a! @ if NOW - drop &(S") (CALL,) jump (STRING,) - NOW: drop WBUF+1 PAD WBUF C@ CMOVE PAD WBUF jump C@ diff --git a/v4/capsule/system.v4 b/v4/capsule/system.v4 deleted file mode 100644 index aa48a364..00000000 --- a/v4/capsule/system.v4 +++ /dev/null @@ -1,170 +0,0 @@ -\ system.v4 -- words about the dictionary as a whole: WORDS, FORGET, FENCE. -\ -\ DECOMPOSITION.md 5.13 and 5.15. Part of the compiler capsule; rests on -\ dict.v4, quit.v4 and forth.v4. -\ -\ Constants the loader supplies: -\ FENCE word address of the variable: FORGET will not remove an entry -\ that starts below the address it holds -\ VOC-LINK word address of the variable: the newest vocabulary, or 0 -\ (BOOT) word address of two cells: DP and (LATEST) as the loader left them - -header FENCE inline : FENCE' FENCE ; - -\ ---- vocabularies (FORTH-79) ---------------------------------------------------- -\ A vocabulary is two cells: its head -- the xt of its newest entry, or 0 -- -\ and the address of the vocabulary defined before it, or 0. VOC-LINK holds -\ the newest one's address. FORTH's head is (LATEST) and it is in no chain. -header CONTEXT inline : CONTEXT' CONTEXT ; -header CURRENT inline : CURRENT' CURRENT ; - -\ FORTH-79: the primary vocabulary; it becomes the CONTEXT vocabulary. -header FORTH immediate -: FORTH (LATEST) CONTEXT a! ! ; -\ FORTH-79: new definitions go into the CONTEXT vocabulary from now on. -header DEFINITIONS -: DEFINITIONS CONTEXT a! @ CURRENT a! ! ; - -\ VOCABULARY xxx FORTH-79: xxx is a new, empty list of words; executing -\ xxx makes it the CONTEXT vocabulary. When a search of it finds nothing, -\ FORTH is searched. -: (DOVOC) pop CONTEXT a! ! ; -header VOCABULARY -: VOCABULARY - &(DOVOC) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop - 0 , VOC-LINK a! @ , HERE -2 + VOC-LINK a! ! ; - NONE: drop ; - -\ ( cell -- ) print the name of the vocabulary whose head cell this is -: (.VOC) - dup (LATEST) xor if F drop -1 + -2 + a! @ 4* COUNT 31 and jump TYPE - F: drop drop $54524F46 (EMIT4) $48 (EMIT4) ; - -\ ( -- ) as v3's, but true: where names are looked for, and where new ones go -header ORDER -: ORDER - $72616553 (EMIT4) $6F206863 (EMIT4) $72656472 (EMIT4) $203A (EMIT4) - CONTEXT a! @ dup (.VOC) SPACE - (LATEST) xor if ONLY drop (LATEST) (.VOC) jump TWO - ONLY: drop - TWO: CR - $72727543 (EMIT4) $3A746E65 (EMIT4) $20 (EMIT4) - CURRENT a! @ (.VOC) jump CR - -\ ( -- ) the names in the CONTEXT vocabulary, the newest first, a blank after -\ each, a new line whenever one has passed column 64. Hidden entries -- a -\ definition under way -- are not shown. (Q)+0 is the column. -header WORDS -: WORDS - 0 (Q) a! ! - CONTEXT a! @ a! @ - L: if DONE - dup -3 + a! @ 2 and if SHOW drop jump NXT - SHOW: drop - dup -2 + a! @ 4* COUNT 31 and \ xt baddr u - dup (Q) a! @ + 1 + ! - TYPE SPACE - (Q) a! @ -64 + -if WRAP drop jump NXT - WRAP: drop CR 0 (Q) a! ! - NXT: -1 + a! @ jump L - DONE: drop jump CR -header VLIST -: VLIST jump WORDS - -\ ( cell -- ) take off a vocabulary's list every entry at or above the -\ address in (Q)+0. The newest are first, so it stops at the first one below. -: (PRUNE) - (Q)+1 a! ! - L: (Q)+1 a! @ a! @ if DONE - dup (Q) a! @ inv + 1 + -if CUT drop drop ; - CUT: drop -1 + a! @ (Q)+1 a! @ a! ! jump L - DONE: drop ; - -\ FORGET xxx FORTH-79: remove xxx and every word defined after it, in -\ whatever vocabulary; the space they took is free again. A vocabulary that -\ goes is no longer CONTEXT or CURRENT: FORTH is. A word that is not there -\ is an error, and so is one below FENCE, which is where the capsule's own -\ words are (code 10, "Protected word"). -header FORGET -: FORGET - 32 WORD (LOOKUP) if MISSING - -2 + a! @ \ where its name starts - dup FENCE a! @ inv + 1 + -if OK \ name - fence - drop drop NODE-ERROR b! 10 !b ; - OK: drop - dup (Q) a! ! 4* DP a! ! \ the space from its name on - (LATEST) (PRUNE) - V: VOC-LINK a! @ if PRUNED \ vocabularies that go - dup (Q) a! @ inv + 1 + -if GONE drop jump KEPT - GONE: drop 1 + a! @ VOC-LINK a! ! jump V - KEPT: P: if PRUNED \ the lists of those that stay - dup (PRUNE) 1 + a! @ jump P - PRUNED: drop - CONTEXT a! @ (Q) a! @ inv + 1 + -if C1 drop jump C2 - C1: drop (LATEST) CONTEXT a! ! - C2: CURRENT a! @ (Q) a! @ inv + 1 + -if C3 drop jump TOLD - C3: drop (LATEST) CURRENT a! ! - TOLD: (Q) a! @ jump (FORGOTTEN) \ the kernel's records of them go too (dict.v4) - MISSING: drop (UNKNOWN) drop ; - -\ ---- the system as a whole ------------------------------------------------------- -\ (BOOT) is two cells the loader fills when the capsule is in place: DP and -\ the newest FORTH entry as they then are. COLD goes back to them. - -\ FORTH-79: execute to be sure a FORTH-79 system is there. It is: nothing -\ happens. (v3's prints two lines and leaves a flag.) -header 79-STANDARD -: 79-STANDARD ; - -\ ( -- ) which system this is, and its cell width -header VERSION -: VERSION - $72617453 (EMIT4) $74726F46 (EMIT4) $34762068 (EMIT4) $302E302E (EMIT4) $38314620 (EMIT4) $20 (EMIT4) - N-1 1 + 0 U-DOT-R $7469622D (EMIT4) CR ; - -\ ( -- ) clear the screen and put the cursor at the top, as v3: ESC [2J ESC [H -header PAGE -: PAGE 27 EMIT 91 EMIT 50 EMIT 74 EMIT 27 EMIT 91 EMIT 72 jump EMIT - -\ ( -- ) as v3's message, and then ABORT: both stacks emptied, the prompt -header WARM -: WARM - $54524F46 (EMIT4) $39372D48 (EMIT4) $72615720 (EMIT4) $7453206D (EMIT4) $747261 (EMIT4) CR - $74737953 (EMIT4) $72206D65 (EMIT4) $61747365 (EMIT4) $64657472 (EMIT4) $2E (EMIT4) CR - jump ABORT - -\ ( -- ) the system as it was when the capsule had just been loaded: -\ everything defined since is gone, there is one vocabulary, numbers are -\ decimal, the block buffers are empty. Then as WARM. -header COLD -: COLD - (BOOT) a! @ DP a! ! - (BOOT)+1 a! @ (LATEST) a! ! - (BOOT) a! @ 2/ 2/ FENCE a! ! - (LATEST) CONTEXT a! ! (LATEST) CURRENT a! ! 0 VOC-LINK a! ! - 10 BASE a! ! 0 SCR a! ! 2 (LOG-LEVEL) a! ! 0 (ACL-HOOK) a! ! EMPTY-BUFFERS - (BOOT) a! @ 2/ 2/ (FORGOTTEN) \ the kernel's records of what has gone go too (dict.v4) - $54524F46 (EMIT4) $39372D48 (EMIT4) $6C6F4320 (EMIT4) $74532064 (EMIT4) $747261 (EMIT4) CR - $74737953 (EMIT4) $69206D65 (EMIT4) $6974696E (EMIT4) $7A696C61 (EMIT4) $2E6465 (EMIT4) CR - jump ABORT - -\ ---- deferred words (as v3) ------------------------------------------------------- -\ DEFER xxx makes xxx, which does whatever word it has been given: -\ ' yyy IS xxx gives it one; DEFER@ xxx leaves the one it has. A deferred -\ word with none is an error (code 15, "Deferred word not set"). -: (DODEFER) - pop a! @ if UNSET push ; \ go to it: it returns to xxx's caller - UNSET: drop NODE-ERROR b! 15 !b ; -header DEFER -: DEFER &(DODEFER) (C)+3 a! ! (DATA) (C)+8 a! @ if NONE drop 0 jump , NONE: drop ; -: (is!) a! ! ; -: (defer@) a! @ ; -header IS immediate -: IS - (') STATE a! @ if NOW drop (LIT,) &(is!) jump (CALL,) - NOW: drop jump (is!) -header DEFER@ immediate -: DEFER@ - (') STATE a! @ if NOW drop (LIT,) &(defer@) jump (CALL,) - NOW: drop jump (defer@) - diff --git a/v4/capsule/words.v4 b/v4/capsule/words.v4 deleted file mode 100644 index 717135b3..00000000 --- a/v4/capsule/words.v4 +++ /dev/null @@ -1,201 +0,0 @@ -\ words.v4 -- more of the FORTH vocabulary: the stack, comparison, double, -\ mixed, shift and string words that are short runs of opcodes or small loops. -\ -\ Each is the definition DECOMPOSITION.md gives (sections 4, 5.1 - 5.7, 5.9) -\ and the mesh-node tests execute (test_cells.c, test_foundation.c, -\ test_strings.c), here as words of the host node's vocabulary. Rests on -\ core.v4, forth.v4 and numout.v4. -\ -\ Constants the loader supplies: -\ MAX-INT the largest positive number: every bit but the top one -\ (X) word address of four cells of scratch for COMPARE and SEARCH - -\ ---- stack ---- -header 2SWAP -: 2SWAP ( a b c d -- c d a b ) ROT push ROT pop ; -header 2OVER -: 2OVER ( a b c d -- a b c d a b ) push push over over pop pop jump 2SWAP -header 2ROT -: 2ROT ( a b c d e f -- c d e f a b ) push push 2SWAP pop pop jump 2SWAP -header 2>R inline compile-only : 2>R SWAP push push ; -header 2R> inline compile-only : 2R> pop pop SWAP ; -header 2R@ inline compile-only : 2R@ pop pop over over push push SWAP ; -header NOP inline : NOP' nop ; -header TRUE inline : TRUE -1 ; -header FALSE inline : FALSE 0 ; -header INVERT inline : INVERT inv ; - -\ ---- memory ---- -header 2@ -: 2@ ( addr -- lo hi ) a! @+ @ ; -header 2! -: 2! ( lo hi addr -- ) a! SWAP !+ ! ; -header -! -: -! ( n addr -- ) a! NEGATE @ + ! ; - -\ ---- comparison ---- -header 0<> -: 0<> if Z drop -1 ; Z: ; -header 0> -: 0> -if NN drop 0 ; NN: if Z drop -1 ; Z: ; -header <> -: <> xor jump 0<> -header <= -: <= GREATER jump 0= -header >= -: >= LESS jump 0= -header U< -: U< over over xor -if SAME drop NIP jump 0< - SAME: drop - jump 0< -header U> -: U> SWAP jump U< -header ABS -: ABS -if P inv 1 + P: ; -header MAX -: MAX over over LESS if A drop push drop pop ; A: drop drop ; -header MIN -: MIN over over LESS if B drop drop ; B: drop push drop pop ; -header WITHIN -: WITHIN ( n low high -- flag ) push over pop LESS push LESS inv pop and ; - -\ ---- shifts ---- -\ As v3, a count that is negative or as large as the cell is wide is an -\ error (code 9, "Shift count out of range"). -header LSHIFT -: LSHIFT ( x n -- x' ) - -if NN jump BAD - NN: dup N-1 inv + -if BAD2 drop - L: if DONE -1 + push 2* pop jump L - DONE: drop ; - BAD2: drop - BAD: drop drop NODE-ERROR b! 9 !b ; -header RSHIFT -: RSHIFT ( x n -- x' ) \ zeros come in at the top - -if NN jump BAD - NN: dup N-1 inv + -if BAD2 drop - L: if DONE -1 + push 2/ MAX-INT and pop jump L - DONE: drop ; - BAD2: drop - BAD: drop drop NODE-ERROR b! 9 !b ; - -\ ---- doubles and mixed ---- -header D- -: D- DNEGATE jump D+ -header DABS -: DABS -if P jump DNEGATE P: ; -header D0= -: D0= OR jump 0= -header D0< -: D0< push drop pop jump 0< -header D= -: D= D- jump D0= -header D2* -: D2* 2* over -if P drop 1 + jump J P: drop J: push 2* pop ; -header D2/ -: D2/ push a! 0 pop +* push drop a pop ; -header M+ -: M+ S>D jump D+ -header M- -: M- S>D DNEGATE jump D+ - -\ ( d1 d2 -- d1 d2 flag ) the flag's top bit is set exactly when d1 < d2 -: (D<) - dup push push over pop over over xor if TIE - drop over over xor -if HS drop drop jump S1 - HS: drop push inv pop + inv - S1: -if N1 drop -1 jump D1 N1: drop 0 - D1: pop SWAP ; - TIE: drop drop drop dup push push over pop - over over xor -if LS drop NIP jump S2 - LS: drop push inv pop + inv - S2: -if N2 drop -1 jump D2 N2: drop 0 - D2: pop pop ROT ; -header D< -: D< (D<) push drop drop drop drop pop ; -header DMAX -: DMAX (D<) if L drop push push drop drop pop pop ; L: drop drop drop ; -header DMIN -: DMIN (D<) if L drop drop drop ; L: drop push push drop drop pop pop ; - -\ ---- strings and memory ---- -header ?TERMINAL -: ?TERMINAL ( -- flag ) CONSOLE-STATUS b! @b ; - -header CMOVE> -: CMOVE> ( src dst u -- ) - -if OK drop drop drop NODE-ERROR b! 1 !b ; - OK: if DONE -1 + push - over pop dup push + C@ - over pop dup push + C! - pop jump OK - DONE: drop drop drop ; - -\ FORTH-79: n cells from addr1 to addr2, the cell at addr1 first. -header MOVE -: MOVE ( addr1 addr2 n -- ) - -if OK drop drop drop ; - OK: if DONE push over a! @ over a! ! 1 + push 1 + pop pop -1 + jump OK - DONE: drop drop drop ; - -header FILL -: FILL ( baddr u c -- ) - SWAP push SWAP pop \ c baddr u - -if OK drop drop drop NODE-ERROR b! 1 !b ; - OK: if DONE push over over C! 1 + pop -1 + jump OK - DONE: drop drop drop ; -header ERASE -: ERASE ( baddr u -- ) 0 jump FILL -header BLANK -: BLANK ( baddr u -- ) 32 jump FILL - -header -TRAILING -: -TRAILING ( baddr u -- baddr u' ) - -if L drop 0 ; - L: if DONE over over + -1 + C@ -32 + if SP drop ; - SP: drop -1 + jump L - DONE: ; - -header COMPARE -: COMPARE ( a1 u1 a2 u2 -- n ) - -if A drop 0 A: (X)+1 b! !b - SWAP -if B drop 0 B: dup (X) b! !b - (X)+1 b! @b - over over - -if GE drop drop jump M - GE: drop push drop pop - M: - L: if EQ push - over C@ over C@ - if SAME - -if GT drop drop drop pop drop -1 ; - GT: drop drop drop pop drop 1 ; - SAME: drop 1 + push 1 + pop pop -1 + jump L - EQ: drop drop drop (X) b! @b (X)+1 b! @b - - -if NN drop -1 ; - NN: if ZZ drop 1 ; - ZZ: ; - -header SEARCH -: SEARCH ( a1 u1 a2 u2 -- a3 u3 flag ) - -if A drop 0 A: (X)+1 b! !b (X) b! !b - -if B drop 0 B: dup (X)+3 b! !b over (X)+2 b! !b - L: dup (X)+1 b! @b - -if TRY - drop drop drop (X)+2 b! @b (X)+3 b! @b 0 ; - TRY: drop over (X) b! @b (X)+1 b! @b - I: if MATCH push - over C@ over C@ xor if SAME - drop drop drop pop drop push 1 + pop -1 + jump L - SAME: drop 1 + push 1 + pop pop -1 + jump I - MATCH: drop drop drop -1 ; - -header SCAN -: SCAN ( baddr u c -- baddr' u' ) - 255 and push -if L drop 0 - L: if DONE over C@ pop dup push xor if FOUND - drop push 1 + pop -1 + jump L - FOUND: drop - DONE: pop drop ; -header SKIP -: SKIP ( baddr u c -- baddr' u' ) - 255 and push -if L drop 0 - L: if DONE over C@ pop dup push xor if SAME drop jump DONE - SAME: drop push 1 + pop -1 + jump L - DONE: pop drop ; diff --git a/v4/include/v4/boot.h b/v4/include/v4/boot.h index bf795a46..246ecbdd 100644 --- a/v4/include/v4/boot.h +++ b/v4/include/v4/boot.h @@ -1,11 +1,13 @@ -/* boot.h -- how a StarForth v4 system comes up: the nucleus, then its - * capsules, then the prompt. docs/v4.0.0/NUCLEUS.md. +/* boot.h -- how a StarForth v4 system comes up: the machine's ROM assembles + * the system, then its capsules are loaded, then the prompt. + * docs/v4.0.0/MACHINE.md, NUCLEUS.md. * * The hosted binary (tools/hosted.c) and the bare-metal kernel * (kernel/src/v4/sk_v4.c) both call v4_boot_run and differ only in where * the text goes. So the two start the same way and print the same lines: * - * PARITY:V4_NUCLEUS name=v4:nucleus-64.f18 capsule_id=0x... capsule_hash=0x... words=N + * PARITY:V4_F18 name=v4:sys:map-64.f18 capsule_hash=0x... (one for each blob of the system's source) + * PARITY:V4_ROM words=N rom_hash=0x... instructions=N (the ROM, and what assembling the system cost) * PARITY:V4_CAPSULE name=v4:forth79.4th capsule_id=0x... capsule_hash=0x... dict_hash=0x... * PARITY:V4_POST tests=N pass=N fail=N (POST is the kernel's: v4/post.h) * PARITY:V4_SYSTEM word_count=N dict_hash=0x... (the system as sealed, after POST) @@ -39,13 +41,13 @@ typedef struct { v4_node *n; v4_exec_state *es; v4_heat *h; - const v4_image *im; /* the nucleus */ + v4_image *im; /* the system: the map's description (v4_map_image), which the boot completes */ void (*out)(const char *text, unsigned len); /* the console */ int (*key)(void); /* a character for a line that reads the keyboard, or 0: there is none */ /* THE KERNEL'S WORDS (docs/v4.0.0/ENGINE.md 3.3). `words` names them, * `word_count` of them; the boot makes each a word on the node (KERNEL- - * WORD, v4/capsule/compile.v4) whose request number is its place in the + * WORD, capsules/v4/sys/compile.f18) whose request number is its place in the * list, counting from 1. When the node writes a request to its port it * is blocked, and `serve` is called with the number: it takes the * word's arguments from the node's data stack and leaves its results @@ -63,8 +65,9 @@ typedef struct { #define V4_BOOT_KEY_NONE (-1) /* not yet: it is asked again */ #define V4_BOOT_KEY_END (-2) /* and there never will be */ -/* A node is born empty (v4_image_born); it is sent the nucleus through its - * port; and the capsules are loaded. Its blocks are the kernel's block +/* A node is born empty (v4_image_born); its ROM assembles the system from + * its source, capsules/v4/sys, fed to it through its console; and the + * capsules are loaded. Its blocks are the kernel's block * subsystem's, which whoever calls this has set up (v4/blocks.h). Returns 1 with the node idle, * waiting to be handed a line; or 0, the failure printed. It prints no * prompt: that is the host's. */ diff --git a/v4/include/v4/capsule.h b/v4/include/v4/capsule.h index 4185c6fa..8cffe023 100644 --- a/v4/include/v4/capsule.h +++ b/v4/include/v4/capsule.h @@ -18,8 +18,9 @@ * jump start * * This is the F18's own way of loading a node through a port. Nothing here - * knows what the programme is: StarForth's nucleus is one such capsule - * (v4/tools/mkimage.c), and anything written for the node is another. + * knows what the programme is: StarForth's system, as the machine's ROM + * assembled it, is one such capsule (what a node that is born is sent: + * tests/test_host_unit.c), and anything written for the node is another. */ #ifndef V4_CAPSULE_H #define V4_CAPSULE_H diff --git a/v4/include/v4/image.h b/v4/include/v4/image.h index 80adffd2..ec598f8a 100644 --- a/v4/include/v4/image.h +++ b/v4/include/v4/image.h @@ -1,18 +1,19 @@ -/* image.h -- the StarForth nucleus, as its host knows it: where things are - * in a node that has taken it in, and how a line is handed to that node. +/* image.h -- the StarForth system, as its host knows it: where things are + * in a node that holds it, and how a line is handed to that node. * - * The nucleus is text (capsule/ *.v4). tools/mkimage.c assembles it on the - * build machine and writes two things: + * The system is text, the .f18 blobs of capsules/v4/sys, and the machine's + * ROM assembles it when the machine starts (docs/v4.0.0/MACHINE.md; v4/ + * system/boot.c). Its host knows two things of it: * - * - the nucleus as a capsule of F18 code (capsule.h), which is put into - * an empty node through its port. It is a capsule like any other: in - * the capsule directory, with a name, a hash and a signature - * (capsules/v4/nucleus-.f18). docs/v4.0.0/MESH.md section 5. - * - this description of it, a C file: the addresses a host needs. + * - the memory map, before it is built: v4_map_image, a C file that + * tools/mkmap.c writes from the map (`mkmap image`); + * - what only the assembled system knows -- where it waits, its fault + * table, KEY -- from the image record, a fixed block of RAM whose + * address is a constant of the map and which the system's source + * stores (capsules/v4/sys/end.f18): v4_image_from_node. * - * A node that has taken the nucleus in is sent text as messages and sends - * back what it prints (v4/include/v4/message.h); nothing here hands it a - * line. + * A node that holds the system is sent text as messages and sends back + * what it prints (v4/include/v4/message.h); nothing here hands it a line. * * A description is for one cell width, one node size and one pair of stack * sizes; v4_image_born refuses one the engine was not built for. @@ -26,9 +27,11 @@ typedef struct { /* what the image was built for */ unsigned cell_bits, node_words, data_ring, ret_ring; - /* Where the nucleus waits for a message (v4/capsule/quit.v4, (IDLE)): - * a node that has taken the nucleus in begins there, and with nothing - * to do it is asleep at a wire inside it (operation 8, MESH.md 7d.3). */ + /* Where the system waits for a message (capsules/v4/sys/quit.f18, + * (IDLE)): a node that holds the system begins there, and with nothing + * to do it is asleep at a wire inside it (operation 8, MESH.md 7d.3). + * This, fault_table, key_start and key_end are -1 until the system is + * built (v4_image_from_node). */ v4_cell idle; v4_cell fault_table; /* (FAULTS): where a fault goes */ v4_cell port; /* word address of the node's port (node.h) */ @@ -38,7 +41,7 @@ typedef struct { v4_cell key_start, key_end; /* the memory-mapped registers (DECOMPOSITION.md section 7; D-4 leaves - * the map to the loader, and this is the map the image was built with) */ + * the map to the loader, and this is the map the system is built with) */ v4_cell console_tx, console_rx, console_status; v4_cell dstack_reg, rstack_reg; v4_cell node_error; @@ -50,24 +53,36 @@ typedef struct { /* What COLD returns the system to and FORGET will not go below: two * cells, DP and LATEST as they were when the system was complete, and - * the variable FENCE. The image has them as the nucleus alone; a system - * that loads capsules when it boots sets them again when it has + * the variable FENCE. The system's source sets them; a system that + * loads capsules when it boots sets them again when it has * (v4_image_seal). */ v4_cell boot_cells, fence; /* the block window: the word address of the slots the kernel copies * blocks into (v4/blocks.h) */ v4_cell block_window; + + /* the image record (capsules/v4/sys/end.f18): four cells, where the + * system waits, its fault table, KEY and the word after KEY; and the + * ROM's two cells that say why it stopped, if it did: the code of its + * error (0 if none) and the line it was on, counting from 0 */ + v4_cell record, rom_failed, rom_errline; } v4_image; -/* The nucleus's error for a node blocked at a port with no one on it - * (v4/capsule/core.v4's list; node.h, v4_node_port_gone): "No one on that - * port". */ +/* The system's error for a node blocked at a port with no one on it + * (capsules/v4/sys/core.f18's list; node.h, v4_node_port_gone): "No one on + * that port". */ #define V4_ERROR_NO_ONE 18 -/* The description of the nucleus built from v4/capsule (the generated file - * defines it). */ -extern const v4_image v4_capsule_image; +/* The memory map's description of the system (the generated file defines + * it): what is known of it before it is built. */ +extern const v4_image v4_map_image; + +/* What only the assembled system knows, read from the image record of the + * node `n` that holds it into `im`, which the map's description is in. + * Returns 1, or 0 if the record does not name addresses of the node's + * memory (nothing is then changed). */ +int v4_image_from_node(const v4_node *n, v4_image *im); /* The system is complete: what is in the dictionary now is what COLD comes * back to, and FORGET will not go below it. */ @@ -79,9 +94,9 @@ void v4_image_seal(v4_node *n, const v4_image *im); * width, gives the same hash for the same dictionary. */ uint64_t v4_image_dict_hash(const v4_node *n, const v4_image *im); -/* A node newly born (node.h), with the registers the nucleus expects of the +/* A node newly born (node.h), with the registers the system expects of the * node it runs on. Its memory is empty and it is blocked - * reading its ports: the nucleus is yet to be sent to it. Returns 1, or 0 + * reading its ports: its code is yet to be sent to it, or assembled on it. Returns 1, or 0 * if the description is not for this build of the engine (nothing is then * done). */ int v4_image_born(v4_node *n, v4_exec_state *es, v4_heat *h, const v4_image *im); diff --git a/v4/include/v4/manage.h b/v4/include/v4/manage.h index 93ff4110..c030cdaf 100644 --- a/v4/include/v4/manage.h +++ b/v4/include/v4/manage.h @@ -5,7 +5,7 @@ * a node like any other and cannot make one: she asks, by a write to the * port where her requests go (ENGINE.md 3.3), and the write blocks her until * she is answered. Each request is a word on her, made with KERNEL-WORD - * (v4/capsule/compile.v4); its arguments are what it finds on her data + * (capsules/v4/sys/compile.f18); its arguments are what it finds on her data * stack and its results are what is left there. * * These are the requests, in order. The n-th is request `first + n`, where diff --git a/v4/include/v4/message.h b/v4/include/v4/message.h index 14aa3525..85ec42ea 100644 --- a/v4/include/v4/message.h +++ b/v4/include/v4/message.h @@ -18,7 +18,7 @@ * * This is for whatever is on the other end of a node's port and is not a * node -- a console, a host -- to speak what the nodes speak (v4/capsule/ - * core.v4 and quit.v4 are the same thing in the node). Nothing here uses + * core.f18 and quit.f18 are the same thing in the node). Nothing here uses * the C library. */ #ifndef V4_MESSAGE_H diff --git a/v4/include/v4/node.h b/v4/include/v4/node.h index 94202ff9..b6caefe4 100644 --- a/v4/include/v4/node.h +++ b/v4/include/v4/node.h @@ -380,7 +380,7 @@ void v4_node_rom_attach(v4_node *n, const v4_cell *rom, unsigned words); * chose to, after taking its own arguments off); * - P becomes fault_vector + fault_kind. The handler table is six words, * one for each kind in the order below, each a jump to that kind's - * handler (capsule/quit.v4, (FAULTS)). + * handler (capsules/v4/sys/quit.f18, (FAULTS)). * With no table attached (fault_vector -1) the node stops instead: `stopped` * is set and v4_exec_step_word does nothing more until the node is reset or * a table is attached. diff --git a/v4/include/v4/text.h b/v4/include/v4/text.h index 682eaab1..f48d93a0 100644 --- a/v4/include/v4/text.h +++ b/v4/include/v4/text.h @@ -56,7 +56,21 @@ * count byte, then its characters, four to a cell, low * byte first, zero-padded to a whole cell. * - * header NAME a dictionary entry for NAME (capsule/dict.v4), laid down + * set NAME VALUE an assembler variable: like a constant, but it may be + * set again (the newest value is its value). In code it + * is a literal. + * here as a VALUE: the next word address, the word being built + * ended first. Not something to assemble on its own. + * store ADDR VALUE ADDR, a VALUE that is a word of RAM, is given VALUE: the + * state the system is switched on in. + * start NAME the end of the text: every branch must have its target, + * and NAME, a word, is where the system starts + * (v4_text_start). Nothing may follow. + * These four, constant, #, and ", are the ROM's language + * (docs/v4.0.0/MACHINE.md): the ROM assembles the same + * text the same way. + * + * header NAME a dictionary entry for NAME (capsules/v4/sys/dict.f18), laid down * in front of the word that the next `:` starts, and * linked to the header before it. NAME is taken as it * stands -- it may be ( or \ or + -- and is at most 31 @@ -123,6 +137,7 @@ typedef struct { unsigned pool_used; v4_cell latest; /* xt of the newest header, 0 if none */ + v4_cell start; /* the word `start` named, -1 if none yet */ int header_pending; /* a header waits for its `:` */ unsigned line; @@ -155,6 +170,13 @@ v4_cell v4_text_word(const v4_text *t, const char *name); * dictionary's LATEST starts as. */ v4_cell v4_text_latest(const v4_text *t); +/* The value of the constant or set variable NAME: 1 and *value, or 0 if + * NAME is neither. */ +int v4_text_value(const v4_text *t, const char *name, v4_cell *value); + +/* The word `start` named, or -1 if the text has had no start. */ +v4_cell v4_text_start(const v4_text *t); + /* The next free word address. */ v4_cell v4_text_here(v4_text *t); diff --git a/v4/src/image.c b/v4/src/image.c index f9b7711c..35352aa7 100644 --- a/v4/src/image.c +++ b/v4/src/image.c @@ -1,4 +1,4 @@ -/* image.c -- the StarForth nucleus, as its host knows it. See image.h. +/* image.c -- the StarForth system, as its host knows it. See image.h. * * Nothing here uses the C library: the bare-metal kernel links this file. */ @@ -22,6 +22,21 @@ int v4_image_born(v4_node *n, v4_exec_state *es, v4_heat *h, const v4_image *im) return 1; } +int v4_image_from_node(const v4_node *n, v4_image *im) +{ + v4_cell r = im->record, idle, faults, key, key_end; + if (r < 0 || r + 3 >= (v4_cell)V4_NODE_WORDS) return 0; + idle = n->mem[r]; faults = n->mem[r + 1]; key = n->mem[r + 2]; key_end = n->mem[r + 3]; + if (idle <= 0 || idle >= (v4_cell)V4_NODE_WORDS || faults <= 0 || faults >= (v4_cell)V4_NODE_WORDS + || key <= 0 || key_end <= key || key_end >= (v4_cell)V4_NODE_WORDS) + return 0; + im->idle = idle; + im->fault_table = faults; + im->key_start = key; + im->key_end = key_end; + return 1; +} + int v4_image_waiting(const v4_node *n, const v4_image *im) { return n->input_pos == n->input_len && n->p >= im->key_start && n->p < im->key_end; diff --git a/v4/src/manage.c b/v4/src/manage.c index 9b44639f..7d56b67a 100644 --- a/v4/src/manage.c +++ b/v4/src/manage.c @@ -10,7 +10,7 @@ const char *const v4_manage_words[V4_MANAGE_WORDS] = { }; /* A character of the node's memory: four to a cell, the first lowest, as - * the nucleus keeps text (v4/capsule/core.v4). */ + * the nucleus keeps text (capsules/v4/sys/core.f18). */ static int in_memory(v4_cell baddr) { return baddr >= 0 && (baddr >> 2) < (v4_cell)V4_NODE_WORDS; } static char char_at(const v4_node *n, v4_cell baddr) { diff --git a/v4/src/text.c b/v4/src/text.c index 4f477166..928c7900 100644 --- a/v4/src/text.c +++ b/v4/src/text.c @@ -5,7 +5,7 @@ #include #include -enum { KIND_WORD = 1, KIND_CONST, KIND_MACRO }; +enum { KIND_WORD = 1, KIND_CONST, KIND_MACRO, KIND_SET }; /* the ROM's kinds: 1 word, 2 constant, 3 macro, 4 set variable */ static const char *const mnemonic[V4_OPCODE_COUNT] = { ";", "ex", "jump", "call", "unext", "next", "if", "-if", @@ -50,7 +50,7 @@ static const v4_text_symbol *find(const v4_text *t, const char *s) return NULL; } -/* The entry flags a `header` may be given (capsule/dict.v4). */ +/* The entry flags a `header` may be given (capsules/v4/sys/dict.f18). */ static v4_cell flag_of(const char *s) { if (strcmp(s, "immediate") == 0) return 1; @@ -66,7 +66,8 @@ static int is_reserved(const char *s) || strcmp(s, "\\") == 0 || strcmp(s, "(") == 0 || strcmp(s, "FOR") == 0 || strcmp(s, "NEXT") == 0 || strcmp(s, "UNEXT") == 0 || strcmp(s, "header") == 0 || strcmp(s, "constant") == 0 - || strcmp(s, "#,") == 0 || strcmp(s, "\",") == 0 || flag_of(s) != 0; + || strcmp(s, "#,") == 0 || strcmp(s, "\",") == 0 || strcmp(s, "set") == 0 || strcmp(s, "here") == 0 + || strcmp(s, "store") == 0 || strcmp(s, "start") == 0 || flag_of(s) != 0; } static int is_label_def(const char *s) @@ -189,7 +190,7 @@ static void lay_name(v4_text *t, const char *name) } } -/* `header NAME`: a dictionary entry for NAME, as capsule/dict.v4 lays one +/* `header NAME`: a dictionary entry for NAME, as capsules/v4/sys/dict.f18 lays one * out, in front of the word the next `:` starts: * the name: its count byte, then its characters, four bytes to a cell, * zero-padded to a whole cell @@ -366,12 +367,14 @@ static void constant_directive(v4_text *t, reader *r) define(t, name, KIND_CONST, v); } -/* A VALUE in a directive: a number, a constant, CONST+N, or &NAME of a word - * already defined. 1 and its value, or 0 having failed. */ +/* A VALUE in a directive: a number, a constant, a set variable, CONST+N, + * here, or &NAME of a word already defined. 1 and its value, or 0 having + * failed. */ static int value_of(v4_text *t, const char *tok, v4_cell *out) { const v4_text_symbol *s; int big; + if (strcmp(tok, "here") == 0) { *out = v4_asm_label(&t->as); return 1; } if (number_of(tok, out, &big)) { if (big) { fail(t, "number does not fit a cell", tok); return 0; } return 1; @@ -383,7 +386,7 @@ static int value_of(v4_text *t, const char *tok, v4_cell *out) return 0; } s = find(t, tok); - if (s && s->kind == KIND_CONST) { *out = s->value; return 1; } + if (s && (s->kind == KIND_CONST || s->kind == KIND_SET)) { *out = s->value; return 1; } if (!s) { const char *plus = strrchr(tok, '+'); if (plus && plus != tok && plus[1] != 0) { @@ -428,6 +431,51 @@ static void string_directive(v4_text *t, reader *r) check_asm(t, tok); } +/* `set NAME VALUE`: an assembler variable, set again if it is one already. */ +static void set_directive(v4_text *t, reader *r) +{ + char name[V4_TEXT_MAX_TOKEN + 1u], tok[V4_TEXT_MAX_TOKEN + 1u]; + v4_cell v; + v4_text_symbol *s; + + if (r->depth != 1) { fail(t, "not allowed in a macro", "set"); return; } + if (!next_token(t, r, name)) { if (!t->failed) fail(t, "set without a name", NULL); return; } + if (!next_token(t, r, tok)) { if (!t->failed) fail(t, "set without a value", name); return; } + if (!value_of(t, tok, &v)) return; + s = (v4_text_symbol *)find(t, name); + if (s && s->kind == KIND_SET) { s->value = v; return; } + define(t, name, KIND_SET, v); +} + +/* `store ADDR VALUE`: a word of RAM is given VALUE. */ +static void store_directive(v4_text *t, reader *r) +{ + char tok[V4_TEXT_MAX_TOKEN + 1u]; + v4_cell addr, v; + + if (r->depth != 1) { fail(t, "not allowed in a macro", "store"); return; } + if (!next_token(t, r, tok)) { if (!t->failed) fail(t, "store without an address", NULL); return; } + if (!value_of(t, tok, &addr)) return; + if (!next_token(t, r, tok)) { if (!t->failed) fail(t, "store without a value", NULL); return; } + if (!value_of(t, tok, &v)) return; + if (addr < 0 || (v4_ucell)addr >= V4_NODE_WORDS) { fail(t, "address out of range", tok); return; } + v4_node_store(t->as.n, addr, v); +} + +/* `start NAME`: the text has ended; NAME is where the system starts. */ +static void start_directive(v4_text *t, reader *r) +{ + char name[V4_TEXT_MAX_TOKEN + 1u]; + const v4_text_symbol *s; + + if (r->depth != 1) { fail(t, "not allowed in a macro", "start"); return; } + if (!next_token(t, r, name)) { if (!t->failed) fail(t, "start without a name", NULL); return; } + if (!v4_text_finish(t)) return; + s = find(t, name); + if (!s || s->kind != KIND_WORD) { fail(t, "start of something not a word", name); return; } + t->start = s->value; +} + static void one_token(v4_text *t, reader *r, const char *tok) { const v4_text_symbol *s; @@ -435,6 +483,7 @@ static void one_token(v4_text *t, reader *r, const char *tok) v4_cell v; int op, big; + if (t->start >= 0) { fail(t, "text after start", tok); return; } if (strcmp(tok, "header") == 0) { header(t, r); return; } if (t->header_pending) { v4_cell f = flag_of(tok); @@ -454,6 +503,10 @@ static void one_token(v4_text *t, reader *r, const char *tok) if (strcmp(tok, "constant") == 0) { constant_directive(t, r); return; } if (strcmp(tok, "#,") == 0) { cell_directive(t, r); return; } if (strcmp(tok, "\",") == 0) { string_directive(t, r); return; } + if (strcmp(tok, "set") == 0) { set_directive(t, r); return; } + if (strcmp(tok, "store") == 0) { store_directive(t, r); return; } + if (strcmp(tok, "start") == 0) { start_directive(t, r); return; } + if (strcmp(tok, "here") == 0) { fail(t, "here is only a value", NULL); return; } if (strcmp(tok, "endmacro") == 0) { fail(t, "endmacro without macro", NULL); return; } if (is_label_def(tok)) { @@ -536,7 +589,7 @@ static void one_token(v4_text *t, reader *r, const char *tok) check_asm(t, tok); return; } - if (s && s->kind == KIND_CONST) { + if (s && (s->kind == KIND_CONST || s->kind == KIND_SET)) { v4_asm_lit(as, s->value); check_asm(t, tok); return; @@ -572,6 +625,7 @@ void v4_text_begin(v4_text *t, v4_node *n, v4_cell origin) t->failed = 0; t->message[0] = 0; t->latest = 0; + t->start = -1; t->header_pending = 0; } @@ -654,6 +708,19 @@ v4_cell v4_text_latest(const v4_text *t) return t->latest; } +int v4_text_value(const v4_text *t, const char *name, v4_cell *value) +{ + const v4_text_symbol *s = find(t, name); + if (!s || (s->kind != KIND_CONST && s->kind != KIND_SET)) return 0; + *value = s->value; + return 1; +} + +v4_cell v4_text_start(const v4_text *t) +{ + return t->start; +} + v4_cell v4_text_here(v4_text *t) { return v4_asm_label(&t->as); diff --git a/v4/system/boot.c b/v4/system/boot.c index af2c3904..1d6cc002 100644 --- a/v4/system/boot.c +++ b/v4/system/boot.c @@ -1,4 +1,5 @@ -/* boot.c -- the nucleus, then its capsules, then the prompt. See boot.h. +/* boot.c -- the machine's ROM assembles the system, then its capsules, then + * the prompt. See boot.h. * * Nothing here uses the C library: the bare-metal kernel links this file. * It is not part of the engine (v4/src): it needs the capsule directory, @@ -311,25 +312,19 @@ static void post_say(void *self, const char *text, unsigned len) /* ---- one capsule --------------------------------------------------------- */ -static void say_where(const v4_boot *b, const char *name, uint32_t block, uint32_t line) -{ - say(b, "\nV4: capsule "); say(b, name); - say(b, " block "); say_dec(b, block); - say(b, " line "); say_dec(b, line); -} - -static int load_capsule(const v4_boot *b, const char *name) +/* The capsule `name`: found, its hash checked, its signature verified -- one + * that does not verify is refused, a missing one is only reported. Its + * payload, or NULL with what was wrong said. */ +static const uint8_t *open_capsule(const v4_boot *b, const char *name, const CapsuleDesc **found) { const CapsuleDirHeader *dir = capsule_get_directory(); const CapsuleDesc *descs = capsule_get_descriptors(); const CapsuleNameEntry *names = capsule_get_names(); const uint8_t *arena = capsule_get_arena(); const CapsuleDesc *cap; - const uint8_t *p, *end; + const uint8_t *p; CapsuleValidateResult vr; CapsuleSigResult sr; - uint32_t block = 0, line = 0; - int in_block = 0; cap = capsule_find_by_name(dir, descs, names, name); if (!cap) { say(b, "V4: capsule "); say(b, name); say(b, " is not in this binary\n"); return 0; } @@ -348,6 +343,27 @@ static int load_capsule(const v4_boot *b, const char *name) p = capsule_get_payload(cap, arena); if (!p) { say(b, "V4: capsule "); say(b, name); say(b, " has no payload\n"); return 0; } + *found = cap; + return p; +} + + +static void say_where(const v4_boot *b, const char *name, uint32_t block, uint32_t line) +{ + say(b, "\nV4: capsule "); say(b, name); + say(b, " block "); say_dec(b, block); + say(b, " line "); say_dec(b, line); +} + +static int load_capsule(const v4_boot *b, const char *name) +{ + const CapsuleDesc *cap; + const uint8_t *p, *end; + uint32_t block = 0, line = 0; + int in_block = 0; + + p = open_capsule(b, name, &cap); + if (!p) return 0; end = p + cap->length; while (p < end) { @@ -391,78 +407,157 @@ static int load_capsule(const v4_boot *b, const char *name) return 1; } -/* ---- the nucleus ----------------------------------------------------------- */ +/* ---- the system: the machine's ROM assembles it ----------------------------- */ -/* The nucleus is a capsule of F18 code (v4/include/v4/capsule.h): the words - * themselves, to be written to the port of a node that has nothing in it. - * The boot is that node's neighbour. It finds the capsule, checks its hash - * and its signature as it does any capsule's, and gives the node a word - * each time it reads its port, until the node has taken them all and is - * where the nucleus waits to be handed a line. */ -#define NUCLEUS_NAME_(bits) "v4:nucleus-" #bits ".f18" -#define NUCLEUS_NAME__(bits) NUCLEUS_NAME_(bits) -#define NUCLEUS_NAME NUCLEUS_NAME__(V4_CELL_BITS) -#define CELL_BYTES (V4_CELL_BITS / 8) +/* The ROM (docs/v4.0.0/MACHINE.md section 2): the machine's one binary, + * built by v4/tools/mkrom.c for this cell width. The machine starts at its + * entry 12, (ROM) (capsules/v4/rom/main.f18), which reads the system's + * source from the console, assembles it into RAM and, at the source's + * `start`, runs it. */ +#if V4_CELL_BITS == 64 +extern const v4_cell v4_rom_64[]; +extern const unsigned v4_rom_64_words; +#define BOOT_ROM v4_rom_64 +#define BOOT_ROM_WORDS v4_rom_64_words +#else +extern const v4_cell v4_rom_32[]; +extern const unsigned v4_rom_32_words; +#define BOOT_ROM v4_rom_32 +#define BOOT_ROM_WORDS v4_rom_32_words +#endif +#define ROM_START 12u /* the entry where the machine starts */ +#define ROM_STEP_LIMIT 400000000ULL /* instruction words the ROM may take: it takes about 16 million */ +#define EOT 4 /* the end of the source: the ROM's (KEY) sees no more */ -static int load_nucleus(const v4_boot *b) +/* The system's source, in the order the ROM reads it: the memory map, then + * the system, then its end -- the state it is switched on in, and `start`. + * capsules/v4/sys; each blob is a capsule like any other. */ +#define MAP_NAME_(bits) "v4:sys:map-" #bits ".f18" +#define MAP_NAME__(bits) MAP_NAME_(bits) +static const char *const system_blobs[] = { + MAP_NAME__(V4_CELL_BITS), + "v4:sys:core.f18", "v4:sys:input.f18", "v4:sys:dict.f18", "v4:sys:codegen.f18", "v4:sys:compile.f18", + "v4:sys:quit.f18", "v4:sys:forth.f18", "v4:sys:numout.f18", "v4:sys:words.f18", "v4:sys:system.f18", + "v4:sys:qmath.f18", "v4:sys:blocks.f18", "v4:sys:log.f18", "v4:sys:acl.f18", + "v4:sys:end.f18", +}; +#define SYSTEM_BLOBS (sizeof system_blobs / sizeof system_blobs[0]) + +/* What the ROM's error codes mean (v4/tests/host_map.h, ROM_ERR_*): the ROM + * stops with the code, and the loader, which owns the console, says it. */ +static const char *const rom_errors[] = { + "", "name too long", "comment not closed", "cannot be used as a name", "already defined", + "too many names", "does not fit: memory is full, or a branch cannot reach", "not an opcode the packer takes there", + "not allowed in a macro", "macro without endmacro, or endmacro without macro", + "label already defined in this word", "too many labels in one word", + "FOR nested too deep, NEXT or UNEXT without FOR, or FOR without NEXT", + "FOR ... UNEXT must fit one instruction word and hold no literal", "not something to branch to", + "never defined", "number does not fit a cell", "& needs a word that is already defined", + "write the number, not @p", "a name, a target, a value or a string is missing", "macros nested too deep", + "too many unresolved branches", "not a value", "the source ended with no start", "start of something not a word", +}; +#define ROM_ERRORS (sizeof rom_errors / sizeof rom_errors[0]) + +/* FNV-1a over the ROM, a cell at a time, low byte first, as the dictionary + * hash is (image.c). */ +static uint64_t rom_hash(void) { - const CapsuleDirHeader *dir = capsule_get_directory(); - const CapsuleDesc *descs = capsule_get_descriptors(); - const CapsuleNameEntry *names = capsule_get_names(); - const uint8_t *arena = capsule_get_arena(); - const CapsuleDesc *cap; - const uint8_t *p; - CapsuleValidateResult vr; - CapsuleSigResult sr; - v4_node *n = b->n; - uint64_t words, at = 0, steps = 0; + uint64_t h = 0xcbf29ce484222325ULL; + unsigned w, i; + for (w = 0; w < BOOT_ROM_WORDS; w++) + for (i = 0; i < V4_CELL_BITS / 8; i++) { + h ^= (uint64_t)(((v4_ucell)BOOT_ROM[w] >> (8 * i)) & 0xFFu); + h *= 0x00000100000001b3ULL; + } + return h; +} - cap = capsule_find_by_name(dir, descs, names, NUCLEUS_NAME); - if (!cap) { say(b, "V4: capsule " NUCLEUS_NAME " is not in this binary\n"); return 0; } - vr = capsule_validate(cap, arena, dir->arena_size, 1); - if (vr != CAPSULE_VALID) { - say(b, "V4: capsule " NUCLEUS_NAME ": "); say(b, capsule_validate_result_str(vr)); say(b, "\n"); +/* The machine starts in its ROM, and the boot is its console: it feeds the + * system's source to the console a blob at a time, each found and checked + * as any capsule is, with a new line after each, and then EOT, until the + * ROM has assembled the system and started it. Then the node is where the + * system waits for a message, and its host reads from the image record + * what only the system knows (v4_image_from_node). If the ROM stops on an + * error, the blob and line are said, and what the error is. */ +static int load_system(const v4_boot *b) +{ + static const uint8_t *payload[SYSTEM_BLOBS]; + static uint32_t length[SYSTEM_BLOBS], first_line[SYSTEM_BLOBS]; + static const char newline = '\n', eot = EOT; + v4_node *n = b->n; + uint64_t steps = 0; + uint32_t lines = 0, at = 0; + unsigned i, blob = 0; + int fed_all = 0; + + for (i = 0; i < SYSTEM_BLOBS; i++) { + const CapsuleDesc *cap; + uint32_t k; + payload[i] = open_capsule(b, system_blobs[i], &cap); + if (!payload[i]) return 0; + length[i] = (uint32_t)cap->length; + first_line[i] = lines; + for (k = 0; k < length[i]; k++) if (payload[i][k] == '\n') lines++; + lines++; /* the new line after it */ + say(b, "PARITY:V4_F18 name="); say(b, system_blobs[i]); + say(b, " capsule_hash="); say_hex(b, cap->content_hash); + say(b, "\n"); + } + + v4_node_rom_attach(n, BOOT_ROM, BOOT_ROM_WORDS); + n->p = V4_ROM_BASE + (v4_cell)ROM_START; + while (n->p >= V4_ROM_BASE) { + /* the console is given more of the source whenever it has taken + * all it had */ + if (!fed_all && n->input_pos == n->input_len) { + if (blob < SYSTEM_BLOBS && at < length[blob]) { + at += v4_node_console_feed(n, payload[blob] + at, length[blob] - at); + } else if (blob < SYSTEM_BLOBS) { + if (v4_node_console_feed(n, &newline, 1)) { blob++; at = 0; } + } else if (v4_node_console_feed(n, &eot, 1)) { + fed_all = 1; + } + } + (void)v4_exec_step_word(n, b->es, b->h); + if (n->stopped || ++steps > ROM_STEP_LIMIT) { + say(b, "V4: the machine's ROM did not assemble the system\n"); + return 0; + } + if ((steps & 1023u) == 0 && n->mem[b->im->rom_failed] != 0) { + v4_cell code = n->mem[b->im->rom_failed]; + uint32_t line = (uint32_t)n->mem[b->im->rom_errline]; + for (i = SYSTEM_BLOBS; i-- > 1 && first_line[i] > line; ) { } + say(b, "V4: "); say(b, system_blobs[i]); say(b, " line "); say_dec(b, line - first_line[i] + 1u); say(b, ": "); + say(b, code > 0 && (unsigned)code < ROM_ERRORS ? rom_errors[code] : "an error the ROM has no words for"); + say(b, "\n"); + return 0; + } + } + + say(b, "PARITY:V4_ROM words="); say_dec(b, BOOT_ROM_WORDS); + say(b, " rom_hash="); say_hex(b, rom_hash()); + say(b, " instructions="); say_dec(b, (uint32_t)b->es->anticlock); + say(b, "\n"); + + if (!v4_image_from_node(n, b->im) || n->p != b->im->idle) { + say(b, "V4: the system the ROM assembled has no image record, or did not start where it says it waits\n"); return 0; } - sr = capsule_verify_signature(descs, names, capsule_get_signatures(), arena, dir->desc_count, (int)(cap - descs)); - if (sr != CAPSULE_SIG_OK) { - say(b, "V4: capsule " NUCLEUS_NAME " signature: "); say(b, capsule_sig_result_str(sr)); say(b, "\n"); - if (sr == CAPSULE_SIG_INVALID) return 0; - } - p = capsule_get_payload(cap, arena); - if (!p || cap->length % CELL_BYTES != 0) { say(b, "V4: capsule " NUCLEUS_NAME " is not whole words\n"); return 0; } - words = cap->length / CELL_BYTES; + v4_node_fault_attach(n, b->im->fault_table); - /* until it has taken every word and is where the nucleus waits for a - * message: asleep, no message having come */ + /* until it is where the system waits for a message: asleep, no message + * having come */ for (;;) { if (!boot_step(b)) { - if (at >= words && n->do_op == 8) break; - say(b, "V4: the node did not take the nucleus in\n"); + if (n->do_op == 8) break; + say(b, "V4: the system did not come to where it waits\n"); return 0; } if (n->stopped || n->asking || ++steps > STEP_LIMIT) { - say(b, "V4: the node did not take the nucleus in\n"); + say(b, "V4: the system did not come to where it waits\n"); return 0; } - if (n->reading && !n->given) { - v4_ucell word = 0; - unsigned i; - if (at >= words) { - say(b, "V4: the node wants more than the nucleus holds\n"); - return 0; - } - for (i = 0; i < CELL_BYTES; i++) word |= (v4_ucell)p[at * CELL_BYTES + i] << (8 * i); - v4_node_port_give(n, 0, (v4_cell)word); - at++; - } } - - say(b, "PARITY:V4_NUCLEUS name=" NUCLEUS_NAME); - say(b, " capsule_id="); say_hex(b, cap->capsule_id); - say(b, " capsule_hash="); say_hex(b, cap->content_hash); - say(b, " words="); say_dec(b, word_count(n, b->im)); - say(b, "\n"); return 1; } @@ -472,15 +567,15 @@ int v4_boot_run(const v4_boot *b) { unsigned i; - /* a node is born with nothing in it, and is sent the nucleus */ + /* a node is born with nothing in it, and its ROM assembles the system */ if (!v4_image_born(b->n, b->es, b->h, b->im)) { - say(b, "V4: the nucleus is not for this build of the engine\nPARITY:FAIL\nPOST: FAILED\n"); + say(b, "V4: the memory map is not for this build of the engine\nPARITY:FAIL\nPOST: FAILED\n"); return 0; } /* its console's wire, with nothing on it */ v4_wire_reset(TO_NODE); v4_wire_reset(FROM_NODE); v4_blocks_init(&boot_blocks, b->im->block_window); - if (!load_nucleus(b)) { say(b, "PARITY:FAIL\nPOST: FAILED\n"); return 0; } + if (!load_system(b)) { say(b, "PARITY:FAIL\nPOST: FAILED\n"); return 0; } /* the kernel's words, before any capsule that might use one */ for (i = 0; i < b->word_count; i++) { diff --git a/v4/tests/host_map.h b/v4/tests/host_map.h index 0315323d..8f873f49 100644 --- a/v4/tests/host_map.h +++ b/v4/tests/host_map.h @@ -5,7 +5,7 @@ * one. Every test_host_*.c uses this one, so that the capsule's variables * and buffers are in the same place in all of them: * - * 16 .. the capsule's code, assembled from capsule/ *.v4 + * 16 .. the capsule's code, assembled from capsules/v4/sys/ *.f18 * DICT_W .. DICT_END_W dictionary space for what is defined at run time * top of memory buffers, then variables, as below */ @@ -34,13 +34,13 @@ #define RSTACK_REG (TOP - 16) /* RSTACK-DEPTH */ /* each capsule file's scratch cells */ -#define PVARS (TOP - 24) /* (P): input.v4, 8 cells */ -#define DVARS (TOP - 32) /* (D): dict.v4, 5 cells */ -#define CGVARS (TOP - 48) /* (CG): codegen.v4, 14 cells */ -#define CVARS (TOP - 62) /* (C): compile.v4, 10 cells */ -#define FVARS (TOP - 105) /* (F): forth.v4, 7 cells */ +#define PVARS (TOP - 24) /* (P): input.f18, 8 cells */ +#define DVARS (TOP - 32) /* (D): dict.f18, 5 cells */ +#define CGVARS (TOP - 48) /* (CG): codegen.f18, 14 cells */ +#define CVARS (TOP - 62) /* (C): compile.f18, 10 cells */ +#define FVARS (TOP - 105) /* (F): forth.f18, 7 cells */ #define SVARS (TOP - 540 - (v4_cell)V4_DATA_DEPTH) /* (S): where PICK and ROLL set stack values aside, one cell for each cell of the stack */ -#define WVARS (TOP - 99) /* (W): numout.v4, 3 cells */ +#define WVARS (TOP - 99) /* (W): numout.f18, 3 cells */ #define CONTEXT (TOP - 64) /* the vocabulary names are looked up in */ #define CURRENT (TOP - 63) /* the vocabulary new words go into */ #define VOC_LINK (TOP - 50) /* the newest vocabulary */ @@ -57,14 +57,14 @@ #define SBUF_W (TOP - 540) /* 64 cells for the tests' own strings */ #define HBUF_W (SVARS - 16) /* the hold buffer: 16 cells = 64 bytes */ #define HEND ((HBUF_W + 16) * 4) -#define XVARS (HBUF_W - 4) /* (X): words.v4, 4 cells */ +#define XVARS (HBUF_W - 4) /* (X): words.f18, 4 cells */ #define QBASE (XVARS - 40) /* the Q words' and DUMP's scratch cells, 39 in all */ -#define BVARS (QBASE - 16) /* blocks.v4: 6 cells not used now, then SCR BLK (SRC) (SRC-HOOK) */ +#define BVARS (QBASE - 16) /* blocks.f18: 6 cells not used now, then SCR BLK (SRC) (SRC-HOOK) */ #define SCR (BVARS + 6) #define BLK (BVARS + 7) #define SRC (BVARS + 8) #define SRC_HOOK (BVARS + 9) -#define QUIET (BUF0_W - 10) /* 1 while the node does something that is no text's doing: an error then is not told (quit.v4, (RAISED)) */ +#define QUIET (BUF0_W - 10) /* 1 while the node does something that is no text's doing: an error then is not told (quit.f18, (RAISED)) */ #define REFUSED (BUF0_W - 7) /* how many of this node's messages it has been told were refused */ #define ACL_HOOK (BUF0_W - 6) /* the xt of the access control recheck word, or 0 */ #define LINE_STATUS (BUF0_W - 9) /* how the last line ended: 0 QUIT, 1 completed, 2 an error */ @@ -76,7 +76,7 @@ #define PRINT_TO (BUF0_W - 20) /* where what the text being served prints is to go: the node, */ #define PRINT_PORT (BUF0_W - 33) /* and the port, by its number, that leads there */ #define DONE_PORT (BUF0_W - 34) /* the port, by its number, that leads back to whoever sent the text being served */ -/* WHOLE MESSAGES (MESH.md 7d.4; core.v4). A node keeps no message but the one it is doing: these are what it +/* WHOLE MESSAGES (MESH.md 7d.4; core.f18). A node keeps no message but the one it is doing: these are what it * builds one in and looks at one with, and where it has got to in going through its wires. */ #define WIRE (PORT + (v4_cell)V4_PORT_WIRE) /* the six addresses after the ports (node.h): the wire an operation is about, */ #define WIRE_A (PORT + (v4_cell)V4_PORT_A) /* what it needs, */ @@ -235,7 +235,7 @@ typedef char host_map_ports_fit[(PORT >= OUT_W + OUT_CELLS && PORT + (v4_cell)V4_PORT_HAVE < OUT_HDR) ? 1 : -1]; /* Nothing printed: a node's variable for it, as at switch-on. */ #define HOST_MESSAGES_EMPTY(n) do { (n)->mem[OUT_PTR] = OUT_W; } while (0) -#define QVARS (BUF0_W - 4) /* (Q): quit.v4, system.v4 and blocks.v4, 4 cells */ +#define QVARS (BUF0_W - 4) /* (Q): quit.f18, system.f18 and blocks.f18, 4 cells */ #define WBUF (WBUF_W * 4) #define TIB (TIB_W * 4) #define PAD (PAD_W * 4) @@ -388,19 +388,25 @@ static int host_load(v4_text *tx, v4_node *n, const char *const *files, unsigned unsigned i; v4_node_reset(n); - HOST_MESSAGES_EMPTY(n); /* nothing has been printed and no message waits (core.v4) */ + HOST_MESSAGES_EMPTY(n); /* nothing has been printed and no message waits (core.f18) */ v4_text_begin(tx, n, 16); #define HOST_CONSTANT(name, value) v4_text_constant(tx, name, (v4_cell)(value)); HOST_CONSTANTS(HOST_CONSTANT) #undef HOST_CONSTANT v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG); for (i = 0; i < count; i++) { - snprintf(path, sizeof path, "%s/%s", V4_CAPSULE_DIR, files[i]); + snprintf(path, sizeof path, "%s/%s", V4_SYS_DIR, files[i]); if (!v4_text_assemble_file(tx, path)) { printf(" %s does not assemble: %s\n", files[i], v4_text_error(tx)); return 0; } } + /* the newest entry the source laid down (its HDR-LINK) is the + * assembler's latest: a `header` in a test's own text links to it */ + { + v4_cell newest; + if (v4_text_value(tx, "HDR-LINK", &newest)) tx->latest = newest; + } /* one vocabulary, FORTH, whose head cell is LATEST */ n->mem[CONTEXT] = LATEST; n->mem[CURRENT] = LATEST; diff --git a/v4/tests/rom_harness.h b/v4/tests/rom_harness.h index 19a1c89b..dc24b102 100644 --- a/v4/tests/rom_harness.h +++ b/v4/tests/rom_harness.h @@ -13,6 +13,7 @@ #include "v4/testcode.h" #include "host_map.h" #include +#include #include #if V4_CELL_BITS == 64 @@ -84,9 +85,13 @@ static int rom_in(const v4_node *n, const char *name) return (long)n->p >= start && (long)n->p < next; } +static char *rom_system_text(size_t *len); +static int rom_build_system(v4_node *n, long *words); + /* Reset `n`, attach the ROM and the console's receive registers. */ static void rom_boot(v4_node *n) { + (void)rom_build_system; (void)host_load; /* host_map.h's loader is not used here */ (void)host_branch_slots; (void)rom_call; /* not every test uses every helper */ @@ -99,4 +104,61 @@ static void rom_boot(v4_node *n) v4_node_console_input_attach(n, CONSOLE_RX, CONSOLE_ST); } +/* THE SYSTEM, AS THE MACHINE BUILDS IT (MACHINE.md section 6, step 1). The + * system's source, capsules/v4/sys (V4_SYS_DIR): the map, the fourteen and + * the end, each followed by a new line, then EOT -- what v4/system/boot.c + * feeds the console. rom_system_text gives it whole, *len its length; + * rom_build_system has `n`, booted with its ROM, assemble it, and runs it to + * its start: 1 if it started, with *words the instruction words it took. */ +static const char *const rom_system_files[] = { "core", "input", "dict", "codegen", "compile", "quit", "forth", + "numout", "words", "system", "qmath", "blocks", "log", "acl" }; + +static char *rom_system_text(size_t *len) +{ + size_t total = 0, cap = 1u << 20; + char *text = malloc(cap); + unsigned i; + if (!text) return NULL; + for (i = 0; i < 16; i++) { + char path[512]; + FILE *f; + long n; + if (i == 0) snprintf(path, sizeof path, "%s/map-%d.f18", V4_SYS_DIR, V4_CELL_BITS); + else if (i <= 14) snprintf(path, sizeof path, "%s/%s.f18", V4_SYS_DIR, rom_system_files[i - 1]); + else snprintf(path, sizeof path, "%s/end.f18", V4_SYS_DIR); + f = fopen(path, "rb"); + if (!f) { printf(" cannot read %s\n", path); free(text); return NULL; } + fseek(f, 0, SEEK_END); n = ftell(f); fseek(f, 0, SEEK_SET); + if (n < 0 || total + (size_t)n + 2 > cap || fread(text + total, 1, (size_t)n, f) != (size_t)n) { + fclose(f); free(text); return NULL; + } + fclose(f); + total += (size_t)n; + text[total++] = '\n'; /* a blob that does not end with a new line still ends a token */ + } + text[total++] = 4; /* EOT */ + *len = total; + return text; +} + +static int rom_build_system(v4_node *n, long *words) +{ + size_t total, fed = 0; + char *text = rom_system_text(&total); + long w = 0; + if (!text) return 0; + rom_boot(n); + v4_node_stack_regs_attach(n, DSTACK_REG, RSTACK_REG); + n->p = V4_ROM_BASE + 12; /* entry 12, (ROM): where the machine starts */ + while (n->p >= V4_ROM_BASE && w < 400000000L && !n->stopped) { + if (fed < total && n->input_pos == n->input_len) fed += v4_node_console_feed(n, text + fed, (unsigned)(total - fed)); + (void)v4_exec_step_word(n, &rom_es, &rom_h); + w++; + if (w % 1000 == 0 && n->mem[ROM_FAILED] != 0) break; + } + free(text); + if (words) *words = w; + return n->p < V4_ROM_BASE && n->mem[ROM_FAILED] == 0; +} + #endif /* V4_TESTS_ROM_HARNESS_H */ diff --git a/v4/tests/test_host_codegen.c b/v4/tests/test_host_codegen.c index 17ce4315..86d1a677 100644 --- a/v4/tests/test_host_codegen.c +++ b/v4/tests/test_host_codegen.c @@ -1,6 +1,6 @@ /* test_host_codegen.c -- the code generator, executed on the host node. * - * capsule/codegen.v4 packs opcodes, literals and branches into instruction + * capsules/v4/sys/codegen.f18 packs opcodes, literals and branches into instruction * words at HERE; it is what the compiling words will be built on. It is the * third thing in this tree that does that job -- after the slot packer in C * (asm.h) and the text assembler on top of it (text.h) -- and the first that @@ -107,7 +107,7 @@ static int lay_by_text(void) return v4_text_assemble(&rtx, src) && v4_text_finish(&rtx); } -/* By the code generator, on `n`: one call to a word of codegen.v4 for each +/* By the code generator, on `n`: one call to a word of codegen.f18 for each * item, as the compiling words will make them. */ static int lay_by_generator(void) { @@ -179,7 +179,7 @@ int main(void) CHECK(bslots == 3, "at this node size a branch may sit in slots 0 .. 2: %u", bslots); { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4" }; + static const char *const files[] = { "core.f18", "input.f18", "dict.f18", "codegen.f18" }; CHECK(host_load(&tx, &n, files, 4), "the capsule assembles"); } CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); diff --git a/v4/tests/test_host_compile.c b/v4/tests/test_host_compile.c index 46fd9361..352018f8 100644 --- a/v4/tests/test_host_compile.c +++ b/v4/tests/test_host_compile.c @@ -1,7 +1,7 @@ /* test_host_compile.c -- the defining and compiling words, executed on the * host node. * - * capsule/compile.v4 and capsule/forth.v4 on top of the earlier layers: for + * capsules/v4/sys/compile.f18 and capsules/v4/sys/forth.f18 on top of the earlier layers: for * the first time FORTH source text goes in and running code comes out. Each * test hands lines of source to INTERPRET, which defines words with : and ; * and the rest, runs them, and leaves results on the stack. @@ -195,7 +195,7 @@ int main(void) printf("v4 host compiler tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS); { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4" }; + static const char *const files[] = { "core.f18", "input.f18", "dict.f18", "codegen.f18", "compile.f18", "quit.f18", "forth.f18" }; CHECK(host_load(&tx, &n, files, 7), "the capsule assembles"); } /* two in-line words of the test's own, to exercise the in-liner: one with diff --git a/v4/tests/test_host_depth.c b/v4/tests/test_host_depth.c index b8ec1a13..4619b6c6 100644 --- a/v4/tests/test_host_depth.c +++ b/v4/tests/test_host_depth.c @@ -375,15 +375,15 @@ int main(void) printf("v4 mesh depth tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS); { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", - "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" }; + static const char *const files[] = { "core.f18", "input.f18", "dict.f18", "codegen.f18", "compile.f18", "quit.f18", "forth.f18", + "numout.f18", "words.f18", "system.f18", "qmath.f18", "blocks.f18", "log.f18", "acl.f18" }; CHECK(host_load(&tx, &nucleus, files, 14), "the nucleus assembles"); } CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; } w_idle = v4_text_word(&tx, "(IDLE)"); w_fault = v4_text_word(&tx, "(FAULTS)"); - nucleus.mem[DP] = DICT_W * 4; /* the variables, as at switch-on (tools/mkimage.c) */ + nucleus.mem[DP] = DICT_W * 4; /* the variables, as at switch-on (capsules/v4/sys/end.f18) */ nucleus.mem[LATEST] = v4_text_latest(&tx); nucleus.mem[CFP] = CFS_W; nucleus.mem[BASE] = 10; diff --git a/v4/tests/test_host_dict.c b/v4/tests/test_host_dict.c index ed52c5b5..c3a55cdb 100644 --- a/v4/tests/test_host_dict.c +++ b/v4/tests/test_host_dict.c @@ -2,7 +2,7 @@ * * DECOMPOSITION.md 5.12 and 5.13: HERE ALIGN ALLOT , C, 2, PAD LATEST, FIND * and ', and the entry-field words. The definitions are text, - * capsule/dict.v4, on top of core.v4 and input.v4. + * capsules/v4/sys/dict.f18, on top of core.f18 and input.f18. * * v4's dictionary is new: v3's was a C structure and its words handed out * host pointers. What carries over is what the words mean: @@ -192,7 +192,7 @@ int main(void) printf("v4 host dictionary tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS); { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4" }; + static const char *const files[] = { "core.f18", "input.f18", "dict.f18" }; CHECK(host_load(&tx, &n, files, 3), "the capsule assembles"); } capsule_latest = v4_text_latest(&tx); diff --git a/v4/tests/test_host_input.c b/v4/tests/test_host_input.c index c0c33250..596fb705 100644 --- a/v4/tests/test_host_input.c +++ b/v4/tests/test_host_input.c @@ -3,7 +3,7 @@ * * DECOMPOSITION.md 5.9 and 5.15: TIB >IN SPAN SOURCE BL EXPECT QUERY WORD * ENCLOSE CONVERT NUMBER and the comment words. The definitions are text, - * capsule/core.v4 and capsule/input.v4, assembled here by the text assembler. + * capsules/v4/sys/core.f18 and capsules/v4/sys/input.f18, assembled here by the text assembler. * * These are FORTH-79 words and follow the standard (ruled 2026-10-04) where * v3 did something else: @@ -211,7 +211,7 @@ int main(void) printf("v4 host input tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS); { - static const char *const files[] = { "core.v4", "input.v4" }; + static const char *const files[] = { "core.f18", "input.f18" }; CHECK(host_load(&tx, &n, files, 2), "the capsule assembles"); } /* the in-line names, as words the test can call */ @@ -263,7 +263,7 @@ int main(void) } n.mem[BASE] = 10; CHECK(v4_node_console_feed(&n, "Z", 1) == 1 && run("KEY", 0, 0, 0, 0) && pop() == 'Z' && clean(), "KEY"); - /* a node has no console of its own: what it prints is kept to be sent (core.v4) */ + /* a node has no console of its own: what it prints is kept to be sent (core.f18) */ n.mem[OUT_PTR] = OUT_W; CHECK(run("EMIT", 1, 'q', 0, 0) && clean() && n.mem[OUT_PTR] == OUT_W + 1 && n.mem[OUT_W] == 'q', "EMIT"); CHECK(run("EMIT", 1, 0x141, 0, 0) && clean() && n.mem[OUT_PTR] == OUT_W + 2 && n.mem[OUT_W + 1] == 'A', "EMIT prints the low 8 bits"); diff --git a/v4/tests/test_host_mesh.c b/v4/tests/test_host_mesh.c index d5cbb5dd..684dd9b9 100644 --- a/v4/tests/test_host_mesh.c +++ b/v4/tests/test_host_mesh.c @@ -4,7 +4,7 @@ * * console --1 [10] 2--2 [11] 3--2 [12] * - * Each node is the nucleus (v4/capsule/ *.v4) and nothing else. They start + * Each node is the nucleus (capsules/v4/sys/ *.f18) and nothing else. They start * alike, numbered 0 and knowing no way anywhere; everything they come to * know they are told by text sent from the console, as whoever wires a node * tells it. The console is a device on a port and speaks whole messages @@ -343,15 +343,15 @@ int main(void) printf("v4 mesh tests: V4_CELL_BITS=%d, V4_NODE_WORDS=%u\n", V4_CELL_BITS, (unsigned)V4_NODE_WORDS); { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", - "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" }; + static const char *const files[] = { "core.f18", "input.f18", "dict.f18", "codegen.f18", "compile.f18", "quit.f18", "forth.f18", + "numout.f18", "words.f18", "system.f18", "qmath.f18", "blocks.f18", "log.f18", "acl.f18" }; CHECK(host_load(&tx, &nucleus, files, 14), "the nucleus assembles"); } CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; } w_idle = v4_text_word(&tx, "(IDLE)"); w_fault = v4_text_word(&tx, "(FAULTS)"); - nucleus.mem[DP] = DICT_W * 4; /* the variables, as at switch-on (tools/mkimage.c) */ + nucleus.mem[DP] = DICT_W * 4; /* the variables, as at switch-on (capsules/v4/sys/end.f18) */ nucleus.mem[LATEST] = v4_text_latest(&tx); nucleus.mem[CFP] = CFS_W; nucleus.mem[BASE] = 10; diff --git a/v4/tests/test_host_quit.c b/v4/tests/test_host_quit.c index 99e28e09..fe9d6b1b 100644 --- a/v4/tests/test_host_quit.c +++ b/v4/tests/test_host_quit.c @@ -1,6 +1,6 @@ /* test_host_quit.c -- the prompt, executed on the host node. * - * capsule/quit.v4 on top of the earlier layers: QUIT, ABORT, ABORT" and ." . + * capsules/v4/sys/quit.f18 on top of the earlier layers: QUIT, ABORT, ABORT" and ." . * For the first time the node is not handed a line: it is started at QUIT and * left running, characters are fed to its console, and what it prints is * read back. Nothing here calls INTERPRET or pokes TIB. @@ -558,7 +558,7 @@ static const transcript script[] = { { "2 BASE ! 5 . DECIMAL\n", "UNKNOWN WORD: '5'\n ERROR\nok> ", 1 }, { ": T 10 0 DO I . LOOP ; T\n", "0 1 2 3 4 5 6 7 8 9 ok\nok> ", 1 }, { "DEPTH . 1 2 DEPTH . . .\n", "0 2 2 1 ok\nok> ", 1 }, - /* qmath.v4: every result printed by Q.PRINT, which shows all sixteen bits of the fraction */ + /* qmath.f18: every result printed by Q.PRINT, which shows all sixteen bits of the fraction */ { "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.PRINT\n", "1.00000 ok\nok> ", 1 }, { "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.SQRT Q.PRINT\n", "1.00000 ok\nok> ", 1 }, { "1 Q.FROM-INT 1 Q.FROM-INT Q./ Q.LOG Q.ABS Q.PRINT\n", "0.00000 ok\nok> ", 1 }, @@ -697,7 +697,7 @@ static const transcript script[] = { { "Q.0 Q.LOG 65 EMIT\n-1 Q.FROM-INT Q.LOG\n", "Argument out of range\n ERROR\nok> Argument out of range\n ERROR\nok> ", 0 }, { "7 PAD -1 DUMP 65 EMIT\n.S\n", "Negative count\n ERROR\nok> <1> 7 \n ok\nok> ", 0 }, { "PAD 0 DUMP\n", " ok\nok> ", 1 }, - /* acl.v4: the fields of an entry, and the check, as v3 */ + /* acl.f18: the fields of an entry, and the check, as v3 */ { ": FOO 65 EMIT ; ' FOO ACL-MODE@ . ' FOO ACL-TTL@ . ' FOO ACL-ALLOW@ .\n' FOO ACL-PINNED? .\n", "0 0 -1 ok\nok> 0 ok\nok> ", 1 }, { ": FOO 65 EMIT ; 1 ' FOO ACL-MODE! 77 ' FOO ACL-TTL! ' FOO ACL-MODE@ .\n' FOO ACL-TTL@ . FOO ' FOO ACL-TTL@ .\n", "1 ok\nok> 77 A76 ok\nok> ", 1 }, { ": FOO 65 EMIT ; ' FOO ACL-PIN ' FOO ACL-PINNED? . 5 ' FOO ACL-TTL!\n0 ' FOO ACL-ALLOW! 1 ' FOO ACL-MODE!\n' FOO ACL-TTL@ . ' FOO ACL-ALLOW@ . ' FOO ACL-MODE@ .\n", @@ -720,7 +720,7 @@ static const transcript script[] = { { ": IM 65 EMIT ; IMMEDIATE 3 ' IM ACL-TTL! 0 ' IM ACL-ALLOW! : U IM ;\n", "\033[33mWARN: \033[0mACL: denied 'IM'\n ERROR\nok> ", 0 }, { ": P1 ; : P2 ; VOCABULARY VV VV DEFINITIONS : P3 ; FORTH DEFINITIONS\n9 ' P1 ACL-TTL! 1 ' P2 ACL-MODE! ' P2 ACL-PIN VV 9 ' P3 ACL-TTL!\nACL-INIT-PRIMITIVES ' P1 ACL-TTL@ . ' P2 ACL-MODE@ . ' P3 ACL-TTL@ . FORTH\n", " ok\nok> ok\nok> 0 1 0 ok\nok> ", 0 }, - /* log.v4: v3's lines, colours and all, without its time of day */ + /* log.f18: v3's lines, colours and all, without its time of day */ { "LOG-LEVEL@ . LOG-ERROR . LOG-WARN . LOG-INFO . LOG-TEST . LOG-DEBUG .\n", "2 0 1 2 3 4 ok\nok> ", 1 }, { "LOG-INFO\" hello info\"\nLOG-WARN\" careful\"\nLOG-ERROR\" bad\"\nLOG-DEBUG\" dbg\"\nLOG-TEST\" tst\"\n", @@ -750,7 +750,7 @@ static const transcript script[] = { "\033[32mINFO: \033[0m\n ok\nok> ", 1 }, { ": W LOG-ERROR\" e\" LOG-WARN\" w\" LOG-TEST\" t\" ; W 3 LOG-LEVEL! W\n", "\033[31mERROR: \033[0me\n\033[33mWARN: \033[0mw\n\033[31mERROR: \033[0me\n\033[33mWARN: \033[0mw\n\033[35mTEST: \033[0mt\n ok\nok> ", 1 }, - /* blocks.v4 */ + /* blocks.f18 */ { "20 BLOCK 1024 BLANK 65 20 BLOCK C! UPDATE SAVE-BUFFERS 20 BLOCK C@ .\n", "65 ok\nok> ", 1 }, { "20 BLOCK 1024 BLANK 20 BLOCK 16 65 FILL UPDATE 20 LIST\nSCR @ .\n", @@ -789,7 +789,7 @@ static const transcript script[] = { { "7 FORGET DUP 65 EMIT\nFORGET NOSUCH\nDUP . .\n", "Protected word\n ERROR\nok> UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> 7 7 ok\nok> ", 0 }, { ": S3 S\" \" SWAP DROP . S\" ab\" S\" cde\" TYPE TYPE ; S3\n", "0 cdeab ok\nok> ", 0 }, { ": T3 ['] NOSUCH ;\n['] DUP\n", "UNKNOWN WORD: 'NOSUCH'\n ERROR\nok> [']: compile-only\n ERROR\nok> ", 0 }, - /* words.v4 */ + /* words.f18 */ { "1 2 3 4 2SWAP . . . .\n", "2 1 4 3 ok\nok> ", 1 }, { "1 2 3 4 2OVER . . . . . .\n", "2 1 4 3 2 1 ok\nok> ", 1 }, { "1 2 3 4 5 6 2ROT . . . . . .\n", "2 1 6 5 4 3 ok\nok> ", 1 }, @@ -918,7 +918,7 @@ int main(void) CHECK(storage_made(), "the chains behind the storage port are made"); { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" }; + static const char *const files[] = { "core.f18", "input.f18", "dict.f18", "codegen.f18", "compile.f18", "quit.f18", "forth.f18", "numout.f18", "words.f18", "system.f18", "qmath.f18", "blocks.f18", "log.f18", "acl.f18" }; CHECK(host_load(&tx, &n, files, 14), "the capsule assembles"); } CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); @@ -927,7 +927,7 @@ int main(void) if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; } w_idle = v4_text_word(&tx, "(IDLE)"); w_key = v4_text_word(&tx, "KEY"); - w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.v4 */ + w_key_end = v4_text_word(&tx, "CR"); /* the word after KEY in core.f18 */ w_fault = v4_text_word(&tx, "(FAULTS)"); capsule_latest = v4_text_latest(&tx); CHECK(w_key_end > w_key && w_key_end - w_key <= 12, "KEY is the few words before CR"); diff --git a/v4/tests/test_host_rom_nucleus.c b/v4/tests/test_host_rom_nucleus.c index d1107793..4b583ff8 100644 --- a/v4/tests/test_host_rom_nucleus.c +++ b/v4/tests/test_host_rom_nucleus.c @@ -1,13 +1,13 @@ -/* test_host_rom_nucleus.c -- the proof: the ROM rebuilds today's nucleus, word for word. +/* test_host_rom_nucleus.c -- the proof: the ROM assembles the system as text.c does, word for word. * - * Plan Task 8; MACHINE.md section 6, step 1. Node A is built as - * v4/tools/mkimage.c builds the nucleus: text.c assembles v4/capsule/ *.v4, - * then the switch-on state is set in C. Node B is the machine with its ROM, - * fed the system's blobs -- capsules/v4/sys/map-.f18, the fourteen - * .f18 files made from the .v4 ones, and end.f18 -- through the console. - * When the ROM starts the system, every word of B's RAM must be A's, except - * the ROM's own state area and the image record (which A does not have, and - * which must hold A's addresses). It also reports what the assembly cost: + * Plan Task 8 and 9; MACHINE.md section 6, step 1. The system's source is + * capsules/v4/sys: map-.f18, the fourteen .f18 files and end.f18. + * Node A is that source assembled off the node by text.c, the oracle (it + * speaks the ROM's language: constant, set, here, #, ", store, start). + * Node B is the machine with its ROM, fed the same source through the + * console. When the ROM starts the system, every word of B's RAM must be + * A's, except the ROM's own state area (which A does not have), and B must + * start where A's start says. It also reports what the assembly cost: * instructions retired and seconds (Captain Bob: watch the startup cost). */ #include "rom_harness.h" @@ -20,118 +20,55 @@ static int failures = 0, checks = 0; static v4_node a, b; static v4_text tx; -static const char *const files[] = { "core", "input", "dict", "codegen", "compile", "quit", "forth", - "numout", "words", "system", "qmath", "blocks", "log", "acl" }; -/* node A: mkimage.c's main, as it is */ +/* node A: text.c assembles the system's source, map first and end last */ static int build_a(void) { - static const char *const v4files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", - "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" }; - v4_cell k; - if (!host_load(&tx, &a, v4files, 14) || !v4_text_finish(&tx)) return 0; - a.mem[DP] = DICT_W * 4; - a.mem[LATEST] = v4_text_latest(&tx); - a.mem[STATE] = 0; - a.mem[CFP] = CFS_W; - a.mem[BASE] = 10; - a.mem[FENCE] = DICT_W; - a.mem[LOG_LEVEL] = 2; - a.mem[CONTEXT] = LATEST; - a.mem[CURRENT] = LATEST; - a.mem[SRC] = TIB; - a.mem[BOOT_CELLS] = a.mem[DP]; - a.mem[BOOT_CELLS + 1] = a.mem[LATEST]; - a.mem[FENCE] = (a.mem[DP] + 3) / 4; - a.mem[NODE_ERROR] = 0; - a.mem[BLK] = 0; a.mem[SCR] = 0; a.mem[SRC] = TIB; a.mem[SRC_HOOK] = 0; - for (k = BVARS; k < BVARS + 6; k++) a.mem[k] = 0; - for (k = BUF0_W; k < BUF0_W + (v4_cell)(V4_BLOCK_SLOTS * V4_BLOCK_CELLS); k++) a.mem[k] = 0; - for (k = TIB_W; k < TIB_W + 260; k++) a.mem[k] = 0; - for (k = WBUF_W; k < WBUF_W + WBUF_CELLS; k++) a.mem[k] = 0; - for (k = PAD_W; k < PAD_W + 21; k++) a.mem[k] = 0; - a.mem[TO_IN] = 0; a.mem[SPAN] = 0; - a.mem[LINE_STATUS] = 1; - HOST_MESSAGES_EMPTY(&a); - return 1; + char path[512]; + unsigned i; + v4_node_reset(&a); + v4_text_begin(&tx, &a, ROM_ORIGIN); + for (i = 0; i < 16; i++) { + if (i == 0) snprintf(path, sizeof path, "%s/map-%d.f18", V4_SYS_DIR, V4_CELL_BITS); + else if (i <= 14) snprintf(path, sizeof path, "%s/%s.f18", V4_SYS_DIR, rom_system_files[i - 1]); + else snprintf(path, sizeof path, "%s/end.f18", V4_SYS_DIR); + if (!v4_text_assemble_file(&tx, path)) return 0; + } + return v4_text_start(&tx) >= 0; } -/* the ROM's own cells, and the image record: not compared */ +/* the ROM's own cells: not compared */ static int excluded(v4_cell w) { return (w >= OUT_W - 144 && w < OUT_W - 64) || (w >= BUF0_W - 32 && w < BUF0_W - 22) - || (w >= BUF0_W - 122 && w < BUF0_W - 119) - || (w >= ROM_IMG && w < ROM_IMG + 4); -} - -static char *slurp(const char *name, size_t *len) -{ - char path[512]; - FILE *f; - char *t; - long n; - snprintf(path, sizeof path, "%s/%s", V4_SYS_DIR, name); - f = fopen(path, "rb"); - if (!f) { printf(" cannot read %s\n", path); return NULL; } - fseek(f, 0, SEEK_END); n = ftell(f); fseek(f, 0, SEEK_SET); - t = malloc((size_t)n + 2); - if (fread(t, 1, (size_t)n, f) != (size_t)n) { fclose(f); free(t); return NULL; } - fclose(f); - t[n] = '\n'; t[n + 1] = 0; /* a blob that does not end with a new line still ends a token */ - *len = (size_t)n + 1; - return t; + || (w >= BUF0_W - 122 && w < BUF0_W - 119); } int main(void) { - static char *text; - size_t total = 0, cap = 1u << 20, len, fed = 0; - char name[32]; - unsigned i; long words = 0; clock_t t0, t1; v4_cell w, idle_a; - CHECK(build_a(), "node A builds as mkimage.c builds it: %s", v4_text_error(&tx)); - idle_a = v4_text_word(&tx, "(IDLE)"); + CHECK(build_a(), "text.c assembles the system's source to its start: %s", v4_text_error(&tx)); + idle_a = v4_text_start(&tx); + CHECK(idle_a == v4_text_word(&tx, "(IDLE)"), "the system starts at (IDLE)"); - /* the system's source, as the loader will feed it: map, the fourteen, end, EOT */ - text = malloc(cap); - snprintf(name, sizeof name, "map-%d.f18", V4_CELL_BITS); - for (i = 0; i < 16; i++) { - char *t; - if (i == 0) t = slurp(name, &len); - else if (i <= 14) { char f18[32]; snprintf(f18, sizeof f18, "%s.f18", files[i - 1]); t = slurp(f18, &len); } - else t = slurp("end.f18", &len); - if (!t) { CHECK(0, "a blob is missing"); return 1; } - memcpy(text + total, t, len); total += len; free(t); - } - text[total++] = 4; - - rom_boot(&b); - v4_node_stack_regs_attach(&b, DSTACK_REG, RSTACK_REG); - b.p = V4_ROM_BASE + 12; t0 = clock(); - while (b.p >= V4_ROM_BASE && words < 400000000L && !b.stopped) { - if (fed < total) fed += v4_node_console_feed(&b, text + fed, (unsigned)(total - fed)); - (void)v4_exec_step_word(&b, &rom_es, &rom_h); - words++; - if (words % 1000 == 0 && rom_in(&b, "(ROM-FAILED)")) break; - } - t1 = clock(); - CHECK(b.p < V4_ROM_BASE, "the ROM started the system: P %ld, failed %ld at line %ld", (long)b.p, + CHECK(rom_build_system(&b, &words), "the ROM started the system: P %ld, failed %ld at line %ld", (long)b.p, (long)b.mem[ROM_FAILED], (long)b.mem[ROM_ERRLINE] + 1); + t1 = clock(); printf(" the ROM assembled the system: %lu instructions, %lu instruction words, %.2f s (%d-bit cells)\n", (unsigned long)rom_es.anticlock, (unsigned long)words, (double)(t1 - t0) / CLOCKS_PER_SEC, V4_CELL_BITS); - CHECK(b.p == idle_a, "it starts at (IDLE): %ld, mkimage's %ld", (long)b.p, (long)idle_a); + CHECK(b.p == idle_a, "it starts where text.c's start says: %ld, text.c's %ld", (long)b.p, (long)idle_a); CHECK(b.mem[ROM_IMG] == idle_a && b.mem[ROM_IMG + 1] == v4_text_word(&tx, "(FAULTS)") && b.mem[ROM_IMG + 2] == v4_text_word(&tx, "KEY") && b.mem[ROM_IMG + 3] == v4_text_word(&tx, "CR"), - "the image record holds mkimage's addresses"); + "the image record holds text.c's addresses"); for (w = 0; w < (v4_cell)V4_NODE_WORDS; w++) { if (excluded(w) || a.mem[w] == b.mem[w]) continue; - CHECK(0, "RAM word %ld: mkimage %lx, ROM %lx", (long)w, (unsigned long)a.mem[w], (unsigned long)b.mem[w]); + CHECK(0, "RAM word %ld: text.c %lx, ROM %lx", (long)w, (unsigned long)a.mem[w], (unsigned long)b.mem[w]); break; } CHECK(w == (v4_cell)V4_NODE_WORDS, "every word of RAM is the same"); diff --git a/v4/tests/test_host_unit.c b/v4/tests/test_host_unit.c index d51a49cd..9ad0aff6 100644 --- a/v4/tests/test_host_unit.c +++ b/v4/tests/test_host_unit.c @@ -7,8 +7,12 @@ * kernel --0 | / \ | square; the corners across from each * [13]---[14] other are not wired * - * Hera is born empty and is given the nucleus through the port her requests - * go to, as the boot gives it (v4/system/boot.c). She is told who she is, + * The host builds the system as the machine does: a node with its ROM + * assembles capsules/v4/sys (MACHINE.md section 6, step 1; tests/ + * rom_harness.h). That system, assembled, is the nucleus capsule: a node + * that is born is given assembled code, never the source (Captain Bob, + * 2026-10-15). Hera is born empty and is given it through the port her + * requests go to. She is told who she is, * given the words that ask for nodes (v4/include/v4/manage.h), FORTH-79, * POST, and her own capsule, capsules/v4/hera.4th. Then she is told * `10 UNIT`, and everything after that is hers: she asks for four nodes, @@ -16,7 +20,7 @@ * joins them and then FORTH-79 and POST a line at a time, and joins them. * * What stands in here for the host: the capsules are read from the files - * the build bakes in, and the nucleus is assembled as mkimage assembles it. + * the build bakes in. * * STORAGE (MESH.md section 8, acceptance 3). Every node asks its kernel * for its blocks, on its port 0, and the kernel's block subsystem @@ -38,14 +42,13 @@ #include #include -#include "host_map.h" +#include "rom_harness.h" static int failures = 0, checks = 0; #define CHECK(c,...) do{checks++; if(!(c)){failures++; printf("FAIL %s:%d: ",__FILE__,__LINE__); printf(__VA_ARGS__); printf("\n");}}while(0) #define PLACES 10u -static v4_text tx; -static v4_node nucleus; /* the nucleus, assembled: what the capsule of F18 code is written from */ +static v4_node nucleus; /* the system, as the ROM assembled it: what the capsule of F18 code is written from */ static v4_cell w_idle, w_fault; static v4_fabric_node pool[PLACES]; static int pool_used[PLACES]; @@ -369,28 +372,11 @@ int main(void) return 0; } CHECK(storage_made(), "the kernel's blocks are there before any node is"); - { - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", - "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" }; - CHECK(host_load(&tx, &nucleus, files, 14), "the nucleus assembles"); - } - CHECK(v4_text_finish(&tx), "everything is defined: %s", v4_text_error(&tx)); + CHECK(rom_build_system(&nucleus, 0), "the host's machine assembles the system with its ROM"); if (failures) { printf(" %d checks, %d failures\n", checks, failures); return 1; } - w_idle = v4_text_word(&tx, "(IDLE)"); - w_fault = v4_text_word(&tx, "(FAULTS)"); - nucleus.mem[DP] = DICT_W * 4; /* the variables, as at switch-on (tools/mkimage.c) */ - nucleus.mem[LATEST] = v4_text_latest(&tx); - nucleus.mem[CFP] = CFS_W; - nucleus.mem[BASE] = 10; - nucleus.mem[FENCE] = DICT_W; - nucleus.mem[BOOT_CELLS] = nucleus.mem[DP]; - nucleus.mem[BOOT_CELLS + 1] = nucleus.mem[LATEST]; - nucleus.mem[LOG_LEVEL] = 2; - nucleus.mem[CONTEXT] = LATEST; - nucleus.mem[CURRENT] = LATEST; - nucleus.mem[SRC] = TIB; - nucleus.mem[LINE_STATUS] = 1; - HOST_MESSAGES_EMPTY(&nucleus); + w_idle = nucleus.mem[ROM_IMG]; /* the image record (capsules/v4/sys/end.f18) */ + w_fault = nucleus.mem[ROM_IMG + 1]; + CHECK(nucleus.p == w_idle, "and it has started where it waits"); (void)v4_capsule_write(&nucleus, w_idle, f18_put, 0); CHECK(f18_count > 1000 && f18_count < sizeof f18 / sizeof f18[0], "the nucleus is a capsule of F18 code: %u cells", f18_count); memset(&im, 0, sizeof im); @@ -437,7 +423,7 @@ int main(void) CHECK(hera->mem[DP] == before[DP] && hera->mem[LATEST] == before[LATEST], "HERE and LATEST are where they were before POST"); for (k = 0; k < here; k++) if (hera->mem[k] != before[k]) { if (first < 0) first = k; changed++; } /* What differs is the TTL in the entry of each word POST had interpreted: a count of uses left before - * the word's access is checked again, which every use counts down (compile.v4, (ACL?)), as in v3. */ + * the word's access is checked again, which every use counts down (compile.f18, (ACL?)), as in v3. */ printf(" after POST and COLD: %ld of the %ld cells below HERE differ from before POST (the first at %ld); dict_hash %s\n", (long)changed, (long)here, (long)first, v4_image_dict_hash(hera, &im) == hash ? "the same" : "differs"); } diff --git a/v4/tests/test_text.c b/v4/tests/test_text.c index db2e88e9..d1b949e6 100644 --- a/v4/tests/test_text.c +++ b/v4/tests/test_text.c @@ -424,7 +424,7 @@ int main(void) CHECK(refused(": T &VAR ;", "already defined", 1), "and be a word"); CHECK(refused(": &X 1 ;", "cannot be used as a name", 1), "a name cannot begin with &"); - /* headers: a dictionary entry in front of a word (capsule/dict.v4) */ + /* headers: a dictionary entry in front of a word (capsules/v4/sys/dict.f18) */ CHECK(ok("header DUP : (DUP) dup + ;"), "a header assembles: %s", v4_text_error(&tx)); { v4_cell xt = v4_text_word(&tx, "(DUP)"); @@ -521,6 +521,36 @@ int main(void) "#, and \", are reserved"); } + /* ---- `set`, `here`, `store` and `start`: the rest of the ROM's language ---- */ + { + v4_cell v = 0; + CHECK(ok("set V 3 set V 4 #, V") && nb.mem[ORIGIN] == 4 && v4_text_value(&tx, "V", &v) && v == 4, + "a set variable may be set again; the newest value is its value: %s", v4_text_error(&tx)); + CHECK(ok("set V 7 : T V ;") && result("T", 0, 0, 0) == 7, "a set variable in code is a literal"); + CHECK(ok("constant K 2 set V K+1 #, V") && nb.mem[ORIGIN] == 3, "set takes a VALUE"); + CHECK(ok(": T ; set H here #, H set H here #, H") && nb.mem[ORIGIN + 1] == ORIGIN + 1 && nb.mem[ORIGIN + 2] == ORIGIN + 2, + "here is the next word address, the word before ended"); + CHECK(ok(": T dup set H here ; #, H") && nb.mem[ORIGIN + 2] == ORIGIN + 1, "here inside a word ends the instruction word"); + CHECK(ok("set V 1 #, V+1") == 0, "CONST+N is for constants only"); + CHECK(refused("constant K 1 set K 2", "already defined", 1), "set over a constant is refused"); + CHECK(refused("set V 1 constant V 2", "already defined", 1), "a constant over a set variable is refused"); + CHECK(refused("set V", "set without a value", 1), "set needs a value"); + CHECK(refused(": T here ;", "here is only a value", 1), "here alone is not something to assemble"); + CHECK(ok("constant A 300 store A 5 store A+1 &T : T ;") == 0, "store's &NAME needs a word already defined"); + CHECK(ok(": T ; constant A 300 store A 5 store A+1 &T") && nb.mem[300] == 5 && nb.mem[301] == ORIGIN, + "store puts a VALUE anywhere in RAM"); + CHECK(refused("store -1 5", "address out of range", 1), "store outside RAM is refused"); + CHECK(refused("store 5", "store without a value", 1), "store needs a value"); + CHECK(ok(": A ; : B ; start B") && v4_text_start(&tx) == ORIGIN + 1, "start names the word the system starts at"); + CHECK(ok(": A ;") && v4_text_start(&tx) == -1, "no start: -1"); + CHECK(refused(": A C ; start A", "never defined", 1), "at start every branch has its target"); + CHECK(refused("constant K 1 start K", "start of something not a word", 1), "start of a constant is refused"); + CHECK(refused(": A ; start A : B ;", "text after start", 1), "nothing comes after start"); + CHECK(refused(": set ;", "cannot be used as a name", 1) && refused(": here ;", "cannot be used as a name", 1) + && refused(": store ;", "cannot be used as a name", 1) && refused(": start ;", "cannot be used as a name", 1), + "set, here, store and start are reserved"); + } + CHECK(v4_node_guards_intact(&na) && v4_node_guards_intact(&nb), "guards intact"); printf(" %d checks, %d failures\n", checks, failures); diff --git a/v4/tools/hosted.c b/v4/tools/hosted.c index 4eec0e82..3a3898e2 100644 --- a/v4/tools/hosted.c +++ b/v4/tools/hosted.c @@ -1,7 +1,7 @@ -/* hosted.c -- StarForth v4 as a Linux program: the nucleus image on the - * golden model, its capsules loaded as the system comes up (v4/include/v4/ - * boot.h, the same boot the bare-metal kernel runs), the console on stdin - * and stdout. +/* hosted.c -- StarForth v4 as a Linux program: the golden model with its + * ROM, which assembles the system from its source, and its capsules loaded + * as the system comes up (v4/include/v4/boot.h, the same boot the + * bare-metal kernel runs), the console on stdin and stdout. * * It runs until its input ends. Blocks are kept in memory and are gone * when it stops. @@ -14,6 +14,7 @@ static v4_node n; static v4_exec_state es; static v4_heat h; +static v4_image im; /* STORAGE. The node asks its kernel for its blocks (v4/blocks.h), and the * kernel's block subsystem has them (docs/v4.0.0/MESH.md section 8). A @@ -58,7 +59,8 @@ int main(void) static char line[1026]; v4_boot boot; - boot.n = &n; boot.es = &es; boot.h = &h; boot.im = &v4_capsule_image; + im = v4_map_image; + boot.n = &n; boot.es = &es; boot.h = &h; boot.im = &im; boot.out = console_out; boot.key = console_key; boot.words = kernel_words; boot.word_count = sizeof kernel_words / sizeof kernel_words[0]; boot.serve = serve; sf_time_init(); diff --git a/v4/tools/mkimage.c b/v4/tools/mkimage.c deleted file mode 100644 index f4d17725..00000000 --- a/v4/tools/mkimage.c +++ /dev/null @@ -1,122 +0,0 @@ -/* mkimage.c -- build the capsule image (include/v4/image.h). - * - * mkimage DESCRIPTION.c CAPSULE.f18 - * - * Runs on the build machine. It assembles capsule/ *.v4 -- the nucleus, - * docs/v4.0.0/NUCLEUS.md -- onto a host node with the memory map of - * tests/host_map.h. It runs nothing. It writes the nucleus as a capsule - * of F18 code (v4/include/v4/capsule.h) -- what is sent to an empty node's - * port to make it a StarForth node -- and the addresses a host needs, as a - * C file (v4/include/v4/image.h). No FORTH source is compiled here: what - * is not in the nucleus is loaded from capsules when the system boots. - * - * The image is the same on every machine it is built on: nothing in it - * depends on the build machine but the cell width this tool was compiled - * for. - */ -#include "v4/image.h" -#include "v4/capsule.h" -#include "v4/text.h" -#include -#include -#include - -#include "../tests/host_map.h" - -static v4_node n; -static v4_text tx; -static v4_cell w_key, w_key_end; - -static void die(const char *what, const char *detail) -{ - fprintf(stderr, "mkimage: %s%s%s\n", what, detail ? ": " : "", detail ? detail : ""); - exit(1); -} - -/* one word of the capsule, to the file */ -static void put_word(void *self, v4_cell word) -{ - v4_ucell u = (v4_ucell)word; - unsigned i; - for (i = 0; i < V4_CELL_BITS / 8; i++) fputc((int)((u >> (8 * i)) & 0xFFu), (FILE *)self); -} - -/* every entry from xt back: no access control fields set */ -static void clear_acl(v4_cell xt) -{ - for (; xt != 0; xt = n.mem[xt - 1]) n.mem[xt - 3] &= 31; -} - -int main(int argc, char **argv) -{ - static const char *const files[] = { "core.v4", "input.v4", "dict.v4", "codegen.v4", "compile.v4", "quit.v4", "forth.v4", - "numout.v4", "words.v4", "system.v4", "qmath.v4", "blocks.v4", "log.v4", "acl.v4" }; - FILE *out; - v4_cell k, idle, faults, voc; - unsigned count = 0; - - if (argc != 3) die("usage: mkimage DESCRIPTION.c CAPSULE.f18", NULL); - - if (!host_load(&tx, &n, files, (unsigned)(sizeof files / sizeof files[0]))) die("the capsule does not assemble", NULL); - if (!v4_text_finish(&tx)) die("not everything is defined", v4_text_error(&tx)); - if (v4_text_here(&tx) >= DICT_W) die("the capsule's code runs into the dictionary space", NULL); - idle = v4_text_word(&tx, "(IDLE)"); - faults = v4_text_word(&tx, "(FAULTS)"); - w_key = v4_text_word(&tx, "KEY"); - w_key_end = v4_text_word(&tx, "CR"); - - /* the variables, as at switch-on */ - n.mem[DP] = DICT_W * 4; - n.mem[LATEST] = v4_text_latest(&tx); - n.mem[STATE] = 0; - n.mem[CFP] = CFS_W; - n.mem[BASE] = 10; - n.mem[FENCE] = DICT_W; - n.mem[LOG_LEVEL] = 2; - n.mem[CONTEXT] = LATEST; - n.mem[CURRENT] = LATEST; - n.mem[SRC] = TIB; - - /* The nucleus is the system as COLD finds it: COLD comes back to here, - * and FORGET will not go below it. What the capsules add at boot - * (v4/system/boot.c) is above it. */ - n.mem[BOOT_CELLS] = n.mem[DP]; - n.mem[BOOT_CELLS + 1] = n.mem[LATEST]; - n.mem[FENCE] = (n.mem[DP] + 3) / 4; - /* and nothing of the building is left behind: the terminal is the input, - * no block is in a buffer, no word has an access control field set */ - n.mem[NODE_ERROR] = 0; - n.mem[BLK] = 0; n.mem[SCR] = 0; n.mem[SRC] = TIB; n.mem[SRC_HOOK] = 0; - for (k = BVARS; k < BVARS + 6; k++) n.mem[k] = 0; - for (k = BUF0_W; k < BUF0_W + (v4_cell)(V4_BLOCK_SLOTS * V4_BLOCK_CELLS); k++) n.mem[k] = 0; - for (k = TIB_W; k < TIB_W + 260; k++) n.mem[k] = 0; - for (k = WBUF_W; k < WBUF_W + WBUF_CELLS; k++) n.mem[k] = 0; - for (k = PAD_W; k < PAD_W + 21; k++) n.mem[k] = 0; - n.mem[TO_IN] = 0; n.mem[SPAN] = 0; - clear_acl(n.mem[LATEST]); - for (voc = n.mem[VOC_LINK]; voc != 0; voc = n.mem[voc + 1]) clear_acl(n.mem[voc]); - if (!v4_node_guards_intact(&n)) die("the node's guards are damaged", NULL); - - n.mem[LINE_STATUS] = 1; /* nothing has ended badly */ - HOST_MESSAGES_EMPTY(&n); /* nothing has been printed, no message waits */ - - /* the nucleus as a capsule of F18 code: the words a neighbour writes to - * an empty node's port, each in V4_CELL_BITS / 8 bytes, low byte first */ - out = fopen(argv[2], "wb"); - if (!out) die("cannot write", argv[2]); - count = v4_capsule_write(&n, idle, put_word, out); - if (fclose(out) != 0) die("cannot write", argv[2]); - - out = fopen(argv[1], "w"); - if (!out) die("cannot write", argv[1]); - fprintf(out, "/* Generated by v4/tools/mkimage.c from v4/capsule -- do not edit. */\n#include \"v4/image.h\"\n\n"); - fprintf(out, "const v4_image v4_capsule_image = {\n %uu, %uu, %uu, %uu,\n", - (unsigned)V4_CELL_BITS, (unsigned)V4_NODE_WORDS, (unsigned)V4_DATA_RING, (unsigned)V4_RET_RING); - fprintf(out, " %ld,\n %ld, %ld,\n %ld, %ld,\n", (long)idle, (long)faults, (long)PORT, (long)w_key, (long)w_key_end); - fprintf(out, " %ld, %ld, %ld,\n %ld, %ld,\n %ld,\n %ld, %ld,\n %ld, %ld,\n %ld\n};\n", (long)CONSOLE_TX, (long)CONSOLE_RX, (long)CONSOLE_ST, - (long)DSTACK_REG, (long)RSTACK_REG, (long)NODE_ERROR, (long)DP, (long)LATEST, - (long)BOOT_CELLS, (long)FENCE, (long)BUF0_W); - if (fclose(out) != 0) die("cannot write", argv[1]); - fprintf(stderr, "mkimage: a capsule of %u words, dictionary to word %ld, %d-bit cells -> %s, %s\n", count, (long)((n.mem[DP] + 3) / 4), V4_CELL_BITS, argv[2], argv[1]); - return 0; -} diff --git a/v4/tools/mkmap.c b/v4/tools/mkmap.c index e2701793..c0fa9ac6 100644 --- a/v4/tools/mkmap.c +++ b/v4/tools/mkmap.c @@ -2,6 +2,7 @@ * * mkmap > rom-map-.f18 * mkmap sys > capsules/v4/sys/map-.f18 + * mkmap image > v4_map_.c * * Runs on the build machine, built for the host node (HOST_WORDS and the * host stack sizes) at one cell width. It writes, as `constant` lines in @@ -33,11 +34,30 @@ static int system_map(void) return 0; } +/* `mkmap image`: the system as its host knows it before it is built + * (include/v4/image.h, v4_map_image): what the build was for, the map's + * addresses, and where the image record and the ROM's error are. What only + * the assembled system knows -- where it waits, its fault table, KEY -- is + * -1 here; v4_image_from_node reads it from the image record. */ +static int image_description(void) +{ + printf("/* Generated by v4/tools/mkmap.c (mkmap image) from v4/tests/host_map.h -- do not edit. */\n"); + printf("#include \"v4/image.h\"\n\nconst v4_image v4_map_image = {\n"); + printf(" %uu, %uu, %uu, %uu,\n", (unsigned)V4_CELL_BITS, (unsigned)V4_NODE_WORDS, (unsigned)V4_DATA_RING, (unsigned)V4_RET_RING); + printf(" -1,\n -1, %ld,\n -1, -1,\n", (long)PORT); + printf(" %ld, %ld, %ld,\n %ld, %ld,\n %ld,\n %ld, %ld,\n %ld, %ld,\n %ld,\n", + (long)CONSOLE_TX, (long)CONSOLE_RX, (long)CONSOLE_ST, (long)DSTACK_REG, (long)RSTACK_REG, + (long)NODE_ERROR, (long)DP, (long)LATEST, (long)BOOT_CELLS, (long)FENCE, (long)BUF0_W); + printf(" %ld, %ld, %ld\n};\n", (long)ROM_IMG, (long)ROM_FAILED, (long)ROM_ERRLINE); + return 0; +} + int main(int argc, char **argv) { (void)host_load; /* host_map.h's loader is not this tool's */ (void)host_branch_slots; if (argc == 2 && argv[1][0] == 's') return system_map(); + if (argc == 2 && argv[1][0] == 'i') return image_description(); printf("\\ Generated by v4/tools/mkmap.c from v4/tests/host_map.h -- do not edit.\n"); constant("CONSOLE-RX", (long)CONSOLE_RX); constant("CONSOLE-STATUS", (long)CONSOLE_ST); diff --git a/v4/tools/v4tof18.py b/v4/tools/v4tof18.py deleted file mode 100644 index ff9029a6..00000000 --- a/v4/tools/v4tof18.py +++ /dev/null @@ -1,110 +0,0 @@ -#!/usr/bin/env python3 -"""v4tof18.py -- turn the nucleus's .v4 sources into the system's .f18 blobs. - - v4/tools/v4tof18.py - -Run once (MACHINE.md step 2; plan Task 8): reads v4/capsule/*.v4 and writes -capsules/v4/sys/*.f18. Everything is kept token for token and line for -line except `header NAME flags :`, which text.c lays down itself and the -ROM's language says with its directives: - - set HDR-NFA here ", NAME #, F #, HDR-NFA #, HDR-LINK set HDR-LINK here : - --- the name as a counted string, the flags (immediate 1, data 4, inline 8, -compile-only 16), the name's address and the link to the header before; -HDR-LINK is then the new entry's code address, as text.c's latest is. The -first file begins `set HDR-LINK 0`. The tokens are found as text.c's -next_token finds them: `\\` and `(` as whole tokens begin comments; a -header's name is the next run of characters, whatever they are. -""" -import os -import sys - -ROOT = os.path.abspath(os.path.join(os.path.dirname(__file__), "..", "..")) -SRC = os.path.join(ROOT, "v4", "capsule") -OUT = os.path.join(ROOT, "capsules", "v4", "sys") -FILES = ["core", "input", "dict", "codegen", "compile", "quit", "forth", "numout", - "words", "system", "qmath", "blocks", "log", "acl"] -FLAGS = {"immediate": 1, "data": 4, "inline": 8, "compile-only": 16} -BLANK = " \t\r\n" - - -def tokens(text): - """(token, start, end) for each token text.c's next_token would return, - and for each header its raw name.""" - i, n = 0, len(text) - raw_next = False - while True: - while i < n and text[i] in BLANK: - i += 1 - if i >= n: - return - j = i - while j < n and text[j] not in BLANK: - j += 1 - tok = text[i:j] - if raw_next: - raw_next = False - yield tok, i, j - i = j - continue - if tok == "\\": - while j < n and text[j] != "\n": - j += 1 - i = j - continue - if tok == "(": - k = text.find(")", j) - if k < 0: - sys.exit("comment not closed") - i = k + 1 - continue - yield tok, i, j - if tok == "header": - raw_next = True - i = j - - -def convert(text, first): - out, last = [], 0 - toks = list(tokens(text)) - k = 0 - while k < len(toks): - tok, s, e = toks[k] - if tok != "header": - k += 1 - continue - name = toks[k + 1][0] - flags, m = 0, k + 2 - while toks[m][0] != ":": - if toks[m][0] not in FLAGS: - sys.exit("header %s: %s is not a flag" % (name, toks[m][0])) - flags |= FLAGS[toks[m][0]] - m += 1 - colon = toks[m][1] - span = text[s:colon] - directive = ('set HDR-NFA here ", %s #, %d #, HDR-NFA #, HDR-LINK set HDR-LINK here ' - % (name, flags)) - out.append(text[last:s]) - out.append(directive + "\n" * span.count("\n")) - last = colon - k = m - out.append(text[last:]) - body = "".join(out) - if first: - body = "set HDR-LINK 0 \\ the newest dictionary entry: none yet\n" + body - return body - - -def main(): - os.makedirs(OUT, exist_ok=True) - for i, f in enumerate(FILES): - with open(os.path.join(SRC, f + ".v4")) as h: - text = h.read() - with open(os.path.join(OUT, f + ".f18"), "w") as h: - h.write(convert(text, i == 0)) - print("v4tof18: %d files -> %s" % (len(FILES), OUT)) - - -if __name__ == "__main__": - main()