Commit ec52ea5f authored by bp's avatar bp
Browse files

Added nested picture number stuff

git-svn-id: https://forth-ev.de/repos/bigforth@1716 3b8d8251-53f3-0310-8f3b-fd1cb8370982
parent 90a171f1
\\ *** Show Forth Status *** 21may93py \ display stack in a window 05dec99py MINOS also memory also forth terminal class intstack cell var saddr cell var sdepth cell var app method .line0 method .line cell var base# static width method draw-it how: &15 width ! : init ( base app -- ) ^ over ! app ! base# ! 0 0 super init curoff ; : assign ( addr n -- ) dup sdepth ! cells saddr dup @ IF dup HandleOff THEN Handle! saddr @ sdepth @ cells move width @ sdepth @ 1+ super assign ; --> \ display stack in a window 29dec02py : .type ( addr u -- ) width @ 1- min width @ 1- over - pos +! type ; : .line0 ( -- addr u ) sdepth @ 0 <# '> hold #S '< hold #> ; : .line ( n -- addr u ) extend tuck dabs <# #S rot sign #> ; : draw-it ( -- ) base push base# @ base ! page .line0 .type sdepth @ 0 ?DO cr saddr @ Ith .line .type LOOP 0. at draw ; class; --> \ search order 05dec99py intstack class vocstack how: : .voc ?dup 0= IF s" ???" EXIT THEN body> >name ?dup 0= IF " ???" THEN count $1F and ; : .line0 base# @ .voc ; : .line .voc ; : assign ( addr n addr -- ) base# ! super assign ; : init ( dpy app -- ) 0 -rot super init ; class; --> \ open stack window 05dec99py User stackw stackw off User orderw orderw off : stack-window ( -- ) screen self window new window with 1 1 vviewport new DS[ base @ stackw intstack new 0 1 *fill 0 1 *fil rule new 2 vabox new ]DS s" Stack" assign 1 8 geometry show endwith ; : order-window ( -- ) screen self window new window with 1 1 vviewport new DS[ current @ orderw vocstack new 0 1 *fill 0 1 *fil rule new 2 vabox new ]DS s" Order" assign 1 8 geometry show endwith ; --> \ open stack window 01jan00py : display-stack ( n1 .. nx -- n1 .. nx ) .blk blk @ ?EXIT stackw @ IF sp@ depth 1- stackw @ intstack with assign draw-it endwith THEN orderw @ IF vp cell+ context over - cell/ 1+ current @ orderw @ vocstack with assign draw-it endwith THEN ; ' display-stack IS .status onlyforth
\ No newline at end of file
\\ *** Show Forth Status *** 21may93py \ display stack in a window 05dec99py MINOS also memory also forth terminal class intstack cell var saddr cell var sdepth cell var app method .line0 method .line cell var base# static width method draw-it how: &15 width ! : init ( base app -- ) ^ over ! app ! base# ! 0 0 super init curoff ; : assign ( addr n -- ) dup sdepth ! cells saddr dup @ IF dup HandleOff THEN Handle! saddr @ sdepth @ cells move width @ sdepth @ 1+ super assign ; --> \ display stack in a window 07aug10py : .type ( addr u -- ) width @ 1- min width @ 1- over - pos +! type ; : .line0 ( -- addr u ) sdepth @ 0 <<# '> hold #S '< hold #> #>> ; : .line ( n -- addr u ) extend tuck dabs <<# #S rot sign #> #>> ; : draw-it ( -- ) base push base# @ base ! page .line0 .type sdepth @ 0 ?DO cr saddr @ Ith .line .type LOOP 0. at draw ; class; --> \ search order 05dec99py intstack class vocstack how: : .voc ?dup 0= IF s" ???" EXIT THEN body> >name ?dup 0= IF " ???" THEN count $1F and ; : .line0 base# @ .voc ; : .line .voc ; : assign ( addr n addr -- ) base# ! super assign ; : init ( dpy app -- ) 0 -rot super init ; class; --> \ open stack window 05dec99py User stackw stackw off User orderw orderw off : stack-window ( -- ) screen self window new window with 1 1 vviewport new DS[ base @ stackw intstack new 0 1 *fill 0 1 *fil rule new 2 vabox new ]DS s" Stack" assign 1 8 geometry show endwith ; : order-window ( -- ) screen self window new window with 1 1 vviewport new DS[ current @ orderw vocstack new 0 1 *fill 0 1 *fil rule new 2 vabox new ]DS s" Order" assign 1 8 geometry show endwith ; --> \ open stack window 01jan00py : display-stack ( n1 .. nx -- n1 .. nx ) .blk blk @ ?EXIT stackw @ IF sp@ depth 1- stackw @ intstack with assign draw-it endwith THEN orderw @ IF vp cell+ context over - cell/ 1+ current @ orderw @ vocstack with assign draw-it endwith THEN ; ' display-stack IS .status onlyforth
\ No newline at end of file
This diff is collapsed.
This diff is collapsed.
......@@ -21,7 +21,7 @@ screen self menu-window : win0
0 ' noop edit-action new s" " s" Text:" infotextfield : tfield0
\ 0 edit-action new s" " (textfield : tfield0
: .button button text @ @+ swap tfield0 assign ;
: .pos base push decimal dup 0 <# #s #> tfield0 assign ;
: .pos base push decimal dup 0 <<# #s #> tfield0 assign #>> ;
0 :noname s" Test 0" tfield0 assign ; simple new s" Menu 0" menu-entry : menu0
0 :noname s" Test 1" tfield0 assign ; simple new s" Menu 1" menu-entry : menu1
......
......@@ -81,7 +81,7 @@ descriptors implements
ELSE
set-var @ IF nvar @ number ! 1 nvar +! THEN
." (" item self >class" lctype ." -" number @ 0
<# # # #> type ." )"
<<# # # #> type #>> ." )"
THEN ;
: dump-class ( -- )
item self >class" lctype ;
......
......@@ -51,8 +51,7 @@ ficon: minos-win icons/minos1+"
Variable comp#
: anonymous-component ( -- addr u ) base push hex
comp# @ 0 <# 3 0 ?DO # LOOP #S
S" pmoc" bounds ?DO I c@ hold LOOP #>
comp# @ 0 <<# 3 0 ?DO # LOOP #s s" comp" holds #> #>>
1 comp# +! ;
: new-code ( addr u content -- o )
......@@ -1414,7 +1413,7 @@ Variable $acc
s" .#" +$
cur file-name @ IF cur file-name $@ 2dup '/' -scan nip safe/string +$ THEN
base push hex cur self dup $10 >> + $FFFF and dup $8 >> + $FF and
0 <# '#' hold #S '-' hold #> +$ ;
0 <<# '#' hold #S '-' hold #> +$ #>> ;
: auto-save-name ( -- addr u )
s" " $acc $! auto-save-add
$acc $@ ;
......
This diff is collapsed.
......@@ -69,7 +69,7 @@ how:
base @ 8 =
IF 8 umin S" 01ZXLHWU-----D" rot /string 1 min
ELSE base @ 2 = IF 0 tuck ELSE extend tuck dabs THEN
<# bl hold #S rot sign bl hold #> THEN text ;
<<# bl hold #S rot sign bl hold #> #>> THEN text ;
: draw-normal ( path xi addr' addr -- )
?DO 0. rot I @ extend rot extend d- dto
1 0 to
......
......@@ -35,7 +35,7 @@ Constant message
: .16 ( u[d] -- )
[ cell 8 = ] [IF] 0 [THEN]
base @ >r hex <# 16 0 DO # LOOP #> type r> base ! ;
base @ >r hex <<# 16 0 DO # LOOP #> type #>> r> base ! ;
: .state ( -- ) 8 0 DO wurst-state I 64s + 64@ .16 LOOP ;
: .source ( -- ) 8 0 DO wurst-source I 64s + 64@ .16 LOOP ;
......@@ -270,45 +270,45 @@ s" gforth" environment? [IF] 2drop
\ %> a<% r@ 7 and 0 .r %> ^=ROL(rnds[states[<% 0 .r %> ]^(0xff&(t>><% $7 and 8 * 0 .r %> ))],<% r> 7 r@ - 0 .r %> );<% \c, ;
: mix2bytes_ind, ( index n k i -- index n ) >r
>r over r@ 64 +
<#
<<#
s" );" holds r> 7 r@ - 0 #s 2drop >r
s" ))]," holds $7 and 8 * 0 #s 2drop
s" ]^(0xff&(t>>" holds 0 #s 2drop
s" ^=ROL(rnds[states[" holds r@ 7 and 0 #s 2drop
s" a" holds 0. #> \c,
s" a" holds 0. #> \c, #>>
rdrop rdrop ;
: round_ind, ( n -- )
<# s" _ind(unsigned char * states, uint64_t * rnds) {" holds dup 0 # s" static inline void round" holds #> \c,
<<# s" _ind(unsigned char * states, uint64_t * rnds) {" holds dup 0 # s" static inline void round" holds #> \c, #>>
s" uint64_t a0, a1, a2, a3, a4, a5, a6, a7, t;" \c,
round# dup 1- swap 8 0 DO
<#
<<#
s" )),8);" holds I permut# 8 + 64s 0 #S 2drop
s" =ROL(*((uint64_t*)(states+" holds I 0 #S
s" a" holds #> \c,
s" a" holds #> \c, #>
LOOP
8 0 DO
s\" asm volatile(\"# line break\" : : \"g\" (a0), \"g\" (a1), \"g\" (a2), \"g\" (a3), \"g\" (a4), \"g\" (a5), \"g\" (a6), \"g\" (a7));" \c,
<#
<<#
s" ));" holds I 8 * 64 + 0 #s
s" t=*((uint64_t*)(states+" holds #> \c,
s" t=*((uint64_t*)(states+" holds #> \c, #>>
8 0 DO I J 8 * + J mix2bytes_ind,
dup >r 8 * + $3F and r>
LOOP dup >r + $3F and r>
LOOP
2drop
8 0 DO
<#
<<#
s" ;" holds I 0 #s 2drop
s" )) = a" holds I 16 + 64s 0 #s
s" *((uint64_t *)(states+" holds
#> \c,
#> \c, #>>
LOOP
8 0 DO
<#
<<#
s" ));" holds I 8 + 64s 0 #s 2drop
s" )) ^= *((uint64_t *)(states+" holds I 64s 0 #s
s" *((uint64_t *)(states+" holds
#> \c,
#> \c, #>>
LOOP
s" memcpy(states+64, states+128, 64); }" \c, ;
......@@ -533,7 +533,7 @@ Create 'round-flags
: read-first32 ( flags -- n ) wurst-size32 >reads >r
message state#32 r> * 2 2* /string wurst-in read-file throw 2 2* + ;
: .4h ( u -- )
0 base @ >r hex <# # # # # #> type r> base ! ;
0 base @ >r hex <<# # # # # #> type #>> r> base ! ;
: .source32 ( -- ) 2 0 DO wurst-source I 2* + w@ .4h LOOP ;
: .state32 ( -- ) 2 0 DO wurst-state I 2* + w@ .4h LOOP ;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment