Menu
▾
▴
Re: [Amforth-devel] A collection of new ".s" - for fun
|
From: pito <pi...@vo...> - 2010-09-10 00:35:27
|
Ni, based on Stefan's recommendation - everything in right->left and bottom-> up. Ufff! GRRRH! Pito \ Some new .s \ by Pito 2010-09-09 \ v2 WITH TOS AND TOR ON RIGHT SIDE \ WITH TOS AND TOR ON BOTTOM marker -newdots : u.r ( s n -- ) 0 swap ud.r ; \ comment if installed variable temporary : rdepth rp0 rp@ - 2/ 1- 1- ; \ ONELINE HEXA STACK : .slh sp@ temporary ! ." [" depth dup 0 ?do dup 1- i - 2* temporary @ + base @ swap hex @ 6 u.r base ! loop drop ." <TOSH]" ; \ ONELINE UNSIGNED STACK : .slu sp@ temporary ! ." [" depth dup 0 ?do dup 1- i - 2* temporary @ + base @ swap decimal @ 6 u.r base ! loop drop ." <TOSU]" ; \ ONELINE SIGNED STACK : .sls sp@ temporary ! ." [" depth dup 0 ?do dup 1- i - 2* temporary @ + base @ swap decimal @ 6 .r base ! loop drop ." <TOSS]" ; \ ONELINE SIGNED RSTACK : .rls rp@ 1- temporary ! \ alignment vs. .s ??? ." [" rdepth dup 0 ?do dup 1- i - 2* temporary @ + base @ swap decimal @ 6 .r base ! loop drop ." <TORS]" ; \ ONELINE UNSIGNED RSTACK : .rlu rp@ 1- temporary ! \ alignment vs. .s ??? ." [" rdepth dup 0 ?do dup 1- i - 2* temporary @ + base @ swap decimal @ 6 u.r base ! loop drop ." <TORU]" ; \ ONELINE HEXA RSTACK : .rlh rp@ 1- temporary ! \ alignment vs. .s ??? ." [" rdepth dup 0 ?do dup 1- i - 2* temporary @ + base @ swap hex @ 6 u.r base ! loop drop ." <TORH]" ; \ IN COLUMNS DSTACK ON BOTTOM NO ADDRR UNSIGNED SIGNED HEXA : .scb sp@ temporary ! depth dup 0 ?do dup 1- i - dup dup 0 = if ." TOS>|" drop else negate 4 .r ." |" then 2* temporary @ + \ dup 7 u.r ( prints the address ) dup dup base @ swap decimal @ 7 u.r base ! base @ swap decimal @ 7 .r base ! base @ swap hex @ 6 u.r base ! cr loop drop ; \ IN COLUMNS DSTACK ON BOTTOM WITH ADDRR UNSIGNED SIGNED HEXA : .sab sp@ temporary ! depth dup 0 ?do dup 1- i - dup dup 0 = if ." TOS>|" drop else negate 4 .r ." |" then 2* temporary @ + dup 7 u.r ." |" ( prints the address ) dup dup base @ swap decimal @ 7 u.r base ! base @ swap decimal @ 7 .r base ! base @ swap hex @ 6 u.r base ! cr loop drop ; \ IN COLUMNS RSTACK ON BOTTOM WITH ADDRR UNSIGNED SIGNED HEXA : .rcb rp@ 1- temporary ! rdepth dup 0 ?do dup 1- i - dup dup 0 = if ." TOR>|" drop else negate 4 .r ." |" then 2* temporary @ + \ dup 7 u.r ( prints the address ) dup dup base @ swap decimal @ 7 u.r base ! base @ swap decimal @ 7 .r base ! base @ swap hex @ 6 u.r base ! cr loop drop ; \ IN COLUMNS RSTACK ON BOTTOM WITH ADDRR UNSIGNED SIGNED HEXA : .rab rp@ 1- temporary ! rdepth dup 0 ?do dup 1- i - dup dup 0 = if ." TOR>|" drop else negate 4 .r ." |" then 2* temporary @ + dup 7 u.r ." |" ( prints the address ) dup dup base @ swap decimal @ 7 u.r base ! base @ swap decimal @ 7 .r base ! base @ swap hex @ 6 u.r base ! cr loop drop ; \ a quick test for oneline .s marker -testsdtot : .sla cr .sls cr .slu cr .slh ; : stest1 $AAAA .sla cr 5 0 do dup .sla cr loop 5 0 do drop .sla cr loop drop .sla cr ; : ? .sls cr .rls cr ; : rtest ? -8888 -8888 -8888 -8888 ? >r ? >r ? >r ? >r ? r> ? r> ? r> ? r> ? drop drop drop drop ? ; : rtest1 .rls ; : rtest2 rtest1 ; : rtest3 rtest2 ; : rtestc1 cr .rab ; : rtestc2 rtestc1 ; : rtestc3 rtestc2 ; --------------------------------------------- Examples: > stest1 [-21846<TOSS] [ 43690<TOSU] [ AAAA<TOSH] [-21846-21846<TOSS] [ 43690 43690<TOSU] [ AAAA AAAA<TOSH] [-21846-21846-21846<TOSS] [ 43690 43690 43690<TOSU] [ AAAA AAAA AAAA<TOSH] [-21846-21846-21846-21846<TOSS] [ 43690 43690 43690 43690<TOSU] [ AAAA AAAA AAAA AAAA<TOSH] [-21846-21846-21846-21846-21846<TOSS] [ 43690 43690 43690 43690 43690<TOSU] [ AAAA AAAA AAAA AAAA AAAA<TOSH] [-21846-21846-21846-21846-21846-21846<TOSS] [ 43690 43690 43690 43690 43690 43690<TOSU] [ AAAA AAAA AAAA AAAA AAAA AAAA<TOSH] [-21846-21846-21846-21846-21846<TOSS] [ 43690 43690 43690 43690 43690<TOSU] [ AAAA AAAA AAAA AAAA AAAA<TOSH] [-21846-21846-21846-21846<TOSS] [ 43690 43690 43690 43690<TOSU] [ AAAA AAAA AAAA AAAA<TOSH] [-21846-21846-21846<TOSS] [ 43690 43690 43690<TOSU] [ AAAA AAAA AAAA<TOSH] [-21846-21846<TOSS] [ 43690 43690<TOSU] [ AAAA AAAA<TOSH] [-21846<TOSS] [ 43690<TOSU] [ AAAA<TOSH] [<TOSS] [<TOSU] [<TOSH] ok > rtest [<TOSS] [ 0 934 1539 14535 14526 13987<TORS] [ -8888 -8888 -8888 -8888<TOSS] [ 0 934 1539 14544 14526 13987<TORS] [ -8888 -8888 -8888<TOSS] [ 0 934 1539 -8888 14546 14526 13987<TORS] [ -8888 -8888<TOSS] [ 0 934 1539 -8888 -8888 14548 14526 13987<TORS] [ -8888<TOSS] [ 0 934 1539 -8888 -8888 -8888 14550 14526 13987<TORS] [<TOSS] [ 0 934 1539 -8888 -8888 -8888 -8888 14552 14526 13987<TORS] [ -8888<TOSS] [ 0 934 1539 -8888 -8888 -8888 14554 14526 13987<TORS] [ -8888 -8888<TOSS] [ 0 934 1539 -8888 -8888 14556 14526 13987<TORS] [ -8888 -8888 -8888<TOSS] [ 0 934 1539 -8888 14558 14526 13987<TORS] [ -8888 -8888 -8888 -8888<TOSS] [ 0 934 1539 14560 14526 13987<TORS] [<TOSS] [ 0 934 1539 14565 14526 13987<TORS] ok > rtest1 [ 0 934 1539 14573 13987<TORS] ok > rtest2 [ 0 934 1539 14581 14573 13987<TORS] ok > rtest3 [ 0 934 1539 14589 14581 14573 13987<TORS] ok > rtestc1 -4| 16634| 0 0 0 -3| 16632| 934 934 3A6 -2| 16630| 1539 1539 603 -1| 16628| 14599 14599 3907 TOR>| 16626| 14427 14427 385B ok > rtestc2 -5| 16634| 0 0 0 -4| 16632| 934 934 3A6 -3| 16630| 1539 1539 603 -2| 16628| 14608 14608 3910 -1| 16626| 14599 14599 3907 TOR>| 16624| 14427 14427 385B ok > rtestc3 -6| 16634| 0 0 0 -5| 16632| 934 934 3A6 -4| 16630| 1539 1539 603 -3| 16628| 14617 14617 3919 -2| 16626| 14608 14608 3910 -1| 16624| 14599 14599 3907 TOR>| 16622| 14427 14427 385B ok > .s ok > 1 2 3 4 5 6 7 8 9 10 ok > .slh [ 1 2 3 4 5 6 7 8 9 A<TOSH] ok > .sls [ 1 2 3 4 5 6 7 8 9 10<TOSS] ok > .slu [ 1 2 3 4 5 6 7 8 9 10<TOSU] ok > .scb -9| 1 1 1 -8| 2 2 2 -7| 3 3 3 -6| 4 4 4 -5| 5 5 5 -4| 6 6 6 -3| 7 7 7 -2| 8 8 8 -1| 9 9 9 TOS>| 10 10 A ok > .sab -9| 16381| 1 1 1 -8| 16379| 2 2 2 -7| 16377| 3 3 3 -6| 16375| 4 4 4 -5| 16373| 5 5 5 -4| 16371| 6 6 6 -3| 16369| 7 7 7 -2| 16367| 8 8 8 -1| 16365| 9 9 9 TOS>| 16363| 10 10 A ok > |
