Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH	MTHPRM,FORPRM
	TV	FORINI	INITIALIZE FOROTS LOWSEG, 10(4204)
	SUBTTL	/DAW/JLC/AHM/BL/PLB/CDM		16-Feb-84

; Previous authors (before V6)
;	D. TODD/DRT/HPW/DMN/MD/JNG/SWG/CAL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

***** Begin Version 6 *****

1262	DAW	 9-Feb-81
	Allow FORINI to run in a non-zero section. (Assumes
	that all code is in the same section).

1530	JLC	10-Jul-81
	FOROTS becomes FOROT6.

1623	DAW	21-Aug-81
	Entry point RESET$ to test extended addressing in FOROTS.

2005	JLC	15-Oct-81
	Added REENTER code. Make DDT-20 understand symbol tables
	at other than 400000.

2007	JLC	16-Oct-81
	Fixed temp stack to be larger for reenter code.

2033	DAW	19-Nov-81
	Fixed problems in REENTER code.

***** Begin Version 7 *****

3035	JLC	29-Jan-81
	FOROT6 becomes FOROT7.

3056	JLC	23-Mar-82
	Rework lowseg/hiseg dispatch, save ACs in lowseg.

3101	JLC	5-Apr-81
	Modified lowseg/hiseg interface - address of user's ACs
	are now passed in F instead of T1.

3102	JLC	7-Apr-82
	Fix OTS/NONSHAR, INIT call was going to 0. Slightly modify
	passing of return address of RESET. - PDL is now in
	the lowseg.

3103	JLC	8-Apr-82
	More minor changes to lowseg/hiseg interface. Stack setup
	is now done totally in FORINI.

3122	JLC	28-May-82
	Change lowseg/hiseg interface again. Now uses 2-word entries.

3123	JLC	29-May-82
	Modified interface again to make it faster.

3125	JLC	3-Jun-82
	Moved AC save routine to hiseg again.

3137	AHM	30-Jun-82
	Development patches for running entirely in a non-zero section
	for V8.  If .JBSA in  RESET.'s section contains 0,  synthesize
	reasonable numbers to put in  JOBDAT for the current  section.
	Do XGVEC% and XSVEC% to  save and restore the program's  entry
	vector.  Set  up a  global  stack pointer  when running  in  a
	non-zero section.  Don't pass the  address of AU.ACS to  INIT.
	in F, since it isn't used any more.

3156	AHM	21-Jul-82
	Don't do XGVEC% and XSVEC% unless we are running in a non-zero
	section so that we can run UNDER Tops-20 release 4.1 on a  KS.
	Also, do private OPDEFs of  PDVOP%, XGVEC% and XSVEC% so  that
	FORINI will assemble with release 4.1 MONSYM.

3163	AHM	24-Aug-82
	Make FAKJBD a little more paranoid about blamming the location
	that 770001 references with a symbol table pointer by checking
	770000 for  JRST  770002 ala  EXEC  and OVRLAY.   Use  section
	defaulting in RPACS% calls.  Don't zero left half of .JBREN.

3177	BL	14-Sep-82
	Store DBMS entry vector at .JBBLT.

3202	JLC	26-Oct-82
	Install non-skip (error) return from CLOSF.

3205	AHM	28-Oct-82
	Add code under IF20 conditional to define %SRTAD (SORT's start
	address) here, zero it upon restart, and toss the section that
	SORT is in, if it owns its own section.

3220	AHM	18-Nov-82
	Replace non-zero section tests that depended upon the sign  of
	the stack pointer  with a check  that uses XMOVEI  so that  we
	know which section we are currently executing in.

3231	JLC	14-Dec-82
	RESET. becomes FOROK. for new DBMS interface.

3235	AHM	16-Dec-82
	Fix ACs for entry vector JSYS call around code to GET% FOROTS.

3236	JLC	17-Dec-82
	Move setup of FUNCT. in .JBBLT to FORMEM.

3244	JLC	30-Dec-82
	Moved setup of FUNCT. back into FORINI, as PORTAL is
	almost inaccessible from hiseg. Changed the name of
	DBSTP$ to a FOROTS entry, resolved by a file later
	in FORLIB if DBMS program, resolved to dummy one if
	no DBMS program.

3245	JLC	4-Jan-82
	Look at %DBSTP to determine whether to GETSEG FOROT7.EXE
	or FDBOT7.EXE.

3246	JLC	5-Jan-83
	Put PORTAL back here.

3252	JLC	12-Jan-83
	Move KSORT to FORSRT.MAC.

3253	JLC	13-Jan-83
	Change %FRSNONSHARE to %FRSNS. Change %FRSLOAD to %FRSLO.
	Fix CLSFIL to set up 'STOP!!' on stack to stop traceback loop.

3254	CKS	13-Jan-83
	Do not set up .JBHSO so that FOROTS symbols will not be seen by DDT
	unless user explicitly requests them by setting up .JBHSO.

3260	JLC	17-Jan-83
	Make KSORT an EXTERN on the -10 so it will be drawn in to
	get %SRTAD.

***** End V7 Development *****

3354	TGS	3-Oct-83	SPR:NONE
	Move setup of DBMS entry vector from FORINI to FOROTS.  Store
	FUNCT address in .JBBLT+2 as well as .JBBLT.


BEGIN V10

4000	JLC	22-Feb-83
	Make RESET$ entry restartable.

4002	JLC	23-Feb-83
	Code review changes.

4006	JLC	28-Feb-83
	FOROT7 becomes FORO10.

4022	PLB	28-Jun-83
	Ream FORINI so it will get FOROTS into another section,
	this includes section searching.

4023	JLC	29-Jun-83
	Move CHRPT. from here to FORCHR. Insert global symbols
	F.BOT and F.TOP, both set to zero, to resolve them
	and keep them out of the way for FORMEM.

4025	JLC	1-Jul-83
	Add arg block for user subroutine calls on library traps.

4031	JLC	7-Jul-83
	Fix JBHRL so it looks like LINK built it.

4037	JLC	31-Aug-83
	Modify GET code to allow for FORO10.EXE having a page 0,
	which will now be ignored.

4042	JLC	8-Sep-83
	Fix GTFRSX so that it will avoid page 0 of FOROTS for
	non-zero sections.

4065	JLC	6-Dec-83
	Just some cleanup.

4066	JLC	11-Jan-84
	Just a little bit more cleanup.

4072	JLC	24-Jan-84
	New lowseg/hiseg value-passing interface.

4101	CDM	16-Feb-84
	Create and expand the  character stack differently when  running
	in extended addressing.   Give the stack  its own section(s)  so
	that it has plenty of room.  Also add user subroutine ALCCHR.

4104	JLC	23-Feb-84
	Add a new internal which is (FLGVX. V FLG77.) for use
	in subroutine entries.

4111	JLC	16-Mar-84
	Moved code around to eliminate the "percented" entry points
	in FOROTS, and avoid loading the GETSEG code if there is nothing
	to GETSEG.

4112	JLC	19-Mar-84
	Removed code for FDBOTS, no longer needed.

4116	JLC	6-Apr-84
	Fix DOCLS, stack setup was not updated for extended addressing.

4117	JLC	26-Apr-84
	Fix DOCLS for TOPS-20 entry vector.

4122	JLC	2-May-84
	Fix .JBSYM so it has IOWD format symbol pointer for FORDDT
	and FORERR.

4123	JLC	5-May-84
	Install REENT., the reenter address for /EXTEND. By default
	a REENTER command will go to code which merely does an EXIT
	(TOPS-10) or a CLOSF and HALTF (TOPS-20).

4127	JLC	15-May-84
	Fixed some TOPS-10 code.

4131	JLC	12-Jun-84
	Fix %EXTND, broken in some previous rework.

4134	JLC	3-Jul-84
	Fix REENTER, was broken by half-word fixup. Make it
	Polish, so it will get a full-word fixup.

4144	JLC	29-Aug-84
	Remove code to put FOROTS in its own section, since this
	would make it impossible to use V7 and non-extend rel files
	with extended code.

4147	MRB	11-Sep-84
	Change the symbol named FLGVX. to FLGV. 

4152	JLC	24-Sep-84
	Remove FAKJBD, replaced with much enhanced code in FORMEM.
	Add new RESET entry point for use by FORDDT which sets
	a flag to prevent the RESET. call from the FORTRAN
	program from doing another one.

4153	JLC	27-Sep-84
	Fix start address recording problem introduced by edit 4152,
	by adding an entry in the initialization arg block containg
	the start address.

4155	JLC	4-Oct-84
	Modify REENTER behavior to what it should have been - HALTF%
	or EXIT 1, and do not close any files.

4203	JLC	13-Mar-85
	Fix REENTER on TOPS-10.

4204	MRB	15-Mar-85
	Moved DUMVAX and DUMF77 to here from FORINI.  Aleviates the 
	undefinied globals when searching FORLIB for math routines
	in a non-FORTRAN program.

***** End V10 Development *****

***** End Revision History *****

\

	SEGMENT	CODE

	ENTRY	FOROT.,FOROT$,FINIT.

	EXTERN	%DBSTP,%EXTND,FLG77.,FLGV.
	EXTERN	KCHST.,KDBMS.,KSORT.
	EXTERN	%LARGL
	EXTERN	%GOGET

	INTERN	F.TOP,F.BOT,F.BHS,FLGON.,%ENTVC,%GTSEC,%EXICL

	DEFINE	X(E) <EXTERN	E'.>
	FORVEC

	F.BHS==0		;BOTTOM OF FOROTS HIGH SEGMENT IS ZERO
	F.TOP==0		;TOP AND BOTTOM OF FOROTS ARE
	F.BOT==0		;ZERO FOR /OTS:NONSHARE

	FLGON.==FLGV.!FLG77.	;[4147] NON-ZERO IF EITHER VAX OR ANSI FLAGGING


;RESET. WILL GETSEG FOROTS IF IT WAS NOT LOADED WITH THE PROGRAM.
;IF FOROT% HAS NOT BEEN DEFINED, IT IS RESOLVED IN
;FORNON, AND FOROTS WILL BE LOADED WITH THE USER PROGRAM.
;IF FOROT% HAS BEEN DEFINED, EITHER BY
;LINK OR IN THE LINK COMMAND STRING, THE GETSEG ROUTINE IS LOADED.
;
;CALL:
;	JSP	16,RESET.
;	 0			;ARG, IGNORED
;
;RETURNS WITH FOROTS PRESENT AND INITIALIZED.  SETS UP P.
;CAN DESTROY ALL ACS

FINIT.:	SETOM	FDDTFL		;SET THE "INIT FROM FORDDT" FLAG
	JRST	INCOM		;JOIN COMMON INIT CODE

FOROT.:!
	PORTAL	.+1		;ALLOW ENTRY FROM PUBLIC
	SKIPN	FDDTFL		;DID WE JUST INIT FROM FORDDT?
	 JRST	INCOM		;NO. JUST A PLAIN OLD INIT CALL
	SETZM	FDDTFL		;YES. MAKE SURE WE DON'T LEAVE IT THAT WAY
	XMOVEI	T1,@L		;[4153] GET RETURN ADDRESS
	SUBI	T1,2		;[4153] POINT TO START ADDRESS OF PROGRAM
	MOVEM	T1,STADR	;[4153] SAVE IT FOR FORERR
	JRST	1(L)		;AND RETURN TO USER IMMEDIATELY
				;SINCE WE DON'T WANT TO RESET FORDDT'S INIT

INCOM:	SKIPN	[%EXTND]	;DO WE WANT TO RUN IN SECTION 1?
	 JRST	NOMAP		;NO. DON'T

FOROT$:!
	PORTAL	.+1		;ALLOW ENTRY FROM PUBLIC
	SKIPE	MAPPED		;[4022] ALREADY MAPPED?
	 JRST	DOEXTJ		;YES. DON'T TRY AGAIN
	XMOVEI	T1,.		;GET CURRENT SECTION IN LH
	TLNE	T1,-1		;ALREADY IN NON-ZERO SECTION?
	 JRST	NOMAP		;YES. DON'T MAP SECTIONS TOGETHER
	MOVE	P,[IOWD LPDL,INIPDL] ;[4022] SET UP LOCAL STACK (TEMP)
	PUSHJ	P,%GTSEC	;[4022] FIND A FREE SECTION
	 JRST	MAPERR		;[4022] NO YOU DON'T
	MOVEM	T1,SECNUM	;SAVE THE SECTION NUMBER
	PUSHJ	P,MAPSEC	;MAP SECTION ZERO TO SOME NON-ZERO SECTION
	SETOM	MAPPED		;FLAG WE ARE MAPPED

DOEXTJ:	SETZ	T1,		;[4022] FLAGS
	HRLZ	T2,SECNUM	;[4131] GET SECTION NUMBER
	HRRI	T2,EXTJ		;[4022] ,, PC
	XJRSTF	T1		;[4022] JUMP!
EXTJ:	HRL	L,SECNUM	;[4022] AND PUT A SECTION NUMBER IN RETURN ADDR

NOMAP:	XMOVEI	P,INIPDL-1	;[3137] Set up a global stack
	TLNN	P,-1		;[3137] Is there a section number ?
	 HRLI	P,-LPDL		;NO. USE A LOCAL STACK

	PUSH	P,['STOP!!']	;FLAG BOTTOM OF STACK FOR TRACEBACK
	PUSH	P,L		;PUSH RETURN ADDR FROM JSP
	XMOVEI	T1,@L		;[4153] GET RETURN ADDRESS
	SUBI	T1,2		;[4153] POINT TO START ADDRESS OF PROGRAM
	MOVEM	T1,STADR	;[4153] SAVE IT FOR FORERR

	PUSHJ	P,KCHST.	;[4101] Kill the character stack.
	PUSHJ	P,KDBMS.	;KILL PREVIOUS TRACES OF DBMS
	PUSHJ	P,KSORT.	;[3205] Get rid of SORT, if it is present
	PUSHJ	P,SETEV		;GET ENTRY VECTOR, SETUP REENTER IN IT
	PUSHJ	P,%GOGET	;GO GET FOROTS
	XMOVEI	L,INIARG	;PASS ARG LIST OF PARAMETERS
	PJRST	INIT.		;GO TO FOROTS INITIALIZATION

	-ININUM,,0		;[4153] ARG COUNT (ALA FORTRAN CALL)
INIARG:	IFIW	%DBSTP	 	;PASS ADDRESS OF DBSTP$ OR POPJ P,
	IFIW	%LARGL		;PASS ADDRESS OF LIBRARY ERROR ARG LIST
	IFIW	[FLGV.]		;[4147] ADDRESS OF VAX COMPATIBILITY FLAG
	IFIW	[FLG77.]	;ADDRESS OF ANSI-77 FLAG
	IFIW	STADR		;[4153] START ADDRESS OF USER'S PROGRAM
ININUM=.-INIARG

CLSMSG:	ASCIZ /Do you want to close all files? (Y or N):/
MAPMSG:	ASCIZ /Can't map up section 0
/

	SEGMENT	DATA

STADR:	BLOCK	1		;[4153] START ADDRESS OF USER'S PROGRAM
FDDTFL:	BLOCK	1		;FLAG FOR "FORDDT DID THE INIT CALL"
SECNUM:	BLOCK	1		;SECTION # TO WHICH WE ARE MAPPED
MAPPED:	BLOCK	1		;IF .NE. 0, WE ARE MAPPED TO ANOTHER SECTION
INIPDL:	BLOCK	LPDL		;FOR NOW THE PERM PDL
USEREN:	BLOCK	1		;USER REENTER ADDR
YESWRD:	BLOCK	1		;WORD FOR USER RESPONSE
%ENTVC:	BLOCK	2		;SAVED ENTRY VECTOR

	SEGMENT	CODE

;JOBDAT CODE FOR REENTER ADDRESS FIXUP
USJOBD:	SKIPN	T1,.JBREN	;DOES USER HAVE .JBREN ADDR?
	 MOVEI	T1,%EXICL	;NO. USE AN EXIT CALL
	HRRZ	T2,T1		;Did we already do this?
	CAIN	T2,CLSFIL
	 POPJ	P,		;YES. DON'T DO IT AGAIN
	HRLI	T1,(JRST)	;MAKE IT A LOCAL INSTRUCTION
	MOVEM	T1,USEREN	;TO EXECUTE AFTER %EXIT1
	MOVEI	T1,CLSFIL	;[3137] Used to close all files
	HRRM	T1,.JBREN	;[3137] When user types "REENTER"
	POPJ	P,

IF10,<
SETEV:	JRST	USJOBD		;USE JOBDAT CODE FOR ENTRY VECTOR SETUP

%GTSEC:	MOVEI	T1,1		;FOR NOW, JUST RETURN SECTION 1
	AOS	(P)		;SKIP RETURN
	POPJ	P,

MAPSEC:	MOVE	T1,SECNUM	;GET SECTION NUMBER
	TXO	T1,PG.GMS	;MAP IT TO SECTION 0
	MOVEM	T1,MAPBLK+1	;SAVE FOR PAGE.
	MOVEI	T1,1		;1 ARGUMENT
	MOVEM	T1,MAPBLK
	MOVE	T1,[.PAGSC,,MAPBLK]
	PAGE.	T1,		;MAP THEM
	 JRST	MAPERR		;CAN'T
	POPJ	P,

CLSFIL:	OUTSTR	CLSMSG		;GIVE USER A MSG
	INCHWL	T1		;GET THE FIRST CHAR
	CLRBFI			;CLEAR TYPE-AHEADS

				;[4203]
	CAIE	T1,"Y"		;CHECK FOR UPPER AND LOWER CASE Y
	 CAIN	T1,"y"
	  JRST	DOCLS		;YES, IT'S YES
	XCT	USEREN		;[4155] EXECUTE REENTER INST
	EXIT	1,		;[4155] DO A MONRET
	JRST	.-1		;[4155] AND DON'T ALLOW CONTINUATION

DOCLS:	XMOVEI	P,INIPDL-1	;[3137] Set up a global stack
	TLNN	P,-1		;[3137] Is there a section number ?
	 HRLI	P,-LPDL		;NO. USE A LOCAL STACK
	PUSH	P,['STOP!!']	;FLAG BOTTOM OF STACK FOR TRACEBACK
	XMOVEI	L,[1+[EXP 0,0]]	;NULL ARGS
	PUSHJ	P,EXIT1.	;CLOSE ALL FILES
NDOCLS:	XCT	USEREN		;EXECUTE REENTER INST

%EXICL:	EXIT			;HALT FOROTS

MAPERR:	OUTSTR	MAPMSG		;CAN'T MAP TO A NON-ZERO SECTION
	EXIT

	SEGMENT	DATA

MAPBLK:	BLOCK	2		;A SHORT PAGE BLOCK

	SEGMENT	CODE

>;END IF10

IF20,<
SETEV:
	MOVEI	T1,.FHSLF	;[3137] Reference this fork
	XGVEC%			;[3137] Get entry vector length and address
	 ERJMP	S0GVEC		;NOT RUNNING ON A MODEL B
	JRST	S1GVEC		;[3156] Interpret the entry vector

S0GVEC:	MOVEI	T1,.FHSLF	;[3137] Reference this fork
	GEVEC%			;[3156] Get entry vector info using old call
	HRRZ	T3,T2		;[3235] Put the address where XGVEC% puts it
	HLRZ	T2,T2		;[3235] Put the length in the right half
S1GVEC:	DMOVEM	T2,%ENTVC	;[3137] Save it
	CAIE	T2,(JRST)	;[3137] Real entry vector?
	 CAIG	T2,1		;[3137] Yes, big enough?
	  JRST	USJOBD		;NO. USE JOBDAT
	SKIPN	T1,1(T3)	;[3137] Get reenter instruction
	 MOVE	T1,[JRST %EXICL];USE OURS IF NONE
	CAMN	T1,[JRST CLSFIL] ;Already setup? (Program re-started?)
	 POPJ	P,		;YES. DON'T DO IT AGAIN
	TLNN	T1,-1		;ANY OPCODE?
	 HRLI	T1,(JRST)	;NO. PUT IN A JRST
	MOVEM	T1,USEREN	;TO EXECUTE AFTER %EXIT1
	MOVE	T1,[JRST CLSFIL];USED TO CLOSE ALL FILES
	MOVEM	T1,1(T3)	;[3137] When user types "@REENTER"
	POPJ	P,

MAPSEC:	MOVSI	T1,.FHSLF	;THIS FORK IN SECT 0
	MOVSI	T2,.FHSLF	;[4022] THIS FORK ,,
	HRR	T2,SECNUM	;[4022] CORRECT SECTION
	MOVX	T3,SM%RD!SM%WR!SM%EX+1
	SMAP%			;MAP SECTIONS 0 & N TOGETHER
	 ERJMP	MAPERR		;CAN'T
	POPJ	P,

CLSFIL:	MOVE	T1,[POINT 7,CLSMSG] ;GIVE USER A MSG
	PSOUT%
	MOVE	T1,[TXIBLB,,TXIBLK] ;Copy args to TXIBLK
	BLT	T1,TXIBLK+.TXLEN-1
	XMOVEI	T1,TXIBLK	;SETUP FOR TEXTI
	TEXTI%
	 JFCL			;?Failed

;Clear input buffer.

	MOVEI	T1,.PRIIN	;Get terminal designator
	CFIBF%			;Clear input buffer
	 ERJMP	.+1		;Ignore error

	LDB	T1,[POINT 7,YESWRD,6] ;GET THE 1ST CHAR
	CAIE	T1,"Y"		;CHECK FOR UPPER AND LOWER CASE Y
	 CAIN	T1,"y"
	  JRST	DOCLS		;YES, IT'S YES
	XCT	USEREN		;[4155] EXECUTE REENTER INST
	HALTF%			;[4155] STOP THE PROGRAM
	JRST	.-1		;[4155] AND DON'T ALLOW CONTINUATION

DOCLS:	XMOVEI	P,INIPDL-1	;[3137] Set up a global stack
	TLNN	P,-1		;[3137] Is there a section number ?
	 HRLI	P,-LPDL		;NO. USE A LOCAL STACK
	PUSH	P,['STOP!!']	;FLAG BOTTOM OF STACK FOR TRACEBACK
	XMOVEI	L,[1+[EXP 0,0]]	;NULL ARGS
	PUSHJ	P,EXIT1.	;CLOSE ALL FILES
NDOCLS:	XCT	USEREN		;EXECUTE REENTER INST

%EXICL:	MOVNI	T1,1		;CLOSE ALL OTHER FILES
	CLOSF%
	 $FCALL	IOE		;REPORT WHATEVER ERROR IT IS
	HALTF%			;STOP FOROTS
	JRST	.-1		;AND STAY THAT WAY

MAPERR:	HRROI	T1,MAPMSG	;GET MESSAGE
	ESOUT%
	HALTF%
	JRST	.-1

TXIBLB:	.RDRTY			;LENGTH FOLLOWING
	RD%TOP!RD%JFN		;STOP ON TOPS-10 STYLE CODES
	.PRIIN,,.PRIOU		;INPUT,,OUTPUT
	POINT 7,YESWRD		;THE ANSWER POINTER
	5			;5 BYTES MAX
	POINT 7,YESWRD		;THE DELETE-UP-TO-HERE POINTER
	POINT 7,CLSMSG		;THE GIVE-ME-BACK-THAT-PROMPT POINTER
.TXLEN==.-TXIBLB		;Length of block

	SEGMENT	DATA

TXIBLK:	BLOCK	.TXLEN		;Real TEXTI block.

	SEGMENT	CODE


; New [4022]/PLB FNDSEC; FIND A FREE SECTION
%GTSEC:	MOVSI	T3, -37		;[4022] SEARCH 1..37
FNDLOP:	MOVSI	T1, .FHSLF	;[4022] GET FORK (THATS US)
	HRRI	T1, 1(T3)	;[4022] SNEAK SECTION IN
	RSMAP%			;[4022] READ SECTION MAP
	 ERJMP	FNDRET		;[4022] YOU LOSE BIG
	AOJE	T1, FNDGOT	;[4022] IN USE? (NOT -1)
	 AOBJN	T3, FNDLOP	;[4022] FRAID SO
	POPJ	P,		;[4022] I'M SORRY YOUR TIME IS UP.

FNDGOT:	MOVEI	T1, 1(T3)	;[4022] RETURN SECTION IN T1
	AOS	(P)		;[4022] GIVE HAPPY RETURN
FNDRET:	POPJ	P,		;[4022] HOMEWARD BOUND


	SEGMENT	DATA

PDVARG:	EXP	PDVLEN		;[3137] Length of the block
	EXP	.FHSLF		;[3137] This process
	EXP	PDVALN		;[3137] Data block length
	BLOCK	1		;[3137] Address of associated data block (PDVA)
	PDVLEN==.-PDVARG	;[3137] Length of this block
				;[3137] 
PDVA:	BLOCK	1		;[3137] Gets address of PDV
	PDVALN==.-PDVA		;[3137] Length of this block

	SEGMENT	CODE

>;END IF20

	PRGEND

	SEARCH	MTHPRM,FORPRM
	TV	FORNON	NON-SHARE MODULE

;THIS MODULE IS REACHED IF LINK DOES NOT DEFINE FOROT%, THAT IS, IF
;WE ARE LOADING /OTS:NONSHARE OR WITH /SEARCH. THIS MODULE IS HERE
;TO REMOVE ALL OTHER TRACES OF THE SYMBOL FOROT% FROM FOROTS.

	ENTRY	FOROT%

	INTERN	%GOGET

	SEGMENT	CODE

FOROT%==0		;IF DEFINED HERE, FORCES LOADING OF FOROTS

%GOGET:	POPJ	P,

	PRGEND

	SEARCH	MTHPRM,FORPRM
	TV	FORGET	GETSEG FOROTS

	SEGMENT	CODE

	ENTRY	%GOGET

	EXTERN	%GTSEC,%ENTVC

	DEBUG==1		;[4022] NON-ZERO FOR DEBUG CODE
	DDTPAG==766		;BOTTOM PAGE OF CURRENT DDT

%GOGET:	SKIPE	T1,FBASE	;FOROTS ALREADY GETED?
	 POPJ	P,		;YES. DON'T GET IT AGAIN

IF10,<
	JS.XO==2000		;JBTSTS BIT, JOB IS EXECUTE ONLY

	MOVEM	P,SAVET		;SAVE P, GETSEG DESTROYS IT
	HRROI	T1,.GTSTS	;GET JOB STATUS
	GETTAB	T1,
	  SETZ	T1,		;CAN'T, ASSUME NOT EXECUTE ONLY
	TRNN	T1,JS.XO	;EXECUTE ONLY?
	  TDZA	T2,T2		;NO
	MOVEI	T2,UU.PHY	;YES, SET FOR PHYS-ONLY GETSEG
	MOVEI	T1,FOROTS

DOGETS:	GETSEG	T1,(T2)
	  HALT			;FAILED, TYPE MONITOR ERROR MESSAGE

	MOVE	P,SAVET		;GETSEG WRECKED P, GET IT BACK

	MOVE	T1,[-2,,.GTUPM]	;GET BASE ADDRESS OF HIGH SEG (FOROTS)
	GETTAB	T1,
	 JRST	GETFAL		;SHOULDN'T FAIL
	HLRZ	T1,T1		;PUT IN RIGHT HALF
	TRZ	T1,777		;CLEAR EXTRA BITS
	TRO	T1,10		;START ADDRESS IS XXX010
	SUBI	T1,RBASE	;SUBTRACT TABLE OFFSET
	MOVEM	T1,FBASE	;STORE FOR LATER
	POPJ	P,		;DONE

GETFAL:	OUTSTR	[ASCIZ /?Cannot find base address of FOROTS
/]
	EXIT

FOROTS:	'SYS   '
	'FORO10'
	EXP 0,0,0,0

> ;IF10

IF20,<
	MOVX	T1,RF%LNG+.FHSLF ;FUNNY CALL,,THIS FORK
	MOVEI	T2,STBLK	;POINT TO FORK STATUS BLOCK
	RFSTS%			;READ FORK STATUS
	SKIPL	STBLK+.RFSFL	;SEE IF WE ARE EXECUTE ONLY
	  SKIPA	T1,[GJ%SHT+GJ%OLD] ;NO, SET UP FOR REGULAR GTJFN
	MOVX	T1,GJ%SHT+GJ%OLD+GJ%PHY	;YES, SET UP FOR PHYSICAL-ONLY GTJFN
	HRROI	T2,[ASCIZ /SYS:FORO10.EXE/]
	GTJFN%
	  ERJMP	RERR

	HRRZM	T1,FRSJFN	;SAVE THE JFN
	PUSHJ	P,GTFRSX	;[4022] SETUP FOR SECTION N GET%
	GET%			;GET FOROTS
	  ERJMP	RERR

	XMOVEI	T1,.		;[4022] GET OUR SECTION
	HLRZ	T1,T1		;[4022] PUT IN RIGHT HALF
	CAME	T1,GARGBL+.GBASE ;[4022] SAME AS FOROTS SECTION?
	 PUSHJ	P,FRSJBD	;[4022] NO, MAKE A JOBDAT FOR FOROTS

	MOVEI	T1,.FHSLF	;THIS FORK
	XMOVEI	T2,0		;[4022] SECTION 0?
	JUMPN	T2,GOGET1	;[4022] NO, GET XTENDED ENTRY VECTOR
	GEVEC%			;GET FOROTS ENTRY VECTOR
	MOVEI	T3,(T2)		;[4022] ADDR ONLY, WHERE XGVEC LEAVES IT
	HLRZ	T2,T2		;[4022] GET ENTRY VECTOR LENGTH
	TRNA			;[4022] PRETEND WE JUST DID AN XGVEC
GOGET1:	 XGVEC%			;[4022] GET START ADDRESS W/ SECTION
	CAIE	T2,(JRST)	;[4022] IF NOT TOPS-10 ENTRY VECTOR
	 HRR	T3,(T3)		;[4022] GET ENTRY ADDRESS W/ SECTION
	XMOVEI	T2,(T3)		;[4022] GET EXTENDED ADDR THEREOF
	XMOVEI	T4,RBASE	;GET EXTENDED ADDR OF TABLE OFFSET
	SUB	T2,T4		;[4022] SUBTRACT TABLE OFFSET
	MOVEM	T2,FBASE	;[4022] SAVE BASE ADDRESS OF DISPATCH VECTOR
	TRZ	T3,777		;GET JUST PAGE-ALIGNED ADDRESS
	HLRZ	T2,.JBHRN(T3)	;GET SEGMENT LENGTH
	ADDI	T2,-1(T3)	;CALC TOP ADDR OF FOROTS
	IORI	T2,777		;MAKE IT THE END OF THE PAGE
	HLL	T2,.JBHRN(T3)	;MAKE .JBHRL LOOK LIKE ON THE -10
	SKIPN	.JBHRL		;AND IF THE USER DIDN'T HAVE ONE
	 MOVEM	T2,.JBHRL	;SAVE FOR DDT

IFN DEBUG,<			;[3254] USE THIS FOR DEBUGGING; REMOVED FOR
				;[3254] PRODUCTION
	XMOVEI	T1,(T3)		;GET EXTENDED ADDR
	LSH	T1,-9		;CREATE PAGE ADDR
	SKIPN	.JBHSO		;AND IF THE USER DOESN'T HAVE ONE
	 MOVEM	T1,.JBHSO	;SAVE THE FOROTS HIGH SEG ORIGIN FOR DDT

	XMOVEI	T1,.		;[4022] GET OUR SECTION
	HLRZ	T1,T1		;[4022] GET IN RIGHT HALF
	CAMN	T1,GARGBL+.GBASE ;[4022] SAME AS FOROTS?
	 JRST	GOGET2		;[4022] YES, PMAP WILL DIE
	MOVE	T1,[.FHSLF,,770] ;[4022] IS DDT ACCESSIBLE?
	RPACS%			;[4022] GET ACCESS INFO
	 $FJCAL	IJE,ABORT.	;[4022] SHOULD NEVER FAIL
	JUMPE	T2,GOGET2	;[4022] NO DDT
	MOVE	T1,770000	;[4022] GET FIRST WORD OF 'DDT'
	CAME	T1,[JRST 770002] ;[4022] IS IT FOR REAL?
	 JRST	GOGET2		;[4022] NO
	XMOVEI	T1,DDTPAG*1000	;[4022] GET DDT BOTTOM ADDR
	LSH	T1,-9		;[4022] MAKE PAGE
	HRLI	T1,.FHSLF	;[4022] IN US
	MOVE	T2,GARGBL+.GBASE ;[4022] GET DESTINATION SECTION #
	LSH	T2,9		;[4022] PAGEIFY
	ADD	T2,[.FHSLF,,DDTPAG] ;[4022] DESTINATION
	MOVE	T3,[PM%CNT!PM%RWX+<1000-DDTPAG>] ;[4022] ACCESS INFO
	PMAP%			;[4022] MAP THE PAGES TOGETHER
	 $FJCAL	IJE,ABORT.	;[4022] SHOULD NEVER FAIL!
GOGET2:
> ;IFN DEBUG

	MOVEI	T1,.FHSLF	;THIS FORK
	DMOVE	T2,%ENTVC	;[3137] Put real entry vector back
	XMOVEI	T4,0		;[3220] See what section the ACs are in
	JUMPE	T4,S0SVEC	;[3220] Do a SEVEC% if we are in section 0
	XSVEC%			; SO ^C, START WORKS
	POPJ	P,		;DONE

S0SVEC:	HRLZ	T2,T2		;[3235] Put the size in the left half
	HRR	T2,T3		;[3235] Put the address in the right half
	SEVEC%			;[3156] Set the entry vector with an old call
	POPJ	P,		;DONE


;Call here to do setup for GET% into any section
;Exits with AC1 and AC2 set up for GET%
GTFRSX:	MOVX	T1,GT%BAS!GT%LOW ;Tell monitor to look at .GBASE in GARGBL
	MOVEM	T1,GARGBL+.GFLAG ;STORE FLAGS
	XMOVEI	T1,GARGBL	;[4022] GET SECTION FOR ARGBLOCK
	HLRZ	T1,T1		;GET SECTION NUMBER IN RH
	MOVEM	T1,GARGBL+.GBASE ;[4022] STORE SECTION NUMBER
	MOVEI	T2,(T1)		;COPY THE SECTION NUMBER
	LSH	T2,^D9		;MAKE IT A PAGE NUMBER
	ADDI	T2,1		;IGNORE PAGE 0 WITHIN IT
	MOVEM	T2,GARGBL+.GLOW	;ON THE GET
	MOVE	T1,FRSJFN	;GET JFN
	TDO	T1,[.FHSLF,,GT%NOV!GT%ARG] ;[4022] THIS FORK,
				;ERROR IF PAGES EXIST, USE ARG BLOCK
	XMOVEI	T2,GARGBL	;[4022] GET% ARG BLOCK
	POPJ	P,		;Back to main code

RERR:	HRROI	T1,RERRBF	;POINT TO MESSAGE BUFFER
	HRLOI	T2,.FHSLF	;THIS FORK,,LAST ERROR
	MOVSI	T3,-^D80	;LIMIT OF 80 CHARS
	ERSTR%			;GET ERROR STRING
	 JRST	[HRROI T1,[ASCIZ /Undefined error number/]
		 JRST RQUIT]
	  SKIPA	T1,[-1,,[ASCIZ /Error in ERSTR/]]
	HRROI	T1,RERRBF

RQUIT:	MOVEM	T1,SAVET	;SAVE T1 FOR A WHILE
	HRROI	T1,[ASCIZ /Can't get FORO10.EXE/]
	ESOUT%			;TYPE EXPLANATION
	MOVE	T1,SAVET	;GET POINTER BACK
	ESOUT%			;TYPE ERROR STRING
	HALTF%			;QUIT AND DON'T CONTINUE
	JRST	.-1


; [4022] New /PLB; Create crucial JOBDAT locations in FOROTS' section
; when FOROTS resides in another section.

FRSJBD:	HRLZ	T2,GARGBL+.GBASE ;GET FOROTS SECTION

	MOVEI	T1,.JBDA	;GET VALUE
	MOVSM	T1,.JBSA(T2)	;STORE INITIAL FIRST FREE LOCATION
	MOVEM	T1,.JBFF(T2)	;STORE FIRST FREE LOCATION

	MOVEI	T1,777		;GET VALUE
	MOVEM	T1,.JBREL(T2)	;SET LOWSEG LOWER BOUND
	POPJ	P,

	SEGMENT	DATA

STBLK:	5			;LENGTH OF RFSTS BLOCK
	BLOCK	4		;RFSTS BLOCK
GARGBL:	BLOCK	4		;"GET" arg block

RERRBF: BLOCK	^D80/5		;BUFFER FOR ERROR MESSAGE

	SEGMENT	CODE

> ;END IF20

;DISPATCH VECTOR.  JUMP TO APPROPRIATE PLACE IN FOROTS DISPATCH VECTOR

DEFINE	X (E) <
	INTERN	E'.
	SIXBIT	/E'./
E'.:	PUSHJ	P,RDISP
>

	XALL
RVEC:	FORVEC
	SALL

RBASE==RVEC+1			;LOCAL RETURN PC-1 ON CALL FROM 1ST ENTRY

;THE FOLLOWING LOWSEG/HISEG INTERFACE ALLOWS FORGET TO BE IN
;A DIFFERENT SECTION THAN FOROTS. FBASE IS THE ENTRY VECTOR
;ADDRESS, MINUS THE OFFSET OF THE TRANSFER VECTOR TABLE (RVEC).
;RDISP JUST DOES A JUMP TO FOROTS, WITHOUT SAVING ANY AC'S.
;IT IS EXPECTED THAT EITHER THE AC'S ARE STORED SEPARATELY (E.G. INIT)
;OR STORED BY THE HISEG ENTRY POINT
RDISP:	EXCH	0,(P)		;GET RETURN ADDR, SAVE 0
	ADD	0,FBASE		;RELOCATE TO FOROTS ENTRY POINT
	EXCH	0,(P)		;GET 0 BACK, SAVE ENTRY POINT
	POPJ	P,		;GO TO IT

	SEGMENT	DATA

FBASE:	BLOCK	1		;FOROTS BASE ADDR MINUS TABLE OFFSET
SAVET:	BLOCK	1		;RANDOM TEMP
FRSJFN:	BLOCK	1		;FOROTS' JFN
SRETAD:	BLOCK	1		;RETURN ADDR OF CALL TO SDISP

	SEGMENT	CODE

	PRGEND

	TITLE	DUMEXT

	ENTRY	%EXTND

;THIS MODULE IS LINKED IF EXTEND HAS NOT BEEN CALLED IN THE
;USER PROGRAM. IT RESOLVES THE GLOBAL SYMBOL %EXTND, WHICH DETERMINES
;WHETHER THE USER WISHES TO RUN IN A NON-ZERO SECTION.

%EXTND==0

	PRGEND

	TITLE	FORREN	REENTER ADDRESS FOR /EXTEND

	ENTRY	REENT.

	EXTERN	%EXICL

REENT.==<%EXICL+0>

	END