cmp: remove global entries machinery

This is a dead code which is not used in the compiler. It was meant
for providing entry points from Common Lisp code to ECL functions
written in C, but it was replaced by more robust machinery.
This commit is contained in:
Daniel Kochmański 2019-11-28 15:57:43 +01:00
parent 01e49c845a
commit 05cc54a75e
2 changed files with 0 additions and 55 deletions

View file

@ -276,16 +276,6 @@ lines are inserted, but the order is preserved")
;;; | ( 'CLINES' string* )
;;; | ( 'LOAD-TIME-VALUE' vv )
;;; *global-entries* holds (... ( fname cfun return-types arg-type ) ...).
;;; FIXME: global-entries mechanism seems to be completely abandoned
;;; (always NIL). Either remove compiler code which uses it and remove
;;; variable itself or properly document it and use where
;;; applicable. -- jd 2019-05-07
(defvar *global-entries* nil)
(defvar *global-macros* nil)
(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
@ -320,7 +310,6 @@ be deleted if they have been opened with LoadLibrary.")
(*global-vars* nil)
(*global-funs* nil)
(*global-cfuns-array* nil)
(*global-entries* nil)
(*undefined-vars* nil)
(*top-level-forms* nil)
(*clines-string-list* '())

View file

@ -200,10 +200,6 @@
(wt-nl-h "#define VM " (data-permanent-storage-size))
(wt-nl-h "#define VMtemp " (data-temporary-storage-size)))))
;;; Global entries for directly called functions.
(dolist (x *global-entries*)
(apply 'wt-global-entry x))
(wt-nl-h "#define ECL_DEFINE_SETF_FUNCTIONS ")
(loop for (name setf-vv name-vv) in *setf-definitions*
do (wt-h #\\ #\Newline setf-vv "=ecl_setf_definition(" name-vv ",ECL_T);"))
@ -436,46 +432,6 @@
do (wt comma "CLV" i)
finally (wt ";"))))
(defun wt-global-entry (fname cfun arg-types return-type)
(when (and (symbolp fname) (si:get-sysprop fname 'NO-GLOBAL-ENTRY))
(return-from wt-global-entry nil))
(wt-comment-nl "global entry for the function ~a" fname)
(wt-nl "static cl_object L" cfun "(cl_narg narg")
(wt-nl-h "static cl_object L" cfun "(cl_narg")
(do ((vl arg-types (cdr vl))
(lcl (1+ *lcl*) (1+ lcl)))
((endp vl) (wt1 ")"))
(declare (fixnum lcl))
(wt1 ", cl_object ") (wt-lcl lcl)
(wt-h ", cl_object"))
(wt-h1 ");")
(wt-nl-open-brace)
(when (compiler-check-args)
(wt-nl "_ecl_check_narg(" (length arg-types) ");"))
(wt-nl "cl_env_copy->nvalues = 1;")
(wt-nl "return " (ecase return-type
(FIXNUM "ecl_make_fixnum")
(CHARACTER "CODE_CHAR")
(DOUBLE-FLOAT "ecl_make_double_float")
(SINGLE-FLOAT "ecl_make_single_float")
(LONG-FLOAT "ecl_make_long_float"))
"(LI" cfun "(")
(do ((types arg-types (cdr types))
(n 1 (1+ n)))
((endp types))
(declare (fixnum n))
(wt (case (car types)
(FIXNUM "fix")
(CHARACTER "ecl_char_code")
(DOUBLE-FLOAT "df")
(SINGLE-FLOAT "sf")
(LONG-FLOAT "ecl_long_float")
(otherwise "")) "(")
(wt-lcl n) (wt ")")
(unless (endp (cdr types)) (wt ",")))
(wt "));")
(wt-nl-close-many-braces 0))
(defun rep-type (type)
(case type
(FIXNUM "cl_fixnum ")