version 1.19, 2007/12/31 18:40:23
|
version 1.20, 2010/05/12 20:13:33
|
Line 77 s" address-unit-bits" environment? drop
|
Line 77 s" address-unit-bits" environment? drop
|
coffset 0<> cell1 coffset + cell2 = and |
coffset 0<> cell1 coffset + cell2 = and |
if |
if |
cell1 cbase - cell / { tag } |
cell1 cbase - cell / { tag } |
tag dodoes-tag = |
|
if |
|
\ make sure that the next cell will not be tagged |
|
\ !! can probably be optimized away with hybrid threading |
|
dbase negate image1 i 1+ th +! |
|
dbase doffset + negate image2 i 1+ th +! |
|
endif |
|
tag >tag $4000 xor file-id write-cell throw |
tag >tag $4000 xor file-id write-cell throw |
i reloc-bits set-bit |
i reloc-bits set-bit |
else |
else |
xoffset 0<> cell1 xoffset + cell2 = and |
xoffset 0<> cell1 xoffset + cell2 = and |
if |
if |
cell1 xbase - cell / { tag } |
cell1 xbase - cell / { tag } |
tag dodoes-tag = |
|
if |
|
\ make sure that the next cell will not be tagged |
|
\ !! can probably be optimized away with hybrid threading |
|
dbase negate image1 i 1+ th +! |
|
dbase doffset + negate image2 i 1+ th +! |
|
endif |
|
tag >tag file-id write-cell throw |
tag >tag file-id write-cell throw |
i reloc-bits set-bit |
i reloc-bits set-bit |
else |
else |