;;; -*- Mode:LISP; Package:LISP-INTERNALS; Base:10; Readtable:CL -*- ;;; (warm-compile-and-load-file "dj:pfc;defmics") ;; accounted for all exported functions in k;cons.lisp ;; accounted for all functions in k;miscellaneous-functions.lisp ;; no functions from nuclear-control.lisp used ;; no functions from area-data.lisp used ;;; :who-calls-in-cold-load-system ;;; :exists-for-k (defvar *micro-code-functions* nil "List of cons of function symbols which are micro code and keywords about them.") (defmacro def-lambda-ucode-db-item (fun-symbol &rest keywords) `(progn (setq *micro-code-functions* (cl:remove ',fun-symbol *micro-code-functions* :test #'(lambda (x y) (eq x (car y))))) (push (cons ',fun-symbol ',keywords) *micro-code-functions*))) (defun uc-not-on-k? (fun) (let ((uc (cl:find fun *micro-code-functions* :key #'car :test #'eq))) (if uc (let ((uc (cl:find fun *micro-code-functions-on-k* :key #'car :test #'eq))) (if uc "micro-coded on lambda, coded for k" "**** micro-coded on lambda, not coded for k ****")) "not micro-coded on lambda"))) (defvar *micro-code-functions-on-k* '((ASSOC) (LISP-INTERNALS::MEMBER-EQUAL) (MEMBER) (LOWER-CASE-P) (CHAR-DOWNCASE) (CHAR-UPCASE) (BOTH-CASE-P) (COMPLEXP) (RATIONALP) (LISP-INTERNALS::MEMBER-EQL) (ALPHANUMERICP) (UPPER-CASE-P) (ALPHA-CHAR-P) (INT-CHAR) (CHAR-INT) (ENDP :EXISTS-FOR-K) (CHARACTERP) (SIMPLE-BIT-VECTOR-P) (BIT-VECTOR-P) (SIMPLE-STRING-P) (SIMPLE-VECTOR-P) (VECTORP) (ARRAY-DIMENSION) (ARRAY-RANK) (ARRAY-HAS-FILL-POINTER-P) (VECTOR-PUSH) (EQUALP) (ASET) (AREF) (ASH) (ELT) (EQ) (ABS) (SYMBOL-FUNCTION) (BOUNDP) (STRINGP) (FBOUNDP) (ARRAYP) (SYMBOLP) (LISTP) (ARRAY-TOTAL-SIZE) (EQL) (DEPOSIT-FIELD) (MASK-FIELD) (LIST*) (LIST) (NTHCDR) (NTH) (LISP-INTERNALS::BIND) (SYMBOL-VALUE) (CONS :EXISTS-FOR-K) (LISP-INTERNALS::%SXHASH-STRING) (MINUSP) (PLUSP) (NUMBERP) (SYMBOL-NAME) (EVENP) (ODDP) (ATOM) (PRIMITIVES::NULL :EXISTS-FOR-K) (PRIMITIVES::NOT :EXISTS-FOR-K) (EQUAL) (FLOATP) (INTEGERP) (SET) (ZEROP) (RPLACD :EXISTS-FOR-K) (RPLACA :EXISTS-FOR-K) (1-) (1+) (LENGTH) (LAST) (DPB) (LDB) (LISP-INTERNALS::%POINTER) (CDDDDR :EXISTS-FOR-K) (CDDDAR :EXISTS-FOR-K) (CDDADR :EXISTS-FOR-K) (CDDAAR :EXISTS-FOR-K) (CDADDR :EXISTS-FOR-K) (CDADAR :EXISTS-FOR-K) (CDAADR :EXISTS-FOR-K) (CDAAAR :EXISTS-FOR-K) (CADDDR :EXISTS-FOR-K) (CADDAR :EXISTS-FOR-K) (CADADR :EXISTS-FOR-K) (CADAAR :EXISTS-FOR-K) (CAADDR :EXISTS-FOR-K) (CAADAR :EXISTS-FOR-K) (CAAADR :EXISTS-FOR-K) (CAAAAR :EXISTS-FOR-K) (CDDDR :EXISTS-FOR-K) (CDDAR :EXISTS-FOR-K) (CDADR :EXISTS-FOR-K) (CDAAR :EXISTS-FOR-K) (CADDR :EXISTS-FOR-K) (CADAR :EXISTS-FOR-K) (CAADR :EXISTS-FOR-K) (CAAAR :EXISTS-FOR-K) (CDDR :EXISTS-FOR-K) (CDAR :EXISTS-FOR-K) (CADR :EXISTS-FOR-K) (CAAR :EXISTS-FOR-K) (CDR :EXISTS-FOR-K) (CAR :EXISTS-FOR-K) (bitblt :EXISTS-FOR-K) (*plus :EXISTS-FOR-K) (*times :EXISTS-FOR-K) (*dif :EXISTS-FOR-K) (*quo :EXISTS-FOR-K) (%div :EXISTS-FOR-K) (*logior :EXISTS-FOR-K) (*logand :EXISTS-FOR-K) (*logxor :EXISTS-FOR-K) (*min :EXISTS-FOR-K) (*max :EXISTS-FOR-K) (assq :EXISTS-FOR-K) (cons-in-area) (ncons) (ncons-in-area) (xcons) (xcons-in-area) )) (defun down-load () (setq *micro-code-functions* nil) (DEF-LAMBDA-UCODE-DB-ITEM CAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CAAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CADR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CAAAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CAADR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CADAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CADDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDAAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDADR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDDAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDDDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CAAAAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CAAADR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CAADAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CAADDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CADAAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CADADR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CADDAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CADDDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDAAAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDAADR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDADAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDADDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDDAAR :exists-for-k) ) (defun down-load1 () (DEF-LAMBDA-UCODE-DB-ITEM CDDADR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDDDAR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CDDDDR :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM %LOAD-FROM-HIGHER-CONTEXT) (DEF-LAMBDA-UCODE-DB-ITEM %LOCATE-IN-HIGHER-CONTEXT) (DEF-LAMBDA-UCODE-DB-ITEM %STORE-IN-HIGHER-CONTEXT) (DEF-LAMBDA-UCODE-DB-ITEM %DATA-TYPE) (DEF-LAMBDA-UCODE-DB-ITEM %POINTER) (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-REST-ARG-SAFE) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-FLOAT) (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-POINTER) ;; function make-pointer in cons.lisp use?? (DEF-LAMBDA-UCODE-DB-ITEM %SPREAD) (DEF-LAMBDA-UCODE-DB-ITEM %P-STORE-CONTENTS) ) (defun down-load2 () (DEF-LAMBDA-UCODE-DB-ITEM %LOGLDB) ;These don't complain about loading/clobbering (DEF-LAMBDA-UCODE-DB-ITEM %LOGDPB) ; sign bit. Result is always a fixnum (DEF-LAMBDA-UCODE-DB-ITEM LDB) (DEF-LAMBDA-UCODE-DB-ITEM DPB) (DEF-LAMBDA-UCODE-DB-ITEM %P-STORE-TAG-AND-POINTER) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-GET-2) (DEF-LAMBDA-UCODE-DB-ITEM GETL) (DEF-LAMBDA-UCODE-DB-ITEM ASSQ) (DEF-LAMBDA-UCODE-DB-ITEM LAST) (DEF-LAMBDA-UCODE-DB-ITEM LENGTH) (DEF-LAMBDA-UCODE-DB-ITEM 1+) (DEF-LAMBDA-UCODE-DB-ITEM 1-) (DEF-LAMBDA-UCODE-DB-ITEM RPLACA :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM RPLACD :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM ZEROP) ) (defun down-load3 () (DEF-LAMBDA-UCODE-DB-ITEM SET) (DEF-LAMBDA-UCODE-DB-ITEM INTEGERP) (DEF-LAMBDA-UCODE-DB-ITEM FIXP) (DEF-LAMBDA-UCODE-DB-ITEM FLOATP) (DEF-LAMBDA-UCODE-DB-ITEM EQUAL) (DEF-LAMBDA-UCODE-DB-ITEM %SET-SELF-MAPPING-TABLE) (DEF-LAMBDA-UCODE-DB-ITEM PDL-WORD) (DEF-LAMBDA-UCODE-DB-ITEM FALSE) (DEF-LAMBDA-UCODE-DB-ITEM TRUE) (DEF-LAMBDA-UCODE-DB-ITEM NOT :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM NULL :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM ATOM) (DEF-LAMBDA-UCODE-DB-ITEM ODDP) (DEF-LAMBDA-UCODE-DB-ITEM EVENP) (DEF-LAMBDA-UCODE-DB-ITEM %HALT) (DEF-LAMBDA-UCODE-DB-ITEM GET-PNAME) ) (defun down-load4 () (DEF-LAMBDA-UCODE-DB-ITEM SYMBOL-NAME) (DEF-LAMBDA-UCODE-DB-ITEM LSH) (DEF-LAMBDA-UCODE-DB-ITEM ROT) (DEF-LAMBDA-UCODE-DB-ITEM *BOOLE) (DEF-LAMBDA-UCODE-DB-ITEM NUMBERP) (DEF-LAMBDA-UCODE-DB-ITEM PLUSP) (DEF-LAMBDA-UCODE-DB-ITEM MINUSP) (DEF-LAMBDA-UCODE-DB-ITEM \\) (DEF-LAMBDA-UCODE-DB-ITEM MINUS) (DEF-LAMBDA-UCODE-DB-ITEM %SXHASH-STRING) (DEF-LAMBDA-UCODE-DB-ITEM VALUE-CELL-LOCATION) (DEF-LAMBDA-UCODE-DB-ITEM FUNCTION-CELL-LOCATION) (DEF-LAMBDA-UCODE-DB-ITEM PROPERTY-CELL-LOCATION) (DEF-LAMBDA-UCODE-DB-ITEM NCONS) (DEF-LAMBDA-UCODE-DB-ITEM NCONS-IN-AREA) (DEF-LAMBDA-UCODE-DB-ITEM CONS :exists-for-k) ) (defun down-load5 () (DEF-LAMBDA-UCODE-DB-ITEM CONS-IN-AREA :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM XCONS) (DEF-LAMBDA-UCODE-DB-ITEM XCONS-IN-AREA) (DEF-LAMBDA-UCODE-DB-ITEM %SPREAD-N) (DEF-LAMBDA-UCODE-DB-ITEM SYMEVAL) (DEF-LAMBDA-UCODE-DB-ITEM SYMBOL-VALUE) (DEF-LAMBDA-UCODE-DB-ITEM POP-M-FROM-UNDER-N) (DEF-LAMBDA-UCODE-DB-ITEM GET-LEXICAL-VALUE-CELL) (DEF-LAMBDA-UCODE-DB-ITEM %CALL-MULT-VALUE) (DEF-LAMBDA-UCODE-DB-ITEM %CALL0-MULT-VALUE) (DEF-LAMBDA-UCODE-DB-ITEM %RETURN-2) (DEF-LAMBDA-UCODE-DB-ITEM %RETURN-3) (DEF-LAMBDA-UCODE-DB-ITEM %RETURN-N) (DEF-LAMBDA-UCODE-DB-ITEM RETURN-NEXT-VALUE) (DEF-LAMBDA-UCODE-DB-ITEM RETURN-LIST) (DEF-LAMBDA-UCODE-DB-ITEM UNBIND-TO-INDEX-UNDER-N) ) (defun down-load6 () (DEF-LAMBDA-UCODE-DB-ITEM %BIND) (DEF-LAMBDA-UCODE-DB-ITEM BIND) (DEF-LAMBDA-UCODE-DB-ITEM %NWAY-BRANCH) (DEF-LAMBDA-UCODE-DB-ITEM MEMQ) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-<) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL->) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-=) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-CHAR-EQUAL) (DEF-LAMBDA-UCODE-DB-ITEM %STRING-SEARCH-CHAR) (DEF-LAMBDA-UCODE-DB-ITEM %STRING-EQUAL) (DEF-LAMBDA-UCODE-DB-ITEM NTH) (DEF-LAMBDA-UCODE-DB-ITEM NTHCDR) (DEF-LAMBDA-UCODE-DB-ITEM *PLUS) (DEF-LAMBDA-UCODE-DB-ITEM *DIF) (DEF-LAMBDA-UCODE-DB-ITEM *TIMES) (DEF-LAMBDA-UCODE-DB-ITEM *QUO) ) (defun down-load7 () (DEF-LAMBDA-UCODE-DB-ITEM *LOGAND) (DEF-LAMBDA-UCODE-DB-ITEM *LOGXOR) (DEF-LAMBDA-UCODE-DB-ITEM *LOGIOR) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-LEADER) (DEF-LAMBDA-UCODE-DB-ITEM STORE-ARRAY-LEADER) (DEF-LAMBDA-UCODE-DB-ITEM GET-LIST-POINTER-INTO-ARRAY) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-PUSH) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-APPLY) ;was APPLY with NO-QINTCMP (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-LIST) ; these next four have been moved to macrocode --- leave this in for now in case of some weird screw. Mly (DEF-LAMBDA-UCODE-DB-ITEM LIST) (DEF-LAMBDA-UCODE-DB-ITEM LIST*) ;(&REST ELEMENTS LAST) (DEF-LAMBDA-UCODE-DB-ITEM LIST-IN-AREA) (DEF-LAMBDA-UCODE-DB-ITEM LIST*-IN-AREA) ;(AREA &REST ELEMENTS LAST) (DEF-LAMBDA-UCODE-DB-ITEM LOCATE-IN-INSTANCE) (DEF-LAMBDA-UCODE-DB-ITEM %P-CDR-CODE) ) (defun down-load8 () (DEF-LAMBDA-UCODE-DB-ITEM %P-DATA-TYPE) (DEF-LAMBDA-UCODE-DB-ITEM %P-POINTER) (DEF-LAMBDA-UCODE-DB-ITEM %PAGE-TRACE) (DEF-LAMBDA-UCODE-DB-ITEM THROW-N) (DEF-LAMBDA-UCODE-DB-ITEM %P-STORE-CDR-CODE) (DEF-LAMBDA-UCODE-DB-ITEM %P-STORE-DATA-TYPE) (DEF-LAMBDA-UCODE-DB-ITEM %P-STORE-POINTER) (DEF-LAMBDA-UCODE-DB-ITEM FLOAT-EXPONENT) (DEF-LAMBDA-UCODE-DB-ITEM FLOAT-FRACTION) (DEF-LAMBDA-UCODE-DB-ITEM SCALE-FLOAT) (DEF-LAMBDA-UCODE-DB-ITEM %CATCH-OPEN) (DEF-LAMBDA-UCODE-DB-ITEM %CATCH-OPEN-MV) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-FLOOR-1) ;;; due to lossage, this INTERNAL-FLOOR-1 is pretty weird. ;;; does not store in its destination. Instead, destination field decodes: ;;; 0 => FLOOR, 1 => CEIL, 2 => TRUNC, 3 => ROUND ) (defun down-load9 () (DEF-LAMBDA-UCODE-DB-ITEM %DIV) (DEF-LAMBDA-UCODE-DB-ITEM %FEXPR-CALL) (DEF-LAMBDA-UCODE-DB-ITEM %FEXPR-CALL-MV) (DEF-LAMBDA-UCODE-DB-ITEM %FEXPR-CALL-MV-LIST) (DEF-LAMBDA-UCODE-DB-ITEM %CATCH-OPEN-MV-LIST) (DEF-LAMBDA-UCODE-DB-ITEM *CATCH) (DEF-LAMBDA-UCODE-DB-ITEM CATCH) (DEF-LAMBDA-UCODE-DB-ITEM %BLT) (DEF-LAMBDA-UCODE-DB-ITEM *THROW) (DEF-LAMBDA-UCODE-DB-ITEM THROW) (DEF-LAMBDA-UCODE-DB-ITEM %XBUS-WRITE-SYNC) (DEF-LAMBDA-UCODE-DB-ITEM %P-LDB) (DEF-LAMBDA-UCODE-DB-ITEM %P-DPB) (DEF-LAMBDA-UCODE-DB-ITEM MASK-FIELD) (DEF-LAMBDA-UCODE-DB-ITEM %P-MASK-FIELD) ) (defun down-load10 () (DEF-LAMBDA-UCODE-DB-ITEM DEPOSIT-FIELD) (DEF-LAMBDA-UCODE-DB-ITEM %P-DEPOSIT-FIELD) (DEF-LAMBDA-UCODE-DB-ITEM COPY-ARRAY-CONTENTS) (DEF-LAMBDA-UCODE-DB-ITEM COPY-ARRAY-CONTENTS-AND-LEADER) (DEF-LAMBDA-UCODE-DB-ITEM %FUNCTION-INSIDE-SELF) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-HAS-LEADER-P) (DEF-LAMBDA-UCODE-DB-ITEM COPY-ARRAY-PORTION) (DEF-LAMBDA-UCODE-DB-ITEM FIND-POSITION-IN-LIST) (DEF-LAMBDA-UCODE-DB-ITEM %GET-SELF-MAPPING-TABLE) (DEF-LAMBDA-UCODE-DB-ITEM G-L-P) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-FLOOR-2) ;;; takes two args on stack, two values also to stack. ;;; destination of this one also weird. See INTERNAL-FLOOR-1. (DEF-LAMBDA-UCODE-DB-ITEM EQL) (DEF-LAMBDA-UCODE-DB-ITEM AR-1) (DEF-LAMBDA-UCODE-DB-ITEM AR-2) ) (defun down-load11 () (DEF-LAMBDA-UCODE-DB-ITEM AR-3) (DEF-LAMBDA-UCODE-DB-ITEM AS-1) (DEF-LAMBDA-UCODE-DB-ITEM AS-2) (DEF-LAMBDA-UCODE-DB-ITEM AS-3) (DEF-LAMBDA-UCODE-DB-ITEM %INSTANCE-REF) (DEF-LAMBDA-UCODE-DB-ITEM %INSTANCE-LOC) (DEF-LAMBDA-UCODE-DB-ITEM %INSTANCE-SET) (DEF-LAMBDA-UCODE-DB-ITEM %BINDING-INSTANCES) (DEF-LAMBDA-UCODE-DB-ITEM %EXTERNAL-VALUE-CELL) (DEF-LAMBDA-UCODE-DB-ITEM %USING-BINDING-INSTANCES) (DEF-LAMBDA-UCODE-DB-ITEM %GC-CONS-WORK) (DEF-LAMBDA-UCODE-DB-ITEM %P-CONTENTS-OFFSET) ;function contents-offset in cons.lisp use??? (DEF-LAMBDA-UCODE-DB-ITEM %DISK-RESTORE) (DEF-LAMBDA-UCODE-DB-ITEM %DISK-SAVE) (DEF-LAMBDA-UCODE-DB-ITEM %ARGS-INFO) (DEF-LAMBDA-UCODE-DB-ITEM %OPEN-CALL-BLOCK) ) (defun down-load12 () (DEF-LAMBDA-UCODE-DB-ITEM %PUSH) (DEF-LAMBDA-UCODE-DB-ITEM %ACTIVATE-OPEN-CALL-BLOCK) (DEF-LAMBDA-UCODE-DB-ITEM %ASSURE-PDL-ROOM) (DEF-LAMBDA-UCODE-DB-ITEM STACK-GROUP-RETURN) (DEF-LAMBDA-UCODE-DB-ITEM AS-2-REVERSE) ;Perhaps the next one should be flushed. (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-STACK-LIST) (DEF-LAMBDA-UCODE-DB-ITEM STACK-GROUP-RESUME) (DEF-LAMBDA-UCODE-DB-ITEM %CALL-MULT-VALUE-LIST) (DEF-LAMBDA-UCODE-DB-ITEM %CALL0-MULT-VALUE-LIST) (DEF-LAMBDA-UCODE-DB-ITEM %GC-SCAV-RESET) (DEF-LAMBDA-UCODE-DB-ITEM %P-STORE-CONTENTS-OFFSET) (DEF-LAMBDA-UCODE-DB-ITEM %GC-FREE-REGION) (DEF-LAMBDA-UCODE-DB-ITEM %GC-FLIP) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-LENGTH) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-TOTAL-SIZE) ) (defun down-load13 () (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-ACTIVE-LENGTH) (DEF-LAMBDA-UCODE-DB-ITEM %COMPUTE-PAGE-HASH) (DEF-LAMBDA-UCODE-DB-ITEM THROW-SPREAD) (DEF-LAMBDA-UCODE-DB-ITEM %UNIBUS-READ) (DEF-LAMBDA-UCODE-DB-ITEM %UNIBUS-WRITE) (DEF-LAMBDA-UCODE-DB-ITEM %GC-SCAVENGE) (DEF-LAMBDA-UCODE-DB-ITEM %CHAOS-WAKEUP) (DEF-LAMBDA-UCODE-DB-ITEM %AREA-NUMBER) (DEF-LAMBDA-UCODE-DB-ITEM *MAX) (DEF-LAMBDA-UCODE-DB-ITEM *MIN) (DEF-LAMBDA-UCODE-DB-ITEM CLOSURE) (DEF-LAMBDA-UCODE-DB-ITEM AR-2-REVERSE) (DEF-LAMBDA-UCODE-DB-ITEM LISTP) (DEF-LAMBDA-UCODE-DB-ITEM NLISTP) (DEF-LAMBDA-UCODE-DB-ITEM SYMBOLP) (DEF-LAMBDA-UCODE-DB-ITEM NSYMBOLP) ) (defun down-load14 () (DEF-LAMBDA-UCODE-DB-ITEM ARRAYP) (DEF-LAMBDA-UCODE-DB-ITEM FBOUNDP) (DEF-LAMBDA-UCODE-DB-ITEM STRINGP) (DEF-LAMBDA-UCODE-DB-ITEM BOUNDP) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-\\) (DEF-LAMBDA-UCODE-DB-ITEM FSYMEVAL) (DEF-LAMBDA-UCODE-DB-ITEM SYMBOL-FUNCTION) (DEF-LAMBDA-UCODE-DB-ITEM AP-1) (DEF-LAMBDA-UCODE-DB-ITEM AP-2) (DEF-LAMBDA-UCODE-DB-ITEM AP-3) (DEF-LAMBDA-UCODE-DB-ITEM AP-LEADER) (DEF-LAMBDA-UCODE-DB-ITEM %P-LDB-OFFSET) (DEF-LAMBDA-UCODE-DB-ITEM %P-DPB-OFFSET) (DEF-LAMBDA-UCODE-DB-ITEM %P-MASK-FIELD-OFFSET) (DEF-LAMBDA-UCODE-DB-ITEM %P-DEPOSIT-FIELD-OFFSET) (DEF-LAMBDA-UCODE-DB-ITEM %MULTIPLY-FRACTIONS) ) (defun down-load15 () (DEF-LAMBDA-UCODE-DB-ITEM %DIVIDE-DOUBLE) (DEF-LAMBDA-UCODE-DB-ITEM %REMAINDER-DOUBLE) (DEF-LAMBDA-UCODE-DB-ITEM HAULONG) (DEF-LAMBDA-UCODE-DB-ITEM %BETTER-GC-SCAVENGE) (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-POINTER-OFFSET) (DEF-LAMBDA-UCODE-DB-ITEM ^) (DEF-LAMBDA-UCODE-DB-ITEM %CHANGE-PAGE-STATUS) (DEF-LAMBDA-UCODE-DB-ITEM %CREATE-PHYSICAL-PAGE) (DEF-LAMBDA-UCODE-DB-ITEM %DELETE-PHYSICAL-PAGE) (DEF-LAMBDA-UCODE-DB-ITEM %24-BIT-PLUS) (DEF-LAMBDA-UCODE-DB-ITEM %24-BIT-DIFFERENCE) (DEF-LAMBDA-UCODE-DB-ITEM %24-BIT-TIMES) (DEF-LAMBDA-UCODE-DB-ITEM ABS) (DEF-LAMBDA-UCODE-DB-ITEM %POINTER-DIFFERENCE) (DEF-LAMBDA-UCODE-DB-ITEM %P-CONTENTS-AS-LOCATIVE) ) (defun down-load16 () (DEF-LAMBDA-UCODE-DB-ITEM %P-CONTENTS-AS-LOCATIVE-OFFSET) (DEF-LAMBDA-UCODE-DB-ITEM EQ) (DEF-LAMBDA-UCODE-DB-ITEM %STORE-CONDITIONAL) (DEF-LAMBDA-UCODE-DB-ITEM %STACK-FRAME-POINTER) (DEF-LAMBDA-UCODE-DB-ITEM *UNWIND-STACK) (DEF-LAMBDA-UCODE-DB-ITEM %XBUS-READ) (DEF-LAMBDA-UCODE-DB-ITEM %XBUS-WRITE) (DEF-LAMBDA-UCODE-DB-ITEM ELT) (DEF-LAMBDA-UCODE-DB-ITEM MOVE-PDL-TOP) (DEF-LAMBDA-UCODE-DB-ITEM SHRINK-PDL-SAVE-TOP) (DEF-LAMBDA-UCODE-DB-ITEM SPECIAL-PDL-INDEX) (DEF-LAMBDA-UCODE-DB-ITEM UNBIND-TO-INDEX) (DEF-LAMBDA-UCODE-DB-ITEM UNBIND-TO-INDEX-MOVE) (DEF-LAMBDA-UCODE-DB-ITEM FIX) ;; Changed in 95 to exist only for old code. -- now use INTERNAL-FLOAT (DEF-LAMBDA-UCODE-DB-ITEM FLOAT) ) (defun down-load17 () (DEF-LAMBDA-UCODE-DB-ITEM SMALL-FLOAT) (DEF-LAMBDA-UCODE-DB-ITEM %FLOAT-DOUBLE) (DEF-LAMBDA-UCODE-DB-ITEM BIGNUM-TO-ARRAY) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-TO-BIGNUM) (DEF-LAMBDA-UCODE-DB-ITEM %UNWIND-PROTECT-CONTINUE) (DEF-LAMBDA-UCODE-DB-ITEM %WRITE-INTERNAL-PROCESSOR-MEMORIES) (DEF-LAMBDA-UCODE-DB-ITEM %PAGE-STATUS) (DEF-LAMBDA-UCODE-DB-ITEM %REGION-NUMBER) (DEF-LAMBDA-UCODE-DB-ITEM %FIND-STRUCTURE-HEADER) (DEF-LAMBDA-UCODE-DB-ITEM %STRUCTURE-BOXED-SIZE) (DEF-LAMBDA-UCODE-DB-ITEM %STRUCTURE-TOTAL-SIZE) (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-REGION) ;new incarnation, old thing had two args. (DEF-LAMBDA-UCODE-DB-ITEM BITBLT) (DEF-LAMBDA-UCODE-DB-ITEM %DISK-OP) (DEF-LAMBDA-UCODE-DB-ITEM %PHYSICAL-ADDRESS) (DEF-LAMBDA-UCODE-DB-ITEM POP-OPEN-CALL) ) (defun down-load18 () (DEF-LAMBDA-UCODE-DB-ITEM %BEEP) (DEF-LAMBDA-UCODE-DB-ITEM %FIND-STRUCTURE-LEADER) (DEF-LAMBDA-UCODE-DB-ITEM BPT) (DEF-LAMBDA-UCODE-DB-ITEM %FINDCORE) (DEF-LAMBDA-UCODE-DB-ITEM %PAGE-IN) (DEF-LAMBDA-UCODE-DB-ITEM ASH) (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-EXPLICIT-STACK-LIST) (DEF-LAMBDA-UCODE-DB-ITEM %DRAW-CHAR) (DEF-LAMBDA-UCODE-DB-ITEM %DRAW-RECTANGLE) (DEF-LAMBDA-UCODE-DB-ITEM %DRAW-LINE) (DEF-LAMBDA-UCODE-DB-ITEM %DRAW-TRIANGLE) (DEF-LAMBDA-UCODE-DB-ITEM %COLOR-TRANSFORM) (DEF-LAMBDA-UCODE-DB-ITEM %RECORD-EVENT) (DEF-LAMBDA-UCODE-DB-ITEM %AOS-TRIANGLE) (DEF-LAMBDA-UCODE-DB-ITEM %SET-MOUSE-SCREEN) (DEF-LAMBDA-UCODE-DB-ITEM %OPEN-MOUSE-CURSOR) ) (defun down-load19 () (DEF-LAMBDA-UCODE-DB-ITEM SETELT) (DEF-LAMBDA-UCODE-DB-ITEM %BLT-TYPED) (DEF-LAMBDA-UCODE-DB-ITEM %DRAW-PATTERNED-LINE) (DEF-LAMBDA-UCODE-DB-ITEM AR-1-FORCE) (DEF-LAMBDA-UCODE-DB-ITEM AS-1-FORCE) (DEF-LAMBDA-UCODE-DB-ITEM AP-1-FORCE) (DEF-LAMBDA-UCODE-DB-ITEM AREF) (DEF-LAMBDA-UCODE-DB-ITEM ASET) (DEF-LAMBDA-UCODE-DB-ITEM ALOC) (DEF-LAMBDA-UCODE-DB-ITEM EQUALP) (DEF-LAMBDA-UCODE-DB-ITEM %MAKE-EXPLICIT-STACK-LIST*) (DEF-LAMBDA-UCODE-DB-ITEM SETCAR) (DEF-LAMBDA-UCODE-DB-ITEM SETCDR) (DEF-LAMBDA-UCODE-DB-ITEM GET-LOCATION-OR-NIL) ) (defun down-load20 () (DEF-LAMBDA-UCODE-DB-ITEM %STRING-WIDTH) (DEF-LAMBDA-UCODE-DB-ITEM AR-1-CACHED-1) (DEF-LAMBDA-UCODE-DB-ITEM AR-1-CACHED-2) (DEF-LAMBDA-UCODE-DB-ITEM %MULTIBUS-READ-16) (DEF-LAMBDA-UCODE-DB-ITEM %MULTIBUS-WRITE-16) (DEF-LAMBDA-UCODE-DB-ITEM %MULTIBUS-READ-8) (DEF-LAMBDA-UCODE-DB-ITEM %MULTIBUS-WRITE-8) (DEF-LAMBDA-UCODE-DB-ITEM %MULTIBUS-READ-32) (DEF-LAMBDA-UCODE-DB-ITEM %MULTIBUS-WRITE-32) (DEF-LAMBDA-UCODE-DB-ITEM SET-AR-1) (DEF-LAMBDA-UCODE-DB-ITEM SET-AR-2) (DEF-LAMBDA-UCODE-DB-ITEM SET-AR-3) (DEF-LAMBDA-UCODE-DB-ITEM SET-AR-1-FORCE) (DEF-LAMBDA-UCODE-DB-ITEM SET-AREF) ) (defun down-load21 () (DEF-LAMBDA-UCODE-DB-ITEM SET-ARRAY-LEADER) (DEF-LAMBDA-UCODE-DB-ITEM SET-%INSTANCE-REF) (DEF-LAMBDA-UCODE-DB-ITEM VECTOR-PUSH) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-HAS-FILL-POINTER-P) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-LEADER-LENGTH) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-RANK) (DEF-LAMBDA-UCODE-DB-ITEM ARRAY-DIMENSION) (DEF-LAMBDA-UCODE-DB-ITEM RETURN-N-KEEP-CONTROL) (DEF-LAMBDA-UCODE-DB-ITEM RETURN-SPREAD-KEEP-CONTROL) (DEF-LAMBDA-UCODE-DB-ITEM COMMON-LISP-LISTP) (DEF-LAMBDA-UCODE-DB-ITEM %NUBUS-READ) ;SLOT is really the high 8 bits. ;the "top F" can be supplied via slot, avoiding bignums. (DEF-LAMBDA-UCODE-DB-ITEM %NUBUS-WRITE) ) (defun down-load22 () (DEF-LAMBDA-UCODE-DB-ITEM %MICROSECOND-TIME) ; Returns 32 bits maybe as a bignum (DEF-LAMBDA-UCODE-DB-ITEM %FIXNUM-MICROSECOND-TIME) (DEF-LAMBDA-UCODE-DB-ITEM %IO-SPACE-READ) ;32 bit read from HARDWARE-VIRTUAL-ADDRESS space. ;actual ucode is identical to that for %XBUS-READ on CADR. (DEF-LAMBDA-UCODE-DB-ITEM %IO-SPACE-WRITE) ;actual microcode is identical to %XBUS-WRITE ;on CADR. (DEF-LAMBDA-UCODE-DB-ITEM %NUBUS-PHYSICAL-ADDRESS) ;arg is "apparent" physical page number (gotten, for example, ;by shifting value from %PHYSICAL-ADDRESS). ;value is 22 bit NUBUS page number. (DEF-LAMBDA-UCODE-DB-ITEM VECTORP) (DEF-LAMBDA-UCODE-DB-ITEM SIMPLE-VECTOR-P) (DEF-LAMBDA-UCODE-DB-ITEM SIMPLE-ARRAY-P) (DEF-LAMBDA-UCODE-DB-ITEM SIMPLE-STRING-P) ) (defun down-load23 () (DEF-LAMBDA-UCODE-DB-ITEM BIT-VECTOR-P) (DEF-LAMBDA-UCODE-DB-ITEM SIMPLE-BIT-VECTOR-P) (DEF-LAMBDA-UCODE-DB-ITEM NAMED-STRUCTURE-P) (DEF-LAMBDA-UCODE-DB-ITEM NAMED-STRUCTURE-SYMBOL) (DEF-LAMBDA-UCODE-DB-ITEM TYPEP-STRUCTURE-OR-FLAVOR) (DEF-LAMBDA-UCODE-DB-ITEM FIXNUMP) (DEF-LAMBDA-UCODE-DB-ITEM SMALL-FLOATP) (DEF-LAMBDA-UCODE-DB-ITEM CHARACTERP) (DEF-LAMBDA-UCODE-DB-ITEM CAR-SAFE) (DEF-LAMBDA-UCODE-DB-ITEM CDR-SAFE) (DEF-LAMBDA-UCODE-DB-ITEM CADR-SAFE) (DEF-LAMBDA-UCODE-DB-ITEM CDDR-SAFE) (DEF-LAMBDA-UCODE-DB-ITEM CDDDDR-SAFE) (DEF-LAMBDA-UCODE-DB-ITEM NTHCDR-SAFE) (DEF-LAMBDA-UCODE-DB-ITEM NTH-SAFE) ) (defun down-load24 () (DEF-LAMBDA-UCODE-DB-ITEM CARCDR) (DEF-LAMBDA-UCODE-DB-ITEM ENDP :exists-for-k) (DEF-LAMBDA-UCODE-DB-ITEM CONSP-OR-POP) (DEF-LAMBDA-UCODE-DB-ITEM INDICATORS-VALUE) (DEF-LAMBDA-UCODE-DB-ITEM %POINTER-TIMES) (DEF-LAMBDA-UCODE-DB-ITEM COMMON-LISP-AREF) (DEF-LAMBDA-UCODE-DB-ITEM COMMON-LISP-AR-1) (DEF-LAMBDA-UCODE-DB-ITEM COMMON-LISP-AR-1-FORCE) (DEF-LAMBDA-UCODE-DB-ITEM INTERNAL-GET-3) (DEF-LAMBDA-UCODE-DB-ITEM CHAR-INT) (DEF-LAMBDA-UCODE-DB-ITEM INT-CHAR) (DEF-LAMBDA-UCODE-DB-ITEM ALPHA-CHAR-P) (DEF-LAMBDA-UCODE-DB-ITEM UPPER-CASE-P) (DEF-LAMBDA-UCODE-DB-ITEM ALPHANUMERICP) (DEF-LAMBDA-UCODE-DB-ITEM PACKAGE-CELL-LOCATION) ) (defun down-load25 () (DEF-LAMBDA-UCODE-DB-ITEM MEMBER-EQL) (DEF-LAMBDA-UCODE-DB-ITEM RATIONALP) (DEF-LAMBDA-UCODE-DB-ITEM RATIOP) (DEF-LAMBDA-UCODE-DB-ITEM COMPLEXP) (DEF-LAMBDA-UCODE-DB-ITEM %RATIO-CONS) (DEF-LAMBDA-UCODE-DB-ITEM %COMPLEX-CONS) (DEF-LAMBDA-UCODE-DB-ITEM BOTH-CASE-P) (DEF-LAMBDA-UCODE-DB-ITEM CHAR-UPCASE) (DEF-LAMBDA-UCODE-DB-ITEM CHAR-DOWNCASE) (DEF-LAMBDA-UCODE-DB-ITEM LOWER-CASE-P) (def-lambda-ucode-db-item %micro-paging) (def-lambda-ucode-db-item %processor-switches) (def-lambda-ucode-db-item %cold-boot) (def-lambda-ucode-db-item %test-multiply-return-low) ;these changed from sys 94 defs. ) (defun down-load26 () (def-lambda-ucode-db-item %test-multiply-return-high) (def-lambda-ucode-db-item %mult-16) (def-lambda-ucode-db-item %mult-32) (def-lambda-ucode-db-item %quart-transfer) ;; quart-flags bit0 0-> read, 1-> write. value is number blocks transferred (def-lambda-ucode-db-item %nubus-read-8) ;; SLOT is really the high 8 bits. The "top F" can be supplied via slot, avoiding bignums. (def-lambda-ucode-db-item %nubus-write-8) (def-lambda-ucode-db-item %lambda-rg-quad-slot) (def-lambda-ucode-db-item %lambda-tv-quad-slot) (def-lambda-ucode-db-item %lambda-sdu-quad-slot) (def-lambda-ucode-db-item %lambda-sys-conf-virtual-to-phys) (def-lambda-ucode-db-item %lambda-sys-conf-phys-to-virtual) ) (defun down-load27 () (def-lambda-ucode-db-item %lambda-sys-conf-virtual-adr) ;; Gets mouse button state directly out of a-memory. (def-lambda-ucode-db-item %lambda-mouse-buttons) (def-lambda-ucode-db-item member) (def-lambda-ucode-db-item member-equal) (def-lambda-ucode-db-item assoc) (def-lambda-ucode-db-item assoc-equal) ;; Don't bind %meter-micro-enables anymore... use this instead. (def-lambda-ucode-db-item %set-meter-enables) (def-lambda-ucode-db-item invalidate-cons-caches) (def-lambda-ucode-db-item %internal-list) ) (defun down-load28 () (def-lambda-ucode-db-item %internal-list*) (def-lambda-ucode-db-item %internal-list-in-area) (def-lambda-ucode-db-item %internal-list*-in-area) (def-lambda-ucode-db-item %internal-mapc) (def-lambda-ucode-db-item %internal-mapcar) (def-lambda-ucode-db-item %internal-append-2) (def-lambda-ucode-db-item %internal-nconc-2) ;; Fast FEFs bypass the old trap-on-next-call-within-this-stack-group mechanism. ;; Call this for BREAKON. (def-lambda-ucode-db-item %trap-on-next-call) (def-lambda-ucode-db-item %blt-boole) (def-lambda-ucode-db-item %findcore-hexadec) ;find core with specified 4 bits of physical page num (def-lambda-ucode-db-item %sxhash-substring) ) (defun down-load29 () (def-lambda-ucode-db-item %stat-counter) (def-lambda-ucode-db-item %internal-delq) (def-lambda-ucode-db-item %make-structure) (def-lambda-ucode-db-item %make-array) (def-lambda-ucode-db-item %pointer-info) ;leaves one value on stack plus returns one! ;if invalid-region, NIL on stack, returns 0 ;if to unboxed, obj origin as fixnum on stack, returns 1 ;if to boxed, obj origin as fixnum on stack, returns 2 (def-lambda-ucode-db-item %pointer-lessp) (def-lambda-ucode-db-item %pointer-greaterp) ) (defun down-load30 () (def-lambda-ucode-db-item %io-cmd-run) (def-lambda-ucode-db-item %advance-free-pointer-and-wipe) ;used to initialize MOBY areas. (def-lambda-ucode-db-item %string-translate) (def-lambda-ucode-db-item %multibus-blt-16) (def-lambda-ucode-db-item %regular-pdl-index) (def-lambda-ucode-db-item %store-conditional-double) (def-lambda-ucode-db-item %p-store-data-type-and-pointer) (def-lambda-ucode-db-item %nubus-read-safe) (def-lambda-ucode-db-item %nubus-read-8-safe) (def-lambda-ucode-db-item %nubus-write-safe) ) (defun down-load31 () (def-lambda-ucode-db-item %nubus-write-8-safe) (def-lambda-ucode-db-item %set-mouse-arrays) (def-lambda-ucode-db-item %map-device-quantum) (def-lambda-ucode-db-item %ip-checksum) ) (defun on-k? (x) (fboundp (car x))) (defun meta-load() ( down-load) ( down-load1) ( down-load2) ( down-load3) ( down-load4) ( down-load5) ( down-load6) ( down-load7) ( down-load8) ( down-load9) ( down-load10) ( down-load11) ( down-load12) ( down-load13) ( down-load14) ( down-load15) ( down-load16) ( down-load17) ( down-load18) ( down-load19) ( down-load20) ( down-load21) ( down-load22) ( down-load23) ( down-load24) ( down-load25) ( down-load26) ( down-load27) ( down-load28) ( down-load29) ( down-load30) ( down-load31) ) (defun ucode-on-k () (remove-if-not #'on-k? *micro-code-functions*) )