mirror of https://github.com/mgcaret/of816.git
properties fixes
This commit is contained in:
parent
953e2c985e
commit
188e80756b
|
@ -8,6 +8,15 @@ true value of-verbose?
|
||||||
|
|
||||||
db" OF base"
|
db" OF base"
|
||||||
|
|
||||||
|
\ OF816 constants, these should follow macros.include
|
||||||
|
binary
|
||||||
|
10000000 constant (f_immed)
|
||||||
|
01000000 constant (f_conly)
|
||||||
|
00100000 constant (f_prot)
|
||||||
|
00010000 constant (f_tempd)
|
||||||
|
00001000 constant (f_smudg)
|
||||||
|
hex
|
||||||
|
|
||||||
\ Reverse engineer the leading JSLs for these words
|
\ Reverse engineer the leading JSLs for these words
|
||||||
|
|
||||||
: (function) ;
|
: (function) ;
|
||||||
|
@ -24,6 +33,7 @@ alias (alias) (function)
|
||||||
\ ALIAS will have 5C in the low byte, and we maybe need to fix that...
|
\ ALIAS will have 5C in the low byte, and we maybe need to fix that...
|
||||||
\ in SLOF most of these are only used by the debug.fs
|
\ in SLOF most of these are only used by the debug.fs
|
||||||
\ except the ones needed to support instance values
|
\ except the ones needed to support instance values
|
||||||
|
\ so most of these should be removed since no plans to implement debug.fs
|
||||||
' (function) 1+ @ \ ( <colon> )
|
' (function) 1+ @ \ ( <colon> )
|
||||||
' (function) 1+ /n + @ \ ( ... <semicolon> )
|
' (function) 1+ /n + @ \ ( ... <semicolon> )
|
||||||
' (defer) 1+ @ \ ( ... <defer> )
|
' (defer) 1+ @ \ ( ... <defer> )
|
||||||
|
|
|
@ -319,6 +319,10 @@ defer find-node
|
||||||
|
|
||||||
\ fixed for OF816
|
\ fixed for OF816
|
||||||
: (.print-alias) ( lfa -- )
|
: (.print-alias) ( lfa -- )
|
||||||
|
\ Don't print smudged alias
|
||||||
|
dup lfa>xt c@ (f_smudg) and IF
|
||||||
|
drop EXIT
|
||||||
|
THEN
|
||||||
dup lfa>name
|
dup lfa>name
|
||||||
\ Don't print name property
|
\ Don't print name property
|
||||||
2dup s" name" string=ci IF 2drop drop
|
2dup s" name" string=ci IF 2drop drop
|
||||||
|
|
|
@ -43,11 +43,12 @@ true value encode-first?
|
||||||
\ >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ;
|
\ >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ;
|
||||||
\ : prune ( name len -- ) last (prune) ;
|
\ : prune ( name len -- ) last (prune) ;
|
||||||
\ OF816: just smudge it, hopefully properties don't change that often
|
\ OF816: just smudge it, hopefully properties don't change that often
|
||||||
: prune ( name len -- ) context @ search-wordlist 0= if exit then
|
: prune ( name len -- )
|
||||||
dup c@ 20 and if
|
get-current search-wordlist 0= if ." no prune!" cr exit then
|
||||||
drop \ protected
|
dup c@ (f_prot) (f_smudg) or and if
|
||||||
|
drop \ protected or smudged already
|
||||||
else
|
else
|
||||||
dup c@ 8 or swap c!
|
dup c@ (f_smudg) or swap c!
|
||||||
then
|
then
|
||||||
;
|
;
|
||||||
|
|
||||||
|
@ -136,6 +137,10 @@ true value encode-first?
|
||||||
;
|
;
|
||||||
|
|
||||||
: .property ( lfa -- )
|
: .property ( lfa -- )
|
||||||
|
\ Don't print smudged alias
|
||||||
|
dup lfa>xt c@ (f_smudg) and IF
|
||||||
|
drop EXIT
|
||||||
|
THEN
|
||||||
dup cr indent @ 0 ?do space loop
|
dup cr indent @ 0 ?do space loop
|
||||||
lfa>name 2dup type nip
|
lfa>name 2dup type nip
|
||||||
indent-prop swap -
|
indent-prop swap -
|
||||||
|
|
Loading…
Reference in New Issue