version 1.11, 2002/12/28 17:18:26
|
version 1.16, 2004/12/31 13:23:56
|
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 Free Software Foundation, Inc. |
\ Copyright (C) 1996,1997,1998,2002,2003,2004 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 43 s" address-unit-bits" environment? drop
|
Line 43 s" address-unit-bits" environment? drop
|
if |
if |
." : images have the same base address; producing only a data-relocatable image" cr |
." : images have the same base address; producing only a data-relocatable image" cr |
else |
else |
offset abs expected-offset <> abort" images produced by different engines" |
\ the following sanity check produces false positices with exec-shield |
|
\ offset abs expected-offset <> abort" images produced by different engines" |
." offset=" offset . cr |
." offset=" offset . cr |
0 image1 i-field + ! 0 image2 i-field + ! |
0 image1 i-field + ! 0 image2 i-field + ! |
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 -- } |