Trailing-Edge
-
PDP-10 Archives
-
decuslib10-07
-
43,50433/fortio.mac
There are 7 other files named fortio.mac in the archive. Click here to see a list.
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