From c49410087905081cd1cad16928d2ce046e436305 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 5 Mar 1990 17:05:25 +0000 Subject: [PATCH] Moved source-transforms from funny functions => %primitive to here from ir2tran, mainly to reduce assumptions about how internal errors are done. Also moved syscall support here. --- compiler/old-rt/vm-tran.lisp | 50 +++++++++++++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/compiler/old-rt/vm-tran.lisp b/compiler/old-rt/vm-tran.lisp index 73afd5c20..33a2f4e49 100644 --- a/compiler/old-rt/vm-tran.lisp +++ b/compiler/old-rt/vm-tran.lisp @@ -7,7 +7,8 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; This file contains impelemtentation-dependent transforms. +;;; This file contains impelemtentation-dependent transforms, IR2 convert +;;; methods, etc. ;;; ;;; Written by Rob MacLachlan ;;; @@ -31,3 +32,50 @@ (def-source-transform char-int (x) `(truly-the char-int (%primitive make-fixnum ,x))) + + +;;;; Funny function implementations: + +;;; Convert these funny functions into a %Primitive use, letting %Primitive +;;; deal with evaluating the "Fixed" codegen-info arguments. +;;; +(def-source-transform %more-arg-context (&rest foo) + `(%primitive more-arg-context ,@foo)) +;;; +(def-source-transform %verify-argument-count (&rest foo) + `(%primitive verify-argument-count ,@foo)) + + +;;; Error funny functions: +;;; +;;; Mark these as as not returning by using TRULY-THE NIL. + +(def-source-transform %type-check-error (obj type) + `(truly-the nil (%primitive error2 clc::error-object-not-type ,obj ,type))) + +(def-source-transform %odd-keyword-arguments-error () + '(truly-the nil (%primitive error0 clc::error-odd-keyword-arguments))) + +(def-source-transform %unknown-keyword-argument-error (key) + `(truly-the nil (%primitive error1 clc::error-unknown-keyword-argument ,key))) + +(def-source-transform %argument-count-error (&rest foo) + `(truly-the nil (%primitive argument-count-error ,@foo))) + + +;;;; Syscall: + +(def-primitive-translator syscall (&rest args) `(%syscall ,@args)) +(defknown %syscall (&rest t) *) + +(defoptimizer (%syscall ir2-convert) ((&rest args) node block) + (let* ((refs (move-full-call-args node block)) + (cont (node-cont node)) + (res (continuation-result-tns + cont + (list *any-primitive-type* *any-primitive-type*)))) + (vop* syscall node block + (refs) + ((first res) (second res) nil) + (length args)) + (move-continuation-result node block res cont))) -- GitLab