From 0dc42ff488606130ed661870925ea0fa038eabd3 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Wed, 6 Jun 1990 14:52:33 +0000 Subject: [PATCH] COERCE-TO-FUNCTION => FAST-SAFE-COERCE-TO-FUNCTION. Added new type-checking COERCE-TO-FUNCTION. --- compiler/old-rt/type-vops.lisp | 30 +++++++++++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/compiler/old-rt/type-vops.lisp b/compiler/old-rt/type-vops.lisp index 55c37560b..85bb1ed14 100644 --- a/compiler/old-rt/type-vops.lisp +++ b/compiler/old-rt/type-vops.lisp @@ -234,7 +234,7 @@ simple-integer-vector-p? ;;; Since we test for a function rather than the unbound marker, this works on ;;; NIL. ;;; -(define-vop (coerce-to-function) +(define-vop (fast-safe-coerce-to-function) (:args (thing :scs (descriptor-reg) :target res)) (:results (res :scs (descriptor-reg))) @@ -257,3 +257,31 @@ simple-integer-vector-p? (test-simple-type res temp done-lab nil system:%function-type) (error-call clc::error-symbol-undefined thing-temp)))))) + +(define-vop (coerce-to-function) + (:args (thing :scs (descriptor-reg) + :target res)) + (:results (res :scs (descriptor-reg))) + (:node-var node) + (:temporary (:type random :scs (non-descriptor-reg)) temp) + (:temporary (:scs (descriptor-reg)) thing-temp) + (:generator 0 + (let ((not-fun-lab (gen-label)) + (done-lab (gen-label)) + (not-sym-lab (gen-label))) + (test-simple-type thing temp not-fun-lab t system:%function-type) + (unless (location= thing res) + (inst lr res thing)) + (emit-label done-lab) + + (unassemble + (assemble-elsewhere node + (emit-label not-fun-lab) + (test-simple-type thing temp not-sym-lab t system:%symbol-type) + (inst lr thing-temp thing) + (loadw res thing (/ clc::symbol-definition 4)) + (test-simple-type res temp done-lab nil system:%function-type) + (error-call clc::error-symbol-undefined thing-temp) + + (emit-label not-sym-lab) + (error-call clc::error-object-not-function-or-symbol thing)))))) -- GitLab