mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-14 21:32:49 -08:00
Further split cmpdefs.lsp into other files, including now a file for package definitions, a file for data types, a file for global variables, and a new package C-DATA that contains all those common structures.
This commit is contained in:
Juan Jose Garcia Ripoll
parent
2dad791a12
commit
509a7eae43
11 changed files with 703 additions and 524 deletions
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
||||
|
|
|
|||
|
|
@ -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* "<ecl/ecl-cmp.h>")
|
||||
|
||||
;;;
|
||||
;;; 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)
|
||||
|
|
|
|||
123
src/new-cmp/cmpform.lsp
Normal file
123
src/new-cmp/cmpform.lsp
Normal file
|
|
@ -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 "#<form ~A ~X>" (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)))
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
256
src/new-cmp/cmpglobals.lsp
Normal file
256
src/new-cmp/cmpglobals.lsp
Normal file
|
|
@ -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)
|
||||
55
src/new-cmp/cmppackage.lsp
Normal file
55
src/new-cmp/cmppackage.lsp
Normal file
|
|
@ -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"))
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
229
src/new-cmp/cmptypes.lsp
Normal file
229
src/new-cmp/cmptypes.lsp
Normal file
|
|
@ -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))
|
||||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue