!* modified 17/03/82
!*
!*************************** 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
!*
!********************************************************************
!*
!***********************************************************************
!*
!*
!***********************************************************************
!* 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)
!*
!*
!%EXTERNALROUTINESPEC CODEGEN(%INTEGER CGENEP,
!                             %RECORD(TRIADF)%ARRAYNAME TRIADS,
!                             %INTEGER COMAD)
!*
%EXTERNALINTEGERFNSPEC GET COMAD
!*
%EXTERNALINTEGERFNSPEC ANALSTART(%RECORD(TRIADF)%ARRAYNAME TRIADS,
                           %INTEGER MAXTRIADS,COMAD,
                           %INTEGER ADICT0,ANAMES0,AMT,AM)
!%EXTERNALROUTINESPEC INIT ALLOC(%INTEGER COMAD)
%EXTERNALROUTINESPEC INITMAIN
%EXTERNALROUTINESPEC READBLOCK(%HALFINTEGER ID,BLLKNO,%INTEGER BUFFADDR)
!*
!*
%CONSTINTEGER NO=0
%CONSTINTEGER YES=1
%CONSTINTEGER FULL=2
!*
%OWNINTEGER COMAD
%OWNINTEGER INIT
%OWNINTEGER BLKBUFFADDR
%OWNHALFINTEGER INBLKS,INBYTES,FILEID
!*
%EXTERNALROUTINE F77COMP(   %C
   %HALFINTEGER OUTID,INID,WKID,EXTERN,RANGE,CHECK,LIST,CODE,XREF,
                ATTR,NOISY,QUERY,DEBUG,DOSTAT,BLOCKS,
   %INTEGER INFILE,ERRFILE,OUTFILE,
   %HALFINTEGER BLKS,BITS,ISN,
   %INTEGER MODS,
   %HALFINTEGER NUMIMPORTS,MEMSIZE)

%RECORD(COMFMT)%NAME COM
!*
%OWNRECORD(TRIADF)%ARRAY TRIADS(0:100)
%OWNINTEGER MAXTRIADS = 100
%OWNINTEGERARRAY OUTPUT(0:100)
%OWNBYTEINTEGERARRAY NAMES(0:99)
%OWNBYTEINTEGERARRAY DICT(0:1023)
!*
%BYTEINTEGERARRAY BLKBUFF(0:511)
%INTEGER VERSION,I
!*
  %ROUTINE ENTER
      %IF INIT=0 %THEN INIT=1 %AND INITMAIN
      COMAD= GET COMAD
      COM==RECORD(COMAD)
      COM_ADOUTPUT=ADDR(OUTPUT(0))
      COM_ANAMES=ADDR(NAMES(0))
      COM_MAXTRIADS=MAXTRIADS
      COM_ADICT=ADDR(DICT(0))
      COM_DPTR=32
      COM_DICLEN=1023
      COM_NAMESLEN=99
     PRINTSTRING("Edinburgh PERQ Fortran77 Compiler Test Version 0.1")
          NEWLINES(2)
      COM_CHARACTER CODE=0
      COM_SPACE CHAR=X'20'
      COM_CMNIIN=10
!*
      COM_DIAGSTREAM=0
!      INIT ALLOC(COMAD)
      I=ANALSTART(TRIADS,MAXTRIADS,COMAD,COM_ADICT,COM_ANAMES,0,0)
!      %IF I#0 %THEN CODEGEN(I,TRIADS,COMAD)
      PRINTSTRING("Returned to F77COMP")
      NEWLINES(2)
      %STOP
  %END; ! ENTER
!*
BLKBUFFADDR=ADDR(BLKBUFF(0))
INBLKS=BLKS
INBYTES=BITS//8
FILEID=INID
!*
ENTER
!*
%END;! F77COMP1
!*
%INTEGERFN NEXTBLOCK
%OWNINTEGER BLKSREAD
%IF BLKSREAD<INBLKS %THENSTART
  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
!*
%EXTERNALROUTINE DICFUL
%INTEGER I,J
I=0
J=1//i
%END
!*
%ENDOFFILE