From a755df496cc3abeae1624bb4eec89be4656bf30f Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Tue, 9 Jan 2024 07:28:22 -0800 Subject: [PATCH] Attempt better formatting for SHOW --- images/apple/PLFORTH.PO | Bin 143360 -> 143360 bytes src/toolsrc/plforth.pla | 83 +++++++++++++++++++++++----------------- 2 files changed, 48 insertions(+), 35 deletions(-) diff --git a/images/apple/PLFORTH.PO b/images/apple/PLFORTH.PO index ac4f0ea20704ce0fd1aaaa9a8747e383deb60b31..abd4433ecf32f0c4427afc4cd6c37f940fc85646 100755 GIT binary patch delta 3962 zcmYk;dvH@_8prYXoSvj<3A8|4n)H&iq-mN$3If6cRoWzlK$?^`6e^&xVnq+&K9DiP`#<% z6d$$NsqBo;T6}-3Z}NbSlKmphHLSY6D&(D1*4x@!^1e_5HPKxh^ks?W4>tIt=gH?v zw8$iXDEcGW=+wMb^hJ&k{hVsJCTb>GoCbf$N0CcW=}e{Q-BnDv+^M;I;WAV5qT8IR zFC2?j(7x<61pQTw{t1&QdYmTq1jFIFGIMfYW~r7eq7i1JU1_fJ{~sdu*PMm_D>9iqAycya2cv5R#Ci8vB_na7K#L7!RT(Pc9&uLq(IOg z{eU9jGS>U+{8f?YXH@%K#+q>bM1Q31B-O|=qqm-s-*k~`hL~)FgcxpBy+cexNR?J)Y}+WpbcZrC8oQZfFHvTa|bvP7kvfo0zsw6!SiumiVcjnW1x+E=7TkH1)xF`EE8tpu+8G*>$C&^nJ z%DCtj!V!nT8|M3pZ4}2{T1_D26A5zqS(j33{~IYYapb=8z<_*FGg6cd%TFCFPKn-- z82H!je5EU{bmsP5U8YSB*ZV}DTp>=!ot<`vX*jXot$0k;ggm$E@R+8MZgQu1i4meZ zKCiPl)>CF|sH^h&8$^tr=GG!jb$;;#`CGSI9kf47YIbYhNmcdscJf1RrP#iMu-UCO z1OpL6@@JvE*dsKTr?|}YE)yYCPqF<|lBrzvxa?h|(d8)(^H$07_XQ1 zN~%XII7QHBswKZtp}1T#38@t+)lGhJ7xB#stzlAldfOuMr6FmtWYG|*@=g)U=K>3MCuS?YMB2$k3d_>3C$q#4oEk&Xb84VEs7N>u4~h)8MuZq+Vs-XO zRwC{=?Mu&{SDG1VE?VRa#h0AEZGf+0R%DA~u4CZ%%%D*Sw#AR09?j`8&Wz&If5yW} z?>`exUTFW>-z!ROyy|?Zaw2~B`3IHb@ssB_B~)fTn6RjXSkJWAYo zv9_v3<7T7dO+ka;+q9@-)O*$Dd$mxG@EGmM-=)6)Yqx6iglG(=CwC4@YSBWA<0~)z zqSVBfUwV!EDZOkj@KxNR%}5cE&F;XAFl*6dRux?G*W4;tL!b3x1|Q-Iahqj()i3Pl}aMM=}K2D4>C)IT8m{kfzd9Z-i9^UfK6z3iI|!o?89-K zMP`{$M`AU)a2h?(+(ONR8#kdI&3Fi#@hwc{TnH`Li6cl15$e~tg#AN>`V$I0LM_E` z&&@&|PpH9sEWu%XgKJPKgqn&B_)v$rcoeVT&BV?hW2RVnmXIT|gnna|S&k!5fEP8G zf-oYOftk1!&A0~(aUWXoFdo5bti|JqbKZ?vn*LmtDxatRBi_I+`k!QJ^3yC4lSgTE z;uKEf9KOR9Ttg2`*+REuYcfAu$Rd=%gW(v>EX=H)+=wR3#_gEHYy~q(UX8U_2OS%+ zDLW?Q^Msf1Dz;$<65y3D-^GVGh);18$I!)zPi6O$r^(&8f~)j?q4z86Z`o!&HODN| zbA-&m0OY_5{sSOO;6izfj}bXSADz=rjwM&222;Rqo<5b6@Wz)-m_W_0Yd5FyGTYiDBz{^{n!*{rX*i|G9-FY$%Jc6a?8W<5p?_fQr+;i6pnqmH z%cIntR}PZo=v9Y^ZbqZLZ+i{zR>L$oIg+>k)NfHLsh;_`k75a5MeZ;iG5LKcarB~ zKJLZ+co0jm91^Rr7EfS3$Gw`b>3_!d{1n*{qq!IF;{XogD_p?8@C#B3gzSd_u)VN$xjrd=v$d>FDTOADKP503yktZjyr@- z=CQME?&d(HQ0S?J2Hjk!%A7(WZE(N^4{pHkPzf(4Vlrw`hXyoa7Vba`?!iK|a_&uq zntYM`GTuM}9fdsq-GsetIK+k{TpiSrnHcfY+)K;W> zY)1VCn^BHo=Eo%FL7PLr-KNPo+ux+z-+Ui3D{DLJHoHyV&PCs1zLR>Fy+Ge%FO=_5@1x#t iA1ps2AHrdLjxRedYf7e)$W&ic)@UZBLo=zrmi`y8mjhM+ delta 3851 zcmYk;dvp_J8prW>rjyW1ghKD>C25k3nFq$(-Z=264K!&!UmL!uoQ~iRF3Ij z5#h+izyO-Qr_=ksNBUSFf zmJcPVb=15~Qnqv|UGQ(dkP4-X-Eo1CJ%z$BHI}4^j0_=43gn?tVf1fwO0O9YHZF{t zx(?V*`c_4KA^*s-?$)-F4}=`7iM`7~pOh$p+WJ8368S`lqK*uNV%Nz(l_-86 zeUT}|?Gia$6SI(#oTfminj)K`!r6nOdsh+VT&Loy4wrR3r)Y7?)!}%olJ;4rsW#vn z7Z^T@qTQLup4xCYQl@loELFOSn98iwmE`jL|8P#J$Ic}?~wXsqYMnh;cDYsf7Q>HgTugfAQ>f0*kPZ&G~f zQfh*sYSBtg{>mkl+TSOM*5i+Qf_-wu_xFghzIoFeyf7L_UE z!_jJyk}bq>!}+z{A^H)k+>%#R5mMZ;!z)IUyzT@)Q6*Z9* zR~a)lsETZ|Qfcy4g`=u)P^4BSy1FZ#t}nH#(tM}151|THa*En&QAeI$DY@*E2nW3h zRTBeZCb6+nsUI00-!z|mraUR$Rn)6K|7h_9o#u+q2#M>g>`~bz0$k=O|$z zw8qG~;^ndC%4%txapa1J!*5;LudH!9uNl@WxzYjSY`fdDO3V=Iio$8mQ4WWtE9-@e z3c|T9?Xeo*@sE8@k#vl+dfjzN^1TW@Gn%{=)fZcG&Zk z$_JDQ2|``tp5;gz+_yGGIEUn@XA2@Gp}LIC9rII`i>~YBIYSMGtux;$J9>3@^um}r z#2OjgT}&&CDGp;oXSKA<*w{Hl+GKpwc{)DIA>?|r;0v5bYKf2oScnx^k1g1SPjCW1 z;Wm<-LaxAEwBRh-Axecj1at5?N?k$@V+odH71p~%T;4=@8=vAUh%zBNun3279PPM{ z6t|GA@S+M)%)%NR!wr;rggg$f;Q%(3b744x<_aP2#J6ZeN5wE9-z1p5+?jAUp2udq zhrKw6!%!-DXW&8*)6v-a^YwUQyfR(rcc)vld((wB7{gG75g3gKRE)<1n1WfDgLznh zMR*b#nz0gVIq$l3Mc%ncfWQN5CCgTZkphn&}(l^>~?jPo|>n zCGW>a_zXvI0w-|}=h=6W<1Ulq+6nKFSPJg4aqVfsDsY?Cp2Mryj5n|qJFpA8@d5sYL--Q^#wnb^WwfIc z|Ajf5i@;q-g%viq&=>dM{%k(~p#&dl5JW8^n1D%m2s7{q8qkP^Sc)gIh5l5wMSGgO z8f)+z3~T`RVr?T{!Deh>|JLlD+TX}Ku!~!`wj1wbAHxHj>|63#{0MUnSAm}3zN*>b zMg{K85&EDUt2UhMM-3uS=}*k*rA=mS$l;ej?=kX|ITmdN>*}07`r4cx+B*92=XrP? z+ZgP~>7%{N`d*Gj-%tLC{z>YN99h4G-d2;IX_a+5O00>xoAr0N&zhtUWeqY9S!J!> zDzwR%js`436IQ{%7Hq>iRuR{CT6^kytbO$TR*QDfD)f)77X1kIX-;&LO-ioNdLSA6 zr%Er*RWuLz9t^;J@X?RvD*C+K41INOhPIX79(sFOKW1&?m`kizb8Xr+dOzV;+{%p$ zJvC40X?baSabCLaLBBkk);~{Z12GuGP=g@*BFx5;Ctwn$;9<zxH=?FKWGO=yWWp<8SYz0js;4)P$Iq7OrrEkO$~uR{bA zFbPvJ1COwGuFat>U|npBJMVei*}BD9+%OM4qV62 z_zkk1pDQfrg)CT60EeBw_jX11*%fUh^=O0;t>s}X!%6lOZ3^pD)`wYV*=_n3@xsn}lawm$)J;-?yi!S&b}EVT&C>q?q|@wa diff --git a/src/toolsrc/plforth.pla b/src/toolsrc/plforth.pla index cad56ff..7b7f5a3 100644 --- a/src/toolsrc/plforth.pla +++ b/src/toolsrc/plforth.pla @@ -86,6 +86,7 @@ byte = $60 // RTS const inline_flag = $01 const inlinew_flag = $02 const param_flag = $04 +const showcr_flag = $08 // Help pretty print SHOW const itc_flag = $10 const imm_flag = $20 const componly_flag = $40 @@ -118,7 +119,7 @@ predef _abort_(a)#0, _doabortstr_(a,b)#0, _abortstr_#0 predef _compword_(dentry)#0, _compliteral_(a)#0, _execword_(dentry)#0, _isnum_(a,b)#2 // DROP char d_drop = "DROP" -byte = inline_flag +byte = inline_flag | showcr_flag word = 0, 0, 0, $30 // SWAP char d_swap = "SWAP" @@ -254,15 +255,15 @@ byte = 0 word = @d_min, 0, @_max_ // CHAR PUT char d_cset = "C!" -byte = inline_flag +byte = inline_flag | showcr_flag word = @d_max, 0, 0, $70 // WORD PUT char d_wset = "!" -byte = inline_flag +byte = inline_flag | showcr_flag word = @d_cset, 0, 0, $72 // WORD PLUS PUT char d_wplusset = "+!" -byte = 0 +byte = showcr_flag word = @d_wset, 0, @_wplusset_ // CHAR GET char d_cget = "C@" @@ -274,11 +275,11 @@ byte = inline_flag word = @d_cget, 0, 0, $62 // EXECUTE char d_execute = "EXECUTE" -byte = 0 +byte = showcr_flag word = @d_wget, 0, @_execword_ // TO RSTACK char d_torstk = ">R" -byte = 0 +byte = showcr_flag word = @d_execute, 0, @_tors_ // FROM RSTACK char d_fromrstk = "R>" @@ -326,11 +327,11 @@ byte = 0 word = @d_pad, 0, @_allot_ // BRANCH ( not in vocabulary ) char d_branch = "(BRANCH)" -byte = param_flag | inline_flag +byte = param_flag | inline_flag | showcr_flag word = 0, 0, @_branch_, $C4 // BRANCH IF 0 ( not in vocabulary ) char d_0branch = "(0BRANCH)" -byte = param_flag | inline_flag +byte = param_flag | inline_flag | showcr_flag word = 0, 0, @_0branch_, $C2 // IF char d_if = "IF" @@ -362,7 +363,7 @@ byte = imm_flag | componly_flag word = @d_endof, 0, @_endcase_ // COMPILED DO ( not in vocabulary ) char d_dodo = "(DO)" -byte = 0 +byte = showcr_flag word = 0, 0, @_dodo_ // DO char d_do = "DO" @@ -374,7 +375,7 @@ byte = componly_flag word = @d_do, 0, @_leave_ // COMPILED LOOP ( not in vocabulary ) char d_doloop = "(DOLOOP)" -byte = param_flag +byte = param_flag | showcr_flag word = 0, 0, @_doloop_ // LOOP char d_loop = "LOOP" @@ -382,7 +383,7 @@ byte = imm_flag | componly_flag word = @d_leave, 0, @_loop_ // COMPILED LOOP+ ( not in vocabulary ) char d_doplusloop = "(+DOLOOP)" -byte = param_flag +byte = param_flag | showcr_flag word = 0, 0, @_doplusloop_ // LOOP char d_plusloop = "+LOOP" @@ -418,15 +419,15 @@ byte = imm_flag | componly_flag word = @d_while, 0, @_repeat_ // FORGET char d_forget = "FORGET" -byte = 0 +byte = interponly_flag word = @d_repeat, 0, @_forget_ // CREATE char d_create = "CREATE" -byte = 0 +byte = showcr_flag word = @d_forget, 0, @_create_ // RECREATE/DOES COMPILE TIME ( not in vocabulary ) char d_createdoes = "(CREATEDOES)" -byte = 0 +byte = showcr_flag word = 0, 0, @_itcdoes_ // DOES char d_does = "DOES>" @@ -434,11 +435,11 @@ byte = imm_flag | componly_flag word = @d_create, 0, @_does_ // COMMA char d_comma = "," -byte = 0 +byte = showcr_flag word = @d_does, 0, @_dictaddw_ // COMMA char d_commab = "C," -byte = 0 +byte = showcr_flag word = @d_comma, 0, @_dictaddb_ // COLON char d_colon = ":" @@ -470,7 +471,7 @@ byte = imm_flag word = @d_interponly, 0, @_immediate_ // EXIT char d_exit = "EXIT" -byte = imm_flag | componly_flag +byte = imm_flag | componly_flag | showcr_flag word = @d_immediate, 0, @_exit_ // SEMI char d_semi = ";" @@ -522,19 +523,19 @@ byte = 0 word = @d__isnum_, 0, @_trailing_ // PRINT @TOS char d_prat = "?" -byte = 0 +byte = showcr_flag word = @d_trailing, 0, @_prat_ // PRINT TOS char d_prtos = "." -byte = 0 +byte = showcr_flag word = @d_prat, 0, @_prval_ // PRINT TOS HEX char d_prtoshex = "$." -byte = 0 +byte = showcr_flag word = @d_prtos, 0, @_prhex_ // PRINT TOS HEX BYTE char d_prtosbyte = "C$." -byte = 0 +byte = showcr_flag word = @d_prtoshex, 0, @_prbyte_ // EMIT char d_emit = "EMIT" @@ -574,7 +575,7 @@ byte = param_flag | inline_flag word = 0, 0, @_slit_, $2E // PRINT STRING FROM STACK char d_doprstr = "(.\")" -byte = 0 +byte = showcr_flag word = @d_str, 0, @puts // PRINT STRING char d_prstr = ".\"" @@ -586,7 +587,7 @@ byte = imm_flag word = @d_prstr, 0, @_prpstr_ // READ SOURCE FILE FROM STACK char d_src = "SRC" -byte = 0 +byte = showcr_flag word = @d_prpstr, 0, @_src_ // READ SOURCE FILE FROM INPUT char d_srcstr = "SRC\"" @@ -594,7 +595,7 @@ byte = imm_flag word = @d_src, 0, @_srcstr_ // END SOURCE FILE char d_endsrc = "ENDSRC" -byte = 0 +byte = showcr_flag word = @d_srcstr, 0, @_endsrc_ // CONTINUE AFTER BRK char d_cont = "CONT" @@ -602,15 +603,15 @@ byte = interponly_flag word = @d_endsrc, 0, @_cont_ // QUIT char d_quit = "QUIT" -byte = 0 +byte = showcr_flag word = @d_cont, 0, @_quit_ // ABORT IF <> 0 char d_abort = "ABORT" -byte = 0 +byte = showcr_flag word = @d_quit, 0, @_abort_ // DOABORTSTR char d_doabortstr = "(ABORT\")" -byte = 0 +byte = showcr_flag word = @d_abort, 0, @_doabortstr_ // ABORTSTR char d_abortstr = "ABORT\"" @@ -618,11 +619,11 @@ byte = imm_flag word = @d_doabortstr, 0, @_abortstr_ // COLD exitforth char d_exitforth = "COLD" -byte = 0 +byte = showcr_flag word = @d_abortstr, 0, @_restart_ // COMMENT char d_comment = "(" -byte = imm_flag +byte = imm_flag | showcr_flag word = @d_exitforth, 0, @_comment_ // // PLFORTH custom words @@ -1233,8 +1234,9 @@ end def _does_#0 if state & comp_itc_flag _dictaddw_(@d_lit) - _dictaddw_(heapmark + 6) // Pointer to DOES code + _dictaddw_(heapmark + 8) // Pointer to DOES code _dictaddw_(@d_createdoes) + _dictaddw_(0) // Double zero for SHOW _dictaddw_(0) // End of else // comp_pbc_flag @@ -1253,7 +1255,7 @@ def _colon_#0 newdict state = state | comp_mode if state & comp_itc_flag - ^(_ffa_(vlist)) = itc_flag + ^(_ffa_(vlist)) = itc_flag | showcr_flag *(_cfa_(vlist)) = @_docolon_ else // comp_pbc_flag _dictaddb_(JSR); _dictaddw_(vmvect) @@ -1274,6 +1276,9 @@ def _exit_#0 end def _semi_#0 _exit_ + if state & comp_itc_flag // Add double zero at end of definition for SHOW + _dictaddw_(0) + fin addhash(vlist) state = state & ~comp_flag end @@ -1718,7 +1723,7 @@ def _show_#0 fin w = *pfa while w - puts(" ") + puts(" ") if ^_ffa_(w) & param_flag pfa = pfa + 2 fin @@ -1732,9 +1737,17 @@ def _show_#0 else puts(w) fin - putln + if ^_ffa_(w) & showcr_flag; putln; fin pfa = pfa + 2 w = *pfa + if !w + puts(" EXIT\n") + pfa = pfa + 2 + w = *pfa + fin + if conio:keypressed() + getc; getc + fin loop fin end @@ -1891,9 +1904,9 @@ while vlist if *_cfa_(vlist) == 0 *_cfa_(vlist) = heapmark _dictaddb_(JSR); _dictaddw_(vmvect) - if ^_ffa_(vlist) == inline_flag + if ^_ffa_(vlist) & inline_flag _dictaddb_(^_pfa_(vlist)) - elsif ^_ffa_(vlist) == inlinew_flag + elsif ^_ffa_(vlist) & inlinew_flag _dictaddw_(*_pfa_(vlist)) else puts(vlist); puts(": Invalid dictionary\n")