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
> 


------------------------------------------------------------------------------
Automate Storage Tiering Simply
Optimize IT performance and efficiency through flexible, powerful, 
automated storage tiering capabilities. View this brief to learn how
you can reduce costs and improve performance. 
http://p.sf.net/sfu/dell-sfdev2dev
_______________________________________________
Amforth-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/amforth-devel

Reply via email to