1;;; -*- *cold-load:t; 1Mode:Common-Lisp; Package:SYSTEM-INTERNALS; Fonts:(CPTFONT CPTFONTB); Base:10. -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ;;;* ;1;; Copyright (C) 1986-1989 Texas Instruments Incorporated. All rights reserved.* (DEFUN CATCH (tag "E &REST body) 1"Sets up and evaluates as a PROGN. Returns all values of the last form in unless some form executes a throw to in which case all values thrown are returned."* (CATCH tag (EVAL-BODY-AS-PROGN body))) (DEFCONSTANT NOCATCH (LIST NIL) 1"This is used as a catch tag when a conditional catch is not supposed to happen."*) ;Interpreter version of UNWIND-PROTECT ;(UNWIND-PROTECT risky-stuff forms-to-do-when-unwinding-this-frame...) ;If risky-stuff returns, we return what it returns, doing forms-to-do ;(just as PROG1 would do). If risky-stuff does a throw, we let the throw ;function as specified, but make sure that forms-to-do get done as well. (defun unwind-protect ("e body-form &rest cleanup-forms) 1"Execute and returns BODY-FORM, and on completion or nonlocal exit execute the CLEANUP-FORMS."* (UNWIND-PROTECT (*EVAL body-form) (DOLIST (form cleanup-forms) (*EVAL form)))) (DEFUN THROW (tag "e value-expression) 1"SYNTAX: (THROW tag exp) Transfers control to a matching CATCHER. First TAG is evaluated to produce a throw tag. Next EXP is evaluated and all of its values are saved. Lastly a search of the stack is made to find the innermost catcher for the evaluated tag and the saved values are returned as the value(s) of the catcher."* (THROW tag (*EVAL value-expression))) (DEFF ZLC:*THROW #'THROW) (DEFF ZLC:*CATCH #'CATCH)