From 4813e5285d518cb50714f48d73084d3ec8c6a86f Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Sat, 3 Feb 1990 19:33:02 +0000 Subject: [PATCH] Wrote ERROR-CALL and GENERATE-ERROR-CODE macros. --- compiler/mips/macros.lisp | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/compiler/mips/macros.lisp b/compiler/mips/macros.lisp index 8f9436dec..787523fef 100644 --- a/compiler/mips/macros.lisp +++ b/compiler/mips/macros.lisp @@ -7,6 +7,8 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/macros.lisp,v 1.2 1990/02/03 19:33:02 wlott Exp $ +;;; ;;; This file contains various useful macros for generating MIPS code. ;;; ;;; Written by William Lott. @@ -16,7 +18,6 @@ - (defmacro nop () "Emit a nop." '(inst or zero-tn zero-tn zero-tn)) @@ -81,3 +82,31 @@ (sc-case ,n-stack ((control-stack number-stack string-char-stack sap-stack) (storew ,n-reg cont-tn (tn-offset ,n-stack)))))))) + +;;; Error stuff. +;;; + +(defmacro error-call (error-code &rest values) + (once-only ((n-error-code error-code)) + `(progn + ,@(collect ((args)) + (do ((vals values (cdr vals)) + (regs register-argument-tns (cdr regs))) + ((or (null vals) (null regs)) + (if (null vals) + (args) + (error "Can't use ERROR-CALL with ~D values" + (length values)))) + (args `(move ,(car regs) ,(car vals))))) + (inst break ,error-code)))) + +(defmacro generate-error-code (node error-code &rest values) + "Generate-Error-Code Node Error-code Value* + Emit code for an error with the specified Error-Code and context Values. + Node is used for source context." + `(unassemble + (assemble-elsewhere ,node + (let ((start-lab (gen-label))) + (emit-label start-lab) + (error-call ,error-code ,@values) + start-lab)))) -- GitLab