! xcontrl8 ! 28/09/87 - increase ares sizes if PARM MAXDICT set ! new version no. 2.16 ! xcontrl7b ! 23/09/87 - intialise inclevel in ICL9CEIBMF77 ! 28/07/87 - new version no. 2.15 ! xcontrl7a ! 02/07/87 - new version no. 2.12 ! xcontrld7 ! 30/06/87 - in Icl9ceibmf77, set OPT1 bit in OPT1, if Parm opt2; set OPT bit in ! - Control, if Parm Opt1; set minbound bit in F77parm, if not Parm OPT ! 09/06/87 - change BSIZE to 128 ! new version no. 2.11 ! xcontrl6 ! 29/05/87 - new code in SOURCELINE & SELECTINCLUDE, define new own ! - variables; new dynamic specs ! - set OPT2 for Include listing ! 06/05/87 - define Get Space and own integers gsconad, gsfindex, gsflen ! xcontrl5d ! 13/04/87 - change vsn to 2.10 ! xcontrl5b ! 28/04/87 - change version t. 2.08 ! xcontrl5a ! 06/04/87 - change version to 2.07 ! xcontrl5 ! 26/03/87 - set DIAGLEVEL from CONTROL in ICL9CEIBMF77 ! 18/03/87 - change vsn to 2.06 ! xcontrol4 ! 17/03/87 - change VSN to 2.05 ! 02/02/87 - remove strict,nowarnings,nocomments from OPT1 ! ! modified 18/11/86 ! %CONSTSTRING (5) VSN = "2.16" ! %owninteger inclevel %ownintegerarray sfchan(0:10) %owninteger gsconad,gsfindex ; ! used by Get Space %owninteger gsflen=256*1024 ;! initial size of temp file created by Get Space %dynamicroutinespec EMAS3CLAIMCHANNEL(%integername chan) %dynamicroutinespec EMAS3DEFINE(%stringname file,%integername chan,flag) %dynamicroutinespec EMAS3CLOSE(%integername chan,flag) %dynamicroutinespec EMAS3CLEAR(%integername chan,flag) ! %externalroutinespec EMAS3EXISTTYPE(%stringname file,%integername flag) %EXTERNALROUTINESPEC EMONON %EXTERNALROUTINESPEC MOVE %ALIAS "S#MOVE" (%INTEGER LENGTH, FROM, TO) %EXTERNALROUTINESPEC OUTFILE %ALIAS "EMAS3OUTFILE" (%STRINGNAME FILE, %INTEGERNAME SIZE, HOLE, PROT, CONAD, FLAG) %externalroutinespec changefilesize %alias "emas3changefilesize" %c (%stringname file,%integername newsize,flag) %EXTERNALINTEGERMAPSPEC COMREGMAP %ALIAS "S#COMREGMAP" (%INTEGER X) %EXTERNALINTEGERFNSPEC FORT77 (%INTEGER CONTROL, OPT1, OPT2, F77PARM, OPTFLAGS, SRFLAGS, CONSOLE, LSTREAM, %C DSTREAM, DIAGLEV, DSIZE, TSIZE, BSIZE, LSIZE, ASIZE, SP2) ! %ROUTINE SIM2 (%INTEGER EP, R1, R2, %INTEGERNAME R3) %BYTEINTEGER SYM ! %ON %EVENT 9 %START byteinteger(R1+R3)=25 {EM} BYTEINTEGER(R1 + R3 + 1) = NL R3 = R3 + 2 %RETURN %FINISH ! %CYCLE R3 = 0, 1, 159 READSYMBOL(SYM) BYTEINTEGER(R1 + R3) = SYM %IF SYM = NL %THEN %START R3 = R3 + 1 %RETURN %FINISH %REPEAT %END ! %EXTERNALROUTINE ICL9CEIBMF77 %INTEGER FLAG, CONTROL, OPT1, OPT2, F77PARM, SRFLAGS, LSTREAM, DSTREAM, OPTFLAGS, DIAGLEVEL, %C ASIZE, BSIZE, DSIZE, LSIZE, TSIZE, SP2 LSTREAM = COMREGMAP(23) CONTROL = COMREGMAP(27) OPT1 = COMREGMAP(28) DSTREAM = COMREGMAP(40) OPT2 = COMREGMAP(53) ; ! (used by sub_system ??? ) OPT2 = x'10' ;! PRO TEM - 'INCLUDE' listing SRFLAGS = COMREGMAP(54) F77PARM = COMREGMAP(55) OPTFLAGS = COMREGMAP(56) OPTFLAGS = (OPTFLAGS << 15) >> 15 %if Control&X'10000'#0 %then Control=Control!X'30' F77parm=F77parm!(opt1&X'E0');!! strict,nowarnings,nocomments opt1=opt1&(\(x'e0')) %if opt1&x'200000'#0 %then Opt1=opt1!x'100000' ;! opt1 %if opt1&x'100000'#0 %then control=control!x'30' ;! opt %if control&x'20'=0 %then F77parm=F77parm!x'8' ;! minbound %if F77parm&X'40'#0 %then F77parm=F77parm!X'1000';! nowarnings -> noF77warnings %IF CONTROL & 1 # 0 %THEN EMONON diaglevel=4 %if Control&(1<<2)#0 %then diaglevel=0 %if Control&(1<<6)#0 %then diaglevel=0 inclevel=0 ASIZE = 0 BSIZE = 128 DSIZE = 64 LSIZE = 4 TSIZE = 256 %if OPT1&256#0 %thenstart; ! PARM MAXDICT set bsize=bsize*2;dsize=dsize*2;tsize=tsize*2 %finish SP2 = 0 Comregmap(24)=-1 %IF LSTREAM # 0 %THEN %START NEWLINES(3) PRINTSTRING(" Edinburgh Amdahl Fortran77 Compiler Version ".VSN) NEWLINES(3) %FINISH FLAG = FORT77(CONTROL,OPT1,OPT2,F77PARM,OPTFLAGS,SRFLAGS,DSTREAM,LSTREAM,DSTREAM, %C DIAGLEVEL,DSIZE,TSIZE,BSIZE,LSIZE,ASIZE,SP2) %IF FLAG > 0 %THEN %START ! WRITE(FLAG,1) Comregmap(47)=Flag COMREGMAP(24) = 0 ! PRINTSTRING(" Statements Compiled") %FINISH %ELSE %START ! PRINTSTRING("Program contains") ! WRITE(-FLAG,1) ! PRINTSTRING(" faults") Comregmap(47)=-Flag %FINISH ! NEWLINE %END ! %EXTERNALROUTINE F77AREA (%INTEGER INDEX, SIZE, %INTEGERNAME CONAD) %INTEGER FLAG %STRING (31) FILE %CONSTSTRING (6) %ARRAY AREAS (0:6) = %C "DICT", "NAMES", "TRIADS", "BLOCKS", "TABS", "LOOPS", "ASAVE" FILE = "T#".AREAS(INDEX) OUTFILE(FILE,SIZE,SIZE,0,CONAD,FLAG) %IF FLAG # 0 %THEN %START CONAD = -FLAG %RETURN %FINISH %END ! %externalintegerfn Get Space(%integer Size) %integer newconad,flag %if gsconad=0 %thenstart outfile("t#opt2",gsflen,0,0,gsconad,flag) %if flag#0 %then %result=-1 gsfindex=size %result=gsconad %finish newconad=gsconad+gsfindex gsfindex=gsfindex+size %if gsfindex>gsflen %thenstart gsflen=gsfindex changefilesize("t#opt2",gsflen,flag) %if flag#0 %then %result=-1 %finish %result=newconad %end %EXTERNALROUTINE SOURCE LINE (%INTEGER ABUFF) %INTEGER I, L,cic,flag SIM2(0,ABUFF + 1,0,L) BYTEINTEGER(ABUFF) = L - 1 %if byteinteger(abuff+1)=25 %and inclevel>0 %thenstart cic=comregmap(22) inclevel=inclevel-1 selectinput(sfchan(inclevel)) emas3close(cic,flag) emas3clear(cic,flag) %return %finish %IF L < 73 %THEN %START %CYCLE I = L, 1, 72 BYTEINTEGER(ABUFF + I) = ' ' %REPEAT %FINISH %END ! %EXTERNALROUTINE SETFUN %END ! %EXTERNALintegerfn SELECTINCLUDE (%STRING (255) NAME) %integer flag,cic ! PRINTSTRING("CALLING SELECTINCLUDE") ! NEWLINE emas3existtype(name,flag) %if flag<3 %or flag>4 %then %result=-1 sfchan(inclevel)=comregmap(22) inclevel=inclevel+1 emas3claimchannel(cic) emas3define(name,cic,flag) %if flag#0 %then %result=flag selectinput(cic) %result=0 %END ! %EXTERNALROUTINE QPUT (%INTEGER A, B, C, D) PRINTSTRING("CALLING QPUT");NEWLINE %END ! %EXTERNALROUTINE QCODE (%INTEGER A, B, C, D) PRINTSTRING("CALLING QCODE");NEWLINE %END ! %EXTERNALROUTINE FREE (%INTEGER ADDRESS) { PRINTSTRING("FREE");NEWLINE} %END ! %ENDOFFILE