From c681cb639d330ab71207920439f4be6242e94037 Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Mon, 4 May 2020 22:30:29 -0400 Subject: [PATCH] Add words >< and =><= --- blk/056 | 12 +++++++----- blk/394 | 4 +++- blk/395 | 5 ++--- blk/399 | 12 +++--------- blk/401 | 7 ++----- blk/444 | 2 +- emul/forth.bin | Bin 5715 -> 5729 bytes 7 files changed, 18 insertions(+), 24 deletions(-) diff --git a/blk/056 b/blk/056 index d2bc570..d3db076 100644 --- a/blk/056 +++ b/blk/056 @@ -1,11 +1,13 @@ Logic -= n1 n2 -- f Push true if n1 == n2 -< n1 n2 -- f Push true if n1 < n2 -> n1 n2 -- f Push true if n1 > n2 -CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1. += n1 n2 -- f Push true if n1 == n2 +< n1 n2 -- f Push true if n1 < n2 +> n1 n2 -- f Push true if n1 > n2 +>< n l h -- f Push true if l < n < h +=><= n l h -- f Push true if l <= n <= h +CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1. n=0: a1=a2. n=1: a1>a2. n=-1: a1= < NOT ; : <= > NOT ; : 0>= 0< NOT ; - +( n l h -- f ) +: >< 2 PICK > ( n l f ) ROT ROT > AND ; +: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ; ( a -- a+1 c ) : C@+ DUP C@ SWAP 1+ SWAP ; ( c a -- a+1 ) diff --git a/blk/395 b/blk/395 index 6223ae9..00037e1 100644 --- a/blk/395 +++ b/blk/395 @@ -5,10 +5,9 @@ : _pdacc DUP 0x21 < IF DROP 1 EXIT THEN ( parse char ) - '0' - ( if bad, return "r -1" ) - DUP 0< IF DROP -1 EXIT THEN ( bad ) - DUP 9 > IF DROP -1 EXIT THEN ( bad ) + '0' - + DUP 10 < NOT IF DROP -1 EXIT THEN ( good, add to running result ) SWAP 10 * + ( r*10+n ) 0 ( good ) diff --git a/blk/399 b/blk/399 index bac471c..1b5d0e8 100644 --- a/blk/399 +++ b/blk/399 @@ -1,14 +1,8 @@ ( returns negative value on error ) : _ ( c -- n ) - ( '0' is ASCII 48 ) - 48 - - DUP 0< ( bad ) OVER 10 < ( good ) OR IF EXIT THEN - ( 'a' is ASCII 97. 59 = 97 - 48 ) - 49 - - DUP 0< IF EXIT THEN ( bad ) - DUP 6 < IF 10 + EXIT THEN ( good ) - ( bad ) - 255 - + DUP '0' '9' =><= IF '0' - EXIT THEN + DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN + DROP -1 ( bad ) ; diff --git a/blk/401 b/blk/401 index eb50ae5..9cee536 100644 --- a/blk/401 +++ b/blk/401 @@ -1,10 +1,7 @@ ( returns negative value on error ) : _ ( c -- n ) - ( '0' is ASCII 48 ) - 48 - - DUP 0< ( bad ) OVER 2 < ( good ) OR IF EXIT THEN - ( bad ) - 255 - + DUP '0' '1' =><= IF '0' - EXIT THEN + DROP -1 ( bad ) ; diff --git a/blk/444 b/blk/444 index 57fde9a..da6b73e 100644 --- a/blk/444 +++ b/blk/444 @@ -8,7 +8,7 @@ DROP 8 0 DO C@+ - DUP 0x20 < OVER 0x7e > OR + DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT LOOP diff --git a/emul/forth.bin b/emul/forth.bin index bbe415892e7c9e5a44587428be5b8fe16604f237..c93de2618fd372b6cfc1bdb2b237099b105cc5f6 100644 GIT binary patch delta 2451 zcmZWrZERCz6h800x9#oMy}fG-PQLDH-CBnO7ah9r)w^}jQM%cdv1U#J8>_&w52m2= zV*!;3KhW@Inbr^&5MtJt=&uHUEJm{*#As&pkMScS8i^8##z>-)dd|JwAo0g-d(L~_ z=bZDr&v|dZSbJry^W!(*;|~B}@B7ZzZB3guIzdo$5a1iO-!{o6@iQhEuxazgP0K;5 ztQ<2}j+rYhTkDtc3$|8S2N!hPjtl&jO=m59wS9R*o4s9{WEX`JGoW26F|Zd{9%NW9 zv`YpQS&5BE1-4F{#9v_NefAw&3QULfpu;2Zp)HSyWL?Ap$iEk@fhGTL(_dtL2o)LG zdw6XB6VWaFmVK4>m94;z3s#~oT>XOAJ8J6|ksnw>u#oRW*cYwi&pG~&Fu-RWYpdV3 z=RpDkf)4BZwaRxJzu}m9ph+&UQ!?eHm?F!-Z)F2^ccfcan8YdYo-`w0W@TYSGGqCN z@+vmUzmvmjuE`6MDo!973sM>Bx+su+6Q7GhP9Eho&SkZ8ve#)qB9)D&JJa#351h)J z>_Eb)(Vra|OgqkMd9QQM--Ch4L^k!DnOKLMoZ}6y(1SVooLI!OXjXtJ+nqWnFe(#B z9+n})Nf$wlW91TV$$%YUALcK)9-knDAojt&h(!C@=1aV)K;u6HH8sKnj(Ax=xj&dx+Ku1vtB z=~+bUsVwv^gOj*G35@u*M9Kp%EAuV`V%uVglnae8WUzpF7qMu-u2eRW44Cfx9qxz^ zjwvCC!kqk_n1{dc)aq+AEVsliGgX`xO8k5G%AMD+phTM!jw7nIoyNrNF(A7=o(f{~ z1vc;c*ImLBHXxqN#5MF;6ep{*Qvht1;s!m8JQL4Z6#w`R9&0fv|Ogu zlC~^w#Y(n$QL#^}2UPd9F}n^$eo|f2{0cfv9qQQUf-5?V7>Utlx7DHYS2cjy`Mj95TfTHz&J zqt(+=BmdR6VjCR>wWY%gc+FXNLlHdOuO(wbK%rkpn{mgHaU^r(K%W3hb;_7Dzbg z-!~QwqW`R>inAJtfUZWeCM1fQQXk{LYx=#HNKuFT2Z#DhMNz;dGo0>!7tXK*ausi? zs$D~D=y*w4g1U;?DW58qg)T(A#-FWP)%1yWe-(B9cln??t5F^U(yhtV#=G%wDR>S8~y^LEw@LJ?6MFy zAuQOMTHM@arbAUW(f|?N^j=4}JWQ$0D9&UelcoOxVt|B9?{(5-pEx2l2S}$|p-(Ic zC;Za_&WB2>`*BHiDD8()+EY%#l`6-$TsTSN+YxK6roQ-FfqPUjK=d@2WQ5^W{&~R9 zdiYO)`Ux?R!L;Xa0AzEu@=C(p^{26X>Ty~q1}wm|4_zZz;$o2n*6cg476Vk)A9s{R z+0*s)cx)Cx$s`N!e%2AhJFqRYm1@HSX7F&utV2NngVJZ zP~fNeCR`8p?->~E>I}7jBqgFZ4y7^X88iALz7tGzPGS$X|NV%`8+phxn`iYTiW;@5J3kGUMsDbGT~aG9dRAF=74FQY>H?zAH%*<42poL zBh8lMh-5{dI!ub>`Mf31kxqgNz74gPta(;%3xxk01CKsl#PBly-cXoL+LoyQ$7yBX z*lH?|TFp3%rT0-=DG$a;pIHJ@o*QAaQdM|Ty2cgxe$miKJ@BAd!D}GH=NM7CzIDe+ z5KBB}*&kA1=S}Ils0d?Xp1UpNJhAoW@k8(bivtRMX?K&jlndA}lt0AK?DaN)q{IAEPbHW9z zS)B}=yunT(W+ejYfd$wUbq*qOlq0B^lt!X&*s9s5j@@Yj+-1d0=6=LZI}L0<8s5aP zP_s#a_b{Tr9flM!*8}7m*H>BO-x2}^Skv((qbll5 zpQh!D^*OfFwUoQaMqSHn#IF;w?3}AQOmVeEQt^nMh_1v#^^t4dM}12&orxqfUPBv` zPP2!ukP?#ua8j86onv8l^-9f6@{5!LaL%x}z>)s>Hyd#uvQ4-(5MY8ma)&sLRmrVO z*E#dtCYjo8g>1G~v^}0#wh%0sN}PQnuOB;woCf;`_V*2i{Mc{vN5YCnONSXb4ZkC2 zHU3I0BsIDQeq$t9aU|&2M`^f^>#O}skV#sLNk7X?Vise&B2)emy(N|LFNP1~r|43* zkS=(zyLULGf)y+C&fw6Vjsx1kzRs?J?%v!mZqqGT^7LYKs9|Hy$kR@xOjcdhjf5RCSpVW*X6!E(V{`}!tq!BlbCaHNcFR*~r^Rt)Qq zJ)+Ve37Y)yV2U9Z($%X@iX;a2_jUJ%6f8`Wct*{0Q)-bn=F$GXy@R20)K963a7Lv& zfhIdiV=SU7UfJNZ+D zB2M%v^(LDrTe9J@T2*!&Gk;oaSI(&9M~75HBDrZ17L$zWlIj5$7+ai#K3z7&ZkN4M zIp@&eZ5+i#zE{P%;wAIMd07p>mrV86j`_XVVu@|bR=E&}4rNL47IhMtm*j@b4q}7u ztCA*YT1fM9h~yEk1|ZTshM)ljHROJW;U04opEwCKD>aGxyhXl4+~0;TGlCErw|Nzz z5uZ`cG|-_ju|2(&PU${W6W8CG0dG;!{Ej!z(H4_AI))?{`C0?Qgk4sRo7=>FY^|@N zdt3=(=OyClOa*R#gu!}@3;d*TQs@x+#TwtZqQMsE5DNT=cbdoMSE$AAK5sGX+l|<_ z<94cL{R5kP*t1v2H@lJT4XH%Ka@A(`(BwJvV(^Q;hE%z`dn}C Up8mluttCyPK%tv3`zCPz0{ko*$N&HU