BaseAddress &1000

 LEADR BaseAddress

 GET $.Alib.BCPLMacs
 GET $.LispDir.BCPL.Asm.LispConsts

RootStackSize	*	&200

Kreadl		*	14  ; different between emulator & u-K
realarm 	*	1
lispmode	*	1
downStack	*	0

; description of stack-frame linkage
frrb		*	0
frrp		*	4
frrl		*	8
frpc		*	12

E_car		*	173
E_cdr		*	174
E_rplaca	*	175
E_rplacd	*	176
E_rplacw1	*	177
E_rplacw2	*	178

arg1		GlobNo	151
true		GlobNo	172
fringe		GlobNo	356
quotefringe	GlobNo	355
interLispFlag	GlobNo	443

PollSR		GlobNo	5
Add		GlobNo	527
Difference	GlobNo	571
Sub1		GlobNo	657
Add1		GlobNo	587
Equal		GlobNo	605
Greaterp	GlobNo	622
Lessp		GlobNo	626
Mult		GlobNo	536
Remainder	GlobNo	575
Quotient	GlobNo	574
Rclm		GlobNo	520
Funap		GlobNo	510
MixError	GlobNo	582
Poll		GlobNo	811
LinkFexprn	GlobNo	832

; The EQ tests at the beginning of each of these call
; sequences provides a free way to do slow function
; linkage (all calls forced through the interpreter).
; Normally, RGB has bit 1 set and branches to these
; sequences set the PSR, so on arrival the instructions
; get executed.  When slow linkage is selected, however,
; bit 1 is cleared in RGB so all these sequences (except
; the ICall ones) turn into no-ops

	MACRO
	CallN	$type
jcall$type
	MOV	rts, rp
	LDMED	rp, {r14, rl, rp}
call$type
	BIC	rb, w2, #P_key
	LDREQ	rb, [rb]
	MOVEQ	r0, #P_code$type.:SHR:24
	CMPEQS	r0, rb, LSR #24
	BNE	qcall$type
zxcall$type
	BIC	r0, rb, #P_key
	LDR	r0, [r0, #0]
	CMPS	w1, r0, LSR #16
	BNE	qcall$type
icall$type
	LDR	r0, [rg, #G_fringe]
	CMPS	r0, rts
	ADDGE	pc, rb, #4
	B	gc$type
	& 0
	MEND

	MACRO
	Call	$type
jcall$type
	MOV	rts, rp
	LDMED	rp, {r14, rl, rp}
call$type
	BIC	rb, w2, #P_key
	LDREQ	rb, [rb]
	MOVEQ	r0, #P_code$type.:SHR:24
	CMPEQS	r0, rb, LSR #24
	BNE	qcall$type
zxcall$type
icall$type
	LDR	r0, [rg, #G_fringe]
	CMPS	r0, rts
	BICGE	pc, rb, #P_key
	B	gc$type
	MEND

	MACRO
	XCall	$type
xjcall$type
	MOV	rts, rp
	LDMED	rp, {r14, rl, rp}
xcall$type
	MOV	rb, w2
	MOV	r0, #P_code$type.:SHR:24
	CMPS	r0, rb,LSR #24
	BEQ	zxcall$type
	MOV	r0, #P_id:SHR:24
	CMPS	r0, w2, LSR #24
	BEQ	call$type
	B	qcall$type
	MEND

; No special action need be taken here to deal with the case
; of slow linkage, because in that case rb has tag bits 00.

	MACRO
	QCallBody $type
qcall$type
	MOV	r0, #P_id:SHR:24  ; was it an ID
	CMPS	r0, rb, LSR #24
	MOV	r0, w2
	BICEQ	rb, rb, #P_key	  ; if so, is its value the right sort of thing
	LDREQ	rb, [rb]
	MOVEQ	r0, #P_code$type.:SHR:24
	CMPEQS	r0, rb, LSR #24
	BEQ	zxcall$type	  ; if so, go ahead and call it
	MEND

; BCalln are normal call sequences for functions internal to
; a block.  The sequence used depends only on the number of
; arguments in registers; not at all on the function type.
; Call of these sequences is via
;	ADD	w2, rb, #offset
;	MOV	r14, pc
;	SUB	pc, rgb, #Bcalln
; and again rb must be loaded with the address of the base of
; the block.
; The sequence looks much like ordinary ILinks, except that
; a different register is used.

	MACRO
	BCall	$type
bcall$type
	LDR	r0, [rg, #G_fringe]
	CMPS	r0, rts
	BICGE	pc, w2, #P_key
	B	bgc$type
	MEND

	LNK a.mclibr
