Description: 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; (Closes: #802593). Author: Camm Maguire 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: , Bug: Bug-Debian: https://bugs.debian.org/ Bug-Ubuntu: https://launchpad.net/bugs/ Forwarded: Reviewed-By: 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;icfd.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;symn_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;symn_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__