/////	RECURSIVE FORTRAN SUBROUTINES   \\\\\
/
/	JOHN VAN ESSEN	05MAR76
/
/	CALL RINIT
/	CALL ILOCAL
/	CALL FLOCAL
/	CALL RECUR
/
/	DOCUMENTATION IS FORTHCOMING!!!
/

/-----------------------------------------------------------

/	LIST OF ERROR MESSAGES:
/
/	REC!	RECURSION SYSTEM ERROR.
/	REC0	FAILURE TO CALL RINIT BEFORE CALLING OTHERS.
/	REC1	STACK OVERFLOW.
/	REC2	STACK UNDERFLOW.
/	REC3	ILLEGAL LOCAL CALL.
/	REC4	ILLEGAL RECUR CALL.
/	REC5	LOCAL STORAGE EXHAUSTED. (STACK OVERFLOW).

	ENTRY	RINIT
	ENTRY	ILOCA
	ENTRY	FLOCA
	ENTRY	RECUR

/	PAGE 0 LOCATIONS USED FOR TEMP. STORAGE
/	ALL LOCATIONS ARE CELLS USED FOR JMS FOR RUN-TIME
/	LINKAGES, DF CHANGING, ETC.

	ABSYM	IADDR	33	/ADDR OF CALL VIA JMS 33 OR 40.
	ABSYM	LPTR	40	/LTABL CONTENTS OF CURRENT ROUT.
	ABSYM	PCNT	45	/TEMP STORAGE.
	ABSYM	ACLOC	51	/AC STORAGE.
	ABSYM	LPARA	55	/LINKAGE PARAMETER.
	ABSYM	PADDR	62	/TEMP STORAGE.
	ABSYM	PTR	67	/ADDR OF EXTERNAL.


/	PAGE 0 LOCATIONS THAT CONTAIN DF INSTRUCTIONS.

	ABSYM	CDFCUR	34
	ABSYM	P0CIF0	35


/	CONSTANTS GENERATED IN THE ACCUMULATOR.

	ABSYM	MINUS3	7346	/CLA CLL CMA RTL
	ABSYM	MINUS2	7344	/CLA CLL CMA RAL
	ABSYM	MINUS1	7340	/CLA CLL CMA
	ABSYM	PLUS1	7301	/CLA CLL IAC
	ABSYM	PLUS2	7305	/CLA CLL IAC RAL
	ABSYM	PLUS3	7325	/CLA CLL IAC CML RAL
	ABSYM	PLUS4	7307	/CLA CLL IAC RTL
	ABSYM	PLUS6	7327	/CLA CLL IAC CML RTL


/	MISCELLANEOUS DEFINED OPERATIONS.

	ABSYM	CDF0	6201
	ABSYM	CDI0	6203

	ABSYM	RDF	6214
	ABSYM	RIF	6224

		/THESE ARE USED FOR DEBUGGING.
	ABSYM	MQL	7421	/LOAD MULTIPLIER QUOTIENT
	ABSYM	ACL	7701	/LOAD AC FROM MQ.


/	     SABR-GENERATED CDF INSTRUCTIONS ARE AVOIDED
/	AS MUCH AS POSSIBLE!!
/	     IN THE CASES WHERE GENERATION IS DESIRED, THE
/	COMMENT WILL CONTAIN  /*** SABR CDF ***  .

	OPDEF	TADI	1400
	OPDEF	DCAI	3400
	OPDEF	JMSI	4400
	OPDEF	JMPI	5400


/	PAGE BOUNDARIES ARE CONTROLLED BY SELF.

		LAP


/>>>>	THESE ROUTINES TAKE THE PLACE OF THE RUN-TIME
/	LINKAGE ROUTINES LOCATED IN PAGE 0 AT LOC. 400-530.
/	THE PATCH TO FORCE THE JUMPS TO THESE ROUTINES IS MADE
/	WHEN THE RECURSIVE SYSTEM INITIALIZATION ROUTINE
/	IS CALLED.

CLINKP,	CLINK
A0033,	0033		/CALL  GENERATES  JMS 33
CCODE,	DCA ACLOC	/  CALL N,SUBR   WAS EXECUTED!!
	TADI A0033	/GET INDEX PARA FROM CALLING FIELD.
	JMS LOOKUP
	INC IADDR	/POINT TO EXIT/1ST PARA
	TAD LPTR
	SZA		/SPECIAL SUBROUTINE?
	JMSI CLINKP	/YES.  HANDLE IT.
	TAD LPARA	/SAVE INDEX, SO ILOCA ,FLOCA ,RECUR
	DCA INDEX	/KNOW WHICH SUBR. IS BEING MADE RECUR.
CXIT,			/CLINK EXITS HERE.
	TAD CDFCL	/(DF SHOULD BE SET TO EXTERNAL'S DF)
	DCAI PTR	/STORE RETURN DATA FIELD.
	INC PTR
	TAD IADDR
	DCAI PTR	/STORE RETURN ADDR.
	INC PTR
	RDF
	TAD P0CIF0
	DCA CCIF
CCIF,	HLT		/CIF TO EXTERNAL FIELD.
	TAD ACLOC
	JMPI PTR	/GO TO THE CALLED SUBROUTINE.

RLINKP,	RLINK
A0040,	0040		/RETRN GENERATES JMS 40.
RCODE,	DCA ACLOC	/  RETRN SUBR    WAS EXECUTED!!
	TADI A0040	/GET INDEX PARA FROM CALLING FIELD.
	JMS LOOKUP
	PLUS2
	TADI PTR	/CDF OF FIELD TO RETURN TO.
	DCA RCDI	/CONVERTED TO CDI BY PLUS2.
	INC PTR
	TADI PTR	/ADDRESS.
	DCA LOOKUP	/TEMP.
	TAD LPTR
	SZA		/SPECIAL SUBROUTINE?
	JMSI RLINKP	/YES.  HANDLE IT.
RXIT,			/RLINK EXITS HERE.
RCDI,	HLT		/CDI TO RETURN FIELD.
	TAD ACLOC
	JMPI LOOKUP	/GO TO RETURN POINT.


/>>>>	JMS LOOKUP  -  LOOK UP INFO ON EXTERNAL IN TABLES.
/
/	EACH TABLE IS 100 OCTAL WORDS LONG.
/
/	CDF TABLE	FIELD 0  ADDR 200
/	ADDR TABLE	FIELD 0  ADDR 300
/	LOCALS TABLE	FIELD F  ADDR LTABL
/
/	ENTRY:	DF = CALLING FIELD'S DF.
/		AC = ADDR OF INDEX PARA IN CALLING FIELD.
/	EXIT :	AC = 0.  DF SET TO EXTERNALS DF.

LOOKUP,	0
	DCA IADDR
	RDF
	TAD CDF0L
	DCA CDFCL	/CDF FOR CALLING FIELD.
	TADI IADDR
	AND (0077	/INDEX ONLY.
	DCA LPARA
	TAD LPARA
	TAD (200
	DCA PTR
CDF0L,	CDF0
	TADI PTR	/CDF FOR EXTERNAL.
	DCA CDFEX
	TAD PTR
	TAD (100
	DCA PTR
	TADI PTR	/ADDR OF EXTERNAL.
	SNA
	JMP UNDEF
	DCA PTR
	TAD LPARA
	TAD LTABLA
	DCA LPTR
	TAD I LPTR	/*** SABR CDF ***
	DCA LPTR
CDFEX,	HLT		/EXECUTE CDF FOR EXTERNAL.
	JMPI LOOKUP

INDEX,	0		/INDEX OF LAST NON-SPECIAL CALL.
LTABLA,	LTABL
UNDEF,	CDI0
	JMPI UNDEFX
UNDEFX,	535		/FIELD 0 LOCATION WHERE UNDEF EXT.
			/ARE HANDLED WITH USR CALL.


/>>>>	JMS DOINIT  -  PERFORMS MINOR INITIALIZATION.
/
/		MAJOR PATCHING IS DONE ONLY ONCE.
/	EXIT :	AC = 0.  DF = CURRENT DF.

DOINIT,	0		/DON'T CARE IF SABR GENERATES CDF'S.
	TAD SEMPTP
	DCA STACKP
	CMA
	DCA INDEX	/CREAM INDICES.
	CMA
	DCA LOCIX
	DCA RECURP	/INIT LOCAL VAR PROCESSED POINTER.
			/BUT DO NOT INIT LOCAL LIST POINTERS.
	JMPI DOINIT


/>>>>	JMP ERR  -  ERROR IN RECURSION SYSTEM.
/
/	ENTRY :	AC = ERROR NUMBER FOR  "REC#" MESSAGE.
/
/	EXIT :	TO OS/8 VIA "ERROR" ROUTINE.

ERR,	TAD (0360
	DCA ERRM#
	TAD IADDR
	DCA FAKE
	CALL 1,ERROR
	ARG ERRM
ERRM,	2205;0377	/ "REC?"
CDFCL,	0
FAKE,	0


	PAGE

/>>>>	JMS CLINK  -  HANDLE SPECIAL CALL LINKAGES.
/
/	ENTRY :	DF = DF OF EXTERNALS FIELD.
/		AC = LTABL CONTENTS FOR EXTERNAL BEING CALLED.
/	EXIT :	AC = 0.   DF SET TO SAME AS UPON ENTRY.
/		EXIT TO ADDRESS  CXIT.

CDF0X,	CDF0
RTEMP1,
CLINK,	0
	DCA CTEMP1	/SAVE CONTENTS.
	ISZ CTEMP1	/ONE OF OUR ROUTINES?
	JMP CTEST2	/NO.
	JMP XROUT	/YES.   EXECUTE IT.

PUSHL,	PUSH
PUSHXL,	PUSHX

CTEST2,	RDF
	TAD CDF0X
	DCA CXCDF
	TAD CXCDF
	DCA I PUSHXL	/*** SABR CDF ***  SET UP PUSH CALLS.
	ISZ CTEMP1	/ANY LOCALS TO SAVE?
	JMS PUSHLV	/YES.  SAVE THEM.
	TAD PTR		/SET UP CALL TO PUSH
	DCA PADDR	/TO SAVE OLD RETURN BLOCK.
	MINUS2
	JMSI PUSHL
CXCDF,	HLT
	JMPI CXITL
CXITL,	CXIT


/>>>>	JMS PUSHLV  -  PUSH LOCAL VARIABLES.
/
/	ENTRY :	'LPTR' CONTAINS POINTER TO LOCAL VAR LIST.
/		THAT WAS GOTTEN OUT OF LTABL.
/		'PUSHX' IN 'PUSH' ROUTINE SHOULD BE SET.
/	EXIT :	AC = 0.  DF = CURRENT.


/	THE VALUES ARE PUSHED ON THE STACK IN REVERSE ORDER,
/	AND ARE POPPED IN FORWARD ORDER.   THEREFORE, MUST
/	FIND END OF LIST, AND WORK BACKWARDS.

RTEMP2,
PUSHLV,	0
LLCDF1,	HLT
PUSHV1,	TADI LPTR
	SNA CLA		/END OF LIST?
	JMP PUSHV2	/YES.
	INC LPTR	/NO.  LOOK AT NEXT.
	INC LPTR
	JMP PUSHV1

PUSHV2,	CMA		/BACK UP POINTER.
	TAD LPTR
	DCA LPTR
LLCDF2,	HLT
	TADI LPTR	/FWA
	SNA		/END (TOP) OF LIST?
	JMP PUSHVX	/YES.
	DCA PADDR
	CMA
	TAD LPTR	
	DCA LPTR
	TADI LPTR	/-COUNT.
	JMSI PUSHL
	JMP PUSHV2

PUSHVX,	JMP I PUSHLV	/*** SABR CDF ***


/>>>>	JMS RLINK  - HANDLE SPECIAL  RETURN LINKAGE.
/
/	ENTRY :	DF = DF OF EXTERNALS FIELD.
/		AC = LTABL CONTENTS FOR EXTERNAL BEING EXITED.
/	EXIT :	AC = 0.   DF = ?

CTEMP1,
RXITL,
RLINK,	0
	DCA RTEMP1
	ISZ RTEMP1
	JMP RTEST2
	TAD (-17
	JMP ERR

POPL,	POP
POPXL,	POPX

RTEST2,	RDF
	TAD CDF0X
	DCA I POPXL	/*** SABR CDF ***  SET UP POP CALLS.
	MINUS1		/RCODE MOVED IT TO ADDR...
	TAD PTR		/SET UP FOR CALL TO POP
	DCA PADDR	/TO GET OLD RETURN BLOCK.
	MINUS2
	JMSI POPL
	ISZ RTEMP1	/ANY LOCALS TO RESTORE?
	JMP POPLV	/YES.
RXITX,	JMPI RXITL

/	POPLV - POP LOCAL VARIABLES.
/
/	THE VARIABLES WERE PUSHED IN REVERSE ORDER,
/	SO WE CAN SEQUENTIALLY POP THE VALUES.

LLCDF3,
POPLV,	HLT
	TADI LPTR	/-COUNT.
	SNA		/END OF LIST?
	JMP RXITX	/YES.
	DCA RTEMP2
	INC LPTR
	TADI LPTR	/FWA.
	DCA PADDR
	INC LPTR
	TAD RTEMP2
	JMSI POPL
	JMP POPLV


/	XROUT - EXECUTE ONE OF OUR SPECIAL
/		RECURSION HANDLER ROUTINES.
/		(ILOCA  FLOCA  RECUR)
/		(  NOT RINIT!  )

XROUT,	TAD CDFCL	/*** SABR CDF ***
	DCA SCDFX	/INIT FOR SETDF CALLS.
	JMS FIND	/CUTE WAY OF INITIALIZING A PTR.
QFLOCA,	CALL 0,FLOCA	/WILL GET US AN INDEX...
	JMP XFLOCA	/EXIT TO THIS LOC IF INDICES MATCH.
QILOCA,	CALL 0,ILOCA
	JMP XILOCA
QRECUR,	CALL 0,RECUR
	JMP XRECUR
	0000

FIND,	0		/FIND INDEX # OF SPECIAL ROUTINE
			/THAT WAS FLAGGED WITH A -1 IN THE
			/ROUTINES ENTRY IN LTABL.
FIND1,	TAD I FIND	/*** SABR CDF ***
	SNA CLA		/ANOTHER ENTRY?
	JMP MYERR	/NO.
	INC FIND
	TAD I FIND
	INC FIND
	CIA
	TAD LPARA
	SNA CLA		/MATCH?
	JMP I FIND	/YES.
	INC FIND
	JMP FIND1

MYERR,	TAD (-17
	JMP ERR		/TRANSFORM "0" INTO "!".


	PAGE

/		POINTERS.
/	******   THEY MUST BE IN THIS ORDER  *******
/	******   (SEE  ONCE  ROUTINE ON LAST PAGE)  ******

LFULLP,	0		/LWA AVAILABLE IN LOCAL LIST.
STACKP,	0		/NEXT LOCATION ON STACK.
SEMPTP,	0		/FWA OF STACK.
SFULLP,	0		/LWA+1 OF STACK.
LOCALP,	0		/LAST USED LOCATION IN LOCAL LIST.


/>>>>	JMS PUSH  -  PUSH DATA ONTO STACK.
/
/	ENTRY :	AC = -NUMBER OF WORDS TO PUSH.
/		'PADDR' CONTAINS FWA OF WORDS TO PUSH.
/		'PUSHX' CONTAINS CDF FOR WORDS BEING PUSHED.
/	EXIT :	AC = 0.  DF = ?
/		'PADDR' = 'PADDR' + NUMBER OF WORDS PUSHED.

PUSH,	0
	DCA PCNT	/STORE -COUNT
	TAD STACKP
	DCA POP		/INIT TEMP POINTER.
	TAD STACKP
	CLL CIA
SFULC1,	TAD SFULLP
	TAD PCNT	/FULLP-STACKP-COUNT.
	SZL		/ROOM LEFT?
	JMP PSHERR	/NOPE.   OVERFLOW.
	CIA		/STACKP+COUNT-FULLP
SFULC2,	TAD SFULLP	/STACKP+COUNT
	MQL		/*** DEBUG ***\
	ACL		/*** DEBUG ***\
	DCA STACKP	/NEW STACK POINTER.

PUSH1,
PUSHX,	HLT		/CDF FOR DATA.
	TADI PADDR
STCDF1,	HLT
	DCAI POP
	INC PADDR
	INC POP
	ISZ PCNT
	JMP PUSH1
	JMPI PUSH

/	ERROR EXITS.

ERRP,	ERR
PSHERR,	PLUS1
	JMPI ERRP

POPERR,	PLUS2
	JMPI ERRP

LLERR,	TAD (5
	JMPI ERRP


/>>>>	JMS POP  -  POP DATA FROM STACK.
/
/	ENTRY :	AC = -NUMBER OF WORDS TO POP.
/		'PADDR' CONTAINS FWA OF WORDS TO POP.
/		'POPX' CONTAINS CDF FOR WORDS BEING POPPED.
/	EXIT :	AC = 0.  DF = ?
/		'PADDR' = 'PADDR' + NUMBER OF WORDS POPPED.

POP,	0
	DCA PCNT
	TAD SEMPTP
	CLL CIA
	TAD STACKP
	TAD PCNT	/STACKP-EMPTYP-COUNT
	SZL		/ENOUGH TO POP?
	JMP POPERR	/BAD.  SHOULD NEVER HAPPEN.
	TAD SEMPTP	/STACKP-COUNT
	MQL		/*** DEBUG ***\
	ACL		/*** DEBUG ***\
	DCA STACKP	/NEW STACK POINTER.
	TAD STACKP
	DCA PUSH	/INIT TEMP. POINTER.

STCDF2,
POP1,	HLT
	TADI PUSH
POPX,	HLT
	DCAI PADDR
	INC PADDR
	INC PUSH
	ISZ PCNT
	JMP POP1
	JMPI POP


/>>>>	JMS LLDEP - DEPOSIT VALIUE IN LOCAL LIST AREA.
/
/	ENTRY :	AC = CONTENTS TO DEPOSIT.
/	EXIT :	DF = CURRENT DF.

LLDEP,	0
	DCA PUSH	/STORE CONTENTS TEMP.
LFULC1,	TAD LFULLP
	CIA
	TAD LOCALP	/LOCALP-FULLP
	SNA CLA		/STILL ROOM?
	JMP LLERR	/NOPE.
	MINUS1
	TAD LOCALP	/BACK UP POINTER.
	DCA LOCALP
	TAD PUSH
LLCDF4,	HLT
	DCAI LOCALP
	JMP I LLDEP	/*** SABR CDF ***


/>>>>	JMS NOPIT  -  CANCEL CALL CODE WITH NOP'S.
/
/	ENTRY :	AC = -NUMBER OF WORDS TO CANCEL.
/		'IADDR' CONTAINS LWA+1 OF WORDS TO CANCEL.
/	EXIT :	AC = 0.  DF = CALLING FIELD DF.

NOPIT,	0
	DCA PCNT
	TAD PCNT
	TAD IADDR
	DCA PADDR
	JMS SETDF
NOP1,	TAD NOPEX
	DCAI PADDR
	INC PADDR
	ISZ PCNT
	JMP NOP1
	JMPI NOPIT
NOPEX,	NOP


	PAGE

/>>>>	TRAP ANY PREMATURE CALLS.
/
/	THE CALLS TO THESE ROUTINES IS HANDLED AFTER
/	RINIT HAS BEEN CALLED.   IF THEY ARE CALLED BEFORE,
/	IT IS AN IMPROPER CALLING SEQUENCE.

RECUR,
FLOCA,
ILOCA,	BLOCK 2
	JMP ERR		/ERR # = 0.


/>>>>	EXECUTION OF    CALL RINIT

RINIT,	BLOCK 2
RINIT1,	JMS ONCE	/ONLY CALLED ONCE!
	TAD (7000
	DCA RINIT1
	JMS DOINIT
	RETRN RINIT


/>>>>	EXECUTION OF    CALL ILOCAL(IPAR)

XILOCA,	MINUS1
	JMP LOCAL


/>>>>	EXECUTION OF    CALL FLOCAL(FPAR)

XFLOCA,	MINUS3
	JMP LOCAL


/>>>>	EXECUTION OF    CALL RECUR

XRECUR,	PLUS4
	JMS CHECKP
	TAD INDEX
	TAD LTABLP
	DCA CHECKP	/TEMP.
	TAD RECURP
	SNA		/ANY LOCALS?
	JMP XREC1	/NO.
	DCA LPTR	/YES.   SET UP PUSHLV CALL.
	JMS LLDEP	/FIRST, END THIS LOCAL LIST WITH 0.
	TAD SCDFX
	DCA PUSHX
	JMS PUSHLV
	SKP
XREC1,	MINUS2		/AC = -2 IF NO LOCAL PARAS.
	TAD RECURP	/AC = ADDR OF LLIST IF LOCAL VARS.
	DCA I CHECKP	/*** SABR CDF ***  STORE INTO LTABL.
	TAD HLTADR	/PUSH DUMMY RETURN ADDRESS.
	DCA PADDR	/REAL ONE ALREADY CREAMED, AND WAS
	TAD CDFCUR	/WORTHLESS, ANYWAY.
	DCA PUSHX
	MINUS2
	JMS PUSH
	DCA RECURP	/RESET LOCAL VAR LIST POINTER.
	MINUS2
	JMS NOPIT	/CANCEL CALL CODE.   CLINK WILL HANDLE
			/THE CALLS FROM NOW ON.

XXIT,	PLUS2		/EXIT FROM RECUR,ILOCA,FLOCA.
	TAD SCDFX
	DCA XXIT1	/DEPOSIT CDI.
XXIT1,	HLT
	JMPI IADDR

RECURP,	0	/PTR TO LAST LLIST ENTRY (0 IF NONE).
HLTADR,	HLTADR#
	HLT		/THIS WILL BE RESTORED TO CDF SLOT
			/UPON LOWEST LEVEL RETURN.


/>>>>	JMP LOCAL  -  PROCESS LOCAL CALL.
/
/	ENTRY :	AC = -NUMBER OF WORDS IN VARIABLE.
/		'SCDFX' CONTAINS CDF FOR ARGUMENT DUMMY.
/		'IADDR' CONTAINS ADDRESS OF ARGUMENT DUMMY.
/	EXIT :	BACK TO PROGRAM THROUGH XXIT.

/	     THE VARIABLES DATA FIELD MUST BE SAME AS CALLING
/	DATA FIELD.
/	     THE LENGTH AND FWA ARE PUT ON THE LOCAL LIST
/	STACK IN REVERSE ORDER, SO THE WILL BE REFERENCED
/	PROPERLY WHEN THE LIST IS PROCESSED.

LOCAL,	DCA PCNT
	PLUS3
	JMS CHECKP
	JMS SETDF
	TADI IADDR	/VERIFY THAT THE VARIABLE'S DF IS SAME
	CIA		/AS SUBROUTINES DF.
	TAD SCDFX
	SZA CLA		/ARE THEY THE SAME?
	JMP LOCERR	/NO.
	INC IADDR	/(DF IS STILL SET TO CALLING FIELD)
	TADI IADDR	/ADDR OF DATA.
	JMS LLDEP	/PUT ADDR IN LOCAL LIST.
	TAD PCNT
	JMS LLDEP	/PUT LENGTH IN LOCAL LIST.
	INC IADDR	/MOVE TO EXIT POINT FOR LOCAL ROUTINE.
	TAD LOCALP	/SAVE THIS POINTER TO BE USED
	DCA RECURP	/AS INDICATOR IN LOCAL TABLE.
	TAD (-4
	JMS NOPIT	/PUT NOP'S OVER CALL CODE.
	JMP XXIT

LOCERR,	PLUS3
	JMP ERR


/>>>>	JMS SETDF  -  SET DF TO CALLING DF.
/
/	ONLY THE DF IS CHANGED.

SETDF,	0
SCDFX,	HLT		/SHOULD BE SET TO CDFEX
	JMPI SETDF


/>>>>	JMS CHECKP  -  CHECK LOCAL PROCESSING.
/
/	ENTRY :	AC = ERROR # IN CASE OF ERROR.  DF = ?
/		'INDEX' CONTAINS INDEX OF ROUTINE
/			THAT IS BEING MADE RECURSIVE.
/		'RECURP' CONTAINS 0 IF NO LOCAL VARS PROCESSED
/			SINCE LAST RECUR CALL, OR CONTAINS
/			POINTER TO FWA OF LLIST.
/		'LOCIX' CONTAINS INDEX OF ROUTINE WHICH WAS
/			LOCALIZING VARIABLES.
/		'INDEX' CONTAINS INDEX OF CURRENT ROUTINE.
/	EXIT :	AC = 0.  DF = CURRENT.

/	     IT VERIFIES THAT THE ROUTINE HAS NOT ALREADY
/	BEEN MADE RECURSIVE.
/	     IT VERIFIES THAT THE CALL CAME FROM THE SAME
/	FIELD AS THE ONE LAST ENTERED BY A NORMAL CALL.
/	     IT VERIFIES THAT THE PREVIOUS LOCAL CALL
/	(IF ANY) AND THE CURRENT CALL BOTH CAME FROM THE 
/	SAME ROUTINE.

CHECKP,	0
	DCA SETDF	/TEMP.
	TAD INDEX	/*** SABR CDF ***
	TAD LTABLP
	DCA PADDR
	TAD I PADDR
	SZA CLA		/ALREADY RECURSIVE?
	JMP CHKPE	/YES.
	MINUS1
	TAD CCIF	/CONVERT TO CDF.
	CIA
	TAD SCDFX
	SZA CLA		/SAME FIELD?
	JMP CHKPE	/NO.
	TAD RECURP
	SZA CLA		/ANY LOCAL CALLS MADE?
	JMP CHKP1	/YES.
	TAD INDEX	/NO.
	DCA LOCIX	/SAVE THE ROUTINES INDEX.
	JMPI CHECKP

CHKP1,	TAD INDEX	/*** SABR CDF ***
	CIA
	TAD LOCIX
	SNA CLA		/SAME INDEX?
	JMPI CHECKP	/YES.
CHKPE,	TAD SETDF	/GET ERR # OUT OF TEMP.
	JMP ERR

LTABLP,	LTABL
LOCIX,	0		/INDEX OF ROUTINE IN WHICH
			/LOCAL CALLS ARE BEING MADE.


	PAGE

/	DEFINE STORAGE FOR 64 WORD TABLE THAT WILL CONTAIN
/
/	0	IF ROUTINE IS NOT RECURSIVE OR SPECIAL.
/	-1	IF ROUTINE IS ONE OF OUR RECURSIVE SETUP
/		ROUTINES.  ( RECUR  ILOCA  OR  FLOCA )
/	-2	IF ROUTINE IS RECURSIVE, BUT HAS NO LOCAL VARS.
/	ADDR	IF ROUTINE IS RECURSIVE, AND HAS LOCAL VARS
/		TO SAVE/RESTORE.   ADDR IS PTR TO FIRST ENTRY
/		IN LLIST.

LTABL,	0

	PAGE


/>>>>	JMS ONCE  -  ONCE ONLY EXECUTED INITIALIZATION.
/
/	CALLED FROM VERY FIRST CALL OF RINIT!

ONCE,	0		/***  MUST BE 1ST LOC ON PAGE !!!  ***
			/***  MIGHT BE USED AS STACK !!!!  ***

	TAD HIEST	/ROUND UP TO TOP OF PAGE.
	AND (7600
	TAD (177
	DCA HIEST

/	INSTALL PATCH IN FIELD 0 LINKAGE ROUTINES.

	RIF
	TAD P0CIF0
	DCA SCR
ONCE2,	TAD I PATCH	/*** SABR CDF ***
	SNA
	JMP ONCE3
	DCA PADDR
	INC PATCH
	TAD I PATCH
	SNA
	TAD SCR
	CDF0
	DCAI PADDR
	INC PATCH
	JMP ONCE2

PATCH,	PATCH#
	460		/ADDRESS IN FIELD 0.
	0000		/(CIF IS SUBSTITUTED)
	461
	5662		/JMP I 462
	462
	CCODE

	475
	0000		/(CIF IS SUBSTITUTED)
	476
	5677		/JMP I 477
	477
	RCODE

	0000		/END OF TABLE

OPTR1,	200
OPTR2,	300
OCTR1,	-100
SFIRST,	ONCE

/	MAKE SURE WE HAVE ENTIRE FIELD FROM HERE ON UP.

ONCE3,	CDF0
	TADI OPTR1	/EXTERNAL'S CDF.
	CIA
	TAD CDFCUR
	SZA CLA		/THIS FIELD?
	JMP ONCE31	/NO.
	TADI OPTR2	/GET ENTRY ADDRESS.
	CLL CML CIA
	TAD HIEST
	SNL CLA		/LOADED HIGHER UP?
	JMP ONCE31	/NO.  IS O.K. THEN.
	TAD HIEST
	IAC
	JMP ONCE4

ONCE31,	INC OPTR1
	INC OPTR2
	ISZ OCTR1
	JMP ONCE3
	TAD (7600

/	INITIALIZE LIMIT POINTERS FOR LLIST AND STACK.
/			LFULLP IS SAME AS STACKP.
/			SFULLP IS SAME AS LOCALP.
/			STACKP GETS INITIALIZED IN DOINIT.

ONCE4,	DCA SCR		/AC = LWA+1 OF AVAIL. STORAGE.
	TAD SFIRST
	DCA SEMPTP	/*** SABR CDF ***
	TAD SCR
	DCA LOCALP

/	STACK AND LLIST ARE IN SAME FIELD AND
/	SHARE THE SAME BUFFER.   THEREFORE, THE POINTER
/	FOR ONE IS THE LIMIT FOR THE OTHER.   MODIFY
/	LIMIT CHECKING INSTRUCTIONS TO ACCOUNT FOR THIS.

	INC LFULC1
	INC SFULC1
	INC SFULC2

/	INIT ALL CDF SETS.

ONCE5,	TADI CDFLOC
	SNA
	JMP ONCE6
	DCA PADDR
	TAD CDFCUR
	DCAI PADDR
	INC CDFLOC
	JMP ONCE5

CDFLOC,	CDFLOC#
	LLCDF1
	LLCDF2
	LLCDF3
	LLCDF4
	STCDF1
	STCDF2
	0000

LTPTR,	LTABL
LTCNT,	-100

/	INIT LTABL TO 0000'S

ONCE6,	DCAI LTPTR
	INC LTPTR
	ISZ LTCNT
	JMP ONCE6

/	SET LTABL ENTRIES FOR  ILOCA, FLOCA, AND RECUR.

	TAD QFLOCA#
	JMS SETLTE
	TAD QILOCA#
	JMS SETLTE
	TAD QRECUR#
	JMS SETLTE

/	SET FIRST WORD (TOP WORD) OF LLIST TO 0.

	JMS DOINIT
	JMS LLDEP

	JMP I ONCE

LTABL0,	LTABL
SCR,
SETLTE,	0
	TAD LTABL0
	DCA PADDR
	MINUS1
	DCAI PADDR
	JMPI SETLTE

HIEST,	HIEST		/ROUNDED UP TO LWA OF LAST PAGE.
			/(MUST BE ON LAST PAGE)

	PAGE


	END