version 1.108, 2001/09/05 11:45:38
|
version 1.109, 2001/09/05 13:11:36
|
Line 1684 previous
|
Line 1684 previous
|
|
|
: (cm) ( -- addr ) |
: (cm) ( -- addr ) |
T here align H |
T here align H |
-1 colon, ; ' (cm) plugin-of colonmark, |
-1 prim, ; ' (cm) plugin-of colonmark, |
|
|
>TARGET |
>TARGET |
: compile, ( xt -- ) |
: compile, ( xt -- ) |
Line 2468 Cond: DOES>
|
Line 2468 Cond: DOES>
|
\ do:-xt is executed when the created word from builder is executed |
\ do:-xt is executed when the created word from builder is executed |
\ for do:-xt an additional entry after the normal ghost-entrys is used |
\ for do:-xt an additional entry after the normal ghost-entrys is used |
|
|
ghost ( Create-xt do-ghost ghost ) |
ghost to built |
to built |
|
built >created @ 0= IF |
built >created @ 0= IF |
built >created on |
built >created on |
['] prim-resolved built >comp ! |
['] prim-resolved built >comp ! |
Line 2500 Cond: DOES>
|
Line 2499 Cond: DOES>
|
\ so predefined semantics e.g. for .... |
\ so predefined semantics e.g. for .... |
\ FIXME: find an example in the normal kernel!!! |
\ FIXME: find an example in the normal kernel!!! |
2dup >exec @ swap >exec2 ! |
2dup >exec @ swap >exec2 ! |
|
\ cr ." XXX" over .ghost |
|
\ dup >comp @ xt-see |
>comp @ swap >comp ! ; |
>comp @ swap >comp ! ; |
\ old version of this: |
\ old version of this: |
\ >exec dup @ ['] NoExec = |
\ >exec dup @ ['] NoExec = |
Line 2565 Cond: DOES>
|
Line 2566 Cond: DOES>
|
: ;DO ( [xt] [colon-sys] -- ) |
: ;DO ( [xt] [colon-sys] -- ) |
postpone ; doexec! ; immediate |
postpone ; doexec! ; immediate |
|
|
: by ( -- do-ghost ) \ Name |
: by ( -- ) \ Name |
Ghost >do:ghost @ do:ghost! ; |
Ghost >do:ghost @ do:ghost! ; |
|
|
: compile: ( do-ghost -- do-ghost [xt] [colon-sys] ) |
: compile: ( --[xt] [colon-sys] ) |
\G defines a compile time action for created words |
\G defines a compile time action for created words |
\G by this builder |
\G by this builder |
:noname ; |
:noname ; |
|
|
: ;compile ( do-ghost [xt] [colon-sys] -- do-ghost ) |
: ;compile ( [xt] [colon-sys] -- ) |
postpone ; built >do:ghost @ >comp ! ; immediate |
postpone ; built >do:ghost @ >comp ! ; immediate |
|
|
|
|
>TARGET |
|
\ Variables and Constants 05dec92py |
\ Variables and Constants 05dec92py |
|
|
Builder (Constant) |
Builder (Constant) |
Line 2629 by Create
|
Line 2628 by Create
|
|
|
\ User variables 04may94py |
\ User variables 04may94py |
|
|
>CROSS |
|
|
|
Variable tup 0 tup ! |
Variable tup 0 tup ! |
Variable tudp 0 tudp ! |
Variable tudp 0 tudp ! |
|
|
Line 2642 Variable tudp 0 tudp !
|
Line 2639 Variable tudp 0 tudp !
|
tup @ tudp @ + T A! H |
tup @ tudp @ + T A! H |
tudp @ dup T cell+ H tudp ! ; |
tudp @ dup T cell+ H tudp ! ; |
|
|
>TARGET |
|
|
|
Builder User |
Builder User |
Build: 0 u, X , ;Build |
Build: 0 u, X , ;Build |
by: :douser ( ghost -- up-addr ) X @ tup @ + ;DO |
by: :douser ( ghost -- up-addr ) X @ tup @ + ;DO |
Line 2680 DO: ( ghost -- ) ABORT" CROSS: Don't exe
|
Line 2675 DO: ( ghost -- ) ABORT" CROSS: Don't exe
|
|
|
\ Sturctures 23feb95py |
\ Sturctures 23feb95py |
|
|
>CROSS |
|
: nalign ( addr1 n -- addr2 ) |
: nalign ( addr1 n -- addr2 ) |
\ addr2 is the aligned version of addr1 wrt the alignment size n |
\ addr2 is the aligned version of addr1 wrt the alignment size n |
1- tuck + swap invert and ; |
1- tuck + swap invert and ; |
>TARGET |
|
|
|
Builder (Field) |
Builder (Field) |
Build: ;Build |
Build: ;Build |
Line 2696 Build: ( align1 offset1 align size "name
|
Line 2690 Build: ( align1 offset1 align size "name
|
+ >r nalign r> ;Build |
+ >r nalign r> ;Build |
by (Field) |
by (Field) |
|
|
|
>TARGET |
: struct T 1 chars 0 H ; |
: struct T 1 chars 0 H ; |
: end-struct T 2Constant H ; |
: end-struct T 2Constant H ; |
|
|
: cell% ( n -- size align ) |
: cell% ( n -- size align ) |
T 1 cells H dup ; |
T 1 cells H dup ; |
|
>CROSS |
|
|
\ Input-Methods 01py |
\ Input-Methods 01py |
|
|
Line 2726 DO: abort" Not in cross mode" ;DO
|
Line 2722 DO: abort" Not in cross mode" ;DO
|
|
|
T has? peephole H [IF] |
T has? peephole H [IF] |
|
|
: (cc) compile call T >body a, H ; ' (cc) IS colon, |
>CROSS |
|
: (callc) compile call T >body a, H ; ' (callc) plugin-of colon, |
|
|
|
\ if we want this, we have to spilt aconstant |
|
\ and constant!! |
|
\ Builder (Constant) |
|
\ compile: g>body X @ lit, ;compile |
|
|
Builder (Constant) |
Builder (Constant) |
compile: g>body X @ lit, ;compile |
compile: g>body alit, compile @ ;compile |
|
|
Builder (Value) |
Builder (Value) |
compile: g>body alit, compile @ ;compile |
compile: g>body alit, compile @ ;compile |
Line 3268 Variable outfile-fd
|
Line 3270 Variable outfile-fd
|
\ \ [IF] [ELSE] [THEN] ... 14sep97jaw |
\ \ [IF] [ELSE] [THEN] ... 14sep97jaw |
|
|
\ it is useful to define our own structures and not to rely |
\ it is useful to define our own structures and not to rely |
\ on the words in the compiler |
\ on the words in the host system |
\ The words in the compiler might be defined with vocabularies |
\ The words in the host system might be defined with vocabularies |
\ this doesn't work with our self-made compile-loop |
\ this doesn't work with our self-made compile-loop |
|
|
Create parsed 20 chars allot \ store word we parsed |
Create parsed 20 chars allot \ store word we parsed |