version 1.59, 1998/12/11 22:54:26
|
version 1.66, 1999/01/21 20:09:13
|
Line 1164 VARIABLE ;Resolve 1 cells allot
|
Line 1164 VARIABLE ;Resolve 1 cells allot
|
.sourcepos ." needs doer: " >in @ bl word count type >in ! cr |
.sourcepos ." needs doer: " >in @ bl word count type >in ! cr |
THEN |
THEN |
ghost tuck swap resolve <do:> swap >magic ! ; |
ghost tuck swap resolve <do:> swap >magic ! ; |
|
|
|
Variable prim# |
|
: first-primitive ( n -- ) prim# ! ; |
|
: Primitive ( -- ) \ name |
|
prim# @ T Alias H -1 prim# +! ; |
>CROSS |
>CROSS |
|
|
\ Conditionals and Comments 11may93jaw |
\ Conditionals and Comments 11may93jaw |
Line 1247 Cond: ['] T ' H alit, ;Cond
|
Line 1252 Cond: ['] T ' H alit, ;Cond
|
|
|
: (lit,) ( n -- ) compile lit T , H ; ' (lit,) IS lit, |
: (lit,) ( n -- ) compile lit T , H ; ' (lit,) IS lit, |
|
|
: (alit,) ( n -- ) lit, T here cell - H relon ; ' (alit,) IS alit, |
: (alit,) ( n -- ) compile lit T a, H ; ' (alit,) IS alit, |
|
|
: (fini,) compile ;s ; ' (fini,) IS fini, |
: (fini,) compile ;s ; ' (fini,) IS fini, |
|
|
Line 1799 Cond: S" restrict? compile (S")
|
Line 1804 Cond: S" restrict? compile (S")
|
Cond: ABORT" restrict? compile (ABORT") T ," H ;Cond |
Cond: ABORT" restrict? compile (ABORT") T ," H ;Cond |
|
|
Cond: IS T ' >body H compile ALiteral compile ! ;Cond |
Cond: IS T ' >body H compile ALiteral compile ! ;Cond |
: IS T ' >body ! H ; |
: IS T >address ' >body ! H ; |
Cond: TO T ' >body H compile ALiteral compile ! ;Cond |
Cond: TO T ' >body H compile ALiteral compile ! ;Cond |
: TO T ' >body ! H ; |
: TO T ' >body ! H ; |
|
|
Line 1954 previous
|
Line 1959 previous
|
\ save-cross 17mar93py |
\ save-cross 17mar93py |
|
|
>CROSS |
>CROSS |
Create magic s" Gforth10" here over allot swap move |
Create magic s" Gforth2x" here over allot swap move |
|
|
char 1 bigendian + tcell + magic 7 + c! |
bigendian 1+ \ strangely, in magic big=0, little=1 |
char 0 tchar + magic 6 + c! |
tcell 1 = 0 and or |
|
tcell 2 = 2 and or |
|
tcell 4 = 4 and or |
|
tcell 8 = 6 and or |
|
tchar 1 = $00 and or |
|
tchar 2 = $28 and or |
|
tchar 4 = $50 and or |
|
tchar 8 = $78 and or |
|
magic 7 + c! |
|
|
: save-cross ( "image-name" "binary-name" -- ) |
: save-cross ( "image-name" "binary-name" -- ) |
bl parse ." Saving to " 2dup type cr |
bl parse ." Saving to " 2dup type cr |
Line 2007 bigendian Constant bigendian
|
Line 2020 bigendian Constant bigendian
|
: tempdp> tempdp> ; |
: tempdp> tempdp> ; |
: const constflag on ; |
: const constflag on ; |
: warnings name 3 = 0= twarnings ! drop ; |
: warnings name 3 = 0= twarnings ! drop ; |
: | NoHeaderFlag on ; |
: | ; |
|
\ : | NoHeaderFlag on ; \ This is broken (damages the last word) |
|
|
: save-cross save-cross ; |
: save-cross save-cross ; |
: save-region save-region ; |
: save-region save-region ; |