version 1.5, 1997/01/25 20:53:02
|
version 1.7, 1997/02/16 20:51:10
|
Line 15 decimal
|
Line 15 decimal
|
: define? ( -- flag ) |
: define? ( -- flag ) |
bl word find nip 0= ; |
bl word find nip 0= ; |
|
|
define? cell [IF] 1 cells Constant cell [THEN] |
define? cell [IF] |
|
1 cells Constant cell |
|
[THEN] |
|
|
define? ?EXIT [IF] |
define? ?EXIT [IF] |
: ?EXIT postpone IF postpone EXIT postpone THEN ; immediate |
: ?EXIT postpone IF postpone EXIT postpone THEN ; immediate |
Line 26 define? Vocabulary [IF]
|
Line 28 define? Vocabulary [IF]
|
DOES> @ >r get-order nip r> swap set-order ; |
DOES> @ >r get-order nip r> swap set-order ; |
[THEN] |
[THEN] |
|
|
|
define? faligned [IF] false [ELSE] 1 faligned 8 = [THEN] |
|
[IF] |
|
: 8aligned ( n1 -- n2 ) faligned ; |
|
[ELSE] |
|
: 8aligned ( n1 -- n2 ) 7 + -8 and ; |
|
[THEN] |
|
|
Vocabulary Objects also Objects also definitions |
Vocabulary Objects also Objects also definitions |
|
|
Vocabulary types types also |
Vocabulary types types also |
Line 85 Objects definitions
|
Line 94 Objects definitions
|
: defer? ( addr -- flag ) |
: defer? ( addr -- flag ) |
>body cell+ @ #defer = ; |
>body cell+ @ #defer = ; |
|
|
define? faligned [IF] false [ELSE] 1 faligned 8 = [THEN] |
|
[IF] : 8aligned ( n1 -- n2 ) faligned ; |
|
[ELSE] : 8aligned ( n1 -- n2 ) 7 + -8 and ; |
|
[THEN] |
|
|
|
: o+, ( addr offset -- ) |
: o+, ( addr offset -- ) |
postpone Literal postpone ^ postpone + |
postpone Literal postpone ^ postpone + |
postpone >o drop ; |
postpone >o drop ; |
Line 493 how: 0 parento !
|
Line 497 how: 0 parento !
|
: with ( -- ) |
: with ( -- ) |
state @ oset? 0= and IF postpone >o THEN |
state @ oset? 0= and IF postpone >o THEN |
o@ add-order voc# ! false to oset? |
o@ add-order voc# ! false to oset? |
rdrop state @ |
r> drop state @ |
IF o> |
IF o> |
ELSE oset? IF ^ THEN o> postpone >o |
ELSE oset? IF ^ THEN o> postpone >o |
THEN |
THEN |
rdrop rdrop ; |
r> drop r> drop ; |
: endwith postpone o> |
: endwith postpone o> |
voc# @ drop-order ; |
voc# @ drop-order ; |
class; \ object |
class; \ object |
Line 559 Forth definitions
|
Line 563 Forth definitions
|
DOES> @ decl @ IF implement ELSE inter-method, THEN ; |
DOES> @ decl @ IF implement ELSE inter-method, THEN ; |
|
|
previous previous |
previous previous |
|
|
|
\ The program uses the following words |
|
\ from CORE : |
|
\ decimal : bl word 0= ; cells Constant POSTPONE IF EXIT THEN immediate |
|
\ Create , DOES> @ >r r> swap + and Variable ! allot ELSE +! dup * >body |
|
\ cell+ = Literal drop align here aligned execute ['] 2@ recurse 1+ over |
|
\ LOOP ?dup 0< rot r@ - i negate +LOOP 2drop BEGIN WHILE 2dup REPEAT 1- |
|
\ rshift > / ' move UNTIL or count |
|
\ from CORE-EXT : |
|
\ nip tuck true ?DO compile, false Value erase pick :noname 0<> |
|
\ from BLOCK-EXT : |
|
\ \ |
|
\ from EXCEPTION : |
|
\ throw |
|
\ from EXCEPTION-EXT : |
|
\ abort" |
|
\ from FILE : |
|
\ ( S" |
|
\ from FLOAT : |
|
\ faligned |
|
\ from LOCAL : |
|
\ TO |
|
\ from MEMORY : |
|
\ allocate free |
|
\ from SEARCH : |
|
\ find wordlist get-order set-order definitions get-current set-current search-wordlist |
|
\ from SEARCH-EXT : |
|
\ also Forth previous |
|
\ from STRING : |
|
\ /string compare |
|
\ from TOOLS-EXT : |
|
\ state [IF] [THEN] |