TITLE FORTRAN CALLING ROUTINES

	SEARCH	IMPPRM
	ENTRY	CALL0,CALL1,CALL2,CALL3,CALL4,CALL5,CALL6,CALL7,CALL8,CALL9
	ENTRY	ICALL0,ICALL1,ICALL2,ICALL3,ICALL4,ICALL5,ICALL6,ICALL7,ICALL8,ICALL9
	ENTRY	RCALL0,RCALL1,RCALL2,RCALL3,RCALL4,RCALL5,RCALL6,RCALL7,RCALL8,RCALL9

CALL9:
ICALL9:
RCALL9:
	MOVSI	T2,-^D9
	JRST	.C9
CALL8:
ICALL8:
RCALL8:
	MOVSI	T2,-^D8
	JRST	.C8
CALL7:
ICALL7:
RCALL7:
	MOVSI	T2,-7
	JRST	.C7
CALL6:
ICALL6:
RCALL6:
	MOVSI	T2,-6
	JRST	.C6
CALL5:
ICALL5:
RCALL5:
	MOVSI	T2,-5
	JRST	.C5
CALL4:
ICALL4:
RCALL4:
	MOVSI	T2,-4
	JRST	.C4
CALL3:
ICALL3:
RCALL3:
	MOVSI	T2,-3
	JRST	.C3
CALL2:
ICALL2:
RCALL2:
	MOVSI	T2,-2
	JRST	.C2
CALL1:
ICALL1:
RCALL1:
	MOVSI	T2,-1
	JRST	.C1
CALL0:
ICALL0:
RCALL0:
	SETZB	T2,FARGS
	JRST	.C0

.C9:	MOVEI	T1,@ARGLST+^D9(P)
	MOVEM	T1,FARGS+^D8
.C8:	MOVEI	T1,@ARGLST+^D8(P)
	MOVEM	T1,FARGS+7
.C7:	MOVEI	T1,@ARGLST+7(P)
	MOVEM	T1,FARGS+6
.C6:	MOVEI	T1,@ARGLST+6(P)
	MOVEM	T1,FARGS+5
.C5:	MOVEI	T1,@ARGLST+5(P)
	MOVEM	T1,FARGS+4
.C4:	MOVEI	T1,@ARGLST+4(P)
	MOVEM	T1,FARGS+3
.C3:	MOVEI	T1,@ARGLST+3(P)
	MOVEM	T1,FARGS+2
.C2:	MOVEI	T1,(ARG3)
	MOVEM	T1,FARGS+1
.C1:	MOVEI	T1,(ARG2)
	MOVEM	T1,FARGS
.C0:	MOVEM	ARG1,ARGLST(P)
	MOVEM	T2,FARGN
	MOVEM	BASE1,B1SAV
	MOVEM	BASE2,B2SAV
	MOVEM	BASE3,B3SAV
	MOVEM	BASE4,B4SAV
	MOVEM	BASE5,B5SAV
	MOVEI	16,FARGS
	PUSHJ	P,@ARGLST(P)
	MOVE	AC,0		;GET RESULT FROM FUNCTION
	MOVE	BASE1,B1SAV
	MOVE	BASE2,B2SAV
	MOVE	BASE3,B3SAV
	MOVE	BASE4,B4SAV
	MOVE	BASE5,B5SAV
	POPJ	P,		;RETURN TO CALLER

B1SAV:	Z
B2SAV:	Z
B3SAV:	Z
B4SAV:	Z
B5SAV:	Z

FARGN:	Z
FARGS:	BLOCK	^D9

	PRGEND

TITLE INITFOR	DO A RESET. TO FOROTS
;	%SYSTEMROUTINE INITFOR
;	CAUSES FOROTS TO BE LOADED AND INITIALISES IT

	.REQUEST	SYS:FORLIB.REL
	EXTERN	%%TRAP,RESET.
	ENTRY	$INITFOR
	SEARCH	IMPPRM,C

$INITFOR:MOVEM	P,SAVP	;SAVE IMP STACK POINTER
	MOVEM	BASE1,SAVB1	;AND CURRENT BASE REG. TOP LEVEL
	JSP	16,RESET.
	  EXP	0	;ARG TO FOROTS
	MOVEI	AC1,%%TRAP
	MOVEM	AC1,.JBAPR	;OVERWRITE FOROTS ERROR TRAPPING
	MOVEI	AC1,AP.REN!AP.POV!AP.ILM!AP.FOV!AP.AOV	; SET CONDITIONS
	APRENB	AC1,		;SET IT
	MOVE	BASE1,SAVB1	;RESTORE CURRENT BASE REGISTER
	MOVE	P,SAVP
	POPJ	P,

SAVP:	Z
SAVB1:	Z

	END