; -*- MIDAS -*-
comment |

The following file implements functions which are to LEXPR-FUNCALL as
SUBRCALL and LSUBRCALL are to FUNCALL.  Provided are:

LEXPR-SUBRCALL subr arg0 arg1 ... argn rest-arg
  where n may be equal to zero.  The rest-arg is a list of arguments to the
  subr after the argi arguments.  The user is responsible for calling the
  subr with the correct number of arguments, since no checking can be done.
  It is illegal to call a SUBR with more than 5 arguments.  To avoid blowing
  away the LISP, LEXPR-SUBRCALL always checks this constraint.

LEXPR-LSUBRCALL lsubr arg0 arg1 ... argn rest-arg
  Where n may be equal to zero.  The rest-arg is a list of arguments to the
  lsubr after the argi arguments.  The user is responsible for calling the
  lsubr with the correct number of arguments, since no checking can be done.
  This is particularly important with lsubr's, since calling with the incorrect
  number of arguments can result in getting the stack out of phase.  Typically
  this will result in your being thrown to DDT with an ILOPR or MPV.

In addition, the following functions are defined:

LEXPR-SUBRCALL-FIXNUM
LEXPR-SUBRCALL-FLONUM
LEXPR-LSUBRCALL-FIXNUM
LEXPR-LSUBRCALL-FLONUM

These are just like their generic counterparts, but only take SUBR's or
LSUBRs which have been declared to return FIXNUM or FLONUM.  Calling
SUBR's or LSUBR's which have not been so declared will result in
unpredictable behaviour, as the first instruction of the called subr or
lsubr will be skipped.  For these to provide any advantage, they must
be declared to the compiler before compiling the calls to them.  This
can be done by loading this file into the compiler before compiling
files using these functions.

Loading this file into the compiler is also a way to ensure that
these functions are known by the compiler to be LSUBR's.
|
.fasl
.insrt sys:.fasl defs

VERPRT LSCALL

.SXEVAL (AND (FBOUNDP (QUOTE FIXNUM))
	     (FIXNUM (LEXPR-SUBRCALL-FIXNUM) (LEXPR-LSUBRCALL-FIXNUM)))
.SXEVAL (AND (FBOUNDP (QUOTE FLONUM))
	     (FLONUM (LEXPR-SUBRCALL-FLONUM) (LEXPR-LSUBRCALL-FLONUM)))

lxse:	WNA [WRONG NUMBER OF ARGS TO LEXPR-LSUBRCALL]

.entry LEXPR-SUBRCALL-FLONUM LSUBR 003010	;LSUBR, 2-7 arguments
	skipa d,cfix1-1
.entry LEXPR-SUBRCALL-FIXNUM LSUBR 003010	;LSUBR, 2-7 arguments
	  movei d,fix1
	move tt,p		;Calculate where the bottom of this frame is
	add tt,t		;TT <- return address
	aos 1(tt)		;Skip over the PUSH P,CFIX1
	jrst lxs0

.entry LEXPR-SUBRCALL LSUBR 003010	;LSUBR, 2-7 arguments
	move tt,p		;Calculate where the bottom of this frame is
	add tt,t		;TT <- return address
	movei d,[popj p,]
lxs0:	aos t			;count last arg
	aojg t,lxse		;Count function arg, must have at least 2 args
	pop p,a			;Get list of extra arguments
lxs1:	jumpe a,lxs2
	hlrz b,(a)		;Get the CAR of the list
	push p,b		;and push it.
	hrrz a,(a)		;next item
	soja t,lxs1		;repeat, counting

lxs2:	movns t			;Get the number of arguments
	caile t,5		;Must have 5 or fewer args
	  jrst lxse		;  We always check, to avoid blowing away the LISP!
	hrlzi tt,2(tt)		;Address of first arg,,0
	aos tt			;Address of first arg,,1
	blt tt,(t)		;Move the args into the AC's
	sub p,(t)[0,,0 ? 1,,1 ? 2,,2 ? 3,,3 ? 4,,4 ? 5,,5]
	exch d,(p)		;Subr pointer <-> fix1/float1/popj1
	jrst (d)		;Call it

.entry LEXPR-LSUBRCALL-FLONUM LSUBR 003777	;LSUBR, 2-infinity arguments
	skipa d,cfix1-1
.entry LEXPR-LSUBRCALL-FIXNUM LSUBR 003777	;LSUBR, 2-infinity arguments
	  movei d,fix1
	move tt,p		;Calculate where the bottom of this frame is
	add tt,t		;TT <- return address
	aos 1(tt)		;Skip over the PUSH P,CFIX1
	jrst lxls0

.entry LEXPR-LSUBRCALL LSUBR 003777	;LSUBR, 2-infinity arguments
	move tt,p		;Calculate where the bottom of this frame is
	add tt,t		;TT <- return address
	movei d,[popj p,]
lxls0:	aos t			;count last arg
	aojg t,lxse		;Count function arg, must have at least 2 args
	pop p,a			;Get list of extra arguments
lxls1:	jumpe a,lxls2
	hlrz b,(a)		;Get the CAR of the list
	push p,b		;and push it.
	hrrz a,(a)		;next item
	soja t,lxls1		;repeat, counting

lxls2:	exch d,1(tt)		;Rescue the lsubr-ptr before we bash it
	jrst (d)		;Call it


fasend