version 1.12, 2003/03/09 15:16:46
|
version 1.14, 2003/08/25 14:17:43
|
Line 1
|
Line 1
|
\ Compare nonrelocatable images and produce a relocatable image |
\ Compare nonrelocatable images and produce a relocatable image |
|
|
\ Copyright (C) 1996,1997,1998,2002 Free Software Foundation, Inc. |
\ Copyright (C) 1996,1997,1998,2002,2003 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 49 s" address-unit-bits" environment? drop
|
Line 49 s" address-unit-bits" environment? drop
|
endif |
endif |
base offset ; |
base offset ; |
|
|
Create tag-offsets |
|
include kernel/groups.fs |
|
tag-offsets $20 cells + here tuck - dup allot erase |
|
|
|
: >tag ( index -- tag ) |
: >tag ( index -- tag ) |
dup dodoes-tag 2 + > IF dodoes-tag 2 + - |
dup dodoes-tag 2 + > IF |
$21 1 DO dup tag-offsets I cells + @ < IF |
$21 1 DO dup tag-offsets I cells + @ < IF |
tag-offsets I 1- cells + @ - I 9 lshift + negate |
tag-offsets I 1- cells + @ - I 1- 9 lshift + negate |
UNLOOP EXIT THEN LOOP |
UNLOOP EXIT THEN LOOP |
dodoes-tag 2 + + |
|
THEN -2 swap - ; |
THEN -2 swap - ; |
|
|
: compare-images { image1 image2 reloc-bits size file-id -- } |
: compare-images { image1 image2 reloc-bits size file-id -- } |