Symbolics L-machine Macrocode Compendium
Brad Parker <brad@heeltoe.com>
6/03/2004

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
     bit-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
     bit-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 value sin a-temp and b-temp
bit-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

	----------
	prev frame
	----------
	prev top  (cdr-code = frame-value-disposition)
	----------
	return pc
	----------
	misc data
	----------
	function
	----------
fp ->

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)
take-keyword-argument,146,address-operand,needs-stack)
take-n-args,150,unsigned-immediate-operand)
take-n-args-rest,151,unsigned-immediate-operand)

take-rest-arg		152	unsigned-immediate-operand

    dispatch-after-next frame-argument-format
      %frame-arguments-normal
         a-nargs <- frame-number-of-args
	 jump take-rest-args-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

    ; pointer to last argument + 1
    a-temp <- frame-pointer - 5

	frame-misc-data <- a-memory[frame-pointer-2]
	switch (frame-misc-data >> 24) & 3
	  case %frame-arguments-normal

take-rest-arg-1
    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-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-ponter next-on-stack top-of-stack
      set-pc pc-add pc signed-operaand
    popval

branch-atom,200,signed-pc-relative,branch-if-not)
branch-not-atom,201,signed-pc-relative,branch-if)
branch-endp,202,signed-pc-relative,branch-if)
branch-not-endp,203,signed-pc-relative,branch-if-not)
long-branch,167,constant-pc-relative,stop-ifu)
long-branch-immed,157,unsigned-immediate-operand,stop-ifu|operand-long-branch-low-byte),
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
  ;
  argdec <- 
  ...
  ;
  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


   
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-1-stack,305,indirect-operand,stop-ifu)
call-1-return,306,indirect-operand,stop-ifu)
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-2-return,312,indirect-operand,stop-ifu)
call-2-multiple,313,indirect-operand,stop-ifu)
call-3-ignore,314,indirect-operand,stop-ifu)
call-3-stack,315,indirect-operand,stop-ifu)
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-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-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)

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)
greaterp,1207,no-operand,needs-stack)

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)
fixp,1212,no-operand)
single-float-p,1213,no-operand)
numberp,1214,no-operand)
symbolp,1215,no-operand)
arrayp,1216,no-operand)
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)
add-immed,241,signed-immediate-operand)

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)
sub-immed,243,signed-immediate-operand)
unary-minus,1242,no-operand)
logand-stack,1243,no-operand,needs-stack)
logior-stack,1244,no-operand,needs-stack)
logxor-stack,1245,no-operand,needs-stack)
multiply-stack,1246,no-operand,needs-stack)

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 ! all-ones 
      a-temp - complemented-sign-bit top-of-stack
      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)

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)
floor-stack	,,1451,no-operand,needs-stack)
truncate-stack,1452,no-operand,needs-stack)
ceiling-stack,,1453,no-operand,needs-stack)
round-stack	,,1454,no-operand,needs-stack)

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)
cdr,1101,no-operand)
rplaca,1102,no-operand,smashes-stack)
rplacd,1103,no-operand,smashes-stack)
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)
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

    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)
ar-1-local,271,address-operand)
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)
array-leader-immed,274,unsigned-immediate-operand)
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)
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)
setup-1d-array-sequential,1257,no-operand)
setup-force-1d-array-sequential,1267,no-operand)
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)
%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)

%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)
%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)
%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))
%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)
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)
%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)
%phtc-read,1031,no-operand)
%phtc-write,1032,no-operand,smashes-stack)
%phtc-setup,1033,no-operand,needs-stack|smashes-stack)
%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)
%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)
array-active-length,1226,no-operand)
stringp,1227,no-operand)
%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)
