ifuncom1.ppcs

;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*-

;(include-header "aihead.s")
;(include-header "aistat.s")
;(include-header "ifunhead.s")

(comment "The most commonly used instructions, part 1. ")

;;; The functions in this file are pretty much in order of usage count for
;;; a set of representative "benchmarks" (compiler, window system, UI).
;;; The exception to the ordering is that sometimes short procedures are
;;; placed just before another longer one that will be tail-called, in
;;; order to get better instruction fetching behavior.


;;; From IFUNMOVE.PPCS

;; Really this is :operand-from-stack-immediate, but we can save some
;; crucial cycles by doing the loads here inline.  Not only that, but we
;; even do the NextInstruction here, which saves us three cycles over
;; branching to NextInstruction.  Since PushFP accounts for nearly 1/10
;; of all instructions executed, this is nothing to sneeze at.
(define-instruction |DoPush| :operand-from-stack (:own-immediate t)
    (GetNextPC)
    (ADDI iSP iSP 8 "Push the new value")
    (GetNextCP)
    (stack-read2 arg1 t1 t2 "Get the tag/data" :signed t)
    (stack-write-data iSP t2 "Store the data word")
    (force-alignment)
    (TagType t1 t1 "make it CDR NEXT")
    (stack-write-tag iSP t1 "Store the TAG - this *DOES* dual issue!")
    ;; Falls through to cacheValid
)

;; From idispat, this is here so DoPush can fall into it, saving a
;; branch and cycle
(define-procedure |nextInstruction| ()
  (label cacheValid)
    (LD arg3 CACHELINE_INSTRUCTION (iCP) "Grab the instruction/operand while stalled")
    (ADDI arg1 iFP 0                "Assume FP mode")
    (LD t2 CACHELINE_PCDATA (iCP)  "Get the PC to check cache hit.")
    (ADDI arg4 iSP -8              "SP-pop mode constant")
  (label continuecurrentinstruction)
    (LD t3 CACHELINE_CODE (iCP)    "Instruction handler")
    (MTSPR 9 t3                    "Put into CTR register for later dispatch")
    (ADDI arg5 iSP #.(* -255 8)    "SP mode constant")
    (STD iSP PROCESSORSTATE_RESTARTSP (ivory) "Need this in case we take a trap")
    (extrdi t4 arg3 8 16	   "Get the mode bits")
    (SUBF t2 iPC t2                "check for HIT.")
    (LD arg6 0 (iSP)               "Load TOS in free di slot")
    (extrdi arg2 arg3 8 24         "Extract (8-bit, unsigned) operand")
    (branch-if-nonzero t2 TakeICacheMiss          "PC didn't match, take a cache miss")
    (ANDI-DOT R31 t4 1)
    (BC 12 2 skip23 "B.EQ")
    (mov arg1 iLP "LP or Immediate mode")
   (unlikely-label skip23)
    (passthru "#ifdef DEBUGGING")
    (branch-if-zero t3 haltmachine "Just in case...")
    (passthru "#endif")
    (passthru "#ifdef TRACING")
    (maybe-icount t2)
    (maybe-trace t2 t3 t4 t5 t6 t7)
    (passthru "#endif")
    (passthru "#ifdef STATISTICS")
    (maybe-statistics t2 t3 t4 t5 t6 t7)
    (passthru "#endif")
    (passthru "#ifdef CACHEMETERING")
    (maybe-meter-hit t2 t3 t4 t5 t6 t7)
    (passthru "#endif")
    (passthru "#ifdef DEBUGGING")
    (passthru "#if DEBUGGING == 1")
    (clr  t1) (clr  t2) (clr  t3) (clr  t4)
    (clr  t5) (clr  t6) (clr  t7) (clr  t8)
    (clr  t9) (clr t10) (clr t11) (clr t12)
    (clr  r0) (clr r31)
    (passthru "#else")
    (li  t1 DEBUGGING) (li  t2 DEBUGGING) (li  t3 DEBUGGING) (li  t4 DEBUGGING)
    (li  t5 DEBUGGING) (li  t6 DEBUGGING) (li  t7 DEBUGGING) (li  t8 DEBUGGING)
    (li  t9 DEBUGGING) (li t10 DEBUGGING) (li t11 DEBUGGING) (li t12 DEBUGGING)
    (li  r0 DEBUGGING) (li r31 DEBUGGING)
    (passthru "#endif")
    (passthru "#endif")

    (BCCTR 20 0 "Jump to the handler") ; t3

    (comment "Here to advance the PC and begin a new instruction.  Most")
    (comment "instructions come here when they have finished.  Instructions")
    (comment "that explicitly update the PC (and CP) go to interpretInstruction.")
  (label nextInstruction)
    (LD iPC CACHELINE_NEXTPCDATA (iCP) "Load the next PC from the cache")
    (LD iCP CACHELINE_NEXTCP (iCP) "Advance cache position")
    (B cacheValid)

  ;; When ICacheFill precedes iInterpret, we put this label here in
  ;; order to get conditional branch prediction right
  #-iCacheMiss-after-iInterpret (label TakeICacheMiss)
    #-iCacheMiss-after-iInterpret (external-branch ICacheMiss)
)

(define-procedure |DoPushImmediateHandler| ()
  (immediate-handler |DoPush|)
    (GetNextPCandCP)
    (stack-push-ir |TypeFixnum| arg2 t4 "Push it with CDR-NEXT onto the stack")
    (ContinueToNextInstruction-NoStall)) 


;;; From IFUNLOOP.PPCS

(define-instruction |DoBranchTrue| :10-bit-signed-immediate (:own-immediate t :needs-tos t)
    (ibranchcond nil t t nil |BranchException|))	;and-pop else-pop
 
(define-instruction |DoBranchFalse| :10-bit-signed-immediate (:own-immediate t :needs-tos t)
    (ibranchcond t t t nil |BranchException|))		;invert and-pop else-pop


;;; From IFUNFCAL.PPCS

;; Register conventions for return instruction:
;;   arg1 is 10-bit immediate (unused)
;;   arg2 is 8-bits of that
;;   arg3 is the return value (with cdr already cleared)
;;   arg4 is the disposition dispatch
;;   arg5 is the control register
;;   arg6 is stack-cache-data (for underflow check)

;; Return completes by branching to StackCacheUnderflowCheck, which goes
;; to NextInstruction after dealing with underflow.  In the for-return
;; case, this re-executes the instruction one frame up.  We only need
;; the low bit of the immediate argument, which is already available in
;; arg2, so we use :own-immediate.
(define-instruction |DoReturnSingle| :10-bit-immediate (:own-immediate t :needs-tos t)
    (comment "Fetch value based on immediate, interleaved with compute disposition dispatch")
    (get-control-register arg5)
    ;; inline (stack-top arg3 :tos-valid t)
    (clrldi arg3 arg6 #.(- 64 38) "Clear cdr")
    (load-constant t3 #.(* 3 1_18) "value disposition mask")
    (get-nil t1)
    (get-t t2)
    (AND t3 t3 arg5 "mask disposition bits")
    (srdi t3 t3 18 "shift disposition bits into place")
    (LD arg6 PROCESSORSTATE_STACKCACHEDATA (ivory))
    (comment "arg2 is 8 bits of \"kludge operand\" 0=TOS 40=NIL 41=T")
    (CMPI 0 1 arg2 0)
    (BC 4 1 skip17 "B.LE")
    (mov arg3 t1)
  (unlikely-label skip17)
    (ADDI arg4 t3 -2 "arg4 -2=effect -1=value 0=return 1=multiple")
    (ANDI-DOT R31 arg2 1)
    (BC 12 2 skip24 "B.EQ")
    (mov arg3 t2)
   (unlikely-label skip24)
    ;; Return-multiple comes here for effect and value cases after
    ;; loading arg3, arg4, arg5, and arg6 appropriately
  (label returncommontail)
    ;; Load's pc if arg4 /= 0
    (abandon-frame-simple (not arg4) arg5 returnsinglecleanup t1 t2 t3 t4 t5 t6 t7)
    (force-alignment)
    (comment "arg4 -2=effect -1=value 0=return 1=multiple")
    (branch-if-zero arg4 returnsinglereturn)
    (ANDI-DOT R31 arg4 1 "BLBC")
    (BC 12 2 returnsingleeffect)
    ;; Cdr already cleared, so we can use raw push here
    (stack-push-with-cdr arg3)
    (branch-if-greater-than-zero arg4 returnsinglemultiple)
  (label returnsingleeffect)
  (label returnsingledone)
    (CMPL 0 1 iFP arg6 "ARG6 = stack-cache underflow")
    (BC 12 0 returnsingleunderflow)
;; Unneeded
;;    (branch-if-zero arg4 returnsingleretry "For return, simply retry")
    (branch-if-zero t7 interpretInstructionForBranch "No prediction, validate cache")
    ;; Duplicate code from (label interpretInstructionPredicted)
    (mov iCP t7)
    (ContinueToInterpretInstruction)
  (label returnsinglemultiple)
    (stack-push-fixnumb 1 t8 "Multiple-value group")
    (B returnsingledone)
  (label returnsinglereturn)
    ;; repush arg only if TOS arg, 
    (branch-if-nonzero arg2 returnsingledone)
    (stack-push-with-cdr arg3)
    (B returnsingledone)
  (label returnsinglecleanup)
    (external-branch handleframecleanup)
  (label returnsingleunderflow)
    (external-branch |StackCacheUnderflowCheck|))


;;; From IFUNFULL.PPCS

(passthru ".globl callindirectprefetch")
#||
(define-instruction |callindirect| :full-word-instruction () 
  (label |callindirectprefetch|)		;the same as |callindirect|
    (clrldi arg2 arg3 32 "Get operand")
    (ANDC arg3 arg3 arg3 "No extra arg")
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (B startcallindirect)
      ))
||#

(passthru ".globl startcallagain") 
(define-instruction |callindirect| :full-word-instruction () 
  (label |callindirectprefetch|)		;the same as |callindirect|
    (clrldi arg2 arg3 32 "Get operand")
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (clr arg3 "No extra arg")
      (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)
      (CheckDataType arg5 |TypeCompiledFunction| startcallagain t5)
      (li arg5 |TypeEvenPC|)
      (push-frame t3 t7 t8 t5 t6)
      (GetNextPCandCP)
      (set-continuation2r arg5 arg6)
      (stzd PROCESSORSTATE_CONTINUATIONCP (Ivory))
      (branch-if-nonzero arg3 |callindirectextra|)
      (ContinueToNextInstruction-NoStall)
      (label |callindirectextra|)
      (LWA t1 PROCESSORSTATE_CONTROL+4 (ivory))
      (load-constant t2 #.1_8 "cr.extra-argument")
      (stack-push2 arg3 arg4 t3 "Push the extra arg.")
      (OR t1 t1 t2 "Set the extra arg bit")
      (STW t1 PROCESSORSTATE_CONTROL+4 (Ivory) "Save control with new state")
      (ContinueToNextInstruction-NoStall)))

;;; From IFUNFCAL.PPCS

;; This handles both the apply and the non-apply cases
(define-instruction |DoFinishCallN| :10-bit-immediate (:own-immediate t)
    (comment "arg2 contains the 8 bit N+1")
    (extrdi arg1 arg3 8 16 "arg1 contains the disposition (two bits)")
    (sldi arg2 arg2 3 "convert N to words (stacked words that is)")
  (label finishcallmerge)
    ;; ARG3 contains opcode, from which we compute apply-p
    (finish-call-guts arg2 arg1 arg3 t1 t2 t3 t4 t5 t6 t7))

(define-instruction |DoEntryRestNotAccepted| :entry-instruction ()
    (srdi t2 arg5 27 "Get the cr.trace-pending bit")
    (ANDI-DOT t1 arg5 #xFF "The supplied args")
    (ANDI-DOT R31 t2 1 "BLBS")
    (BC 4 2 TraceTrap)
    (b-apply-argument-supplied applysupprna t2 t3 t4 arg5)
    (SUBF t2 arg2 t1 "t2=supplied-minimum")
    (branch-if-less-than-zero t2 retryernatoofew "B. if too few args.")
    (SUBF arg1 t1 arg4 "maximum-supplied")
    (branch-if-less-than-zero arg1 retryernatoomany "B. if too many args.")
    (enter-function t2  t3 t4)			;doesn't return
  (label applysupprna)
    (SUBF arg1 t1 arg4)
    ;; Not LT, since the apply arg is at least one argument!  If you
    ;; need to pull 0, you have too many args
    (branch-if-less-than-or-equal-to-zero arg1 retryernatoomany "B. if too many args.")
    ;; Pulls arg1 args and retries the instruction
    (B |PullApplyArgs|)
  (label retryernatoomany)
    (illegal-operand too-many-arguments)
  (label retryernatoofew)
    (illegal-operand too-few-arguments))


;;; This small trampoline is near it's popular callee so you gan get to
;;; the PullApplyArgs tail from xxx-dispatch without a cache miss
(define-procedure |VerifyGenericArity| ()
    (verify-generic-arity arg2 arg5 t11))

;; Not clear where this really belongs.  Kept it here with it's most
;; popular caller

(define-procedure |PullApplyArgs| (arg1)
    ;; W-M-M-R for VMAinStackCache, which is used several times
    (with-multiple-memory-reads (arg3 arg4 arg5 arg6)
      (pull-apply-args arg1 t1 t2 InterpretInstruction t4 t5 t6 t7 t8 t9 t10 t11)))


;;; From IFUNFULL.PPCS

(define-instruction |valuecell| :full-word-instruction () 
    (clrldi arg2 arg3 32 "Get address")
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t))
    (GetNextPCandCP)
    (stack-push2 arg5 arg6 t3 "Push the result")
    (ContinueToNextInstruction-NoStall))

(define-instruction |pushconstantvalue| :full-word-instruction () 
    (GetNextPCandCP)
    (stack-push-with-cdr arg3)
    (ContinueToNextInstruction-NoStall))


;;; From IFUNPRED.PPCS

;; Really operand-from-stack-immediate, but save cycles loading own operand
(define-instruction |DoZerop| :operand-from-stack (:own-immediate t)
    (simple-unary-arithmetic-predicate zerop 4 2 12 2) ; CMOVEQ test is EQ
  ;; This is a VERY common idiom used to push NIL or T using a halfword
  ;; instruction.
  (immediate-handler |DoZerop|)
    (Get-T t2)
    (ADDI iSP iSP 8)
    (Get-NIL t1)
    (GetNextPCandCP)
    (CMPI 0 1 arg2 0)
    (BC 4 2 skip5 "B.NE")
    (mov t1 t2)
   (unlikely-label skip5)
    (stack-write iSP t1 "yes Virginia, we dual issue with above yahoo")
    (ContinueToNextInstruction-NoStall))

(define-instruction |DoSetSpToAddress| :operand-from-stack ()	
    (GetNextPCandCP)
    (mov iSP arg1 "Set iSP=address of operand")
    (ContinueToNextInstruction-NoStall)) 

;;; From IFUNPRED.PPCS

;; DoEqNoPop is handled here, too...
;; Note the |DoEqIM| is in IFUNCOM2.PPCS (yeah, it's wierd)
;; Really operand-from-stack-immediate, but save cycles loading own operand
(define-instruction |DoEq| :operand-from-stack (:own-immediate t :needs-tos t)
    (Get-NIL t11)
    (srdi arg3 arg3 #.(+ 10 2))
    (Get-T t12)
    (stack-read arg1 arg1 "load op2")
    (GetNextPC)
    (ANDI-DOT arg3 arg3 1 "1 if no-pop, 0 if pop")
    (GetNextCP)
    ;; inline (stack-top t3 "Load op1 into t3" :tos-valid t)
    (XOR t3 arg6 arg1 "compare tag and data")
    (sldi t3 t3 #.(- 32 6) "shift off the cdr code")
    (sldi t4 arg3 3)
    (ADD iSP t4 iSP "Either a stack-push or a stack-write")
    (CMPI 0 1 t3 0)
    (BC 4 2 skip6 "B.NE")
    (mov t11 t12 "pick up T or NIL")
   (unlikely-label skip6)
    (stack-write iSP t11)
    (ContinueToNextInstruction-NoStall))

(define-instruction |DoAref1| :operand-from-stack-immediate (:own-immediate t :needs-tos t)
    (stack-top2 arg3 arg4 "Get the array tag/data" :tos-valid t)
    (exts arg2 arg1 32 "arg2=signextend(arg1)")
    (li t8 |AutoArrayRegMask|)
    (AND t8 arg4 t8)
    ;(sldi t8 t8 #.|AutoArrayRegShift|)		; mask is in place, so shift is zero.
    (srdi arg1 arg1 32 "Index Tag")
    (ADDI t7 ivory PROCESSORSTATE_AC0ARRAY)
    (ADD t7 t7 t8 "This is the address if the array register block.")
    (CheckDataType arg1 |TypeFixnum| Aref1Illegal t1 t)
  (label aref1merge)
    (branch-if-zero arg4 |Aref1Regset|) ;+++
    (LD t8 ARRAYCACHE_ARRAY (t7) "Cached array object.")
    ;; Array or String
    (CheckAdjacentDataTypes arg3 |TypeArray| 2  ReallyAref1Exc t1 t)
    (XOR t8 arg4 t8 "t8==0 iff cached array is ours.")
    (branch-true t8 |Aref1Regset| "Go and setup the array register.")
    (passthru "#ifdef SLOWARRAYS")
    (B |Aref1Regset|)
    (passthru "#endif")
    ;; Get control register, base, and length.  Don't need any data types
    ;; since we checked all that when we set up the array register.
    (LD arg6 ARRAYCACHE_ARWORD (t7))
    (LD t9   ARRAYCACHE_LOCAT (t7) "high order bits all zero")
    (LD t3   ARRAYCACHE_LENGTH (t7) "high order bits all zero")
    (clrldi t5 arg6 #.(- 64 |ArrayRegisterEventCountSize|))
    (LD t4 PROCESSORSTATE_AREVENTCOUNT (ivory))
    ;; (check-array-bounds arg2 t3 Aref1Bounds t2)
    (SUBF t6 t5 t4)
    (branch-if-nonzero t6 |Aref1Regset| "J. if event count ticked.")
    (CMPL 0 1 arg2 t3)
    (bclong 4 0 Aref1Bounds)
    (srdi arg5 arg6 #.|ArrayRegisterBytePackingPos|)
    (srdi arg4 arg6 #.|ArrayRegisterByteOffsetPos|)
    (srdi t8 arg6 #.|ArrayRegisterElementTypePos|)
    (ANDI-DOT arg4 arg4 |ArrayRegisterByteOffsetMask|)
    (ANDI-DOT arg5 arg5 |ArrayRegisterBytePackingMask|)
    (ANDI-DOT arg6 t8 |ArrayRegisterElementTypeMask|)
  (label Aref1Restart)
    (new-aref-1-internal arg3 t9 arg5 arg4 arg6 arg2 t1 t2 t3 t5 t6)
  (immediate-handler |DoAref1|)
    (li t8 |AutoArrayRegMask|)
    (stack-top2 arg3 arg4 "Get the array tag/data")
    (ADDI t7 ivory PROCESSORSTATE_AC0ARRAY)
    (AND t8 arg4  t8)
    ;(sldi t8 t8 #.|AutoArrayRegShift| 0)
    (ADD t7 t7 t8 "This is the address of the array register block.")
    (B aref1merge))

(define-instruction |DoTypeMember| :10-bit-immediate (:own-immediate t)
    (itypemember))

;;; From IFUNSUBP.PPCS

;; Really operand-from-stack-immediate, but save cycles loading own operand
(define-instruction |DoPointerPlus| :operand-from-stack (:own-immediate t :needs-tos t)
    (GetNextPCandCP)
    (stack-read-data arg1 t2 "Get the data of op2" :signed t :tos-valid t)
    ;; inline (stack-read-data iSP t1 "Get the data of op1" :signed t :tos-valid t)
    (exts t3 arg6 32)
    (exts t2 t2 32)
    (ADD t3 t3 t2 "(%32-bit-plus (data arg1) (data arg2))")
    (stack-write-data iSP t3 "Put result back on the stack")		
    (ContinueToNextInstruction-NoStall)
  (immediate-handler |DoPointerPlus|)
    (exts t2 arg2 8)
    (GetNextPCandCP)
    (force-alignment)
    ;; inline (stack-read-data iSP t1 "Get the data of op1" :signed t :tos-valid t)
    (exts t3 arg6 32)
    (ADD t3 t3 t2 "(%32-bit-plus (data arg1) (data arg2))")
    (stack-write-data iSP t3 "Put result back on the stack")		
    (ContinueToNextInstruction-NoStall))


;;; From IFUNFEXT.PPCS

;; Must implement this as if it were a ROT followed by a LOGAND as the
;; compiler will generate a LDB instruction instead of a ROT instruction
;; for constant rotations.
(define-instruction |DoLdb| :field-extraction (:needs-tos t)
    (stack-read2 iSP arg3 arg4 "get ARG1 tag/data" :tos-valid t)
    ;; inline (CheckDataType arg3 |TypeFixnum| LdbException t8)
    (TagType arg3 t8)
    (ADDI t9 t8 #.(- |type$K-fixnum|))
    (SLD t3 arg4 arg2 "Shift ARG1 left to get new high bits")
    (long-branch-if-nonzero t9 LdbException "Not a fixnum")	;in |OutOfLineExceptions|
    (load-constant t7 -2)
    (GetNextPC)
    (srdi t6 t3 32 "Get new low bits")
    (GetNextCP)
    (SLD t7 t7 arg1 "Unmask")
    (OR t3 t3 t6 "Glue two parts of shifted operand together")
    (stack-write-tag iSP t8 "T8 is TypeFixnum from above")
    (ANDC t3 t3 t7 "T3= masked value.")
    (stack-write-data iSP t3)
    (ContinueToNextInstruction-NoStall))


;;; From IFUNMOVE.PPCS

#+experiment
;; Also handles DoSetSpToAddressSaveTos
(define-instruction |DoSetSpToAddress| :operand-from-stack ()	
    (GetNextPC)
    (srdi arg3 arg3 10 "LBC iff save tos")
    (GetNextCP)
    (mov iSP arg1 "Set iSP=address of operand")
    (ANDI-DOT R31 arg3 1 "BLBS")
    (BC 4 2 cachevalid)
    ;; inline (stack-read iSP t1 "Read current stack top." :tos-valid t)
    (stack-write arg1 arg6 "Restore the TOS.")
    (ContinueToNextInstruction-NoStall))

(define-instruction |DoSetSpToAddressSaveTos| :operand-from-stack (:needs-tos t)
    (GetNextPCandCP)
    (mov iSP arg1 "Set the stack top as specified.")
    ;; inline (stack-read iSP t1 "Read current stack top." :tos-valid t)
    (stack-write arg1 arg6 "Restore the TOS.")
    (ContinueToNextInstruction-NoStall))

;; --- sp-pop mode can't be valid for this op?
(define-instruction |DoPop| :operand-from-stack (:needs-tos t)
    (GetNextPCandCP)
    ;; inline (stack-pop t3 "Pop the operand" :tos-valid t)
    (ADDI iSP iSP -8 "Pop Stack.")
    (stack-write arg1 arg6 "Store all 40 bits on stack")
    (ContinueToNextInstruction-NoStall))

(define-instruction |DoMovem| :operand-from-stack (:needs-tos t)
    (GetNextPCandCP)
    ;; inline (stack-read iSP t3 "Get TOS" :tos-valid t)
    (stack-write arg1 arg6 "Store all 40 bits of TOS on stack")
    (ContinueToNextInstruction-NoStall)) 

#+experiment
;; Also handles DoPop
(define-instruction |DoMovem| :operand-from-stack (:needs-tos t)
    (GetNextPC)
    (srdi arg3 arg3 10 "LBC iff pop")
    (GetNextCP)
    (ADDI t1 iSP -8 "Maybe pop Stack.")
    ;; inline (stack-read iSP t3 "Get TOS" :tos-valid t)
    (stack-write arg1 arg6 "Store all 40 bits of TOS on stack")
    (ANDI-DOT R31 arg3 1)
    (BC 4 2 skip27 "B.NE")
    (mov iSP t1 "Maybe pop Stack.")
   (unlikely-label skip27)
    (ContinueToNextInstruction-NoStall))


;;; From IFUNMOVE.PPCS

(define-instruction |DoPushAddress| :operand-from-stack ()
    (SCAtoVMA arg1 t1 t2)
    (GetNextPCandCP)
    (stack-push-ir |TypeLocative| t1 t3)
    (ContinueToNextInstruction-NoStall))


;;; From IFUNSUBP.PPCS

;; DoMemoryReadAddress is handled here, too...
(define-instruction |DoMemoryRead| :10-bit-immediate (:needs-tos t)
    (srdi t1 arg3 10 "Low bit clear if memory-read, set if memory-read-address")
    (ANDI-DOT t2 arg1 #x20 "T2 = fixnum check")
    (ANDI-DOT t3 arg1 #x10 "T3 = reset CDR code")
    (srdi arg3 arg1 6 "arg3 = cycle type")
    (stack-read2 iSP arg1 arg2 "Get tag/data" :tos-valid t)
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (memory-read arg2 arg5 arg6 arg3 t5 t6 t7 t8 nil t))
    (branch-if-zero t2 mrdataok "J. if no check for fixnum.")
    ;; --- Should make memory-read do the fixnum check by getting funny
    ;; trap tables
    (CheckDataType arg5 |TypeFixnum| mrnotfixnum t5)
  (label mrdataok)
    (GetNextPC)
    (ANDI-DOT R31 t1 1)
    (BC 12 2 skip25 "B.EQ")
    (mov arg5 arg1 "Get original tag if memory-read-address")
   (unlikely-label skip25)
    (branch-if-zero t3 mrcdrunch "J. if no reset CDR code")
    (TagType arg5 arg5)
  (label mrcdrunch)
    (GetNextCP)
    (ANDI-DOT R31 t1 1)
    (BC 12 2 skip26 "B.EQ")
    (mov arg6 arg2 "Get forwarded address if memory-read-address")
   (unlikely-label skip26)
    (stack-write2 iSP arg5 arg6)
    (ContinueToNextInstruction-NoStall)
  (label mrnotfixnum)
    (illegal-operand %memory-read-transport-and-fixnum-type-check))

;;; From IFUNLOOP.PPCS

(define-instruction |DoBranch| :10-bit-signed-immediate ()
    ;; Cache metering steals ANNOTATION from us
    (passthru "#ifndef CACHEMETERING")
    (LD arg2 CACHELINE_ANNOTATION (iCP))
    (passthru "#endif")
    (ADD iPC iPC arg1 "Update the PC in halfwords")
    ;; Cache metering steals ANNOTATION from us
    (passthru "#ifndef CACHEMETERING")
    (branch-if-nonzero arg2 interpretInstructionPredicted)
    (passthru "#endif")
    (B interpretInstructionForBranch))


;;; From IFUNGENE.PPCS

(define-instruction |DoGenericDispatch| :operand-from-stack ()
    (generic-dispatch arg1 t1 arg3 arg4 t4 t9 t6 t7 arg2 arg5 t3 t2))

;; Takes generic function tag/data in ARG1/t1 and instance tag/data in ARG3/ARG4.
;; Returns mask data in t2, table data in t3, parameter tag/data in T6/T7,
;; and method tag/data in T4/arg3.  Clobbers T1 through T5, and T10.
;; Linkage register is R0
(define-subroutine |LookupHandler| () (r0)
    ;; Note well!  Don't change these memo registers without also fixing
    ;; the call to USING-MULTIPLE-MEMORY-READS in |LookupHandlerMemoryRead|
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (instance-descriptor-info
	arg3 arg4 t2 t3  arg2 arg5 arg6 t5 t6 t7 t8)
      ;; Watch it!  We're clobbering ARG3/ARG4 to save some cycles!
      (lookup-handler
	;; looks bad, but we know t6/t7 are set last thing when they are
	;; no longer needed for temps
	arg1 t1 t3 t2 t6 t7 t4 arg3  arg4 arg2 arg5 arg6 t5 t6 t7 t8))
    (mov t9 arg3)				;sigh
    )

;;; From IFUNSUBP.PPCS

;; Really operand-from-stack-immediate, but save cycles loading own operand
(define-instruction |DoSetTag| :operand-from-stack (:own-immediate t)
    (stack-read2 arg1 t1 arg2 "Get tag/data of op2" :signed t)
    (CheckDataType t1 |TypeFixnum| settagexc t3)
  ;; Sneaky immediate handler
  (immediate-handler |DoSetTag|)
    (GetNextPCandCP)
    (stack-write-tag iSP arg2 "Set TAG of op1")
    (ContinueToNextInstruction-NoStall)
  (label settagexc)
    (illegal-operand one-operand-fixnum-type-error)) 

;;; From IFUNLIST.PPCS

(define-instruction |DoCar| :operand-from-stack ()
    (with-multiple-memory-reads (t9 t10 t11 t12)
      ;; (icar arg1  arg5 arg6 arg2 t2 t3 t4 t5 t6 t7 t8)
      (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t)
      #+list-inline (car-internal arg5 arg6 car arg2 t5 t6 t7 t8 t)
      #-list-inline (call-subroutine |CarInternal|)
      (stack-push2 arg5 arg6 t5)
      (ContinueToNextInstruction)))

#-list-inline
;; --- All the temps aren't really arguments, but they are smashed
(define-subroutine |CarInternal|
		   (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12)
		   (r0)
  (using-multiple-memory-reads (t9 t10 t11 t12)
    (car-internal arg5 arg6 car arg2 t5 t6 t7 t8))) 

(define-instruction |DoCdr| :operand-from-stack ()
    (with-multiple-memory-reads (t9 t10 t11 t12)
      ;; (icdr arg1  arg5 arg6 arg2 t2 t3 t4 t5 t6 t7 t8)
      (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t)
      #+list-inline (cdr-internal arg5 arg6 cdr arg2 t5 t6 t7 t8 t)
      #-list-inline (call-subroutine |CdrInternal|)
      (stack-push2 arg5 arg6 t5)
      (ContinueToNextInstruction)))

#-list-inline
;; --- All the temps aren't really arguments, but they are smashed
(define-subroutine |CdrInternal|
		   (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12)
		   (r0)
  (using-multiple-memory-reads (t9 t10 t11 t12)
    (cdr-internal arg5 arg6 cdr arg2 t5 t6 t7 t8)))


;;; From IFUNSUBP.PPCS

(define-instruction |DoReadInternalRegister| :10-bit-immediate ()
    (internal-register-dispatch arg1 nil |ReadRegisterError| t1 t2 t3))

(define-instruction |DoWriteInternalRegister| :10-bit-immediate (:needs-tos t)
    (stack-pop2 arg2 arg3 "Arg2=tag arg3=data" :tos-valid t)
    (internal-register-dispatch arg1 t |WriteRegisterError| t1 t2 t3))

(define-procedure |WriteRegisterBARx| ()
  (srdi t2 arg1 7 "BAR number into T2")
  (GetNextPC)
  (sldi t3 arg2 32 "Make a quadword from tag and data")
  (GetNextCP)
  (ADDI t1 ivory PROCESSORSTATE_BAR0)
  (sldi t4 t2 3)
  (ADD t1 t4 t1 "Now T1 points to the BAR")
  (OR t3 t3 arg3 "Construct the combined word")
  (STD t3 0 (t1))
  (ContinueToNextInstruction-NoStall))


;;; From IFUNBLOK.PPCS

(define-instruction |DoBlock3Read| :10-bit-immediate ()
    (ADDI arg4 ivory PROCESSORSTATE_BAR3)
    (B |BlockRead|))

(define-instruction |DoBlock2Read| :10-bit-immediate ()
    (ADDI arg4 ivory PROCESSORSTATE_BAR2)
    (B |BlockRead|))

(define-instruction |DoBlock1Read| :10-bit-immediate ()
    (ADDI arg4 ivory PROCESSORSTATE_BAR1)
  (label |BlockRead|)
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (i%block-n-read arg4 arg1 arg2 arg5 arg6 arg3 t1 t2 t3 t4 t5 t6 t7 t8))) 

(define-instruction |DoBlock2Write| :operand-from-stack-signed-immediate ()
    (LWA arg3 PROCESSORSTATE_BAR2+4 (ivory))
    (ADDI arg2 ivory PROCESSORSTATE_BAR2)
    (B |BlockWrite|))

;; ARG1 has the data to write, put the proper BAR into ARG2
(define-instruction |DoBlock1Write| :operand-from-stack-signed-immediate ()
    (LWA arg3 PROCESSORSTATE_BAR1+4 (ivory))
    (ADDI arg2 ivory PROCESSORSTATE_BAR1)
  (label |BlockWrite|)
    ;; This is a trick, mostly to separate the clrldi from the LWA
    ;; (above).  Note that with-multiple-memory-reads really should be
    ;; called with-multiple-memory-operations
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (clrldi arg3 arg3 32 "Unsigned vma")
      (i%block-n-write arg2 arg3 arg1 t1 t2 t3 t4 t5 t6 t7 t8)))



;;; From IFUNLOOP.PPCS

(define-instruction |DoBranchTrueNoPop| :10-bit-signed-immediate
    (:own-immediate t :needs-tos t)
    (ibranchcond nil nil nil nil |BranchException|))	;

(define-instruction |DoBranchFalseNoPop| :10-bit-signed-immediate
    (:own-immediate t :needs-tos t)
    (ibranchcond t nil nil nil |BranchException|))	;invert

;; The next two are here, not because they are frequent, but they are
;; miniscule and drop right into the start-call code
(passthru ".globl callgenericprefetch")
(define-instruction |callgeneric| :full-word-instruction () 
  (label |callgenericprefetch|)			;the same as |callgeneric|
    (LD t3 PROCESSORSTATE_TRAPVECBASE (ivory))
    (mov arg4 arg3 "Get operand")
    (li arg3 |TypeGenericFunction|)
    ;; Build the constant PC for generic dispatch
    (li arg5 |TypeEvenPC|)
    (ADDI arg6 t3 #.sys:%generic-dispatch-trap-vector)
    (B startcallcompiledmerge))

(passthru ".globl callcompiledevenprefetch")
(define-instruction |callcompiledeven| :full-word-instruction () 
  (label |callcompiledevenprefetch|)		;the same as |callcompiledeven|
    (mov arg6 arg3 "Get operand")
    (li arg5 |TypeEvenPC|)
    (clr arg3 "No extra arg")
    (B startcallcompiledmerge))	;push new frame and exit

;; Strictly speaking, |DoStartCall| doesn't belong here, but we put it
;; here so that it gets fetched along with |callindirect|
(define-instruction |DoStartCall| :operand-from-stack ()
    (with-multiple-memory-reads (t9 t10 t11 t12)
      (stack-read2 arg1 arg5 arg6 :signed t)
      (label startcallagain)
      (start-call-dispatch arg5 arg6 arg3 arg4  arg2 t1 t2 t3 t5 t6 t7 t8
			   startcallcompiledmerge startcallindirect))) 

(comment "Fin.")