From 8cbb18c32429dba8eee5a48c8667f75897b57d69 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Wed, 25 Apr 1990 21:46:44 +0000 Subject: [PATCH] added foreign call vops. --- compiler/mips/subprim.lisp | 70 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 68 insertions(+), 2 deletions(-) diff --git a/compiler/mips/subprim.lisp b/compiler/mips/subprim.lisp index 7b94f18a7..99ad67a42 100644 --- a/compiler/mips/subprim.lisp +++ b/compiler/mips/subprim.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/subprim.lisp,v 1.5 1990/04/24 02:56:39 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/subprim.lisp,v 1.6 1990/04/25 21:46:44 wlott Exp $ ;;; ;;; Linkage information for standard static functions, and random vops. ;;; @@ -39,7 +39,7 @@ (emit-label loop) (inst beq ptr null-tn done) - (nop) + (inst nop) (simple-test-simple-type ptr temp not-list t vm:list-pointer-type) @@ -55,3 +55,69 @@ (define-static-function length (object) :translate length) + + + +;;;; Debugger support + +(define-vop (current-sp) + (:results (res :scs (sap-reg))) + (:generator 1 + (move res csp-tn))) + +(define-vop (read-control-stack sap-ref) + (:results (result :scs (descriptor-reg))) + (:variant :pointer nil)) + +(define-vop (write-control-stack sap-set) + (:arg-types system-area-pointer fixnum *) + (:results (result :scs (descriptor-reg))) + (:variant :pointer nil)) + + + + +;;;; Foreign function call interfaces. + +(define-vop (foreign-symbol-address) + (:info foreign-symbol) + (:result (res :scs (sap-reg))) + (:generator 2 + (inst li res (make-fixup foreign-symbol :foreign)))) + +(define-vop (call-out) + (:args (args :more t)) + (:ignore args) + (:save-p t) + (:info function) + (:results (result :scs (sap-reg signed-reg unsigned-reg))) + (:temporary (:sc any-reg :offset 2) v0) + (:temporary (:sc any-reg :offset lra-offset) lra) + (:temporary (:sc any-reg :offset code-offset) code) + (:temporary (:scs (any-reg) :type fixnum) temp) + (:generator 0 + (let ((lra-label (gen-label))) + (inst li v0 (make-fixup function :foreign)) + (inst li temp (make-fixup "call_into_c" :foreign)) + (inst j temp) + (inst compute-lra-from-code lra code lra-label) + (align vm:lowtag-bits) + (emit-label lra-label) + (inst lra-header-word) + (move result v0)))) + + +(define-vop (alloc-number-stack-space) + (:info amount) + (:translate %alloc-number-stack-space) + (:results (result :scs (sap-reg))) + (:generator 0 + (inst addu nsp-tn nsp-tn (- amount)) + (move result nsp-tn))) + +(define-vop (dealloc-number-stack-space) + (:info amount) + (:policy :fast-safe) + (:translate %dealloc-number-stack-space) + (:generator 0 + (inst addu nsp-tn nsp-tn amount))) -- GitLab