; IfsCallProc.asm
; Copyright Xerox Corporation 1979, 1980

; Last modified February 27, 1980  11:07 AM by Taft
; Last modified December 20, 1979  4:55 PM by Wobber
;   (fixed numargs bug on direct call)

; outgoing
.ent CallProcProcess, CallProc

; incoming
.bext Block, CtxRunning, Enqueue

	.srel

CallProcProcess: .CallProcProcess
CallProc: .CallProc
callProcQ: .callProcQ

	.nrel

; Procedure Call Descriptor (PCD) layout
link = 0
nargs = 1	; number of args passed down, -1 means done
args = 2	; pointer to args passed down, result returned here

; BCPL runtime statics
getframe = 370
storeargs = 367
return = 366

; BCPL frame layout
flink = 0
fret = 1
ftemp = 2
fargx = 3

; extended frame offsets for direct call, (see below)
farg0 = 4
farg1 = 5
fswat = 6	;swat...nobody should re-execute from here
fnargs = 7	;numargs for call
fcoret = 10	;jsr @return ... return to original frame
fextra = 11	; size of frame

; CallProc(proc,arg,...,arg; numargs na) = valof
; Calls Proc(arg,...,arg) in a big stack, and returns the result.
; This code is self-modifying, so it can't be called from interrupt level.


.CallProc:
	sta 3 fret 2		; free an index register
	sta 0 ftemp 2		; and one other register
	lda 0 cppCtx
	snz 0 0			; are contexts running yet?
	 jmp cp1		; no.  call directly
	lda 3 @pCtxRunning
	se 0 3			; is CtxRunning = CallProcProcess?
	 jmp cp5		; no.  queue the call

; Come here if the call should be made directly rather then queueing it
; on callProcQ.  This will happen for 2 reasons: 1) contexts aren't
; running yet or 2) we are already running in the CallProcProcess context.

; An extra frame is allocated here with no argument space.  It will include
; three words other than the overhead: a CallSwat, a numargs word to be
; filled in, and a jsr @return.  The caller's arguments and numargs will be
; fixed and then the call will be continued with 3 pointing to xnargs 2.
; The word above xnargs on the stack is a CallSwat because one should not
; be re-executing, (as in overlay,) from here.

cp1:	lda 0 fret 2		; get old return pointer
	jsr .+2
			; fake out getframe with a "numargs" of 2
	 2
	sta 3 fret 2		; just for the following call
	jsr @getframe		; make a new frame, (save AC0, AC1)
	 fextra			; size of extra frame
	jsr @storeargs
	lda 3 flink 2		; get previous frame
	lda 1 farg0 2		; get back return address
	sta 1 fret 3		; replace old return
	lda 1 ftemp 3		; get proc to be called
	sta 1 ftemp 2		; put it in our frame
	lda 1 cSwat
	sta 1 fswat 2
	lda 1 cReturn
	sta 1 fcoret 2
	lda 1 @fret 3		; numargs
	neg 1 1
	com 1 1
	sta 1 fnargs 2		; numargs -1 for the call we pass on
	lda 0 c3
	sge 1 0			; 3 or more args?
	 jmp cp2   		; no
	sne 1 0			; exactly 3?
	 jmp cp3   		; yes

; There were more than 4 args to the original call, so there will be more
; than 3 args to the call we pass on, so the arg vector is still needed,
; though it is shortened by one.

	lda 1 fargx 3
	add 1 3
	inc 3 3			; bump vector
	lda 1 2 3 		; old 3rd arg, new 2nd arg
	sub 2 3
	sta 3 fargx 2		; store new arg vec offset
cp4:	lda 3 cfnargs
		; 3 should point to fnargs
	add 2 3
	lda 0 farg1 2		; old 2nd arg is new first arg
	jmp @ftemp 2		; continue the call, returns to fcoret 2

; There were less than 3 args to the original call.

cp2:	lda 1 fargx 3		; old 3rd arg, new 2nd arg
	jmp cp4			; go call the procedure

; There were 4 args to the original call, so we will pass on 3.
; Move the 3rd arg into where the arg vec offset was.
 
cp3:	lda 1 fargx 3
	add 1 3
	lda 1 3 3 		; old 3rd arg, new 2nd arg
	lda 3 4 3 		; old 4th arg, new 3rd arg
	sta 3 fargx 2		; put it in place of the arg vec offset
	jmp cp4			; go call the procedure

; Come here if we must queue the call and let the CallProcProcess do it.

cp5:	lda 0 @fret 2		; numargs
	lda 3 c7		; frame overhead + space for pcd
	add 0 3
	sta 3 cpf		; frame size
	lda 0 ftemp 2		; pick up first arg again (proc)
	jsr @getframe
cpf:	 0
	jsr @storeargs
	lda 3 c4
	add 2 3
	mov 3 1			; -> arg list
	add 0 3			; -> pcd
	neg 0 0
	com 0 0
	sta 0 nargs 3		; numargs -1
	sta 1 args 3		; arg list
	mov 3 1			; pcd
	lda 0 @pCallProcQ
	jsrii pEnqueue		; Queue the call
	 2
cp6:	jsrii pBlock		; wait
	 0
	lda 3 flink 2		; callers frame
	lda 3 @fret 3		; numargs
	add 2 3
	lda 0 c4		; frame overhead
	add 0 3			; -> pcd
	lda 0 nargs 3
	com 0 0 szr		; done flag set?
	 jmp cp6		; no
	lda 0 args 3		; get result
	jsr @return

pCtxRunning:	CtxRunning
pCallProcQ:	callProcQ
pEnqueue:	Enqueue
cSwat:		77400
cReturn:	jsr @return
cfnargs:	fnargs
c4:		4
c7:		7

pBlock:		Block
c3:		3
cppCtx:		0		; -> CallProcProcess' ctx
.callProcQ:	0		; head
		0		; tail

; CallProcProcess(ctx)
; A context which waits for a PCD to appear on CallProcQ.
; It executes the procedure, and leaves the result in PCD.result.

.CallProcProcess:
	sta 3 fret 2
	sta 0 cppCtx		; our ctx
	jsr @getframe
	 6
	jsr @storeargs

cpp1:	jsrii pBlock		; Block()
	 0
	lda 3 .callProcQ	; queue head
	snz 3 3			; anything to do?
	 jmp cpp1		; no

	lda 0 nargs 3
	sta 0 cppargs		; setup numargs for call
	lda 3 args 3		; pointer to proc and arg vector
	lda 1 c3
	sge 0 1			; 3 or more args?
	 jmp cpp3		; no
	se 0 1			; exactly 3?
	 jmp cpp2		; more than 3
	lda 0 3 3		; exactly 3, put 3rd arg in fargx word
	jmp cpp4

cpp2:	mov 3 0
	sub 2 0			; frame offset of arg vector
cpp4:	sta 0 fargx 2

cpp3:	lda 0 1 3		; load up first 2 args
	lda 1 2 3
	jsr @0 3		; call the procedure
cppargs: 0
	lda 3 .callProcQ
	sta 0 args 3		; result
	mkminusone 0 0
	sta 0 nargs 3		; set done flag
	lda 0 link 3
	sta 0 .callProcQ	; dequeue call descriptor
	jmp cpp1		; wait for more work


	.end

(1792)\2231i1I