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