From 05cc54a75e50f80ac9397866ec00b021a6602033 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Thu, 28 Nov 2019 15:57:43 +0100 Subject: [PATCH] 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. --- src/cmp/cmpglobals.lsp | 11 ----------- src/cmp/cmptop.lsp | 44 ------------------------------------------ 2 files changed, 55 deletions(-) diff --git a/src/cmp/cmpglobals.lsp b/src/cmp/cmpglobals.lsp index ea5ad902b..7159b6a52 100644 --- a/src/cmp/cmpglobals.lsp +++ b/src/cmp/cmpglobals.lsp @@ -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* '()) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 7fc59df39..30389867d 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -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 ")