Mercurial > hg > xemacs-beta
annotate src/unexaix.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 07 Feb 2011 12:01:24 +0000 |
parents | 304aebb79cd3 |
children | 308d34e9f07d |
rev | line source |
---|---|
428 | 1 /* Dump an executable image. |
2 Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. | |
3 | |
4 This file is part of XEmacs. | |
5 | |
6 XEmacs is free software; you can redistribute it and/or modify it | |
7 under the terms of the GNU General Public License as published by the | |
8 Free Software Foundation; either version 2, or (at your option) any | |
9 later version. | |
10 | |
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
14 for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with XEmacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
19 Boston, MA 02111-1307, USA. */ | |
20 | |
21 /* Synched up with: FSF 20.2. */ | |
22 | |
771 | 23 /* This file has been ... uhhhhh ... Mule-ized. Yeah. |
24 | |
25 (Everything here is external format. That's potentially dangerous, | |
26 but in practice it'll be OK.) --ben */ | |
27 | |
428 | 28 /* Originally based on the COFF unexec.c by Spencer W. Thomas. |
29 * | |
30 * Subsequently hacked on by | |
31 * Bill Mann <Bill_Man@praxisint.com> | |
32 * Andrew Vignaux <Andrew.Vignaux@comp.vuw.ac.nz> | |
33 * Mike Sperber <sperber@informatik.uni-tuebingen.de> | |
34 * | |
35 * Synopsis: | |
36 * unexec (new_name, a_name, data_start, bss_start, entry_address) | |
37 * char *new_name, *a_name; | |
38 * unsigned data_start, bss_start, entry_address; | |
39 * | |
40 * Takes a snapshot of the program and makes an a.out format file in the | |
41 * file named by the string argument new_name. | |
42 * If a_name is non-NULL, the symbol table will be taken from the given file. | |
43 * On some machines, an existing a_name file is required. | |
44 * | |
45 * data_start and entry_address are ignored. | |
46 * | |
47 * bss_start indicates how much of the data segment is to be saved in the | |
48 * a.out file and restored when the program is executed. It gives the lowest | |
49 * unsaved address, and is rounded up to a page boundary. The default when 0 | |
50 * is given assumes that the entire data segment is to be stored, including | |
51 * the previous data and bss as well as any additional storage allocated with | |
52 * sbrk(2). | |
53 * | |
54 */ | |
55 | |
56 #ifndef emacs | |
57 #define PERROR(arg) perror (arg); return -1 | |
58 #else | |
59 #include <config.h> | |
3025 | 60 #define PERROR(file) report_error (file, new_) |
428 | 61 #endif |
62 | |
63 #include <a.out.h> | |
64 /* Define getpagesize () if the system does not. | |
65 Note that this may depend on symbols defined in a.out.h | |
66 */ | |
67 #include "getpagesize.h" | |
68 | |
69 #include <sys/types.h> | |
70 #include <stdio.h> | |
71 #include <sys/stat.h> | |
72 #include <errno.h> | |
73 #include <unistd.h> | |
74 #include <fcntl.h> | |
75 | |
76 extern char *start_of_text (void); /* Start of text */ | |
77 extern char *start_of_data (void); /* Start of initialized data */ | |
78 | |
79 extern int _data; | |
80 extern int _text; | |
81 | |
82 #include <filehdr.h> | |
83 #include <aouthdr.h> | |
84 #include <scnhdr.h> | |
85 #include <syms.h> | |
86 | |
87 static struct filehdr f_hdr; /* File header */ | |
88 static struct aouthdr f_ohdr; /* Optional file header (a.out) */ | |
89 static long bias; /* Bias to add for growth */ | |
90 static long lnnoptr; /* Pointer to line-number info within file */ | |
91 | |
92 static long text_scnptr; | |
93 static long data_scnptr; | |
94 #define ALIGN(val, pwr) (((val) + ((1L<<(pwr))-1)) & ~((1L<<(pwr))-1)) | |
95 static long load_scnptr; | |
96 static long orig_load_scnptr; | |
97 static long orig_data_scnptr; | |
98 static int unrelocate_symbols (int, int, char *, char *); | |
99 | |
100 #ifndef MAX_SECTIONS | |
101 #define MAX_SECTIONS 10 | |
102 #endif | |
103 | |
104 static int adjust_lnnoptrs (int, int, char *); | |
105 | |
106 static int pagemask; | |
107 | |
108 /* Correct an int which is the bit pattern of a pointer to a byte | |
109 into an int which is the number of a byte. | |
110 This is a no-op on ordinary machines, but not on all. */ | |
111 | |
112 #ifndef ADDR_CORRECT /* Let m-*.h files override this definition */ | |
113 #define ADDR_CORRECT(x) ((char *)(x) - (char*)0) | |
114 #endif | |
115 | |
116 #ifdef emacs | |
117 #include "lisp.h" | |
118 | |
119 static void | |
120 report_error (char *file, int fd) | |
121 { | |
122 if (fd) | |
123 close (fd); | |
563 | 124 report_error_with_errno (Qio_error, "Cannot unexec", |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
125 build_cistring (file)); |
428 | 126 } |
127 #endif /* emacs */ | |
128 | |
3025 | 129 #define ERROR0(msg) report_error_1 (new_, msg, 0, 0); return -1 |
130 #define ERROR1(msg,x) report_error_1 (new_, msg, x, 0); return -1 | |
131 #define ERROR2(msg,x,y) report_error_1 (new_, msg, x, y); return -1 | |
428 | 132 |
133 static void | |
134 report_error_1 (int fd, char *msg, int a1, int a2) | |
135 { | |
136 close (fd); | |
137 #ifdef emacs | |
563 | 138 signal_ferror (Qio_error, msg, a1, a2); |
428 | 139 #else |
140 fprintf (stderr, msg, a1, a2); | |
141 fprintf (stderr, "\n"); | |
142 #endif | |
143 } | |
144 | |
145 static int make_hdr (int, int, unsigned, unsigned, unsigned, char *, char *); | |
146 static void mark_x (char *); | |
147 static int copy_text_and_data (int); | |
148 static int copy_sym (int, int, char *, char *); | |
149 static void write_segment (int, char *, char *); | |
150 | |
151 /* **************************************************************** | |
152 * unexec | |
153 * | |
154 * driving logic. | |
155 */ | |
156 int unexec (char *new_name, char *a_name, | |
157 uintptr_t data_start, | |
158 uintptr_t bss_start, | |
159 uintptr_t entry_address) | |
160 { | |
3025 | 161 int new_ = -1, a_out = -1; |
428 | 162 |
163 if (a_name && (a_out = open (a_name, O_RDONLY)) < 0) | |
164 { | |
165 PERROR (a_name); | |
166 } | |
3025 | 167 if ((new_ = creat (new_name, 0666)) < 0) |
428 | 168 { |
169 PERROR (new_name); | |
170 } | |
3025 | 171 if (make_hdr (new_, a_out, |
428 | 172 data_start, bss_start, |
173 entry_address, | |
174 a_name, new_name) < 0 | |
3025 | 175 || copy_text_and_data (new_) < 0 |
176 || copy_sym (new_, a_out, a_name, new_name) < 0 | |
177 || adjust_lnnoptrs (new_, a_out, new_name) < 0 | |
178 || unrelocate_symbols (new_, a_out, a_name, new_name) < 0) | |
428 | 179 { |
3025 | 180 close (new_); |
428 | 181 return -1; |
182 } | |
183 | |
3025 | 184 close (new_); |
428 | 185 if (a_out >= 0) |
186 close (a_out); | |
187 mark_x (new_name); | |
188 return 0; | |
189 } | |
190 | |
191 /* **************************************************************** | |
192 * make_hdr | |
193 * | |
194 * Make the header in the new a.out from the header in core. | |
195 * Modify the text and data sizes. | |
196 */ | |
197 static int | |
3025 | 198 make_hdr (int new_, int a_out, |
428 | 199 unsigned data_start, unsigned bss_start, |
2286 | 200 unsigned UNUSED (entry_address), |
428 | 201 char *a_name, char *new_name) |
202 { | |
203 int scns; | |
204 unsigned int bss_end; | |
205 | |
206 struct scnhdr section[MAX_SECTIONS]; | |
207 struct scnhdr * f_thdr; /* Text section header */ | |
208 struct scnhdr * f_dhdr; /* Data section header */ | |
209 struct scnhdr * f_bhdr; /* Bss section header */ | |
210 struct scnhdr * f_lhdr; /* Loader section header */ | |
211 struct scnhdr * f_tchdr; /* Typechk section header */ | |
212 struct scnhdr * f_dbhdr; /* Debug section header */ | |
213 struct scnhdr * f_xhdr; /* Except section header */ | |
214 | |
215 load_scnptr = orig_load_scnptr = lnnoptr = 0; | |
216 pagemask = getpagesize () - 1; | |
217 | |
218 /* Adjust text/data boundary. */ | |
219 data_start = (long) start_of_data (); | |
220 data_start = ADDR_CORRECT (data_start); | |
221 | |
222 data_start = data_start & ~pagemask; /* (Down) to page boundary. */ | |
223 | |
224 bss_end = ADDR_CORRECT (sbrk (0)) + pagemask; | |
225 bss_end &= ~ pagemask; | |
226 /* Adjust data/bss boundary. */ | |
227 if (bss_start != 0) | |
228 { | |
229 bss_start = (ADDR_CORRECT (bss_start) + pagemask); | |
230 /* (Up) to page bdry. */ | |
231 bss_start &= ~ pagemask; | |
232 if (bss_start > bss_end) | |
233 { | |
234 ERROR1 ("unexec: Specified bss_start (%u) is past end of program", | |
235 bss_start); | |
236 } | |
237 } | |
238 else | |
239 bss_start = bss_end; | |
240 | |
241 if (data_start > bss_start) /* Can't have negative data size. */ | |
242 { | |
243 ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", | |
244 data_start, bss_start); | |
245 } | |
246 | |
247 /* Salvage as much info from the existing file as possible */ | |
248 f_thdr = NULL; f_dhdr = NULL; f_bhdr = NULL; | |
249 f_lhdr = NULL; f_tchdr = NULL; f_dbhdr = NULL; f_xhdr = NULL; | |
250 if (a_out >= 0) | |
251 { | |
252 if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) | |
253 { | |
254 PERROR (a_name); | |
255 } | |
256 if (f_hdr.f_opthdr > 0) | |
257 { | |
258 if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) | |
259 { | |
260 PERROR (a_name); | |
261 } | |
262 } | |
263 if (f_hdr.f_nscns > MAX_SECTIONS) | |
264 { | |
265 ERROR0 ("unexec: too many section headers -- increase MAX_SECTIONS"); | |
266 } | |
267 /* Loop through section headers */ | |
268 for (scns = 0; scns < f_hdr.f_nscns; scns++) { | |
269 struct scnhdr *s = §ion[scns]; | |
270 if (read (a_out, s, sizeof (*s)) != sizeof (*s)) | |
271 { | |
272 PERROR (a_name); | |
273 } | |
274 | |
275 #define CHECK_SCNHDR(ptr, name, flags) \ | |
276 if (strcmp(s->s_name, name) == 0) { \ | |
277 if (s->s_flags != flags) { \ | |
278 fprintf(stderr, "unexec: %lx flags where %x expected in %s section.\n", \ | |
279 (unsigned long)s->s_flags, flags, name); \ | |
280 } \ | |
281 if (ptr) { \ | |
282 fprintf(stderr, "unexec: duplicate section header for section %s.\n", \ | |
283 name); \ | |
284 } \ | |
285 ptr = s; \ | |
286 } | |
287 CHECK_SCNHDR(f_thdr, _TEXT, STYP_TEXT); | |
288 CHECK_SCNHDR(f_dhdr, _DATA, STYP_DATA); | |
289 CHECK_SCNHDR(f_bhdr, _BSS, STYP_BSS); | |
290 CHECK_SCNHDR(f_lhdr, _LOADER, STYP_LOADER); | |
291 CHECK_SCNHDR(f_dbhdr, _DEBUG, STYP_DEBUG); | |
292 CHECK_SCNHDR(f_tchdr, _TYPCHK, STYP_TYPCHK); | |
293 CHECK_SCNHDR(f_xhdr, _EXCEPT, STYP_EXCEPT); | |
294 } | |
295 | |
296 if (f_thdr == 0) | |
297 { | |
298 ERROR1 ("unexec: couldn't find \"%s\" section", (int) _TEXT); | |
299 } | |
300 if (f_dhdr == 0) | |
301 { | |
302 ERROR1 ("unexec: couldn't find \"%s\" section", (int) _DATA); | |
303 } | |
304 if (f_bhdr == 0) | |
305 { | |
306 ERROR1 ("unexec: couldn't find \"%s\" section", (int) _BSS); | |
307 } | |
308 } | |
309 else | |
310 { | |
311 ERROR0 ("can't build a COFF file from scratch yet"); | |
312 } | |
313 orig_data_scnptr = f_dhdr->s_scnptr; | |
314 orig_load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; | |
315 | |
316 /* Now we alter the contents of all the f_*hdr variables | |
317 to correspond to what we want to dump. */ | |
318 | |
319 /* Indicate that the reloc information is no longer valid for ld (bind); | |
320 we only update it enough to fake out the exec-time loader. */ | |
321 f_hdr.f_flags |= (F_RELFLG | F_EXEC); | |
322 | |
323 f_ohdr.dsize = bss_start - f_ohdr.data_start; | |
324 f_ohdr.bsize = bss_end - bss_start; | |
325 | |
326 f_dhdr->s_size = f_ohdr.dsize; | |
327 f_bhdr->s_size = f_ohdr.bsize; | |
328 f_bhdr->s_paddr = f_ohdr.data_start + f_ohdr.dsize; | |
329 f_bhdr->s_vaddr = f_ohdr.data_start + f_ohdr.dsize; | |
330 | |
331 /* fix scnptr's */ | |
332 { | |
333 ulong ptr = section[0].s_scnptr; | |
334 | |
335 bias = -1; | |
336 for (scns = 0; scns < f_hdr.f_nscns; scns++) | |
337 { | |
338 struct scnhdr *s = §ion[scns]; | |
339 | |
340 if (s->s_flags & STYP_PAD) /* .pad sections omitted in AIX 4.1 */ | |
341 { | |
342 /* | |
343 * the text_start should probably be o_algntext but that doesn't | |
344 * seem to change | |
345 */ | |
346 if (f_ohdr.text_start != 0) /* && scns != 0 */ | |
347 { | |
348 s->s_size = 512 - (ptr % 512); | |
349 if (s->s_size == 512) | |
350 s->s_size = 0; | |
351 } | |
352 s->s_scnptr = ptr; | |
353 } | |
354 else if (s->s_flags & STYP_DATA) | |
355 s->s_scnptr = ptr; | |
356 else if (!(s->s_flags & (STYP_TEXT | STYP_BSS))) | |
357 { | |
358 if (bias == -1) /* if first section after bss */ | |
359 bias = ptr - s->s_scnptr; | |
360 | |
361 s->s_scnptr += bias; | |
362 ptr = s->s_scnptr; | |
363 } | |
364 | |
365 ptr = ptr + s->s_size; | |
366 } | |
367 } | |
368 | |
369 /* fix other pointers */ | |
370 for (scns = 0; scns < f_hdr.f_nscns; scns++) | |
371 { | |
372 struct scnhdr *s = §ion[scns]; | |
373 | |
374 if (s->s_relptr != 0) | |
375 { | |
376 s->s_relptr += bias; | |
377 } | |
378 if (s->s_lnnoptr != 0) | |
379 { | |
380 if (lnnoptr == 0) lnnoptr = s->s_lnnoptr; | |
381 s->s_lnnoptr += bias; | |
382 } | |
383 } | |
384 | |
385 if (f_hdr.f_symptr > 0L) | |
386 { | |
387 f_hdr.f_symptr += bias; | |
388 } | |
389 | |
390 text_scnptr = f_thdr->s_scnptr; | |
391 data_scnptr = f_dhdr->s_scnptr; | |
392 load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; | |
393 | |
3025 | 394 if (write (new_, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) |
428 | 395 { |
396 PERROR (new_name); | |
397 } | |
398 | |
399 if (f_hdr.f_opthdr > 0) | |
400 { | |
3025 | 401 if (write (new_, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) |
428 | 402 { |
403 PERROR (new_name); | |
404 } | |
405 } | |
406 | |
407 for (scns = 0; scns < f_hdr.f_nscns; scns++) { | |
408 struct scnhdr *s = §ion[scns]; | |
3025 | 409 if (write (new_, s, sizeof (*s)) != sizeof (*s)) |
428 | 410 { |
411 PERROR (new_name); | |
412 } | |
413 } | |
414 | |
415 return (0); | |
416 } | |
417 | |
418 /* **************************************************************** | |
419 | |
420 * | |
421 * Copy the text and data segments from memory to the new a.out | |
422 */ | |
423 static int | |
3025 | 424 copy_text_and_data (int new_) |
428 | 425 { |
426 char *end; | |
427 char *ptr; | |
428 | |
3025 | 429 lseek (new_, (long) text_scnptr, SEEK_SET); |
428 | 430 ptr = start_of_text () + text_scnptr; |
431 end = ptr + f_ohdr.tsize; | |
3025 | 432 write_segment (new_, ptr, end); |
428 | 433 |
3025 | 434 lseek (new_, (long) data_scnptr, SEEK_SET); |
428 | 435 ptr = (char *) f_ohdr.data_start; |
436 end = ptr + f_ohdr.dsize; | |
3025 | 437 write_segment (new_, ptr, end); |
428 | 438 |
439 return 0; | |
440 } | |
441 | |
442 #define UnexBlockSz (1<<12) /* read/write block size */ | |
443 static void | |
3025 | 444 write_segment (int new_, char *ptr, char *end) |
428 | 445 { |
446 int i, nwrite, ret; | |
447 char buf[80]; | |
448 char zeros[UnexBlockSz]; | |
449 | |
450 for (i = 0; ptr < end;) | |
451 { | |
452 /* distance to next block. */ | |
453 nwrite = (((int) ptr + UnexBlockSz) & -UnexBlockSz) - (int) ptr; | |
454 /* But not beyond specified end. */ | |
455 if (nwrite > end - ptr) nwrite = end - ptr; | |
3025 | 456 ret = write (new_, ptr, nwrite); |
428 | 457 /* If write gets a page fault, it means we reached |
458 a gap between the old text segment and the old data segment. | |
459 This gap has probably been remapped into part of the text segment. | |
460 So write zeros for it. */ | |
461 if (ret == -1 && errno == EFAULT) | |
462 { | |
463 memset (zeros, 0, nwrite); | |
3025 | 464 write (new_, zeros, nwrite); |
428 | 465 } |
466 else if (nwrite != ret) | |
467 { | |
468 sprintf (buf, | |
469 "unexec write failure: addr 0x%lx, fileno %d, size 0x%x, wrote 0x%x, errno %d", | |
3025 | 470 (unsigned long)ptr, new_, nwrite, ret, errno); |
428 | 471 PERROR (buf); |
472 } | |
473 i += nwrite; | |
474 ptr += nwrite; | |
475 } | |
476 } | |
477 | |
478 /* **************************************************************** | |
479 * copy_sym | |
480 * | |
481 * Copy the relocation information and symbol table from the a.out to the new | |
482 */ | |
483 static int | |
3025 | 484 copy_sym (int new_, int a_out, char *a_name, char *new_name) |
428 | 485 { |
486 char page[UnexBlockSz]; | |
487 int n; | |
488 | |
489 if (a_out < 0) | |
490 return 0; | |
491 | |
492 if (orig_load_scnptr == 0L) | |
493 return 0; | |
494 | |
495 if (lnnoptr && lnnoptr < orig_load_scnptr) /* if there is line number info */ | |
496 lseek (a_out, lnnoptr, SEEK_SET); /* start copying from there */ | |
497 else | |
498 lseek (a_out, orig_load_scnptr, SEEK_SET); /* Position a.out to symtab. */ | |
499 | |
647 | 500 while ((n = read (a_out, page, sizeof (page))) > 0) |
428 | 501 { |
3025 | 502 if (write (new_, page, n) != n) |
428 | 503 { |
504 PERROR (new_name); | |
505 } | |
506 } | |
507 if (n < 0) | |
508 { | |
509 PERROR (a_name); | |
510 } | |
511 return 0; | |
512 } | |
513 | |
514 /* **************************************************************** | |
515 * mark_x | |
516 * | |
517 * After successfully building the new a.out, mark it executable | |
518 */ | |
519 static void | |
520 mark_x (char *name) | |
521 { | |
522 struct stat sbuf; | |
523 int um; | |
3025 | 524 int new_ = 0; /* for PERROR */ |
428 | 525 |
526 um = umask (777); | |
527 umask (um); | |
528 if (stat (name, &sbuf) == -1) | |
529 { | |
530 PERROR (name); | |
531 } | |
532 sbuf.st_mode |= 0111 & ~um; | |
533 if (chmod (name, sbuf.st_mode) == -1) | |
534 PERROR (name); | |
535 } | |
536 | |
537 static int | |
2286 | 538 adjust_lnnoptrs (int UNUSED (writedesc), int UNUSED (readdesc), char *new_name) |
428 | 539 { |
540 int nsyms; | |
541 int naux; | |
3025 | 542 int new_; |
428 | 543 struct syment symentry; |
544 union auxent auxentry; | |
545 | |
546 if (!lnnoptr || !f_hdr.f_symptr) | |
547 return 0; | |
548 | |
3025 | 549 if ((new_ = open (new_name, O_RDWR)) < 0) |
428 | 550 { |
551 PERROR (new_name); | |
552 return -1; | |
553 } | |
554 | |
3025 | 555 lseek (new_, f_hdr.f_symptr, SEEK_SET); |
428 | 556 for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) |
557 { | |
3025 | 558 read (new_, &symentry, SYMESZ); |
428 | 559 if (symentry.n_sclass == C_BINCL || symentry.n_sclass == C_EINCL) |
560 { | |
561 symentry.n_value += bias; | |
3025 | 562 lseek (new_, -SYMESZ, SEEK_CUR); |
563 write (new_, &symentry, SYMESZ); | |
428 | 564 } |
565 | |
566 for (naux = symentry.n_numaux; naux-- != 0; ) | |
567 { | |
3025 | 568 read (new_, &auxentry, AUXESZ); |
428 | 569 nsyms++; |
570 if (naux != 0 /* skip csect auxentry (last entry) */ | |
571 && (symentry.n_sclass == C_EXT || symentry.n_sclass == C_HIDEXT)) | |
572 { | |
573 auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; | |
3025 | 574 lseek (new_, -AUXESZ, SEEK_CUR); |
575 write (new_, &auxentry, AUXESZ); | |
428 | 576 } |
577 } | |
578 } | |
3025 | 579 close (new_); |
428 | 580 |
581 return 0; | |
582 } | |
583 | |
584 static int | |
3025 | 585 unrelocate_symbols (int new_, int a_out, char *a_name, char *new_name) |
428 | 586 { |
587 int i; | |
588 LDHDR ldhdr; | |
589 LDREL ldrel; | |
590 ulong t_reloc = (ulong) &_text - f_ohdr.text_start; | |
591 ulong d_reloc = (ulong) &_data - f_ohdr.data_start; | |
592 int * p; | |
593 | |
594 if (load_scnptr == 0) | |
595 return 0; | |
596 | |
597 lseek (a_out, orig_load_scnptr, SEEK_SET); | |
598 if (read (a_out, &ldhdr, sizeof (ldhdr)) != sizeof (ldhdr)) | |
599 { | |
600 PERROR (new_name); | |
601 } | |
602 | |
603 #define SYMNDX_TEXT 0 | |
604 #define SYMNDX_DATA 1 | |
605 #define SYMNDX_BSS 2 | |
606 | |
607 for (i = 0; i < ldhdr.l_nreloc; i++) | |
608 { | |
609 lseek (a_out, | |
610 orig_load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, | |
611 SEEK_SET); | |
612 | |
613 if (read (a_out, &ldrel, LDRELSZ) != LDRELSZ) | |
614 { | |
615 PERROR (a_name); | |
616 } | |
617 | |
618 /* move the BSS loader symbols to the DATA segment */ | |
619 if (ldrel.l_symndx == SYMNDX_BSS) | |
620 { | |
621 ldrel.l_symndx = SYMNDX_DATA; | |
622 | |
3025 | 623 lseek (new_, |
428 | 624 load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, |
625 SEEK_SET); | |
626 | |
3025 | 627 if (write (new_, &ldrel, LDRELSZ) != LDRELSZ) |
428 | 628 { |
629 PERROR (new_name); | |
630 } | |
631 } | |
632 | |
633 if (ldrel.l_rsecnm == f_ohdr.o_sndata) | |
634 { | |
635 int orig_int; | |
636 | |
637 lseek (a_out, | |
638 orig_data_scnptr + (ldrel.l_vaddr - f_ohdr.data_start), | |
639 SEEK_SET); | |
640 | |
641 if (read (a_out, (void *) &orig_int, sizeof (orig_int)) | |
642 != sizeof (orig_int)) | |
643 { | |
644 PERROR (a_name); | |
645 } | |
646 | |
647 p = (int *) (ldrel.l_vaddr + d_reloc); | |
648 | |
649 switch (ldrel.l_symndx) { | |
650 case SYMNDX_TEXT: | |
651 orig_int = * p - t_reloc; | |
652 break; | |
653 | |
654 case SYMNDX_DATA: | |
655 case SYMNDX_BSS: | |
656 orig_int = * p - d_reloc; | |
657 break; | |
658 } | |
659 | |
660 if (orig_int != * p) | |
661 { | |
3025 | 662 lseek (new_, |
428 | 663 data_scnptr + (ldrel.l_vaddr - f_ohdr.data_start), |
664 SEEK_SET); | |
3025 | 665 if (write (new_, (void *) &orig_int, sizeof (orig_int)) |
428 | 666 != sizeof (orig_int)) |
667 { | |
668 PERROR (new_name); | |
669 } | |
670 } | |
671 } | |
672 } | |
673 return 0; | |
674 } |