{30/06/82 13.00  Varaiable areas as standard}
{15/06/82 17:30 LCG}
{08/06/82 09:50 provide for variable areas on a switch                         }
{03/06/82 06:10 allow 128 blocks in DICT seg                                   }
{20/05/82 13:20 workseg now 40 blocks (8K bytes for names)                     }
{               MOVE BEE called on source block read                           }
{               NAMESFUL and DICFUL tidied                                     }
{13/05/82 14:30 increase workseg as below to 32 blocks                         }
{13/05/82   increase size of workseg to 24 blocks and reallocate space         }
{           to allow GENERATE to use a 4 block cycle for triad output          }
!*
!*************************** EXPORTS **********************
!*
%ROUTINESPEC F77COMP(%HALFINTEGER A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,
   %INTEGER INFILE,ERRFILE,OUTFILE,
   %HALFINTEGER BLKS,BITS,ISN,
   %INTEGER MODE,
   %HALFINTEGER NUMIMPORTS,MEMSIZE)
%ROUTINESPEC SOURCE LINE(%INTEGER ABUFF)
%ROUTINESPEC DICFUL
%ROUTINESPEC NAMESFUL
%ROUTINESPEC EXTFUL
%INTEGERFNSPEC OUTPUTFUL
%INTEGERFNSPEC ANALFUL
%INTEGERFNSPEC GENFUL
!*
%CONSTSTRING(3) VERSION="1.5"
!*
!********************************************************************
!*
!***********************************************************************
!*
!*
!***********************************************************************
!* Formats for accessing dictionary records                            *
!***********************************************************************
!*
%RECORDFORMAT PRECF( %C
               %BYTEINTEGER CLASS,TYPE,X0,X1, %C
               %INTEGER LINK1, LINK2, LINK3, ADDR4,  %C
               %HALFINTEGER DISP,LEN,  %C
               %INTEGER IDEN,LINE,XREF,CMNLENGTH, CMNREFAD)
!*
%RECORDFORMAT SRECF(%INTEGER INF0, LINK1, INF2, INF3, INF4)
!*
%RECORDFORMAT RESF((%INTEGER W %OR %HALFINTEGER H0,
                      (%HALFINTEGER H1 %OR %BYTEINTEGER FORM,MODE)))
!*
%RECORDFORMAT DORECF( %C
    %INTEGER LABEL, LINK1, LOOPAD, ENDREF,
    %RECORD(RESF) INDEXRD, INCRD, FINALRD, ICRD,
    %INTEGER LABLIST,LINE)
!*
%RECORDFORMAT BFMT(%INTEGER L,U,M)
!*
%RECORDFORMAT ARRAYDVF(%INTEGER DIMS, ADDRDV,GLADV,  %C
            %INTEGER ZEROTOFIRST, ADFIRST, NUMELS, ELLENGTH,  %C
            %RECORD(BFMT) %ARRAY B(1 : 7))
!*
!*
%RECORDFORMAT LRECF(%INTEGER NOTFLAG,LINK1,ORLIST,ANDLIST,RELOP)
!*
%RECORDFORMAT IFRECF(%INTEGER TYPE,LINK1,ENDIFJUMP,FALSELIST,  %C
                                        LABLIST,LINE)
!*
%RECORDFORMAT LABRECF(%BYTEINTEGER CLASS,TYPE,X0,X1,  %C
            %INTEGER LINK1,LINK2,LINK3,ADDR4,LINK5,LAB,LINE,  %C
            %HALFINTEGER DOSTART,DOEND,IFSTART,IFEND)
!*
%RECORDFORMAT PLABF(%INTEGER INDEX,CODEAD,REF,REFCHAIN)
!*
%RECORDFORMAT IMPDORECF(%INTEGER VAL,LINK,IDEN)
!*
%RECORDFORMAT CONRECF(%INTEGER MODE,LINK1,DADDR,CADDR)
!*
%RECORDFORMAT TMPF(%BYTEINTEGER REG,MODE,%HALFINTEGER INDEX,  %C
                    %INTEGER LINK1,ADDR)
!*
%RECORDFORMAT CHARF(%INTEGER ADESC,LINK,LEN)
!*
%RECORDFORMAT FNRECF(%INTEGER FPTR,LINK1,HEAD,PCT)
!*
!*
!***********************************************************************
!* Constants defining the size of DICT records                         *
!***********************************************************************
!*
%CONSTINTEGER IDRECSIZE    = 28;! size of dict entry reserved for a new identifier
%CONSTINTEGER CONRECSIZE   = 16
%CONSTINTEGER CNSTRECMIN   =  4
%CONSTINTEGER IMPDORECSIZE = 12;! size of DATA-implied-DO list item
%CONSTINTEGER LABRECSIZE   = 40
%CONSTINTEGER PLABRECSIZE  = 16
%CONSTINTEGER XREFSIZE     =  8
%CONSTINTEGER CMNRECEXT    = 12;! extra space on iden record for common block name
%CONSTINTEGER TMPRECSIZE=12
!*
!***********************************************************************
!* TRIAD record format                                                 *
!***********************************************************************
!*
%RECORDFORMAT TRIADF(  %C
               %BYTEINTEGER OP,
               (%BYTEINTEGER USE %OR %BYTEINTEGER VAL2),
               %HALFINTEGER CHAIN,
               (%RECORD(RESF) RES1      %OR     %C
               (%HALFINTEGER OPD1,%BYTEINTEGER QOPD1,MODE  %OR  %C
               (%INTEGER SLN %OR %INTEGER VAL1))),
               (%RECORD(RESF) RES2      %OR   %C
                %HALFINTEGER OPD2,%BYTEINTEGER QOPD2,MODE2))
!*
!*
!***********************************************************************
!***********************************************************************
!*
!*
!*
%RECORDFORMAT COMFMT(%INTEGER CONTROL,OPTIONS,OPTIONS1,OPTIONS2,PTRACE,
      ADICT,ANAMES,ADOUTPUT,ADBLKDTAID,DICLEN,DPTR,
      MAXTRIADS,NEXTPLAB,ALABH,ADLHEAD,
      SUBPROGTYPE,SFPTR,EXTERNALS,CBNPTR,SCPTR,CHECKLIST,
      RESCOM1,RESCOM2,GLACA,FNO,FAULTY,LINEST,CMNIIN,SFMK,
      LISTL,LISTSTREAM,DIAGSTREAM,LISTPOINT,XREF,
      PACKCMN,ITSMODE,PATHANAL,CHARACTER CODE,SPACE CHAR,
      HEADINGS,ARRAYCHECKS,JBRMODE,MESSLEN,NAMESLEN,
      NEXTCH,FUNRESDISP,WARNCOUNT,INP,MAXINP,MESSCOUNT,
      UNASSPATTERN,LISTCODE,PI21INT,DOPTR,SUBPROGPTR,
      FNLST,LAB,NAMESFREE,ALGOLREF,FIRSTSTATNUM,CEXPDICT,
      COMMONBASE,FASTPROLOGUE,STATEMENT,IFPTR,
      CNSTCA,COMMENTCNT,ADIDENT,ADERRIDEN,
      ADEXT,MAXDICT,MAXNAMES,MAXOUTPUT,MAXEXT,
      ACOMP,ASUBNAMES,MAXPSTACK,
      ATRIADS,TRFILEID,TRBLOCK,CMNCNT,SCANONLY,NOISY,
      MAXANAL,MAXGEN,SAVEANAL,SAVEGEN)
!*
!*
%EXTERNALROUTINESPEC CODEGEN(%INTEGER CGENEP,
                             %RECORD(TRIADF)%ARRAYNAME TRIADS,
                             %INTEGER COMAD)
%EXTERNALROUTINESPEC QPUT(%INTEGER I,J,K,L)
!*
%EXTERNALINTEGERFNSPEC GET COMAD
!*
%EXTERNALROUTINESPEC INIT COMP(%HALFINTEGER LIST,DIAG,DEBUG)
%EXTERNALINTEGERFNSPEC ANALSTART(%RECORD(TRIADF)%ARRAYNAME TRIADS,
                           %INTEGER MAXTRIADS,COMAD,
                           %INTEGER ADICT0,ANAMES0,AMT,AM)
%EXTERNALROUTINESPEC INIT ALLOC(%INTEGER COMAD)
%EXTERNALROUTINESPEC INITMAIN
%EXTERNALROUTINESPEC NEWSEG(%HALFINTEGERNAME SEGNUM,%HALFINTEGER FSIZE,
                            FINCR,FMAX)
%EXTERNALROUTINESPEC EXTENDSEG(%HALFINTEGER SEGNUM,
                               %HALFINTEGER FSIZE)
%EXTERNALROUTINESPEC READBLOCK(%HALFINTEGER ID,BLLKNO,%INTEGER BUFFADDR)
%EXTERNALHALFINTEGERFNSPEC CREATEFILE(%INTEGER NAMEAD)
%EXTERNALROUTINESPEC MOVE BEE
%EXTERNALROUTINESPEC DATEANDTIME(%INTEGER ASTRING)
!*
!*
%CONSTINTEGER NO=0
%CONSTINTEGER YES=1
%CONSTINTEGER FULL=2
!*
%CONSTINTEGER OUTINIT =  384
%CONSTINTEGER OUTINC  =  512
%CONSTINTEGER OUTLIM  = 3968
%CONSTINTEGER DICTINIT= 4096
%CONSTINTEGER DICTINC = 4096
%CONSTINTEGER DICTLIM =32768
%CONSTINTEGER NAMINIT = 1024
%CONSTINTEGER NAMINC  = 1024
%CONSTINTEGER NAMLIM  = 8192
%CONSTINTEGER EXTINIT = 1024
%CONSTINTEGER EXTINC  = 1024
%CONSTINTEGER EXTLIM  =32768
%CONSTINTEGER ANALINIT=1024
%CONSTINTEGER ANALINC=1024
%CONSTINTEGER ANALLIM=8192
%CONSTINTEGER GENINIT=1024
%CONSTINTEGER GENINC=1024
%CONSTINTEGER GENLIM=4096
!*
%OWNINTEGER COMAD,ADICT,ANAMES,ATRIADS,WORKAD,CINFILE,COUTFILE
%OWNHALFINTEGER CISN,CNUMIMPS
%CONSTINTEGER MAXTRIADS=1000
%owninteger ADMODULECHAIN
%OWNINTEGER INIT
%OWNHALFINTEGER LISTFLAG,ERRFLAG,DEBUGFLAG
%OWNINTEGER BLKBUFFADDR
%OWNHALFINTEGER INBLKS,INBYTES,FILEID
%OWNRECORD(TRIADF)%ARRAY TRIADS(0:1)
%OWNHALFINTEGER OUTSEG,NAMSEG,DICTSEG,EXTSEG,TRIADSEG,WORKSEG
%OWNHALFINTEGER ANALSEG,GENSEG
!*
!*
%INTEGERFN VARIABLE
      %RESULT=YES
%END
%EXTERNALROUTINE F77COMP(   %C
   %HALFINTEGER OUTID,INID,WKID,EXTERN,RANGE,CHECK,LIST,CODE,XREF,
                SCAN,NOISY,QUERY,DEBUG,DOSTAT,BLOCKS,
   %INTEGER INFILE,ERRFILE,OUTFILE,
   %HALFINTEGER BLKS,BITS,ISN,
   %INTEGER MODS,
   %HALFINTEGER NUMIMPORTS,MEMSIZE)

%RECORD(COMFMT)%NAME COM
!*
%BYTEINTEGERARRAY BLKBUFF(0:511)
%INTEGER I
%INTEGER WRKF
%STRING(6) ID
!*
%ROUTINE ENTER
%RECORD(COMFMT)%NAME COM
%HALFINTEGER I
%OWNSTRING(18) DT="                  "
%INTEGER II
      %IF INIT=0 %THENSTART
         INIT=1
         INITMAIN
         %RETURN
      %FINISH
      COM==RECORD(COMAD);! avoid using the enclosing stackframe
      NEWLINES(2)
!*
      INIT COMP(LISTFLAG,ERRFLAG,DEBUGFLAG)
      %IF COM_LISTSTREAM=1 %THENSTART
         SELECTOUTPUT(1)
         PRINTSTRING("Fortran version ")
         PRINTSTRING(VERSION)
         SPACES(20)
         II=ADDR(DT)
         DATEANDTIME(II)
         PRINTSTRING(DT)
         NEWLINES(2)
         PRINTSTRING("Source: ")
         PRINTSTRING(STRING(CINFILE))
         NEWLINES(3)
      %FINISH
      %IF LISTFLAG#0 %THENSTART
         SELECTOUTPUT(1)
      %FINISH
      I=ANALSTART(TRIADS,MAXTRIADS,COMAD,ADICT,ANAMES,0,0)
      %IF I#0 %THENSTART
         CODEGEN(I,TRIADS,COMAD)
         %IF COM_FAULTY=0 %THEN QPUT(8,ADMODULECHAIN,CISN,COUTFILE)
      %FINISH
      %IF COM_SCANONLY#0 %OR COM_FAULTY#0 %THEN %RETURN
      PRINTSTRING("[".STRING(CINFILE)." ==> ".STRING(COUTFILE)."]")
      NEWLINE
  %END; ! ENTER
!*
      COMAD= GET COMAD
      COM==RECORD(COMAD)
      %IF VARIABLE=NO %THENSTART
         NEWSEG(WORKSEG,64,1,64)
         WORKAD=WORKSEG
         WORKAD=WORKAD<<16
         COM_ATRIADS=WORKAD
         COM_ADOUTPUT=WORKAD+X'400'
         COM_MAXOUTPUT=8*128;! 1024 x 32 bit
         COM_ANAMES=WORKAD+X'C00'
         COM_NAMESLEN=16*256;! 4096 x 16 bit
         COM_ADEXT=WORKAD+X'1C00'
         COM_MAXEXT=5120
         COM_SAVEANAL=WORKAD+X'3000'
         COM_MAXANAL=3072
         COM_SAVEGEN=WORKAD+X'3C00'
         COM_MAXGEN=1024
         NEWSEG(DICTSEG,64,16,128)
         COM_ADICT=DICTSEG
         COM_ADICT=COM_ADICT<<16
         COM_MAXDICT=64*256;! 16K x 16 bit
      %FINISHELSESTART;! use varible areas
         NEWSEG(WORKSEG,4,4,32)
         WORKAD=WORKSEG
         WORK AD=WORKAD<<16
         COM_ATRIADS=WORKAD
         COM_ADOUTPUT=WORKAD+X'100';! + 256 x 16 bit words
         COM_MAXOUTPUT=OUTINIT
         NEWSEG(DICTSEG,16,16,128)
         COM_ADICT=DICTSEG
         COM_ADICT=COM_ADICT<<16
         COM_MAXDICT=DICTINIT
         NEWSEG(NAMSEG,4,4,32)
         COM_ANAMES=NAMSEG
         COM_ANAMES=COM_ANAMES<<16
         COM_NAMESLEN=NAMINIT
         NEWSEG(EXTSEG,4,4,64)
         COM_ADEXT=EXTSEG
         COM_ADEXT=COM_ADEXT<<16
         COM_MAXEXT=EXTINIT
         NEWSEG(ANALSEG,4,4,32)
         COM_SAVEANAL=ANALSEG
         COM_SAVEANAL=COM_SAVEANAL<<16
         COM_MAXANAL=ANALINIT
         NEWSEG(GENSEG,4,4,16)
         COM_SAVEGEN=GENSEG
         COM_SAVEGEN=COM_SAVEGEN<<16
         COM_MAXGEN=GENINIT
      %FINISH
      COM_DPTR=32
      COM_DICLEN=COM_MAXDICT-X'200'
      COM_CHARACTER CODE=0
      COM_SPACE CHAR=X'20'
      COM_CMNIIN=10
      COM_DIAGSTREAM=0
      COM_SCANONLY=SCAN
      COM_NOISY=NOISY
       ADMODULECHAIN = MODS
      CISN=ISN
      CNUMIMPS=NUMIMPORTS
      WRKF=WKID
      QPUT(1,WRKF,(SCAN<<8)!DEBUG,INFILE)
      ID="F_TEMP"
      COM_TRFILEID=CREATEFILE(ADDR(ID))
      CINFILE=INFILE
      COUTFILE=OUTFILE
      I=0;! for control options
      %IF CHECK=0 %THEN I=I!X'10';! no unassigned checks
      %IF RANGE=0 %THEN I=I!X'20';! no range checks
      %IF LIST#0 %THENSTART
         COM_LISTL=1
         COM_LISTSTREAM=1
         %IF CODE#0 %THEN I=I!X'4000';! object code listing
         %IF XREF#0 %THEN I=I!X'800' %AND COM_XREF=1;! cross-reference listing
      %FINISHELSE COM_LISTSTREAM=-1
      COM_CONTROL=I
!*
      QPUT(0,1,ADDR(VERSION),0)
      INIT ALLOC(COMAD)
!*
      BLKBUFFADDR=ADDR(BLKBUFF(0))
      INBLKS=BLKS
      INBYTES=BITS//8
      FILEID=INID
!*
      LISTFLAG=LIST
      %IF QUERY#0 %THENSTART
         ERRFLAG=0
      %FINISHELSESTART
         ERRFLAG=1
         COM_DIAGSTREAM=3
      %FINISH
      DEBUGFLAG=DEBUG
      ADICT=COM_ADICT
      ANAMES=COM_ANAMES
!*
      ENTER
!*
%END;! F77COMP
!*
%INTEGERFN NEXTBLOCK
%OWNINTEGER BLKSREAD
%IF BLKSREAD<INBLKS %THENSTART
   MOVE BEE
  READBLOCK(FILEID,BLKSREAD,BLKBUFFADDR)
  BLKSREAD=BLKSREAD+1
  %IF BLKSREAD=INBLKS %THEN %RESULT=INBYTES-1
  %RESULT=511
%FINISH
%RESULT=-1
%END; ! NEXTBLOCK
!*
%EXTERNALROUTINE SOURCE LINE(%INTEGER LBADDR)
%OWNINTEGER BITSREAD,BLKEND
%BYTEINTEGERARRAYNAME LBUFF
%BYTEINTEGERARRAYFORMAT LBF(0:80)
%BYTEINTEGERARRAYNAME BLOCK
%BYTEINTEGERARRAYFORMAT BF(0:511)
%INTEGER I
BLOCK==ARRAY(BLKBUFFADDR,BF)
LBUFF==ARRAY(LBADDR,LBF)
I=0
%CYCLE
  %IF BITSREAD=0 %THEN BLKEND=NEXTBLOCK
  %IF BLKEND<0 %THEN ->EOF
  %IF BLOCK(BITSREAD)=10 %THEN ->ENDLINE
  %IF BLOCK(BITSREAD)#13 %AND I<80 %THENSTART
    I=I+1
    LBUFF(I)=BLOCK(BITSREAD)
  %FINISH
  %IF BITSREAD=BLKEND %THEN BITSREAD=0 %ELSE BITSREAD=BITSREAD+1
%REPEAT
ENDLINE:
%IF BITSREAD=BLKEND %THEN BITSREAD=0 %ELSE BITSREAD=BITSREAD+1
LBUFF(0)=I
%IF I<73 %THENSTART
  %CYCLE I=LBUFF(0)+1,1,72
    LBUFF(I)=' '
  %REPEAT
%FINISH
%RETURN
EOF:
LBUFF(0)=1
LBUFF(1)=25
%END;! SOURCE LINE
!*
%ROUTINE TRACE(%STRING(8) NAME,%INTEGER LEN)
      %IF DEBUGFLAG#0 %THENSTART
         PRINTSTRING("EXTENDING ".NAME." SEG TO")
         WRITE(LEN,4)
         NEWLINE
      %FINISH
%END
!*
%EXTERNALINTEGERFN OUTPUTFUL
%RECORD(COMFMT)%NAME COM
      COMAD=GET COMAD
      COM==RECORD(COMAD)
      COM_MAXOUTPUT=COM_MAXOUTPUT+OUTINC
      %IF VARIABLE=NO %OR COM_MAXOUTPUT>OUTLIM %THENRESULT=1
      TRACE("OUTPUT",COM_MAXOUTPUT)
      EXTENDSEG(OUTSEG,COM_MAXOUTPUT//128)
      %RESULT=0
%END; ! OUTPUTFUL

%EXTERNALROUTINE NAMESFUL
%RECORD(COMFMT)%NAME COM
COM==RECORD(COMAD)
COM_NAMESLEN=COM_NAMESLEN+NAMINC
      %IF VARIABLE=NO %OR COM_NAMESLEN>NAMLIM %THENSTART
         SELECT OUTPUT(0)
         NEWLINE
        PRINTSTRING("*** Compiler limit - too many names in subprogram")
         NEWLINE
         %STOP
      %FINISH
      TRACE("NAMES",COM_NAMESLEN)
      EXTENDSEG(NAMSEG,COM_NAMESLEN//256)
%END; ! NAMESFUL

%EXTERNALROUTINE DICFUL
%RECORD(COMFMT)%NAME COM
      COM==RECORD(COMAD)
      COM_MAXDICT=COM_MAXDICT+DICTINC
      %IF COM_MAXDICT>DICTLIM %THENSTART
         SELECT OUTPUT(0)
         NEWLINE
         PRINTSTRING("*** Compiler limit - dictionary full")
         NEWLINE
         %STOP
      %FINISH
     TRACE("DICT",COM_MAXDICT)
      EXTENDSEG(DICTSEG,COM_MAXDICT//256)
COM_DICLEN=COM_MAXDICT-X'200'
%END; ! DICFUL
!*
%EXTERNALROUTINE EXTFUL
%RECORD(COMFMT)%NAME COM
COM==RECORD(COMAD)
COM_MAXEXT=COM_MAXEXT+256
      %IF VARIABLE=NO %OR COM_MAXEXT>EXTLIM %THENSTART
         SELECTOUTPUT(0)
         NEWLINE
       PRINTSTRING("*** Compiler limit - external reference table full")
         NEWLINE
         %STOP
      %FINISH
      TRACE("EXT",COM_MAXEXT)
      EXTENDSEG(EXTSEG,COM_MAXEXT//256)
%END; ! EXTFUL
!*
%EXTERNALINTEGERFN ANALFUL
%RECORD (COMFMT) %NAME COM
      COM==RECORD(COMAD)
      COM_MAXANAL=COM_MAXANAL+ANALINC
      %IF VARIABLE=NO %OR COM_MAXANAL>ANALLIM %THEN %RESULT=1
      TRACE("ANAL",COM_MAXANAL)
      EXTENDSEG(ANALSEG,COM_MAXANAL//256)
      %RESULT=0
%END
!*
%EXTERNALINTEGERFN GENFUL
      %RECORD (COMFMT) %NAME COM
      COM==RECORD(COMAD)
      COM_MAXGEN=COM_MAXGEN+GENINC
      %IF VARIABLE=NO %OR COM_MAXGEN>GENLIM %THEN %RESULT=1
      TRACE("GEN",COM_MAXGEN)
      EXTENDSEG(GENSEG,COM_MAXGEN//256)
      %RESULT=0
%END
!*
%ENDOFFILE