;;; -*- Mode:LISP; Base:8; Readtable:ZL -*-

;	** (c) Copyright 1980 Massachusetts Institute of Technology **
;;; This file contains all the definitions for the machine instruction set
;;; and some other stuff needed by the compiler.


;;; This section contains various information regarding the misc. instructions
;;; on the Lisp Machine.  Every entry is of the form:
;;; (DEFMIC <name> <opcode> <arglist> <lisp-function-p> <no-QINTCMP>)
;;;   <name> is the name of the instruction.  If the Lisp function name
;;; 		is different from the instruction name, this is a cons
;;;		of the function name and the instruction name (e.g. (CAR . M-CAR))
;;;   <opcode> is the number which appears in the macro-instruction.
;;;   <arglist> is a list resembling a lambda-list for the Lisp function
;;;             corresponding to the instruction.  & keywords not allowed.
;;;   <lisp-function-p> should be either T or NIL.  If T, then there
;;;             will be a Lisp function defined in the initial Lisp
;;;             environment (available in the interpreter) corresponding
;;;             to the instruction.
;;;   <no-QINTCMP> is OPTIONAL.  If it is not present it is taken to be NIL.
;;;             If it is non-NIL, then no QINTCMP property will be created
;;;             for the symbol.  Otherwise the QINTCMP property is created from
;;;             the length of <arglist>.  The QINTCMP property permits the
;;;		compiler to compile calls to this function as a misc instruction.

;240 241 FREE
(DEFMIC (CAR . M-CAR) 242 (X) T T)
(DEFMIC (CDR . M-CDR) 243 (X) T T)
(DEFMIC (CAAR . M-CAAR) 244 (X) T T)
(DEFMIC (CADR . M-CADR) 245 (X) T T)
(DEFMIC (CDAR . M-CDAR) 246 (X) T T)
(DEFMIC (CDDR . M-CDDR) 247 (X) T T)
(DEFMIC CAAAR 250 (X) T)
(DEFMIC CAADR 251 (X) T)
(DEFMIC CADAR 252 (X) T)
(DEFMIC CADDR 253 (X) T)
(DEFMIC CDAAR 254 (X) T)
(DEFMIC CDADR 255 (X) T)
(DEFMIC CDDAR 256 (X) T)
(DEFMIC CDDDR 257 (X) T)
(DEFMIC CAAAAR 260 (X) T)
(DEFMIC CAAADR 261 (X) T)
(DEFMIC CAADAR 262 (X) T)
(DEFMIC CAADDR 263 (X) T)
(DEFMIC CADAAR 264 (X) T)
(DEFMIC CADADR 265 (X) T)
(DEFMIC CADDAR 266 (X) T)
(DEFMIC CADDDR 267 (X) T)
(DEFMIC CDAAAR 270 (X) T)
(DEFMIC CDAADR 271 (X) T)
(DEFMIC CDADAR 272 (X) T)
(DEFMIC CDADDR 273 (X) T)
(DEFMIC CDDAAR 274 (X) T)
(DEFMIC CDDADR 275 (X) T)
(DEFMIC CDDDAR 276 (X) T)
(DEFMIC CDDDDR 277 (X) T)

(DEFMIC %LOAD-FROM-HIGHER-CONTEXT 300 (ENVPTR) T)
(DEFMIC %LOCATE-IN-HIGHER-CONTEXT 301 (ENVPTR) T)
(DEFMIC %STORE-IN-HIGHER-CONTEXT 302 (VALUE ENVPTR) T)
(DEFMIC %DATA-TYPE 303 (X) T)
(DEFMIC %POINTER 304 (X) T)
(DEFMIC %MAKE-REST-ARG-SAFE 305 () T)
;(DEFMIC %PERMIT-TAIL-RECURSION 306 () NIL T)
(DEFMIC INTERNAL-FLOAT 307 (NUMBER) NIL)
(DEFMIC %MAKE-POINTER 310 (DTP ADDRESS) T)
(DEFMIC %SPREAD 311 (LIST) NIL T)
(DEFMIC %P-STORE-CONTENTS 312 (POINTER VALUE) T)
(DEFMIC %LOGLDB 313 (PPSS WORD) T)		;These don't complain about loading/clobbering
(DEFMIC %LOGDPB 314 (VALUE PPSS WORD) T)	; sign bit. Result is always a fixnum
(DEFMIC LDB 315 (PPSS WORD) T)
(DEFMIC DPB 316 (VALUE PPSS WORD) T)
(DEFMIC %P-STORE-TAG-AND-POINTER 317 (POINTER MISC-FIELDS POINTER-FIELD) T)

(DEFMIC INTERNAL-GET-2 320 (SYMBOL PROPERTY) NIL)
(DEFMIC GETL 321 (SYMBOL PROPERTY-NAME-LIST) T)
(DEFMIC ASSQ 322 (X ALIST) T)
(DEFMIC LAST 323 (LIST) T)
(DEFMIC LENGTH 324 (LIST-OR-ARRAY) T)
(DEFMIC 1+ 325 (N) T)
(DEFMIC 1- 326 (N) T)
(DEFMIC RPLACA 327 (CONS NEW-CAR) T)
(DEFMIC RPLACD 330 (CONS NEW-CDR) T)
(DEFMIC ZEROP 331 (NUMBER) T)
(DEFMIC SET 332 (SYMBOL VALUE) T)
(DEFMIC INTEGERP 333 (X) T)
(DEFMIC (FIXP . INTEGERP) 333 (X) T)
(DEFMIC FLOATP 334 (X) T)
(DEFMIC EQUAL 335 (X Y) T)
(DEFMIC %SET-SELF-MAPPING-TABLE 336 (MAPPING-TABLE) T)
(DEFMIC PDL-WORD 337 (N) NIL T)
(DEFMIC FALSE 340 () T)
(DEFMIC TRUE 341 () T)
(DEFMIC NOT 342 (X) T)
(DEFMIC (NULL . NOT) 342 (X) T)
(DEFMIC ATOM 343 (X) T)
(DEFMIC ODDP 344 (NUMBER) T)
(DEFMIC EVENP 345 (NUMBER) T)
(DEFMIC %HALT 346 () T)
(DEFMIC GET-PNAME 347 (SYMBOL) T)
(DEFMIC (SYMBOL-NAME . GET-PNAME) 347 (SYMBOL) T)
(DEFMIC LSH 350 (N NBITS) T)
(DEFMIC ROT 351 (N NBITS) T)
(DEFMIC *BOOLE 352 (FN ARG1 ARG2) T)
(DEFMIC NUMBERP 353 (X) T)
(DEFMIC PLUSP 354 (NUMBER) T)
(DEFMIC MINUSP 355 (NUMBER) T)
(DEFMIC \ 356 (X Y) T)
(DEFMIC MINUS 357 (NUMBER) T)
(DEFMIC %SXHASH-STRING 360 (STRING CHARACTER-MASK) T)
(DEFMIC VALUE-CELL-LOCATION 361 (SYMBOL) T)
(DEFMIC FUNCTION-CELL-LOCATION 362 (SYMBOL) T)
(DEFMIC PROPERTY-CELL-LOCATION 363 (SYMBOL) T)
(DEFMIC NCONS 364 (CAR) T)
(DEFMIC NCONS-IN-AREA 365 (CAR AREA) T)
(DEFMIC CONS 366 (CAR CDR) T)
(DEFMIC CONS-IN-AREA 367 (CAR CDR AREA) T)
(DEFMIC XCONS 370 (CDR CAR) T)
(DEFMIC XCONS-IN-AREA 371 (CDR CAR AREA) T)
(DEFMIC %SPREAD-N 372 (LIST N) NIL)
(DEFMIC SYMEVAL 373 (SYMBOL) T)
(DEFMIC (SYMBOL-VALUE . SYMEVAL) 373 (SYMBOL) T)
(DEFMIC POP-M-FROM-UNDER-N 374 (NUM-POPS NUM-TO-KEEP) NIL)
(DEFMIC GET-LEXICAL-VALUE-CELL 375 (ENV-LIST SYMBOL-CELL-LOCATION) T)
(DEFMIC %CALL-MULT-VALUE 376 () NIL T)
(DEFMIC %CALL0-MULT-VALUE 377 () NIL T)
(DEFMIC %RETURN-2 400 () NIL T)
(DEFMIC %RETURN-3 401 () NIL T)
(DEFMIC %RETURN-N 402 () NIL T)
(DEFMIC RETURN-NEXT-VALUE 403 (VALUE) NIL)
(DEFMIC RETURN-LIST 404 (VALUES) NIL T)
(DEFMIC UNBIND-TO-INDEX-UNDER-N 405 (N) NIL)
(DEFMIC %BIND 406 (POINTER VALUE) NIL)
(DEFMIC (BIND . %BIND) 406 (POINTER VALUE) NIL)
(DEFMIC %NWAY-BRANCH 407 (INDEX LIMIT) NIL T)
(DEFMIC MEMQ 410 (X LIST) T)
(DEFMIC (INTERNAL-< . M-<) 411 (NUM1 NUM2) T)
(DEFMIC (INTERNAL-> . M->) 412 (NUM1 NUM2) T)
(DEFMIC (INTERNAL-= . M-=) 413 (NUM1 NUM2) T)
(DEFMIC INTERNAL-CHAR-EQUAL 414 (CH1 CH2) T)
(DEFMIC %STRING-SEARCH-CHAR 415 (CHAR STRING START END) T)
(DEFMIC %STRING-EQUAL 416 (STRING1 INDEX1 STRING2 INDEX2 COUNT) T)
(DEFMIC NTH 417 (N LIST) T)
(DEFMIC NTHCDR 420 (N LIST) T)
(DEFMIC (*PLUS . M-+) 421 (NUM1 NUM2) T)
(DEFMIC (*DIF . M--) 422 (NUM1 NUM2) T)
(DEFMIC (*TIMES . M-*) 423 (NUM1 NUM2) T)
(DEFMIC (*QUO . M-//) 424 (NUM1 NUM2) T)
(DEFMIC (*LOGAND . M-LOGAND) 425 (NUM1 NUM2) T)
(DEFMIC (*LOGXOR . M-LOGXOR) 426 (NUM1 NUM2) T)
(DEFMIC (*LOGIOR . M-LOGIOR) 427 (NUM1 NUM2) T)
(DEFMIC ARRAY-LEADER 430 (ARRAY INDEX) T)
(DEFMIC STORE-ARRAY-LEADER 431 (VALUE ARRAY INDEX) T)
(DEFMIC GET-LIST-POINTER-INTO-ARRAY 432 (ARRAY) T)
(DEFMIC ARRAY-PUSH 433 (ARRAY VALUE) T)
(DEFMIC INTERNAL-APPLY 434 (FN ARGS) NIL)	;was APPLY with NO-QINTCMP
(DEFMIC %MAKE-LIST 435 (INITIAL-VALUE AREA LENGTH) T)
; these next four have been moved to macrocode --- leave this in for now in case of some weird screw. Mly
(DEFMIC LIST 436 (&REST ELEMENTS) T T)
(DEFMIC LIST* 437 (FIRST &REST ELEMENTS) T T)	;(&REST ELEMENTS LAST)
(DEFMIC LIST-IN-AREA 440 (AREA &REST ELEMENTS) T T)
(DEFMIC LIST*-IN-AREA 441 (AREA FIRST &REST ELEMENTS) T T)   ;(AREA &REST ELEMENTS LAST)
(DEFMIC LOCATE-IN-INSTANCE 442 (INSTANCE SYMBOL) T)
(DEFMIC %P-CDR-CODE 443 (POINTER) T)
(DEFMIC %P-DATA-TYPE 444 (POINTER) T)
(DEFMIC %P-POINTER 445 (POINTER) T)
(DEFMIC %PAGE-TRACE 446 (TABLE) T)
(DEFMIC THROW-N 447 (TAG &REST VALUES-AND-COUNT) NIL T)
(DEFMIC %P-STORE-CDR-CODE 450 (POINTER CDR-CODE) T)
(DEFMIC %P-STORE-DATA-TYPE 451 (POINTER DATA-TYPE) T)
(DEFMIC %P-STORE-POINTER 452 (POINTER POINTER-TO-STORE) T)
(DEFMIC FLOAT-EXPONENT 453 (FLONUM) T)
(DEFMIC FLOAT-FRACTION 454 (FLONUM) T)
(DEFMIC SCALE-FLOAT 455 (FLONUM INTEGER) T)
(DEFMIC %CATCH-OPEN 456 () NIL T)
(DEFMIC %CATCH-OPEN-MV 457 () NIL T)
(DEFMIC INTERNAL-FLOOR-1 460 (DIVIDEND DIVISOR) NIL T)
;;; 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

(DEFMIC %DIV 461 (DIVIDEND DIVISOR) T)
(DEFMIC %FEXPR-CALL 462 () NIL T)
(DEFMIC %FEXPR-CALL-MV 463 () NIL T)
(DEFMIC %FEXPR-CALL-MV-LIST 464 () NIL T)
(DEFMIC %CATCH-OPEN-MV-LIST 465 () NIL T)
(DEFMIC *CATCH 466 (TAG &REST FORMS) T T)
(DEFMIC (CATCH . *CATCH) 466 (TAG &REST FORMS) T T)
(DEFMIC %BLT 467 (FROM-ADDRESS TO-ADDRESS COUNT INCREMENT) T)
(DEFMIC *THROW 470 (TAG VALUE) NIL T)
(DEFMIC (THROW . *THROW) 470 (TAG VALUE) NIL T) 
(DEFMIC %XBUS-WRITE-SYNC 471 (IO-ADDR WORD DELAY SYNC-LOC SYNC-MASK SYNC-VAL) T)
(DEFMIC %P-LDB 472 (PPSS POINTER) T)
(DEFMIC %P-DPB 473 (VALUE PPSS POINTER) T)
(DEFMIC MASK-FIELD 474 (PPSS FIXNUM) T)
(DEFMIC %P-MASK-FIELD 475  (PPSS POINTER) T)
(DEFMIC DEPOSIT-FIELD 476 (VALUE PPSS FIXNUM) T)
(DEFMIC %P-DEPOSIT-FIELD 477 (VALUE PPSS POINTER) T)
(DEFMIC COPY-ARRAY-CONTENTS 500 (FROM TO) T)
(DEFMIC COPY-ARRAY-CONTENTS-AND-LEADER 501 (FROM TO) T)
(DEFMIC %FUNCTION-INSIDE-SELF 502 () T)
(DEFMIC ARRAY-HAS-LEADER-P 503 (ARRAY) T)
(DEFMIC COPY-ARRAY-PORTION 504 (FROM-ARRAY FROM-START FROM-END TO-ARRAY TO-START TO-END) T)
(DEFMIC FIND-POSITION-IN-LIST 505 (ELEMENT LIST) T)
(DEFMIC %GET-SELF-MAPPING-TABLE 506 (METHOD-FLAVOR-NAME) T)
(DEFMIC G-L-P 507 (ARRAY) T)
(DEFMIC INTERNAL-FLOOR-2 510 (DIVIDEND DIVISOR) NIL T)
;;; takes two args on stack, two values also to stack.
;;; destination of this one also weird. See INTERNAL-FLOOR-1.
(DEFMIC EQL 511 (X Y) T)
(DEFMIC AR-1 512 (ARRAY SUB) T)
(DEFMIC AR-2 513 (ARRAY SUB1 SUB2) T)
(DEFMIC AR-3 514 (ARRAY SUB1 SUB2 SUB3) T)
(DEFMIC AS-1 515 (VALUE ARRAY SUB) T)
(DEFMIC AS-2 516 (VALUE ARRAY SUB1 SUB2) T)
(DEFMIC AS-3 517 (VALUE ARRAY SUB1 SUB2 SUB3) T)
(DEFMIC %INSTANCE-REF 520 (INSTANCE INDEX) T)
(DEFMIC %INSTANCE-LOC 521 (INSTANCE INDEX) T)
(DEFMIC %INSTANCE-SET 522 (VAL INSTANCE INDEX) T)
(DEFMIC %BINDING-INSTANCES 523 (LIST-OF-SYMBOLS) T)
(DEFMIC %EXTERNAL-VALUE-CELL 524 (SYMBOL) T)
(DEFMIC %USING-BINDING-INSTANCES 525 (BINDING-INSTANCES) T)
(DEFMIC %GC-CONS-WORK 526 (NQS) T)
(DEFMIC %P-CONTENTS-OFFSET 527 (POINTER OFFSET) T)
(DEFMIC %DISK-RESTORE 530 (PARTITION-HIGH-16-BITS LOW-16-BITS) T)
(DEFMIC %DISK-SAVE 531 (MAIN-MEMORY-SIZE PARTITION-HIGH-16-BITS LOW-16-BITS) T)
(DEFMIC %ARGS-INFO 532 (FUNCTION) T)
(DEFMIC %OPEN-CALL-BLOCK 533 (FUNCTION ADI-PAIRS DESTINATION) NIL)
(DEFMIC %PUSH 534 (X) NIL)
(DEFMIC %ACTIVATE-OPEN-CALL-BLOCK 535 () NIL)
(DEFMIC %ASSURE-PDL-ROOM 536 (ROOM) NIL)
(DEFMIC STACK-GROUP-RETURN 537 (X) T)
(DEFMIC AS-2-REVERSE 540 (VALUE ARRAY INDEX2 INDEX1) T)
;Perhaps the next one should be flushed.
(DEFMIC %MAKE-STACK-LIST 541 (N) NIL)
(DEFMIC STACK-GROUP-RESUME 542 (SG X) T)
(DEFMIC %CALL-MULT-VALUE-LIST 543 () NIL T)
(DEFMIC %CALL0-MULT-VALUE-LIST 544 () NIL T)
(DEFMIC %GC-SCAV-RESET 545 (REGION) T)
(DEFMIC %P-STORE-CONTENTS-OFFSET 546 (VALUE POINTER OFFSET) T)
(DEFMIC %GC-FREE-REGION 547 (REGION) T)
(DEFMIC %GC-FLIP 550 (new-region-offset) T)
(DEFMIC ARRAY-LENGTH 551 (ARRAY) T)
(DEFMIC ARRAY-TOTAL-SIZE 551 (ARRAY) T)
(DEFMIC ARRAY-ACTIVE-LENGTH 552 (ARRAY) T)
(DEFMIC %COMPUTE-PAGE-HASH 553 (ADDR) T)
(DEFMIC THROW-SPREAD 554 (TAG VALUE-LIST) T)
(DEFMIC %UNIBUS-READ 555 (UNIBUS-ADDR) T)
(DEFMIC %UNIBUS-WRITE 556 (UNIBUS-ADDR WORD) T)
(DEFMIC %GC-SCAVENGE 557 (WORK) T)
(DEFMIC %CHAOS-WAKEUP 560 () T)
(DEFMIC %AREA-NUMBER 561 (X) T)
(DEFMIC *MAX 562 (NUM1 NUM2) T)
(DEFMIC *MIN 563 (NUM1 NUM2) T)
(DEFMIC CLOSURE 565 (SYMBOL-LIST FUNCTION) T)
(DEFMIC AR-2-REVERSE 566 (ARRAY INDEX2 INDEX1) T)
(DEFMIC LISTP 567 (X) T)
(DEFMIC NLISTP 570 (X) T)
(DEFMIC SYMBOLP 571 (X) T)
(DEFMIC NSYMBOLP 572 (X) T)
(DEFMIC ARRAYP 573 (X) T)
(DEFMIC FBOUNDP 574 (SYMBOL) T)
(DEFMIC STRINGP 575 (X) T)
(DEFMIC BOUNDP 576 (SYMBOL) T)
(DEFMIC INTERNAL-\\ 577 (NUM1 NUM2) T)
(DEFMIC FSYMEVAL 600 (SYMBOL) T)
(DEFMIC (SYMBOL-FUNCTION . FSYMEVAL) 600 (SYMBOL) T)
(DEFMIC AP-1 601 (ARRAY SUB) T)
(DEFMIC AP-2 602 (ARRAY SUB1 SUB2) T)
(DEFMIC AP-3 603 (ARRAY SUB1 SUB2 SUB3) T)
(DEFMIC AP-LEADER 604 (ARRAY INDEX) T)
(DEFMIC %P-LDB-OFFSET 605 (PPSS POINTER OFFSET) T)
(DEFMIC %P-DPB-OFFSET 606 (VALUE PPSS POINTER OFFSET) T)
(DEFMIC %P-MASK-FIELD-OFFSET 607 (PPSS POINTER OFFSET) T)
(DEFMIC %P-DEPOSIT-FIELD-OFFSET 610 (VALUE PPSS POINTER OFFSET) T)
(DEFMIC %MULTIPLY-FRACTIONS 611 (NUM1 NUM2) T)
(DEFMIC %DIVIDE-DOUBLE 612 (HIGH-DIVIDEND LOW-DIVIDEND DIVISOR) T)
(DEFMIC %REMAINDER-DOUBLE 613 (HIGH-DIVIDEND LOW-DIVIDEND DIVISOR) T)
(DEFMIC HAULONG 614 (INTEGER) T)
(DEFMIC %BETTER-GC-SCAVENGE 615 (IDLE-P WORK) T)
;(DEFMIC %ALLOCATE-AND-INITIALIZE-ARRAY 616 (HEADER INDEX-LENGTH LEADER-LENGTH AREA NQS) T)
(DEFMIC %MAKE-POINTER-OFFSET 617 (NEW-DTP POINTER OFFSET) T)
(DEFMIC ^ 620 (NUM EXPT) T)
(DEFMIC %CHANGE-PAGE-STATUS 621 (VIRT-ADDR SWAP-STATUS ACCESS-AND-META) T)
(DEFMIC %CREATE-PHYSICAL-PAGE 622 (PHYS-ADDR) T)
(DEFMIC %DELETE-PHYSICAL-PAGE 623 (PHYS-ADDR) T)
(DEFMIC %24-BIT-PLUS 624 (NUM1 NUM2) T)
(DEFMIC %24-BIT-DIFFERENCE 625 (NUM1 NUM2) T)
(DEFMIC %24-BIT-TIMES 626 (NUM1 NUM2) T)
(DEFMIC ABS 627 (NUM) T)
(DEFMIC %POINTER-DIFFERENCE 630 (PTR1 PTR2) T)
(DEFMIC %P-CONTENTS-AS-LOCATIVE 631 (POINTER) T)
(DEFMIC %P-CONTENTS-AS-LOCATIVE-OFFSET 632 (POINTER OFFSET) T)
(DEFMIC (EQ . M-EQ) 633 (X Y) T)
(DEFMIC %STORE-CONDITIONAL 634 (POINTER OLD NEW) T)
(DEFMIC %STACK-FRAME-POINTER 635 () T)
(DEFMIC *UNWIND-STACK 636 (TAG VALUE FRAME-COUNT ACTION) T)
(DEFMIC %XBUS-READ 637 (IO-ADDR) T)
(DEFMIC %XBUS-WRITE 640 (IO-ADDR WORD) T)
(DEFMIC ELT 641 (SEQUENCE INDEX) T)
(DEFMIC MOVE-PDL-TOP 642 NIL NIL T)
(DEFMIC SHRINK-PDL-SAVE-TOP 643 (VALUE-TO-MOVE N-SLOTS) NIL T)
(DEFMIC SPECIAL-PDL-INDEX 644 NIL T)
(DEFMIC UNBIND-TO-INDEX 645 (SPECIAL-PDL-INDEX) NIL T)
(DEFMIC UNBIND-TO-INDEX-MOVE 646 (SPECIAL-PDL-INDEX VALUE-TO-MOVE) NIL T)
(DEFMIC FIX 647 (NUMBER) T)
;; Changed in 95 to exist only for old code. -- now use INTERNAL-FLOAT
(DEFMIC FLOAT 650 (NUMBER OTHER) NIL T)
(DEFMIC SMALL-FLOAT 651 (NUMBER) T)
(DEFMIC %FLOAT-DOUBLE 652 (LOW HIGH) T)
(DEFMIC BIGNUM-TO-ARRAY 653 (BIGNUM BASE) T)
(DEFMIC ARRAY-TO-BIGNUM 654 (ARRAY BASE SIGN) T)
(DEFMIC %UNWIND-PROTECT-CONTINUE 655 (VALUE TAG COUNT ACTION) NIL T)
(DEFMIC %WRITE-INTERNAL-PROCESSOR-MEMORIES 656 (CODE ADR D-HI D-LOW) T)
(DEFMIC %PAGE-STATUS 657 (PTR) T)
(DEFMIC %REGION-NUMBER 660 (PTR) T)
(DEFMIC %FIND-STRUCTURE-HEADER 661 (PTR) T)
(DEFMIC %STRUCTURE-BOXED-SIZE 662 (PTR) T)
(DEFMIC %STRUCTURE-TOTAL-SIZE 663 (PTR) T)
(DEFMIC %MAKE-REGION 664 (AREA BITS SIZE) T)  ;new incarnation, old thing had two args.
(DEFMIC BITBLT 665 (ALU WIDTH HEIGHT FROM-ARRAY FROM-X FROM-Y TO-ARRAY TO-X TO-Y) T)
(DEFMIC %DISK-OP 666 (RQB) T)
(DEFMIC %PHYSICAL-ADDRESS 667 (PTR) T)
(DEFMIC POP-OPEN-CALL 670 NIL NIL T)
(DEFMIC %BEEP 671 (HALF-WAVELENGTH DURATION) T)
(DEFMIC %FIND-STRUCTURE-LEADER 672 (PTR) T)
(DEFMIC BPT 673 NIL T)
(DEFMIC %FINDCORE 674 () T)
(DEFMIC %PAGE-IN 675 (PFN VPN) T)
(DEFMIC ASH 676 (N NBITS) T)
(DEFMIC %MAKE-EXPLICIT-STACK-LIST 677 (LENGTH) NIL T)
(DEFMIC %DRAW-CHAR 700 (FONT-ARRAY CHAR-CODE X-BITPOS Y-BITPOS ALU-FUNCTION SHEET) T)
(DEFMIC %DRAW-RECTANGLE 701 (WIDTH HEIGHT X-BITPOS Y-BITPOS ALU-FUNCTION SHEET) T)
(DEFMIC %DRAW-LINE 702 (X0 Y0 X Y ALU DRAW-END-POINT SHEET) T)
(DEFMIC %DRAW-TRIANGLE 703 (X1 Y1 X2 Y2 X3 Y3 ALU SHEET) T)
(DEFMIC %COLOR-TRANSFORM 704 (N17 N16 N15 N14 N13 N12 N11 N10 N7 N6 N5 N4 N3 N2 N1 N0
			      WIDTH HEIGHT ARRAY START-X START-Y) T)
(DEFMIC %RECORD-EVENT 705 (DATA-4 DATA-3 DATA-2 DATA-1 STACK-LEVEL EVENT MUST-BE-4) T)
(DEFMIC %AOS-TRIANGLE 706 (X1 Y1 X2 Y2 X3 Y3 INCREMENT SHEET) T)
(DEFMIC %SET-MOUSE-SCREEN 707 (SHEET) T)
(DEFMIC %OPEN-MOUSE-CURSOR 710 () T)
(DEFMIC SETELT 711 (SEQUENCE INDEX VALUE) T)
(DEFMIC %BLT-TYPED 712 (FROM-ADDRESS TO-ADDRESS COUNT INCREMENT) T)
(DEFMIC %DRAW-PATTERNED-LINE 713 (PATTERN-ARRAY FROM-X FROM-Y TO-X TO-Y ALU-FUNCTION DRAW-LAST-POINT-P CURRENT-SHEET) T)
;(DEFMIC %ETHER-WAKEUP 711 (RESET-P) T)
;(DEFMIC %CHECKSUM-PUP 712 (ART-16B-PUP START LENGTH) T)
;(DEFMIC %DECODE-PUP 713 (ART-BYTE-PUP START LENGTH STATE SUPER-IMAGE-P) T)
(DEFMIC AR-1-FORCE 714 (ARRAY INDEX) T)
(DEFMIC AS-1-FORCE 715 (VALUE ARRAY INDEX) T)
(DEFMIC AP-1-FORCE 716 (ARRAY INDEX) T)
(DEFMIC AREF 717 (ARRAY &REST SUBSCRIPTS) T T)
(DEFMIC ASET 720 (VALUE ARRAY &REST SUBSCRIPTS) T T)
(DEFMIC ALOC 721 (ARRAY &REST SUBSCRIPTS) T T)

(DEFMIC EQUALP 722 (X Y) T)
(DEFMIC %MAKE-EXPLICIT-STACK-LIST* 723 (LENGTH) NIL T)
(DEFMIC SETCAR 724 (CONS NEWCAR) T)
(DEFMIC SETCDR 725 (CONS NEWCDR) T)
(DEFMIC GET-LOCATION-OR-NIL 726 (SYMBOL PROPERTY) T)
(DEFMIC %STRING-WIDTH 727 (TABLE OFFSET STRING START END STOP-WIDTH) NIL)
(DEFMIC AR-1-CACHED-1 730 (ARRAY SUBSCRIPT) T)
(DEFMIC AR-1-CACHED-2 731 (ARRAY SUBSCRIPT) T)

(DEFMIC %MULTIBUS-READ-16 732 (MULTIBUS-BYTE-ADR) T)
(DEFMIC %MULTIBUS-WRITE-16 733 (MULTIBUS-BYTE-ADR WORD) T)
(DEFMIC %MULTIBUS-READ-8 734 (MULTIBUS-BYTE-ADR) T)
(DEFMIC %MULTIBUS-WRITE-8 735 (MULTIBUS-BYTE-ADR WORD) T)
(DEFMIC %MULTIBUS-READ-32 736 (MULTIBUS-BYTE-ADR) T)
(DEFMIC %MULTIBUS-WRITE-32 737 (MULTIBUS-BYTE-ADR WORD) T)

(DEFMIC SET-AR-1 740 (ARRAY SUBSCRIPT VALUE) T)
(DEFMIC SET-AR-2 741 (ARRAY SUBSCRIPT1 SUBSCRIPT2 VALUE) T)
(DEFMIC SET-AR-3 742 (ARRAY SUBSCRIPT1 SUBSCRIPT2 SUBSCRIPT3 VALUE) T)
(DEFMIC SET-AR-1-FORCE 743 (ARRAY SUBSCRIPT VALUE) T)
(DEFMIC SET-AREF 744 (ARRAY &REST SUBSCRIPTS-AND-VALUE) T T)
(DEFMIC SET-ARRAY-LEADER 745 (ARRAY INDEX VALUE) T)
(DEFMIC SET-%INSTANCE-REF 746 (INSTANCE INDEX VALUE) T)
(DEFMIC VECTOR-PUSH 747 (NEW-ELEMENT VECTOR) T)
(DEFMIC ARRAY-HAS-FILL-POINTER-P 750 (ARRAY) T)
(DEFMIC ARRAY-LEADER-LENGTH 751 (ARRAY) T)
(DEFMIC ARRAY-RANK 752 (ARRAY) T)
(DEFMIC ARRAY-DIMENSION 753 (ARRAY DIMENSION) T)
;Moved to macrocode. KHS 2/85
;(DEFMIC ARRAY-IN-BOUNDS-P 754 (ARRAY &REST SUBSCRIPTS) T T)
;(DEFMIC ARRAY-ROW-MAJOR-INDEX 755 (ARRAY &REST SUBSCRIPTS) T T)

(DEFMIC RETURN-N-KEEP-CONTROL 756 (&REST VALUES N) NIL T)
(DEFMIC RETURN-SPREAD-KEEP-CONTROL 757 (VALUE-LIST) NIL T) 
(DEFMIC COMMON-LISP-LISTP 760 (OBJECT) T)

(DEFMIC %NUBUS-READ 761 (NUBUS-SLOT SLOT-BYTE-ADR) T)
				;SLOT is really the high 8 bits.
				;the "top F" can be supplied via slot, avoiding bignums.
(DEFMIC %NUBUS-WRITE 762 (NUBUS-SLOT SLOT-BYTE-ADR WORD) T)
(DEFMIC %MICROSECOND-TIME 763 () T)		; Returns 32 bits maybe as a bignum
(DEFMIC %FIXNUM-MICROSECOND-TIME 764 () T)
(DEFMIC %IO-SPACE-READ 765 (IO-ADDR) T)
				;32 bit read from HARDWARE-VIRTUAL-ADDRESS space.
				;actual ucode is identical to that for %XBUS-READ on CADR.
(DEFMIC %IO-SPACE-WRITE 766 (IO-ADDR WORD) T) ;actual microcode is identical to %XBUS-WRITE
				;on CADR.
(DEFMIC %NUBUS-PHYSICAL-ADDRESS 767 (APPARENT-PHYSICAL-PAGE) T)
				;arg is "apparent" physical page number (gotten, for example,
				;by shifting value from %PHYSICAL-ADDRESS).
				;value is 22 bit NUBUS page number.

(DEFMIC VECTORP 770 (OBJECT) T)
(DEFMIC SIMPLE-VECTOR-P 771 (OBJECT) T)
(DEFMIC SIMPLE-ARRAY-P 772 (OBJECT) T)
(DEFMIC SIMPLE-STRING-P 773 (OBJECT) T)
(DEFMIC BIT-VECTOR-P 774 (OBJECT) T)
(DEFMIC SIMPLE-BIT-VECTOR-P 775 (OBJECT) T)
(DEFMIC NAMED-STRUCTURE-P 776 (OBJECT) T)
(DEFMIC NAMED-STRUCTURE-SYMBOL 776 (OBJECT) T)
(DEFMIC TYPEP-STRUCTURE-OR-FLAVOR 777 (OBJECT TYPE) T)
(DEFMIC FIXNUMP 1000 (OBJECT) T)
(DEFMIC SMALL-FLOATP 1001 (OBJECT) T)
(DEFMIC CHARACTERP 1002 (OBJECT) T)

(DEFMIC CAR-SAFE 1003 (OBJECT) T)
(DEFMIC CDR-SAFE 1004 (OBJECT) T)
(DEFMIC CADR-SAFE 1005 (OBJECT) T)
(DEFMIC CDDR-SAFE 1006 (OBJECT) T)
(DEFMIC CDDDDR-SAFE 1007 (OBJECT) T)
(DEFMIC NTHCDR-SAFE 1010 (N OBJECT) T)
(DEFMIC NTH-SAFE 1011 (N OBJECT) T)
(DEFMIC CARCDR 1012 (LIST) NIL)
(DEFMIC ENDP 1013 (X) T)
(DEFMIC CONSP-OR-POP 1014 (OBJECT) NIL)
(DEFMIC INDICATORS-VALUE 1015 (OBJECT) NIL T)
(DEFMIC %POINTER-TIMES 1016 (POINTER1 POINTER2) T)
(DEFMIC COMMON-LISP-AREF 1017 (ARRAY &REST INDICES) T T)
(DEFMIC COMMON-LISP-AR-1 1020 (ARRAY INDEX) T)
(DEFMIC COMMON-LISP-AR-1-FORCE 1021 (ARRAY INDEX) T)
(DEFMIC INTERNAL-GET-3 1022 (SYMBOL PROPERTY DEFAULT) NIL T)

(DEFMIC CHAR-INT 1023 (CHAR) T)
(DEFMIC INT-CHAR 1024 (INTEGER) T)
(DEFMIC ALPHA-CHAR-P 1025 (CHAR) T)
(DEFMIC UPPER-CASE-P 1026 (CHAR) T)
(DEFMIC ALPHANUMERICP 1027 (CHAR) T)
(DEFMIC PACKAGE-CELL-LOCATION 1030 (SYMBOL) T)
(DEFMIC MEMBER-EQL 1031 (ELT LIST) T)
(DEFMIC RATIONALP 1032 (OBJECT) T)
(DEFMIC RATIOP 1033 (OBJECT) T)
(DEFMIC COMPLEXP 1034 (OBJECT) T)
(DEFMIC %RATIO-CONS 1035 (NUMERATOR DENOMINATOR) T)
(DEFMIC %COMPLEX-CONS 1036 (REALPART IMAGPART) T)
(DEFMIC BOTH-CASE-P 1037 (CHAR) T)
(DEFMIC CHAR-UPCASE 1040 (CHAR) T)
(DEFMIC CHAR-DOWNCASE 1041 (CHAR) T)
(DEFMIC LOWER-CASE-P 1042 (CHAR) T)

(defmic %micro-paging 1100 (arg) t)
(defmic %processor-switches 1101 (arg) t)
(defmic %cold-boot 1102 () t)

(defmic %test-multiply-return-low 1103 (n1 n2) t)	;these changed from sys 94 defs.
(defmic %test-multiply-return-high 1104 (n1 n2) t)
(defmic %mult-16 1105 (n1 n2) t)
(defmic %mult-32 1106 (n1 n2) t)

(defmic %quart-transfer 1107 (quart-flags array n-blocks) t)
;; quart-flags bit0 0-> read, 1-> write. value is number blocks transferred
(defmic %nubus-read-8 1110 (nubus-slot slot-byte-adr) t)
;; SLOT is really the high 8 bits. The "top F" can be supplied via slot, avoiding bignums.
(defmic %nubus-write-8 1111 (nubus-slot slot-byte-adr word) t)

(defmic %lambda-rg-quad-slot 1112 () t)
(defmic %lambda-tv-quad-slot 1113 () t)
(defmic %lambda-sdu-quad-slot 1116 () t)

(defmic %lambda-sys-conf-virtual-to-phys 1114 (virtual-address) t)
(defmic %lambda-sys-conf-phys-to-virtual 1115 (physical-address) t)
(defmic %lambda-sys-conf-virtual-adr 1117 () t)

;; Gets mouse button state directly out of a-memory.
(defmic %lambda-mouse-buttons 1120 () t)

(defmic member 1121 (target list) t)
(defmic (member-equal . member) 1121 (target list) t)
(defmic assoc 1122 (target list) t)
(defmic (assoc-equal . assoc) 1122 (target list) t)

;; Don't bind %meter-micro-enables anymore... use this instead.
(defmic %set-meter-enables 1123 (n) t)

(defmic invalidate-cons-caches 1124 () nil)

(defmic %internal-list 1125 (&rest lists) nil t)
(defmic %internal-list* 1126 (&rest lists) nil t)
(defmic %internal-list-in-area 1127 (&rest lists) nil t)
(defmic %internal-list*-in-area 1130 (&rest lists) nil t)
(defmic %internal-mapc 1131 (f l) nil t)
(defmic %internal-mapcar 1132 (f l) nil t)
(defmic %internal-append-2 1133 (a b) t)
(defmic %internal-nconc-2 1134 (a b) t)

;; Fast FEFs bypass the old trap-on-next-call-within-this-stack-group mechanism.
;; Call this for BREAKON.
(defmic %trap-on-next-call 1135 () t)

(defmic %blt-boole 1136 (ALU FROM-ADDRESS TO-ADDRESS COUNT INCREMENT) T)
(defmic %findcore-hexadec 1137 (hexadec) T)  ;find core with specified 4 bits of physical page num

(defmic %sxhash-substring 1140 (string mask start end) t)

(defmic %stat-counter 1141 (op-code value) t)

(defmic %internal-delq 1142 (item list times) t)

(defmic %make-structure 1143 (pointer-tag header-tag header second-word area total boxed) t)
(defmic %make-array 1144 (header-word index-length leader-length area total-size boxed-size) t)

(defmic %pointer-info 1145 (address) nil)  ;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

(defmic %pointer-lessp 1146 (p1 p2) t)
(defmic %pointer-greaterp 1147 (p1 p2) t)

(defmic %io-cmd-run 1150 (io-cmd) t)

(defmic %advance-free-pointer-and-wipe 1151 (region data-type pointer nwords) t)
        ;used to initialize MOBY areas.

(defmic %string-translate 1152
  (source source-start destination destination-start characters table)
  nil)

(defmic %multibus-blt-16 1153 (alu starting-vadr starting-phase width-in-16s rows skip-in-16s multibus-adr) t)
(defmic %regular-pdl-index 1154 () nil)

(defmic %store-conditional-double 1155 (pointer old new-pointer new) t)

(defmic %p-store-data-type-and-pointer 1156 (address data-type pointer-to-store) t)
(defmic %nubus-read-safe 1157 (NUBUS-SLOT SLOT-BYTE-ADR) T)
(defmic %nubus-read-8-safe 1160 (NUBUS-SLOT SLOT-BYTE-ADR) T)
(defmic %nubus-write-safe 1161 (NUBUS-SLOT SLOT-BYTE-ADR WORD) T)
(defmic %nubus-write-8-safe 1162 (NUBUS-SLOT SLOT-BYTE-ADR WORD) T)

(defmic %set-mouse-arrays 1163 (cursor-pattern buttons-buffer x-scale y-scale) t)

(defmic %map-device-quantum 1164 (quantum-number nubus-page nubus-words l2-control) t)

(defmic %ip-checksum 1165 (array sum count odd-p) t)

;;; FROM HERE TO 1777 FREE

;;;; Instructions and other symbols for LAP

(DEFPROP CALL 0 QLVAL) 

(DEFPROP CALL0 1000 QLVAL) 

(DEFPROP MOVE 2000 QLVAL) 

(DEFPROP CAR 3000 QLVAL) 

(DEFPROP CDR 4000 QLVAL) 

(DEFPROP CADR 5000 QLVAL) 

(DEFPROP CDDR 6000 QLVAL) 

(DEFPROP CDAR 7000 QLVAL) 

(DEFPROP CAAR 10000 QLVAL) 

;ND1
(DEFPROP MAKE-CLOSURE-TOP-LEVEL 11000 QLVAL)
(DEFPROP *PLUS 31000 QLVAL)			;These used to be called +, -, etc,
(DEFPROP *DIF 51000 QLVAL)			; but those are now n-arg, while these seven
(DEFPROP *TIMES 71000 QLVAL)			; are two-arguments-only (instructions).
(DEFPROP *QUO 111000 QLVAL) 
(DEFPROP *LOGAND 131000 QLVAL)
(DEFPROP *LOGXOR 151000 QLVAL)
(DEFPROP *LOGIOR 171000 QLVAL)

;ND2
(DEFPROP INTERNAL-= 12000 QLVAL) 
(DEFPROP INTERNAL-> 32000 QLVAL) 
(DEFPROP INTERNAL-< 52000 QLVAL) 
(DEFPROP EQ 72000 QLVAL)
;;; SETE CDR 112000
;;; SETE CDDR 132000
;;; SETE 1+ 152000
;;; SETE 1- 172000

;ND3
;;; 13000 unused, used to be BIND.
(DEFPROP BINDNIL 33000 QLVAL) 
(DEFPROP BINDPOP 53000 QLVAL) 
(DEFPROP SETNIL 73000 QLVAL) 
(DEFPROP SETZERO 113000 QLVAL) 
(DEFPROP PUSH-E 133000 QLVAL)
(DEFPROP MOVEM 153000 QLVAL) 
(DEFPROP POP 173000 QLVAL)

;BRANCH is 14

;MISC
(DEFPROP MISC 15000 QLVAL)
(DEFPROP MISC1 34000 QLVAL)			;MISC code 1000 turns into insn 35000,
						; by adding 34000

;; ND4
(DEFPROP CLOSURE-DISCONNECT 16000 QLVAL)
(DEFPROP CLOSURE-UNSHARE 36000 QLVAL)
(DEFPROP MAKE-CLOSURE 56000 QLVAL)
(DEFPROP PUSH-NUMBER 76000 QLVAL)
(DEFPROP CLOSURE-DISCONNECT-FIRST 116000 QLVAL)
(DEFPROP PUSH-CDR-IF-CAR-EQUAL 136000 QLVAL)
(DEFPROP PUSH-CDR-STORE-CAR-IF-CONS 156000 QLVAL)

;; AREFI
(DEFPROP AREFI 20000 QLVAL)
(DEFPROP AREFI-LEADER 20100 QLVAL)
(DEFPROP AREFI-INSTANCE 20200 QLVAL)
(DEFPROP AREFI-COMMON-LISP 20300 QLVAL)
(DEFPROP AREFI-SET 20400 QLVAL)
(DEFPROP AREFI-SET-LEADER 20500 QLVAL)
(DEFPROP AREFI-SET-INSTANCE 20600 QLVAL)


;;; - MISCELLANEOUS FUNCTIONS -  these all obsolete.
(DEFPROP ASETI 100 QLVAL)
(DEFPROP ASETI-LEADER 120 QLVAL)
(DEFPROP ASETI-INSTANCE 140 QLVAL)

(DEFPROP UNBIND 200 QLVAL)
 (DEFMIC UNBIND-0 200 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-1 201 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-2 202 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-3 203 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-4 204 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-5 205 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-6 206 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-7 207 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-10 210 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-11 211 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-12 212 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-13 213 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-14 214 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-15 215 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-16 216 NIL NIL T)	;FOR UCONS
 (DEFMIC UNBIND-17 217 NIL NIL T)	;FOR UCONS
(DEFPROP POPPDL 220 QLVAL)
 (DEFMIC POPPDL-0 220 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-1 221 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-2 222 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-3 223 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-4 224 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-5 225 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-6 226 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-7 227 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-10 230 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-11 231 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-12 232 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-13 233 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-14 234 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-15 235 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-16 236 NIL NIL T)	;FOR UCONS
 (DEFMIC POPPDL-17 237 NIL NIL T)	;FOR UCONS
;The rest of these come from the DEFMIC table above.

;QIND5 group (only 4 opcodes here)
(defprop 1+-to-pdl 21000 qlval)
(defprop 1--to-pdl 61000 qlval)
(defprop single-address-zerop 121000 qlval)

;; QID1 destination group.
(defprop %reference-simple-q-vector 22000 qlval)   ;array pointer on stack, index from inst.
(defprop %set-simple-q-vector 22100 qlval)   ;data to store in -1(pp), array pointer in 0(pp)

;;;Source address types

(DEFPROP FEF 0 QLVAL) 

(DEFPROP CONST-PAGE 400 QLVAL) 

(DEFPROP LOCAL 500 QLVAL) 

(DEFPROP ARG 600 QLVAL) 

;OBSOLETE NAME
(DEFPROP LPDL 700 QLVAL) 

;Following word holds the actual source address
(DEFPROP EXTEND 776 QLVAL)

(DEFPROP PDL-POP 777 QLVAL)

;DESTINATIONS
(DEFCONST %%MACRO-DEST-FIELD 1602)

(DEFPROP D-IGNORE 0 QLVAL) 

(DEFPROP D-INDS 0 QLVAL) 

(DEFPROP D-PDL 40000 QLVAL)
(DEFPROP D-NEXT 40000 QLVAL) 

(DEFPROP D-RETURN 100000 QLVAL) 

(DEFPROP D-LAST 140000 QLVAL)

;Old values from when the dest field was 3 bits long.
;(DEFPROP D-PDL 20000 QLVAL)
;(DEFPROP D-NEXT 20000 QLVAL) 

;(DEFPROP D-PDL-NEW 40000 QLVAL)

;(DEFPROP D-LAST  60000 QLVAL) 

;(DEFPROP D-RETURN 100000 QLVAL) 

;(DEFPROP D-LAST-NEW 140000 QLVAL)


;(DEFPROP DEST-ARG-QTD 60000 QLVAL) 		;ADDED TO D-NEXT,D-LAST

;(DEFPROP D-NEXT-LIST 160000 QLVAL) 

;;; Properties for the micro-compiler

(DEFPROP M-CAR QMA LAST-ARG-IN-T-ENTRY)
(DEFPROP M-CDR QMD LAST-ARG-IN-T-ENTRY)
(DEFPROP M-CAAR QMAA LAST-ARG-IN-T-ENTRY)
(DEFPROP M-CADR QMAD LAST-ARG-IN-T-ENTRY)
(DEFPROP M-CDAR QMDA LAST-ARG-IN-T-ENTRY)
(DEFPROP M-CDDR QMDD LAST-ARG-IN-T-ENTRY)
(DEFPROP CAAAR QMAAA LAST-ARG-IN-T-ENTRY)
(DEFPROP CAADR QMAAD LAST-ARG-IN-T-ENTRY)
(DEFPROP CADAR QMADA LAST-ARG-IN-T-ENTRY)
(DEFPROP CADDR QMADD LAST-ARG-IN-T-ENTRY)
(DEFPROP CDAAR QMDAA LAST-ARG-IN-T-ENTRY)
(DEFPROP CDADR QMDAD LAST-ARG-IN-T-ENTRY)
(DEFPROP CDDAR QMDDA LAST-ARG-IN-T-ENTRY)
(DEFPROP CDDDR QMDDD LAST-ARG-IN-T-ENTRY)
(DEFPROP CAAAAR QMAAAA LAST-ARG-IN-T-ENTRY)
(DEFPROP CAAADR QMAAAD LAST-ARG-IN-T-ENTRY)
(DEFPROP CAADAR QMAADA LAST-ARG-IN-T-ENTRY)
(DEFPROP CAADDR QMAADD LAST-ARG-IN-T-ENTRY)
(DEFPROP CADAAR QMADAA LAST-ARG-IN-T-ENTRY)
(DEFPROP CADADR QMADAD LAST-ARG-IN-T-ENTRY)
(DEFPROP CADDAR QMADDA LAST-ARG-IN-T-ENTRY)
(DEFPROP CADDDR QMADDD LAST-ARG-IN-T-ENTRY)
(DEFPROP CDAAAR QMDAAA LAST-ARG-IN-T-ENTRY)
(DEFPROP CDAADR QMDAAD LAST-ARG-IN-T-ENTRY)
(DEFPROP CDADAR QMDADA LAST-ARG-IN-T-ENTRY)
(DEFPROP CDADDR QMDADD LAST-ARG-IN-T-ENTRY)
(DEFPROP CDDAAR QMDDAA LAST-ARG-IN-T-ENTRY)
(DEFPROP CDDADR QMDDAD LAST-ARG-IN-T-ENTRY)
(DEFPROP CDDDAR QMDDDA LAST-ARG-IN-T-ENTRY)
(DEFPROP CDDDDR QMDDDD LAST-ARG-IN-T-ENTRY)

(DEFPROP M-+ XTCADD LAST-ARG-IN-T-ENTRY)	;CHECKS INPUT D.T. TO ASSURE FIXED
(DEFPROP M-- XTCSUB LAST-ARG-IN-T-ENTRY)
(DEFPROP M-* XTCMUL LAST-ARG-IN-T-ENTRY)
(DEFPROP M-// XTCDIV LAST-ARG-IN-T-ENTRY)
(DEFPROP M-LOGAND XTCAND LAST-ARG-IN-T-ENTRY)
(DEFPROP M-LOGXOR XTCXOR LAST-ARG-IN-T-ENTRY)
(DEFPROP M-LOGIOR XTCIOR LAST-ARG-IN-T-ENTRY)

(defprop not xtnot last-arg-in-t-entry)

(defprop set-ar-1 xt-set-ar1 last-arg-in-t-entry)
(defprop set-ar-2 xt-set-ar2 last-arg-in-t-entry)
(defprop set-ar-3 xt-set-ar3 last-arg-in-t-entry)

;(DEFPROP XTCADD XTADD NO-TYPE-CHECKING-ENTRY)	;ONE ARG IN T, ONE ON PDL
;(DEFPROP XTCSUB XTSUB NO-TYPE-CHECKING-ENTRY)
;(DEFPROP XTCMUL XTMUL NO-TYPE-CHECKING-ENTRY)
;(DEFPROP XTCDIV XTDIV NO-TYPE-CHECKING-ENTRY)
;(DEFPROP XTCAND XTAND NO-TYPE-CHECKING-ENTRY)
;(DEFPROP XTCXOR XTXOR NO-TYPE-CHECKING-ENTRY)
;(DEFPROP XTCIOR XTIOR NO-TYPE-CHECKING-ENTRY)

;(DEFPROP M-+ XTADD UNBOXED-NUM-IN-T-ENTRY)	;THESE GUYS DONT REALLY CHECK ANYWAY
;(DEFPROP M-- XTSUB UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP M-* XTMUL UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP M-// XTDIV UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP M-LOGAND XTAND UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP M-LOGXOR XTXOR UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP M-LOGIOR XTIOR UNBOXED-NUM-IN-T-ENTRY)

;(DEFPROP M-+ XMADD NO-TYPE-CHECKING-ENTRY)	;THESE ARE A BIT FASTER
;(DEFPROP M-- XMSUB NO-TYPE-CHECKING-ENTRY)	;TAKE 2 ARGS ON PDL
;(DEFPROP M-* XMMUL NO-TYPE-CHECKING-ENTRY)
;(DEFPROP M-// XMDIV NO-TYPE-CHECKING-ENTRY)
;(DEFPROP M-LOGAND XMAND NO-TYPE-CHECKING-ENTRY)
;(DEFPROP M-LOGXOR XMXOR NO-TYPE-CHECKING-ENTRY)
;(DEFPROP M-LOGIOR XMIOR NO-TYPE-CHECKING-ENTRY)

;(DEFPROP ATOM XTATOM LAST-ARG-IN-T-ENTRY)
;(DEFPROP ZEROP XTZERO LAST-ARG-IN-T-ENTRY)
(DEFPROP NUMBERP XTNUMB LAST-ARG-IN-T-ENTRY)
(DEFPROP FIXP XTFIXP LAST-ARG-IN-T-ENTRY)
(DEFPROP FLOATP XTFLTP LAST-ARG-IN-T-ENTRY)
;(DEFPROP PLUSP XTPLUP LAST-ARG-IN-T-ENTRY)
;(DEFPROP MINUSP XTMNSP LAST-ARG-IN-T-ENTRY)
;(DEFPROP MINUS XTMNS LAST-ARG-IN-T-ENTRY)
;(DEFPROP 1+ XT1PLS LAST-ARG-IN-T-ENTRY)
;(DEFPROP 1- XT1MNS LAST-ARG-IN-T-ENTRY)
;(DEFPROP SYMEVAL XTSYME LAST-ARG-IN-T-ENTRY)
(DEFPROP LENGTH XTLENG LAST-ARG-IN-T-ENTRY)

;(DEFPROP ZEROP XBZERO UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP PLUSP XBPLUP UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP MINUSP XBMNSP UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP MINUS XBMNS UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP 1+ XB1PLS UNBOXED-NUM-IN-T-ENTRY)
;(DEFPROP 1- XB1MNS UNBOXED-NUM-IN-T-ENTRY)

;;; Certain MISC-instructions make assumptions about what destinations
;;; they are used with.  Some require D-IGNORE, because they assume that
;;; there is no return address on the micro-stack.  Some do not allow D-IGNORE,
;;; because they popj and start a memory cycle.  Some are really random.
(DEFVAR MISC-INSTRUCTION-REQUIRED-DESTINATION-ALIST
	'(;(%ALLOCATE-AND-INITIALIZE D-PDL D-NEXT D-LAST D-RETURN)
	  ;(%ALLOCATE-AND-INITIALIZE-ARRAY D-PDL D-NEXT D-LAST D-RETURN)
	  (%SPREAD D-NEXT D-LAST)
	  (RETURN-LIST D-RETURN)
	  (%OPEN-CALL-BLOCK D-IGNORE D-INDS)
	  (%ACTIVATE-OPEN-CALL-BLOCK D-IGNORE D-INDS)
	  (%RETURN-2 D-IGNORE D-INDS)
	  (%RETURN-3 D-IGNORE D-INDS)
	  (%RETURN-N D-IGNORE D-INDS)
	  (%RETURN-NEXT-VALUE D-IGNORE D-INDS)))