diff --git a/src/new-cmp/cmpc-ops.lsp b/src/new-cmp/cmpc-ops.lsp index 24926ab18..2944fc499 100644 --- a/src/new-cmp/cmpc-ops.lsp +++ b/src/new-cmp/cmpc-ops.lsp @@ -676,20 +676,7 @@ (defun c2emit-closure-scan (fun) (when (eq (fun-closure fun) 'CLOSURE) - (let ((clv-used (remove-if - #'(lambda (x) - (or - ;; non closure variable - (not (ref-ref-ccb x)) - ;; special variable - (eq (var-kind x) 'special) - ;; not actually referenced - (and (not (var-referenced-in-form x (fun-lambda fun))) - (not (var-changed-in-form x (fun-lambda fun)))) - ;; parameter of this closure - ;; (not yet bound, therefore var-loc is OBJECT) - (eq (var-loc x) 'OBJECT))) - (fun-referred-vars fun))) + (let ((clv-used (function-closure-variables fun)) l) (when clv-used (setf clv-used (sort clv-used #'> :key #'var-loc)) diff --git a/src/new-cmp/cmpc.lsp b/src/new-cmp/cmpc.lsp index ba029fc8c..7c19c1ef4 100644 --- a/src/new-cmp/cmpc.lsp +++ b/src/new-cmp/cmpc.lsp @@ -12,9 +12,5 @@ ;;;; CMPC -- Definitions common to the backend ;;;; -(defpackage "C-BACKEND" - (:use "FFI" "CL" #+threads "MP" "C") - (:export "CTOP-WRITE" "DUMP-ALL" "DATA-DUMP")) - (in-package "C-BACKEND") diff --git a/src/new-cmp/cmpdefs.lsp b/src/new-cmp/cmpdefs.lsp index d7552e1f1..c70984467 100644 --- a/src/new-cmp/cmpdefs.lsp +++ b/src/new-cmp/cmpdefs.lsp @@ -1,7 +1,6 @@ ;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*- ;;;; -;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. -;;;; Copyright (c) 1990, Giuseppe Attardi. +;;;; Copyright (c) 2009, Juan Jose Garcia-Ripoll ;;;; ;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Library General Public @@ -9,423 +8,20 @@ ;;;; version 2 of the License, or (at your option) any later version. ;;;; ;;;; See file '../Copyright' for full details. +;;;; +;;;; CMPDEFS -- Definitions created at compile / configuration time -;;;; CMPDEF Definitions - -(si::package-lock "CL" nil) - -(defpackage "C" - (:nicknames "COMPILER") - (:use "FFI" "CL" #+threads "MP") - (:export "*COMPILER-BREAK-ENABLE*" - "*COMPILE-PRINT*" - "*COMPILE-TO-LINKING-CALL*" - "*COMPILE-VERBOSE*" - "*CC*" - "*CC-OPTIMIZE*" - "BUILD-ECL" - "BUILD-PROGRAM" - "BUILD-FASL" - "BUILD-STATIC-LIBRARY" - "BUILD-SHARED-LIBRARY" - "COMPILER-WARNING" - "COMPILER-NOTE" - "COMPILER-MESSAGE" - "COMPILER-ERROR" - "COMPILER-FATAL-ERROR" - "COMPILER-INTERNAL-ERROR" - "COMPILER-UNDEFINED-VARIABLE" - "COMPILER-MESSAGE-FILE" - "COMPILER-MESSAGE-FILE-POSITION" - "COMPILER-MESSAGE-FORM" - "*SUPPRESS-COMPILER-WARNINGS*" - "*SUPPRESS-COMPILER-NOTES*" - "*SUPPRESS-COMPILER-MESSAGES*") - (:import-from "SI" "GET-SYSPROP" "PUT-SYSPROP" "REM-SYSPROP" "MACRO" - "*COMPILER-CONSTANTS*" "REGISTER-GLOBAL" "CMP-ENV-REGISTER-MACROLET" - "COMPILER-LET")) - -(in-package "COMPILER") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; COMPILER STRUCTURES -;;; - -;;; -;;; REF OBJECT -;;; -;;; Base object for functions, variables and statements. We use it to -;;; keep track of references to objects, how many times the object is -;;; referenced, by whom, and whether the references cross some closure -;;; boundaries. -;;; - -(defstruct (ref (:print-object print-ref)) - name ;;; Identifier of reference. - (ref 0 :type fixnum) ;;; Number of references. - ref-ccb ;;; Cross closure reference. - ;;; During Pass1, T or NIL. - ;;; During Pass2, the index into the closure env - ref-clb ;;; Cross local function reference. - ;;; During Pass1, T or NIL. - ;;; During Pass2, the lex-address for the - ;;; block id, or NIL. - read-nodes ;;; Nodes (c1forms) in which the reference occurs -) - -(deftype OBJECT () `(not (or fixnum character float))) - -(defstruct (var (:include ref) (:constructor %make-var) (:print-object print-var)) -; name ;;; Variable name. -; (ref 0 :type fixnum) - ;;; Number of references to the variable (-1 means IGNORE). -; ref-ccb ;;; Cross closure reference: T or NIL. -; ref-clb ;;; Cross local function reference: T or NIL. -; read-nodes ;;; Nodes (c1forms) in which the reference occurs - set-nodes ;;; Nodes in which the variable is modified - kind ;;; One of LEXICAL, CLOSURE, SPECIAL, GLOBAL, :OBJECT, :FIXNUM, - ;;; :CHAR, :DOUBLE, :FLOAT, REPLACED or DISCARDED - (function *current-function*) - ;;; For local variables, in which function it was created. - ;;; For global variables, it doesn't have a meaning. - (functions-setting nil) - (functions-reading nil) - ;;; Functions in which the variable has been modified or read. - (loc 'OBJECT) ;;; During Pass 1: indicates whether the variable can - ;;; be allocated on the c-stack: OBJECT means - ;;; the variable is declared as OBJECT, and CLB means - ;;; the variable is referenced across Level Boundary and thus - ;;; cannot be allocated on the C stack. Note that OBJECT is - ;;; set during variable binding and CLB is set when the - ;;; variable is used later, and therefore CLB may supersede - ;;; OBJECT. - ;;; During Pass 2: - ;;; For REPLACED: the actual location of the variable. - ;;; For :FIXNUM, :CHAR, :FLOAT, :DOUBLE, :OBJECT: - ;;; the cvar for the C variable that holds the value. - ;;; For LEXICAL or CLOSURE: the frame-relative address for - ;;; the variable in the form of a cons '(lex-levl . lex-ndx) - ;;; lex-levl is the level of lexical environment - ;;; lex-ndx is the index within the array for this env. - ;;; For SPECIAL and GLOBAL: the vv-index for variable name. - (type t) ;;; Type of the variable. - read-only-p ;;; T for variables that are assigned only once. - ) - -;;; A function may be compiled into a CFUN, CCLOSURE or CCLOSURE+LISP_CLOSURE -;;; Here are examples of function FOO for the 3 cases: -;;; 1. (flet ((foo () (bar))) (foo)) CFUN -;;; 2. (flet ((foo () (bar))) #'foo) CFUN+LISP_CFUN -;;; 3. (flet ((foo () x)) #'(lambda () (foo))) CCLOSURE -;;; 4. (flet ((foo () x)) #'foo) CCLOSURE+LISP_CLOSURE - -;;; A function can be referred across a ccb without being a closure, e.g: -;;; (flet ((foo () (bar))) #'(lambda () (foo))) -;;; [the lambda also need not be a closure] -;;; and it can be a closure without being referred across ccb, e.g.: -;;; (flet ((foo () x)) #'foo) [ is this a mistake in local-function-ref?] -;;; Here instead the lambda must be a closure, but no closure is needed for foo -;;; (flet ((foo () x)) #'(lambda () (foo))) -;;; So we use two separate fields: ref-ccb and closure. -;;; A CCLOSURE must be created for a function when: -;;; 1. it appears within a FUNCTION construct and -;;; 2. it uses some ccb references (directly or indirectly). -;;; ref-ccb corresponds to the first condition, i.e. function is referred -;;; across CCB. It is computed during Pass 1. A value of 'RETURNED means -;;; that it is immediately within FUNCTION. -;;; closure corresponds to second condition and is computed in Pass 2 by -;;; looking at the info-referred-vars and info-local-referred of its body. - -;;; A LISP_CFUN or LISP_CLOSURE must be created when the function is returned. -;;; The LISP funob may then be referred locally or across LB or CB: -;;; (flet ((foo (z) (bar z))) (list #'foo))) -;;; (flet ((foo (z) z)) (flet ((bar () #'foo)) (bar))) -;;; (flet ((foo (z) (bar z))) #'(lambda () #'foo))) -;;; therefore we need field funob. - -(defstruct (fun (:include ref)) -; name ;;; Function name. -; (ref 0 :type fixnum) ;;; Number of references. - ;;; During Pass1, T or NIL. - ;;; During Pass2, the vs-address for the - ;;; function closure, or NIL. -; ref-ccb ;;; Cross closure reference. - ;;; During Pass1, T or NIL, depending on whether a - ;;; function object will be built. - ;;; During Pass2, the vs-address for the function - ;;; closure, or NIL. -; ref-clb ;;; Unused. -; read-nodes ;;; Nodes (c1forms) in which the reference occurs - cfun ;;; The cfun for the function. - (last-lcl 0) ;;; Number of local variables (just to bookkeep names) - (last-label 0) ;;; Number of generated labels (same as last-lcl) - (level 0) ;;; Level of lexical nesting for a function. - (env 0) ;;; Size of env of closure. - (global nil) ;;; Global lisp function. - (exported nil) ;;; Its C name can be seen outside the module. - (no-entry nil) ;;; NIL if declared as C-LOCAL. Then we create no - ;;; function object and the C function is called - ;;; directly - (shares-with nil) ;;; T if this function shares the C code with another one. - ;;; In that case we need not emit this one. - closure ;;; During Pass2, T if env is used inside the function - var ;;; the variable holding the funob - description ;;; Text for the object, in case NAME == NIL. - lambda-list ;;; List of (requireds optionals rest-var keywords-p - ;;; keywords allow-other-keys-p) - (minarg 0) ;;; Min. number arguments that the function receives. - (maxarg call-arguments-limit) - ;;; Max. number arguments that the function receives. - lambda ;;; Lambda c1-form for this function. - doc ;;; Documentation - (parent *current-function*) - ;;; Parent function, NIL if global. - (local-vars nil) ;;; List of local variables created here. - (referred-vars nil) ;;; List of external variables referenced here. - (referred-funs nil) ;;; List of external functions called in this one. - ;;; We only register direct calls, not calls via object. - (child-funs nil) ;;; List of local functions defined here. - (debug 0) ;;; Debug quality - (file *compile-file-truename*) - ;;; Source file or NIL - (file-position *compile-file-position*) - ;;; Top-level form number in source file - code-gen-props ;;; Extra properties for code generation - ) - -(defstruct (blk (:include ref)) -; name ;;; Block name. -; (ref 0 :type fixnum) ;;; Number of references. -; ref-ccb ;;; Cross closure reference. - ;;; During Pass1, T or NIL. - ;;; During Pass2, the ccb-lex for the - ;;; block id, or NIL. -; ref-clb ;;; Cross local function reference. - ;;; During Pass1, T or NIL. - ;;; During Pass2, the lex-address for the - ;;; block id, or NIL. -; read-nodes ;;; Nodes (c1forms) in which the reference occurs - exit ;;; Where to return. A label. - destination ;;; Where the value of the block to go. - var ;;; Variable containing the block ID. - (type 'NIL) ;;; Estimated type. - env ;;; Block environment - ) - -(defstruct (tag (:include ref)) -; name ;;; Tag name. -; (ref 0 :type fixnum) ;;; Number of references. -; ref-ccb ;;; Cross closure reference. - ;;; During Pass1, T or NIL. -; ref-clb ;;; Cross local function reference. - ;;; During Pass1, T or NIL. -; read-nodes ;;; Nodes (c1forms) in which the reference occurs - label ;;; Where to jump: a label. - unwind-exit ;;; Where to unwind-no-exit. - var ;;; Variable containing frame ID. - index ;;; An integer denoting the label. - env ;;; Tag environment - ) - -(defstruct (info) - (local-vars nil) ;;; List of var-objects created directly in the form. - (type t) ;;; Type of the form. - (sp-change nil) ;;; Whether execution of the form may change - ;;; the value of a special variable. - (volatile nil) ;;; whether there is a possible setjmp. Beppe - ) - -(defstruct (inline-info) - name ;;; Function name - arg-rep-types ;;; List of representation types for the arguments - return-rep-type ;;; Representation type for the output - arg-types ;;; List of lisp types for the arguments - return-type ;;; Lisp type for the output - exact-return-type ;;; Only use this expansion when the output is - ;;; declared to have a subtype of RETURN-TYPE - expansion ;;; C template containing the expansion - one-liner ;;; Whether the expansion spans more than one line -) - -;;; -;;; VARIABLES -;;; - -;;; --cmpinline.lsp-- -;;; -;;; Empty info struct -;;; -(defvar *info* (make-info)) - -(defvar *inline-functions* nil) -(defvar *inline-blocks* 0) -;;; *inline-functions* holds: -;;; (...( function-name . inline-info )...) -;;; -;;; *inline-blocks* holds the number of C blocks opened for declaring -;;; temporaries for intermediate results of the evaluation of inlined -;;; function calls. - -;;; --cmputil.lsp-- -;;; -;;; Variables and constants for error handling -;;; -(defvar *current-toplevel-form* '|compiler preprocess|) -(defvar *current-form* '|compiler preprocess|) -(defvar *current-c2form* nil) -(defvar *compile-file-position* -1) -(defvar *first-error* t) -(defconstant *cmperr-tag* (cons nil nil)) - -(defvar *active-handlers* nil) -(defvar *active-protection* nil) -(defvar *pending-actions* nil) - -(defvar *compiler-conditions* '() - "This variable determines whether conditions are printed or just accumulated.") - -(defvar *compile-print* nil - "This variable controls whether the compiler displays messages about -each form it processes. The default value is NIL.") - -(defvar *compile-verbose* nil - "This variable controls whether the compiler should display messages about its -progress. The default value is T.") - -(defvar *suppress-compiler-messages* nil - "A type denoting which compiler messages and conditions are _not_ displayed.") - -(defvar *suppress-compiler-notes* nil) ; Deprecated -(defvar *suppress-compiler-warnings* nil) ; Deprecated - -(defvar *compiler-break-enable* nil) - -(defvar *compiler-in-use* nil) -(defvar *compiler-input*) -(defvar *compiler-output1*) -(defvar *compiler-output2*) - -;;; --cmpcbk.lsp-- -;;; -;;; List of callbacks to be generated -;;; -(defvar *callbacks* nil) - -;;; --cmpcall.lsp-- -;;; -;;; Whether to use linking calls. -;;; -(defvar *compile-to-linking-call* t) -(defvar *compiler-declared-globals*) - -;;; --cmpenv.lsp-- -;;; -;;; These default settings are equivalent to (optimize (speed 3) (space 0) (safety 2)) -;;; -(defvar *safety* 2) -(defvar *speed* 3) -(defvar *space* 0) -(defvar *debug* 0) - -;;; Emit automatic CHECK-TYPE forms for function arguments in lambda forms. -(defvar *automatic-check-type-in-lambda* t) - -;;; -;;; Compiled code uses the following kinds of variables: -;;; 1. Vi, declared explicitely, either unboxed or not (*lcl*, next-lcl) -;;; 2. Ti, declared collectively, of type object, may be reused (*temp*, next-temp) -;;; 4. lexi[j], for lexical variables in local functions -;;; 5. CLVi, for lexical variables in closures - -(defvar *lcl* 0) ; number of local variables - -(defvar *level* 0) ; nesting level for local functions - -(defvar *lex* 0) ; number of lexical variables in local functions -(defvar *max-lex* 0) ; maximum *lex* reached - -(defvar *env* 0) ; number of variables in current form -(defvar *max-env* 0) ; maximum *env* in whole function -(defvar *env-lvl* 0) ; number of levels of environments - -(defvar *next-cfun* 0) ; holds the last cfun used. - -;;; -;;; *tail-recursion-info* holds NIL, if tail recursion is impossible. -;;; If possible, *tail-recursion-info* holds -;; ( c1-lambda-form required-arg .... required-arg ), -;;; where each required-arg is a var-object. -;;; -(defvar *tail-recursion-info* nil) - -(defvar *allow-c-local-declaration* t) -(defvar *notinline* nil) - -;;; --cmpexit.lsp-- -;;; -;;; *last-label* holds the label# of the last used label. -;;; *exit* holds an 'exit', which is -;; ( label# . ref-flag ) or one of RETURNs (i.e. RETURN, RETURN-FIXNUM, -;; RETURN-CHARACTER, RETURN-DOUBLE-FLOAT, RETURN-SINGLE-FLOAT, or -;; RETURN-OBJECT). -;;; *unwind-exit* holds a list consisting of: -;; ( label# . ref-flag ), one of RETURNs, TAIL-RECURSION-MARK, FRAME, -;; JUMP, BDS-BIND (each pushed for a single special binding), or a -;; LCL (which holds the bind stack pointer used to unbind). -;;; -(defvar *last-label* 0) -(defvar *exit*) -(defvar *unwind-exit*) - -(defvar *current-function* nil) - -(defvar *cmp-env* (cons nil nil) -"The compiler environment consists of a pair or cons of two -lists, one containing variable records, the other one macro and -function recors: - -variable-record = (:block block-name) | - (:tag ({tag-name}*)) | - (:function function-name) | - (var-name {:special | nil} bound-p) | - (symbol si::symbol-macro macro-function) | - CB | LB | UNWIND-PROTECT -macro-record = (function-name function) | - (macro-name si::macro macro-function) - CB | LB | UNWIND-PROTECT - -A *-NAME is a symbol. A TAG-ID is either a symbol or a number. A -MACRO-FUNCTION is a function that provides us with the expansion -for that local macro or symbol macro. BOUND-P is true when the -variable has been bound by an enclosing form, while it is NIL if -the variable-record corresponds just to a special declaration. -CB, LB and UNWIND-PROTECT are only used by the C compiler and -they denote closure, lexical environment and unwind-protect -boundaries. Note that compared with the bytecodes compiler, these -records contain an additional variable, block, tag or function -object at the end.") - -;;; --cmplog.lsp-- -;;; -;;; Destination of output of different forms. See cmploc.lsp for types -;;; of destinations. -;;; -(defvar *destination*) - -;;; --cmpmain.lsp-- -;;; -;;; Do we debug the compiler? Then we need files not to be deleted. - -(defvar *debug-compiler* nil) -(defvar *delete-files* t) -(defvar *files-to-be-deleted* '()) +(in-package "C") ;;; This is copied into each .h file generated, EXCEPT for system-p calls. ;;; The constant string *include-string* is the content of file "ecl.h". ;;; Here we use just a placeholder: it will be replaced with sed. (defvar *cmpinclude* "") +;;; +;;; Compiler program and flags. +;;; + (defvar *cc* "@ECL_CC@" "This variable controls how the C compiler is invoked by ECL. The default value is \"cc -I. -I/usr/local/include/\". @@ -471,76 +67,3 @@ coprocessor).") (defvar *ecl-include-directory* @includedir\@) (defvar *ecl-library-directory* @libdir\@) - -;;; -;;; Compiler program and flags. -;;; - -;;; --cmptop.lsp-- -;;; -(defvar *do-type-propagation* nil - "Flag for switching on the type propagation phase. Use with care, experimental.") - -(defvar *compiler-phase* nil) - -(defvar *volatile*) - -(defvar *compile-toplevel* T - "Holds NIL or T depending on whether we are compiling a toplevel form.") -(defvar *compile-time-too* nil) - -(defvar *clines-string-list* '() - "List of strings containing C/C++ statements which are directly inserted -in the translated C/C++ file. Notice that it is unspecified where these -lines are inserted, but the order is preserved") - -(defvar *permanent-data* nil) ; detemines whether we use *permanent-objects* - ; or *temporary-objects* -(defvar *permanent-objects* nil) ; holds { ( object (VV vv-index) ) }* -(defvar *temporary-objects* nil) ; holds { ( object (VV vv-index) ) }* -(defvar *load-objects* nil) ; hash with association object -> vv-location -(defvar *load-time-values* nil) ; holds { ( vv-index form ) }*, -;;; where each vv-index should be given an object before -;;; defining the current function during loading process. - -(defvar *use-static-constants-p* nil) ; T/NIL flag to determine whether one may - ; generate lisp constant values as C structs - -(defvar *compiler-constants* nil) ; a vector with all constants - ; only used in COMPILE - -(defvar *proclaim-fixed-args* nil) ; proclaim automatically functions - ; with fixed number of arguments. - ; watch out for multiple values. - -(defvar *global-var-objects* nil) ; var objects for global/special vars -(defvar *global-vars* nil) ; variables declared special -(defvar *global-funs* nil) ; holds { fun }* -(defvar *global-cfuns-array* nil) ; holds { fun }* -(defvar *linking-calls* nil) ; holds { ( global-fun-name fun symbol c-fun-name var-name ) }* -(defvar *local-funs* nil) ; holds { fun }* -(defvar *top-level-forms* nil) ; holds { top-level-form }* -(defvar *make-forms* nil) ; holds { top-level-form }* - -;;; -;;; top-level-form: -;;; ( 'DEFUN' fun-name cfun lambda-expr doc-vv sp ) -;;; | ( 'DEFMACRO' macro-name cfun lambda-expr doc-vv sp ) -;;; | ( 'ORDINARY' expr ) -;;; | ( 'DECLARE' var-name-vv ) -;;; | ( 'DEFVAR' var-name-vv expr doc-vv ) -;;; | ( 'CLINES' string* ) -;;; | ( 'LOAD-TIME-VALUE' vv ) - -(defvar *reservation-cmacro* nil) - -;;; *reservations* holds (... ( cmacro . value ) ...). -;;; *reservation-cmacro* holds the cmacro current used as vs reservation. - -(defvar *self-destructing-fasl* '() -"A value T means that, when a FASL module is being unloaded (for -instance during garbage collection), the associated file will be -deleted. We need this for #'COMPILE because windows DLLs cannot -be deleted if they have been opened with LoadLibrary.") - -(defvar *undefined-vars* nil) diff --git a/src/new-cmp/cmpform.lsp b/src/new-cmp/cmpform.lsp new file mode 100644 index 000000000..f18bbfdee --- /dev/null +++ b/src/new-cmp/cmpform.lsp @@ -0,0 +1,123 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*- +;;;; +;;;; Copyright (c) 2009, Juan Jose Garcia-Ripoll +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Library General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2 of the License, or (at your option) any later version. +;;;; +;;;; See file '../Copyright' for full details. +;;;; +;;;; CMPFORM -- Internal representation of Lisp forms +;;;; + +(in-package "C-DATA") + +(defun print-c1form (form stream) + (format stream "#
" (c1form-name form) (ext::pointer form))) + +(defmacro make-c1form* (&rest args) + `(list (make-c1form-alone ,@args))) + +#+(or) +(defmacro make-c1form-alone (name &rest args) + (let ((info-args '()) + (form-args '())) + (do ((l args (cdr l))) + ((endp l)) + (let ((key (first l))) + (cond ((not (keywordp key)) + (baboon)) + ((eq key ':args) + (setf form-args (rest l)) + (return)) + (t + (setf info-args (list* key (second l) info-args) + l (cdr l)))))) + `(do-make-c1form :name ,name :args (list ,@form-args) + :form *current-form* + :file *compile-file-truename* + :file-position *compile-file-position* + ,@info-args))) + +(defun make-c1form-alone (name &rest args) + (let ((info-args '()) + (form-args '())) + (do ((l args (cdr l))) + ((endp l)) + (let ((key (first l))) + (cond ((not (keywordp key)) + (baboon)) + ((eq key ':args) + (setf form-args (rest l)) + (return)) + (t + (setf info-args (list* key (second l) info-args) + l (cdr l)))))) + (apply #'do-make-c1form :name name :args form-args + :form *current-form* + :file *compile-file-truename* + :file-position *compile-file-position* + info-args))) + +(defun copy-c1form (form) + (copy-structure form)) + +(defmacro c1form-arg (nth form) + (case nth + (0 `(first (c1form-args ,form))) + (1 `(second (c1form-args ,form))) + (otherwise `(nth ,nth (c1form-args ,form))))) + +(defun c1form-volatile* (form) + (if (c1form-volatile form) "volatile " "")) + +(defun get-output-c1form (form) + (cond ((null form) + (error "Empty form list")) + ((listp form) + (first (last form))) + (t + form))) + +(defun c1form-values-type (form) + (c1form-type (get-output-c1form form))) + +(defun (setf c1form-values-type) (type form) + (setf (c1form-type (get-output-c1form form)) type)) + +(defun c1form-primary-type (form) + (values-type-primary-type (c1form-values-type form))) + +(defun find-node-in-list (home-node list) + (flet ((parent-node-p (node presumed-child) + (loop + (cond ((null presumed-child) (return nil)) + ((eq node presumed-child) (return t)) + (t (setf presumed-child (c1form-parent presumed-child))))))) + (member home-node list :test #'parent-node-p))) + +(defun c1form-set-volatile (flag forms) + (loop for i in forms + do (setf (c1form-volatile i) flag)) + forms) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; OUTPUT C1FORMS +;;; + +(defun pprint-c1form (f &optional (stream t)) + (cond ((c1form-p f) + (format stream "~&~4T~16A~4T~{~A ~}" (c1form-name f) (c1form-args f))) + ((tag-p f) + (format stream "~&~A / ~A:" (tag-name f) (tag-label f))) + (t + (format stream "~&;;; Unknown form ~A" f))) + (force-output stream) + f) + +(defun pprint-c1forms (forms &optional (stream t)) + (loop for f in forms do (pprint-c1form f stream))) + diff --git a/src/new-cmp/cmpfun.lsp b/src/new-cmp/cmpfun.lsp index f927c766c..fc669d587 100644 --- a/src/new-cmp/cmpfun.lsp +++ b/src/new-cmp/cmpfun.lsp @@ -47,6 +47,21 @@ (defun function-can-be-evaluated-at-compile-time (fname) (get-sysprop fname 'pure)) +(defun function-closure-variables (fun) + (remove-if #'(lambda (x) + (or + ;; non closure variable + (not (ref-ref-ccb x)) + ;; special variable + (eq (var-kind x) 'special) + ;; not actually referenced + (and (not (var-referenced-in-form x (fun-lambda fun))) + (not (var-changed-in-form x (fun-lambda fun)))) + ;; parameter of this closure + ;; (not yet bound, therefore var-loc is OBJECT) + (eq (var-loc x) 'OBJECT))) + (fun-referred-vars fun))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; CERTAIN OPTIMIZERS diff --git a/src/new-cmp/cmpglobals.lsp b/src/new-cmp/cmpglobals.lsp new file mode 100644 index 000000000..8c0e91837 --- /dev/null +++ b/src/new-cmp/cmpglobals.lsp @@ -0,0 +1,256 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*- +;;;; +;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. +;;;; Copyright (c) 1990, Giuseppe Attardi. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Library General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2 of the License, or (at your option) any later version. +;;;; +;;;; See file '../Copyright' for full details. +;;;; +;;;; CMPVARS -- Global variables and flag definitions +;;;; + +(in-package "C-DATA") + +;;; +;;; VARIABLES +;;; + +;;; --cmpinline.lsp-- +;;; +;;; Empty info struct +;;; +(defvar *inline-functions* nil) +(defvar *inline-blocks* 0) +;;; *inline-functions* holds: +;;; (...( function-name . inline-info )...) +;;; +;;; *inline-blocks* holds the number of C blocks opened for declaring +;;; temporaries for intermediate results of the evaluation of inlined +;;; function calls. + +;;; --cmputil.lsp-- +;;; +;;; Variables and constants for error handling +;;; +(defvar *current-toplevel-form* '|compiler preprocess|) +(defvar *current-form* '|compiler preprocess|) +(defvar *current-c2form* nil) +(defvar *compile-file-position* -1) +(defvar *first-error* t) +(defconstant *cmperr-tag* (cons nil nil)) + +(defvar *active-handlers* nil) +(defvar *active-protection* nil) +(defvar *pending-actions* nil) + +(defvar *compiler-conditions* '() + "This variable determines whether conditions are printed or just accumulated.") + +(defvar *compile-print* nil + "This variable controls whether the compiler displays messages about +each form it processes. The default value is NIL.") + +(defvar *compile-verbose* nil + "This variable controls whether the compiler should display messages about its +progress. The default value is T.") + +(defvar *suppress-compiler-messages* nil + "A type denoting which compiler messages and conditions are _not_ displayed.") + +(defvar *suppress-compiler-notes* nil) ; Deprecated +(defvar *suppress-compiler-warnings* nil) ; Deprecated + +(defvar *compiler-break-enable* nil) + +(defvar *compiler-in-use* nil) +(defvar *compiler-input*) +(defvar *compiler-output1*) +(defvar *compiler-output2*) + +;;; --cmpcbk.lsp-- +;;; +;;; List of callbacks to be generated +;;; +(defvar *callbacks* nil) + +;;; --cmpcall.lsp-- +;;; +;;; Whether to use linking calls. +;;; +(defvar *compile-to-linking-call* t) +(defvar *compiler-declared-globals*) + +;;; --cmpenv.lsp-- +;;; +;;; These default settings are equivalent to (optimize (speed 3) (space 0) (safety 2)) +;;; +(defvar *safety* 2) +(defvar *speed* 3) +(defvar *space* 0) +(defvar *debug* 0) + +;;; Emit automatic CHECK-TYPE forms for function arguments in lambda forms. +(defvar *automatic-check-type-in-lambda* t) + +;;; +;;; Compiled code uses the following kinds of variables: +;;; 1. Vi, declared explicitely, either unboxed or not (*lcl*, next-lcl) +;;; 2. Ti, declared collectively, of type object, may be reused (*temp*, next-temp) +;;; 4. lexi[j], for lexical variables in local functions +;;; 5. CLVi, for lexical variables in closures + +(defvar *lcl* 0) ; number of local variables + +(defvar *level* 0) ; nesting level for local functions + +(defvar *lex* 0) ; number of lexical variables in local functions +(defvar *max-lex* 0) ; maximum *lex* reached + +(defvar *env* 0) ; number of variables in current form +(defvar *max-env* 0) ; maximum *env* in whole function +(defvar *env-lvl* 0) ; number of levels of environments + +(defvar *next-cfun* 0) ; holds the last cfun used. + +;;; +;;; *tail-recursion-info* holds NIL, if tail recursion is impossible. +;;; If possible, *tail-recursion-info* holds +;; ( c1-lambda-form required-arg .... required-arg ), +;;; where each required-arg is a var-object. +;;; +(defvar *tail-recursion-info* nil) + +(defvar *allow-c-local-declaration* t) +(defvar *notinline* nil) + +;;; --cmpexit.lsp-- +;;; +;;; *last-label* holds the label# of the last used label. +;;; *exit* holds an 'exit', which is +;; ( label# . ref-flag ) or one of RETURNs (i.e. RETURN, RETURN-FIXNUM, +;; RETURN-CHARACTER, RETURN-DOUBLE-FLOAT, RETURN-SINGLE-FLOAT, or +;; RETURN-OBJECT). +;;; *unwind-exit* holds a list consisting of: +;; ( label# . ref-flag ), one of RETURNs, TAIL-RECURSION-MARK, FRAME, +;; JUMP, BDS-BIND (each pushed for a single special binding), or a +;; LCL (which holds the bind stack pointer used to unbind). +;;; +(defvar *last-label* 0) +(defvar *exit*) +(defvar *unwind-exit*) + +(defvar *current-function* nil) + +(defvar *cmp-env* (cons nil nil) +"The compiler environment consists of a pair or cons of two +lists, one containing variable records, the other one macro and +function recors: + +variable-record = (:block block-name) | + (:tag ({tag-name}*)) | + (:function function-name) | + (var-name {:special | nil} bound-p) | + (symbol si::symbol-macro macro-function) | + CB | LB | UNWIND-PROTECT +macro-record = (function-name function) | + (macro-name si::macro macro-function) + CB | LB | UNWIND-PROTECT + +A *-NAME is a symbol. A TAG-ID is either a symbol or a number. A +MACRO-FUNCTION is a function that provides us with the expansion +for that local macro or symbol macro. BOUND-P is true when the +variable has been bound by an enclosing form, while it is NIL if +the variable-record corresponds just to a special declaration. +CB, LB and UNWIND-PROTECT are only used by the C compiler and +they denote closure, lexical environment and unwind-protect +boundaries. Note that compared with the bytecodes compiler, these +records contain an additional variable, block, tag or function +object at the end.") + +;;; --cmplog.lsp-- +;;; +;;; Destination of output of different forms. See cmploc.lsp for types +;;; of destinations. +;;; +(defvar *destination*) + +;;; --cmpmain.lsp-- +;;; +;;; Do we debug the compiler? Then we need files not to be deleted. + +(defvar *debug-compiler* nil) +(defvar *delete-files* t) +(defvar *files-to-be-deleted* '()) + +;;; --cmptop.lsp-- +;;; +(defvar *do-type-propagation* nil + "Flag for switching on the type propagation phase. Use with care, experimental.") + +(defvar *compiler-phase* nil) + +(defvar *volatile*) + +(defvar *compile-toplevel* T + "Holds NIL or T depending on whether we are compiling a toplevel form.") +(defvar *compile-time-too* nil) + +(defvar *clines-string-list* '() + "List of strings containing C/C++ statements which are directly inserted +in the translated C/C++ file. Notice that it is unspecified where these +lines are inserted, but the order is preserved") + +(defvar *permanent-data* nil) ; detemines whether we use *permanent-objects* + ; or *temporary-objects* +(defvar *permanent-objects* nil) ; holds { ( object (VV vv-index) ) }* +(defvar *temporary-objects* nil) ; holds { ( object (VV vv-index) ) }* +(defvar *load-objects* nil) ; hash with association object -> vv-location +(defvar *load-time-values* nil) ; holds { ( vv-index form ) }*, +;;; where each vv-index should be given an object before +;;; defining the current function during loading process. + +(defvar *use-static-constants-p* nil) ; T/NIL flag to determine whether one may + ; generate lisp constant values as C structs + +(defvar *compiler-constants* nil) ; a vector with all constants + ; only used in COMPILE + +(defvar *proclaim-fixed-args* nil) ; proclaim automatically functions + ; with fixed number of arguments. + ; watch out for multiple values. + +(defvar *global-var-objects* nil) ; var objects for global/special vars +(defvar *global-vars* nil) ; variables declared special +(defvar *global-funs* nil) ; holds { fun }* +(defvar *global-cfuns-array* nil) ; holds { fun }* +(defvar *linking-calls* nil) ; holds { ( global-fun-name fun symbol c-fun-name var-name ) }* +(defvar *local-funs* nil) ; holds { fun }* +(defvar *top-level-forms* nil) ; holds { top-level-form }* +(defvar *make-forms* nil) ; holds { top-level-form }* + +;;; +;;; top-level-form: +;;; ( 'DEFUN' fun-name cfun lambda-expr doc-vv sp ) +;;; | ( 'DEFMACRO' macro-name cfun lambda-expr doc-vv sp ) +;;; | ( 'ORDINARY' expr ) +;;; | ( 'DECLARE' var-name-vv ) +;;; | ( 'DEFVAR' var-name-vv expr doc-vv ) +;;; | ( 'CLINES' string* ) +;;; | ( 'LOAD-TIME-VALUE' vv ) + +(defvar *reservation-cmacro* nil) + +;;; *reservations* holds (... ( cmacro . value ) ...). +;;; *reservation-cmacro* holds the cmacro current used as vs reservation. + +(defvar *self-destructing-fasl* '() +"A value T means that, when a FASL module is being unloaded (for +instance during garbage collection), the associated file will be +deleted. We need this for #'COMPILE because windows DLLs cannot +be deleted if they have been opened with LoadLibrary.") + +(defvar *undefined-vars* nil) diff --git a/src/new-cmp/cmppackage.lsp b/src/new-cmp/cmppackage.lsp new file mode 100644 index 000000000..80e2a1561 --- /dev/null +++ b/src/new-cmp/cmppackage.lsp @@ -0,0 +1,55 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*- +;;;; +;;;; Copyright (c) 2009, Juan Jose Garcia-Ripoll +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Library General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2 of the License, or (at your option) any later version. +;;;; +;;;; See file '../Copyright' for full details. +;;;; +;;;; CMPPACKAGE -- Package definitions and exported symbols +;;;; + +(si::package-lock "CL" nil) + +(defpackage "C-DATA" + (:nicknames "COMPILER-DATA") + (:use "FFI" "CL" "C-DATA")) + +(defpackage "C-BACKEND" + (:use "FFI" "CL" "C-DATA") + (:export "CTOP-WRITE" "DUMP-ALL" "DATA-DUMP")) + +(defpackage "C" + (:nicknames "COMPILER") + (:use "FFI" "CL" #+threads "MP" "C-BACKEND" "C-DATA") + (:export "*COMPILER-BREAK-ENABLE*" + "*COMPILE-PRINT*" + "*COMPILE-TO-LINKING-CALL*" + "*COMPILE-VERBOSE*" + "*CC*" + "*CC-OPTIMIZE*" + "BUILD-ECL" + "BUILD-PROGRAM" + "BUILD-FASL" + "BUILD-STATIC-LIBRARY" + "BUILD-SHARED-LIBRARY" + "COMPILER-WARNING" + "COMPILER-NOTE" + "COMPILER-MESSAGE" + "COMPILER-ERROR" + "COMPILER-FATAL-ERROR" + "COMPILER-INTERNAL-ERROR" + "COMPILER-UNDEFINED-VARIABLE" + "COMPILER-MESSAGE-FILE" + "COMPILER-MESSAGE-FILE-POSITION" + "COMPILER-MESSAGE-FORM" + "*SUPPRESS-COMPILER-WARNINGS*" + "*SUPPRESS-COMPILER-NOTES*" + "*SUPPRESS-COMPILER-MESSAGES*") + (:import-from "SI" "GET-SYSPROP" "PUT-SYSPROP" "REM-SYSPROP" "MACRO" + "*COMPILER-CONSTANTS*" "REGISTER-GLOBAL" "CMP-ENV-REGISTER-MACROLET" + "COMPILER-LET")) + diff --git a/src/new-cmp/cmppass.lsp b/src/new-cmp/cmppass.lsp index 9c24669c6..f984a10ab 100644 --- a/src/new-cmp/cmppass.lsp +++ b/src/new-cmp/cmppass.lsp @@ -75,24 +75,6 @@ do (setf (fun-lambda f) (funcall pass f (fun-lambda f)) pending (append (fun-child-funs f) pending)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; OUTPUT C1FORMS -;;; - -(defun pprint-c1form (f &optional (stream t)) - (cond ((c1form-p f) - (format stream "~&~4T~16A~4T~{~A ~}" (c1form-name f) (c1form-args f))) - ((tag-p f) - (format stream "~&~A / ~A:" (tag-name f) (tag-label f))) - (t - (format stream "~&;;; Unknown form ~A" f))) - (force-output stream) - f) - -(defun pprint-c1forms (forms &optional (stream t)) - (loop for f in forms do (pprint-c1form f stream))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; DELETE UNUSED FORMS diff --git a/src/new-cmp/cmptables.lsp b/src/new-cmp/cmptables.lsp index 9e3669d7b..33b978fea 100644 --- a/src/new-cmp/cmptables.lsp +++ b/src/new-cmp/cmptables.lsp @@ -20,6 +20,8 @@ ;;; CONSTRUCTORS ;;; +(in-package "C-DATA") + (defun trace-function (f) #'(lambda (&rest args) (terpri) (princ #\>) (princ f) @@ -46,10 +48,17 @@ do (setf (gethash output k) v) finally (return output))) +(let ((p (find-package "C-DATA"))) + (do-symbols (s "C-DATA") + (when (eq (symbol-package s) p) + (export s)))) + ;;; ------------------------------------------------------------------ ;;; COMMON LISP FORMS TRANSLATORS ;;; +(in-package "C") + (defconstant +c1-dispatch-data+ '( ;; cmpblock.lsp diff --git a/src/new-cmp/cmptypes.lsp b/src/new-cmp/cmptypes.lsp new file mode 100644 index 000000000..f82807463 --- /dev/null +++ b/src/new-cmp/cmptypes.lsp @@ -0,0 +1,229 @@ +;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*- +;;;; +;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya. +;;;; Copyright (c) 1990, Giuseppe Attardi. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Library General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 2 of the License, or (at your option) any later version. +;;;; +;;;; See file '../Copyright' for full details. +;;;; +;;;; CMPTYPES -- Data types for the Lisp core structures +;;;; + +(in-package "C-DATA") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; COMPILER STRUCTURES +;;; + +;;; +;;; REF OBJECT +;;; +;;; Base object for functions, variables and statements. We use it to +;;; keep track of references to objects, how many times the object is +;;; referenced, by whom, and whether the references cross some closure +;;; boundaries. +;;; + +(defstruct (ref (:print-object print-ref)) + name ;;; Identifier of reference. + (ref 0 :type fixnum) ;;; Number of references. + ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the index into the closure env + ref-clb ;;; Cross local function reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the lex-address for the + ;;; block id, or NIL. + read-nodes ;;; Nodes (c1forms) in which the reference occurs +) + +(deftype OBJECT () `(not (or fixnum character float))) + +(defstruct (var (:include ref) (:constructor %make-var) (:print-object print-var)) +; name ;;; Variable name. +; (ref 0 :type fixnum) + ;;; Number of references to the variable (-1 means IGNORE). +; ref-ccb ;;; Cross closure reference: T or NIL. +; ref-clb ;;; Cross local function reference: T or NIL. +; read-nodes ;;; Nodes (c1forms) in which the reference occurs + set-nodes ;;; Nodes in which the variable is modified + kind ;;; One of LEXICAL, CLOSURE, SPECIAL, GLOBAL, :OBJECT, :FIXNUM, + ;;; :CHAR, :DOUBLE, :FLOAT, REPLACED or DISCARDED + (function *current-function*) + ;;; For local variables, in which function it was created. + ;;; For global variables, it doesn't have a meaning. + (functions-setting nil) + (functions-reading nil) + ;;; Functions in which the variable has been modified or read. + (loc 'OBJECT) ;;; During Pass 1: indicates whether the variable can + ;;; be allocated on the c-stack: OBJECT means + ;;; the variable is declared as OBJECT, and CLB means + ;;; the variable is referenced across Level Boundary and thus + ;;; cannot be allocated on the C stack. Note that OBJECT is + ;;; set during variable binding and CLB is set when the + ;;; variable is used later, and therefore CLB may supersede + ;;; OBJECT. + ;;; During Pass 2: + ;;; For REPLACED: the actual location of the variable. + ;;; For :FIXNUM, :CHAR, :FLOAT, :DOUBLE, :OBJECT: + ;;; the cvar for the C variable that holds the value. + ;;; For LEXICAL or CLOSURE: the frame-relative address for + ;;; the variable in the form of a cons '(lex-levl . lex-ndx) + ;;; lex-levl is the level of lexical environment + ;;; lex-ndx is the index within the array for this env. + ;;; For SPECIAL and GLOBAL: the vv-index for variable name. + (type t) ;;; Type of the variable. + read-only-p ;;; T for variables that are assigned only once. + ) + +;;; A function may be compiled into a CFUN, CCLOSURE or CCLOSURE+LISP_CLOSURE +;;; Here are examples of function FOO for the 3 cases: +;;; 1. (flet ((foo () (bar))) (foo)) CFUN +;;; 2. (flet ((foo () (bar))) #'foo) CFUN+LISP_CFUN +;;; 3. (flet ((foo () x)) #'(lambda () (foo))) CCLOSURE +;;; 4. (flet ((foo () x)) #'foo) CCLOSURE+LISP_CLOSURE + +;;; A function can be referred across a ccb without being a closure, e.g: +;;; (flet ((foo () (bar))) #'(lambda () (foo))) +;;; [the lambda also need not be a closure] +;;; and it can be a closure without being referred across ccb, e.g.: +;;; (flet ((foo () x)) #'foo) [ is this a mistake in local-function-ref?] +;;; Here instead the lambda must be a closure, but no closure is needed for foo +;;; (flet ((foo () x)) #'(lambda () (foo))) +;;; So we use two separate fields: ref-ccb and closure. +;;; A CCLOSURE must be created for a function when: +;;; 1. it appears within a FUNCTION construct and +;;; 2. it uses some ccb references (directly or indirectly). +;;; ref-ccb corresponds to the first condition, i.e. function is referred +;;; across CCB. It is computed during Pass 1. A value of 'RETURNED means +;;; that it is immediately within FUNCTION. +;;; closure corresponds to second condition and is computed in Pass 2 by +;;; looking at the info-referred-vars and info-local-referred of its body. + +;;; A LISP_CFUN or LISP_CLOSURE must be created when the function is returned. +;;; The LISP funob may then be referred locally or across LB or CB: +;;; (flet ((foo (z) (bar z))) (list #'foo))) +;;; (flet ((foo (z) z)) (flet ((bar () #'foo)) (bar))) +;;; (flet ((foo (z) (bar z))) #'(lambda () #'foo))) +;;; therefore we need field funob. + +(defstruct (fun (:include ref)) +; name ;;; Function name. +; (ref 0 :type fixnum) ;;; Number of references. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the vs-address for the + ;;; function closure, or NIL. +; ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL, depending on whether a + ;;; function object will be built. + ;;; During Pass2, the vs-address for the function + ;;; closure, or NIL. +; ref-clb ;;; Unused. +; read-nodes ;;; Nodes (c1forms) in which the reference occurs + cfun ;;; The cfun for the function. + (last-lcl 0) ;;; Number of local variables (just to bookkeep names) + (last-label 0) ;;; Number of generated labels (same as last-lcl) + (level 0) ;;; Level of lexical nesting for a function. + (env 0) ;;; Size of env of closure. + (global nil) ;;; Global lisp function. + (exported nil) ;;; Its C name can be seen outside the module. + (no-entry nil) ;;; NIL if declared as C-LOCAL. Then we create no + ;;; function object and the C function is called + ;;; directly + (shares-with nil) ;;; T if this function shares the C code with another one. + ;;; In that case we need not emit this one. + closure ;;; During Pass2, T if env is used inside the function + var ;;; the variable holding the funob + description ;;; Text for the object, in case NAME == NIL. + lambda-list ;;; List of (requireds optionals rest-var keywords-p + ;;; keywords allow-other-keys-p) + (minarg 0) ;;; Min. number arguments that the function receives. + (maxarg call-arguments-limit) + ;;; Max. number arguments that the function receives. + lambda ;;; Lambda c1-form for this function. + doc ;;; Documentation + (parent *current-function*) + ;;; Parent function, NIL if global. + (local-vars nil) ;;; List of local variables created here. + (referred-vars nil) ;;; List of external variables referenced here. + (referred-funs nil) ;;; List of external functions called in this one. + ;;; We only register direct calls, not calls via object. + (child-funs nil) ;;; List of local functions defined here. + (debug 0) ;;; Debug quality + (file *compile-file-truename*) + ;;; Source file or NIL + (file-position *compile-file-position*) + ;;; Top-level form number in source file + code-gen-props ;;; Extra properties for code generation + ) + +(defstruct (blk (:include ref)) +; name ;;; Block name. +; (ref 0 :type fixnum) ;;; Number of references. +; ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the ccb-lex for the + ;;; block id, or NIL. +; ref-clb ;;; Cross local function reference. + ;;; During Pass1, T or NIL. + ;;; During Pass2, the lex-address for the + ;;; block id, or NIL. +; read-nodes ;;; Nodes (c1forms) in which the reference occurs + exit ;;; Where to return. A label. + destination ;;; Where the value of the block to go. + var ;;; Variable containing the block ID. + (type 'NIL) ;;; Estimated type. + env ;;; Block environment + ) + +(defstruct (tag (:include ref)) +; name ;;; Tag name. +; (ref 0 :type fixnum) ;;; Number of references. +; ref-ccb ;;; Cross closure reference. + ;;; During Pass1, T or NIL. +; ref-clb ;;; Cross local function reference. + ;;; During Pass1, T or NIL. +; read-nodes ;;; Nodes (c1forms) in which the reference occurs + label ;;; Where to jump: a label. + unwind-exit ;;; Where to unwind-no-exit. + var ;;; Variable containing frame ID. + index ;;; An integer denoting the label. + env ;;; Tag environment + ) + +(defstruct (info) + (local-vars nil) ;;; List of var-objects created directly in the form. + (type t) ;;; Type of the form. + (sp-change nil) ;;; Whether execution of the form may change + ;;; the value of a special variable. + (volatile nil) ;;; whether there is a possible setjmp. Beppe + ) + +(defstruct (inline-info) + name ;;; Function name + arg-rep-types ;;; List of representation types for the arguments + return-rep-type ;;; Representation type for the output + arg-types ;;; List of lisp types for the arguments + return-type ;;; Lisp type for the output + exact-return-type ;;; Only use this expansion when the output is + ;;; declared to have a subtype of RETURN-TYPE + expansion ;;; C template containing the expansion + one-liner ;;; Whether the expansion spans more than one line +) + +(defstruct (c1form (:include info) + (:print-object print-c1form) + (:constructor do-make-c1form)) + (name nil) + (parent nil) + (args '()) + (env (cmp-env-copy)) + (form nil) + (toplevel-form) + (file nil) + (file-position 0)) diff --git a/src/new-cmp/load.lsp.in b/src/new-cmp/load.lsp.in index 78643cfb5..957c16601 100644 --- a/src/new-cmp/load.lsp.in +++ b/src/new-cmp/load.lsp.in @@ -1,7 +1,11 @@ ;;; @configure_input@ (defconstant +cmp-module-files+ -'("build:new-cmp;cmpdefs.lsp" +'("src:new-cmp;cmppackage.lsp" + "src:new-cmp;cmptypes.lsp" + "src:new-cmp;cmpglobals.lsp" + "build:new-cmp;cmpdefs.lsp" + "src:new-cmp;cmpform.lsp" "src:new-cmp;cmpmac.lsp" "src:new-cmp;cmputil.lsp" "src:new-cmp;cmptype.lsp" @@ -36,12 +40,12 @@ "src:new-cmp;cmparray.lsp" "src:new-cmp;cmppass.lsp" "src:new-cmp;cmpc.lsp" - "src:new-cmp;cmpc-data.lsp" "src:new-cmp;cmpc-wt.lsp" "src:new-cmp;cmpc-loc.lsp" "src:new-cmp;cmpc-set.lsp" "src:new-cmp;cmpc-ffi.lsp" "src:new-cmp;cmpc-inline.lsp" + "src:new-cmp;cmpc-data.lsp" "src:new-cmp;cmpc-ops.lsp" "src:new-cmp;cmpc-tables.lsp" "src:new-cmp;cmpc-top.lsp" @@ -49,5 +53,5 @@ (let ((si::*keep-documentation* nil)) (mapc #'(lambda (x) (load x :verbose nil)) +cmp-module-files+) - (load "src:new-cmp;sysfun" :verbose nil)) + (load "src:new-cmp;sysfun" :verbose t))