;************************************************
;*						*
;*  routine to make C procedures PL/I-callable  *
;*						*
;************************************************


	.title	plient

	.psect

	.enable lc



	.globl	.ENTRY, .EXIT	;PL/I block enter & exit routines

	stkoflo = 0+5*256.	;PL/I stack overflow condition code

	.globl	signal, vx$tkl	;vx$tkl is stack limit in VEXT impure



.iif ndf c$rt .error CDEFS.MAC must be included in command line
.page
;
; usage:
; ======
;
; For documentation on how to use this routine, refer to CPLI.DOC.
; The calling sequence is plient("xyz"), where xyz is your procedure name.
;


;
; definitions:
; ============
;
;  sp	means the stack pointer (R6).
;
;  fp	means a pointer to the current frame for the language involved.
;
;  frame  means the area of the stack allocated for each invocation of a
;	procedure; it is also known as a "block environment",
;	"block structure", "automatic region", or "dynamic storage area".
;
;  prolog  means a block of data for each PL/I procedure containing the name
;	of the procedure and other stuff for .ENTRY to set up the frame
;	and for .ERROR to give descriptive error messages.
;


;
; Overall logic flow:
; ===================
;
; The calling C procedure has already called CSV (which saves r4, r5, and
; return address, and sets up a C frame) and allocated stack space for 
; auto local variables before calling us. We first check to see if we were 
; called through a cluster and if so we fix up the stack (see more detailed 
; description below). We then store a PL/I prolog on the stack, fudge
; things to make it appear we were called directly by PL/I, and call .ENTRY,
; the standard PL/I block enter routine, which saves all registers and
; sets up a PL/I frame. .ENTRY returns to us (via our JMP following the
; prolog), and we save the PL/I fp so CRET will restore it when the C procedure
; returns, and store our exit routine address in C's return address, before
; returning to the C procedure that called us. When it exits normally through
; CRET, our exit routine gains control, pops the argument list, and goes to
; .EXIT, the standard PL/I block exit routine, which restores all the
; registers and returns to the PL/I caller.
.page
;
; The PL/I calling sequence is
;     =====================
;
;  push argument pointers on stack   		subr:	JSR R5,.ENTRY
;  push argument count					prolog
;  JSR R5,subr						. . .
;							JSR R5,.EXIT
;
; The C calling sequence is
;     ==================
;
;  push arguments on stack			 subr:	JSR R5,CSV$
;  JSR PC,subr						allocate auto vars if any
;  pop arguments					. . .
;							JMP CRET$
;
; Differences:
; ============
;
; in PL/I the callee pops the argument list (this is actually done by .ENTRY,
; which copies it into the PL/I frame), in C the caller pops it.
;
; PL/I has an argument count, C doesn't.
;
; PL/I passes by reference or descriptor, C passes by value (so a C procedure
; working with PL/I will see or pass pointers).
;
; C follows the PDP-11 stack conventions, with sp starting at the top of
; the allocated space and working downward, each block allocating a frame
; below the previous one. PL/I sets sp near the bottom of the allocated space, 
; to function as a token PDP-11 style stack, while frames are allocated going 
; upward (actually being allocated from the heap).
;
; fp, the current frame pointer, is in r4 for PL/I, r5 for C.
;
; register preservation across a call:
;
; C procedure or function:	  r2,3,4,5(fp) preserved, r0,1 need not
; PL/I procedure without RETURNS: r4(fp),r5(link) preserved, r0,1,2,3 need not
; PL/I function returning value:  all registers preserved
;
.page
;
; clustering
; ==========
;
; plient eliminates the restriction that clustered libraries can't take 
; arguments on the stack, for the case of a PL/I program calling procedures
; written in C, so your code can be clustered so long as it observes all the
; other rules for clustering. This is done in a transparent manner - plient
; dynamically determines whether the stack has been affected by the cluster
; mechanism and if so works around it, so in accessing arguments your code 
; neither knows nor cares whether clustering was involved. For example, you
; could build a resident library of C routines using plient that is mapped
; to directly by one user, as the first library of a cluster by another, and
; as a middle library of a cluster by a third user, all simultaneously
; (again, so long as the other clustering rules are followed).
; 
; The way this works is as follows. The cluster remap mechanism stores 
; two extra words on the stack: a segment descriptor address (so it
; can restore the caller's mapping context) and the address of the code
; to restore the caller context. It as assumed the user calls with a
; JSR PC,xxx and so returns with a RTS PC - thus prior to these two extra
; words is the real return address; the user's RTS PC goes to the restore
; code, which restores the user context and does a RTS PC, returning to the
; caller. We can detect these extra words because the segment descriptor
; address falls where the PL/I argument count would be if the extra words
; weren't there (we assume noone will ever call with more than 255 arguments
; and that segment descriptors cannot be in the task header (address less
; than 256. - they are actually in psect $$SGD1, towards the end of the root).
; To work around it, we exchange the argument list and the two extra words
; so the argument list can be accessed normally (and popped). Then we must
; also account for the fact that the cluster mechanism expects JSR PC/RTS PC
; while PL/I uses JSR R5/RTS R5. It is left as an exercise for the reader 
; to verify that the rearrangement shown below does the trick (the saved 
; caller's r5 is saved by PL/I caller's JSR R5,xxx and normally restored by 
; .EXIT effecting a RTS R5, and the return address is the PL/I callee R5 
; saved by JSR R5,CSV$ and normally restored to R5 by CRET$ before going 
; to .EXIT).
;
; The next page shows a picture of the relevant portions of the stack before 
; and after the cluster fix-up. The following page shows the before and after 
; for all of plient, assuming no clustering.
.page


;
;	stack before cluster shuffle		stack after cluster shuffle
;	============================		===========================
;

;
;      		:					:
;      		:					:
;      		:					:
;       |-------------------------------|       |-----------------------------|
;       |				|	|   return to PL/I caller     |
;       | argument list from PL/I       |       |-----------------------------|
;       |				|       |cluster segment descript addr|
;       |-----				|       |-----------------------------|
;       | argument count from PL/I      |       |			      |
;       |-------------------------------|       | argument list from PL/I     |
;       |     PL/I caller's r5		|       |			      |
;       |-------------------------------|       |-----			      |
;+c$pmtr|cluster segment descriptor addr|       | argument count from PL/I    |
;       |-------------------------------|       |-----------------------------|
;       |return to cluster ovrlay loader|       |     PL/I caller's r5	      |
;       |-------------------------------|       |-----------------------------|
; C fp->|   return to PL/I caller       | C fp->|return to cluster ovrly loadr|
;       |-------------------------------|       |-----------------------------|
;       |				|       |			      |
;       | remainder of C frame header   |       | remainder of C frame header |
;       |				|       |			      |
;       |-------------------------------|       |-----------------------------|
;       |				|       |			      |
;       | C frame auto storage		|       | C frame auto storage	      |
;       |				|       |			      |
;       |-------------------------------|       |-----------------------------|
;       |procedure name ptr (plient arg)|       |procedure name ptr (arg)     |
;       |-----				|       |-----			      |
;  sp ->| plient return addr		|  sp ->| plient return addr	      |
;       |-------------------------------|       |-----------------------------|
;      		:					:
;      		:					:
;      		:					:
.page
;
;	stack on entry to plient		stack on return to C caller
;	========================		===========================
;
;      |-------------------------------|		:
;      : high end of stack space       :		:
;      :			       :		:
;      :			       :		:
;      :			       :       |-----------------------------|
;      :			       :  PL/I |			     |
;      :			       :  fp ->| PL/I frame for C procedure, |
;      :			       :       | containing all of PL/I	     |
;      :			       :       | caller's registers & return |
;      :			       :       |			     |
;      |-------------------------------|       |-----------------------------|
; PL/I |			       |       |			     |
; fp ->| PL/I caller's frame	       |       | PL/I caller's frame	     |
;      |			       |       |			     |
;      |-------------------------------|       |-----------------------------|
;      :			       :		:
;      : possibly other PL/I frames    :		:
;      :			       :		:
;      |-------------------------------|		:
;      | sp pointed here in PL/I main  |		:
;      |-------------------------------|		:
;      :			       :		:
;      : possibly other C frames       :		:
;      :			       :		:
;      |-------------------------------|		:
;      |			       |		:
;      | argument list from PL/I       |		:
;      |			       |       		:
;      |-----			       |		:
;      | argument count from PL/I      |		:
;      |-------------------------------|       |-----------------------------|
;      |			       |       |			     |
;      | C frame header, containing:   |       | C frame header, containing: |
;      |  c$r4: PL/I caller's fp       |       |  c$r4: new PL/I fp	     |
;C fp->|  cp$r5: PL/I caller's r5      | C fp->|  c$r5: 0 (flags PL/I call)  |
;      |  cp$rt: return to PL/I caller |       |  c$rt: our exit routine addr|
;      |			       |       |			     |
;      |-------------------------------|       |-----------------------------|
;      |			       |       |			     |
;      | C frame auto storage	       |       | C frame auto storage	     |
;      |			       |       |			     |
;      |-------------------------------|       |-----------------------------|
;      |procedure name ptr (plient arg)|       |			     |
;      |-----			       |       | PL/I prolog		     |
; sp ->| plient return addr	       |       |   for C procedure	     |
;      |-------------------------------|       |			     |
;      :			       :       |-----------------------------|
;      :			       :  sp ->| dummy as arg (caller pops)  |
;      :			       :       |-----------------------------|
;      :			       :		:
;      :			       :		:
;      : low end of stack space	       :		:
;      |-------------------------------|		:
.page

cp$rt = c$r5	;when called by PL/I, return addr & saved r5 are reversed
cp$r5 = c$rt
;( C calls with JSR PC,x; JSR R5,CSV$,  which push return then R5
;PL/I calls with JSR R5,x; JSR R5,CSV$, which push R5 then return )


; refer to the PL/I calling sequence several pages back, and note that the
; combined net effect of the two JSRs is thus
; step 1:	r5 -> push to stack
; step 2:	return addr -> push to stack
; step 3:	#prolog -> r5
; step 4:	#.ENTRY -> pc


; note that registers 0,1,2,3 must be preserved until saved by .ENTRY


plient::
	tstb c$pmtr+1(r5)	;high order byte of arg count
	beq noclst		;arg count must be <256.

;cluster call - rearrange stack to get around 2 extra words:

	mov c$pmtr(r5),-(sp)	;save caller segment descriptor addr
	mov c$pmtr-2(r5),-(sp)	;save cluster return addr
	mov r5,r4
	add #c$pmtr,r4		;point to where arg count should (will) be
	mov r4,c$r3(r5)
	add c$pmtr+4(r5),c$r3(r5) ;add real arg count to point to end of list
	add c$pmtr+4(r5),c$r3(r5) ;two bytes per word
	tst -(r4)		;point to cluster return addr
shuffle:
	mov 4(r4),(r4)+		;move arg list down two words
	cmp r4,c$r3(r5)
	blos shuffle

	;r4 now points to 2-word opening above arg list
	mov c$r5(r5),2(r4)	;move r5 (PL/I return) to above seg desc addr
	mov (sp)+,c$r5(r5)	;move cluster return to saved r5
	mov (sp)+,(r4)		;move segment descriptor addr to new position

noclst:
	;end of cluster shuffle
.page
	mov (sp)+,c$r3(r5)	;stash our return addr in C frame,
	mov (sp)+,c$r2(r5)	;and name ptr (arg), so they dont clutter stack
	mov $vext,r4		;get from impure - we could be in cluster library
	mov vx$tkl(r4),r4	;lowest task address (from .LIMIT directive)
	add #eprolog-bprolog+6+10,r4 ;adjust for how much we will be allocating
	cmp sp,r4		;stack overflow?
	bhi stkok		;no
	clr c$r5(r5)		;flag for plifp routine
	mov #stkoflo,-(sp)	;ERROR condition, with PL/I's subcode for stack overflow
	jsr pc,signal		;let PL/I give message (shouldn't return)

stkok:	mov #eprolog,r4
mvprlg:	mov -(r4),-(sp)		;push prolog less name to stack
	cmp r4,#bprolog
	bhi mvprlg		;addresses are unsigned, dont use bgt!
	sub #6,sp		;allocate space for procedure name
	mov sp,r4
	mov #6,-(sp)
mvnam:	movb @c$r2(r5),(r4)+	;move 6-character name to stack
	beq 1$			;pad with nulls if less than 6
	inc c$r2(r5)
1$:	dec (sp)		;count 6 characters
	bne mvnam
	tst (sp)+		;pop count

	mov r5,r4
	mov sp,r5		;r5 now points to full prolog (call step 3)
	mov r4,-(sp)		;save C frame pointer
	clr -(sp)		;dummy arg list for .ENTER to pop
	mov cp$r5(r4),-(sp)	;call step 1
	mov cp$rt(r4),-(sp)	;call step 2
	mov c$r4(r4),r4		;restore PL/I caller's r4 (fp)
	jmp .ENTRY		;call step 4

; return from .ENTRY

ent2:	mov (sp),r5		;restore C fp, leave for caller to pop as arg
	mov r4,c$r4(r5)		;save PL/I frame pointer
	mov #exi1,c$rt(r5)	;we must intercept C return
	clr c$r5(r5)		;flag for plifp routine
	jmp @c$r3(r5)		;return to calling C procedure




;
; exit from C via cret comes here to get back to PL/I
;
exi1:	mov (sp)+,r0		;number of arguments, and skip it
	asl r0			;two bytes per word
	add r0,sp		;pop arg list
	jsr r5,.EXIT		;let PL/I restore everything else
				;(r4 has PL/I fp, restored by CRET)
.page


;
; PL/I procedure prolog, minus the name
;
bprolog:.word	0		;addr of static csect
	.word	0		;size of auto area
	.word	-1		;no statement number table
	.word	40000		;flags & #parms (0)
	.word	-1		;on enablement mask - enable all
	.word	-1		;no relocation table
	jmp @#ent2		;reference must be absolute, not pc-relative
eprolog = .










;
; routine to find current PL/I frame pointer
;
; call by  jsr pc,plifp  with current C fp in r5
; returns PL/I fp in r4
;
; called by callpli and signal among others
;
plifp::	mov r5,r4	;start with current C frame
	br 2$
1$:	mov c$r5(r4),r4	;back to previous C frame
2$:	tst c$r5(r4)	;have a PL/I frame?
	bne 1$		;not yet
	mov c$r4(r4),r4	;PL/I frame pointer (from plient)
	rts pc
.page
;
; we must define a special csv because the regular one
; does not preserve r0. in the case of a function returning
; a value, PL/I requires all registers to be saved.
; this one leaves registers 0,1,2,3 unchanged, otherwise it's
; functionally identical to the standard supplied CSV.
;
C$SAV::
CSV$::
	mov r4,-(sp)	;save a register first
	mov r5,r4	;save return
	mov sp,r5	;set up frame pointer
	tst (r5)+	;adjust for r4 push
	mov r3,-(sp)
	mov r2,-(sp)
	jsr pc,(r4)	;tst -(sp) (allocate one auto); jmp (r4)



; now that we've defined CSV, we must define CRET (identical to regular CRET)

C$RET::
CRET$::
	mov r5,r2
	mov -(r2),r4
	mov -(r2),r3
	mov -(r2),r2
C$RETS::
	mov r5,sp
	mov (sp)+,r5
	rts pc



	.globl	C$PMTR, C$AUTO	;some C.OLB routines use global definition

	.end
