; IfsExtendStack.asm -- procedure to extend an XBCPL stack
; Copyright Xerox Corporation 1979, 1980

; Last modified February 27, 1980  10:40 AM by Taft
; Last modified by Butterfield, October 25, 1979  8:02 PM
; - ExtendStackCall, use CallProc to allocate new stack - 10/25
; - ExtendStackCall, add stackBottom - 5/24/79

.ent ExtendStackCall

.bext Allocate
.bext CallProc
.bext Free
.bext sysZone

.srel

ExtendStackCall: .ExtendStackCall

.zrel

ExtendStackReturn: .ExtendStackReturn

.nrel

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


; ExtendStackCall(size, Proc, args...)
; Allocates a new stack from sysZone of size "size", then
; calls Proc(args) in that stack.  The new stack is deallocated
; when Proc returns, and ExtendStackCall returns the result
; returned by Proc.

; the frame is laid out as follows (n is the number of args
; beyond size and Proc):

; 0:	caller's frame
; 1:	our pc (stored by callee after we call it)
; 2:	frame temp (clobbered by callee)
; 3:	extra args word passed to callee
; 4:	size (later holds allocated block)
; 5:	Proc
; 6:	arg 1
; ...
; n+5:	arg n
; n+6:	jsr @5 2	; code compiled to call Proc
; n+7:	 n
; n+8:	jmp @ExtendStackReturn

; ** note ** that the code is self-modifying and hence cannot
; be called from interrupt routines (however, recursive calls
; are ok).

.ExtendStackCall:
	sta 3 1 2
	sta 0 2 2	; preserve another ac
	lda 3 0 3	; get number of args in call
	lda 0 d9	; compute required frame size
	add 0 3
	sta 3 fsize	; store for getframe
	lda 0 2 2	; restore arg
	jsr @getframe	; get a frame and store args
fsize:	 0
	jsr @storeargs

; allocate the storage for the new stack using CallProc
	lda 0 4,2	; size
	sta 0 3,2
	lda 0 @lvAllocate
	lda 1 @lvSysZone
	jsrii lvCallProc
	 3

; save old frame pointer and stackMin in words 0 and 1 of
; the allocated block
	mov 0 3		; the allocated block
	sta 2 0 3	; save frame pointer
	lda 1 stackMin
	sta 1 1 3	; save stackMin
	inc 3 1		; compute and set new stackMin
	sta 1 stackMin

; move our frame into the top of the new stack
	lda 1 4 2	; recover block size
	sta 3 4 2	; store block pointer
	neg 3 3		; compute last destination address
	adc 3 1
	neg 2 0		; compute first source address -1
	com 0 0
	lda 3 fsize	; frame size
	neg 3 3		; negate for blt
	mov 1 2		; setup stackBottom in first destination - 1
	add 3 2
	sta 2 0,2
	inc 2 2		; compute new frame location
	blt		; move the frame

; set up to call the supplied Proc
	lda 3 0 2	; caller's frame
	lda 0 @1 3	; get number of args we were called with
	lda 1 c5	; exactly 5 args (n=3 to callee)?
	sne 0 1
	 lda 1 8. 2	; yes, pass arg 3 in extra args word
	sta 1 3 2	; otherwise, pass frame offset = 5
	lda 1 c2	; subtract size and Proc args
	sub 1 0
	mov 2 3		; compute pointer to word n of frame
	add 0 3
	sta 0 7 3	; store n in word n+7
	lda 1 inst6	; setup code to do the call
	sta 1 6 3
	lda 1 inst8
	sta 1 8. 3
	lda 0 6 2	; load ac's with args 1 and 2
	lda 1 7 2
	jmp 6 3		; go call the Proc

; control returns here when Proc returns
.ExtendStackReturn:
	lda 3 4 2	; get pointer to allocated block
	lda 2 0 3	; recover old frame pointer
	lda 1 1 3	; restore old stackMin
	sta 1 stackMin
	sta 0 4 2	; preserve return value
	mov 3 1		; free the block
	lda 0 @lvSysZone
	jsrii lvFree
	 1
	lda 0 4 2	; recover return value
	jmp @return

lvAllocate: Allocate
lvCallProc: CallProc
lvFree:	Free
lvSysZone: sysZone
c2:	2
c5:	5
d9:	9.
inst6:	jsr @5 2
inst8:	jmp @ExtendStackReturn

.end