Symbolics L-machine Macrocode Compendium Brad Parker 7/05/2004 Overview -------- Everything in this document may be wrong. It's primarily my best guess after reading the patent document and using a 3640. This docuement is primarily an architecture overview divorced from the actual implementation. The l-machine can address 28 bits of 36 bit memory. It can only address the entire 36 bit word; there is no byte or half word addressing. Memory words consist of a 28-32 bit data area and a 4-8 bit tag. 32 bit integers use 4 bit tag and 32 bits of data. Pointers use an 8 bit tag and 28 bits of address. Instructions are 18 bits, two per memory word. The PC is tagged (naturally) and indicates using the top or bottom half of the word. Instructions are know as "macrocode" to differentiate them from microcode. There is no traditional register file. The only real registers the macrosees are the stack pointer and the frame pointer. This is a true stack machine. The stack ends up in an area of fast memory which the microcode can access in one cycle. The microcode handles spills of the full stack into and out of the fast stack area. There are many, many, many instructions, all implemented in microcode. The microcode was implemented using a writable control store, so it could be easily changed. The system uses virtual memory with 256 word pages. When booted a "world file" (or "band") is loaded into the physical memory and started. The world file is originally bootstrapped from scratch and then saved as a sequence of VM pages (i.e. the world file). Cdr-coding ---------- Traditionally lisp is implemented using "cons cells" which are a group of 2 pointers, one representing the 'car' pointer and one representing the 'cdr' ptr. The CONS machine and following machines used an optimization called 'cdr coding' where the pointers where compressed into the top few bits of the tag. so, a list like (1 2 3) using cons cells might be -> | . | . | | | v +---> | . | . | 1 | | v +----| . | . | 2 | | v v 3 NIL and using cdr codes is ends up as -> | 1 | 2 | 3 | NIL | or, in more detail, the list items are stored in sequential tagged memory locations -> tag = dtp-fix, cdr-code = CDR-NEXT, data = 1 tag = dtp-fix, cdr-code = CDR-NEXT, data = 2 tag = dtp-fix, cdr-code = CDR-NIL, data = 3 In the first case the tag of the list pointers would be CDR-NORMAL to tell the microcode that the list was not cdr-coded. Instructions ------------ 17 bit instructions, two per 36 bit word 7 instruction formats: 1. Unsigned-immediate operand Operand is 8-bit unsigned; used for program-counter-relative branches, immediate fixnum arithmetic, etc 2. Signed-immediate operand Operand is an 8-bit two's complement (signed). Used like unsigned-immediate format. 3. PC-relative operand Like signed-immediate but with the offset relative to the program counter. 4. No-operand no operand used 5. Link operand A reference to a linkage area in a function header. 6. @Link operand An indirect reference to a stack frame area associated with a function. 7. Local operand Operands are on the stack or within function frame. Universal opcodes instruction bits: 1 1 7 6 5 4 3 2 1 0 9 8 7 6 4 5 4 3 2 1 0 <- operand -> <- opcode -> no-operand opcodes (opcode = 0777) uop = 01000 + opcode field otherwise uop = opcode instruction format dicates the use of the operand unsigned-immediate-operand signed-immediate-operand 10-bit-immediate-operand 2 high bits are in the opcode address-operand FP+displacement or SP-displacement no-operand quick-external-call constant-operand compiled-function constants area indirect-operand indirect thru compiled-func link area lexical-operand microcode-operand global constants/variables area unsigned-pc-relative signed-pc-relative constant-pc-relative attributes are mostly for microcode and disassembler data-type an immediate data type code byte-pointer an immediate byte pointer argument-number 0 means the first argument, 1 the second, ... instance-variable reference to mapped or unmapped instance variable lexical-variable reference to a lexical variable data-types dtp-null 0 dtp-nil 1 dtp-symbol 2 dtp-extended-number 3 dtp-external-value-cell-pointer 4 dtp-locative 5 dtp-list 6 dtp-compiled-function 7 dtp-array 8 010 0x08 dtp-closure 9 dtp-entity 10 dtp-lexical-closure 11 dtp-select-method 12 dtp-instance 13 dtp-header-p 14 dtp-header-i 15 0x0f dtp-fix 16-31 0x10-0x1f dtp-float 32-47 0x20-0x2f dtp-even-pc 48 060 0x30 dtp-gc-forward 49 dtp-one-q-forward 50 dtp-header-forward 51 dtp-body-forward 52 dtp-65 dtp-66 dtp-67 dtp-odd-pc 56 070 0x38 dtp-71 dtp-72 dtp-73 dtp-74 dtp-75 dtp-76 dtp-77 cdr-codes cdr-next 00 cdr-nil 01 cdr-normal 10 cdr-spare 11 xxx format-2 - address operand? a-memory[ local-operand address operand 7 6 5 4 3 2 1 0 | <- offset -> | +----- 0=fp+offset, 1=sp-offset address-add address-add-macrocode Microcode Operations -------------------- pc-add (pc offset) word <- pc + (offset >> 1) halfword <- logxor ldb 1 31 pc offset offset < 0 ? 1 : 0 if halfword & 1 set-type word dtp-odd-pc else set-type word dtp-even-pc return word convert-branch-length (address length) word-offset <- (length >> 1) + (length & 1) && ((address & 1) == 0) ? 1 : 0; halfword-offset <- (length & 1) ^ (word-offset < 0) ? 1 : 0; return (word-offset >> 1) + halfword-offset pushval (val) push value onto stack cdr-code(val) <- cdr-next a-memory[stack-pointer + 1] <- val top-of-stack <- val stack-pointer++ pushval-with-cdr (val) push value onto stack, preserve tag (cdr code) amem[stack-pointer + 1] <- val top-of-stack <- val stack-pointer++ popval pop top of stack top-of-stack <- a-memory[stack-pointer-1] stack-pointer-- popmem pop top of stack, write to vma, leave memory's cdr code unchanged memory[vma] <- top-of-stack-a tag[vma] <- merge-cdr top-of-stack-a tag[vma] popval popmemind vma <- memory[vma] popmem pop-indirect vma <- frame-function - operand - 1 popmemind pushmem pushval memory[vma] pushmemind vma <- memory[vma] pushmem pop2push ;like doing two popval's and then pushval cdr-code(val) <- cdr-next a-memory[stack-pointer - 1] <- val top-of-stack <- val stack-pointer-- newtop cdr-code(val) <- cdr-next a-memory[stack-pointer] <- val top-of-stack <- val newtopmem newtop memory[vma] setup-stack-load pushval (set-type frame-pointer dtp-locative) stacklow <- (stack-limit-02000) & ~(page-size-1) pushval (set-type (stacklow + page-size) dtp-locative frame-pointer <- stacklow finish-stack-load stacklow <- (stack-limit-02000) & ~(page-size-1) stack-limit -= page-size adjust-frame-buffer-underflow-bits stacklow adjust-frame-buffer-underflow-bits stacklow stacklow += 5 pushval frame-pointer temp-2 <- frame-pointer loop until frame-pointer < stacklow temp-2 <- frame-pointer frame-buffer-underflow <- 0 frame-pointer <- frame-previos-frame xx do code above one last time with these? frame-pointer <- temp-2 frame-buffer-underflow-bit <- 1 frame-pointer <- popval stack-load loop until frame-pointer == top-of-stack a <- amem[frame-pointer] amem[a] <- frame-pointer frame-pointer++ popval frame-pointer <- popval return-continuation return-stack popj-no-value if data-type top-of-stack != dtp-even-pc dtp-odd-pc error pc <- popval return-cleanup setup-stack-load stack-load finish-stack-load popj-no-value take-jump-trap (new-pc) pc <- new-pc (*throw 'pclsr nil) value-disposition 0 effect ignore 1 value stack 2 return return 3 multiple-value multiple common-return-processing (value) temp1 <- value if frame-cleanup-bits if data-type frame-cleanup-bits == dtp-nil error pushval temp-1 pushval return-continuation take-jump-trap return-cleanup if data-type frame-return-pc != dtp-even-pc and dtp-odd-pc error pc <- frame-return-pc stack-pointer <- frame-previous-top value-disposition = (effect value return multiple-values)[cdr-field(frame-previous-top)] frame-pointer <- frame-previous-frame if value-disposition == effect top-of-stack <- amem[stack-pointer] pushval temp-1 common-return-processsing temp-1 general-return (a-temp, b-temp = # of values) switch cdr-code frame-previous-top trap if bits frame-buffer-overflow or frame-cleanup-bits set in frame-misc-data general-return-cleanup 0 /* ignore */ check-arg-type return-pc frame-return-pc dtp-even-pc dtp-odd-pc stack-pointer <- frame-previous-top top-of-stack <- top-of-stack-a if bit not set frame-buffer-underflow-bit frame-pointer <- frame-previous-frame (done) else frame-pointer <- frame-previous-frame take-post-trap reload-stack-buffer preserve-stack 1 /* stack */ check-arg-type return-pc frame-return-pc dtp-even-pc dtp-odd-pc pc <- frame-return-pc if a-temp == 0 top-of-stack <- quote-nil stack-pointer <- stack-pointer - b-temp top-of-stack <- amem[stack-pointer+1] stack-pointer <- frame-previous-top if bit not set frame-buffer-underflow-bit frame-pointer <- frame-previous-frame pushval top-of-stack (done) else frame-pointer <- frame-previous-frame pushval top-of-stack take-post-trap reload-stack-buffer preserve-stack 2 /* return */ a-temp-misc-data <- frame-misc-data blt-values-down frame-pointer <- a-temp-prev-frame if ! bit a-temp-misc-data frame-buffer-underflow-bit ;return from caller's frame to his caller goto general-return ;reload stack buffer, then popj to return-multiple instruction pushval set-type a-temp dtp-fix ;# of values returning take-jump-trap-with-continuation reload-stack-buffer return-multiple-escape-pc preserve-stack 3 /* multiple */ check-arg-type return-pc frame-return-pc dtp-even-pc dtp-odd-pc pc <- frame-return-pc a-temp-misc-data <- frame-misc-data blt-values-down frame-pointer <- a-temp-prev-frame if ! bit a-temp-misc-data frame-buffer-underflow-bit ;store # of values returned pushval set-type a-temp dtp-fix done ;reload stack buffer, then popj pushval set-type a-temp dtp-fix ;# of values returning take-jump-trap-with-continuation reload-stack-buffer pc preserve-stack general-return-cleanup trap-no-save if bit frame-catch-bit goto catch-cleanup drop-through if bit frame-bindings-bit pushval set-type a-temp dtp-fix ;# of values clear-stack-adjustment restart-pc return-multiple-escape-pc accept-restart-pc frame-cleanup-bind-stack-unwind a-temp <- top-of-stack b-temp <- top-of-stack stack-pointer-- jump general-return drop-through if bit frame-bottom-bit if a-temp == 0 pushval quote-nil xbas <- stack-pointer - b-temp pushval amem[xbas + 1] take-jump-trap stack-group-exhausted preserve-stack drop-through if bit frame-trace-bit pushval set-type a-temp dtp-fix ;make values a multiple group signal-error-no-restore-stack return-from-traced-frame drop-through ;unknown cleanup bit set pushval set-type a-temp dtp-fix ;make values a multiple group signal-error-no-restore-stack garbage-in-frame-cleanup-bits catch-cleanup xbas <- %catch-block-list ; inspect catch lock if amem[xbas] == b-quote-t ; catch-block-tag pushval set-type a-temp dtp-fix ;# of values returning clear-stack-adjustment restart-pc return-multiple-escape-pc accept-restart-pc a-catch-nwords <- 1 + a-temp jump catch-close-1 drop-through ;not an unwind-protect %catch-block-list <- amem[xbas + 3] b-temp-2 <- amem[xbas + 3] if data-type %catch-block-list dtp-nil frame-catch-bit <- 0 jump general-return if b-temp-2 < frame-pointer frame-catch-bit <- 0 jump general-return goto catch-cleanup catch-close-1 xbas <- %catch-block-list b-temp <- amem[xbas + 2] if b-temp != %binding-stack-pointer pop-binding-stack-to-b-temp drop-through b-temp <- amem[xbas] if b-temp == quote-t a-batch-pc <- amem[xbas+1] catch-close-2 pushval pc pc <- a-catch-pc done goto catch-close-2 catch-close-2 b-temp <- frame-pointer b-temp-2 <- stack-pointer ;last word to save frame-pointer <- b-temp-2 - a-catch-nwords ;first word to save-1 stack-pointer <- %catch-block-list - 1 ; flush stack down to base of block %catch-block-list <- amem[xbas + 3] blt-stack frame-pointer <- b-temp if data-type %catch-block-list dtp-locative if %catch-block-list >= b-temp return drop-through frame-catch-bit <- 0 ; no more blocks this frame done frame-cleanup-bind-stack-unwind if bit frame-bindings-bit call-unbind-1 frame-cleanup-bind-stack-unwind call-unbind-1 return vma <- %binding-stack-pointer b-temp-2 <- %binding-stack-pointer if return call-and-return-to unbind-1 return unbind-1 unbind-1 if %binding-stack-low > b-temp-2 bind-stack-underflow if ! bit frame-bindings-bit unbind-too-many a-temp-2 <- mem[vma] ; locative to value cell a-temp <- mem[%binding-stack-pointer - 1] ; old value bind-write b-temp-2 <- mem[a-temp-2] store-contents a-temp cdr b-temp-2 ;store back old value, preserving cdr if ! bit more-bindings-flag a-temp-2 frame-bindings-bit <- 0 %binding-stack-pointer <- %binding-stack-pointer - 2 frame-cleanup-bind-stack-unwind if bit frame-bindings-bit call-unbind-1 frame-cleanup-bind-stack-unwind ; number of values in a-temp and b-temp blt-values-down a-temp-2 <- frame-previous-top a-temp-prev-frame <- frame-previous-frame frame-pointer <- stack-pointer - b-temp b-temp-2 <- stack-pointer stack-pointer <- a-temp-2 blt-stack blt-stack frame-pointer <- frame-pointer + 1 if frame-pointer > b-temp-2 return pushval-with-cdr amem[frame-pointer] jump blt-stack restart-pc new-pc pc <- new-pc accept-restart-pc pc++ Macros ------ top-of-stack-a a-memory[stack-pointer] next-on-stack a-memory[stack-pointer-1] frame-function a-memory[frame-pointer-1] frame-misc-data a-memory[frame-pointer-2] args, dtp-fix frame-return-pc a-memory[frame-pointer-3] pc, dtp-even-pc frame-previous-top a-memory[frame-pointer-4] dtp-locative frame-previous-frame a-memory[frame-pointer-5] frame misc data ---------------- ;frame-number-of-args (frame-misc-data & 0x003f) ;frame-cleanup-bits (frame-misc-data & 0x07c0) frame-number-of-args (frame-misc-data & 0x00ff) frame-cleanup-bits (frame-misc-data & 0xff00) frame-buffer-underflow-bit (frame-misc-data & 0x0100) frame-unsafe-reference 1<<9 frame-catch-bit 1<<10 frame-bindings-bit 1<<11 frame-trace-bit 1<<12 frame-meter-bit 1<<13 frame-bottom-bit 1<<14 frame-consed-bit 1<<15 frame-lexical-called 1<<24 frame-lexpr-called 1<<25 frame-instance-called 1<<26 frame-funcalled 1<<27 frame-part-done 1<<28 frame-cleanup-in-progress 1<<29 frame-thrown-through 1<<30 frame-argument-format 3<<24 stack frame: ---------- -5 prev frame ptr ---------- -4 prev top (cdr-code = frame-value-disposition) ---------- -3 return pc ---------- -2 misc data ---------- -1 function ---------- fp -> usually 1st arg a-memory -------- quote-nil value (set-type 0 dtp-nil) Macrocode Instructions ---------------------- push-indirect 100 indirect-operand push indirect frame value onto stack vma <- frame-function - operand -1 pushmemind val <- mem[frame-function - operand - 1] val <- mem[val] cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-constant 101 constant-operand push frame value onto stack pushval mem[frame-function - operand - 1] val <- mem[frame-function - operand - 1] cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-local 102 address-operand push local frame/stack value onto stack pushval local-operand offset = isn<6:0> if isn<7> == 1 amem-addr <- sp - sign-extend(offset) else amem-addr <- fp + offset val <- amem[amem-addr] cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-immed 103 signed-immediate-operand pushval set-type signed-immediate dtp-fix val <- sign-extend(operand) set-type(val) <- dtp-fix cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-address-local 104 address-operand push local frame/stack relative address if sign-extend & 0x80 ;stack-relative pushval set-type stack-pointer + signed-immediate + 1 dtp-locative done ;frame-relative pushval set-type frame-pointer + signed-immediate dtp-locative done if isn<7> == 1 val <- stack-pointer + sign-extend(operand) + 1 ;stack-relative else val <- frame-pointer + sign-extend(operand) ;frame-relative set-type(val) <- dtp-locative cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-from-beyond-multiple 105 unsigned-immediate-operand push stack value from previous frame b-temp <- top-of-stack-a + operand + 1 xbas <- stack-pointer - b-temp pushval amem[xbas] ; add size of multiple grop at top of stack to operand addr <- stack-pointer - a-memory[stack-pointer] + operand + 1 val <- amem[addr] set-type(val) <- dtp-fix cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val movem-local 106 address-operand,needs-stack local-operand <- top-of-stack if isn<7> == 1 amem-addr <- sp - sign-extend(offset) else amem-addr <- fp + offset amem[amem-addr] <- top-of-stack movem-indirect 107 indirect-operand,needs-stack pushval top-of-stack pop-indirect val <- top-of-stack set-type(val) <- dtp-fix cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val addr <- memory[frame-function - operand - 1] addr <- memory[addr] memory[addr] <- a-memory[stack-pointer] tag[addr] <- merge-cdr a-memory-tag[stack-pointer] tag[addr] top-of-stack <- a-memory[--stack-pointer] pop-local 110 address-operand,needs-stack local-operand <- popval if isn<7> == 1 amem-addr <- sp - sign-extend(offset) else amem-addr <- fp + offset top-of-stack <- a-memory[--stack-pointer] amem[amem-addr] <- top-of-stack pop-indirect 111 indirect-operand,needs-stack pop top of stack, write to indirect memory, leave memory's cdr code unchanged vma <- frame-function - operand - 1 popmemind addr <- memory[frame-function - operand - 1] addr <- memory[addr] memory[addr] <- a-memory[stack-pointer] tag[addr] <- merge-cdr a-memory-tag[stack-pointer] tag[addr] top-of-stack <- a-memory[--stack-pointer] push-character 112 unsigned-immediate-operand,operand-character not in original microcode; push-n-nils 120 unsigned-immediate-operand does pushval quote-nil, operand times repeat operand times pushval quote-nil repeat operand times val <- quote-nil set-type(val) <- dtp-fix cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-nil 1120 no-operand not in original microcode; looks likes "push-n-nils 1" pushval quote-nil val <- quote-nil set-type(val) <- dtp-fix cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-2-nils 1230 no-operand not in original microcode; looks likes "push-n-nils 2" does pushval quote-nil, pushval quote-nil pushval quote-nil pushval quote-nil repeat 2 times val <- quote-nil set-type(val) <- dtp-fix cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val push-t 1231 no-operand ;not in original microcode val <- quote-t set-type(val) <- dtp-fix cdr-code(val) <- cdr-next mem[++stack-pointer] <- val top-of-stack <- val pop-n 121 unsigned-immediate-operand stack-pointer <- stack-pointer - operand jump fixup-tos stack-pointer <- stack-pointer - operand top-of-stack <- a-memory[stack-pointer] pop-n-save-1 122 unsigned-immediate-operand,needs-stack stack-pointer <- stack-pointer - operand a-memory[stack-pointer] <- top-of-stack pop-n-save-m 123 unsigned-immediate-operand,needs-stack) a-temp <- frame-pointer stack-pointer-- frame-pointer <- stack-pointer - operand b-temp-2 <- stack-pointer stack-pointer <- frame-pointer - top-of-stack call blt-stack frame-pointer <- at-temp pop-n-save-multiple 124 unsigned-immediate-operand,needs-stack a-temp <- frame-pointer frame-pointer <- stack-pointer - top-of-stack - 1 b-temp-2 <- stack-pointer ; range to save stack-pointer <- frame-pointer - operand call blt-stack frame-pointer <- a-temp pop-multiple-save-n 125 unsigned-immediate-operand a-temp <- frame-pointer frame-pointer <- stack-pointer - operand - 1 b-temp-2 <- stack-pointer ; range to save b-temp <- 1 + a-memory[frame-pointer] ; size of multiple stack-pointer <- frame-pointer - b-temp call blt-stack frame-pointer <- a-temp fixup-tos 1160 no-operand top-of-stack <- a-memory[stack-pointer] top-of-stack <- a-memory[stack-pointer] pop-multiple-save-multiple 1161 no-operand,needs-stack a-temp <- frame-pointer frame-pointer <- stack-pointer - top-of-stack - 1 b-temp-2 <- stack-pointer ; range to save b-temp <- 1 + a-memory[frame-pointer] ; size of multiple stack-pointer <- frame-pointer - b-temp call blt-stack frame-pointer <- a-temp push-car-local 255 address-operand ?? push-cdr-local 256 address-operand ?? push-instance-variable 130 unsigned-immediate-operand,operand-instance-variable check-arg-type self-mapping-table self-mapping-table dtp-array if equal-typed-pointer self-mapping-table b-cached-mapping-table call fast-mapping-table-lookup else call slow-mapping-table-lookup pushval memory[vma] movem-instance-variable,131,unsigned-immediate-operand,needs-stack|operand-instance-variable) pop-instance-variable,132,unsigned-immediate-operand,needs-stack|operand-instance-variable) push-address-instance-variable,133,unsigned-immediate-operand,operand-instance-variable) push-instance-variable-ordered,134,unsigned-immediate-operand,operand-instance-variable) movem-instance-variable-ordered,135,unsigned-immediate-operand,needs-stack|operand-instance-variable) pop-instance-variable-ordered,136,unsigned-immediate-operand,needs-stack|operand-instance-variable) push-address-instance-variable-ordered,137,unsigned-immediate-operand,operand-instance-variable) %instance-ref 230 unsigned-immediate-operand check-arg-type instance top-of-stack-a dtp-instance vma <- top-of-stack-a call instance-size error-if greater-fixnum-unsigned macro-unsigned-immediate a-temp illegal-subscript vma <- top-of-stack-a + operand jump newtopmem ... vma <- a-memory[stack-pointer] ... addr <- a-memory[stack-pointer] + operand val <- memory[addr] cdr-code(val) <- cdr-next a-memory[stack-pointer] <- val top-of-stack <- val %instance-loc,231,unsigned-immediate-operand) %instance-set,232,unsigned-immediate-operand) bind-specvar,140,indirect-operand) bind-locative,1140,no-operand) unbind-n,141,unsigned-immediate-operand) %save-binding-stack-level,1141,no-operand) %restore-binding-stack-level 1142 no-operand check-data-type top-of-stack-a dtp-locative b-temp <- top-of-stack-a popval jump pop-binding-stack-to-b-temp pop-binding-stack-to-b-temp if %binding-stack-pointer == b-temp return call-unbind-1 pop-binding-stack-to-b-temp optional-arg-supplied-p,142,unsigned-immediate-operand,operand-argument-number) append-multiple-groups,1143,no-operand,needs-stack) take-arg,143,unsigned-immediate-operand) require-args,144,unsigned-immediate-operand,needs-stack|smashes-stack) take-values 145 ,unsigned-immediate-operand ; pick up multiple values left on stack check-arg-type top-of-stack top-of-stack-a dtp-fix if equal-fixnum top-of-stack-a macro-unsigned-immediate popval next-instruction b-temp <- top-of-stack-a - macro-unsigned-immediate decrement-stack-pointer if b-temp >= 0 ? stack-pointer <- stack-pointer - b-temp top-of-stack <- amem[stack-pointer] next-instruction ;not enough values, push nils push-missing-values push-missing-values b-temp <- b-temp + 1 if b-temp >= 0 pushval quote-nil next-instruction pushval quote-nil jump push-missing-values take-keyword-argument 146 address-operand,needs-stack ;not in original microcode take-n-args 150 unsigned-immediate-operand general-take-args macro-unsigned-immediate nil nil nil take-n-args-rest 151 unsigned-immediate-operand general-take-args macro-unsigned-immediate macro-unsigned-immediate nil t take-rest-arg 152 unsigned-immediate-operand ; pointer to last argument + 1 a-temp <- frame-pointer - 5 dispatch-after-next frame-argument-format %frame-arguments-normal a-nargs <- frame-number-of-args jump take-rest-arg-1 %frame-arguments-lexpr a-temp <- a-temp - 1 a-nargs <- frame-number-of-args - 1 jump take-rest-args-lexpr-1 %frame-arguments-instance a-nargs <- frame-number-of-args + 2 error-if unsigned-immediate < 2 function-is-not-a-method jump take-rest-arg-lexpr-1 %frame-arguments-lexpr-instance a-temp <- a-temp - 1 a-nargs <- frame-number-of-args + 1 error-if unsigned-immediate < 2 function-is-not-a-method jump take-rest-arg-lexpr-1 take-rest-arg-1 ; # of args that go into the rest arg b-temp <- a-nargs - unsigned-immediate - 1 if a-nargs > unsigned-immediate a-memory[frame-pointer - 6] <- set-cdr a-memory[frame-pointer - 6] cdr-nil pushval set-type a-temp - b-temp - 1 dtp-list else pushval quote-nil take-rest-arg-lexpr-1 ;Get the number of arguments that go into the rest arg b-temp <- a-nargs - macro-unsigned-immediate - 1 ;Enough arguments for the rest argument to be embedded in the args? if greater-fixnum-unsigned a-nargs macro-unsigned-immediate ;Yes, return pointer into caller's copy of args amem[frame-pointer -7] <- set-cdr amem[frame-pointer -7] cdr-normal pushval set-type a-temp - b-temp - 1 dtp-list ;Get here if there were exactly the desired number of spread arguments. There ;can't be fewer, because either the desired number is 0 or a require-args ;instruction has been executed previously. pushval amem [frame-pointer -6] take-n-optional-args,153,unsigned-immediate-operand) take-n-optional-args-rest,154,unsigned-immediate-operand) take-m-required-n-optional-args,155,unsigned-immediate-operand,needs-stack|smashes-stack) take-m-required-n-optional-args-rest,156,unsigned-immediate-operand,needs-stack|smashes-stack) branch 160 signed-pc-relative,branch set-pc pc-add pc signed-operand pc <- pc + signed-extend(operand) branch-true 161 signed-pc-relative,branch-if-not if ! data-type top-of-stack-a dtp-nil set-pc pc-add pc signed-operaand popval val <- a-memory[stack-pointer] if data-type(val) != dtp-nil pc <- pc + signed-extend(operand) top-of-stack <- a-memory[--stack-pointer] branch-false 162 signed-pc-relative,branch-if if data-type top-of-stack-a dtp-nil set-pc pc-add pc signed-operaand popval val <- a-memory[stack-pointer] if data-type(val) == dtp-nil pc <- pc + signed-extend(operand) top-of-stack <- a-memory[--stack-pointer] branch-true-else-pop 163 signed-pc-relative,branch-if-not if ! data-type top-of-stack-a dtp-nil goto branch else popval val <- a-memory[stack-pointer] if data-type(val) != dtp-nil pc <- pc + signed-extend(operand) else top-of-stack <- a-memory[--stack-pointer] branch-false-else-pop 164 signed-pc-relative,branch-if if data-type top-of-stack-a dtp-nil goto branch else popval val <- a-memory[stack-pointer] if data-type(val) == dtp-nil pc <- pc + signed-extend(operand) else top-of-stack <- a-memory[--stack-pointer] branch-true-and-pop 165 signed-pc-relative,branch-if-not if ! data-type top-of-stack-a dtp-nil goto branch popval val <- a-memory[stack-pointer] if data-type(val) != dtp-nil pc <- pc + signed-extend(operand) top-of-stack <- a-memory[--stack-pointer] branch-false-and-pop 166 signed-pc-relative,branch-if if data-type top-of-stack-a dtp-nil goto branch popval val <- a-memory[stack-pointer] if data-type(val) == dtp-nil pc <- pc + signed-extend(operand) top-of-stack <- a-memory[--stack-pointer] branch-eq 176 signed-pc-relative,needs-stack,branch-if-not stack-pointer-- if equal-typed-ponter next-on-stack top-of-stack set-pc pc-add pc signed-operaand popval branch-not-eq 177 signed-pc-relative,needs-stack,branch-if stack-pointer-- if not-equal-typed-pointer next-on-stack top-of-stack set-pc pc-add pc signed-operaand popval branch-atom 200 signed-pc-relative,branch-if-not ;not in original microcode branch-not-atom 201 signed-pc-relative,branch-if ;not in original microcode branch-endp 202 signed-pc-relative,branch-if ;not in original microcode branch-not-endp 203 signed-pc-relative,branch-if-not ;not in original microcode long-branch 167 constant-pc-relative,stop-ifu vma <- frame-function - macro-unsigned-immediate - 1 val <- memory[vma] b-temp <- pc check-data-type memory-data dtp-fix a-temp <- memory-data set-pc pc-add b-temp a-temp long-branch-immed 157 unsigned-immediate-operand,stop-ifu|operand-long-branch-low-byte ;not in original microcode ; here's a guess addr <- a-memory[stack-pointer] + operand error-if-true,1162,no-operand,needs-stack) error-if-false,1163,no-operand,needs-stack) catch-open-ignore,170,unsigned-pc-relative,needs-stack) catch-open-stack,171,unsigned-pc-relative,needs-stack) catch-open-return,172,unsigned-pc-relative,needs-stack) catch-open-multiple,173,unsigned-pc-relative,needs-stack) unwind-protect-open,174,unsigned-pc-relative) catch-close,175,unsigned-immediate-operand) catch-close-multiple,1170,no-operand) call-0-ignore 300 indirect-operand,stop-ifu indirect-operand common-call-processing effect 0 get-elink-operand funcall-0-ignore? common-call-processing value-disposition nargs fcn pushval set-type frame-pointer dtp-locative pushval-with-cdr set cdr field to 0,1,2,3 based on (effect value return multiple-value) value-disposition set-type stack-pointer - (nargs + 2) dtp-locative pushval pc pushval set-type nargs dtp-fix pushval fcn if data-type fcn != dtp-compiled-function error call of non-function pc <- set-type (pointer-field fcn) dtp-odd-pc frame-pointer <- stack-pointer + 1 if stack-pointer > stack-limit take-post-trap stack-buffer-overflow-handler resume-common-call-processing-nargs resume-common-call-processing-nargs ; entry instruction mem <- mem-read pc ; argdesc <- ... ; if (nargs < car argdesc or nargs > cdr argdesc) error wrong number of args ; if (mem & 0x0f00) == 0 ? if nargs > car argdesc pc <- pc + (nargs - car argdesc) ; copy the arguments for argno = 0 to nargs-1 pushval a-memory[ frame-pointer + (argno - (nargs + 5)) ] get-elink-operand addr <- frame-function - operand - 1 val <- memory[addr] val <- memory[val] call-0-stack 301 indirect-operand,stop-ifu call-indirect stack 0 call-indirect ;read of pointer to function call vma <- frame-function - unsigned-immediate-operand - 1 ;push previous-frame base poiner a-memory[stack-pointer + 1] <- set-cdr ? 0d8 set-type DTP_LOCATIVE frame-pointer a-memory[stack-pointer + 2] <- set-cdr set-type stack-pointer - (nargs==N ? top-of-stack : nargs) dtp-locative find-position-in-list value-disposition (ignore stack return multiple) stack-pointer++ jump call-indirect-nargs call-indirect-part-2 a-memory[stack-pointer + 3] <- return pc a-memory[stack-pointer + 4] <- set-cdr set-type nargs==N ? top-of-stack : nargs dtp-fix 0 a-memory[stack-pointer + 5] <- set-cdr func-ptr 0 call-0-return 302 indirect-operand,stop-ifu call-indirect return 0 call-0-multiple 303 indirect-operand,stop-ifu call-indirect mutiple 0 call-1-ignore 304 indirect-operand,stop-ifu call-indirect ignore 1 call-1-stack 305 indirect-operand,stop-ifu call-indirect stack 1 call-1-return 306 indirect-operand,stop-ifu call-indirect return 1 call-1-multiple,307,indirect-operand,stop-ifu) call-2-ignore 310 indirect-operand,stop-ifu call-indirect ignore 2 call-2-stack 311 indirect-operand,stop-ifu call-indirect stack 2 call-2-return,312,indirect-operand,stop-ifu) call-2-multiple,313,indirect-operand,stop-ifu) call-3-ignore 314 indirect-operand,stop-ifu call-indirect ignore 2 call-3-stack 315 indirect-operand,stop-ifu call-indirect stack 3 call-3-return,316,indirect-operand,stop-ifu) call-3-multiple,317,indirect-operand,stop-ifu) call-4-ignore 320 indirect-operand,stop-ifu call-indirect ignore 4 call-4-stack,321,indirect-operand,stop-ifu) call-4-return,322,indirect-operand,stop-ifu) call-4-multiple,323,indirect-operand,stop-ifu) call-n-ignore,324,indirect-operand,needs-stack|stop-ifu) call-n-stack,325,indirect-operand,needs-stack|stop-ifu) call-n-return 326 indirect-operand,needs-stack|stop-ifu call-indirect return N call-n-multiple,327,indirect-operand,needs-stack|stop-ifu) funcall-0-ignore 1300 no-operand (funcall-stack ignore 0) ; prev previous-frame base pointer val <- frame-function set-type(val) dtp-locative set-cdr(val) 0 a-memory[stack-pointer++] <- val ; push previous-frame top pointer ; cdr code is value disposition val <- stack-pointer - nargs - 1 set-type(val) <- dtp-locative cdr-code(val) <- 0 a-memory[stack-pointer++] <- val stack-pointer++ ; return pc a-memory[stack-pointer++] <- pc ; misc data val <- frame-funccalled a-memory[stack-pointer++] <- val ; function val <- xxx set-cdr(val) <- 0 a-memory[stack-pointer++] <- val val <- stack-pointer + 1 set-type(val) <- dtp-null frame-pointer <- val val <- stack-pointer + 1 set-type(val) <- dtp-null a-pclsr-top-of-stack <- val funcall-stack funcall-stack value-disposition nargs ; push previous-frame top pointer ; cdr code is value disposition amem[stack-pointer+2] <- set-cdr set-type (stack-pointer - nargs) - 1 dtp-locative 0 1 2 3 based on value-disposition (ignore stack return multiple) xbas <- amem[stack-pointer+2] stack-pointer++ jump funcall-stack- funcall-stack-0 funcall-stack-part-2 0 funcall-stack-part-2 ; prev previous-frame base pointer amem[stack-pointer] <- set-cdr set-type frame-function dtp-locative 0 stack-pointer++ ; return pc store-return-pc amem[stack-pointer + 1] stack-pointer++ ; misc data amem[stack-pointer + 1] <- set-cdr set-type frame-funcalled + nargs? dtp-fix 0 stack-pointer++ ; function amem[stack-pointer + 1] <- set-cdr amem[xbas + 1] 0 trap if ! data-type amem[xbas + 1] dtp-compiled-function funcall-funny-function-trap function-entry-instruction-fetch amem[xbas + 1] frame-pointer <- set-type stack-pointer + 1 dtp-null a-pclsr-top-of-stack <- set-type stack-pointer + 1 dtp-null dump call-indirect-disp-0 funcall-0-stack 1301 no-operand (funcall-stack stack no-operand) funcall-0-return 1302 no-operand (funcall-stack return no-operand) funcall-0-multiple 1303 no-operand (funcall-stack multiple no-operand) funcall-1-ignore 1304 no-operand funcall-1-stack,1305,no-operand) funcall-1-return,1306,no-operand) funcall-1-multiple,1307,no-operand) funcall-2-ignore,1310,no-operand) funcall-2-stack 1311 no-operand funcall-2-return,1312,no-operand) funcall-2-multiple,1313,no-operand) funcall-3-ignore,1314,no-operand) funcall-3-stack,1315,no-operand) funcall-3-return,1316,no-operand) funcall-3-multiple,1317,no-operand) funcall-4-ignore,1320,no-operand) funcall-4-stack,1321,no-operand) funcall-4-return,1322,no-operand) funcall-4-multiple,1323,no-operand) funcall-n-ignore,1324,no-operand,needs-stack) funcall-n-stack,1325,no-operand,needs-stack) funcall-n-return,1326,no-operand,needs-stack) funcall-n-multiple,1327,no-operand,needs-stack) funcall-ni-ignore,330,unsigned-immediate-operand,stop-ifu) funcall-ni-stack,331,unsigned-immediate-operand,stop-ifu) funcall-ni-return,332,unsigned-immediate-operand,stop-ifu) funcall-ni-multiple,333,unsigned-immediate-operand,stop-ifu) lexpr-funcall-ignore,334,unsigned-immediate-operand,stop-ifu) lexpr-funcall-stack,335,unsigned-immediate-operand,stop-ifu) lexpr-funcall-return 336 unsigned-immediate-operand,stop-ifu lexpr-funcall return a-pclsr-top-of-stack <- top-of-stack-a top-of-stack <- unsigned-immediate-operand + 1 lexpr-funcall-part-1 return a-memory[stack-pointer + 2] <- set-cdr based on value-disposition (ignore stack return multiple) set-type dtp-locative stack-pointer - top-of-stack - 1 xbas <- obus stack-pointer++ jump lexp-funcall-part-2 lexp-funcall-part-2 ; check if rest arg is nil check-arg-type rest-arg a-memory[stack-pointer - 1] dtp-list dtp-nil if data-type a-memory[stack-pointer - 1] dtp-nil a-memory[stack-pointer] <- a-memory[stack-pointer + 1] top-of-stack <- top-of-stack - 1 stack-pointer-- jump funcal-stack-n ; push previous-frame base pointer a-memory[stack-pointer] <- set-cdr 0 set-type dtp-locative frame-pointer stack-pointer++ ; push return pc store-return-pc amem[stack-pointer + 1] stack-pointer++ ; push misc fields word a-memory[stack-pointer + 1] <- set-cdr 0 set-type ftp-fix byte-mask(frame-funcalled) + byte-mask(frame-lexpr-called) + top-of-stack stack-pointer++ ; push function a-memory[stack-pointer + 1] <- set-cdr 0 a-memory[xbas + 1] trap-if not-data-type a-memory[xbas + 1] dtp-compiled-function funcall-funny-function-trap stack-pointer++ function-entry-instruction-fetch a-memory[xbas + 1] frame-pointer <- stack-pointer + 1 a-pclsr-top-of-stack <- set-type dtp-null stack-pointer + 1 dispatch-after-next entry-instruction-dispatch 0 1 lexpr-funcall-fast-0 2 3 lexpr-funcall-fast-1 4 5 6 lexpr-funcall-fast-2 7 10 11 12 lexpr-funcall-fast-3 13 14 15 16 17 lexpr-funcall-fast-4 trap-if stack-pointer > stack-limit take-jump-trap stack-buffer-overflow-handler preserve-stack lexpr-funcall-multiple,337,unsigned-immediate-operand,stop-ifu) lexpr-funcall-n-ignore,1330,no-operand,needs-stack) lexpr-funcall-n-stack,1331,no-operand,needs-stack) lexpr-funcall-n-return,1332,no-operand,needs-stack) lexpr-funcall-n-multiple,1333,no-operand,needs-stack) call-quick-external,370,quick-external-call,stop-ifu) return-n 371 unsigned-immediate-operand,stop-ifu a-temp <- set-type micro-unsigned-immediate dtp-fix b-temp <- obus jump general-return return-stack 1370 no-operand,needs-stack common-return-processing (top-of-stack) or check-arg-type return-pc frame-return-pc dtp-even-pc dtp-odd-pc pc <- frame-return-pc trap if frame-cleanup-bits ;more complex general-return stack-pointer <- frame-previous-top old-frame-previous-top <- frame-previous-top frame-pointer <- frame-previous-frame switch cdr-code old-frame-previous-top 0 top-of-stack <- top-of-stack-a ; effect 1 pushval top-of-stack ; value 2 pushval top-of-stack ; return clear-stack-adjustment return-stack 3 pushval top-of-stack ; multiple-values pushval (set-type 1 dtp-fix) return-multiple,1371,no-operand) return-nil 1374 no-operand call-quick-internal,372,unsigned-pc-relative,stop-ifu) call-quick-internal-long,373,constant-operand,stop-ifu) popj 1372 no-operand check-arg-type top-of-stack top-of-stack-a dtp-even-pc dtp-odd-pc pc <- top-of-stack-a popval pc <- a-memory[stack-pointer] top-of-stack <- a-memory[--stack-pointer] popj-n,374,unsigned-immediate-operand,stop-ifu) popj-multiple,1373,no-operand,needs-stack) %dispatch-elt 375 unsigned-immediate-operand,needs-stack ;not in original microcode limit = operand table <- a-memory[stack-pointer-1] stack-pointer-- table += top-of-stack newtop memory[table] eq,1200,no-operand,needs-stack) eql,1201,no-operand,needs-stack) not 1202 no-operand if data-type top-of-stack-a dtp-nil goto true1 goto false1 zerop 1203 no-operand,needs-stack check-unary-arithmetic-operator-fast no-operand %arith-op-zerop zerop fzerop if zero-fixnum top-of-stack goto true1 else goto false1 plusp 1204 no-operand,needs-stack check-unary-arithmetic-operator-fast no-operand %arith-op-plusp plus fplusp if plus-fixnum top-of-stack goto true1 else goto false1 minusp 1205 no-operand,needs-stack check-unary-arithmetic-operator-fast no-operand %arith-op-minusp minusp fminusp if minus-fixnum top-of-stack goto true1 else goto false1 check-unary-arithmetic-operator-fast check-fixnum-1arg-a switch type no-operand fixnum-fixnum fixnum-flonum fixnum-extnum if fixnum-overflow goto fixnum-overflow else signal-error fixnum-overflow flonum-fixnum flonum-flonum flonum-extnum if float-version goto float-version else arith-operation-index index jump rith-unary-call-out extnum-fixnum extnum-flonum extnum-extnum arith-operation-index index jump rith-unary-call-out address-operand trap-no-save pushval address-operand jump no-operand-version (minusp) fminusp trap-no-save call fsignum if minus-fixnum top-of-stack goto true1 else goto false1 true1 newtop quote-t false1 newtop quote-nil lessp 1206 no-operand,needs-stack check-binary-arithmetic-operand-fast no-operand %arith-op-lessp lessp flessp stack-pointer-- if lesser-fixnum next-on-stack top-of-stack goto true1 goto false1 greaterp 1207 no-operand,needs-stack check-binary-arithmetic-operand-fast no-operand %arith-op-greaerp greaterp fgreaterp stack-pointer-- if greater-fixnum next-on-stack top-of-stack goto true1 goto false1 equal-number 1210 no-operand,needs-stack check-binary-arithmetic-operand-fast no-operand %arith-op-equal-number equal-number fequal stack-pointer-- if equal-fixnum next-on-stack top-of-stack goto true1 goto false1 atom 1211 no-operand if data-type top-of-stack-a dtp-list goto fals1 goto true1 fixp,1212,no-operand) single-float-p,1213,no-operand) numberp 1214 no-operand if data-type top-of-stack-a dtp-fix or dtp-float or dtp-extended-number goto true1 goto false1 symbolp 1215 no-operand if data-type top-of-stack-a dtp-symbol or dtp-nil goto true1 goto false1 arrayp 1216 no-operand if data-type top-of-stack-a dtp-array goto true1 goto false1 cl-listp,1217,no-operand) endp,1220,no-operand) double-float-p,1221,no-operand) floatp,1222,no-operand) char-equal,1223,no-operand,needs-stack) char=,1224,no-operand,needs-stack) add-stack 1240 no-operand,needs-stack if data-type top-of-stack != dtp-fix || data-type next-of-stack != dtp-fix take-arithmetic-trap add stack pop2push set-type plus-check-overflow unbox-fixnum top-of-stack unbox-fixnum next-on-stack dtp-fix add-local 240 address-operand,needs-stack check-binary-arithmetic-operands-fast address-operand %arith-op-add add-stack fadd add-overflow newtop set-type add-checking-overflow address-operand top-of-stack dtp-fix OR if data-type? top-of-stack != dtp-fix or data-type? local-operand != dtp-fix take-arithmetic-trap 'add 'local newtop set-type plus-check-overflow unbox-fixnum top-of-stack unbox-fixnum local-operand 0 dtp-fix add-immed 241 signed-immediate-operand check-binary-arithmetic-operands-fast signed-immediate-operand %arith-op-add add-stack fadd add-overflow newtop set-type add-checking-overflow top-of-stack-a macro-signed-immediate dtp-fix OR if data-type? top-of-stack != dtp-fix take-arithmetic-trap 'add 'signed-immed newtop set-type plus-check-overflow unbox-fixnum top-of-stack instruction-signed-immediate 0 dtp-fix sub-stack 1241 no-operand,needs-stack check-binary-arithmetic-operands-fast no-operand %arith-op-subtract sub-stack fsub pop2push set-type sub-checking-overflow next-on-stack top-of-stack dtp-fix sub-local 242 ,address-operand,needs-stack check-binary-arithmetic-operands-fast address-operand %arith-op-subtract sub-stack fsub newtop set-type sub-checking-overflow top-of-stack address-operand dtp-fix sub-immed,243,signed-immediate-operand) unary-minus,1242,no-operand) logand-stack 1243 no-operand,needs-stack check-binary-arithmetic-operands-fast no-operand %arith-op-logand logand-stack pop2push set-type logand next-on-stack top-of-stack dtp-fix logior-stack 1244 no-operand,needs-stack check-binary-arithmetic-operands-fast no-operand %arith-op-logior logior-stack pop2push set-type logior next-on-stack top-of-stack dtp-fix logxor-stack 1245 no-operand,needs-stack multiply-stack 1246 no-operand,needs-stack check-fixnum-2args next-on-stack top-of-stack trap-no-save check-binary-arithmetic-operands-fast no-operand %arith-op-multiply multiply-stack fmul mpy-32-32 next-on-stack top-of-stack pop2push set-a-temp nil ;overflow check ;overflow = any bits in high word not equal to sign of low word trap-if a-temp - complemented-sign-bit(top-of-stack) != 0xffffffff multiply-overflow multiply-immed 244 unsigned-immediate-operand check-binary-arithmetic-operands-fast signed-immediate-operand %arith-op-multiply multiply-stack fmul mpy-32-16 top-of-stack-a macro-signed-immediate newtop set-a-temp nil trap-if a-temp - complemented-sign-bit(top-of-stack) != 0xffffffff multiply-overflow ; 32x16 multiply newtop top-of-stack-a * signed-immediate-operand XXX quotient-stack 1263 no-operand,needs-stack integer-divide-setup %arith-op-divide fdiv call trunc2-internal dtp-fix trunc2-internal call divide-subroutine ; check dividend sign if plus-or-zero-fixnum next-on-stack if plus-or-zero-fixnum top-of-stack-a ; divisor return b-low-dividend <- -b-low-dividend return if plus-or-zero-fixnum top-of-stack-a b-low-dividend <- -b-low-dividend else error-if minus-fixnum b-low-dividend unimplemented-arithmetic b-high-dividend <- -b-high-dividend return remainder-stack,1264,no-operand,needs-stack) rational-quotient-stack 1265 no-operand,needs-stack ;not in original microcode integer-divide-setup %arith-op-divide fdiv call trunc2-internal dtp-fix mod-stack,1266,no-operand,needs-stack) increment-local 250 address-operand,tos-unchanged ;not in original microcode if data-type(top-of-stack) != dtp-fix or data-type(local-operand) != dtp-fix take-arithmetic-trap 'increment 'local newtop set-type plus-check-overflow unbox-fixnum top-of-stack unbox-fixnum local-operand dtp-fix decrement-local 251 address-operand,tos-unchanged ;not in original microcode if data-type(top-of-stack) != dtp-fix or data-type(local-operand) != dtp-fix take-arithmetic-trap 'decrement 'local newtop set-type plus-check-overflow unbox-fixnum top-of-stack unbox-fixnum local-operand dtp-fix set-cdr-local 252 address-operand,tos-unchanged ; not in original microcode floor-stack 1451 no-operand,needs-stack ; not in original microcode truncate-stack,1452,no-operand,needs-stack) ceiling-stack 1453 no-operand,needs-stack ; not in original microcode round-stack 1454 no-operand,needs-stack ; not in original microcode ldb-immed 260 10-bit-immediate-operand,operand-byte-pointer check-fixnum-1arg-a top-of-stack-a otherwise take-post-trap ldb-escape preserve-stack newtop set-type ldb top-of-stack-a macro macro dtp-fix ... val <- a-memory[stack-pointer] val <- ldb 10-bit-operand val set-type(val) <- dtp-fix cdr-code(val) <- cdr-next a-memory[stack-pointer] <- val top-of-stack <- val dpb-immed 264 10-bit-immediate-operand,needs-stack|operand-byte-pointer check-fixnum-2args next-on-stack top-of-stack otherwise take-post-trap dpb-escape preserve-stack pop2push set-type dpb next-on-stack macro macro top-of-stack dtp-fix ... val <- a-memory[stack-pointer-1] val1 <- a-memory[stack-pointer] val <- dpb 10-bit-operand val val1 set-type(val) <- dtp-fix cdr-code(val) <- cdr-next a-memory[stack-pointer-1] <- val top-of-stack <- val stack-pointer-- lsh-stack,1260,no-operand,needs-stack) rot-stack,1261,no-operand,needs-stack) ash-stack,1262,no-operand,needs-stack) sign-extend-8,1442,no-operand) sign-extend-16,1443,no-operand) %numeric-dispatch-index,1347,no-operand) %32-bit-plus 1440 no-operand,needs-stack ; not in original microcode %32-bit-difference 1441 no-operand,needs-stack ; not in original microcode %add-bignum-step,1444,no-operand,needs-stack) %sub-bignum-step 1445 no-operand,needs-stack ; not in original microcode %lshc-bignum-step,1446,no-operand,needs-stack) %multiply-bignum-step,1447,no-operand,needs-stack) %divide-bignum-step,1450,no-operand,needs-stack) %convert-single-to-double,1060,no-operand,needs-stack) %convert-double-to-single,1061,no-operand) %convert-double-to-fixnum,1062,no-operand) %convert-fixnum-to-double,1063,no-operand,needs-stack) %convert-single-to-fixnum,1064,no-operand) float,1065,no-operand,needs-stack) %double-floating-compare,1067,no-operand) %double-floating-add,1070,no-operand) %double-floating-sub,1071,no-operand) %double-floating-multiply,1072,no-operand) %double-floating-divide,1073,no-operand) %double-floating-abs,1074,no-operand) %double-floating-minus,1075,no-operand) %double-floating-scale,1076,no-operand) car 1100 no-operand check-data-type top-of-stack-a dtp-list dtp-locative dtp-nil vma <- top-of-stack-a if data-type? top-of-stack-a dtp-nil newtop quote-nil else goto newtopmem cdr 1101 no-operand check-data-type top-of-stack-a dtp-list dtp-locative dtp-nil vma <- top-of-stack-a if data-type? top-of-stack-a dtp-nil newtop quote-nil else val <- memory[vma] if data-type? top-of-stack-a dtp-locative newtop val else if cdr-code? val cdr-next newtop set-type vma+1 dtp-list else vma++ take-dispatch dispatch-after-next (cdr-code memory-data) cdr-nil: newtop quote-nil cdr-normal: val <- memory[vma] newtop val otherwise: signal-error bad-cdr-code rplaca 1102 no-operand,smashes-stack check-data-type next-on-stack dtp-list dtp-locative vma <- next-on-stack rplaca1 val <- memory[vma] b-temp <- top-of-stack-a stack-pointer-- popval ;merge new data with old cdr code a-temp <- merge-cdr b-temp val ;write back the new car memory[vma] <- a-temp rplacd 1103 no-operand,smashes-stack check-data-type next-on-stack dtp-list dtp-locative vma <- next-on-stack if data-type? next-on-stack dtp-locative goto rplaca1 val <- memory[vma] a-temp <- top-of-stack-a stack-pointer-- popval if cdr-code? val cdr-normal vma++ memory[vma] <- a-temp cdr-nil next-instruction ;; This is the abnormal case. Trap out to macrocode to allocate a new ;; 2-word cons cell and forward the old one to it. But first, check ;: for rplacd’ing something to nil, which we can do. if not data-type? a-temp dtp-nil take-post-trap rplacd-escape restore-stack vma <- amem[stack-pointer+1] val <- memory[vma] val <- set-cdr val cdr-nil memory[vma] <- val set,1104,no-operand) symeval,1105,no-operand) fsymeval,1106,no-operand) boundp 1107 no-operand check-data-type top-of-stack-a dtp-symbol dtp-nil vma <- top-of-stack-a + 1 jump check-boundp fboundp 1110 no-operand check-data-type top-of-stack-a dtp-symbol dtp-nil vma <- top-of-stack-a + 2 jump check-boundp check-boundp val <- memory[vma] if data-type(val) dtp-null newtop quote-nil else newtop quote-t location-boundp 1375 no-operand ; not in original microcode ? vma <- top-of-stack-a + 1 val <- memory[vma] if data-type(val) dtp-null newtop quote-nil else newtop quote-t get-pname,1111,no-operand) value-cell-location,1112,no-operand) function-cell-location,1113,no-operand) property-cell-location,1114,no-operand) package-cell-location,1115,no-operand) assq,1116,no-operand,needs-stack) memq,1117,no-operand,needs-stack) get,1121,no-operand,needs-stack) cons,1122,no-operand) ncons,1123,no-operand,) getf-internal,1232,no-operand) member-fast 1236 no-operand,needs-stack ; not in original microcode assoc-fast,1237,no-operand,needs-stack) last,1376,no-operand) length-internal,1377,no-operand) cl-length-internal,1346,no-operand) vector-length,1345,no-operand) float-operating-mode,1124,no-operand) set-float-operating-mode,1125,no-operand,smashes-stack) float-operation-status,1126,no-operand) set-float-operation-status,1127,no-operand,smashes-stack) ftn-ar-1,1144,no-operand,needs-stack) ftn-as-1,1145,no-operand,needs-stack,smashes-stack) ftn-ap-1,1146,no-operand,needs-stack) ftn-load-array-register,1147,no-operand) ftn-double-ar-1,1150,no-operand,needs-stack) ftn-double-as-1,1151,no-operand,needs-stack,smashes-stack) ar-1 1270 no-operand,needs-stack ;format 3, array and subscript are on the stack check-arg-type array next-on-stack dtp-array vma <- next-on-stack b-vma <- next-on-stack memory[vma] check-arg-type subscript top-of-stack-a dtp-fix jump ar-1-common ; ;check-arg-type array next-on-stack dtp-array val <- a-memory[stack-pointer-1] if val.tag != dtp-array exception 'array; b-vma <- next-on-stack ;check-arg-type subscript top-of-stack-a dtp-fix val <- a-memory[stack-pointer] if val.tag != dtp-fix exception 'subscript; ;jump ar-1-common val <- a-memory[stack-pointer-1] #define array-normal-lenth-field(w) ((w) & 0x0003ffff) #define array-dispatch-field(w) ((w) & 0x003c0000) a-temp <- val.word & 0x3ffff; switch (val.word & 0x003c0000) { } %ARRAY-DISPATCH-1-BIT 1 %ARRAY-DISPATCH-2-BIT 2 %ARRAY-DISPATCH-4-BIT 3 %ARRAY-DISPATCH-8-BIT 4 %ARRAY-DISPATCH-16-BIT 5 %ARRAY-DISPATCH-WORD 6 %ARRAY-DISPATCH-SHORT-INDIRECT 7 %ARRAY-DISPATCH-FIXNUM 8 %ARRAY-DISPATCH-BOOLEAN 9 %ARRAY-DISPATCH-LEADER 10 %ARRAY-DISPATCH-SHORT-2D 11 %ARRAY-DISPATCH-CHARACTER 12 %ARRAY-DISPATCH-14 13 %ARRAY-DISPATCH-LONG 14 %ARRAY-DISPATCH-LONG-MULTIDIMENSIONAL 15 %ARRAY-DISPATCH-FAT-CHARACTER 16 ar-1-common declare-memory-timing active-cycle a-temp <- array-normal-lenth-field memory-data byte-r array-index-shift-prom dispatch-after-next array-dispatch-field memory-data %array-dispatch-1-bit: ar-1-ucode 1 %array-dispatch-2-bit: ar-1-ucode 2 %array-dispatch-4-bit: ar-1-ucode 4 %array-dispatch-8-bit: ar-1-ucode 8 %array-dispatch-16-bit: ar-1-ucode 16. %array-dispatch-word: ar-1-ucode Word %array-dispatch-boolean: ar-1-ucode 1 t %array-dispatch-leader: goto ar-1-with-leader %array-dispatch-short-indirect: goto ar-1-hair %array-dispatch-long: goto ar-1-hair otherwise: signal-error unimplemented-or-illegal-array-type vma <- vma + (ldb top-of-stack 27. byte-r) + 1 take-dispatch ar-1-immed 270 unsigned-immediate-operand ;format 1, array is on the stack, subscript is unsigned immediate argument ar-1-local 271 address-operand ;format 2, array is on the stack, subscript is in local variable check-arg-type array top-of-stack-a dtp-array vma <- top-of-stack-a b-vma <- top-of-stack-a start-memory read check-arg-type subscript address-operand dtp-fix pushval address-operand jump ar-1-common as-1,1271,no-operand,needs-stack,smashes-stack) as-1-immed,272,unsigned-immediate-operand,smashes-stack) as-1-local 273 address-operand,smashes-stack ;format 2: value and array on the stack, subscript in local variable check-arg-type array top-of-stack-a dtp-array vma <- top-of-stack-a b-vma <- top-of-stack-a val <- memory[vma] check-arg-type subscript address-operand dtp-fix pushval address-operand jump as-1-common ;value, array and subscript on the stack, array header being fetched, as-1-common ;extract length from header, assuming fast case a-temp <- array-normal-length-field val byte-r <- array-index-shift-prom ;set VMA to word containing array element, assuming fast case, ;but leave B-VMA pointing at the original array header, vma <- vma + (ldb top-of-stack 27. byte-r) + 1 dispatch-after-next array-dispatch-field val %array-dispatch-1-bit as-1-ucode 1 %array-dispatch-2-bit as-1-ucode 2 %array-dispatch-4-bit as-1-ucode 4 %array-dispatch-8-bit as-1-ucode 8 %array-dispatch-16-bit as-1-ucode 16 %array-dispatch-word as-1-ucode Word %array-dispatch-boolean as-1-ucode 1 t %array-dispatch-leader goto as-1-with-leader %array-dispatch-short-indirect goto as-1-hair %array-dispatch-long goto as-1-hair otherwise signal-error unimplemented-or-illegal-array-type array-leader-immed 274 unsigned-immediate-operand ;Format 1: Array on the stack, subscript as unsigned immediate argument check-arg-type array top-of-stack-a dtp-array vma <- top-of-stack-a b-vma <- top-of-stack-a call array-setup-leader vma <- amem[stack-pointer+2] + micro-unsigned-immediate array-ucode-read Word nil macro-unsigned-immediate amem[stack-pointer+3] newtop ;Set up an array leader as a "Q" array. If no leader, make it zero ;long since some things call this to test for the presence of a leader. ;Things that really want a leader will then get an error. ;top-of-stack is not touched, since indirection and offset don’t ;apply to leaders. array-setup-leader ;Fetch first word of array prefix val <- memory[vma] amem[stack-pointer + 1] <- array-register-event-count ;Set up type as Q array-register-dispatch-field <- amem[stack-pointer + 1] %array-register-dispatch-word ;Dispatch on kind (parallel (transport header) (assign b-temp memory-data) ;Initialize length to zero, assuming no leader is present (assign (amem (stack-pointer 3)) (set-type (b-constant 0) dtp-fix)) (dispatch-after-next (array-dispatch-field memory-data) ((%array-dispatch-1-bit %array-dispatch-2-bit %array-dispatch-4-bit %array-dispatch-8-bit %array-dispatch-16-bit %array-dispatch-word %array-dispatch-boolean) (return)) ;Arrays of the first kind ((%array-dispatch-leader) ;Short array with leader (parallel (assign (amem (stack-pointer 3)) (set-type (array-leader-length-field b-temp) dtp-fix)) (return))) ((%array-dispatch-short-indirect %array-dispatch-short-2d) (return)) ;no leader ((%array-dispatch-long %array-dispatch-long-multidimensional) (assign (amem (stack-pointer 3)) ;Long array, may have leader (set-type (array-long-leader-length-field b-temp) dtp-fix)) (parallel (assign (amem (stack-pointer 2)) (set-type (+ vma (array-long-prefix-length-field b-temp)) dtp-fix)) (return))) (otherwise (signal-error unimplemented-or-illegal-array-type)))) ;Set basepointer to word containing first leader element, assuming fast case (parallel (assign (amem (stack-pointer 2)) (set-type (1+ vma) dtp-locative)) (take-dispatch))) array-leader,1272,no-operand,needs-stack) store-array-leader,1273,no-operand,needs-stack,smashes-stack) store-array-leader-immed,275,unsigned-immediate-operand,smashes-stack) %1d-aref,1274,no-operand,needs-stack) %1d-aset,1275,no-operand,needs-stack|smashes-stack) %1d-aloc,1276,no-operand,needs-stack) ap-1 1277 no-operand,needs-stack check-arg-type array next-on-stack dtp-array vma <- next-on-stack b-vma <- next-on-stack call-and-return-to array-setup-id ap-1-hair-a array-setup-1d val <- memory[vma] amem[stack-pointer + 1] <- array-register-event-count jump array-setup-1d-a array-setup-1d-a a-memory-data <- memory[vma] amem[stack-pointer+3] <- set-type array-normal-length-field a-memory-data dtp-fix amem[stack-pointer+2] <- set-type vma+1 dtp-locative dispatch array-dispatch-field a-memory-data %array-dispatch-1-bit array-setupx %array-register-dispatch-1-bit %array-dispatch-2-bit array-setupx %array-register-dispatch-2-bit %array-dispatch-4-bit array-setupx %array-register-dispatch-4-bit %array-dispatch-8-bit array-setupx %array-register-dispatch-8-bit %array-dispatch-16-bit array-setupx %array-register-dispatch-16-bit %array-dispatch-word array-setupx %array-register-dispatch-word %array-dispatch-boolean array-setupx %array-register-dispatch-boolean %array-dispatch-leader array-setup-with-leader %array-dispatch-short-indirect array-setup-short-indirect %array-dispatch-long array-setup-long otherwise signal-error unimplemented-or-illegal-array-type array-setupx type-code array-register-dispatch-field <- amem[stack-pointer+1] type-code ap-1-hair-a if equal-fixnum array-register-dispatch-field amem[stack-pointer+1] %array-register-dispatch-word val <- amem[stack-pointer+2] + top-of-stack set-type val dtp-locative pop2push val else signal-error locative-to-non-word-array ap-leader,1250,no-operand,needs-stack) ar-2,1251,no-operand) as-2,1252,no-operand,smashes-stack) ap-2,1253,no-operand) array-register-event,1254,no-operand,tos-unchanged) setup-1d-array,1255,no-operand,smashes-stack) setup-force-1d-array 1256 no-operand,smashes-stack sp+1 array-register-event-count sp+2 baseptr sp+3 length sp+4 end sp+5 start setup-1d-array-sequential,1257,no-operand) setup-force-1d-array-sequential 1267 no-operand ; not in original microcode sp+1 array sp+2 control sp+3 base (address) sp+4 bound (upper bound) sp+5 offset fast-aref,276,address-operand,needs-stack) fast-aset,277,address-operand,needs-stack|smashes-stack) octet-aref-8,1152,no-operand,needs-stack) octet-aref-16,1153,no-operand,needs-stack) octet-aref,1154,no-operand,needs-stack) octet-aset-8,1155,no-operand,needs-stack|smashes-stack) octet-aset-16,1156,no-operand,needs-stack|smashes-stack) octet-aset,1157,no-operand,needs-stack|smashes-stack) %start,1133,no-operand) %halt 1000 no-operand,tos-unchanged %multiply-double,1001,no-operand,needs-stack) %data-type,1002,no-operand) %pointer 1003 no-operand,needs-stack newtop set-type pointer-field top-of-stack dtp-fix %fixnum,1004,no-operand,needs-stack) %flonum,1005,no-operand,needs-stack) %make-pointer,1006,no-operand) %trap-on-instance,1131,no-operand) %make-pointer-immed 2 unsigned-immediate-operand,operand-data-type newtop dpb-type-field macro-unsigned-immediate top-of-stack-a %make-pointer-immed-offset 3 unsigned-immediate-operand,operand-data-type pop2push set-type next-on-stack + top-of-stack dtp-fix newtop dpb-type-field macro-unsigned-immediate top-of-stack-a %pointer-difference,1007,no-operand,needs-stack) %p-store-contents 1010 no-operand vma <- next-on-stack val <- memory[vma] stack-pointer-- val.tag <- merge-cdr top-of-stack.tag val.tag memory[vma] <- val stack-pointer-- %p-store-tag-and-pointer,1011,no-operand,needs-stack|smashes-stack) %p-contents-as-locative,1012,no-operand,needs-stack) %p-structure-offset 1013 no-operand vma <- next-on-stack val <- memory[vma] b-vma <- next-on-stack ;transport header-or-data pop2push set-type b-vma + top-of-stack-a dtp-locative %p-ldb-immed,10,10-bit-immediate-operand,needs-stack,operand-byte-pointer)) %p-tag-ldb-immed,4,unsigned-immediate-operand,needs-stack|operand-byte-pointer)) %p-dpb-immed 14 10-bit-immediate-operand,needs-stack|operand-byte-pointer vma <- top-of-stack start-memory read write b-temp <- next-on-stack stack-pointer-- popval memory-data dpb b-temp macro macro memory-data start-memory write vma <- top-of-stack memory-data <- memory[vma] ; next-on-stack b-temp <- a-memory[stack-pointer-1] stack-pointer-- ;popval top-of-stack <- a-memory[stack-pointer-1] stack-pointer-- memory-data <- dpb b-temp macro macro memory-data memory[vma] <- memory-data %p-tag-dpb-immed,5,unsigned-immediate-operand,needs-stack|operand-byte-pointer)) char-ldb-immed,20,10-bit-immediate-operand,operand-byte-pointer)) %microsecond-clock 1014 ,no-operand read clock pushval dtp-fix val <- microsecond clock set-type(val) <- dtp-fix a-memory[stack-pointer++] <- val %stack-group-switch,1015,no-operand,needs-stack) %p-store-cdr-and-contents,1016,no-operand,smashes-stack) follow-structure-forwarding,1017,no-operand) follow-cell-forwarding,1020,no-operand) %unsynchronized-device-read,1021,no-operand) %block-store-cdr-and-contents 1022 no-operand,needs-stack|smashes-stack b-temp <- dpb a-memory[stack-pointer -2] 2 6 0 a-temp <- dpb-cdr-field ldb b-temp 2 6 a-memory[stack-pointer - 1] jump block-store-start block-store-start a-temp <- merge-high-tag a-temp - top-of-stack a-temp vma <- a-memory[stack-pointer - 4] jump block-store-fast-loop block-store-fast-loop if lesser-fixnum a-memory[stack-pointer - 3] 8 goto block-store-slow-loop store-contents-with-increment a-temp top-of-stack block stere-contents-with-increment a-temp top-of-stack block store-contents-with-increment a-temp top-of-stack block store-contents-with-increment a-temp top-of-stack block store-contents-with-increment a-temp top-of-stack block store-contents-with-increment a-temp top-of-stack block store-contents-with-increment a-temp top-of-stack block store-contents-with-increment a-temp top-of-stack block a-memory[stack-pointer - 3] set-type (- (amem (stack-pointer -3)) (b-constant 8)) dtp-fix)) a-memory[stack-pointer - 4] set-type (+ (amem (stack-pointer -4)) (b-constant 8)) dtp-locative)) a-memory[stack-pointer - 1] merge-high-tag a-memory[stack-pointer - 1] + dpb top-of-stack 29. 3 0 a-memory[stack-pointer - 1] jump block-store-fast-loop block-store-slow-loop if minus-or-zero-fixnum a-memory[stack-pointer - 3] stack-pointer <- stack-pointer - 5 store-contents-with-increment a-temp top-of-stack block a-memory[stack-pointer - 3] <- set-type a-memory[stack-pointer -3 ] - 1 dtp-fix a-memory[stack-pointer - 4] <- set-type a-memory[stack-pointer - 4] + 1 dtp-locative a-memory[stack-pointer - 1] <- merge-high-tag a-memory[stack-pointer - 1] + top-of-stack a-memory[stack-pointer - 1] jump block-store-slow-loop %block-store-tag-and-pointer,1023,no-operand,needs-stack|smashes-stack) %block-search-eq-internal,1132,no-operand,needs-stack) %p-contents-increment-pointer,24,address-operand) %p-store-contents-increment-pointer,25,address-operand) %p-contents-pointer-decrement,26,address-operand) %p-store-contents-pointer-decrement,27,address-operand,smashes-stack) %io-read-until-bit-test,30,address-operand,needs-stack) %io-read-while-bit-test,31,address-operand,needs-stack) %io-read 32 address-operand %io-write 33 address-operand,smashes-stack store-conditional,1025,no-operand,needs-stack) %bitblt-short-row,1350,no-operand,tos-unchanged) %bitblt-long-row,1351,no-operand,tos-unchanged) %bitblt-long-row-backwards,1352,no-operand,tos-unchanged) %bitblt-decode-arrays,1353,no-operand) push-microcode-escape-constant,6,unsigned-immediate-operand) funcall-microcode-escape-constant,7,unsigned-immediate-operand) restart-trapped-call 1360 no-operand *pc* <- popval resume-common-call-processing frame-number-of-args OR dispatch-after-next frame-argument-format %frame-arguments-normal goto general-call-1 %frame-arguments-lexpr goto restart-lexpr-funcall %frame-arguments-instance goto method-call-1 %frame-arguments-lexpr-instance goto restart-lexpr-method-call a-nargs <- frame-number-of-args b-temp <- frame-number-of-args take-dispatch general-call-1 trap-if not-data-type? frame-function dtp-compiled-function general-call-funny-function function-entry-instruction-fetch frame-function dismatch-after-next ldb a-nargs 3 0 0 goto call-indirect-disp-0 1 goto call-indirect-disp-1 2 goto call-indirect-disp-2 3 goto call-indirect-disp-3 4 goto call-indirect-disp-4 trap-if greater-fixnum a-nargs 4 trap-no-save) declare-memory-timing data-cycle if zero-fixnum entry-instruction-dispatch memory-data keep-function-history call next-instruction signal-error-no-restore-stack wrong-number-of-arguments take-dispatch un-lexpr-funcall,1361,no-operand) stack-dump,1362,no-operand) stack-load,1363,no-operand) %assure-pdl-room,1367,no-operand,needs-stack|smashes-stack) %resume-main-stack-buffer 1364 no-operand ;Discard the state of the auxiliary stack buffer and resume the saved state ;of the main stack buffer. If %sequence-break-pending is set, trap imeadiately. error-if not equal-pointer %current-stack-buffer auxiliary-stack-buffer-address illegal-instruction if not-data-type? %sequence-break-pending dtp-nil %sequence-break-pending <- quote-nil call set-sequence-break %control-stack-low <- %other-control-stack-low %control-stack-limit <- %other-control-stack-limit %binding-stack-low <- %other-binding-stack-low %binding-stack-limit <- %other-binding-stack-limit %binding-stack-pointer <- %other-binding-stack-pointer %catch-block-list <- %other-catch-block-list %current-stack-group-status-bits <- %other-stack-group-status-bits pc <- %other-pc frame-pointer <- %other-frame-pointer stack-pointer <- %other-stack-pointer %current-stack-buffer <- set-type main-stack-buffer-address dtp-fix b-temp <- obus call set-stack-buffer top-of-stack <- top-of-stack-a jump set-stack-buffer-limit ;Tell the hardware to use the stack buffer whose address is in b-temp set-stack-buffer write-dp-control ldb b-temp 2 10. current-dp-control current-dp-control <- obus return set-stack-buffer-limit stack-limit <- set-type %stack-buffer-low + (2000 - 400 - 1) dtp-fix if greater-pointer stack-limit %control-stack-limit stack-limit <- %control-stack-limit %stack-buffer-limit <- stack-limit + 1 %stack-buffer-limit <- set-type %stack-buffer-limit | (*page-size* - 1) dtp-fix return %funcall-in-auxiliary-stack-buffer,1365,no-operand,needs-stack) %audio-start,1354,no-operand,needs-stack) %fep-doorbell,1355,no-operand,tos-unchanged) %disk-start,1356,no-operand,tos-unchanged) %net-wakeup,1357,no-operand,tos-unchanged) %set-ethernet-address,1337,no-operand,smashes-stack) %tape-wakeup,1366,no-operand,tos-unchanged) %read-scc-register,1412,no-operand) %write-scc-register,1413,no-operand) %map-cache-write 1030 no-operand,smashes-stack ;Arguments are vma and word to be written ;We must clobber any previous mapping for that virtual page ;Macracode takes care of any necessary clobbering of PHTC ;The 0 case hsre is a little bit of overkilll we could simply never touch ;the map when there was a miss, and let a refill from PHTC take care of it. (definst %map-cache-write (no-operand smashes-stack) (parallel (check-arg-type 0 next-on-stack dtp-fix) (assign vma next-on-stack) (decrement-stack-pointer)) (parallel (dispatch-after-this map-select-code (check-arg-type 1 (amem (stack-pointer 1)) dtp-fix) ((0) (if (all-ones (amem (stack-pointer 1))) ;Map cache miss. Clearing? (parallel (decrement-stack-pointer) ;Clearing--leave alone (next-instruction)) (parallel (write-lru-map (amem (stack-pointer 1))) ;Writing--put into LRU map (decrement-stack-pointer) (next-instruction)))) ((1) (parallel (write-map-a (amem (stack-pointer 1))) ;Original TOS to map A (decrement-stack-pointer) (next-instruction))) ((2) (parallel (write-map-b (amem (stack-pointer 1))) ;Original TOS to map B (decrement-stack-pointer) (next-instruction))) ((3) (parallel (decrement-stack-pointer) ;Should not get here--ignore (next-instruction)))))) %phtc-read,1031,no-operand) %phtc-write 1032 no-operand,smashes-stack check-arg-type 0 next-on-stack dtp-fix vma <- next-on-stack stack-pointer-- check-arg-type 1 amem[stack-pointer+1] dtp-fix amemory[address-phtc] <- amem[stack-pointer+1] stack-pointer-- %phtc-setup 1033 no-operand,needs-stack|smashes-stack check-fixnum-1arg-b top-of-stack write-lbus-dev 37 1 top-of-stack %current-phtc <- top-of-stack stack-pointer-- %reference-tag-read,1034,no-operand) %reference-tag-write,1035,no-operand,smashes-stack) %scan-reference-tags,1036,no-operand,needs-stack) %gc-tag-read,1037,no-operand) %gc-tag-write,1040,no-operand,smashes-stack) %scan-gc-tags,1041,no-operand,needs-stack) %gc-map-write 1042 no-operand,needs-stack|smashes-stack ;Write into the gc map. Args are virtual address and contents (including odd parity). check-fixnum-2args next-on-stack top-of-stack stack-pointer-- write-gc-map top-of-stack-a top-of-stack stack-pointer-- %meter-on,1043,no-operand,tos-unchanged) %meter-off,1044,no-operand,tos-unchanged) %block-gc-copy,1045,no-operand,smashes-stack) %block-transport,1046,no-operand,needs-stack) %scan-for-oldspace,1047,no-operand,needs-stack) %clear-caches,1050,no-operand,tos-unchanged) %physical-address-cache,1051,no-operand) %set-preempt-pending,1052,no-operand,tos-unchanged) %check-preempt-pending,1053,no-operand,tos-unchanged) %scan-for-ephemeral-space,1027,no-operand,needs-stack) %ephemeralp,1024,no-operand) %clear-instruction-cache,1026,no-operand,tos-unchanged) %scan-for-ecc-error,1130,no-operand,needs-stack) %frame-consing-done,1066,no-operand,tos-unchanged) %allocate-list-block,1054,no-operand,needs-stack) %allocate-structure-block,1055,no-operand,needs-stack) %allocate-list-transport-block,1056,no-operand,needs-stack) %allocate-structure-transport-block,1057,no-operand,needs-stack) %fetch-freevar-n,400,unsigned-immediate-operand,operand-lexical-variable) %fetch-freevar-0,401,address-operand,operand-lexical-variable) %fetch-freevar-1,402,address-operand,operand-lexical-variable) %fetch-freevar-2,403,address-operand,operand-lexical-variable) %fetch-freevar-3,404,address-operand,operand-lexical-variable) %fetch-freevar-4,405,address-operand,operand-lexical-variable) %fetch-freevar-5,406,address-operand,operand-lexical-variable) %fetch-freevar-6,407,address-operand,operand-lexical-variable) %fetch-freevar-7,410,address-operand,operand-lexical-variable) %pop-freevar-n,411,unsigned-immediate-operand,operand-lexical-variable) %pop-freevar-0,412,address-operand,operand-lexical-variable) %pop-freevar-1,413,address-operand,operand-lexical-variable) %pop-freevar-2,414,address-operand,operand-lexical-variable) %pop-freevar-3,415,address-operand,operand-lexical-variable) %pop-freevar-4,416,address-operand,operand-lexical-variable) %pop-freevar-5,417,address-operand,operand-lexical-variable) %pop-freevar-6,420,address-operand,operand-lexical-variable) %pop-freevar-7,421,address-operand,operand-lexical-variable) %movem-freevar-n,422,unsigned-immediate-operand,operand-lexical-variable) %movem-freevar-0,423,address-operand,operand-lexical-variable) %movem-freevar-1,424,address-operand,operand-lexical-variable) %movem-freevar-2,425,address-operand,operand-lexical-variable) %movem-freevar-3,426,address-operand,operand-lexical-variable) %movem-freevar-4,427,address-operand,operand-lexical-variable) %movem-freevar-5,430,address-operand,operand-lexical-variable) %movem-freevar-6,431,address-operand,operand-lexical-variable) %movem-freevar-7,432,address-operand,operand-lexical-variable) array-length 1225 no-operand ; not in original microcode ? array-active-length,1226,no-operand) stringp 1227 no-operand ; not in original microcode %draw-line-loop,1400,no-operand,tos-unchanged) %draw-string-step,433,address-operand) %draw-triangle-segment,1405,no-operand,tos-unchanged) %bitblt-short,1406,no-operand,tos-unchanged) %bitblt-long,1407,no-operand,tos-unchanged) soft-matte-decode-arrays,1430,no-operand) soft-matte-internal,1431,no-operand,tos-unchanged) %block-checksum-copy,1233,no-operand,smashes-stack) %block-32-36-checksum-copy,1234,no-operand,smashes-stack) %block-36-32-checksum-copy,1235,no-operand,smashes-stack) %leave-unwind-protect,1411,no-operand) %set-cdr-code-1 253 address-operand ; not in original microcode %set-cdr-code-2 254 address-operand ; not in original microcode proceed,1600,no-operand) assure-prolog-frame-room,600,unsigned-immediate-operand,needs-stack) push-choice-pointer,1601,no-operand) cut,1602,no-operand,needs-stack) neck-cut,1603,no-operand,smashes-stack) fail,1604,no-operand) fail-if-false,1605,no-operand) fail-if-true,1606,no-operand) %restart-trapped-fail,1611,no-operand) %prolog-meter-on,1626,no-operand,tos-unchanged) %prolog-meter-off,1627,no-operand,tos-unchanged) push-goal,601,indirect-operand) execute-goal,607,indirect-operand) execute-stack,1607,no-operand) dereference-local,610,address-operand) dereference-stack,1610,no-operand) globalize-var,611,unsigned-immediate-operand) globalize-var-for-neck-cut,615,unsigned-immediate-operand) push-var,612,address-operand) push-void,1612,no-operand) push-list,613,unsigned-immediate-operand,operand-push-list-counts) push-list-star,614,unsigned-immediate-operand,operand-push-list-counts) unify-nil,1620,no-operand,smashes-stack) unify-constant,620,constant-operand,smashes-stack) unify-immediate,621,signed-immediate-operand,smashes-stack) unify-local,622,address-operand,smashes-stack) unify-list,623,unsigned-immediate-operand) unify-list-star,624,unsigned-immediate-operand) unify-list-star-1,1624,no-operand)