X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fearly-alieneval.lisp;h=803d7f8bf6231ae22e6b986c50693c2e59ccf1be;hb=8c6e2e85859766d2c4c6a272b952de2ebe467487;hp=67478a548bdb4150a8afbbddeead67df8c494fd3;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/code/early-alieneval.lisp b/src/code/early-alieneval.lisp
index 67478a5..803d7f8 100644
--- a/src/code/early-alieneval.lisp
+++ b/src/code/early-alieneval.lisp
@@ -17,3 +17,44 @@
 ;;; used to keep from outputting the slots again if the same structure
 ;;; shows up twice.
 (defvar *record-types-already-unparsed*)
+
+;;; not documented in CMU CL:-(
+;;;
+;;; reverse engineering observations:
+;;;   * seems to be set when translating return values
+;;;   * seems to enable the translation of (VALUES), which is the
+;;;     Lisp idiom for C's return type "void" (which is likely
+;;;     why it's set when when translating return values)
+(defvar *values-type-okay* nil)
+
+(defvar *default-c-string-external-format* nil)
+
+;;; Frame pointer, program counter conses. In each thread it's bound
+;;; locally or not bound at all.
+(defvar *saved-fp-and-pcs*)
+
+#!+:c-stack-is-control-stack
+(declaim (inline invoke-with-saved-fp-and-pc))
+#!+:c-stack-is-control-stack
+(defun invoke-with-saved-fp-and-pc (fn)
+  (declare #-sb-xc-host (muffle-conditions compiler-note)
+           (optimize (speed 3)))
+  (let* ((fp-and-pc (cons (sb!kernel:%caller-frame)
+                          (sap-int (sb!kernel:%caller-pc)))))
+    (declare (truly-dynamic-extent fp-and-pc))
+    (let ((*saved-fp-and-pcs* (if (boundp '*saved-fp-and-pcs*)
+                                  (cons fp-and-pc *saved-fp-and-pcs*)
+                                  (list fp-and-pc))))
+      (declare (truly-dynamic-extent *saved-fp-and-pcs*))
+      (funcall fn))))
+
+(defun find-saved-fp-and-pc (fp)
+  (when (boundp '*saved-fp-and-pcs*)
+    (dolist (x *saved-fp-and-pcs*)
+      (when (#!+:stack-grows-downward-not-upward
+             sap>
+             #!-:stack-grows-downward-not-upward
+             sap<
+             (int-sap (sb!kernel:get-lisp-obj-address (car x))) fp)
+        (return (values (car x) (cdr x)))))))
+