LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032237. :SYSTEM-TYPE :LOGICAL :VERSION 3. :TYPE "LISP" :NAME "DEFSYSMAC" :DIRECTORY ("REL3-SOURCE" "UCODE") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758898022. :AUTHOR "REL3" :LENGTH-IN-BYTES 3500. :LENGTH-IN-BLOCKS 4. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ;;; -*- Mode: Lisp; Base: 8; Package: SI -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(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;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.;;; This file contains the base version of the system definition;;; functions for use during system operation.  Special systems such;;; as the cold load generator and the microcode assembler may define;;; their own version of these functions to get similar but different;;; action.(DefMacro DefSysConst (symbol value &optional documentation)   `(progn 'compile   (DefConst ,symbol ,value ,documentation)   ,@(add-properties symbol '(system-constants))))(DefMacro DefSysVar (symbol value &optional documentation)  `(DefVar ,symbol ,value ,documentation))(DefMacro DefEnum (header properties enumeration-list)  (Let* ((name (If (atom header) header (Car header))) (init (If (or (atom header) (< (length header) 2))   0 (Eval (Second header)))) (delta (If (or (atom header) (< (length header) 3))    1  (Eval (Third header)))) (field (If (or (atom header) (< (length header) 4))    nil  (Eval (Fourth header)))) (field-width (If field (Ldb 0006 field)))         (name-list nil))    (Do ((enum enumeration-list (cdr enum)) (value init (+ value delta)) (*forms* nil))((null enum) `(Progn 'compile                 (DefConst ,name ',(Reverse name-list))                 ,@(reverse *forms*)                 ,@(add-properties name properties)                 ,name))      ;; check value      (If (and (not (null field)) (> (Haulong value) field-width))  (Ferror nil "Enumeration ~a exceeded maximum value ~d.//~d."  name value (1- (expt 2 field-width))))      ;; Add the next definition.      (Let ((item-name (If (Atom (Car enum)) (Car Enum) (Caar enum)))            (item-prop (If (Listp (Car enum)) (Cdar enum))))        (Push item-name name-list)        (Push `(DefConst ,item-name ,(If field (Dpb value field 0) value)) *forms*)        (If (Not (Null item-prop))            (Setq *forms*               (Append (Add-Properties item-name item-prop) *forms*))))))  )(DefMacro DefAlternate (symbol properties alternation-list)  (DO ((list alternation-list (cddr list))       (alternates (car alternation-list) (Cons (car list) alternates))       (*forms* nil))      ((null list)       `(Progn 'compile       (DefConst ,symbol ',(Reverse alternates))       ,@(Reverse *forms*)       ,@(add-properties symbol properties)))    (Push `(DefConst ,(Car list) ,(Cadr list)) *forms*)    )  );;; Returns a list of forms which when evaluated will add SYMBOL to the;;; lists represented by PROPERTIES.(Defun Add-Properties (symbol properties)  (If (not (null properties))      (Do ((property properties (Cdr property))           (*forms* nil))          ((Null property)           *forms*)        (Push `(Add-Property ',symbol ',(Car property)) *forms*)))  )(Defun Add-Property (symbol list)  (If (Not (boundp list))      (Set list nil))  (When (Not (zlc:memq symbol (Symbol-value list)))    (Push symbol (Symbol-value list))))fns;; soon (hopefully) gone too;;d (DEFMIC (*PLUS . M-+) 421 (NUM1 NUM2) T);;d (DEFMIC (*DIF . M--) 422 (NUM1 NUM2) T);;d (DEFMIC (*TIMES . M-*) 423 (NUM1 NUM2) T);;d (DEFMIC (*LOGAND . M-LOGAND) 425 (NUM1 NUM2) T);;d (DEFMIC (*LOGXOR . M-LOGXOR) 426 (NUM1 NUM2) T);;r (DEFMIC 1+ 325 (N) T);;r (DEFMIC 1- 326 (N) T);??(DEFMIC %MULTIPLY-FRACTIONS 611 (NUM1 NUM2) T);??(DEFMIC %DIVIDE-DOUBLE 612 (HIGH-DIVIDEND LOW-DIVIDEND DIVISOR) T);;d (DEFMIC %REMAINDER-DOUBLE 613 (HIGH-DIVIDEND LOW-DIVIDEND DIVISOR) T);;d (DEFMIC %24-BIT-PLUS 624 (NUM1 NUM2) T);;d (DEFMIC %24-BIT-DIFFERENCE 6