; 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