movei d,(p)		;where to put address returned
	pushj p,getpag		;now allocate a block for Fortran
;pass it to Fortran as .jbff and .jbrel
	move t,.jbff		;exchange .jbff and 0(p)
	exch t,(p)		;
	movem t,.jbff		;.jbff _ start of block
    ;stack: space in wrds, pag no., pascal .jbff
	add t,-2(p)
	subi t,1
	movem t,.jbrel		;.jbrel _ end of block
	movem t,ftnrel
> ;ife tops10

ifn tops10,<
forini:	aose in.use		;prevent reentry
	popj p,
forin:
> ;ifn tops10

;if first time through, save initial FORER%, since we change it in exit code
;if not first, restore FORER% to saved value
;this code is more complex on Tops-10, since we have to write enable the
;high-segment, since the code is there.
ifn tops10,<
	hrroi a,.gtsgn		;see if high segment is sharable
	gettab a,
	 jrst noshar		;monitor is so old, probably doesn't share
	tlne a,(sn%shr)		;shared?
	jrst shared		;yes - trouble
noshar:	movei t,0		;enable writing
	setuwp t,		;enables, saving old setting in t
	 jrst shared		;we must be able to change it eventually
> ;ifn tops10
	skipn a,olderr		;get saved value of FORER%, if any
	skipa a,forer%		;else it is first time - use initial FORER%
	movem a,forer%		;not first time - restore FORER% to initial
	movem a,olderr		;and save for next time
ifn tops10,<
	setuwp t,		;now put back old setting
	 jfcl			;less critical
> ;ifn tops10


;.jbff - .jbrel is now block for fortran
;now we are ready to call fortran init
	movem n,acsavn		;save global AC's
	movem o,acsavo
	movem p,acsavp
	jsp o,reset.+1
	0
	move p,acsavp		;restore global AC's
	move o,acsavo
	move n,acsavn

ife tops10,<
;Return .jbff to its pascal state and check for illicit memory expansion
	pop p,.jbff		;restore pascal's .JBFF
	pop p,(p)		;clean up stack
	pop p,(p)
	move t,.jbrel		;see if fortran had to get more space
	came t,ftnrel
	pushj p,forcer		;if so, error
;now we allocate all of memory, to turn off NXM trap
forfix:	
ifn kludge,<
	push p,.jbhrl		;and this to make restartable
	move a,[xwd 677777,377777] ;allocate all of memory
	calli a,11		;for the emulator
	 0
	pop p,.jbhrl
	move t,ftnrel
	movem t,.jbrel
> ;ifn kludge
	popj p,


forcer:	hrroi a,[asciz /
% Fortran seems to have run out of space during this program
/]
	psout
	popj p,


> ;ife tops10

ifn tops10,<
forfix:	popj p,
> ;ifn tops10

	reloc 0

olderr:	block 1
acsavn:	block 1
acsavo:	block 1
acsavp:	block 1
ftnrel:	block 1
acsav:	block 20

	reloc


;procedure forexi
;  close all fortran files 
forexi:	
ife tops10,<
;See if fortran needed more space than we gave it
	move t,.jbrel		;see if fortran has run out of space
	came t,ftnrel		;same as we left it?
	pushj p,forcer		;no - core error in fortran
> ;ife tops10
ifn tops10,<
;Allow us to change the high seg, since forer% is probably there
	movei t,0		;enable
	setuwp t,		;and save old setting
	 jrst shared		;something is wrong
	push p,t		;save old setting
> ;ifn tops10
	movem p,acsavp
	movem o,acsavo
	movem n,acsavn
	move t,[jrst forex1]
	movem t,forer%		;cause exit. to return here after closing files
	hrrzi o,.+3
	pushj p,exit.
	0
	0
forex1:	move p,acsavp
	move o,acsavo
	move n,acsavn
ifn tops10,<
	pop p,t			;put back old setting of write prot
	setuwp t,
	 jfcl			;not critical
>;ifn tops10
ife tops10,<
ifn kludge,<
	movei a,.fhslf		;clear compatibility mode, or somebody will
	movei b,0		;garbage .jbrel and .jbhrl
	scvec
> ;ifn kludge
> ;ife tops10
	popj p,

ifn tops10,<

;special find channel routine, calls fortran's
fn.chn:	pushj p,startf		;start up fortran if needed
	push p,o		;save o
	movei o,fnarg		;say give me any channel
	pushj p,alchn.		;allocate channel
	move a,t		;pascal wants result in a
	pop p,o
	popj p,

	xwd 0,-1
fnarg:	xwd 0,.+1
	z

;special lose channel routine, calls fortran's
lo.chn:	pushj p,startf		;start up fortran if needed
	push p,o		;save o
	push p,fnarg-1		;one arg
	push p,.+1		;this is a dummy
	push p,ac1		;ac1 is the value
	hrrzm p,-1(p)		;and put the location in the dummy slot
	pushj p,dechn.		;deallocate channel
	sub p,[xwd 3,3]
	pop p,o
	popj p,

;routine to call forini implicitly if pascal open is done before the
;first explicit call.
startf:	aose in.use		;in.use is -1 if not yet initialized
	popj p,
	movem 0,acsav		;save ac's
	move 0,[xwd 1,acsav+1]
	blt 0,acsav+17
	pushj p,forin		;call real workhorse
	move 0,[xwd acsav+1,1]	;restore ac's
	blt 0,17
	movem 0,acsav
	popj p,

;error in case we can't set write enable
shared:	outstr [asciz /
? Can't write enable high segment.  Probably program is sharable.  If
  so, GET it and then SAVE it.
/]
	exit

> ;ifn tops10	

	end