Description: <short summary of the patch>
TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.
.
gcl (2.6.12-65) unstable; urgency=medium
.
* Version_2_6_13pre52
* Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com</a>;
(Closes: #802593).
Author: Camm Maguire <camm@debian.org>
Bug-Debian: https://bugs.debian.org/802593
---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:
Origin: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: 2018-03-02
--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp
@@ -49,7 +49,6 @@
(setq *reservations* nil)
(setq *closures* nil)
(setq *top-level-forms* nil)
- (setq *non-package-operation* nil)
(setq *function-declarations* nil)
(setq *inline-functions* nil)
(setq *inline-blocks* 0)
@@ -71,12 +70,10 @@
(defun add-symbol (symbol) (add-object symbol))
(defun add-object2 (object)
- (let* ((init (when (si::contains-sharp-comma object)
- (if (when (consp object) (eq (car object) 'si::|#,|))
- (cdr object) (si::string-to-object (wt-to-string object)))))
+ (let* ((init (if (when (consp object) (eq (car object) '|#,|)) (cdr object) `',object))
(object (if (when (consp init) (eq (car init) 'si::nani)) (si::nani (cadr init)) object)))
(cond ((gethash object *objects*))
- ((push-data-incf (unless init object))
+ ((push-data-incf nil)
(when init (add-init `(si::setvv ,*next-vv* ,init)))
(setf (gethash object *objects*) *next-vv*)))))
--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp
@@ -180,7 +180,7 @@
(*compile-print* (or print *compile-print*))
(*package* *package*)
(*DEFAULT-PATHNAME-DEFAULTS* #p"")
- (*data* (list (make-array 50 :fill-pointer 0 :adjustable t) nil nil))
+ (*data* (list nil))
*init-name*
(*fasd-data* *fasd-data*)
(*error-count* 0))
@@ -281,10 +281,8 @@ Cannot compile ~a.~%"
(if (consp *split-files*)
(dolist (v (fourth *split-files*)) (t1expr v)))
(unwind-protect
- (do ((form (read *compiler-input* nil eof)
- (read *compiler-input* nil eof))
- (load-flag (or (eq :defaults *eval-when-defaults*)
- (member 'load *eval-when-defaults*))))
+ (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof))
+ (load-flag (if *eval-when-defaults* (member 'load *eval-when-defaults*) t)))
(nil)
(cond
((eq form eof))
@@ -292,7 +290,7 @@ Cannot compile ~a.~%"
((maybe-eval nil form)))
(cond
((and *split-files* (check-end form eof))
- (setf (fourth *split-files*) (reverse (third *data*)))
+ (setf (fourth *split-files*) nil);(reverse (third *data*)) ;FIXME check this
(return nil))
((eq form eof) (return nil))))
--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp
@@ -72,7 +72,6 @@
(defvar *top-level-forms* nil)
-(defvar *non-package-operation* nil)
;;; *top-level-forms* holds ( { top-level-form }* ).
;;;
@@ -99,18 +98,7 @@
;;; Package operations.
-(si:putprop 'make-package t 'package-operation)
-(si:putprop 'in-package t 'package-operation)
-(si:putprop 'shadow t 'package-operation)
-(si:putprop 'shadowing-import t 'package-operation)
-(si:putprop 'export t 'package-operation)
-(si:putprop 'unexport t 'package-operation)
-(si:putprop 'use-package t 'package-operation)
-(si:putprop 'unuse-package t 'package-operation)
-(si:putprop 'import t 'package-operation)
-(si:putprop 'provide t 'package-operation)
-(si:putprop 'require t 'package-operation)
-(si:putprop 'defpackage:defpackage t 'package-operation)
+(si:putprop 'in-package t 'eval-at-compile)
;;; Pass 1 top-levels.
@@ -135,6 +123,7 @@
;;; Pass 2 initializers.
(si:putprop 'defun 't2defun 't2)
+(si:putprop 'progn 't2progn 't2)
(si:putprop 'declare 't2declare 't2)
(si:putprop 'defentry 't2defentry 't2)
(si:putprop 'si:putprop 't2putprop 't2)
@@ -142,6 +131,7 @@
;;; Pass 2 C function generators.
(si:putprop 'defun 't3defun 't3)
+(si:putprop 'progn 't3progn 't3)
(si:putprop 'ordinary 't3ordinary 't3)
(si:putprop 'sharp-comma 't3sharp-comma 't3)
(si:putprop 'clines 't3clines 't3)
@@ -242,15 +232,6 @@
((symbolp fun)
(cond ((eq fun 'si:|#,|)
(cmperr "Sharp-comma-macro is in a bad place."))
- ((get fun 'package-operation)
- (when *non-package-operation*
- (cmpwarn "The package operation ~s was in a bad place."
- form))
- (let ((res (if (setq fd (macro-function fun))
- (cmp-expand-macro fd fun (copy-list (cdr form)))
- form)))
- (maybe-eval t res)
- (wt-data-package-operation res)))
((setq fd (get fun 't1))
(when *compile-print* (print-current-form))
(funcall fd args))
@@ -278,11 +259,24 @@
(defvar *vaddress-list*) ;; hold addresses of C functions, and other data
(defvar *vind*) ;; index in the VV array where the address is.
(defvar *Inits*)
+
+(defun t23expr (form prop &aux (def (when (consp form) (get (car form) prop)))
+ *local-funs* (*first-error* t) *vcs-used*)
+ (when def
+ (apply def (cdr form)))
+ (when (eq prop 't3)
+ ;;; Local function and closure function definitions.
+ (block
+ nil
+ (loop
+ (when (endp *local-funs*) (return))
+ (let (*vcs-used*)
+ (apply 't3local-fun (pop *local-funs*)))))))
+
(defun ctop-write (name &aux
- def
- (*function-links* nil) *c-vars* (*volatile* " VOL ")
- *vaddress-list* (*vind* 0) *inits*
- *current-form* *vcs-used*)
+ (*function-links* nil) *c-vars* (*volatile* " VOL ")
+ *vaddress-list* (*vind* 0) *inits*
+ *current-form* *vcs-used*)
(declare (special *current-form* *vcs-used*))
(setq *top-level-forms* (nreverse *top-level-forms*))
@@ -295,32 +289,19 @@
;; write all the inits.
- (dolist* (*current-form* *top-level-forms*)
- (setq *first-error* t)
- (setq *vcs-used* nil)
- (when (setq def (get (car *current-form*) 't2))
- (apply def (cdr *current-form*))))
-
+ (dolist (*current-form* *top-level-forms*)
+ (t23expr *current-form* 't2))
;;; C function definitions.
- (dolist* (*current-form* *top-level-forms*)
- (setq *first-error* t)
- (setq *vcs-used* nil)
- (when (setq def (get (car *current-form*) 't3))
- (apply def (cdr *current-form*))))
-
- ;;; Local function and closure function definitions.
- (let (lf)
- (block local-fun-process
- (loop
- (when (endp *local-funs*) (return-from local-fun-process))
- (setq lf (car *local-funs*))
- (pop *local-funs*)
- (setq *vcs-used* nil)
- (apply 't3local-fun lf))))
+ (dolist (*current-form* *top-level-forms*)
+ (let* ((inits (data-inits)))
+ (t23expr *current-form* 't3)
+ (unless (or (eq (data-inits) inits) (eq (cdr (data-inits)) inits))
+ (let ((di (data-inits)))
+ (setf (data-inits) inits)
+ (add-init (cons 'progn (nreverse (mapcar 'cdr (ldiff di inits)))))))))
;;; Global entries for directly called functions.
-
(dolist* (x *global-entries*)
(setq *vcs-used* nil)
(apply 'wt-global-entry x))
@@ -400,31 +381,27 @@
;; as I can make it. Valid values of *eval-when-defaults* are
;; a sublist of '(compile eval load)
-(defvar *eval-when-defaults* :defaults)
-
-(defun maybe-eval (default-action form)
- (or default-action (and (symbolp (car form))
- (setq default-action (get (car form) 'eval-at-compile))))
- (cond ((or (and default-action (eq :defaults *eval-when-defaults*))
- (and (consp *eval-when-defaults*)(member 'compile *eval-when-defaults* )))
- (if form (cmp-eval form))
- t)))
+(defvar *eval-when-defaults* nil);:defaults
+(defun maybe-eval (def form)
+ (when (or def
+ (intersection '(compile :compile-toplevel) *eval-when-defaults*)
+ (let ((c (car form))) (when (symbolp c) (get c 'eval-at-compile))))
+ (when form
+ (cmp-eval form))
+ t))
(defun t1eval-when (args &aux load-flag compile-flag)
(when (endp args) (too-few-args 'eval-when 1 0))
- (dolist** (situation (car args))
+ (dolist (situation (car args))
(case situation
((load :load-toplevel) (setq load-flag t))
((compile :compile-toplevel) (setq compile-flag t))
((eval :execute))
- (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal."
- situation))))
- (let ((*eval-when-defaults* (car args)))
- (cond (load-flag
- (t1progn (cdr args)))
- (compile-flag
- (cmp-eval (cons 'progn (cdr args)))))))
+ (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." situation))))
+ (let ((*eval-when-defaults* (or *eval-when-defaults* (car args))))
+ (cond (load-flag (t1progn (cdr args)))
+ (compile-flag (cmp-eval (cons 'progn (cdr args)))))))
(defun t1macrolet(args &aux (*funs* *funs*))
(dolist (def (car args))
@@ -441,7 +418,17 @@
(let ((*compile-ordinaries* t))
(t1progn (cdr args))))
(t
- (dolist** (form args) (t1expr form)))))
+ (let ((f *top-level-forms*))
+ (dolist (form args) (t1expr form))
+ (setq *top-level-forms* (cons `(progn ,(nreverse (ldiff *top-level-forms* f))) f))))))
+
+(defun t3progn (args)
+ (dolist (arg args)
+ (t23expr arg 't3)))
+
+(defun t2progn (args)
+ (dolist (arg args)
+ (t23expr arg 't2)))
;; (defun foo (x) .. -> (defun foo (g102 &aux (x g102)) ...
(defun cmpfix-args (args bind &aux tem (lam (copy-list (second args))))
@@ -464,7 +451,6 @@
(unless (macro-function (car args)) (maybe-eval nil (cons 'defun args)))
(tagbody
top
- (setq *non-package-operation* t)
(setq *local-functions* nil)
(let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) lambda-expr
(*special-binding* nil)
@@ -681,8 +667,8 @@
(push (list a) *vaddress-list*)
(prog1 *vind* (incf *vind*)))
-(defun t2defun (fname cfun lambda-expr doc sp)
- (declare (ignore cfun lambda-expr doc sp))
+(defun t2defun (fname cfun lambda-expr doc sp &optional macro-p)
+ (declare (ignore cfun lambda-expr doc sp macro-p))
(cond ((get fname 'no-global-entry)(return-from t2defun nil)))
(cond ((< *space* 2)
(setf (get fname 'debug-prop) t)
@@ -716,8 +702,7 @@
(t (wt-h cfun "();")
(add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname)))))))
-(defun t3defun (fname cfun lambda-expr doc sp &aux inline-info
- (macro-p (equal `(mflag ,fname) (cadr (member *current-form* *top-level-forms*))))
+(defun t3defun (fname cfun lambda-expr doc sp &optional macro-p &aux inline-info
(*current-form* (list 'defun fname))
(*volatile* (volatile (second lambda-expr)))
*downward-closures*)
@@ -1333,47 +1318,29 @@
(maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME?
(t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args))))))
(setf (symbol-plist n) l)
- (push `(mflag ,n) *top-level-forms*))
+ (nconc (car *top-level-forms*) '(t)))
+
+(defvar *compiling-ordinary* nil)
-(defun t1ordinary (form &aux tem )
- (setq *non-package-operation* t)
- ;; check for top level functions
- (cond ((or *compile-ordinaries* (when (listp form) (member (car form) '(let let* flet labels))))
+(defun compile-ordinary-p (form)
+ (when (consp form)
+ (or (member (car form) '(lambda defun defmacro flet labels))
+ (compile-ordinary-p (car form))
+ (compile-ordinary-p (cdr form)))))
+
+(defun t1ordinary (form)
+ (cond ((unless *compiling-ordinary*
+ (or *compile-ordinaries* (compile-ordinary-p form)))
(maybe-eval nil form)
- (let ((gen (gensym "progn 'compile")))
+ (let ((gen (gensym))(*compiling-ordinary* t))
(proclaim `(function ,gen nil t))
- (t1expr `(defun ,gen (), form nil))
- (push (list 'ordinary `(,gen) ) *top-level-forms*)))
- ;;Hack to things like (setq bil #'(lambda () ...)) or (foo nil #'(lambda () ..))
- ;; but not (let ((x ..)) (setq bil #'(lambda () ..)))
- ;; for the latter you must use (progn 'compile ...)
- ((and (consp form)
- (symbolp (car form))
- (or (eq (car form) 'setq)
- (not (special-operator-p (car form))))
- (do ((v (cdr form) (and (consp v) (cdr v)))
- (i 1 (the fixnum (+ 1 i))))
- ((or (>= i 1000)
- (not (consp v))) nil)
- (declare (fixnum i))
- (cond ((and (consp (car v))
- (eq (caar v) 'function)
- (consp (setq tem (second (car v))))
- (eq (car tem) 'lambda))
- (let ((gen (gensym)))
- (t1expr `(defun ,gen ,@ (cdr tem)))
- (return-from t1ordinary
- (t1ordinary (append
- (subseq form 0 i)
- `((symbol-function ', gen))
- (nthcdr (+ 1 i) form))))))))))
+ (t1expr `(progn (defun ,gen nil ,form nil) (,gen)))))
(t
(maybe-eval nil form)
(let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil)
(*sharp-commas* nil))
(push (list 'ordinary form) *top-level-forms*)
- nil
- ))))
+ nil))))
(defun t3ordinary (form)
(cond ((atom form))
--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp
@@ -217,7 +217,7 @@
(dolist (v '(si::cdefn lfun inline-safe inline-unsafe
inline-always c1conditional c2 c1 c1+ co1
si::structure-access co1special
- top-level-macro t3 t2 t1 package-operation))
+ top-level-macro t3 t2 t1))
(si::putprop v t 'compiler-prop ))
(defun compiler-def-hook (symbol code) symbol code nil)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp
@@ -25,9 +25,7 @@
(require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp")
-(defmacro data-vector () `(car *data*))
-(defmacro data-inits () `(second *data*))
-(defmacro data-package-ops () `(third *data*))
+(defmacro data-inits () `(first *data*))
)
@@ -69,7 +67,7 @@
(defvar *fasd-data*)
(defvar *hash-eq* nil)
-(defvar *run-hash-equal-data-checking* nil)
+(defvar *run-hash-equal-data-checking* t)
(defun memoized-hash-equal (x depth);FIXME implement all this in lisp
(declare (fixnum depth))
(when *run-hash-equal-data-checking*
@@ -85,7 +83,6 @@
(si::hash-equal x depth)))))))
(defun push-data-incf (x)
- (vector-push-extend (cons (memoized-hash-equal x -1000) x) (data-vector))
(incf *next-vv*))
(defun wt-data1 (expr)
@@ -105,58 +102,36 @@
(terpri *compiler-output-data*)
(prin1 expr *compiler-output-data*)))
-(defun verify-data-vector(vec &aux v)
- (dotimes (i (length vec))
- (setq v (aref vec i))
- (let ((has (memoized-hash-equal (cdr v) -1000)))
- (cond ((not (eql (car v) has))
- (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" (cdr v)))))
- (setf (aref vec i) (cdr v)))
- vec
- )
+(defun add-init (x &optional endp &aux (tem (cons (memoized-hash-equal x -1000) x)))
+ (if endp
+ (nconc (data-inits) (list tem))
+ (push tem (data-inits)))
+ x)
+
+(defun verify-datum (v)
+ (unless (eql (pop v) (memoized-hash-equal v -1000))
+ (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" v))
+ v)
+
+(defun wt-fasd-element (x)
+ (si::find-sharing-top x (fasd-table (car *fasd-data*)))
+ (si::write-fasd-top x (car *fasd-data*)))
-(defun add-init (x &optional endp)
- (let ((tem (cons (memoized-hash-equal x -1000) x)))
- (setf (data-inits)
- (if endp
- (nconc (data-inits) (list tem))
- (cons tem (data-inits) )))
- x))
+(defun wt-data2 (x)
+ (if *fasd-data*
+ (wt-fasd-element x)
+ (wt-data1 x)))
-(defun wt-data-file ()
+(defun wt-data-file nil
(when *prof-p* (add-init `(si::mark-memory-as-profiling)))
- (verify-data-vector (data-vector))
- (let* ((vec (coerce (nreverse (data-inits)) 'vector)))
- (verify-data-vector vec)
- (setf (aref (data-vector) (- (length (data-vector)) 1))
- (cons 'si::%init vec))
- (setf (data-package-ops) (nreverse (data-package-ops)))
- (cond (*fasd-data*
- (wt-fasd-data-file))
- (t
- (format *compiler-output-data* " ~%#(")
- (dolist (v (data-package-ops))
- (format *compiler-output-data* "#! ")
- (wt-data1 v))
- (wt-data1 (data-vector))
- (format *compiler-output-data* "~%)~%")
- ))))
+ (wt-data2 (1+ *next-vv*))
+ (dolist (v (nreverse (data-inits)))
+ (wt-data2 (verify-datum v)))
+ (when *fasd-data*
+ (si::close-fasd (car *fasd-data*))))
-(defun wt-fasd-data-file ( &aux (x (data-vector)) tem)
-; (si::find-sharing-top (data-package-ops) (fasd-table (car *fasd-data*)))
- (si::find-sharing-top x (fasd-table (car *fasd-data*)))
- (cond ((setq tem (data-package-ops))
- (dolist (v tem)
- (put-op d_eval_skip *compiler-output-data*)
- (si::write-fasd-top v (car *fasd-data*)))))
- (si::write-fasd-top x (car *fasd-data*))
-; (sloop::sloop for (k v) in-table (fasd-table (car *fasd-data*))
-; when (>= v 0) do (print (list k v)))
- (si::close-fasd (car *fasd-data*)))
(defun wt-data-begin ())
(defun wt-data-end ())
-(defun wt-data-package-operation (x)
- (push x (data-package-ops)))
(defmacro wt (&rest forms &aux (fl nil))
(dolist** (form forms (cons 'progn (reverse (cons nil fl))))
--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp
+++ gcl-2.6.12/cmpnew/sys-proclaim.lisp
@@ -2,197 +2,163 @@
(COMMON-LISP::IN-PACKAGE "COMPILER")
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
- COMPILER::TAG-REF-CLB COMPILER::SET-TOP
- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LIST-NTH
- COMPILER::C1RPLACA-NTHCDR COMPILER::C1DEFINE-STRUCTURE
- COMPILER::BLK-REF-CLB COMPILER::WT-VV COMPILER::C1LENGTH
- COMPILER::C1MAPC COMPILER::C1LOCAL-CLOSURE
- COMPILER::CHECK-VREF COMPILER::WT-VAR-DECL COMPILER::C1TAGBODY
- COMPILER::BLK-REF-CCB COMPILER::C1LOAD-TIME-VALUE
- COMPILER::C1ASH COMPILER::FUN-LEVEL COMPILER::COPY-INFO
- COMPILER::INLINE-POSSIBLE COMPILER::WT-VS-BASE
- COMPILER::T1DEFENTRY COMPILER::CHARACTER-LOC-P
- COMPILER::C2RPLACA COMPILER::RESET-INFO-TYPE
- COMPILER::TYPE-FILTER COMPILER::TAG-SWITCH
- COMPILER::DECL-BODY-SAFETY COMPILER::C1AND
- COMPILER::C1FMLA-CONSTANT COMPILER::C2GO-CLB
- COMPILER::C1FUNCTION COMPILER::C1MAPLIST COMPILER::VAR-TYPE
- COMPILER::CLINK COMPILER::UNWIND-NO-EXIT COMPILER::VAR-LOC
- COMPILER::C2RPLACD COMPILER::VERIFY-DATA-VECTOR
- COMPILER::TAG-REF-CCB COMPILER::C1RETURN-FROM
- COMPILER::T1DEFINE-STRUCTURE COMPILER::MDELETE-FILE
- COMPILER::OBJECT-TYPE COMPILER::WT-CAR COMPILER::TAG-P
- COMPILER::ADD-LOOP-REGISTERS COMPILER::C1MEMQ
- COMPILER::C2FUNCTION COMPILER::CMP-MACRO-FUNCTION
- COMPILER::C1BOOLE-CONDITION COMPILER::REP-TYPE COMPILER::C2GET
- COMPILER::C2VAR COMPILER::C2EXPR* COMPILER::C1ADD-GLOBALS
- COMPILER::WT1 COMPILER::C1BLOCK COMPILER::C1MAPL
- COMPILER::C1MAPCAR COMPILER::FSET-FN-NAME COMPILER::C2GO-CCB
- COMPILER::T1DEFLA COMPILER::C1NTH-CONDITION
- COMPILER::ADD-OBJECT2 COMPILER::VAR-NAME COMPILER::C1EXPR
- COMPILER::FUN-REF COMPILER::SCH-LOCAL-FUN
- COMPILER::FIXNUM-LOC-P COMPILER::BLK-VAR
- COMPILER::C1UNWIND-PROTECT COMPILER::C2BIND
- COMPILER::PARSE-CVSPECS COMPILER::C1NTH
- COMPILER::WT-SWITCH-CASE SYSTEM::UNDEF-COMPILER-MACRO
- COMPILER::SET-UP-VAR-CVS COMPILER::C1ECASE
- COMPILER::C1STRUCTURE-REF COMPILER::FUN-INFO
- COMPILER::C1MEMBER COMPILER::C1GET COMPILER::WT-FUNCTION-LINK
- COMPILER::C1ASH-CONDITION COMPILER::WT-CCB-VS COMPILER::INFO-P
- COMPILER::REGISTER COMPILER::TAG-VAR COMPILER::C1VAR
- COMPILER::C1TERPRI COMPILER::LTVP
- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1MAPCON
- COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1SETQ
- COMPILER::C2DOWNWARD-FUNCTION COMPILER::T3ORDINARY
- COMPILER::C1VREF COMPILER::WT-VS COMPILER::CONSTANT-FOLD-P
- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-EXIT
- COMPILER::T1DEFUN COMPILER::C1LABELS COMPILER::C1FSET
- COMPILER::T1MACROLET COMPILER::FUN-NAME COMPILER::C1APPLY
- COMPILER::FUN-P COMPILER::WT-DATA-PACKAGE-OPERATION
- COMPILER::C1FUNOB COMPILER::WT-SYMBOL-FUNCTION
- COMPILER::GET-RETURN-TYPE COMPILER::ADD-CONSTANT
- COMPILER::SAFE-SYSTEM COMPILER::BLK-VALUE-TO-GO
- COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C2TAGBODY-LOCAL
- COMPILER::C1DECLARE COMPILER::C1OR COMPILER::C1ASSOC
- COMPILER::ADD-ADDRESS COMPILER::VAR-KIND
- COMPILER::PROCLAMATION COMPILER::FIX-OPT COMPILER::WT-DATA1
- COMPILER::INFO-SP-CHANGE COMPILER::ARGS-CAUSE-SIDE-EFFECT
- COMPILER::WRITE-BLOCK-OPEN COMPILER::C2TAGBODY-BODY
- COMPILER::CONS-TO-LISTA COMPILER::SAVE-FUNOB COMPILER::VAR-REF
- COMPILER::C1LOCAL-FUN COMPILER::VAR-REP-LOC
- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::CTOP-WRITE
- COMPILER::C2TAGBODY-CLB COMPILER::T1CLINES
- COMPILER::ADD-OBJECT COMPILER::GET-LOCAL-RETURN-TYPE
- COMPILER::DEFAULT-INIT COMPILER::FUNCTION-ARG-TYPES
- COMPILER::C1STRUCTURE-SET COMPILER::CMP-MACROEXPAND-1
- COMPILER::INLINE-TYPE COMPILER::VAR-REGISTER
- COMPILER::DECLARATION-TYPE COMPILER::C1CATCH COMPILER::C1LET
- COMPILER::T3CLINES COMPILER::UNDEFINED-VARIABLE COMPILER::C1GO
- COMPILER::TAG-NAME COMPILER::SCH-GLOBAL COMPILER::C1IF
- COMPILER::C1FLET COMPILER::INLINE-BOOLE3-STRING
- COMPILER::INFO-CHANGED-ARRAY COMPILER::C2FUNCALL-AUX
- COMPILER::FUN-REF-CCB COMPILER::WT-CADR COMPILER::FUN-CFUN
- COMPILER::WT-VS* COMPILER::WT-DOWN COMPILER::C2GETHASH
- COMPILER::ADD-REG1 COMPILER::REPLACE-CONSTANT
- COMPILER::C2DM-RESERVE-V COMPILER::RESULT-TYPE
- COMPILER::C1FUNCALL COMPILER::C1THE COMPILER::VARARG-P
- COMPILER::INFO-REFERRED-ARRAY COMPILER::C1PROGV
- COMPILER::T2DECLARE COMPILER::T1DEFCFUN COMPILER::C2VALUES
- COMPILER::C1SWITCH COMPILER::C1MAPCAN
- COMPILER::CMP-MACROEXPAND COMPILER::TAG-LABEL
- COMPILER::TAG-UNWIND-EXIT COMPILER::C1PRINC COMPILER::C1THROW
- COMPILER::SAVE-AVMA COMPILER::VOLATILE COMPILER::FLAGS-POS
- COMPILER::INFO-TYPE COMPILER::C1NTHCDR-CONDITION
- COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::WT-FUNCALL-C
- COMPILER::PUSH-ARGS COMPILER::C1DM-BAD-KEY
- COMPILER::T1ORDINARY COMPILER::C1PSETQ COMPILER::BLK-REF
- COMPILER::C2DM-RESERVE-VL COMPILER::C1MACROLET
- COMPILER::C1SHARP-COMMA COMPILER::C1RPLACA
- COMMON-LISP::PROCLAIM COMPILER::PUSH-DATA-INCF
- COMPILER::MACRO-DEF-P COMPILER::BLK-NAME COMPILER::C1VALUES
- COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1DEFMACRO
- COMPILER::GET-ARG-TYPES COMPILER::ADD-SYMBOL
- COMPILER::NAME-SD1 COMPILER::C2GO-LOCAL
- COMPILER::C2TAGBODY-CCB COMPILER::WT-LIST
- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::C1BOOLE3
- COMPILER::C1STACK-LET COMPILER::WT-CDR COMPILER::C1QUOTE
- COMPILER::C1EVAL-WHEN COMPILER::VAR-P COMPILER::CHECK-DOWNWARD
- COMPILER::T1PROGN COMPILER::BLK-P COMPILER::C2LOCATION
- COMPILER::THE-PARAMETER COMPILER::C2VAR-KIND
- COMPILER::C1GETHASH COMPILER::LTVP-EVAL COMPILER::C1RPLACD
- COMPILER::INFO-VOLATILE COMPILER::LONG-FLOAT-LOC-P
- COMPILER::FUNCTION-RETURN-TYPE COMPILER::SHORT-FLOAT-LOC-P
- COMPILER::WT-H1 COMPILER::C1MULTIPLE-VALUE-CALL
- COMPILER::NAME-TO-SD COMPILER::C1PROGN COMPILER::SET-RETURN
- COMPILER::C1LET* COMPILER::AET-C-TYPE COMPILER::C1COMPILER-LET
- COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::VV-STR
- COMPILER::C1NTHCDR COMPILER::TAG-REF COMPILER::GET-INCLUDED))
-(COMMON-LISP::PROCLAIM
- '(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
- COMPILER::INLINE-BOOLE3))
-(COMMON-LISP::PROCLAIM
- '(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION
- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER
- COMMON-LISP::*))
+ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
COMMON-LISP::T)
- COMPILER::TS COMPILER::DASH-TO-UNDERSCORE))
+ COMPILER::CMPERR COMPILER::CMPWARN COMPILER::WT-CVAR
+ COMPILER::ADD-INIT COMPILER::INIT-NAME
+ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::C1CASE
+ COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE
+ COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT
+ COMPILER::C1LAMBDA-EXPR))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION
- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
- COMMON-LISP::T)
- COMMON-LISP::T)
- COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::WT-IF-PROCLAIMED
- COMPILER::MY-CALL COMPILER::WT-GLOBAL-ENTRY
- COMPILER::T3DEFUN-NORMAL COMPILER::C2STRUCTURE-REF
- COMPILER::C2SWITCH COMPILER::C2CALL-GLOBAL
- COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR))
+ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+ COMMON-LISP::*)
+ COMPILER::C2RETURN-LOCAL COMPILER::WT-INLINE-LOC
+ COMPILER::C1SYMBOL-FUN COMPILER::C2DECL-BODY
+ COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES
+ COMPILER::C2BLOCK COMPILER::C1BODY COMPILER::C2BLOCK-LOCAL))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+ (COMMON-LISP::T
+ (COMMON-LISP::INTEGER -9223372036854775808
+ 9223372036854775807))
COMMON-LISP::T)
- COMPILER::LINK COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL
- COMPILER::INLINE-ARGS))
+ COMPILER::MEMOIZED-HASH-EQUAL))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION
- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
- COMMON-LISP::T)
- COMPILER::WT-INLINE-INTEGER COMPILER::ADD-FUNCTION-DECLARATION
- COMPILER::C1STRUCTURE-REF1 COMPILER::ADD-FAST-LINK
- COMPILER::AND-FORM-TYPE COMPILER::C2PRINC COMPILER::C2MAPCAN
- COMPILER::CJT COMPILER::C2CASE COMPILER::WT-INLINE-LONG-FLOAT
- COMPILER::SUBLIS1-INLINE COMPILER::MYSUB
- COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::FIX-DOWN-ARGS
- COMPILER::TOO-MANY-ARGS COMPILER::CMP-EXPAND-MACRO
- COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO
- COMPILER::WT-INLINE-FIXNUM COMPILER::WT-INLINE-COND
- COMPILER::C1MAP-FUNCTIONS COMPILER::C1DM
- COMPILER::WT-MAKE-CCLOSURE COMPILER::CAN-BE-REPLACED*
- COMPILER::C-FUNCTION-NAME COMPILER::C2LET* COMPILER::CJF
- COMPILER::TOO-FEW-ARGS COMPILER::BOOLE3 COMPILER::T3DEFCFUN
- COMPILER::C2FUNCALL-SFUN COMPILER::C2MAPC
- COMPILER::CHECK-FORM-TYPE COMPILER::SET-VAR
- COMPILER::C2TAGBODY COMPILER::CHECK-VDECL
- COMPILER::GET-INLINE-INFO COMPILER::ASSIGN-DOWN-VARS
- COMPILER::C2LET COMPILER::INLINE-TYPE-MATCHES
- COMPILER::COMPILER-PASS2 COMPILER::C2PROGV COMPILER::C2MAPCAR
- COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-CHARACTER
- COMPILER::WT-INLINE-SHORT-FLOAT))
+ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*)
+ COMPILER::MAKE-INIT-STRING))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+ ((COMMON-LISP::INTEGER -9223372036854775808
+ 9223372036854775807)
+ (COMMON-LISP::INTEGER -9223372036854775808
+ 9223372036854775807))
COMMON-LISP::T)
- COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN COMPILER::T3DEFENTRY))
+ COMPILER::MLIN))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION
- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
- COMMON-LISP::T COMMON-LISP::T)
- COMMON-LISP::T)
- COMPILER::T3DEFUN-LOCAL-ENTRY COMPILER::T3INIT-FUN
- COMPILER::T2DEFUN COMPILER::T3DEFUN COMPILER::C2STRUCTURE-SET
- COMPILER::C1APPLY-OPTIMIZE))
+ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+ COMMON-LISP::FIXNUM)
+ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS
+ COMPILER::ANALYZE-REGS1))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION
- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
- COMMON-LISP::*)
- COMMON-LISP::T)
- COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL))
+ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
+ COMPILER::DECL-BODY-SAFETY COMPILER::C2FUNCTION
+ COMPILER::C1PROGN COMPILER::C1MAPCAR COMPILER::C1FLET
+ COMPILER::C1EXPR COMPILER::C1LET COMPILER::ADD-OBJECT
+ COMPILER::C1LABELS COMPILER::C1FMLA-CONSTANT COMPILER::C1ECASE
+ COMPILER::C1LENGTH COMPILER::C1APPLY COMPILER::THE-PARAMETER
+ COMPILER::C1TAGBODY COMPILER::T3CLINES
+ COMPILER::VERIFY-DATA-VECTOR COMPILER::VAR-KIND
+ COMPILER::INLINE-TYPE COMPILER::C1MULTIPLE-VALUE-CALL
+ COMPILER::C2GET COMPILER::ADD-CONSTANT COMPILER::T1DEFMACRO
+ COMPILER::C2EXPR* COMPILER::TAG-UNWIND-EXIT
+ COMPILER::CHECK-DOWNWARD COMPILER::WT-CADR
+ COMPILER::CHARACTER-LOC-P COMPILER::C1DECLARE
+ COMPILER::AET-C-TYPE COMPILER::C1QUOTE COMPILER::CHECK-VREF
+ COMPILER::VAR-LOC COMPILER::INLINE-POSSIBLE COMPILER::SET-TOP
+ COMPILER::T1ORDINARY COMPILER::BLK-VAR COMPILER::SAVE-AVMA
+ COMPILER::C1VREF COMPILER::WT-VV COMPILER::C2GO-LOCAL
+ COMPILER::C1MEMBER COMPILER::LTVP-EVAL COMPILER::VV-STR
+ COMPILER::TAG-REF-CLB COMPILER::T2DECLARE
+ COMPILER::CMP-MACROEXPAND-1 COMPILER::T1DEFINE-STRUCTURE
+ COMPILER::T1DEFENTRY COMPILER::ADD-OBJECT2 COMPILER::FUN-LEVEL
+ COMPILER::VAR-P COMPILER::WT-DATA-PACKAGE-OPERATION
+ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1PSETQ COMPILER::C1OR
+ COMPILER::C1LOCAL-FUN COMPILER::WT-VS-BASE
+ COMPILER::DEFAULT-INIT COMPILER::C1MAPCON COMPILER::C1GO
+ COMPILER::INFO-REFERRED-ARRAY COMPILER::BLK-REF
+ COMPILER::T1DEFLA COMPILER::INFO-CHANGED-ARRAY
+ COMPILER::WT-VAR-DECL COMPILER::UNWIND-NO-EXIT
+ COMPILER::BLK-VALUE-TO-GO COMPILER::C2GO-CLB
+ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1MAPC
+ COMPILER::C2DOWNWARD-FUNCTION COMPILER::CMP-MACRO-FUNCTION
+ COMPILER::C1SHARP-COMMA COMPILER::ADD-ADDRESS
+ COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::T1DEFUN
+ COMPILER::C1ADD-GLOBALS COMPILER::C2DM-RESERVE-V
+ COMPILER::C1ASH COMPILER::C1STACK-LET
+ COMPILER::WT-SYMBOL-FUNCTION COMPILER::C2TAGBODY-CLB
+ COMPILER::C1MAPLIST COMPILER::PUSH-DATA-INCF
+ COMPILER::C2TAGBODY-LOCAL COMPILER::C1FSET COMPILER::WT1
+ COMPILER::VAR-REF-CCB COMPILER::INFO-P COMPILER::C1ASSOC
+ COMPILER::C2GETHASH COMPILER::C1RPLACD COMPILER::C1EVAL-WHEN
+ COMPILER::REP-TYPE COMPILER::C1FUNOB COMPILER::BLK-REF-CLB
+ COMPILER::WT-VS* COMPILER::C1GET COMPILER::SCH-LOCAL-FUN
+ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::C1BOOLE3
+ COMPILER::BLK-EXIT COMPILER::T1DEFCFUN COMPILER::GET-ARG-TYPES
+ COMPILER::WRITE-BLOCK-OPEN COMPILER::C1COMPILER-LET
+ COMPILER::ADD-LOOP-REGISTERS COMPILER::INLINE-BOOLE3-STRING
+ COMPILER::C1LOAD-TIME-VALUE COMPILER::VAR-TYPE
+ COMPILER::REGISTER COMPILER::RESET-INFO-TYPE
+ COMPILER::C1UNWIND-PROTECT COMPILER::C1IF
+ COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1VAR
+ COMPILER::WT-FUNCALL-C COMPILER::C1THE COMPILER::FIX-OPT
+ COMPILER::UNDEFINED-VARIABLE COMPILER::C2RPLACD
+ COMPILER::C1BOOLE-CONDITION COMPILER::C1NTH COMPILER::VARARG-P
+ COMPILER::OBJECT-TYPE COMPILER::VOLATILE COMPILER::FUN-P
+ COMPILER::VAR-REF COMPILER::C1DEFINE-STRUCTURE
+ COMPILER::MAXARGS COMPILER::LONG-FLOAT-LOC-P
+ COMPILER::REPLACE-CONSTANT COMPILER::C2TAGBODY-BODY
+ COMPILER::TAG-P COMPILER::C1RETURN-FROM COMPILER::WT-VS
+ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::C1LIST-NTH
+ COMPILER::FSET-FN-NAME COMPILER::SAVE-FUNOB COMPILER::C1BLOCK
+ COMPILER::C1AND COMPILER::C2TAGBODY-CCB COMPILER::GET-INCLUDED
+ COMPILER::TAG-REF COMPILER::NEED-TO-SET-VS-POINTERS
+ COMPILER::C1VALUES COMPILER::BLK-P COMPILER::COPY-INFO
+ COMPILER::WT-CAR COMPILER::FUN-CFUN
+ COMPILER::C1MULTIPLE-VALUE-PROG1 SYSTEM::UNDEF-COMPILER-MACRO
+ COMPILER::C1DM-BAD-KEY COMPILER::FUN-REF COMPILER::NAME-SD1
+ COMPILER::MDELETE-FILE COMPILER::SAFE-SYSTEM
+ COMPILER::WT-DATA2 COMPILER::WT-CDR COMPILER::C2GO-CCB
+ COMPILER::C1ASH-CONDITION COMPILER::C1RPLACA
+ COMPILER::WT-DATA1 COMPILER::C1RPLACA-NTHCDR
+ COMPILER::NAME-TO-SD COMPILER::WT-LIST
+ COMPILER::CMP-MACROEXPAND COMPILER::WT-SWITCH-CASE
+ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::SET-UP-VAR-CVS
+ COMPILER::WT-FASD-ELEMENT COMPILER::RESULT-TYPE
+ COMPILER::C1SWITCH COMPILER::FIXNUM-LOC-P
+ COMPILER::C1NTHCDR-CONDITION COMPILER::TAG-VAR
+ COMPILER::C1NTHCDR COMPILER::CLINK COMPILER::LTVP
+ COMPILER::C1LET* COMPILER::TAG-NAME COMPILER::C1FUNCALL
+ COMPILER::C2RPLACA COMPILER::MACRO-DEF-P
+ COMPILER::C1STRUCTURE-REF COMPILER::GET-RETURN-TYPE
+ COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1CLINES
+ COMPILER::TYPE-FILTER COMPILER::C1FUNCTION
+ COMPILER::CONS-TO-LISTA COMPILER::C1NTH-CONDITION
+ COMPILER::FUN-NAME COMPILER::PROCLAMATION COMPILER::VAR-NAME
+ COMPILER::WT-CCB-VS COMPILER::FLAGS-POS COMPILER::C1CATCH
+ COMPILER::CTOP-WRITE COMPILER::TAG-LABEL COMPILER::C1MEMQ
+ COMPILER::C1GETHASH COMPILER::TAG-REF-CCB COMPILER::TAG-SWITCH
+ COMPILER::C2BIND COMPILER::VERIFY-DATUM COMPILER::C1MAPCAN
+ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI
+ COMPILER::FUN-REF-CCB COMMON-LISP::PROCLAIM
+ COMPILER::INFO-VOLATILE COMPILER::T3ORDINARY
+ COMPILER::C2LOCATION COMPILER::BLK-NAME
+ COMPILER::C1STRUCTURE-SET COMPILER::C2VAR
+ COMPILER::C1LOCAL-CLOSURE COMPILER::C1MACROLET
+ COMPILER::WT-FUNCTION-LINK COMPILER::C2VALUES
+ COMPILER::T1MACROLET COMPILER::C1MULTIPLE-VALUE-BIND
+ COMPILER::C2FUNCALL-AUX COMPILER::C1MULTIPLE-VALUE-SETQ
+ COMPILER::PUSH-ARGS COMPILER::BLK-REF-CCB COMPILER::C1SETQ
+ COMPILER::ADD-SYMBOL COMPILER::C2VAR-KIND COMPILER::C1THROW
+ COMPILER::DECLARATION-TYPE COMPILER::C1PROGV
+ COMPILER::INFO-TYPE COMPILER::CONSTANT-FOLD-P
+ COMPILER::C1PRINC COMPILER::WT-DOWN COMPILER::SCH-GLOBAL
+ COMPILER::T1PROGN COMPILER::INFO-SP-CHANGE
+ COMPILER::C2DM-RESERVE-VL COMPILER::C1MAPL
+ COMPILER::FUNCTION-RETURN-TYPE COMPILER::ADD-REG1
+ COMPILER::PARSE-CVSPECS COMPILER::FUN-INFO
+ COMPILER::VAR-REGISTER COMPILER::SET-RETURN COMPILER::WT-H1
+ COMPILER::VAR-REP-LOC))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION
- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
- COMMON-LISP::T)
- COMPILER::T3LOCAL-DCFUN COMPILER::T3LOCAL-FUN))
+ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
+ COMPILER::INLINE-BOOLE3))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
@@ -206,8 +172,8 @@
(COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
COMMON-LISP::T)
COMMON-LISP::*)
- COMPILER::C2RETURN-FROM COMPILER::C2DM COMPILER::C1DM-VL
- COMPILER::C2APPLY-OPTIMIZE COMPILER::C1DM-V))
+ COMPILER::C1DM-V COMPILER::C1DM-VL COMPILER::C2APPLY-OPTIMIZE
+ COMPILER::C2RETURN-FROM COMPILER::C2DM))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
@@ -216,40 +182,85 @@
COMPILER::T3DEFUN-AUX))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
- COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC
- COMPILER::WT-CHARACTER-LOC COMPILER::WT-TO-STRING
- COMPILER::WT-LOC COMPILER::MEXPAND-DEFTYPE
- COMPILER::CMP-TOPLEVEL-EVAL COMPILER::T1EVAL-WHEN
- COMPILER::T1EXPR COMPILER::C2OR COMPILER::WT-FIXNUM-LOC
- COMPILER::C2EXPR COMPILER::C2AND COMPILER::CMP-EVAL
- COMPILER::SET-LOC COMPILER::WT-SHORT-FLOAT-LOC))
-(COMMON-LISP::PROCLAIM
- '(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
- COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE
- COMPILER::LIST-INLINE COMPILER::LIST*-INLINE
- COMPILER::COMPILER-COMMAND COMPILER::MAKE-BLK
- COMPILER::MAKE-FUN COMPILER::WT-CLINK COMPILER::C2FSET
- COMPILER::MAKE-TAG COMPILER::CS-PUSH COMPILER::MAKE-VAR
- COMMON-LISP::COMPILE-FILE))
-(COMMON-LISP::PROCLAIM
- '(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM)
COMPILER::F-TYPE))
-(COMMON-LISP::MAPC
- (COMMON-LISP::LAMBDA (COMPILER::X)
- (COMMON-LISP::SETF
- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE)
- COMMON-LISP::T))
- '(COMMON-LISP::DISASSEMBLE COMPILER::CMP-TMP-MACRO
- COMPILER::CMP-ANON COMMON-LISP::COMPILE))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION
- ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)))
+ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
COMMON-LISP::T)
- COMPILER::COPY-ARRAY))
+ COMPILER::C2RETURN-CCB
+ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES
+ COMPILER::DO-CHANGED COMPILER::CO1STRUCTURE-PREDICATE
+ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::CMPFIX-ARGS
+ COMPILER::T3SHARP-COMMA COMPILER::FLAGS
+ COMPILER::CO1WRITE-BYTE COMPILER::CHECK-FNAME-ARGS
+ COMPILER::C2ASSOC!2 COMPILER::CK-SPEC
+ COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::ADD-DEBUG-INFO
+ COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::PRIN1-CMP
+ COMPILER::PUSH-CHANGED-VARS COMPILER::SHIFT>>
+ COMPILER::ARGS-INFO-REFERRED-VARS
+ COMPILER::C2MULTIPLE-VALUE-CALL
+ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::CO1SCHAR
+ COMPILER::NEXT-CVAR COMPILER::C2RETURN-CLB
+ COMPILER::CO1WRITE-CHAR COMPILER::SET-VS SYSTEM::SWITCH
+ COMPILER::FLAG-P COMPILER::DO-ARRAY COMPILER::INLINE-PROC
+ COMPILER::CO1CONS COMPILER::C2EXPR-TOP
+ COMPILER::CHANGED-LENGTH COMPILER::C2MULTIPLE-VALUE-PROG1
+ COMPILER::REMOVE-FLAG COMPILER::CO1SUBLIS COMPILER::ADD-INFO
+ COMPILER::C2BIND-INIT COMPILER::C2DM-BIND-VL COMPILER::C1FMLA
+ COMPILER::C2CATCH COMPILER::WT-MAKE-DCLOSURE
+ COMPILER::UNWIND-BDS COMPILER::IS-REP-REFERRED
+ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::WT-GO
+ COMPILER::FAST-READ COMPILER::WT COMPILER::SAFE-COMPILE
+ COMPILER::WT-H COMPILER::STRUCT-TYPE-OPT
+ COMPILER::REFERRED-LENGTH COMPILER::TYPE-AND COMPILER::C2THROW
+ COMPILER::NEED-TO-PROTECT COMPILER::COERCE-LOC
+ COMPILER::TYPE>= COMPILER::WT-NL1 COMPILER::CHECK-END
+ COMPILER::C2BLOCK-CCB COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY
+ COMPILER::SET-BDS-BIND COMPILER::C2DM-BIND-INIT
+ COMPILER::CAN-BE-REPLACED COMPILER::MAYBE-EVAL
+ COMPILER::WT-VAR COMPILER::WT-REQUIREDS
+ COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::CO1TYPEP
+ COMPILER::C1DECL-BODY COMPILER::DOWNWARD-FUNCTION
+ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::NEXT-CFUN
+ SYSTEM::SWITCH-FINISH COMPILER::CO1READ-CHAR
+ COMPILER::COMPILER-CC COMPILER::C1PROGN*
+ COMPILER::C1LAMBDA-FUN COMPILER::MAKE-USER-INIT
+ COMPILER::SHIFT<< COMPILER::C1ARGS COMPILER::CK-VL
+ COMPILER::T23EXPR COMPILER::IS-CHANGED COMPILER::PUSH-REFERRED
+ COMPILER::WT-CHARACTER-VALUE
+ COMPILER::PUSH-REFERRED-WITH-START COMPILER::NEXT-LABEL*
+ COMPILER::CMPCK COMPILER::C2DM-BIND-LOC
+ COMPILER::WT-SHORT-FLOAT-VALUE
+ COMPILER::PUSH-CHANGED-WITH-START COMPILER::C2EXPR-TOP*
+ COMPILER::DOLIST* COMPILER::WT-LABEL COMPILER::PUSH-CHANGED
+ COMPILER::BASE-USED COMPILER::CO1VECTOR-PUSH
+ COMPILER::WT-V*-MACROS COMPILER::CO1CONSTANT-FOLD
+ COMPILER::WT-FIXNUM-VALUE COMPILER::C2BLOCK-CLB
+ SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::SET-JUMP-TRUE
+ COMPILER::C2BIND-LOC COMPILER::IN-ARRAY
+ COMPILER::SET-JUMP-FALSE COMPILER::PROCLAIM-VAR
+ COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::C1CONSTANT-VALUE
+ COMPILER::COMPILER-DEF-HOOK COMPILER::CO1READ-BYTE
+ COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::IS-REFERRED
+ COMPILER::DOTIMES** SYSTEM::ADD-DEBUG COMPILER::DO-REFERRED
+ COMPILER::NEXT-LABEL COMPILER::C2CALL-LAMBDA COMPILER::C2APPLY
+ COMPILER::C1EXPR* COMPILER::C2SETQ COMPILER::MIA
+ COMPILER::C2PSETQ COMPILER::C1SETQ1
+ COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::WT-NL
+ COMPILER::CO1EQL COMPILER::CFAST-WRITE COMPILER::CO1LDB
+ COMPILER::EQL-NOT-NIL COMPILER::JUMPS-TO-P
+ COMPILER::C2CALL-LOCAL COMPILER::BIGNUM-EXPANSION-STORAGE
+ COMPILER::STACK-LET COMPILER::C2MULTIPLE-VALUE-SETQ
+ COMPILER::C2MEMBER!2 COMPILER::C2UNWIND-PROTECT
+ COMPILER::DOLIST** COMPILER::SET-DBIND COMPILER::DOTIMES*
+ COMPILER::NEXT-CMACRO COMPILER::GET-INLINE-LOC
+ COMPILER::C2STACK-LET))
+(COMMON-LISP::PROCLAIM
+ '(COMMON-LISP::FTYPE
+ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+ COMMON-LISP::*)
+ COMPILER::COMPILE-FILE1))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
@@ -257,9 +268,11 @@
(COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))
(COMMON-LISP::INTEGER -9223372036854775808
9223372036854775807)
+ (COMMON-LISP::INTEGER -9223372036854775808
+ 9223372036854775807)
COMMON-LISP::T)
COMMON-LISP::FIXNUM)
- COMPILER::PUSH-ARRAY))
+ COMPILER::BSEARCHLEQ))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
@@ -267,11 +280,16 @@
(COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))
(COMMON-LISP::INTEGER -9223372036854775808
9223372036854775807)
- (COMMON-LISP::INTEGER -9223372036854775808
- 9223372036854775807)
COMMON-LISP::T)
COMMON-LISP::FIXNUM)
- COMPILER::BSEARCHLEQ))
+ COMPILER::PUSH-ARRAY))
+(COMMON-LISP::PROCLAIM
+ '(COMMON-LISP::FTYPE
+ (COMMON-LISP::FUNCTION
+ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER
+ COMMON-LISP::*))
+ COMMON-LISP::T)
+ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
@@ -285,130 +303,121 @@
COMPILER::DASH-TO-UNDERSCORE-INT))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
+ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
+ COMPILER::VS-PUSH COMPILER::WFS-ERROR COMPILER::MACRO-ENV
+ COMPILER::C1T COMPILER::WT-CVARS COMPILER::WT-DATA-END
+ COMPILER::GAZONK-NAME COMPILER::INIT-ENV
+ COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::CCB-VS-PUSH
+ COMPILER::WT-DATA-FILE COMPILER::WT-FASD-DATA-FILE
+ COMPILER::INC-INLINE-BLOCKS COMPILER::PRINT-CURRENT-FORM
+ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-DATA-BEGIN
+ COMPILER::BABOON COMPILER::WT-C-PUSH COMPILER::WT-NEXT-VAR-ARG
+ COMPILER::WT-FIRST-VAR-ARG COMPILER::CVS-PUSH
+ COMPILER::TAIL-RECURSION-POSSIBLE COMPILER::RESET-TOP
+ COMPILER::C1NIL COMPILER::PRINT-COMPILER-INFO))
+(COMMON-LISP::PROCLAIM
+ '(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
- ((COMMON-LISP::INTEGER -9223372036854775808
- 9223372036854775807)
- (COMMON-LISP::INTEGER -9223372036854775808
- 9223372036854775807))
+ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)))
COMMON-LISP::T)
- COMPILER::MLIN))
+ COMPILER::COPY-ARRAY))
+(COMMON-LISP::PROCLAIM
+ '(COMMON-LISP::FTYPE
+ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
+ COMPILER::T1EXPR COMPILER::WT-TO-STRING COMPILER::C2OR
+ COMPILER::WT-LOC COMPILER::SET-LOC COMPILER::MEXPAND-DEFTYPE
+ COMPILER::C2EXPR COMPILER::C2PROGN COMPILER::C2AND
+ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::WT-CHARACTER-LOC
+ COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN
+ COMPILER::WT-LONG-FLOAT-LOC COMPILER::CMP-TOPLEVEL-EVAL
+ COMPILER::WT-FIXNUM-LOC))
+(COMMON-LISP::PROCLAIM
+ '(COMMON-LISP::FTYPE
+ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
+ COMPILER::FCALLN-INLINE COMPILER::CS-PUSH COMPILER::WT-CLINK
+ COMPILER::COMPILER-COMMAND COMPILER::MAKE-INFO
+ COMPILER::T2PROGN COMPILER::MAKE-TAG COMPILER::C2FSET
+ COMPILER::MAKE-BLK COMPILER::LIST-INLINE
+ COMMON-LISP::COMPILE-FILE COMPILER::MAKE-FUN
+ COMPILER::MAKE-VAR COMPILER::T3PROGN COMPILER::LIST*-INLINE))
+(COMMON-LISP::MAPC
+ (COMMON-LISP::LAMBDA (COMPILER::X)
+ (COMMON-LISP::SETF
+ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE)
+ COMMON-LISP::T))
+ '(COMMON-LISP::COMPILE COMMON-LISP::DISASSEMBLE COMPILER::CMP-ANON
+ COMPILER::CMP-TMP-MACRO))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
(COMMON-LISP::FUNCTION
- (COMMON-LISP::T
- (COMMON-LISP::INTEGER -9223372036854775808
- 9223372036854775807))
+ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+ COMMON-LISP::T)
COMMON-LISP::T)
- COMPILER::MEMOIZED-HASH-EQUAL))
+ COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL
+ COMPILER::C2CALL-GLOBAL COMPILER::C2SWITCH COMPILER::MY-CALL
+ COMPILER::C1MAKE-VAR COMPILER::WT-IF-PROCLAIMED
+ COMPILER::C2STRUCTURE-REF COMPILER::C2CALL-UNKNOWN-GLOBAL
+ COMPILER::WT-GLOBAL-ENTRY))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
- COMPILER::MACRO-ENV COMPILER::C1T COMPILER::PRINT-CURRENT-FORM
- COMPILER::CCB-VS-PUSH COMPILER::C1NIL
- COMPILER::WT-FASD-DATA-FILE COMPILER::INIT-ENV
- COMPILER::WT-CVARS COMPILER::CVS-PUSH
- COMPILER::WT-FIRST-VAR-ARG COMPILER::WT-NEXT-VAR-ARG
- COMPILER::WT-DATA-FILE COMPILER::WT-C-PUSH
- COMPILER::GAZONK-NAME COMPILER::WT-DATA-END
- COMPILER::INC-INLINE-BLOCKS COMPILER::TAIL-RECURSION-POSSIBLE
- COMPILER::RESET-TOP COMPILER::CLOSE-INLINE-BLOCKS
- COMPILER::PRINT-COMPILER-INFO COMPILER::WFS-ERROR
- COMPILER::VS-PUSH COMPILER::BABOON COMPILER::WT-DATA-BEGIN
- COMPILER::ADD-LOAD-TIME-SHARP-COMMA))
+ (COMMON-LISP::FUNCTION
+ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+ COMMON-LISP::T)
+ COMPILER::T2DEFENTRY COMPILER::T3DEFENTRY COMPILER::DEFSYSFUN))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
- COMMON-LISP::FIXNUM)
- COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1
- COMPILER::ANALYZE-REGS))
+ (COMMON-LISP::FUNCTION
+ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+ COMMON-LISP::T)
+ COMPILER::C2PROGV COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY
+ COMPILER::CAN-BE-REPLACED* COMPILER::WT-INLINE-FIXNUM
+ COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-SHORT-FLOAT
+ COMPILER::C2LET* COMPILER::ADD-FAST-LINK
+ COMPILER::C1STRUCTURE-REF1 COMPILER::GET-INLINE-INFO
+ COMPILER::CHECK-FORM-TYPE COMPILER::C2MAPCAN
+ COMPILER::FIX-DOWN-ARGS COMPILER::CMP-EXPAND-MACRO
+ COMPILER::SUBLIS1-INLINE COMPILER::ADD-FUNCTION-PROCLAMATION
+ COMPILER::ADD-FUNCTION-DECLARATION COMPILER::SET-VAR
+ COMPILER::BOOLE3 COMPILER::CJF COMPILER::C2PRINC
+ COMPILER::INLINE-TYPE-MATCHES COMPILER::C1MAP-FUNCTIONS
+ COMPILER::C1DM COMPILER::WT-INLINE-CHARACTER
+ COMPILER::WT-MAKE-CCLOSURE COMPILER::TOO-MANY-ARGS
+ COMPILER::COMPILER-PASS2 COMPILER::WT-INLINE-INTEGER
+ COMPILER::T3DEFCFUN COMPILER::MYSUB
+ COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-FEW-ARGS
+ COMPILER::CHECK-VDECL COMPILER::C2GO COMPILER::C2LET
+ COMPILER::ASSIGN-DOWN-VARS COMPILER::C2CASE
+ COMPILER::C2FUNCALL-SFUN COMPILER::AND-FORM-TYPE
+ COMPILER::C-FUNCTION-NAME COMPILER::C2MAPCAR COMPILER::CJT
+ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2MAPC))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+ (COMMON-LISP::FUNCTION
+ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+ COMMON-LISP::T COMMON-LISP::T)
COMMON-LISP::T)
- COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT COMPILER::CMPERR
- COMPILER::WT-CVAR COMPILER::FAST-LINK-PROCLAIMED-TYPE-P
- COMPILER::C1CASE COMPILER::CMPWARN COMPILER::ADD-INIT
- COMPILER::INIT-NAME COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE
- COMPILER::C1LAMBDA-EXPR))
+ COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN-LOCAL-ENTRY
+ COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-SET))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
- COMMON-LISP::*)
- COMPILER::C2BLOCK COMPILER::C1SYMBOL-FUN
- COMPILER::C2BLOCK-LOCAL COMPILER::C2DECL-BODY
- COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES
- COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL
- COMPILER::C1BODY))
+ (COMMON-LISP::FUNCTION
+ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+ COMMON-LISP::T)
+ COMPILER::T3DEFUN COMPILER::T2DEFUN COMPILER::T3LOCAL-FUN
+ COMPILER::T3LOCAL-DCFUN))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+ (COMMON-LISP::FUNCTION
+ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
COMMON-LISP::T)
- COMPILER::WT-FIXNUM-VALUE COMPILER::DOLIST** COMPILER::CO1LDB
- COMPILER::PUSH-REFERRED-WITH-START COMPILER::C2ASSOC!2
- COMPILER::ADD-DEBUG-INFO COMPILER::WT-CHARACTER-VALUE
- COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::C2BIND-LOC
- COMPILER::C2CATCH COMPILER::DO-REFERRED COMPILER::C2BLOCK-CLB
- COMPILER::CO1CONSTANT-FOLD COMPILER::C2CALL-LOCAL
- COMPILER::SHIFT<< COMPILER::C2UNWIND-PROTECT
- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2DM-BIND-VL
- COMPILER::DOTIMES* COMPILER::REFERRED-LENGTH COMPILER::C1ARGS
- COMPILER::CK-SPEC COMPILER::C2MULTIPLE-VALUE-CALL
- COMPILER::C2CALL-LAMBDA COMPILER::CO1READ-BYTE
- COMPILER::CO1VECTOR-PUSH COMPILER::STACK-LET COMPILER::CMPCK
- COMPILER::MAYBE-EVAL COMPILER::COERCE-LOC COMPILER::C2PSETQ
- SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::WT-MAKE-DCLOSURE
- COMPILER::COMPILER-CC COMPILER::WT-GO COMPILER::C1LAMBDA-FUN
- COMPILER::C2RETURN-CLB COMPILER::C1DECL-BODY
- COMPILER::PUSH-CHANGED-VARS COMPILER::GET-INLINE-LOC
- COMPILER::CO1SUBLIS COMPILER::CHANGED-LENGTH COMPILER::CO1CONS
- COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-JUMP-FALSE
- COMPILER::MAKE-USER-INIT COMPILER::NEXT-CVAR
- COMPILER::CAN-BE-REPLACED COMPILER::WT-V*-MACROS
- COMPILER::NEXT-CMACRO COMPILER::C2RETURN-CCB
- COMPILER::CO1SCHAR COMPILER::IS-CHANGED
- COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::SET-DBIND
- COMPILER::WT-H COMPILER::COERCE-LOC-STRUCTURE-REF
- COMPILER::C1EXPR* COMPILER::IS-REFERRED COMPILER::SHIFT>>
- COMPILER::WT COMPILER::TYPE-AND COMPILER::PRIN1-CMP
- COMPILER::C2BIND-INIT COMPILER::RESULT-TYPE-FROM-ARGS
- COMPILER::EQL-NOT-NIL COMPILER::C2APPLY COMPILER::C2BLOCK-CCB
- COMPILER::WT-NL1 COMPILER::CO1WRITE-CHAR COMPILER::CFAST-WRITE
- COMPILER::NEED-TO-PROTECT COMPILER::T3SHARP-COMMA
- SYSTEM::ADD-DEBUG COMPILER::BIGNUM-EXPANSION-STORAGE
- COMPILER::C2SETQ COMPILER::FLAG-P
- COMPILER::PUSH-CHANGED-WITH-START COMPILER::CMPFIX-ARGS
- COMPILER::CO1STRUCTURE-PREDICATE COMPILER::FAST-READ
- COMPILER::C1CONSTANT-VALUE COMPILER::BASE-USED
- COMPILER::PROCLAIM-VAR COMPILER::CO1TYPEP
- COMPILER::SET-JUMP-TRUE COMPILER::TYPE>= COMPILER::DOTIMES**
- COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::C2MEMBER!2
- COMPILER::DO-CHANGED COMPILER::ADD-INFO COMPILER::SET-VS
- COMPILER::CHECK-FNAME-ARGS
- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES
- COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-LABEL*
- COMPILER::WT-VAR COMPILER::C2THROW COMPILER::INLINE-PROC
- COMPILER::PUSH-REFERRED COMPILER::C2LIST-NTH-IMMEDIATE
- COMPILER::C1FMLA COMPILER::PUSH-CHANGED
- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::MIA
- COMPILER::WT-LABEL COMPILER::WT-NL
- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::SET-BDS-BIND
- COMPILER::DO-ARRAY COMPILER::WT-REQUIREDS
- COMPILER::C2EXPR-TOP* COMPILER::C2DM-BIND-LOC
- COMPILER::DOLIST* SYSTEM::SWITCH-FINISH
- COMPILER::IS-REP-REFERRED COMPILER::WT-LONG-FLOAT-VALUE
- COMPILER::C1SETQ1 COMPILER::FLAGS COMPILER::CO1EQL
- COMPILER::CHECK-END COMPILER::NEXT-LABEL COMPILER::CK-VL
- COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::C1PROGN*
- COMPILER::C2DM-BIND-INIT COMPILER::STRUCT-TYPE-OPT
- COMPILER::UNWIND-BDS COMPILER::SAFE-COMPILE
- COMPILER::CO1READ-CHAR COMPILER::JUMPS-TO-P SYSTEM::SWITCH
- COMPILER::NEXT-CFUN COMPILER::CO1WRITE-BYTE
- COMPILER::DOWNWARD-FUNCTION COMPILER::COMPILER-DEF-HOOK
- COMPILER::C2STACK-LET COMPILER::C2EXPR-TOP
- COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::IN-ARRAY
- COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY))
+ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK
+ COMPILER::INLINE-ARGS))
(COMMON-LISP::PROCLAIM
'(COMMON-LISP::FTYPE
- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
- COMMON-LISP::*)
- COMPILER::COMPILE-FILE1))
\ No newline at end of file
+ (COMMON-LISP::FUNCTION
+ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+ COMMON-LISP::*)
+ COMMON-LISP::T)
+ COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME))
\ No newline at end of file
--- gcl-2.6.12.orig/h/object.h
+++ gcl-2.6.12/h/object.h
@@ -255,6 +255,21 @@ struct freelist {
#define FREE (-1) /* free object */
+struct fasd {
+ object stream; /* lisp object of type stream */
+ object table; /* hash table used in dumping or vector on input*/
+ object eof; /* lisp object to be returned on coming to eof mark */
+ object direction; /* holds Cnil or sKinput or sKoutput */
+ object package; /* the package symbols are in by default */
+ object index; /* integer. The current_dump index on write */
+ object filepos; /* nil or the position of the start */
+ object table_length; /* On read it is set to the size dump array needed
+ or 0
+ */
+ object evald_items; /* a list of items which have been eval'd and must
+ not be walked by fasd_patch_sharp */
+};
+
/*
Storage manager for each type.
*/
--- gcl-2.6.12.orig/h/protoize.h
+++ gcl-2.6.12/h/protoize.h
@@ -144,7 +144,7 @@ struct key {short n,allow_other_keys;
/* cmpaux.c:185:OF */ extern fixnum object_to_fixnum (object x); /* (x) object x; */
/* cmpaux.c:263:OF */ extern char *object_to_string (object x); /* (x) object x; */
typedef int (*FUNC)();
-/* cmpaux.c:294:OF */ extern void call_init (int init_address, object memory, object fasl_vec, FUNC fptr); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */
+/* cmpaux.c:294:OF */ extern void call_init (int init_address,object memory,object faslfile); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */
/* cmpaux.c:339:OF */ extern void do_init (object *statVV); /* (statVV) object *statVV; */
/* cmpaux.c:416:OF */ extern void gcl_init_or_load1 (void (*fn) (void), const char *file); /* (fn, file) int (*fn)(); char *file; */
/* conditional.c:200:OF */ extern void gcl_init_conditional (void); /* () */
--- gcl-2.6.12.orig/o/cmpaux.c
+++ gcl-2.6.12/o/cmpaux.c
@@ -324,63 +324,18 @@ object_to_string(object x) {
/* } */
/* #endif */
+
void
-call_init(int init_address, object memory, object fasl_vec, FUNC fptr)
-{object form;
- FUNC at;
-/* #ifdef CLEAR_CACHE */
-/* static int n; */
-/* static sigset_t ss; */
-
-/* if (!n) { */
-/* struct sigaction sa={{(void *)sigh},{{0}},SA_RESTART|SA_SIGINFO,NULL}; */
-
-/* sigaction(SIGILL,&sa,NULL); */
-/* sigemptyset(&ss); */
-/* sigaddset(&ss,SIGILL); */
-/* sigprocmask(SIG_BLOCK,&ss,NULL); */
-/* n=1; */
-/* } */
-/* #endif */
+call_init(int init_address,object memory,object faslfile) {
+ bds_bind(sSPmemory,memory);
+ bds_bind(sSPinit,faslfile);
+ ((FUNC)(memory->cfd.cfd_start+init_address))();
+ bds_unwind1;
+ bds_unwind1;
- check_type(fasl_vec,t_vector);
- form=(fasl_vec->v.v_self[fasl_vec->v.v_fillp -1]);
+}
- if (fptr) at = fptr;
- else
- at=(FUNC)(memory->cfd.cfd_start+ init_address );
-
-#ifdef VERIFY_INIT
- VERIFY_INIT
-#endif
-
- if (type_of(form)==t_cons &&
- form->c.c_car == sSPinit)
- {bds_bind(sSPinit,fasl_vec);
- bds_bind(sSPmemory,memory);
-/* #ifdef CLEAR_CACHE */
-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */
-/* #endif */
- (*at)();
-/* #ifdef CLEAR_CACHE */
-/* sigprocmask(SIG_BLOCK,&ss,NULL); */
-/* #endif */
- bds_unwind1;
- bds_unwind1;
- }
- else
- /* old style three arg init, with all init being done by C code. */
- {memory->cfd.cfd_self = fasl_vec->v.v_self;
- memory->cfd.cfd_fillp = fasl_vec->v.v_fillp;
-/* #ifdef CLEAR_CACHE */
-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */
-/* #endif */
- (*at)(memory->cfd.cfd_start, memory->cfd.cfd_size, memory);
-/* #ifdef CLEAR_CACHE */
-/* sigprocmask(SIG_BLOCK,&ss,NULL); */
-/* #endif */
-}}
/* statVV is the address of some static storage, which is used by the
cfunctions to refer to global variables,..
@@ -393,48 +348,46 @@ call_init(int init_address, object memor
*/
-DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0,
- NONE,OO,OO,OO,OO,(void),"") {
-
- sSPmemory->s.s_dbind->cfd.cfd_prof=1;
-
- return Cnil;
-
-}
-
void
-do_init(object *statVV)
-{object fasl_vec=sSPinit->s.s_dbind;
- object data = sSPmemory->s.s_dbind;
- {object *p,*q,y;
- int n=fasl_vec->v.v_fillp -1;
- int i;
- object form;
- check_type(fasl_vec,t_vector);
- form = fasl_vec->v.v_self[n];
- dcheck_type(form,t_cons);
+do_init(object *statVV) {
+
+ object faslfile=sSPinit->s.s_dbind;
+ object data=sSPmemory->s.s_dbind;
+ object *p,*q,y;
+ int i,n;
+ object fasl_vec;
+ char ch;
+
+ ch=readc_stream(faslfile);
+ unreadc_stream(ch,faslfile);
+
+ if (ch!='\n') {
+ struct fasd * fd;
+ faslfile=FFN(fSopen_fasd)(faslfile,sKinput,OBJNULL,Cnil);
+ fd=(struct fasd *)faslfile->v.v_self;
+ n=fix(fd->table_length);
+ fd->table->v.v_self=alloca(n*sizeof(object));
+ memset(fd->table->v.v_self,0,n*sizeof(object));
+ fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n;
+ }
+ n=fix(type_of(faslfile)==t_stream ? read_object(faslfile) : FFN(fSread_fasd_top)(faslfile));
+ sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil);
/* switch SPinit to point to a vector of function addresses */
-
+
fasl_vec->v.v_elttype = aet_fix;
- fasl_vec->v.v_dim *= (sizeof(object)/sizeof(fixnum));
- fasl_vec->v.v_fillp *= (sizeof(object)/sizeof(fixnum));
-
+
/* swap the entries */
- p = fasl_vec->v.v_self;
+ for (i=0,p=fasl_vec->v.v_self,q=statVV;i<n;i++) {
+ y=*p;
+ *p++=*q;
+ *q++=y;
+ }
- q = statVV;
- for (i=0; i<=n ; i++)
- { y = *p;
- *p++ = *q;
- *q++ = y;
- }
-
data->cfd.cfd_self = statVV;
- data->cfd.cfd_fillp= n+1;
- statVV[n] = data;
-
+ data->cfd.cfd_fillp= n;
+ statVV[n-1] = data;
/* So now the fasl_vec is a fixnum array, containing random addresses of c
functions and other stuff from the compiled code.
@@ -442,16 +395,20 @@ do_init(object *statVV)
*/
/* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */
- form=form->c.c_cdr;
- {object *top=vs_top;
-
- for(i=0 ; i< form->v.v_fillp; i++)
- {
- eval(form->v.v_self[i]);
- vs_top=top;
- }
- }
-}}
+ FFN(fSload_stream)(faslfile,Cnil);
+ if (type_of(faslfile)!=t_stream)
+ FFN(fSclose_fasd)(faslfile);
+
+}
+
+DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0,
+ NONE,OO,OO,OO,OO,(void),"") {
+
+ sSPmemory->s.s_dbind->cfd.cfd_prof=1;
+
+ return Cnil;
+
+}
#ifdef DOS
#define PATH_LIM 8
@@ -498,14 +455,15 @@ gcl_init_or_load1(void (*fn)(void),const
if (file[strlen(file)-1]=='o') {
object memory;
- object fasl_data;
+ object faslfile;
file=FIX_PATH_STRING(file);
memory=new_cfdata();
memory->cfd.cfd_start= (char *)fn;
printf("Initializing %s\n",file); fflush(stdout);
- fasl_data = read_fasl_data(file);
- call_init(0,memory,fasl_data,0);
+ faslfile=open_stream(make_simple_string(file),smm_input,Cnil,sKerror);
+ SEEK_TO_END_OFILE(faslfile->sm.sm_fp);
+ call_init(0,memory,faslfile);
} else {
printf("loading %s\n",file);
--- gcl-2.6.12.orig/o/fasdump.c
+++ gcl-2.6.12/o/fasdump.c
@@ -35,22 +35,6 @@ object make_pathname ();
static int needs_patching;
-
-struct fasd {
- object stream; /* lisp object of type stream */
- object table; /* hash table used in dumping or vector on input*/
- object eof; /* lisp object to be returned on coming to eof mark */
- object direction; /* holds Cnil or sKinput or sKoutput */
- object package; /* the package symbols are in by default */
- object index; /* integer. The current_dump index on write */
- object filepos; /* nil or the position of the start */
- object table_length; /* On read it is set to the size dump array needed
- or 0
- */
- object evald_items; /* a list of items which have been eval'd and must
- not be walked by fasd_patch_sharp */
-};
-
struct fasd current_fasd;
@@ -599,7 +583,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd
else
check_type(tabl,t_hashtable);}
massert(str==stream);
- result=alloc_simple_vector(sizeof(struct fasd)/sizeof(int),aet_object);
+ result=alloc_simple_vector(sizeof(struct fasd)/sizeof(object),aet_object);
array_allocself(result,1,Cnil);
{struct fasd *fd= (struct fasd *)result->v.v_self;
fd->table=tabl;
@@ -631,6 +615,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd
fd->index=make_fixnum(dump_index);
fd->filepos=current_fasd.filepos;
fd->package=current_fasd.package;
+ fd->table_length=current_fasd.table_length;
return result;
}}
@@ -642,7 +627,7 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa
if (type_of(fd->table)==t_vector)
/* input uses a vector */
{if (fd->table->v.v_self)
- gset(fd->table->v.v_self,0,fix(fd->index),aet_object);
+ fd->table->v.v_dim=0;/*self can be on the stack, and others write there*/
}
else
if(fd->direction==sKoutput)
@@ -1402,66 +1387,6 @@ clrhash(object table)
table->ht.ht_self[i].hte_value = OBJNULL;}
table->ht.ht_nent =0;}
-
-
-object read_fasl_vector1();
-object
-read_fasl_vector(object in)
-{char ch;
- object orig = in;
- object d;
- int tem;
- if (((tem=getc(((FILE *)in->sm.sm_fp))) == EOF) && feof(((FILE *)in->sm.sm_fp)))
- { char *pf;
- coerce_to_filename(in,FN1);
- for (pf=FN1+strlen(FN1);pf>FN1 && pf[-1]!='.';pf--);
- if (pf==FN1) {pf=FN1+strlen(FN1);*pf++='.';}
- snprintf(pf,sizeof(FN1)-(pf-FN1),"data");
- d=make_simple_string(FN1);
- in = open_stream(d,smm_input,Cnil,Cnil);
- if (in == Cnil)
- FEerror("Can't open file ~s",1,d);
- }
- else if (tem != EOF)
- { ungetc(tem,in->sm.sm_fp);}
- while (1)
- { ch=readc_stream(in);
- if (ch=='#')
- {unreadc_stream(ch,in);
- return read_fasl_vector1(in);}
- if (ch== d_begin_dump){
- unreadc_stream(ch,in);
- break;}}
- {object ar=FFN(fSopen_fasd)(in,sKinput,0,Cnil);
- int n=fix(current_fasd.table_length);
- object result,last;
- { BEGIN_NO_INTERRUPT;
-#ifdef HAVE_ALLOCA
- current_fasd.table->v.v_self
- = (object *)alloca(n*sizeof(object));
-#else
- current_fasd.table->v.v_self
- = (object *)alloc_relblock(n*sizeof(object));
-#endif
- current_fasd.table->v.v_dim=n;
- current_fasd.table->v.v_fillp=n;
- gset( current_fasd.table->v.v_self,0,n,aet_object);
- END_NO_INTERRUPT;
- }
- result=FFN(fSread_fasd_top)(ar);
- if (type_of(result) !=t_vector) goto ERROR;
- last=result->v.v_self[result->v.v_fillp-1];
- if(type_of(last)!=t_cons || last->c.c_car !=sSPinit)
- goto ERROR;
- current_fasd.table->v.v_self = 0;
- FFN(fSclose_fasd)(ar);
- if (orig != in)
- close_stream(in);
- return result;
- ERROR: FEerror("Bad fasd stream ~a",1,in);
- return Cnil;
-}}
-
object IfaslInStream;
/* static void */
/* IreadFasdData(void) */
--- gcl-2.6.12.orig/o/file.d
+++ gcl-2.6.12/o/file.d
@@ -1645,7 +1645,7 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st
for (;;) {
preserving_whitespace_flag = FALSE;
detect_eos_flag = TRUE;
- x = read_object_non_recursive(strm);
+ x = type_of(strm)==t_stream ? read_object_non_recursive(strm) : FFN(fSread_fasd_top)(strm);
if (x == OBJNULL)
break;
{
@@ -2371,75 +2371,3 @@ gcl_init_file_function()
gcl_init_readline_function();
#endif
}
-
-
-object
-read_fasl_data(const char *str) {
-
- object faslfile, data;
-#ifndef SEEK_TO_END_OFILE
-#if defined(BSD) && defined(UNIX)
- FILE *fp;
- int i;
-#ifdef HAVE_AOUT
- struct exec header;
-#endif
-#endif
-#ifdef HAVE_FILEHDR
- struct filehdr fileheader;
-#endif
-#ifdef E15
- struct exec header;
-#endif
-#endif
- vs_mark;
-
- faslfile = make_simple_string(str);
- vs_push(faslfile);
- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror);
- vs_push(faslfile);
-
-#ifdef SEEK_TO_END_OFILE
- SEEK_TO_END_OFILE(faslfile->sm.sm_fp);
-#else
-
-#ifdef BSD
- fp = faslfile->sm.sm_fp;
- fread(&header, sizeof(header), 1, fp);
- fseek(fp,
- header.a_text+header.a_data+
- header.a_syms+header.a_trsize+header.a_drsize,
- 1);
- fread(&i, sizeof(i), 1, fp);
- fseek(fp, i - sizeof(i), 1);
-#endif
-
-#ifdef HAVE_FILEHDR
- fp = faslfile->sm.sm_fp;
- fread(&fileheader, sizeof(fileheader), 1, fp);
- fseek(fp,
- fileheader.f_symptr+fileheader.f_nsyms*SYMESZ,
- 0);
- fread(&i, sizeof(i), 1, fp);
- fseek(fp, i - sizeof(i), 1);
- while ((i = getc(fp)) == 0)
- ;
- ungetc(i, fp);
-#endif
-
-#ifdef E15
- fp = faslfile->sm.sm_fp;
- fread(&header, sizeof(header), 1, fp);
- fseek(fp,
- header.a_text+header.a_data+
- header.a_syms+header.a_trsize+header.a_drsize,
- 1);
-#endif
-#endif
- data = read_fasl_vector(faslfile);
-
- vs_push(data);
- close_stream(faslfile);
- vs_reset;
- return(data);
-}
--- gcl-2.6.12.orig/o/gprof.c
+++ gcl-2.6.12/o/gprof.c
@@ -5,6 +5,10 @@
static unsigned long gprof_on;
+#ifdef DARWIN
+void _mcleanup() {}
+#endif
+
DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
extern void _mcleanup(void);
--- gcl-2.6.12.orig/o/read.d
+++ gcl-2.6.12/o/read.d
@@ -333,16 +333,16 @@ setup_READ()
backq_level = 0;
}
-static void
-setup_standard_READ()
-{
- READtable = standard_readtable;
- READdefault_float_format = 'F';
- READbase = 10;
- READsuppress = FALSE;
- sSAsharp_eq_contextA->s.s_dbind=Cnil;
- backq_level = 0;
-}
+/* static void */
+/* setup_standard_READ() */
+/* { */
+/* READtable = standard_readtable; */
+/* READdefault_float_format = 'F'; */
+/* READbase = 10; */
+/* READsuppress = FALSE; */
+/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */
+/* backq_level = 0; */
+/* } */
object
read_char(in)
@@ -1393,28 +1393,6 @@ FFN(siLsharp_comma_reader_for_compiler)(
vs_base[0] = make_cons(siSsharp_comma, vs_base[0]);
}
-/*
- For fasload.
-*/
-static void
-Lsharp_exclamation_reader()
-{
- check_arg(3);
- if(vs_base[2] != Cnil && !READsuppress)
- extra_argument('!');
- vs_popp;
- vs_popp;
- if (READsuppress) {
- vs_base[0] = Cnil;
- return;
- }
- vs_base[0] = read_object(vs_base[0]);
- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil)
- vs_base[0]=patch_sharp(vs_base[0]);
- ieval(vs_base[0]);
- vs_popp;
-}
-
static void
Lsharp_B_reader()
{
@@ -2327,8 +2305,6 @@ gcl_init_read()
dtab['*'] = make_cf(Lsharp_asterisk_reader);
dtab[':'] = make_cf(Lsharp_colon_reader);
dtab['.'] = make_cf(Lsharp_dot_reader);
- dtab['!'] = make_cf(Lsharp_exclamation_reader);
- /* Used for fasload only. */
dtab[','] = make_cf(Lsharp_comma_reader);
dtab['B'] = dtab['b'] = make_cf(Lsharp_B_reader);
dtab['O'] = dtab['o'] = make_cf(Lsharp_O_reader);
@@ -2441,96 +2417,96 @@ gcl_init_read_function()
object sSPinit;
-object
-read_fasl_vector1(in)
-object in;
-{
- int dimcount, dim;
- VOL object *vsp;
- object vspo;
- VOL object x;
- long i;
- bool e;
- object old_READtable;
- int old_READdefault_float_format;
- int old_READbase;
- int old_READsuppress;
- volatile object old_READcontext;
- int old_backq_level;
-
- /* to prevent longjmp clobber */
- i=(long)&vsp;
- i+=i;
- vsp=&vspo;
- old_READtable = READtable;
- old_READdefault_float_format = READdefault_float_format;
- old_READbase = READbase;
- old_READsuppress = READsuppress;
- old_READcontext=sSAsharp_eq_contextA->s.s_dbind;
- /* BUG FIX by Toshiba */
- vs_push(old_READtable);
- old_backq_level = backq_level;
-
- setup_standard_READ();
-
- frs_push(FRS_PROTECT, Cnil);
- if (nlj_active) {
- e = TRUE;
- goto L;
- }
-
- while (readc_stream(in) != '#')
- ;
- while (readc_stream(in) != '(')
- ;
- vsp = vs_top;
- dimcount = 0;
- for (;;) {
- sSAsharp_eq_contextA->s.s_dbind=Cnil;
- backq_level = 0;
- delimiting_char = code_char(')');
- preserving_whitespace_flag = FALSE;
- detect_eos_flag = FALSE;
- x = read_object(in);
- if (x == OBJNULL)
- break;
- vs_check_push(x);
- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil)
- x = vs_head = patch_sharp(x);
- dimcount++;
- }
- if(dimcount==1 && type_of(vs_head)==t_vector)
- {/* new style where all read at once */
- x=vs_head;
- goto DONE;}
- /* old style separately sharped, and no %init */
- {BEGIN_NO_INTERRUPT;
- x=alloc_simple_vector(dimcount,aet_object);
- vs_push(x);
- x->v.v_self
- = (object *)alloc_relblock(dimcount * sizeof(object));
- END_NO_INTERRUPT;}
- for (dim = 0; dim < dimcount; dim++)
- {SGC_TOUCH(x);
- x->cfd.cfd_self[dim] = vsp[dim];}
+/* object */
+/* read_fasl_vector1(in) */
+/* object in; */
+/* { */
+/* int dimcount, dim; */
+/* VOL object *vsp; */
+/* object vspo; */
+/* VOL object x; */
+/* long i; */
+/* bool e; */
+/* object old_READtable; */
+/* int old_READdefault_float_format; */
+/* int old_READbase; */
+/* int old_READsuppress; */
+/* volatile object old_READcontext; */
+/* int old_backq_level; */
+
+/* /\* to prevent longjmp clobber *\/ */
+/* i=(long)&vsp; */
+/* i+=i; */
+/* vsp=&vspo; */
+/* old_READtable = READtable; */
+/* old_READdefault_float_format = READdefault_float_format; */
+/* old_READbase = READbase; */
+/* old_READsuppress = READsuppress; */
+/* old_READcontext=sSAsharp_eq_contextA->s.s_dbind; */
+/* /\* BUG FIX by Toshiba *\/ */
+/* vs_push(old_READtable); */
+/* old_backq_level = backq_level; */
+
+/* setup_standard_READ(); */
+
+/* frs_push(FRS_PROTECT, Cnil); */
+/* if (nlj_active) { */
+/* e = TRUE; */
+/* goto L; */
+/* } */
+
+/* while (readc_stream(in) != '#') */
+/* ; */
+/* while (readc_stream(in) != '(') */
+/* ; */
+/* vsp = vs_top; */
+/* dimcount = 0; */
+/* for (;;) { */
+/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */
+/* backq_level = 0; */
+/* delimiting_char = code_char(')'); */
+/* preserving_whitespace_flag = FALSE; */
+/* detect_eos_flag = FALSE; */
+/* x = read_object(in); */
+/* if (x == OBJNULL) */
+/* break; */
+/* vs_check_push(x); */
+/* if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) */
+/* x = vs_head = patch_sharp(x); */
+/* dimcount++; */
+/* } */
+/* if(dimcount==1 && type_of(vs_head)==t_vector) */
+/* {/\* new style where all read at once *\/ */
+/* x=vs_head; */
+/* goto DONE;} */
+/* /\* old style separately sharped, and no %init *\/ */
+/* {BEGIN_NO_INTERRUPT; */
+/* x=alloc_simple_vector(dimcount,aet_object); */
+/* vs_push(x); */
+/* x->v.v_self */
+/* = (object *)alloc_relblock(dimcount * sizeof(object)); */
+/* END_NO_INTERRUPT;} */
+/* for (dim = 0; dim < dimcount; dim++) */
+/* {SGC_TOUCH(x); */
+/* x->cfd.cfd_self[dim] = vsp[dim];} */
- DONE:
- e = FALSE;
+/* DONE: */
+/* e = FALSE; */
-L:
- frs_pop();
+/* L: */
+/* frs_pop(); */
- READtable = old_READtable;
- READdefault_float_format = old_READdefault_float_format;
- READbase = old_READbase;
- READsuppress = old_READsuppress;
- sSAsharp_eq_contextA->s.s_dbind=old_READcontext;
- backq_level = old_backq_level;
- if (e) {
- nlj_active = FALSE;
- unwind(nlj_fr, nlj_tag);
- }
- vs_top = (object *)vsp;
- return(x);
-}
+/* READtable = old_READtable; */
+/* READdefault_float_format = old_READdefault_float_format; */
+/* READbase = old_READbase; */
+/* READsuppress = old_READsuppress; */
+/* sSAsharp_eq_contextA->s.s_dbind=old_READcontext; */
+/* backq_level = old_backq_level; */
+/* if (e) { */
+/* nlj_active = FALSE; */
+/* unwind(nlj_fr, nlj_tag); */
+/* } */
+/* vs_top = (object *)vsp; */
+/* return(x); */
+/* } */
--- gcl-2.6.12.orig/o/sfasl.c
+++ gcl-2.6.12/o/sfasl.c
@@ -80,619 +80,5 @@ DEFUN_NEW("FIND-SYM-PTABLE",object,fSfin
#ifdef SEPARATE_SFASL_FILE
#include SEPARATE_SFASL_FILE
#else
-
-#include "ext_sym.h"
-struct node * find_sym();
-int node_compare();
-#ifndef _WIN32
-void *malloc();
-void *bsearch();
-#endif
-
-struct reloc relocation_info;
-/* next 5 static after debug */
-
-int debug;
-
-#ifdef DEBUG
-#define debug sfasldebug
-int sfasldebug=0;
-#define dprintf(s,ar) if(debug) { printf(" ( s )",ar) ; fflush(stdout);}
-#define STAT
-
-#else /* end debug */
-#define dprintf(s,ar)
-#define STAT static
-#endif
-
-#ifndef MAXPATHLEN
-#define MAXPATHLEN 256
-#endif
-#define PTABLE_EXTRA 20
-
-struct sfasl_info {
- struct syment *s_symbol_table;
- char *s_start_address;
- char *s_start_data;
- char *s_start_bss;
- char *s_my_string_table;
- int s_extra_bss;
- char *s_the_start;
-
-};
-struct sfasl_info *sfaslp;
-
-#define symbol_table sfaslp->s_symbol_table
-#define start_address sfaslp->s_start_address
-#define my_string_table sfaslp->s_my_string_table
-#define extra_bss sfaslp->s_extra_bss
-#define the_start sfaslp->s_the_start
-
-
-#ifndef describe_sym
-#define describe_sym(a)
-#endif
-
-#ifdef STAND
-#include "rel_stand.c"
-#endif
-
-/* begin reloc_file */
-#include RELOC_FILE
-
-/* end reloc_file */
-int get_extra_bss ( struct syment *sym_table, int length, int start, int *ptr, int bsssize);
-void relocate_symbols ( unsigned int length );
-void set_symbol_address ( struct syment *sym, char *string );
-
-int
-fasload(faslfile)
-object faslfile;
-{ long fasl_vector_start;
- struct filehdr fileheader;
- struct sfasl_info sfasl_info_buf;
-#ifdef COFF
- struct scnhdr section[10];
- struct aouthdr header;
-#endif
- int textsize, datasize, bsssize,nsyms;
-#if defined ( READ_IN_STRING_TABLE ) || defined ( HPUX )
- int string_size=0;
-#endif
-
- object memory, data;
- FILE *fp;
- char filename[MAXPATHLEN];
- int i;
- int init_address=0;
-#ifndef STAND
- object *old_vs_base = vs_base;
- object *old_vs_top = vs_top;
-#endif
- sfaslp = &sfasl_info_buf;
-
- extra_bss=0;
-#ifdef STAND
- strcpy(filename,faslfile);
- fp=fopen(filename,"r");
-#else
- coerce_to_filename(faslfile, filename);
- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror);
- vs_push(faslfile);
- fp = faslfile->sm.sm_fp;
-#endif
-
- HEADER_SEEK(fp);
- if(!fread((char *)&fileheader, sizeof(struct filehdr), 1, fp))
- FEerror("Could not get the header",0,0);
- nsyms = NSYMS(fileheader);
-#ifdef COFF
-
-#ifdef AIX3
- setup_for_aix_load();
-#endif
-
- fread(&header,1,fileheader.f_opthdr,fp);
-
- fread(§ion[1],fileheader.f_nscns,sizeof (struct scnhdr),fp);
- textsize = section[TEXT_NSCN].s_size;
- datasize = section[DATA_NSCN].s_size;
- if (strcmp(section[BSS_NSCN].s_name, ".bss") == 0)
- bsssize=section[BSS_NSCN].s_size;
- else bsssize=section[BSS_NSCN].s_size = 0;
-#endif
-
-#ifdef BSD
- textsize=fileheader.a_text;
- datasize=fileheader.a_data;
- bsssize=fileheader.a_bss;
-#endif
- symbol_table =
- (struct syment *) OUR_ALLOCA(sizeof(struct syment)*
- (unsigned int)nsyms);
- fseek(fp,(int)( N_SYMOFF(fileheader)), 0);
- {
- for (i = 0; i < nsyms; i++)
- { fread((char *)&symbol_table[i], SYMESZ, 1, fp);
- dprintf( symbol table %d , i);
- if (debug) describe_sym(i);
- dprintf( at %d , &symbol_table[i]);
-#ifdef HPUX
- symbol_table[i].n_un.n_strx = string_size;
- dprintf(string_size %d, string_size);
- string_size += symbol_table[i].n_length + 1;
- fseek(fp,(int)symbol_table[i].n_length,1);
-#endif
- }
- }
-/*
-on MP386
-The sizeof(struct syment) = 20, while only SYMESZ =18. So we had to read
-one at a time.
-fread((char *)symbol_table, SYMESZ*fileheader.f_nsyms,1,fp);
-*/
-
-#ifdef READ_IN_STRING_TABLE
-
-my_string_table=READ_IN_STRING_TABLE(fp,string_size);
-
-#else
-#ifdef MUST_SEEK_TO_STROFF
- fseek(fp,N_STROFF(fileheader),0);
-#endif
- {int ii=0;
- if (!fread((char *)&ii,sizeof(int),1,fp))
- {FEerror("The string table of this file did not have any length",0,
- 0);}
- fseek(fp,-4,1);
- /* at present the string table is located just after the symbols */
- my_string_table=OUR_ALLOCA((unsigned int)ii);
- dprintf( string table leng = %d, ii);
-
- if(ii!=fread(my_string_table,1,ii,fp))
- FEerror("Could not read whole string table",0,0) ;
- }
-#endif
-#ifdef SEEK_TO_END_OFILE
-SEEK_TO_END_OFILE(fp);
-#else
- while ((i = getc(fp)) == 0)
- ;
- ungetc(i, fp);
-#endif
-
- fasl_vector_start=ftell(fp);
-
- if (!((c_table.ptable) && *(c_table.ptable)))
- build_symbol_table();
-
-/* figure out if there is more bss space needed */
- extra_bss=get_extra_bss(symbol_table,nsyms,datasize+textsize+bsssize,
- &init_address,bsssize);
-
-/* allocate some memory */
-#ifndef STAND
- {BEGIN_NO_INTERRUPT;
- memory=new_cfdata();
- memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss;
- vs_push(memory);
- the_start=start_address=
- memory->cfd.cfd_start=
- alloc_contblock(memory->cfd.cfd_size);
- sfaslp->s_start_data = start_address + textsize;
- sfaslp->s_start_bss = start_address + textsize + datasize;
- END_NO_INTERRUPT;
- }
-#else
- the_start = start_address
- = malloc ( datasize + textsize + bsssize + extra_bss );
- sfaslp->s_start_data = start_address + textsize;
- sfaslp->s_start_bss = start_address + textsize + datasize;
-#endif
-
- dprintf( code size %d , datasize+textsize+bsssize + extra_bss);
- if (fseek(fp,N_TXTOFF(fileheader) ,0) < 0)
- FEerror("file seek error",0,0);
- SAFE_FREAD(the_start, textsize + datasize, 1, fp);
- dprintf(read into memory text +data %d bytes, textsize + datasize);
-/* relocate the actual loaded text */
-
- dprintf( the_start %x, the_start);
-
- /* record which symbols are used */
-
-#ifdef SYM_USED
- {int j=0;
- for(j=1; j< BSS_NSCN ; j++)
- { dprintf( relocating section %d \n,j);
- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0);
- for(i=0; i < section[j].s_nreloc; i++)
- { struct syment *sym;
- fread(&relocation_info, RELSZ, 1, fp);
- sym = & symbol_table[relocation_info.r_symndx];
- if (TC_SYMBOL_P(sym))
- SYM_USED(sym) = 1;
- }}}
-#endif
-
-
- /* this looks up symbols in c.ptable and also adds new externals to
- that c.table */
- relocate_symbols(NSYMS(fileheader));
-
-#ifdef COFF
- {int j=0;
- for(j=1; j< BSS_NSCN ; j++)
- { dprintf( relocating section %d \n,j);
- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0);
-#ifdef ADJUST_RELOC_START
-ADJUST_RELOC_START(j)
-#endif
- for(i=0; i < section[j].s_nreloc; i++)
- /* RELSZ = sizeof(relocation_info) */
- {fread(&relocation_info, RELSZ, 1, fp);
- dprintf(relocating %d,i);
- relocate();};
- }};
-#endif
-#ifdef BSD
- fseek(fp,N_RELOFF(fileheader),0);
- {int nrel = (fileheader.a_trsize/sizeof(struct reloc));
- for (i=0; i < nrel; i++)
- {fread((char *)&relocation_info, sizeof(struct reloc),
- 1, fp);
- dprintf(relocating %d,i);
- relocate();
- }
- }
-#ifdef N_DRELOFF
- fseek (fp, N_DRELOFF(fileheader), 0);
-#endif
- {int nrel = (fileheader.a_drsize/sizeof(struct reloc));
- the_start += fileheader.a_text;
- for (i=0; i < nrel; i++)
-
- {fread((char *)&relocation_info, sizeof(struct reloc),
- 1, fp);
- dprintf(relocating %d,i);
- relocate();
- }
- }
-#endif
-
-/* end of relocation */
- dprintf( END OF RELOCATION \n,0);
- dprintf( invoking init function at %x, start_address)
- dprintf( textsize is %x,textsize);
- dprintf( datasize is %x,datasize);
-
-/* read in the fasl vector */
- fseek(fp,fasl_vector_start,0);
- if (feof(fp))
- {data=0;}
- else{
- data = read_fasl_vector(faslfile);
- vs_push(data);
-#ifdef COFF
- dprintf( read fasl now symbols %d , fileheader.f_nsyms);
-#endif
- }
- close_stream(faslfile);
-
-/*
- {
- int fd;
-
- fd = creat ("xsgcl.bits", 0777);
- write (fd, memory->cfd.cfd_start, textsize + datasize);
- close (fd);
-
- fd = open ("xsl2.bits", 0);
- read (fd, memory->cfd.cfd_start, memory->cfd.cfd_size);
- close (fd);
- }
-*/
-
-#ifndef STAND
- ALLOCA_FREE(my_string_table);
- ALLOCA_FREE(symbol_table);
-
-
-#ifdef CLEAR_CACHE
- CLEAR_CACHE;
-#endif
- call_init(init_address,memory,data,0);
-
- vs_base = old_vs_base;
- vs_top = old_vs_top;
- if(symbol_value(sLAload_verboseA)!=Cnil)
- printf("start address -T %x ", memory->cfd.cfd_start);
- return(memory->cfd.cfd_size);
-#endif
- {FILE *out;
- out=fopen("/tmp/sfasltest","w");
- fwrite((char *)&fileheader, sizeof(struct filehdr), 1, out);
- fwrite(start_address,sizeof(char),datasize+textsize,out);
- fclose(out);}
- printf("\n(start %x)\n",start_address);
-
-}
-
-int get_extra_bss(sym_table,length,start,ptr,bsssize)
- int length,bsssize;
- struct syment *sym_table;
- int *ptr; /* store init address offset here */
-{
- int result = start;
-
-#ifdef AIX3
- int next_bss = start - bsssize;
-#endif
-
- struct syment *end,*sym;
-
-#ifdef BSD
- char tem[SYMNMLEN +1];
-#endif
-
- end =sym_table + length;
- for(sym=sym_table; sym < end; sym++)
- {
-
-#ifdef FIND_INIT
- FIND_INIT
-#endif
-
-#ifdef AIX3
- /* we later go through the relocation entries making this 1
- for symbols used */
-#ifdef SYM_USED
- if(TC_SYMBOL_P(sym))
- {SYM_USED(sym) = 0;}
-#endif
-
- /* fix up the external refer to _ptrgl to be local ref */
- if (sym->n_scnum == 0 &&
- strcmp(sym->n_name,"_ptrgl")==0)
- {struct syment* s =
- get_symbol("._ptrgl",TEXT_NSCN,sym_table,length);
- if (s ==0) FEerror("bad glue",0,0);
- sym->n_value = next_bss ;
- ptrgl_offset = next_bss;
- ptrgl_text = s->n_value;
- next_bss += 0xc;
- sym->n_scnum = DATA_NSCN;
- ((union auxent *)(sym+1))->x_csect.x_scnlen = 0xc;
-
- }
-
- if(sym->n_scnum != BSS_NSCN) goto NEXT;
- if(SYM_EXTERNAL_P(sym))
- {int val=sym->n_value;
- struct node joe;
- if (val && c_table.ptable)
- {struct node *answ;
- answ= find_sym(sym,0);
- if(answ)
- {sym->n_value = answ->address ;
- sym->n_scnum = N_UNDEF;
- val= ((union auxent *)(sym+1))->x_csect.x_scnlen;
- result -= val;
- goto NEXT;
- }}
- }
- /* reallocate the bss space */
- if (sym->n_value == 0)
- {result += ((union auxent *)(sym+1))->x_csect.x_scnlen;}
- sym->n_value = next_bss;
- next_bss += ((union auxent *)(sym+1))->x_csect.x_scnlen;
- NEXT:
- ;
- /* end aix3 */
-#endif
-
-
-
-#ifdef BSD
- tem; /* ignored */
- if(SYM_EXTERNAL_P(sym) && SYM_UNDEF_P(sym))
-#endif
-#ifdef COFF
- if(0)
- /* what we really want is
- if (sym->n_scnum==0 && sym->n_sclass == C_EXT
- && !(bsearch(..in ptable for this symbol)))
- Since this won't allow loading in of a new external array
- char foo[10] not ok
- static foo[10] ok.
- for the moment we give undefined symbol warning..
- Should really go through the symbols, recording the external addr
- for ones found in ptable, and for the ones not in ptable
- set some flag, and add up the extra_bss required. Then
- when you have the new memory chunk in hand,
- you could make the pass setting the relative addresses.
- for the ones you flagged last time.
- */
-#endif
- /* external bss so not included in size of bss for file */
- {int val=sym->n_value;
- if (val && c_table.ptable
- && (0== find_sym(sym,0)))
- { sym->n_value=result;
- result += val;}}
-
- sym += NUM_AUX(sym);
-
- }
- return (result-start);
-}
-
-
-
-/* go through the symbol table changing the addresses of the symbols
-to reflect the current cfd_start */
-
-
-void
-relocate_symbols(length)
-unsigned int length;
-{struct syment *end,*sym;
- unsigned int typ;
- char *str;
- char tem[SYMNMLEN +1];
- tem[SYMNMLEN]=0;
- int n_value=(int)start_address;
-
- end =symbol_table + length;
- for(sym=symbol_table; sym < end; sym++) {
- typ=NTYPE(sym);
-#ifdef BSD
-#ifdef N_STAB
- if (N_STAB & sym->n_type) continue;/* skip: It is for dbx only */
-#endif
- typ=N_SECTION(sym);
-/* if(sym->n_type & N_EXT) should add the symbol name,
- so it would be accessible by future loads */
-#endif
- switch (typ) {
-#ifdef BSD
- case N_ABS : case N_TEXT: case N_DATA: case N_BSS:
-#endif
-#ifdef COFF
- case TEXT_NSCN : case DATA_NSCN: case BSS_NSCN :
-#ifdef _WIN32
- if (typ==DATA_NSCN)
- n_value = (int)sfaslp->s_start_data;
- if (typ==BSS_NSCN)
- n_value = (int)sfaslp->s_start_bss;
- if (typ==TEXT_NSCN)
- n_value = (int)start_address;
-#endif /* _WIN32 */
-#endif /* COFF */
- str=SYM_NAME(sym);
- dprintf( for sym %s ,str)
- dprintf( new value will be start %x, start_address);
-
-#ifdef AIX3
- if(N_SECTION(sym) == DATA_NSCN
- && NUM_AUX(sym)
- && allocate_toc(sym))
- break;
-#endif
- sym->n_value = n_value;
- break;
- case N_UNDEF:
- str=SYM_NAME(sym);
- dprintf( undef symbol %s ,str);
- dprintf( symbol diff %d , sym - symbol_table);
- describe_sym(sym-symbol_table);
- set_symbol_address(sym,str);
- describe_sym(sym-symbol_table);
- break;
- default:
-#ifdef COFF
- dprintf(am ignoring a scnum %d,(sym->n_scnum));
-#endif
- break;
- }
- sym += NUM_AUX(sym);
- }
-}
-
-/*
-STEPS:
-1) read in the symbol table from the file,
-2) go through the symbol table, relocating external entries.
-3) for i <=2 go thru the relocation information for this section
- relocating the text.
-4) done.
-*/
-
-struct node *
-find_sym(sym,name)
- struct syment *sym;
- char *name;
-{ char tem[SYMNMLEN +1];
- tem [SYMNMLEN] = 0;
- if (name==0) name = SYM_NAME(sym);
- return find_sym_ptable(name);}
-
-void
-set_symbol_address(sym,string)
-struct syment *sym;
-char *string;
-{struct node *answ;
- if (c_table.ptable)
- {
- dprintf(string %s, string);
- answ = find_sym(sym,string);
- dprintf(answ %d , (answ ? answ->address : -1));
- if(answ)
- {
-#ifdef COFF
-#ifdef _AIX370
- if (NTYPE(sym) == N_UNDEF)
- sym->n_value = answ->address;
- else
-#endif
- sym->n_value = answ->address -sym->n_value;
- /* for symbols in the local data,text and bss this gets added
- on when we add the current value */
-#endif
-#ifdef BSD
- /* the old value of sym->n_value is the length of the common area
- starting at this address */
- sym->n_value = answ->address;
-#endif
-#ifdef AIX3
- fix_undef_toc_address(answ,sym,string);
-#endif
-
-}
- else
- {
-/*
-#ifdef BSD
- {char *name;
- name=malloc(1+strlen(string));
- strcpy(name,string);
- sym->n_value = sym->n_value + (unsigned int) the_start;
- add_symbol(name,sym->n_value,NULL);
- }
-#endif
-*/
- fprintf(stdout,"undefined %s symbol",string)
- ;fflush(stdout);
-
- }}
-
- else{FEerror("symbol table not loaded",0,0);}}
-
-/* include the machine independent stuff */
-#include "sfasli.c"
-
-
-#ifdef DEBUG
-print_name(p)
- struct syment *p;
-{char tem[10],*name;
- name=SYM_NAME(p);
- name= (((p)->_n._n_n._n_zeroes == 0) ?
- &my_string_table[(p)->_n._n_n._n_offset] :
- ((p)->_n._n_name[SYMNMLEN -1] ?
- (strncpy(tem,(p)->_n._n_name,
- SYMNMLEN),
- (char *)tem) :
- (p)->_n._n_name ));
-
- printf("(name:|%s|)",name);
- printf("(sclass 0x%x)",p->n_sclass);
- printf("(external_p 0x%x)",SYM_EXTERNAL_P(p));
- printf("(n_type 0x%x)",p->n_type);
- printf("(n_value 0x%x)",p->n_value);
- printf("(numaux 0x%x)\n",NUM_AUX(p));
- fflush(stdout);
-}
-#endif
-
+#error must define SEPARATE_SFASL_FILE
#endif /* SEPARATE_SFASL_FILE */
--- gcl-2.6.12.orig/o/sfaslcoff.c
+++ gcl-2.6.12/o/sfaslcoff.c
@@ -443,7 +443,6 @@ fasload(object faslfile) {
fseek(fp,(void *)ste-st,0);
while ((i = getc(fp)) == 0);
ungetc(i, fp);
- data = read_fasl_vector(faslfile);
massert(!un_mmap(st,est));
@@ -451,7 +450,7 @@ fasload(object faslfile) {
CLEAR_CACHE;
#endif
- call_init(init_address,memory,data,0);
+ call_init(init_address,memory,faslfile);
if(symbol_value(sLAload_verboseA)!=Cnil)
printf("start address -T %p ", memory->cfd.cfd_start);
--- gcl-2.6.12.orig/o/sfaslelf.c
+++ gcl-2.6.12/o/sfaslelf.c
@@ -550,7 +550,7 @@ fasload(object faslfile) {
FILE *fp;
char *sn,*st1,*dst1;
ul init_address=0,end,gs=0,*got=&gs,*gote=got+1;
- object memory,data;
+ object memory;
Shdr *sec1,*sece;
Sym *sym1,*syme,*dsym1,*dsyme;
void *v1,*ve;
@@ -574,7 +574,6 @@ fasload(object faslfile) {
massert(!relocate_code(v1,sec1,sece,sym1,got,gote));
massert(!fseek(fp,end,SEEK_SET));
- data=feof(fp) ? 0 : read_fasl_vector(faslfile);
massert(!un_mmap(v1,ve));
@@ -587,7 +586,7 @@ fasload(object faslfile) {
#endif
init_address-=(ul)memory->cfd.cfd_start;
- call_init(init_address,memory,data,0);
+ call_init(init_address,memory,faslfile);
if(symbol_value(sLAload_verboseA)!=Cnil)
printf("start address -T %p ",memory->cfd.cfd_start);
--- gcl-2.6.12.orig/o/sfaslmacho.c
+++ gcl-2.6.12/o/sfaslmacho.c
@@ -421,7 +421,7 @@ load_self_symbols() {
for (a=c_table.ptable,sym=sym1;sym<syme;sym++) {
- if (sym->n_type & N_STAB || !(sym->n_type & N_EXT))
+ if ((sym->n_type & N_STAB) || !(sym->n_type & N_EXT))
continue;
a->address=sym->n_value;
@@ -435,10 +435,9 @@ load_self_symbols() {
c_table.length=a-c_table.ptable;
qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare);
- c_table.local_ptable=a;
- for (a=c_table.ptable,sym=sym1;sym<syme;sym++) {
+ for (c_table.local_ptable=a,sym=sym1;sym<syme;sym++) {
- if (sym->n_type & N_STAB || sym->n_type & N_EXT)
+ if ((sym->n_type & N_STAB) || sym->n_type & N_EXT)
continue;
a->address=sym->n_value;
@@ -536,7 +535,6 @@ int
fasload(object faslfile) {
FILE *fp;
- object data;
ul init_address=-1;
object memory;
void *v1,*ve,*p;
@@ -564,7 +562,6 @@ fasload(object faslfile) {
relocate_code(v1,sec1,sece,&p,io1,n1,got,gote,start);
fseek(fp,(void *)ste-v1,SEEK_SET);
- data = feof(fp) ? 0 : read_fasl_vector(faslfile);
massert(!clear_protect_memory(memory));
@@ -575,7 +572,7 @@ fasload(object faslfile) {
massert(!un_mmap(v1,ve));
init_address-=(ul)memory->cfd.cfd_start;
- call_init(init_address,memory,data,0);
+ call_init(init_address,memory,faslfile);
if(symbol_value(sLAload_verboseA)!=Cnil)
printf("start address -T %p ",memory->cfd.cfd_start);
--- gcl-2.6.12.orig/o/sfaslmacosx.c
+++ gcl-2.6.12/o/sfaslmacosx.c
@@ -228,8 +228,6 @@ int fasload (object faslfile)
sfasl_error ("error seeking to end of object file");
}
- data = read_fasl_vector (faslstream);
-
close_stream (faslstream);
memory=new_cfdata();
@@ -237,7 +235,7 @@ int fasload (object faslfile)
if (symbol_value (sLAload_verboseA) != Cnil)
printf (" start address (dynamic) %p ", fptr);
- call_init (0, memory, data, fptr);
+ call_init (0,memory,faslstream);
unlink (tmpfile);
--- gcl-2.6.12.orig/o/unixfasl.c
+++ gcl-2.6.12/o/unixfasl.c
@@ -78,197 +78,7 @@ Foundation, 675 Mass Ave, Cambridge, MA
#endif
#ifndef SFASL
-int
-fasload(faslfile)
-object faslfile;
-{
-
-#ifdef BSD
- struct exec header, newheader;
-#endif
-
-#ifdef ATT
- struct filehdr fileheader;
- struct scnhdr sectionheader;
- int textsize, datasize, bsssize;
- int textstart;
-#endif
-
-#ifdef E15
- struct exec header;
-#define textsize header.a_text
-#define datasize header.a_data
-#define bsssize header.a_bss
-#define textstart sizeof(header)
-#endif
-
- object memory, data, tempfile;
- FILE *fp;
- char filename[MAXPATHLEN];
- char tempfilename[32];
- char command[MAXPATHLEN * 2];
- int i;
- object *old_vs_base = vs_base;
- object *old_vs_top = vs_top;
-#ifdef IBMRT
-
-#endif
-
- coerce_to_filename(faslfile, filename);
-
- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror);
- vs_push(faslfile);
- fp = faslfile->sm.sm_fp;
- /* seek to beginning of the header */
-
- HEADER_SEEK(fp);
-
-#ifdef BSD
- fread(&header, sizeof(header), 1, fp);
-#endif
-#ifdef ATT
- fread(&fileheader, sizeof(fileheader), 1, fp);
-#ifdef S3000
- if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1);
-#endif
- fread(§ionheader, sizeof(sectionheader), 1, fp);
- textsize = sectionheader.s_size;
- textstart = sectionheader.s_scnptr;
- fread(§ionheader, sizeof(sectionheader), 1, fp);
- datasize = sectionheader.s_size;
- fread(§ionheader, sizeof(sectionheader), 1, fp);
- if (strcmp(sectionheader.s_name, ".bss") == 0)
- bsssize = sectionheader.s_size;
- else
- bsssize = 0;
-#endif
-#ifdef E15
- fread(&header, sizeof(header), 1, fp);
-#endif
-
- memory=new_cfdata();
- memory->cfd.cfd_size = textsize + datasize + bsssize;
- vs_push(memory);
- /* If the file is smaller than the space asked for, typically the file
- is an invalid object file */
- if (file_len(fp)*4 < memory->cfd.cfd_size)
- FEerror("Invalid object file stream: ~a",1,faslfile);
- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,
- memory->cfd.cfd_size,sizeof(double));
-
-#ifdef SEEK_TO_END_OFILE
-SEEK_TO_END_OFILE(fp);
-#else
-#ifdef BSD
- fseek(fp,
- header.a_text+header.a_data+
- header.a_syms+header.a_trsize+header.a_drsize,
- 1);
- fread(&i, sizeof(i), 1, fp);
- fseek(fp, i - sizeof(i), 1);
-#endif
-
-#ifdef ATT
- fseek(fp,
- fileheader.f_symptr + SYMESZ*fileheader.f_nsyms,
- 0);
- fread(&i, sizeof(i), 1, fp);
- fseek(fp, i - sizeof(i), 1);
- while ((i = getc(fp)) == 0)
- ;
- ungetc(i, fp);
-#endif
-
-#ifdef E15
- fseek(fp,
- header.a_text+header.a_data+
- header.a_syms+header.a_trsize+header.a_drsize,
- 1);
-#endif
-#endif
- data = read_fasl_vector(faslfile);
- vs_push(data);
- close_stream(faslfile);
-
- sprintf(tempfilename, "/tmp/fasltemp%d", getpid());
-
-AGAIN:
-
-#ifdef BSD
- LD_COMMAND(command,
- kcl_self,
- memory->cfd.cfd_start,
- filename,
- " ",
- tempfilename);
- if(symbol_value(sLAload_verboseA)!=Cnil)
- printf("start address -T %x ",memory->cfd.cfd_start);
-#endif
-#ifdef ATT
- coerce_to_filename(symbol_value(sSAsystem_directoryA),
- system_directory);
- sprintf(command,
- "%sild %s %d %s %s",
- system_directory,
- kcl_self,
- memory->cfd.cfd_start,
- filename,
- tempfilename);
-#endif
-#ifdef E15
- coerce_to_filename(symbol_value(sSAsystem_directoryA),
- system_directory);
- sprintf(command,
- "%sild %s %d %s %s",
- system_directory,
- kcl_self,
- memory->cfd.cfd_start,
- filename,
- tempfilename);
-#endif
-
- if (system(command) != 0)
- FEerror("The linkage editor failed.", 0);
-
- tempfile = make_simple_string(tempfilename);
- vs_push(tempfile);
- tempfile = open_stream(tempfile, smm_input, Cnil, sKerror);
- vs_push(tempfile);
- fp = tempfile->sm.sm_fp;
-
- HEADER_SEEK(fp);
-
-#ifdef BSD
- fread(&newheader, sizeof(header), 1, fp);
- if (newbsssize != bsssize) {
- insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size);
- bsssize = newbsssize;
- memory->cfd.cfd_start = NULL;
- memory->cfd.cfd_size = textsize + datasize + bsssize;
- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,memory->cfd.cfd_size,
- sizeof( double));
- close_stream(tempfile);
- unlink(tempfilename);
- goto AGAIN;
- }
-#endif
-
- if (fseek(fp, textstart, 0) < 0)
- error("file seek error");
-
- fread(memory->cfd.cfd_start, textsize + datasize, 1, fp);
-
- close_stream(tempfile);
-
- unlink(tempfilename);
-
- call_init(0,memory,data,0);
-
- vs_base = old_vs_base;
- vs_top = old_vs_top;
-
- return(memory->cfd.cfd_size);
-}
+#error must define SFASL
#endif /* ifndef SFASL */
#ifndef __svr4__