Symbolics L-machine Macrocode Compendium
Brad Parker <brad@heeltoe.com>
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-<nargs>

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)
