!* modified 09/04/85
!*
%externalroutinespec Emonon
%externalroutinespec Emonoff
%externalroutinespec Mmonon
%externalroutinespec Mmonoff
%externalroutinespec msetfiles(%stringname source,object)
%externalroutinespec mgenerate object(%stringname objname)

%EXTERNALROUTINESPEC MOVE %ALIAS "S#MOVE" (%INTEGER LENGTH, FROM, TO)
%EXTERNALROUTINESPEC OUTFILE %ALIAS "EMAS3OUTFILE" (%STRINGNAME FILE, %INTEGERNAME SIZE, HOLE, PROT, CONAD, 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 Gfortentry
   %INTEGER FLAG, CONTROL, OPT1, OPT2, F77PARM, SRFLAGS, LSTREAM, DSTREAM, OPTFLAGS, DIAGLEVEL, %C
      ASIZE, BSIZE, DSIZE, LSIZE, TSIZE, SP2
%integer Com60
%string(31) S1,S2
   Com60=comregmap(60)
   %if Com60&1#0 %then Emonon %else Emonoff
   %if Com60&2#0 %then Mmonon %else Mmonoff
   S1="Source"
   S2="gtest"
   msetfiles(S1,S2)
   LSTREAM = COMREGMAP(23)
   CONTROL = COMREGMAP(27)
   OPT1 = COMREGMAP(28)
   DSTREAM = COMREGMAP(40)
   OPT2 = COMREGMAP(53)
   SRFLAGS = COMREGMAP(54)
   F77PARM = COMREGMAP(55)
   OPTFLAGS = COMREGMAP(56)
   OPTFLAGS = (OPTFLAGS << 15) >> 15
Control=Control!X'10000'
   %if Control&X'10000'#0 %then Control=Control!X'30'
   F77parm=F77parm!(opt1&X'E0');!! strict,nowarnings,nocomments
   %if F77parm&X'40'#0 %then F77parm=F77parm!X'1000';! nowarnings -> noF77warnings
F77Parm=F77parm!X'17'  ;! all checks off pro tem
   DIAGLEVEL = 4
   ASIZE = 0
   BSIZE = 48
   DSIZE = 64
   LSIZE = 4
   TSIZE = 256
   SP2 = 0
      Comregmap(24)=-1
   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
    mgenerateobject(s2)
!      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
!
%EXTERNALROUTINE SOURCE LINE (%INTEGER ABUFF)
   %INTEGER I, L
   SIM2(0,ABUFF + 1,0,L)
   BYTEINTEGER(ABUFF) = L - 1
   %IF L < 73 %THEN %START
      %CYCLE I = L, 1, 72
         BYTEINTEGER(ABUFF + I) = ' '
      %REPEAT
   %FINISH
%END
!
%EXTERNALROUTINE SETFUN
%END
!
%EXTERNALROUTINE SELECTINCLUDE (%STRING (255) NAME)
   PRINTSTRING("CALLING SELECTINCLUDE")
   NEWLINE
%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 FREEdum (%INTEGER ADDRESS)
{   PRINTSTRING("FREE");NEWLINE}
%END
!
%ENDOFFILE