ftncomp65.4.i

    ownstring(255) rcsid="$What: <@(#) ftncomp.i,v	63.0> $"
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved.
    ownstring(90) copyright = " Copyright (c) 1987, 1989 Edinburgh Portable Compilers Ltd. All Rights Reserved."

    externalroutine Set SIgs
    end

    !* $Log: ftncomp.i,v $
    !*                                                             ftncomp65.3
    !* 26/07/93 - Switch off code scheduling when -g
    !*                                                             ftncomp65.2
    !* 19/07/93 - Removed EInitialise call from this module - it's back in
    !*            ftndata again. (rt)
    !*                                                             ftncomp65.1
    !* 15/07/93 - Added -gisbuff=
    !*                                                             ftncomp65rt
    !* 13/07/93 - Added gY option and made gg enable rather than
    !*            disable global scheduling. (rt)
    !*                                                             ftncomp65g
    !* 06/07/93 - add support for O4, O5 and rt private options
    !*          - add calls to Esetoptions,EsetGISoptions
    !*            and Einitialise (Note: deleted call in ftndata)
    !*                                                             ftncomp64g
    !* 01/06/93 - consolidated version for 88110 and Mips
    !* 31/05/93 - recognise private options Zn and Xn for Fortran opt control
    !*                                                             ftncomp63.1
    !* 15/04/93 - -SC option for ADI Shared Commons
    !*            includes coff.inc if object format is ISCOFF
    !* 12Apr93  - added cgpeepmon and directed Malloc via getspace(pds)
    !*
    !* Revision 63.0  1992/12/23  15:25:00  simon
    !*                                                             ftncomp63
    !* 23/11/92 - case sensitivity option {-CS}
    !*            intrinsics left as lower case namelist IO - libI
    !*            passed -CS option
    !*
    !*                                                             ftncomp62.2
    !* 23/11/92 - Case sensitivity option {-CS}
    !*            recognises -CS in command line
    !*            sets bits in com_options2 and cgoptions
    !*                                                             ftncomp62.1
    !* 04/07/92 - Make no scheduling the default, only schedule
    !*            when optimiser switched on or -P cgshced
    !*          - for RS6000 -O3 no longer sets hsflt and as
    !*            reciprocation is done by the rs6000 code generator
    !*            the -O3 option is obsolete.
    !*
    !* Revision 62.0  1992/07/10  11:49:31  simon
    !*                                                             ftncomp62
    !* 10/07/92 - Common source:
    !*            Merge Intel change:
    !*            Only hardwire -us by clearing nus bit in
    !*            options2 if OMRON,not just when non OCScompliant
    !*          - 88K ELF change:
    !*            Increment vptr after processing pic options!
    !*          - RS6000 change:
    !* 17/06/92  Add cgparamsind to cgoptions for scheduler
    !*
    !*
    !* Revision 61.0  92/01/07  11:44:06  simon
    !                                                              ftncomp61.2
    !* 08/04/92 - Add -q[no]chkof to always do overflow checks
    !*            of floating point calculations
    !* 18/03/92 - Set options2 to nus for RS6000 to be compatible
    !*            with ibm's xlf compiler
    !*            also scheduling always on unless -x set
    !* 04/03/92 - Add -q[no]rndsngl,-q[no]hssngl for RS6000
    !*                                                             ftncomp61.1
    !* 24/01/91 - Change for IMP, whereby -O (optimise) implies
    !*            NOTRACE - this improves code scheduling.
    !*
    !*          - Also includes Pete's changes for his Imp compiler:
    !*            !06/12/91 - for IMP
    !*                Decouple MAXDICT and MAXWORK. Maxdict only
    !*                         affects names,
    !*                Allow -N2048 etc to specify exact workfilesize,
    !*                Reset BIGWORK to 512K (old Maxwork) and maxwork
    !*                         to 1023K,
    !*                Allow -m to mean MAXWORK+MAXDICT,
    !*                -m sets the workfile size to 1023K rather
    !*                         than 513K.
    !*                                                             ftncomp61
    !*            Merge in changes from sparc and omron:
    !*
    !*            SPARC:                                           ftncomp60.2
    !* 11/12/91 - for Emachine 4, tell the code generator if -pl
    !*            (for line profiling) has been specified.
    !*
    !*            for SPARC, switches off code scheduling (requested
    !*            via -P cgsched) if compiling with diagnostics or
    !*            sdb/dbx.
    !*                                                             ftncomp60.1
    !* 28/11/91 - Added the options -pic+ and -PIC+ to select
    !*            small-model and large-model position independent
    !*            code - currently no action is taken for Emachine 3
    !*
    !* 14/11/91 - Added the private option CGSCHED to select
    !*            code scheduling (on SPARC scheduling is
    !*            normally only performed when optimising).
    !*
    !*          - Added the private option CGSCHEDMON to switch on
    !*            Emachine4 code scheduler tracing, in bprocs2
    !*            onwards. This option also selects code scheduling.
    !*
    !*            OMRON:                                           ftncomp60.1
    !* 22/11/91 - set -us flag unconditionally for OMRON
    !*
    !* Revision 60.0  91/10/21  11:25:52  simon
    !*                                                               ftncomp60
    !* 19/10/91 - common source
    !*          - define and set superscalar
    !*          - define and set G2traceMOO
    !*
    !*
    !                                                             ftncomp59.2
    ! 03/10/91 - Allow -132 if Env=Gould which gives users
    !            two ways of having long lines (-132 and -ff)
    !                                                               ftncomp59.1
    ! 11/09/91 - Merge in Gould Changes:
    !          - call putincname from select include
    !          - add 77+ option
    !          - add closein
    !                                                               ftncomp59
    ! 28/07/91 - common source (==ftncomp58.1)
    !                                                               ftncomp58.2a
    !  7/08/91 - for m88k, rationalise use of Target = M88000 and
    !            Host = M88000 for the Sun3/Sun4 M88110 compiler.
    !
    !  6/08/91 - for IMP, put references to lineprofiler, profiler,
    !            timeprofiler, autoflag, and recipopt behind
    !            Compiler=Fortran conditional compilation.
    !                                                               ftncomp58.1
    ! 30/04/91 - for 88k call disabletraps to disable 88k fpu traps
    !                                                               ftncomp58
    ! 28/03/91 - added the private option NOUNROLL which inhibits
    !            loop unrolling (will only work in ftnloop27 onwards)
    !
    ! 25/03/91 - uses getstat.c and the host independent form of
    !            the file information table - compatible with
    !            fstatfmt10.inc onwards
    !
    !          - add function Nusoption which returns 1 if -nus
    !            has been used (88k only)
    !
    !          - add call to Esourcefile to pass the source file to
    !            dgen (Host=DRS only)
    !
    !          - implement -Y option to declare unshared common
    !            blocks (Allowparallel only)
    !
    !          - add procedure Abort (to provide a uniformity
    !            when reporting an error)
    !                                                               ftncomp57
    ! 22/01/91 - expanded the searchpaths for an INCLUDE file to
    !            include (a) the current working directory after
    !                        searching -I directories
    !                    (b) /usr/include after the current
    !                        working directory
    !            (required by Release 2.6.2)
    !
    ! 16/01/91 - add recipopt, misalignedreals, and Opt2max to
    !            the -P OPTIONS output
    !
    ! 08/01/91 - make instruction scheduling the default for 88k
    !          - moved Copyright text in Printvers into vers.X.inc
    !                                                               ftncomp56
    ! 08/01/91 - set recipopt if -O3
    !                                                               ftncomp55.1
    !  5/12/90 - allow the -o option to nominate an alternative
    !            name for the object file - compatible with a
    !            driver which only passes the -o option through
    !            for a command line which specifies -c
    !
    ! 16/09/90 - checks for (and skips) 'X' after any -G option
    !                                                               ftncomp54
    ! 12/09/90 - allow for a .for file extension
    !
    ! 11/09/90 - for Emachine>=4, set cgoptions as appropriate if
    !            profiling (-p or -pg) has been specified
    !
    !          - expects the driver to pass -pg as -p and hence
    !            interprets -pg as -p -g (ie. profile and sdb/dbx)
    !                                                               ftncomp53
    ! 05/09/90 - Add -P ctriads option to get triads with ecodes
    !
    ! 31/08/90 - uses the new include file vers.inc which defines   ftncomp52
    !            the compiler's Release and Reldate
    !
    ! 16/08/90 - support -us (underscore) for m88k - compatible     ftncomp51
    !            with a driver which passes -us as -us+ and -u
    !            as -u
    !
    !          - the warning message associated with inconsistent
    !            use of options is now constructed dynamically to
    !            avoid drawing a user's attention to options which
    !            he did not specify and which although recognised
    !            may not be documented for his system. (Note -p
    !            nor -pg invoke this warning, only -pl and -pt)
    !
    !          - moved additional DRS/SEQUENT specifics behind
    !            conditional compilation
    !
    !          - the externalstring SRCEFILENAME has been
    !            increased in size from 64 to 255 (this string
    !            is read by ftnmess)
    !
    !          - on Emachine4 Targets, compatible with ftnprofdum1.i
    !
    ! 15/08/90 - merge with ftncomp49.2.i                           ftncomp50.1
    ! 15/06/90 - merge in Sequent/386 mfcompile47t.i                ftncomp50
    !
    ! 6/06/90 - renamed for systems which only recognise up         ftncomp49.1
    !           to 16 character filenames
    !
    !         - support -V for parameter checking (but not if
    !            targetting on Gould)
    !
    !         - removed support for -args
    !
    !         - -U no longer selects parameter checking (except
    !           for Gould)
    !
    !         - no longer EXIT(1) after performing a syntax
    !           check - otherwise the driver will report
    !          'compiler error'
    !
    !         - relocated the check for inconsistent options
    !           specified with -O (the original location was
    !           after the call to Msetoptions and was therefore
    !           done too late)
    !
    !         - for m88k Fortran: initialise Options2 to nus
    !                                                           mfcompile49
    !19/05/90 - support -args
    !
    !30/04/90 - incorporates access control from Rob            mfcompile48.15
    !
    !         - also no longer breaks if the compiler is
    !           passed no source file
    !
    !17/04/90 - for Emachine>=4, added -x to unconditionally    mfcompile48.14
    !           switch off instruction scheduling
    !
    !         - for Fortran, added private option MISALIGN
    !           which is used by the Fortran compiler on
    !           Risc machines to assume that longreal arguments
    !           are not 8-byte aligned
    !
    !         - for Fortran, correct handling of the private
    !           option SCAN
    !
    ! 6/04/90 - for Fortran, added externalinteger autoflag     mfcompile48.13
    !
    ! 1/04/90 - for Emachine>=4 and Fortran, tell Msetoptions
    !           if the -g option has been specified
    !
    !14/03/90 - initialise Comreg (especially 26) before        mfcompile48.12
    !           calling Msetoptions
    !
    !         - increase the size of Comreg from 50 to 60
    !           because Elfput may set Comreg(59)
    !
    ! 5/03/90 - for both: enable instruction scheduling if      mfcompile48.11
    !                     any -O flag present
    !
    ! 1/03/90 - for IMP: make CHECK a recognised long option    mfcompile48.10
    !                    mark unrecognised long options in
    !                       the listing
    !26/02/90 - for IMP: make ARRAY the default                 mfcompile48.9
    !                    recognise -P MAP (the IMP compiler
    !                       will report and generate line
    !                       numbers with respect to the
    !                       current source or include file
    !                       and not the listing file
    !                    make parm OPT imply NOARRAY
    !                    set x'00800000' in options passed to
    !                       Msetoptions if compiling with parm
    !                       CHECK - the code generator will
    !                       initialise floating point traps
    !                       if compiling a main program
    !
    !02/02/90 - for Fortran, set minimum diags preparation      mfcompile48.8
    !           when calling Msetoptions if one or both of
    !           Unassigned or Array Bound checking has been
    !           requested, even if -d has not been specified
    !
    !28/01/90 - common m88k and sparc version                   mfcompile48.7
    !
    !24/01/90 - if host is m88k then declare and initialise     mfcompile48.6
    !           the diagnostics-stopper in main()
    !
    !18/01/90 - for Fortran modify criterion for setting the    mfcompile48.6
    !           externalinteger Comopt3 from Usechipfns=Weitek
    !           to Fregopt=1 {available}. If Fregopt=1 or host=drs
    !           then the interpretation of the -O option is as
    !           described under mfcompile47b
    !
    !         - for Fortran, add a declaration for externalinteger
    !           Parallelise
    !
    !         - for Fortran, set x'00400000' in options passed
    !           to Msetoptions if the compiler is optimising
    !
    !05/01/90 - modify the options passed to Msetoptions (if    mfcompile48.5
    !           Emachine>= 4) as follows:
    !
    !               IMP:     OPT     => parm NOLINE
    !                        NOTRACE => no preparation for diags
    !
    !               FORTRAN: default => no preparation for diags
    !                                   and no dynamic line numbers
    !                             -d => prepare for diags and
    !                                   dynamic line numbers
    !
    !03/01/90 - for IMP, implement -P ARRAY and interpret -C    mfcompile48.4
    !           as -P ARRAY.
    !
    !28/11/89 - temporarily added NOARRAY to the default        mfcompile48.3
    !           parameters for IMP because there currently
    !           is a problem with CBOUNDCHECK (in cprocs24).
    !
    !27/11/89 - added more compatibility with IMP using mf18i   mfcompile48.2
    !           from castle as a model - in particular:
    !
    !             MAXWORK and MAXDICT are the defaults: added
    !             the private option MINWORK if the original
    !             default is required.
    !
    !             the option -m sets the workfile size to 513K
    !             rather than 256K.
    !
    !             do a select output (Stdout) before calling
    !             Pgenerateobject (or Mgenerateobject) so
    !             that any tracing goes into the listing file
    !             and re-select Stderr on return.
    !
    !             for IMP hijack the -w option to inhibit
    !             the verbose mode of the compiler.
    !                                                           mfcompile48.1
    !19/11/89 - uses the constinteger COMPILER in ftnht rather
    !           than the local constinteger LANGUAGE.
    !
    !         - all references to comreg bar comreg(26) are
    !           now under COMPILER=IMP conditional compilation.
    !
    !         - placed -s and -V under ALLOWVECTOR= YES.
    !
    !         - added private option FILEMON (and FMON).
    !
    !         - does not attempt to align the buffer acquired
    !           from malloc on some boundary.
    !
    !         - updated for Emachine>= 4: in particular all
    !           PUT interfaces are assumed to start with P
    !           rather than M, and also:
    !
    !             added private option CGMON to switch on fragment
    !             and instruction allocation/deallocation
    !
    !             added call to Msetoptions
    !
    !         - also merged in code from sicompile3.4 (mfcompile
    !           for IMP on SPARC) which in turn was based on
    !           micompile2 (mfcompile for IMP on SUN). These
    !           changes are under the constinteger COMPILER=IMP
    !           and the following differences may be perceived
    !           if this version is used in conjunction with an
    !           IMP compiler:
    !
    !             for private option CODE set bit x'00004000' in
    !             comreg(27) - this passes the option to the
    !             impcompiler
    !
    !             added private option NOCHECK
    !
    !             -L is ignored (use -G instead)
    !
    !           The following changes may be preceived if earlier
    !           versions of mfcompile were used by the IMP
    !           compiler:
    !
    !             used Consource from micompile2
    !
    !             initialise com27 to x'010A0022' rather than
    !             to x'01080000'
    !
    !             signals are set by default (via setsigs)
    !
    !             no longer outputs the compilation options
    !             specified and is relatively quiet about the
    !             source filename. The object filename is not
    !             output either
    !
    !             added private options BIGWORK and MAXWORK
    !
    !             does not attempt to align the work file
    !             acquired from malloc on some boundary
    !
    !             does not include dummy routine for either
    !             pow_ri or poweroften
    !
    !                                                           mfcompile48
    !06/09/89 - version 48 taken for common EPC source
    !         - reldate string placed in ftnht to avoid having
    !           to change mfcompile source each time
    {07/08/89 - modified searchpath used by SELECT INCLUDE      mfcompile47g}
    {           which was incorporated into mfcompile47d.                   }
    {                                                                       }
    {           requires DR40 or later for the -Idir option.                }
    {                                                                       }
    {           instead of using $PATH if -I (by itself) was                }
    {           specified, the new searchpath is:                           }
    {              1/. the host directory of the file which                 }
    {                  is being compiled (note that this is                 }
    {                  how INCLUDE files have always been                   }
    {                  searched for in EPC Fortran).                        }
    {              2/. each directory specified by a -Idir                  }
    {                  option (note that -I (by itself) is                  }
    {                  ignored)                                             }
    {              3/. normally C would, as a last resort, look             }
    {                  in /usr/include - but this is considered             }
    {                  NOT suitable for Fortran as it may pick              }
    {                  up a C include file by mistake.                      }
    {                                                                       }
    {         - passes the full name of the INCLUDE file (which             }
    {           was used in the successful open) to MSETFILES.              }
    {           MSETFILES (in cdput8) however will currently                }
    {           perform a no-op on this call.                               }
    {         - removed a second (and therefore redundant) call             }
    {           on Malloc to align workareas if Fortran.                    }
    {29/06/89 - add optcontrols                                 mfcompile47f}
    {19/04/89 - -Idir option implemented                        mfcompile47d}
    {           uses dr36                                                   }
    {14/12/88 - use new include files                           mfcompile47c}
    { 7/08/88 - supports the new interpretation of the -O       mfcompile47b}
    {           option for the 386 which is as follows:                     }
    {                                                                       }
    {                -O      normal optimisation                            }
    {                -O1     normal optimisation + fregvars                 }
    {                -O2     normal optimisation + in-lining                }
    {                -O12    normal optimisation                            }
    {                 or            + fregvars                              }
    {                -O3            + in-lining                             }
    {                                                                       }
    {           this new interpretation is currently controlled             }
    {           by HOST=DRS.                                                }
    {         - note this procedure requires dr22.c onwards.                }
    { 2/08/88 - includes: ftn_ioconsts                          mfcompile47a}
    {                     ftn_ioparams                                      }
    {                     ftn_statfmt                                       }
    {                                                                       }
    {           use of these includes files removes the requirement         }
    {           to examine the form of the file information table           }
    {           when moving to another target.                              }
    {         - add externalinteger COMOPT3 to select fregvar               }
    {           allocation in ftncode if using -O1: also add                }
    {           private option NOFREG to switch allocation off.             }
    { 7/06/88 - remove private option NOUND.                     mfcompile47}
    {         - inhibit -ff setting UseFarData.                             }
    {         - merged UNISYS changes up to mfcompile42d                    }
    {                                                                       }
    {           these include:                                              }
    {         - tidied up output of the listing file when Stdout            }
    {           is different from Stderr: -the listing file gets            }
    {           the source file name as well: -Stderr gets a copy           }
    {           of any compilation errors.                                  }
    {         - also outputs the version text before the source             }
    {           file name.                                                  }
    {         - re-sited position at which version text and                 }
    {           source file name is output to Stderr.                       }
    {         - introduce externalinteger Unasscheck to pass                }
    {           to PUT.                                                     }
    {                                                                       }
    {         - also merged SUN3 changes up to mfcompile42.1                }
    {           these include:                                              }
    {                                                                       }
    {         - uses the constinteger ENV in FTN_HT.                        }
    {         - change "include" argument to Msetfiles as SUN3              }
    {           impcompiler does not support a string value as              }
    {           a string name parameter.                                    }
    {         - the SUN3 compiler does not support Pcodeon or               }
    {           Lineprofile.                                                }
    {                                                                       }
    { NOTE:   - if hosting on other than Gould, Unix5 DRS, or               }
    {           Sun3, then the format of the file information               }
    {           table should be checked.                                    }
    {25/05/88 - spell analyzed the American way                  mfcompile46}
    {         - -i2 equivalent to -I2                                       }
    {         - when checking line length check for tab                     }
    {15/05/88 - Include files to be in source dir (from 43.1)    mfcompile45}
    {18/04/88 - replace private option fuse by nofuse            mfcompile44}
    {16/04/88 - make source file name visible                    mfcompile43}
    {25/03/88 - provide alternative file info format for DRS     mfcompile42}
    {         - -nbs to set bslashnatural                                   }
    {17/03/88 - support -P Ov (optimise vectors)                 mfcompile41}
    {11/03/88 - set Opt2max for max inline subroutine size       mfcompile40}
    {         - support -P newbr                                            }
    {06/03/88 - support -72 and add param to Sourceline          mfcompile39}
    {29/02/88 - generalised for 386 etc.                                    }
    {         - -f adequate for freeformat if not Gould                     }
    {         - assume 132 char buffer                                      }
    {         - replace fuse,fusex by fuseall,fuse,fuselist                 }
    {24/02/88 - Checknus will always be called from gput for cmn mfcompile38}
    {23/02/88 - support -nus[file] and -P div; add Ckecknus      mfcompile37}
    {19/02/88 - Replace fuseloops by fuse and fusex                         }
    {14/01/88 - version 1.1                                      mfcompile36}
    {23/12/87 - Support -P fuseloops                             mfcompile35}
    {         - -P code now gives private listing
    {17/12/87 - -O now equivalent to -O1                         mfcompile34}
    {11/12/87 - Copyright to screen                              mfcompile32}

    {09/12/87 - Support -sr and -se                              mfcompile31}
    {18/11/87 - Support -P minvect                               mfcompile30}
    {09/11/87 - -q means no output                               mfcompile29}
    {                                                            mfcompile28}
    {05/11/87 - change depcheck to nodepcheck                               }
    {                                                            mfcompile27}
    {15/10/87 - support for -ff,-bs,-be,-bm,-bu , X after G,any digit string}
    {22/08/87 - add support for -nv to inhibit vectors}

        { Compilation Control routine for PNX }
        { Begun 14/oct/83 - Alan              }
        { Revised 30/dec/83   }
        { rel 1.2 12/dec/84 accept -N(dltb)  compile2}
        { rel 1.3 17/dec/84 accept -N(dltba)  compile3}
        { rel 1.6 20/feb/84 fix include non-existant file compile4 }
        {                   -i => -A; -r => -v }
        { rel1.1(G)  delete objectfile if compilation fails }
        { rel1.1(K) -A => -q }
        { rel1.2(A) forbid diagnostic options with optimising ones - compile7 }
        { rel1.2(B) Add routine DeleteObjectFile - compile8  15/Oct/85}
        { rel1.2(C) Check local filename length < 14 chars. compile9.i 9/dec/85}
        { alter for 680020 Fortran by using fort77 and P -> M }
        { rel0.1    Check -P text for UNSET before calling SetSigs. This is a }
        {           consequence of ditching FORTENTRY in favour of /lib/crt0.o}
        {           Control is received by routine COMPILE aliased to "main"  }
        {                                                            (Driver7)}
        { rel0.2    -L becomes -G (use Driver8 for compatibility)           }
        {           by default no signal traps are set; use of '-P set' will}
        {              set the traps    (MFCOMPILE6)                        }

        { 28/7/86  Unite Fortran and Imp control routines - Alan  }
        { 2/9/86  Amended compiler flags for Gould. - Alan }
        { 14/09/86 modified header and set Options2 for Inclusion/Exclusion - Geoff}
        { 30/9/86 Modified version text and stdout for -S - alan }
        { 14/Oct/86 Vsn 17 Set options2 on -f flag - alan }
        { 31/Oct/86 Vsn 17 Take + as -W terminator - alan }
        { 4/Nov/86 Vsn 17a DO not open object if -y option set  - alan }
        { 5/Nov/86         Fix check for opt and diag together. }
        {                  Remove check on file length. - alan }
        { 17/4/87 Vsn 18 Put in release identifier }
        { 23/4/87 Vsn 19 Put in name table size -Nx }
        { 29/5/87 vsn 20 Support -P depanal - graham }
        { 02/7/87 vsn 22 Support -P depcheck - geoff }
        { 22/7/87 vsn 23 recode resolution of long names - geoff }
        {                ignore -g to avoid loader failure - geoff }
        { 11/08/87 vsn 24 support -P prof }
        { 05/10/87 vsn 26 accept -Ws,lines }

    include "ftnht.inc"
    include "vers.inc"
    include "protection.inc"

    constinteger YES = 1
    constinteger NO  = 0

    if Object Format = ISCOFF start
      include "coff.inc"
    finishelsestart
      constinteger ADI Shared Commons = NO
    finish

    if Compiler= Fortran thenstart

       externalinteger optcontrols  {enable suppression of opt features}
                                     { 1 no fregs in inner loops }
                                     { 2 limit loop init (sred)  }
                                     { 4 movement of TEMPs       }
                                     {16 no loop unrolling       }
       externalinteger quiet        { suppresses passive compiler output }
       externalinteger Comopt3      { set if non-interference             }
       externalinteger recipopt     { set if compile-time reciprocate ia allowed}
       externalinteger Autoflag
       externalinteger hardoptions
       externalinteger misalignedreals=0
       externalinteger Opt2max=0
       externalinteger ctriads

       if Host= DRS and Env= Sequent thenstart
          externalinteger ATSfort=0
       finish

       if Allowparallel# 0 thenstart
          externalinteger Paralleloptions=0
          externalstring(31) array Unshcom(1:127)
          externalinteger Nunshcom = 0
       finish

       externalinteger Parallelise=0
       externalinteger Profiler=0
       externalinteger Lineprofiler=0
       externalinteger Timeprofiler=0

       externalintegerspec Inhib8X
       externalstring(255) Srcefilename

       externalinteger superscalar = 1
       externalinteger G2traceMOO = 0
    finish

    externalinteger Xoptimiseoptions = 0  {referenced b Fortran optimiser}
    externalinteger Poptimiseoptions = 0

    externalinteger Unasscheck   { referenced by PUT}

    if Target = Sparc thenstart
       externalinteger Sparcfsqrt = 0
    finish

    if Host=M88000 start
       externalroutinespec disabletraps
    finish
    if HOST=DRS thenstart
       externalroutinespec Esourcefile(string(255) name src)
       if Usechipfns=Weitek and Env=Sequent thenstart
          externalroutinespec Set Weitek Flags
       finish
    finish

    if Host# Sun3 or Env= GOULD thenstart

       if Emachine>= 4 thenstart
          externalroutinespec Mcodeon
       finishelsestart
          externalroutinespec Pcodeon
       finish

       if Compiler= Fortran thenstart

          externalintegerspec lineprofile
          externalinteger f77plus=0    { set by -f77+ option. Turns on 77+ extensions}
       finish
    finish

    if Compiler= Fortran and (Host# GOULD or Opsys# MPX) thenstart

       externalintegerfnspec Compstream (integer fildes1, fildes2)
    finish

    if Emachine>= 4 thenstart

       externalroutinespec   Pfaulty
       externalroutinespec   Pmonon
       externalroutinespec   Emonon
    !GT:   %externalroutinespec   Set Sigs
       externalroutinespec   Phex(integer n)
       externalroutinespec   Pgenerate Object(stringname s)
       externalroutinespec   Psetfiles(string(255) name src,obj,integer syntax)
       externalroutinespec   Msetoptions(integer options) {generator control}
       externalroutinespec   Esetoptions(integer cgoptions,botraceoptions, c
                                boinhiboptions,proc,fraglow,fraghigh)
       externalroutinespec   EsetGISoptions(integer buffzone,fullopt,trace, c
                                inhib,rangeregion)
       externalroutinespec   Cstring alias "s_cstring" (string(*) name Impstr, integer adCstr)
    finishelsestart

       externalinteger       Msetoptions
       externalroutinespec   Mfaulty
       externalroutinespec   Mmonon
       externalroutinespec   Emonon
    !GT:   %externalroutinespec   Set Sigs
       externalroutinespec   Phex(integer n)
       externalroutinespec   Mgenerate Object(stringname s)
       externalroutinespec   Msetfiles(string(255) name src,obj,integer syntax)
       externalroutinespec   Cstring(string(*) name Impstr, integer adCstr)
    finish

    if Compiler= IMP and Host= Sun3 thenstart

       externalintegerspec   SaveRegs { flag used by mgen and mcode to genearate}
                                       { code for saving d2-d7,a2-a5 for sun 3   }
                                       { when invoked by -P regsav               }
    finish

    if Compiler= Fortran Start
       externalintegerfnspec FORT77(integer Control,options1,options2,
                                               F77parm,optflags,srcflags,
                                               Console,Liststream,Diagstream,
                                               Diagnostic level,Dsize,Tsize,
                                               Bsize,Lsize,Asize,Nsize)
       recordformat Optfilesfmt(integer inaddr,inlen,exaddr,exlen,nusaddr,nuslen)
       externalrecord(Optfilesfmt) Optfiles
       if Protection=FLEXLM start        {Highland's licence server}
          externalintegerfnspec getlicense alias "get_license" c
                                               (integer adfeaturename)
          ownstring(6) featurename="EPCF77"
       finishelseif Protection=ALF start {ADI's licence server}
          if Env=Gould start
             externalintegerfnspec getadilicense alias "adi_get_gould_f77_license"
             externalroutinespec freeadilicense alias "adi_free_gould_f77_license"
          finishelsestart
             externalintegerfnspec getadilicense alias "adi_get_f77_license"
             externalroutinespec freeadilicense alias "adi_free_f77_license"
          finish
       finishelsestart                      {EPC timebomb}
          externalintegerfnspec accesscontrol alias "access_control_" c
                                 (integer adproducttag, adproductname)
          ownstring(5) producttag="F77"
          ownstring(6) productname="EPCF77"
       finish

    finishelsestart

        if Target= SPARC or Target= rs6000 or Target=MIPS thenstart
           externalroutinespec IMPCOMPILER alias "icl9cezrs6imp"
        finishelsestart
           externalroutinespec IMPCOMPILER alias "icl9cezgouldimp"
        finish
    finish

    externalstring(15) fnspec Itos    (integer n)

    externalroutinespec   EXIT   (integer Process return code) { Sys call }
    externalintegerfnspec Open   (integer adname,mode)         { Sys Call }
    externalroutinespec   LSeek  (integer id,offset,whence)    { Sys Call }
    externalintegerfnspec Read   (integer id,bytead,bytesize)  { Sys Call }
    externalroutinespec   Close  (integer id)                  { Sys Call }
    externalintegerfnspec Unlink (integer bytead)              { Sys Call }
    externalintegerfnspec Mallocalias "getspace" (integer bytesize) { C Library via interface}
    externalroutinespec   Free   (integer bytead)              { C Library }

    externalintegerfnspec Getfstat alias "s_getfstat" (integer id,bufad)

    if Compiler= IMP or (Host= GOULD and Opsys= MPX) thenstart

       externalintegerfnspec IsaTTY(integer id)                { C library }
    finish

    if Compiler= IMP Start
       recordformat EmasFileHeaderformat(integer dataend,
                                                   datastart,
                                                   filesize,
                                                   filetype,
                                                   sum,
                                                   datetime,
                                                   lda,
                                                   ofm)
    finish

    include "fstatfmt.inc"

    if Compiler= Fortran thenstart

       routinespec  InitialiseSource

       constinteger bufsize=4096
       owninteger   bufad
       owninteger   PrimarySrcID
       owninteger   warnlinelen = 0
    finish

    if Compiler= IMP thenstart

       owninteger      srclink=0
       owninteger      workad
       externalinteger SrcId
       owninteger      Srcsize
    finish

    if Emachine>= 4 thenstart

       externalinteger TargetVariant=0
       owninteger cgoptions
       !*
       constinteger cgreport    = x'00000001'
       constinteger cgcodelist  = x'00000002'
       constinteger cgschedmon  = x'00000004'
       constinteger cgparamsind = x'00000008'
       constinteger cgpeepmon   = x'00000010'
       constinteger cgglobsched = x'00000100'
       constinteger cgleafopt   = x'00000200'
       constinteger cgpeepopt   = x'00000400'
       constinteger cgprofile   = x'00010000'
       constinteger cgsetdbx    = x'00020000'
       constinteger cgdiags     = x'00040000'
       constinteger cglinenos   = x'00080000'
       constinteger cglinetab   = x'00100000'
       constinteger cgtrapovf   = x'00200000'
       constinteger cgregvaropt = x'00400000'
       constinteger cgFPUtraps  = x'00800000'
       constinteger cgschedule  = x'01000000'
       constinteger cgargchecks = x'02000000'
       constinteger cgRTcodelist= x'04000000'
       constinteger cglineprof  = x'20000000'
       constinteger cgcasesense = x'40000000'
       constinteger notcgglob   = x'FFFFFEFF'
       constinteger notcgleaf   = x'FFFFFDFF'
       constinteger notcgpeep   = x'FFFFFBFF'
       constinteger notcgsched  = x'FEFFFFFF'
       if Target#RS6000 start
          constinteger cgsmallPIC  = x'08000000'
          constinteger cglargePIC  = x'10000000'
       finishelsestart
          constinteger cgrndsngl   = x'08000000'
          constinteger cghssngl    = x'10000000'
          constinteger cghsflt     = x'40000000'
       finish

       owninteger botraceoptions = 0
       owninteger boinhiboptions = 0
       owninteger gisproc        = 0
       owninteger gisfraglow     = 0
       owninteger gisfraghigh    = 0
       owninteger gisbuffzone    = 0
       owninteger gisfullopt     = 0
       owninteger gistrace       = 0
       owninteger gisinhib       = 0
       owninteger rangeregion    = -1
    finish

    constinteger        READING = 0
    owninteger          syntaxcheck=0
    owninteger          monopt = 0
    owninteger          mmon = 0
    ownbyteintegerarray Cstr(0:255)
    owninteger        adCstr
    ownstring(255)      IncludeDir
    ownstring(255)      IncludePath {a concatenation of all the directories}
                                     {specified by any -Idir options        }

    externalintegermap Comreg(integer n)
      ownintegerarray C(0:60)
      result == C(n)
    end
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

      constinteger Stdin  = 0,
                    Stdout = 1,
                    Stderr = 2

      constinteger            active = x'80000000', { Possible values of F77PARM}
                              depanal = x'40000000',
                                  sdb = x'10000000',
                                   I2 = x'08000000',
                             Optriads = x'04000000',
                               Triads = x'02000000',
                                 Maps = x'01000000',
                            NoWarnlen = x'00002000',
                             NoWarn77 = x'00001000'
    constinteger c
                              Onetrip = x'00000800',
                                  F77 = x'00000400',
                              Vaxflag = x'00000200',
                                 Unix = x'00000100',
                               Strict = x'00000080'
    constinteger c
                          No Warnings = x'00000040',
                          No Comments = x'00000020',
                              NoBound = x'00000010'
    constinteger c
                             MinBound =          8,
                              NoUnass =          4,
                                Noarg =          2,
                               NoChar =          1

      constinteger              Xref = x'00000800', { Possible values of CONTROL}
                                 Code = x'00004000',
                                 Attr = x'00008000',
                               NoList = x'00000002'

      constinteger          Listnone = x'00000800', { Possible values of Options1 }
                                 Opt3 = x'00400000',
                                 Opt2 = x'00200000',
                                 Opt1 = x'00100000',
                              Maxdict = x'00000100',
                               NoCode = x'00000020',
                               Optext = x'00000010'

    constinteger           Dline  = x'00000001',   { Possible values of Options2 }
                            Xline  = x'00000002',
                            Yline  = x'00000004',
                            R8     = x'00000008',
                     List Includes = x'00000010'
    constinteger c
                         Profile   = x'00000020',
                         Noerrors  = x'00000040',
                         Vectorise = x'00000080',
                        Inclusions = x'00000100',
                        Exclusions = x'00000200',
                        UseFarData = x'00000400',
                      Nounderscore = x'00000800'
    constinteger c
                        nodepcheck = x'00001000',
                           fuseall = x'00002000',
                            nofuse = x'00004000',
                          fuselist = x'00008000',
                     bslashnatural = x'00010000'
    constinteger c
                      optionalargs = x'00020000',
                        freeformat = x'00040000',
                          sroption = x'00080000',
                          seoption = x'00100000'
    constinteger c
                               nus = x'00200000',
                           nusfile = x'00400000',
                    optimisevector = x'00800000',
                          csoption = x'01000000'

    constinteger           divset = x'00000001'    {Possible values of hardoptions}
    constinteger           newbr  = x'00000002'

                                      { FORT77 flags }
      owninteger F77parm   = active!Vaxflag!Unix!NoUnass!Noarg!NoChar!NoBound
      owninteger control   = NoList
      owninteger options1  = 0
      if Target= M88000 or Target=RS6000 thenstart
         owninteger options2= nus                     {for 88OPEN conformance}
                                                       {or ibm compatibility  }
      finishelsestart
         owninteger options2= 0
      finish
      owninteger srcflags  = 0
      owninteger optflags  = 0

    constinteger           quotes = x'00000001' , {possible values for Comreg(27)}
                           {NoList = x'00000002'}     {same as for CONTROL}
                            NoDiag = x'00000004' ,
                            iStack = x'00000008' ,
                           NoCheck = x'00000010' ,
                           NoArray = x'00000020' ,
                           NoTrace = x'00000040' ,
                          iProfile = x'00000080' ,
                           NoRange = x'00000100' ,
                          inhibiof = x'00000200' ,
                              zero = x'00000400' ,
                             {xref = x'00000800'}     {same as for CONTROL}
                            labels = x'00001000'
    constinteger c
                               let = x'00002000' ,
                             {code = x'00004000'}     {same as for CONTROL}
                             {attr = x'00008000'}     {same as for CONTROL}
                               opt = x'00010000' ,
                              iMap = x'00020000' ,
                             debug = x'00040000' ,
                             iFree = x'00080000' ,
                           dynamic = x'00100000' ,
                  {diag stream set = x'00200000'}
                            ebcdic = x'00400000'
    constinteger c
                            NoLine = x'00800000' ,
                   {stack size set = x'01000000'}
                            NoMain = x'02000000' ,
                             parmz = x'04000000' ,
                             parmy = x'08000000' ,
                             parmx = x'10000000' ,
                          mismatch = x'20000000'

                         {not used = x'40000000'}
                         {not used = x'80000000'}

    if Compiler= Fortran thenstart

       owninteger dsize = 0
       owninteger tsize = 0
       owninteger lsize = 0
       owninteger bsize = 0
       owninteger asize = 0
       owninteger nsize = 0

       owninteger      Diagnostic level = -1 { no diagnostics is default }
       externalinteger minvect= 4            {minimum array extent for vector code}

       owninteger dup output = 0  {set if info on Stdout is to be copied on Stderr}
       if Target=RS6000 start
          owninteger nohsflt      {set to 1 if user specifies -qnohsflt}
       finish
    finish

       owninteger Liststream = Stdout
       owninteger Diagstream = Stderr

       owninteger consolestream = 0{STDERR}

    routine Abort (string(31) error, string(255) extra info)
    !***************************************************************************
    !* Reports an error message and then exit(1)'s - if extra info#"" then it  *
    !* too will be included in the error message                               *
    !***************************************************************************
          newline
          printstring ("***")
          printstring (error)
          printstring (extra info) if extra info#""
          newline
          exit(1)
    end; ! Abort
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    if Compiler= Imp thenstart

    externalroutine ConSource(string(255)filename, integername filead)
    !***************************************************************************
    !* Connect source-file. Historically this derives from EMAS where the file *
    !* is mapped onto virtual memory. On UNIX systems two alternatives exits:  *
    !* either the file is read into a large buffer whose address is returned   *
    !* via FileAd, or the file is simply opened and reading conducted on a     *
    !* block-by-block basis. In this case, FileAd is preset to -1.             *
    !***************************************************************************
    byteintegerarray Cstr(0:255)
    integer adCstr,i
    record(Emasfileheaderformat) name  Hdr
    record(stat information table) Fid

      adcstr = addr(cstr(0)){*2}
      Cstring(filename,adcstr)                  { Get source filename in C format}
      SrcId = Open(adcstr,READING)              { Open source file}
      if monopt # 0 then printstring("
    SrcID = ") and write(SRcId,4)
      if Srcid=3 then SrcID = Open(adcstr,READING)     { Open source file}
    !  THIS IS JUST TILL WE GET AN OBJECT GENERATOR GOING - SRC MUST BE 4
      if Srcid=-1 then printstring("
    Cannot open source file ") and ->crunch
      i = Getfstat(Srcid,addr(Fid))             { Request info. about source}
      Srcsize = Fid_filesize                    { Find out its size}
      if Srcsize=0 then printstring("
    Empty file - ") and ->crunch
      if i=0 start                            { If ok so far}
        if monopt#0 then printstring("
    claiming source buffer of ") and phex(Srcsize+32)
        filead = malloc(Srcsize+32){//2}        { Grab global space for source }
        if monopt#0 then printstring(" at ") and phex(filead) and newline
      finishelse   printstring("
    Cannot get status on source ") c           { otherwise abort }
        and ->crunch
      if filead=0 start                       { abort if failed to get space }
        printstring("
    Malloc source buffer fails ")
        monitor;  ->crunch
      finish
      if monopt#0 then printstring("
    file size = ") and write(Srcsize,1)
      i = READ(SrcID,(filead{*2})+32,Srcsize)   { Read source file into global }
      CLOSE(SrcID)                              { close file }
      Hdr == record(filead)                     { produce a pseudo emas header}
      Hdr = 0
      Hdr_datastart = 32
      Hdr_dataend   = 32 + Srcsize
      Hdr_ofm = srclink                         { use spare field in hdr to  }
      srclink = filead                          { chain source areas together }
      return

    crunch: printstring(filename)
            stop
    end; ! ConSource
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !
    finish;  !if IMP

    externalroutine FreeSourceAreas
    !***************************************************************************
    !* This routine is called at the end of pass 1 to free source buffers.     *
    !***************************************************************************
      if Compiler = Imp start
         cycle
            FREE(srclink)
            srclink = integer(srclink+28)
         repeat until srclink=0
      finish
    end; ! FreeSourceAreas
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    if Compiler= Fortran thenstart

       routine printvers
             printstring(F77version)
             printstring(F77copyright text)
             newline
       end; ! printvers
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    routine Output (stringname text)

       {This procedure prints the parameter on  }
       {Stderr. If DUP OUTPUT is not set to zero}
       {the text will also be printed on Stdout }
       {It assumes that Stderr is the currently }
       {selected output stream                  }

        print string (text)

       if dup output# 0 thenstart
           select output (Stdout)
            print string (text)
           select output (Stderr)
          finish
    end; ! Output
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !
    finish;  !if Fortran

    routine Prepare (integer argc, argv)
    !***************************************************************************
    !* Prepare compiler options from the argument strings collected by the     *
    !* compiler driver. argc is the number of arguments on the shell statement *
    !* argv is a pointer to an array of string pointers specifying the argum-  *
    !* ents as null-terminated strings.                                        *
    !***************************************************************************

    integerfnspec readn
    integerfnspec readbv
    routinespec readnn(integername val1,val2)

      ownbyteintegerarrayformat argfm(1:1000)
      ownbyteintegerarrayname args
      ownintegerarrayformat argptrfm(1:100)
      ownintegerarrayname  argptr
      integer argument
      integer i,vptr,c,ptr,invalid
      string(254) source,s,object,root
      integer table
      integer slen
      integer setsigs flag   {set to 1 if signal traps are to be set}
                              {set to 0 otherwise                    }

      owninteger com26= 0
      if ADI Shared Commons=YES start
         externalroutinespec shcom list set up(string(32)  common)
         byteintegername    new shcom byte
         string(32)  new shcom      {temp for -SC option}
      finish

      if Compiler= IMP thenstart
         record(Emasfileheaderformat) name  Hdr

         owninteger workK = 2047
         owninteger srcad
         owninteger com27= x'01000000' {stack size set} ! iFree ! NoList
         owninteger com28 = 0
         owninteger com23 = -1
         owninteger com40 = Stderr
         owninteger noisy = 1

         stringname params {mapped onto Cstr while processing private options}

      finish

      if Compiler= Fortran thenstart
         record(stat information table) Fid

         integer    filead
         integer    type
         integer    ID
         integer    size
         integer    x
         ownstring(5) producttag="F77"
         ownstring(6) productname="EPCF77"
         ownstring(80)  Warning 1 Text= ""
         conststring(4) array Warning 1 Option (1:7)= " -d" , " -U" , " -V" ,
                                                        " -C" , " -g" , " -pl",
                                                        " -pt"
                               {the above order is dependent upon the order in}
                               {which Prepare looks for inconsistent options  }
         integer    Warning 1 flag
      finish

    if Compiler= IMP thenstart

       comreg(40) = 2  { Imp error stream }
       setsigs flag= 1 { set signals after processing any options/switches}
    finishelsestart

       size= 0
       setsigs flag= 0 { dont set signals}
    finish

      argptr == array(argv,argptrfm)
      argument = 1

      adcstr = addr(Cstr(0))

      Includepath = ""
      object = ""      { not explicitly specified }

    {---------------------------------------------------------------------------}
    { ********* Analyse Streams specified }

         { If list or diag stream is not tied to console: , tell compiler }
         {  with a negative number. Otherwise set positive }

    if Compiler= IMP or (Host= GOULD and Opsys= MPX) thenstart
       if IsaTTY(Stdout)#1 then Liststream = - Stdout
       unless Diagstream=0 start
          if IsaTTY(Stderr)#1 then Diagstream = - Stderr
       finish
    finishelse if Compstream (Stdout,Stderr)= 0 then Liststream= - Stdout

       select output (stderr)  { All status messages to go to STDERR}
    if Compiler= Fortran Start
       printvers
       if Protection=FLEXLM start
          i = getlicense(addr(featurename))
       finishelseif Protection=ALF start
          i = getadilicense
       finishelsestart
          i = access control(addr(producttag), addr(productname))
       finish
       if i#0 then EXIT(1)
    finish

    {---------------------------------------------------------------------------}
    { *********** Options following - are second parameter }
    {             Standard UNIX single letter options      }

     if argc < 2 start { No command line arguments }
       EXIT(0)
     finish

     cycle
      args == array(argptr(argument+1),argfm)
      if args(1)='-' start
        argument = argument+1
        vptr = 2   { discard '-' }
         cycle
          c = args(vptr)
          exit if c = 0

          ifc

     c = '1' start
             if Compiler= Fortran thenstart
                 if args(vptr+1)='3' and args(vptr+2)='2' start  { - 132 }
                    Options2 = Options2 ! freeformat
                    warnlinelen = 132
                    vptr = vptr+2
                 finishelsestart  { ONETRIP every DO loop to exec at least once }
                    F77parm = F77parm!Onetrip
                 finish
             finish
             finishelseifc

     c = 'C' start                                      { array bound checks on }
             if args(vptr+1)='S' thenstart    {-CS case sensitivity on}
                if Compiler=Fortran thenstart
                   options2=options2!csoption
                   vptr = vptr + 1
                finish
             finishelsestart                   { array bound checks on }
                if Compiler= IMP thenstart
                   com27 = com27&(¬NoArray)
                finishelsestart
                   F77parm = (F77parm!MinBound)&(¬NoChar)
                finish
             finish
             finish elseifc

     c = 'g' start                                       {SDB flag or gis buff  }
                 if args(vptr+1)='i' thenstart          {-gisbuff=             }
                    vptr = vptr + 7
                    i = 0
                    cycle
                       c = args(vptr+1)                   {get digits}
                       exit unless '0' <= c <= '9'
                       i = (i*10) + (c - '0')
                       vptr = vptr+1
                    repeat
                    if c = '+' then vptr = vptr + 1
                    gisbuffzone=i                          {set value}
                  finishelsestart                         {-g}
                    F77parm = F77parm!sdb
                    com26 = com26!4 { tell PUT }
                    cgoptions = cgoptions & (¬cgschedule)  {scheduling off}
                  finish
             finish elseifc

     c = 'G' start                                                 {Listing reqd}
             c = args(vptr+1)
             if Compiler= IMP thenstart
                com27 = com27&(¬NoList)
             finishelsestart
                Control = Control&(¬NoList)
                if c='1' or c='2' start
                   if c='1' then Options2=Options2!ListIncludes { and list include files }
                   if c='2' then Options1=Options1! Optext      { and show code movement by optimiser }
                   vptr=vptr+1
                   c = args(vptr+1)
                finish
             finish
             if c='X' then vptr=vptr+1
             finishelseifc

     c = 'u' thenstart
             if args(vptr+1)= 's' and args(vptr+2)= '+' thenstart { -underscore }
                options2 = options2 & (~nus)
                vptr     = vptr + 2
             finishelsestart
                F77parm = F77parm!x'4000'                            { type=undef  }
             finish
             finishelseifc

     c = 'w' start                              { suppress warnings and comments}
             if Compiler= IMP thenstart
                noisy= 0
             finishelsestart
                if args(vptr+1)='7' start  { suppress F77 warnings }
                   F77parm = F77parm!NoWarn77
                   vptr=vptr+2  { pass over  '77' }
                   finishelse F77parm = F77parm!No Warnings!No Comments!NoWarn77
             finish
             finishelseifc
     c = 'x' start
             if Emachine>= 4 thenstart
                cgoptions = cgoptions & (¬cgschedule) { -x used }
             finish
             finishelseifc
     c = 'y' start                                                { syntax check}
                    Options1 = Options1!NoCode
                    syntaxcheck=1
                    if Compiler= IMP thenstart
                       if Emachine>= 4 then Pfaulty                            c
                                        else Mfaulty
                    finish
             finishelseifc

     c = 'p' start                              { generate profile information }
                                                 { position independent code    }
             if args(vptr+1)='i' and args(vptr+2)='c' and                     c
                 args(vptr+3)='+' thenstart
                if Emachine= 4 and Target#RS6000 thenstart
                   vptr=vptr+2
                   cgoptions= cgoptions ! cgsmallPIC
                finishelsestart

                finish
             finishelsestart
                if args(vptr+1)='l' thenstart
                    if Emachine= 4 thenstart
                       cgoptions= cgoptions ! cglineprof
                    finish
                    if Target# SPARC and Compiler= Fortran then Lineprofiler = 1
                    vptr=vptr+1
                finishelsestart
                   if args(vptr+1)='t' thenstart
                      if Compiler= Fortran then Timeprofiler = 1
                      vptr=vptr+1
                   finishelsestart
                      if Compiler= Fortran then Profiler = 1
                      Options2 = Options2 ! profile
                      if Emachine >=4 thenstart
                         cgoptions= cgoptions!cgprofile
                      finish
                   finish
                finish
             finish
             finishelseifc

     c = 'P' start                     {position independent code - large model}
             if args(vptr+1)='I' and args(vptr+2)='C' and                     c
                 args(vptr+3)='+' thenstart
                if Emachine= 4 and Target#RS6000 thenstart
                   vptr=vptr+2
                   cgoptions= cgoptions ! cglargePIC
                finishelsestart

                finish
             finish
             finishelseifc

     c = 'q' thenstart
                if Target=RS6000 start
                   if args(vptr+1)='n' and  args(vptr+2)='o' start
                      if args(vptr+3)='c' and args(vptr+4)='h' start
                         cgoptions=cgoptions & (~cgtrapovf)        {-qnochkof}
                         vptr=vptr+7
                      finishelseif args(vptr+3)='r' and args(vptr+4)='n' andc
                          args(vptr+5)='d' start                 {-qnorndsngl}
                            cgoptions=cgoptions & (~cgrndsngl)
                            vptr=vptr+9
                      finishelseif args(vptr+3)='h' and args(vptr+4)='s' start
                         if args(vptr+5)='s' start              {-qnohssngl}
                            cgoptions=cgoptions & (~cghssngl)
                            vptr=vptr+8
                         finishelseif args(vptr+5)='f' start        {-qnohsflt}
                            cgoptions=cgoptions & (~cghsflt)
                            nohsflt=1
                            vptr=vptr+7
                         finish
                      finish
                    finishelseif args(vptr+1)='c' and args(vptr+2)='h' start
                       cgoptions=cgoptions ! cgtrapovf             {-qchkof}
                       vptr=vptr+5
                    finishelse if args(vptr+1)='r' and args(vptr+2)='n' andc
                          args(vptr+3)='d' start                 {-qrndsngl}
                            cgoptions=cgoptions ! cgrndsngl
                            vptr=vptr+7
                    finishelseif args(vptr+1)='h' and args(vptr+2)='s' start
                         if args(vptr+3)='s' start              {-qhssngl}
                            cgoptions=cgoptions ! cghssngl
                            vptr=vptr+6
                         finishelseif args(vptr+3)='f' start    {-qhsflt}
                            cgoptions=cgoptions ! cghsflt
                            vptr=vptr+5
                            nohsflt=0
                         finish
                    finishelsestart
                        Consolestream = 0
                    finish
                 finishelsestart
                    Consolestream = 0
                 finish
             finishelseifc
     c = 'S' thenstart                              {list of shared commons}
              if (ADI Shared commons=YES) and (args(vptr+1) = 'C') start
                vptr=vptr+1
                while args(vptr) # '+' cycle
                   vptr=vptr+1
                   i=0
                   while (args(vptr+i) # ',') and (args(vptr+i) # '+') and i<32 cycle
                      new shcom byte == byteinteger(addr(new shcom) + i + 1)
                      new shcom byte = args(vptr+i)
                      i=i+1
                   repeat
                   new shcom byte == byteinteger(addr(new shcom))
                   new shcom byte = i {set up length}
                   vptr=vptr+i
                   shcom list set up(new shcom) {pass as string}
                   while (args(vptr) # ',') and (args(vptr) # '+') cycle
                      vptr=vptr+1
                   repeat
                repeat
              finishelsestart
                    Control = Control!code
                    if Emachine>= 4 thenstart
                       cgoptions=cgoptions!cgcodelist
                    finishelsestart
                       if Compiler= IMP thenstart
                          com27 = com27 ! code
                       finish
                    finish
              finish
             finishelseifc

     c = 'a' start                                               { xref listing }
                  if Compiler= Fortran                      andc
                      args(vptr+1)='u' and args(vptr+2)='t' andc
                      args(vptr+3)='o'                       thenstart {automatic}
                        Autoflag=1
                        vptr=vptr+3
                  finishelsestart
                     if Compiler= Fortran           andc
                         Host= DRS and Env= Sequent thenstart
                        if args(vptr+1)='t' and args(vptr+2)='s' thenstart {ats}
                           ATSfort=1
                           vptr=vptr+2
                        finishelse Control = Control!xref!attr
                     finishelse Control = Control!xref!attr
                  finish
             finishelseifc

     c = 'U' thenstart                                 { unassigned checking on }
                    if Target= Gould thenstart
                       F77parm = F77parm&(¬(NoUnass!Noarg))
                    finishelsestart
                       F77parm = F77parm&(¬NoUnass)
                    finish
                    Unasscheck=1
             finishelseifc

     c = 'O' start                                               { optimisation }
                    cgoptions = cgoptions ! cgschedule ! cgpeepopt ! cgleafopt
                    if Compiler = IMP start
                      com27 = com27!opt
                    finishelsestart
                                  { enable instr scheduling}
                     if args(vptr+1)='X' start  { default case - just -O }
                       Options1=Options1!opt1
                       vptr=vptr+1
                     finishelsestart
                         Options1=Options1!opt1 if Host=drs or Fregopt=1
                        cycle
                           vptr=vptr+1
                           c=args(vptr)
                           exit if c='X'
                           if c='1' thenstart
                              Options1=Options1!opt1 if Host#drs and Fregopt=0
                              Comopt3 =1 if Fregopt=1 {available}
                               cgoptions=cgoptions!cgparamsind
                           finishelsestart
                              if c='2' then Options1=Options1!opt2
                              if c='3' thenstart
                                 recipopt=1 {compile-time invert}
                              finish
                              if c='4' or c='5' thenstart
                                 cgoptions = cgoptions ! cgglobsched
                                 if c='5' then gisfullopt = 1
                              finish
                           finish
                        repeat
                     finish

                    finish
                      finishelseifc
     c = 'D' start                              { Conditional compilation markers }
             if Compiler= Fortran thenstart
                   vptr = vptr + 1
                   c = args(vptr)
                  if c='D' then Options2 = Options2 ! Dline
                  if c='X' then Options2 = Options2 ! Xline
                  if c='Y' then Options2 = Options2 ! Yline
             finish
            finishelseifc
     c = 'n' start
             if Compiler= Fortran thenstart
                   vptr = vptr + 1
                   c = args(vptr)
                   if c='b' thenstart
                      vptr = vptr + 1
                      c = args(vptr)
                      if c='s' thenstart
                         Options2 = Options2 ! bslashnatural
                      finish
                      ->continue
                   finish
                   if c='v' then Inhib8X=1
                   if c='u' thenstart
                      vptr = vptr + 1
                      c = args(vptr)
                      if c='s' thenstart;  ! nus
                         Options2=Options2!nus
                         vptr = vptr + 1
                         if args(vptr)='+' then ->continue
                         s = ""
                         cycle
                            s = s.tostring(args(vptr))
                            vptr = vptr + 1
                         repeat until args(vptr) = '+'
                         cstring(s,addr(cstr(0)))
                         ID = OPEN(addr(cstr(0)),READING)
                         if ID<0 start
                            Abort ("Failed to open -nus file","")
                         finish
                         i = Getfstat(ID,addr(Fid))
                         size = Fid_filesize
                         filead = malloc(size)
                         i = READ(ID,filead,size)
                         if i<0 start
                            Abort ("Failed to read -nus file","")
                         finish
                         Close(ID)
                         Optfiles_nusaddr = filead
                         Optfiles_nuslen = size
                         Options2=Options2 ! nusfile
                      finish
                   finish
              finish
            finishelseifc
     c = 'e'  start                                  { switch off error reporting }
                   Options2 = Options2! noerrors
                       finishelseifc
     c = 'r'  start                                      { force double precision }
                    vptr = vptr+1  { get over '8' }
                   Options2 = Options2 ! R8
             finishelseifc
     c = 'f'  start
              if Target = Sparc thenstart          {look for fsqrt}
                 if args(vptr+1)='s' and args(vptr+2)='q' and   c
                     args(vptr+3)='r' and args(vptr+4)='t' and   c
                     args(vptr+5)='+' thenstart
                    Sparcfsqrt=1
                    vptr=vptr+5
                    ->continue
                 finish
              finish
              if Compiler= Fortran thenstart
                c = args(vptr+1)
                if c='f' thenstart                            { free format }
                  Options2 = Options2 ! freeformat
                  warnlinelen = 132
                  vptr= vptr + 1
                finishelsestart                               { Use Far Data }
                   if Target=GOULD thenstart
                      if c = 'X' then vptr = vptr + 1
                      Options2 = Options2 ! UseFarData
                   finishelsestart
                      Options2 = Options2 ! freeformat
                      warnlinelen = 132
                   finish
                finish
              finish
             finishelseifc
     c = 'b'  start                                         { NP1 Vectorise }
                vptr = vptr + 1
                c = args(vptr)
                if c = 's' then Options2 = Options2 ! bslashnatural
                if c = 'm' then Options2 = Options2 ! optionalargs
             finishelseifc

     c = 's'  start                                         { scalar SUM    }
              if Allowvector= 1 thenstart
                 vptr = vptr + 1
                 c = args(vptr)
                 if c = 'r' then Options2 = Options2 ! sroption
                 if c = 'e' then Options2 = Options2 ! sroption ! seoption
             finishelsestart
                if Allowparallel#0 thenstart
                  if args(vptr+1)='i' and args(vptr+2)='n' and c
                      args(vptr+3)='g' and args(vptr+4)='l' and c
                      args(vptr+5)='e' thenstart {single}
                        Paralleloptions=Paralleloptions!1
                        vptr=vptr+5
                  finish
               finish
             finish
             finishelseifc

     c = 'V'  start
              if Target= Gould thenstart                   { NP1 Vectorise }
                 if Allowvector= 1 thenstart
                    Options2 = Options2 ! Vectorise
                 finish
              finishelsestart                          { Parameter Checking }
                 F77parm = F77parm&(¬Noarg)
              finish
             finishelseifc
     c = 'W'   start                                { File of routine names }
                                                     { for Optimiser }
                  if Compiler= Fortran start
                    vptr = vptr +1   { get over 'O' }
                    type = args(vptr)
                    if type = 's' start  { -Ws,<digits>  (lines) }
                       vptr = vptr + 1
                       i = 0
                       cycle
                         c = args(vptr+1)
                         exit unless '0' <= c <= '9'
                         i = (i*10) + (c - '0')
                         vptr = vptr+1
                       repeat
                       vptr = vptr+1 if c='+'
                       vptr = vptr+1
                       Opt2max=i
                       continue
                    finish
                    vptr = vptr +2
                    s = ""
                    cycle
                      s = s.tostring(args(vptr))
                      vptr = vptr + 1
                    repeat until args(vptr) = '+'
                    cstring(s,addr(cstr(0)))
                    ID = OPEN(addr(cstr(0)),READING)
                    if ID<0 start
                       Abort ("Failed to open -WO file","")
                    finish
                    i = Getfstat(ID,addr(Fid))
                    size = Fid_filesize
                  filead = malloc(size)
                    i = READ(ID,filead,size)
                    if i<0 start
                       Abort ("Failed to read -WO file","")
                    finish
                    Close(ID)
                    if type = 'i' start
                       Optfiles_inaddr = filead
                       Optfiles_inlen = size
                       Options2 = Options2 ! Inclusions
                    finishelsestart
                       Optfiles_exaddr = filead
                       Optfiles_exlen = size
                       Options2 = Options2 ! Exclusions
                    finish
                 finish { fortran }
                  finishelseifc

     c = 'I' or c = 'i' start                       { set default integer size }
                 vptr = vptr + 1
                 c = args(vptr)
             if c = '2' then F77Parm = F77Parm!I2 elsec
             if c # '4'  and args(vptr-1) = 'I' thenstart

                      ptr = addr(s)
               cycle
                      ptr = ptr + 1
                      byteinteger(ptr)= c
                      if c = '+' thenexit
                      vptr = vptr + 1
                      c = args (vptr)
               repeat
                   i = ptr - (addr(s))
               if i > 1 then length(s) = i and Includepath = Includepath . s
               finish
             finishelseifc

     c = 'o' start                     { nominate an alternative object filename }
                   ptr = addr(object)
                cycle
                       v ptr = vptr + 1
                       c = args(vptr)
                       exit if c = '+'
                       ptr = ptr + 1
                       byteinteger(ptr) = c
                repeat
                   length(object) = ptr - addr(object)
             finishelseif c = 'Y' start
             if Allowparallel# 0 thenstart
                 vptr = vptr + 1
                 c = args(vptr)
                 ptr = addr(s)
                 cycle
                      if c = '+' thenexit
                      ptr = ptr + 1
                      byteinteger(ptr)= c
                      vptr = vptr + 1
                      c = args (vptr)
                 repeat
                 i = ptr - (addr(s))
                 if i > 0 thenstart
                    length(s) = i
                    if Nunshcom<127 thenstart
                       Nunshcom = Nunshcom+1
                       Unshcom(Nunshcom) <- s
                    finishelsestart
                       Abort ("Only 127 unshared common blocks allowed","")
                    finish
                 finish
             finish
             finishelseifc

     c = 'N' start                                                 { Table size }
                    vptr = vptr + 1
                    table = args(vptr)
                    i = 0
                    cycle
                       c = args(vptr+1)
                       exit unless '0' <= c <= '9'
                       i = (i*10) + (c - '0')
                       vptr = vptr+1
                    repeat
                    if c = '+' then vptr = vptr + 1
                    if Compiler= Fortran thenstart
                       if table = 'd' then dsize = i
                       if table = 't' then tsize = i
                       if table = 'l' then lsize = i
                       if table = 'b' then bsize = i
                       if table = 'x' then nsize = i
                       if table = 'a' then asize = i
                    finishelsestart
                       workK= i
                    finish

             finishelseifc

     c = '7' start                                             { line length check}
             if Compiler= Fortran thenstart
                    vptr=vptr+1
                    c = args(vptr)
                    if c='2' thenstart
                       warnlinelen = 72
                       c = args(vptr+1)
                    finishelsestart
                         if Env=Gould and c='7' start
                              c = args(vptr+1)
                              if c='+' start
                                   f77plus=1         {77+ extensions}
                                   vptr=vptr+1
                              finish
                         finish
                    finish
             finish
             finishelseifc

     c = 'd' start                                                { Diagnostics }
             if Compiler= Fortran thenstart
                    i = 0
                    cycle
                      c = args(vptr+1)
                      exit unless '0' <= c <= '9'
                      i = (i*10) + (c - '0')
                      vptr = vptr+1
                    repeat
                    if c = '+' then vptr = vptr + 1
                    Diagnostic level = I
             finish
             finishelseifc

     c = 'm' thenstart                                               { parallel }
                if Allowparallel#0 thenstart
                    if args(vptr+1)='p' thenstart
                      vptr=vptr+1                                 { pass over  'p' }
                      Parallelise=1
                    finish
                finish
                if Compiler= IMP thenstart
                   com28 = com28!x'100'
                   workK = 2047 if workK<2047
                finish
             finish

    continue:

    not implemented:
          vptr = vptr+1
        repeat
      finish else exit
    repeat

    if Allowparallel#0 thenstart
       if Parallelise=1 and Lineprofiler=1 then Lineprofiler=0
       if Parallelise=1 and Timeprofiler=1 then Timeprofiler=2
    finish
    if OCScompliant=0 and (Target=M88000 and Object Format=ISBSDOMRON) start
       options2 = options2&(~nus)  {hardwire -us only for OMRON}
    finish

    argument = argument+1
    {----------------------------------------------------------------------------}
    { ********* SOURCE FILE is  third parameter }

      source=""
       args == array(argptr(argument),argfm)
       vptr = 1
       argument = argument+1
      cycle
        source=source.tostring(args(vptr))
        vptr=vptr+1
      repeat until args(vptr)=0
      root = source
      length(root) = length(root)-1 { discard 'i' }

    if Compiler= Fortran thenstart
       Srcefilename=source  {available for error reports}
       printstring(source)
       newline
    finish

    {----------------------------------------------------------------------------}
    { ******** Fourth parameter is -P text used for private verbose options }

    if Host= Sun3 and Compiler= IMP thenstart
       SaveRegs=0   { assume registers are not to be saved }
    finish

       s = ""
    if Compiler= IMP thenstart
       params== string (AdCstr)           {params will be used to save the identity}
       params= ""                         {    of the private options specified    }
    finish

      if argptr(argument)=0 then ->NOfourthPARAM
        args == array(argptr(argument),argfm)
         vptr = 1
      cycle
        c = args(vptr)
        if c=',' or c='/' or c=0 start
          exit if s="(NULL)"            {no long options}

          invalid=0
          if Compiler = IMP start
            if s = "LIST"       then start; com27 = com27&(¬NoList)
            finishelseif s = "CODE"       thenstart
                                    com27 = com27 ! code
                                    if Host# Sun3 or Env= GOULD thenstart
                                       if Emachine>= 4 then Mcodeon             c
                                                        else Pcodeon
                                    finishelse control= control ! code
     {          s = "DIAG"       %then Diagstream = 2 {Stderr}{        %elseifc    }
            finishelseif s = "OPT"        then start
                com27 = com27!opt
            finishelseif s = "QUOTES" or s="CASESENS"     then start;
                com27 = com27!1
            finishelseif s = "MAP"        then start
                com27 = com27!iMap
            finishelseif s = "FIXED"      then start
                com27 = com27&(¬iFree)
            finishelseif s = "PROFILE"    then start
                com27 = com27!iProfile
            finishelseif s = "NOTRACE"    then start
                com27 = com27!NoTrace
            finishelseif s = "NOLINE"     then start
                com27 = com27!NoLine
            finishelseif s = "NOCHECK"    then start
                com27 = com27!NoCheck
            finishelseif s = "MIPS2" then start
                TargetVariant=5{R4000}
            finishelseif s = "CHECK"      then start
                com27 = com27&(¬Nocheck)
            finishelseif s = "NODIAG"     then start
                com27 = com27!NoDiag
            finishelseif s = "NOARRAY"    then start
                com27 = com27!NoArray
            finishelseif s = "ARRAY"      then start
                com27 = com27&(¬NoArray)
            finishelseif s = "PARMX"      then start
                com27 = com27!parmx
            finishelseif s = "PARMY"      then start
                com27 = com27!parmy
            finishelseif s = "PARMZ"      then start
                com27 = com27!parmz
            finishelseif s = "LINE"       then start
                com27 = com27&(¬NoLine)
            finishelseif s = "MINWORK"    then start
                com28 = com28&x'FFFFFEFF'
                workK = 128
            finishelseif s = "BIGWORK"    then start
                workK = 512
            finishelseif s = "MAXWORK"    then  start
                workK = 2047 if workK<2047
            finish elseif s = "MAXDICT"    then start
                com28 = com28!x'100'
            finishelseif Host= Sun3 and s = "REGSAV"     then start
                SaveRegs= 1
            finishelsestart
                { none of these }      invalid=invalid+1
            {GT}finish
          finish

          if  s = "SCAN"       thenstart
                                if Emachine>= 4 then Pfaulty                    c
                                                 else Mfaulty
                                Options1 = Options1!NoCode
                                syntaxcheck= 1
                                finish                                elseifc
               s = "VERSION"    then start; printstring(reldate); finishelseifc
               s = "OPTIONS"    then start; monopt = 1; finishelseifc
    {GT: messed up an edit - check against original if line below is OK }
               s = "SET"        then start; setsigs flag = 1; finishelseifc
               s = "UNSET"      then start; setsigs flag= 0; finishelseifc
               s = "FILEMON" orc
               s = "FMON"       then start;  com26= com26!16; finishelseifc
               s = "MALLOCMON"  then start; com26= com26!128
                                mmon=1; finishelseifc
               s = "CGMON"      thenstart
                                  if Emachine>=4 then cgoptions=cgoptions!cgreport
                                finish                                elseifc
               s = "CGSCHED"    thenstart
                                  if Emachine>=4 thenstart
                                     cgoptions=cgoptions!cgschedule
                                  finish
                                finish                                elseifc
               s = "CGSCHEDMON" thenstart
                                  if Emachine>=4 thenstart
                                     cgoptions=cgoptions!cgschedule!cgschedmon
                                  finish
                                finish                                elseifc

               s = "CGPEEPMON" thenstart
                                  if Emachine>=4 thenstart
                                     cgoptions=cgoptions!cgpeepmon
                                  finish
                                finish                                elseifc
               s = "PMON" orc
               s = "P"          thenstart
                                if Emachine>= 4 then Pmonon                     c
                                                 else Mmonon
                                finish                                elseifc
               s = "EMON" orc
               s = "E"          then Emonon                           elsec
               { none of these }       invalid=invalid+1

          if compiler = IMP start
             if invalid=2 then s="[".s."]"
             if params="" then params=s else params=params.",".s
          finish
          if c=0 then exit
          s=""
          vptr = vptr+1 { discard , or / }
          continue
        finish
        if 'a'<=c<='z' then c = c - 32
        s = s.tostring(c)
        if Compiler = Fortran or Compiler = Imp Start
          if s="G" thenstart
             c = args(vptr+1)
             vptr = vptr+1
             if c='x' thenstart
                       cgoptions = cgoptions & notcgsched
                       finishelseif c
                 c='l' thenstart
                       cgoptions = cgoptions & notcgleaf
                       finishelseif c
                 c='g' thenstart
                       cgoptions = cgoptions ! cgglobsched
                       finishelseif c
                 c='p' thenstart
                       cgoptions = cgoptions & notcgpeep
                       finishelseif c
                 c='Y' thenstart
                       cgoptions = cgoptions ! cgschedmon
                       finishelseif c
                 c='m' thenstart
                       i = readn
                       cgoptions = cgoptions ! ((i&15)<<12)
                       finishelseif c
                 c='t' thenstart
                       gistrace = readbv
                       finishelseif c
                 c='I' thenstart
                       gisinhib = readbv
                       finishelseif c
                 c='B' thenstart
                       boinhiboptions = readbv
                       finishelseif c
                 c='P' thenstart
                       gisproc = readn
                       finishelseif c
                 c='R' thenstart
                       readnn(gisfraglow,gisfraghigh)
                       finishelseif c
                 c='u' thenstart
                       rangeregion = readn
                       finishelseif c
                 c='b' thenstart
                       botraceoptions = readbv
                       finishelsestart
                       printstring("invalid option g".tostring(c))
                       newline
             finish
             s=""
          finish
       finish
       if Compiler = Fortran start

          if s = "SF" or s="OF"  or s="LIMIT" or s="MINVECT"  c
                       or s="X" or s="Z" start
            i = 0
            cycle
              c = args(vptr+1)
              exit unless '0' <= c <= '9'
              i = (i*10) + (c - '0')
              vptr = vptr+1
            repeat
            if s="X" then Xoptimiseoptions = Xoptimiseoptions ! i
            if s="Z" then Poptimiseoptions = Poptimiseoptions ! i
            if s="SF" then srcflags = i
            if s="OF" then optflags=i
            if s="LIMIT" then optcontrols=optcontrols ! i
            {%if s="LIM" %then options2=options2!(i<<16)}
            if s="MINVECT" then minvect=i
            s=""
          finish
        finish
        vptr = vptr+1
      repeat
    NOFOURTHPARAM:

    !check if signal traps are to be set (for diagnostics}
         !
         Set Sigs unless setsigs flag= 0

      comreg(26)= com26 if com26# 0
      comreg(27)= com27 if Compiler= Imp and com27# 0
      comreg(28)= com28 if Compiler= Imp and com28# 0

    if Compiler= Fortran start
    !*
    !***************************************************************************
    !* analyse options/switches specified                                      *
    !***************************************************************************
    !*
       Warning 1 Flag= 0
       if options1&(opt1!opt2!opt3) # 0 thenstart
          if Diagnostic level # -1 thenstart
             Warning 1 Flag= 1
          finish
          if F77parm&NoUnass  =  0 thenstart
             Warning 1 Flag= Warning 1 Flag ! 2
          finish
          if F77parm&Noarg    =  0 thenstart
             Warning 1 Flag= Warning 1 Flag ! 4
          finish
          if F77parm&MinBound #  0 thenstart
             Warning 1 Flag= Warning 1 Flag ! 8
          finish
          if F77parm&sdb      #  0 thenstart
             Warning 1 Flag= Warning 1 Flag ! 16
          finish
          if Lineprofiler     #  0 thenstart
             Warning 1 Flag= Warning 1 Flag ! 32
          finish
          if Emachine= 4 andc
             (cgoptions & cglineprof) # 0 then Warning 1 Flag= Warning 1 Flag ! 32
          if Timeprofiler     #  0 then Warning 1 Flag= Warning 1 Flag ! 64
            !
            !(Optimising overrides Diagnostics, Unassigned Checking, Argument
            !            Checking, Array Bound Checks, SDB, Line Profiling,
            !            and Time Profiling}

          if Warning 1 Flag# 0 thenstart {undo any damage}
             F77parm = (F77parm & ( ¬(MinBound!sdb)) ! NoChar ! NoUnass ! Noarg )
             if Emachine= 4 thenstart
                cgoptions= cgoptions & (~cglineprof)
             finish
             Diagnostic level = -1
             !Note:
             !    Check consistency of options before calling Msetoptions. Any
             !    inconsistency however cannot be reported until the status of
             !    the listing and error stream has been established - hence set
             !    a flag which will be inspected later
          finish
       finish
    finish

    if Emachine>= 4 thenstart
    !*
    !***************************************************************************
    !* prepare options for code generator                                      *
    !***************************************************************************
    !*
        if Compiler= IMP thenstart
           if (com27 & opt    )# 0 then com27=com27 ! NoLine ! NoArray ! NoTracec
                                    and  comreg(27)= com27
           if (com27 & NoTrace)= 0 then cgoptions= cgoptions ! cgdiags
           if (com27 & NoLine )= 0 then cgoptions= cgoptions ! cglinenos
           if (com27 & Nocheck)= 0 then cgoptions= cgoptions ! cgFPUtraps
        finish

        if Compiler= Fortran thenstart
           if Diagnostic level>= 0 orc
               (F77parm & 15)   # 7 then cgoptions=cgoptions ! cgdiags ! cglinenos
           if (F77parm & sdb)  # 0 then cgoptions=cgoptions ! cgsetdbx
           if (F77parm & Noarg)= 0 then cgoptions=cgoptions ! cgargchecks
           if (Options1 & opt1)# 0 then cgoptions=cgoptions ! cgregvaropt
        finish

        !
        if Target = M88000 or Target = SPARC then start
           { no instruction scheduling if any diagnostic options are set }
           if (cgoptions & (cgdiags ! cglinenos ! cgsetdbx ! cgargchecks) <> 0) c
             then cgoptions = cgoptions & (¬cgschedule)
        finish
        !

        if options2&csoption#0 then cgoptions=cgoptions!cgcasesense  {-CS}

        if Compiler = Fortran or Compiler = Imp thenstart     {modified 06/07/93}
           Esetoptions(cgoptions,botraceoptions,boinhiboptions,gisproc,  c
                        gisfraglow,gisfraghigh)
           EsetGISoptions(gisbuffzone,gisfullopt,gistrace, c
                                gisinhib,rangeregion)
        finishelsestart
           Msetoptions (cgoptions)
        finish

    finishelsestart
        Msetoptions = F77parm
    finish

    {--------------------------------------------------------------------------}

      s = source
      {i=i+1 %while s ->("/").s}
      IncludeDir = ""
      slen=length(s)
      cycle i=slen,-1,1
         if charno(s,i)='/' thenstart
            IncludeDir = s
            length(Includedir)=i
            charno(s,i)=slen-i
            s=string(addr(s)+i)
            exit
         finish
      repeat
      !%if length(s)>14 %start
          !print string ("Error: File name longer than 14 characters ")
          !print string ( s )
          !newline
          !EXIT(1)
      !%finish

      if object="" thenstart
         slen= length(s) - 1                        {prepare to discard 'f' or 'i'}
         if Compiler= Fortran thenstart
            if charno(s,slen)='f' thenstart
               slen= slen - 1                       {allow for .fv}
            finishelsestart
               if (charno(s,slen)='o' and charno(s,slen-1)='f') thenstart
                  slen= slen - 2                    {allow for .for}
               finish
            finish
         finish
         length(s)= slen
         object = s."o"
      finish

    if Compiler= Imp and (com27 & NoList)= 0 thenstart
    !*
    !***************************************************************************
    !* print header to the listing file (if IMP and LIST)                      *
    !***************************************************************************
    !*
        if params= "" then params= "Defaults"
        if Diagstream> Liststream thenstart
           print string (source)                                       {on Stderr}
           newline
        finish
        select output (Stdout)
        print string ("Source:    "); print string (source); newline
        print string ("Object:    "); print string (object); newline
        print string ("Parms:     "); print string (params); newline
    finishelsestart

       if Compiler= IMP then print string (source) and newline
    finish

      if Host=DRS thenstart
         Esourcefile(source)                   { Inform gen of sourcefilename }
      finish

      if Emachine>= 4 thenstart
         Psetfiles(source,object,syntaxcheck)  { Inform Put of source and object}
      finishelsestart
         Msetfiles(source,object,syntaxcheck)  { Inform Put of source and object}
      finish

      if Compiler= Fortran start
         Cstring(source,adcstr)
         primarySrcID = Open(adcstr,READING)
         if primarySrcID<0 thenstart
            Abort ("Failed to open Sourcefile - ",source)
         finish
      finish

    if Compiler= IMP start
    !*
    !***************************************************************************
    !* Claim compiler work-space by allocating WorkAd kbytes from memory.      *
    !***************************************************************************
    !*
        if monopt#0 then printstring("
    claiming workspace at ")

      { Set up Work File }
        workad = malloc(workK*1024)
        if monopt#0 then phex(workad) and printstring(" of ") and phex(workk*1024)
        comreg(14) = workad
        Hdr == record(workad)
        Hdr = 0
        Hdr_datastart = 32
        Hdr_filesize = workK*1024
    !*
    !***************************************************************************
    !* Connect source-file. In this case simply open the file for reading.     *
    !***************************************************************************
    !*
        ConSource(source,srcad)                   { grab source file }
        selectinput(Srcid)
        comreg(1)=Srcsize
        comreg(46) = srcad                        { c46 holds address for Peter }

        com23= -1 if noisy= 0

        if (com27 & NoList)= 0 orc
          (Control & Code  )# 0 orc
                     noisy  = 1 thenstart
            com23= Stdout
            com40= -1 if Diagstream> 0 and Liststream> 0
        finish
        comreg(40)= com40
        comreg(23)= com23
        select output (com23)

    finish

    if Compiler= Fortran start

    {--------------------------------------------------------------------------}
    { ********* Analyse Options/Switches specified }

       if control&2=0 thenstart  {listing requested}

          if Liststream< 0 or Diagstream< 0 thenstart
              select output (Stdout)
              dup output= 1
              printvers
              print string (source)
              newlines (2)
              select output (Stderr)
             finishelse newline
       finish

       if gisbuffzone#0 and (cgoptions & cgglobsched#cgglobsched) thenstart
    Warning 1 Text="Warning: -gisbuff= option used without -O4 or -O5
    "
           Output (Warning 1 Text)
           finish

       if Warning 1 flag# 0 thenstart
          i= 1
          Warning 1 Text= ""
          while Warning 1 Flag# 1 cycle
             if Warning 1 Flag & 1# 0 thenstart
                Warning 1 Text= "," . Warning 1 Option(i) . Warning 1 Text
             finish
             i= i + 1
             Warning 1 Flag= Warning 1 Flag>> 1
          repeat
          x= length(Warning 1 Text)
          Warning 1 Text= Warning 1 Option(i) . Warning 1 Text
          if x# 0 then Warning 1 Text= "s" . Warning 1 Text . " are"           c
                   else Warning 1 Text= Warning 1 Text . " is"
          Warning 1 Text= "Warning: Diagnostic option" . Warning 1 Text          c
                                                       . " overridden by -O
    "
          Output (Warning 1 Text)
       finish {warning about inconsistent options}

       if control&code#0 then selectoutput(Stdout)
     finish

    if Compiler= Fortran Start
        bufad = malloc(bufsize+1)    { get buffer to read source into }
        InitialiseSource

        if monopt#0 start
          select output (Stdout)
          printstring("
    FORT77( Control  = ");  phex(control)
          printstring("
             options1 = ");  phex(options1)
          printstring("
             options2 = ");  phex(options2)
          printstring("
             F77parm  = ");  phex(F77parm)
          printstring("
             Optflags = ");  phex(optflags)
          printstring("
             Comopt3  = ");  write(Comopt3,1)
          printstring("
             recipopt = ");  write(recipopt,1)
          printstring("
             Opt2max  = ");  write(Opt2max,1)
          printstring("
             optcontrols = ");  phex(optcontrols)
          printstring("
             misalignedreals = ");  write(misalignedreals,1)
          printstring("
             Srcflags = ");  phex(Srcflags)
          printstring("
             Liststream = "); write(Liststream,1)
          printstring("
             Console = "); write(2,1)
          printstring("
             Diagstream = "); write(Diagstream,1)
          printstring("
             Diagnostic level = "); write(Diagnostic level,1)
          printstring("
             Dsize = "); write(Dsize,1)
          printstring("
             Tsize = "); write(Tsize,1)
          printstring("
             Bsize = "); write(Bsize,1)
          printstring("
             Lsize = "); write(Lsize,1)
          printstring("
             Asize = "); write(Asize,1)
          printstring("
             Nsize = "); write(Nsize,1)
          newline
          printstring("
              cgoptions = "); phex(cgoptions)
          newline
      finish;  !Note currently selected may be either STDOUT or STDERR at this point
    finish

        Cstring(object,adcstr)  { leave object filename in buffer for unlink }

    integerfn readn
    integer i,c
          i = 0
          cycle
             c = args(vptr+1)
             exit unless '0' <= c <= '9'
             i = (i*10) + (c-'0')
             vptr=vptr+1
          repeat
          result = i
    end {readn}

    integerfn readbv
    integer i,j,c
          i = 0
          j = readn
    err:  unless 0<=j<=31 thenstart
             printstring("invalid bit vector
    ")
             result = 0
          finish
          cycle
             i = i ! (1<<j)
             c = args(vptr+1)
             exit unless c = ':'
             vptr=vptr+1
             j = readn
             unless 0<=j<=31 then -> err
          repeat
          result = i
    end {readbv}

    routine readnn(integername val1,val2)
    integer i,c
          val1 = readn
          c = args(vptr+1)
          unless c = ':' thenstart
             printstring("invalid fragrange
    ")
             val2 = 0
             return
          finish
          vptr=vptr+1
          val2 = readn
    end {readnn}

    end; ! Prepare
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    externalroutine COMPILE alias "main" (integer argc, argv)

       routinespec print summary (integer i)
       string(1) s
       integer i
       !
       if Compiler= Fortran then recipopt = 0
       if Target=RS6000 start
          nohsflt=0   {user has not used -qnohsflt yet}
       finish
       if Host = M88000 then start
          integer DiagStopper

          DiagStopper = M'ZDIA'     { in case of compiler crash! }
       finish
       !
       if Host = M88000 then start
          disabletraps              { disable all 88k fpu traps        }
                                    { and set rounding mode to nearest }
       finish
       !
       if Target = M88000 then start
          cgoptions = cgschedule    { default is to enable instr scheduling }
       finish
       !
       if Host=MIPs start
          cgoptions = cgschedule     { Mips default is to schedule }
       finish
       Prepare( argc, argv)         { to keep stack size down }

      if Host=DRS and Usechipfns=Weitek thenstart
         if Env=Sequent then Set Weitek Flags
      finish

       if Compiler= IMP start
          IMPCOMPILER
          if comreg(24)=0 or comreg(27)=8 start { return code }
             FREE(workad)
             i= comreg(47)              {=> continue to generate the object file}
          finishelse i= -1             {=> terminate quickly with a failure    }
      finishelsestart
          i=FORT77(Control,options1,options2,F77parm,Optflags,Srcflags,0,Liststream,
                    Diagstream,diagnostic level,Dsize,Tsize,Bsize,Lsize,Asize,Nsize)

      finish
          select output (Stderr)
          print summary (i) if Compiler= Fortran or (i> 0 and comreg(40)# -1)

      if i>=0 start
         if syntaxcheck=0 thenstart
            select output (Stdout)
            if Emachine>= 4 then Pgenerateobject (s)                            c
                             else Mgenerateobject (s)
            select output (Stderr)
         finish
         if Protection=ALF start
            freeadilicense
         finish
         EXIT(0)
      finishelsestart
    !     i = UNLINK(AdCstr)
         if Protection=ALF start
            freeadilicense
         finish
         EXIT(1)
      finish

    if Compiler= Fortran thenstart

    routine print summary (integer i)
      string(31) s,t
      integer    n
                  n= i
                  n=-n if n< 0

       s= "
       ".itos (n)
      if i< 0 then t= " Error"    c
               else t= " Line"
                     s= s.t

      if i>1 or i<-1 then s= s . "s"

      if i>0 thenstart
          if syntaxcheck= 0 then t= " Compiled
    "                        else t= " Analyzed
    ";    finishelse t= "
    ";           s= s.t

        output (s)
    end; ! print summary
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !
    finish

    if Compiler= IMP thenstart

    routine print summary (integer i)
      string(63) s,t

       s= "
       ".itos (i)

      if i= 1 then t= " Statement"                                              c
               else t= " Statements"

       s= s.t

      if syntaxcheck= 0 then t= " Translated to C
    "                    else t= " Analyzed
    ";              s= s.t

        print string (s)
    end; ! print summary
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !
    finish

    end; ! COMPILE
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    if Compiler= Fortran thenstart

    externalroutine DeleteObjectFile
      integer i

      i = UNLINK(AdCstr)
    end; ! DeleteObjectFile
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !
    finish

    if Compiler= Fortran start
    !---------------------------------------------------------------------------
    !************************* SPACE CLAIMED HERE  *****************************
    !---------------------------------------------------------------------------

    !*
    externalroutine F77area(integer Index,Size,integername Address)
    conststring(9)array Id(0:6)=  c
          "T#DICT","T#NAMES","T#TRIADS","T#BLOCKS","T#TABS",
          "T#LOOPS","T#BUFFS"
    !integer I
    !       I=malloc(0);! to find current address
    !       %if I>0 %thenstart;! force alignment to 4K boundary
    !          %if I&X'FFF'#0 %thenstart
    !             I=malloc(I&X'FFFFF000'+X'1000'-I)
    !          %finish
    !       %finish
          Address=malloc(Size)
          if mmon#0 start
            printstring("
    Creating area ")
            printstring(Id(Index))
            printstring("  size = X")
            phex(Size)
          finish
          if Address>0 thenstart
            if mmon#0 start
              printstring(" address = X")
              phex(Address)
              newline
            finish
          finishelsestart
            printstring("Create area  response=")
            write(Address,1)
            newline
            stop
          finish
    end; ! F77area
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    !---------------------------------------------------------------------------
    !******************  SOURCE INPUT TO COMPILER  *****************************
    !---------------------------------------------------------------------------

    owninteger id                     { file descriptor of current source file }
    ownbyteintegerarray spacepat(0:71)=' '(72)
    owninteger adspaces
    owninteger next
    owninteger linestart
    owninteger left
    recordformat incfm(integer parent,next,left,bufad,id)
    ownrecord(incfm) name inc

          if Bytesreversed=YES thenstart
             constinteger EOF = X'00001901'
          finishelsestart
             constinteger EOF = X'01190000'
          finish

    routine InitialiseSource
      id = PrimarySrcid
      adspaces = addr(spacepat(0))
      linestart = bufad
      left=0
    {   left = READ(id,bufad,bufsize) }
    {   %if left = 0 %start           }   { end of file }
    {     printstring(" }
    { Source is Empty ") }
    {     exit(0) }
    {   %finish }
    {   %if left<bufsize %then byteinteger(bufad+left)=NL  %and left=left+1 }{ make sure all lines terminate }
      next = bufad
      inc == record(0)
    end; ! InitialiseSource
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    externalroutine Closeinc(integer Lwad)

    !  Force closure of an include file.
    !  Closeinc is called when an end line has been specified on the
    !  INCLUDE statement and this has been reached (Gould Fortran-77+)

       integer lbad,i,parent

       lbad=lwad
       integer(lbad) = EOF
       CLOSE(id)
       free(bufad)                { release buffer space }
       parent = addr(inc)
       if parent#0 start        { safety first - should always be true}
           next  = inc_next         { reset vars to parent file }
           left  = inc_left
           bufad = inc_bufad
           id    = inc_id
           i   = inc_parent
           free(parent)           { release include record space }
           inc == record(i)
       finish

    end {Closeinc}

    externalroutine SourceLine(integer Lwad,integername long)
      integer t,i,linesize,parent,top,lbad

      {------------------- Have we run out of data ? ---------------------------}

      lbad = lwad
      if left <= 0 start               { Buffer is empty }
        left = READ(id,bufad,bufsize)
        if left = 0 start             { end of file }
          integer(lbad) = EOF
          CLOSE(id)
          free(bufad)                { release buffer space }
          parent = addr(inc)
          if parent#0 start        { if it was an include file }
            next  = inc_next         { reset vars to parent file }
            left  = inc_left
            bufad = inc_bufad
            id    = inc_id
            i   = inc_parent
            free(parent)           { release include record space }
            inc == record(i)
          finish
          return
        finish
        if left = bufsize start     { Have not got endoffile in buffer }
          top = bufad+left-1           { backup to end of last complete line }
          cycle i = top,-1,bufad      { to avoid split lines }
            if byteinteger(i)=NL start
              left = left - (top-i)
              LSEEK(id,i-top,1)        { adjust file position back }
              exit
            finish                    { to reread incomplete line next time }
          repeat
        finish elsestart           { put an extra NL in case last line incomplete }
          if byteinteger(bufad+left-1)#NL then byteinteger(bufad+left) = NL andc
          left = left + 1
        finish
        next = bufad
      finish

      { ---------------  ch by ch through source ---------------------}

      linestart = next

      next = next + 1 while byteinteger(next) # NL

              {  OR }

    !   **NLch         { search for NL character }
    !   **next         { starting at byte address 'next' }
    !   **bufsize      { stop after 'bufsize characters - always a nl there }
    !   *PUT_x'FD9E'   { swne }
    !   *DISCARD       { get rid of true/false }
    !   **=next        { put address of NL in next }

      {--------------- set up LINE buffer -------------------}

      long = 0
      linesize = next - linestart
      left = left - (linesize + 1)
      if warnlinelen # 0 thenstart
         i = linesize
         if byteinteger(lbad+1) = 9 {tab} then i = i + 5
         if i > warnlinelen then long = warnlinelen
      finish
      linesize = 132 if linesize > 132
      next = next + 1                   { over NL }
      if byteinteger(next-2)=13{CR} then linesize=linesize-1    { Lose CR's }
      byteinteger(lbad) = linesize      { lbad(0) = length }
      t = lbad + 1
      **linestart; **t; **linesize; *MVB
    !   %cycle i=0,1,linesize-1
    !      byteinteger(t+i)=byteinteger(linestart+i)
    !   %repeat

      if linesize < 73 start          { insert trailing spaces }
        t = lbad + linesize + 1
        i = 72 - linesize
        **adspaces; **t; **i; *MVB
    !    %cycle i=0,1,71-linesize
    !      byteinteger(t+i)=32
    !    %repeat
      finish
    end; ! SourceLine
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    externalroutinespec putincname(string(*)name s,
                                    integer j)

    externalintegerfn select include(string(255) Incname)
      ownbyteintegerarray cstr(0:255)
      ownstring(13) usr include text= "/usr/include/"
      ownstring(7) INCLUDE text= "include"
      integer i,parent,parentid,slen, cstr adr
      string(255) s

      string(255) Searchpaths1 {writable copy of IncludeDir}
      stringname  Searchpaths2 {mapped onto the next path in Searchpaths1}

      parentid = id
      cstr adr = addr(cstr(0))

      { If there is no '/' in the Include file name then look for it in }
      { the directory containing the source , not the current directory }

      if charno(Incname,1)= '/' then s= Incname                                c
                                 else s= IncludeDir . Incname
      putincname(s,1)
      Cstring(s,cstr adr)
      ID = Open(cstr adr,READING)
      if ID = -1 start
         if charno(Incname,1) = '/' then -> cant open

      { If the Include file name wasnt found, try the directories specified}
      { by the -I option (if any) so long as the Include file name does not}
      { start with a '/'                                                   }

         if Includepath # "" thenstart
            Searchpaths1 = Includepath
            Searchpaths2== Searchpaths1

            cycle {through all the pathnames specified by -I}
               slen= length(Searchpaths2)

               cycle i= 1,1,slen                      {locate terminating '+'}
                  exit if charno(Searchpaths2,i)= '+'
               repeat
               length(Searchpaths2)= i - 1
               s= Searchpaths2                         {= searchpath for Incname}

               Searchpaths2== string (addr(Searchpaths2) + i)
               length(Searchpaths2)= slen - i          {discard current searchpath}
                                                       {    from the list         }
               s = s."/".Incname
               Cstring(s,cstr adr)
               ID = Open(cstr adr,READING)
               if ID >= 0 then -> Include Opened
               if Searchpaths2= "" thenexit
            repeat
         finish

      { If no success from the -I<dir> option, try the current working directory}

         Cstring(Incname, cstr adr)
         ID = Open(cstr adr,READING)
         if ID >= 0 then -> Include Opened

      { If no success from the current working directory, try /usr/include}

         s = usr include text . Incname
         Cstring(s,cstr adr)
         ID = Open(cstr adr,READING)
         if ID = -1 then -> cant open

      finish

    Include Opened:
      parent = addr(inc)
      i = malloc( 32 {size of inc})
      inc == record(i)
      inc_bufad  = bufad
      inc_parent = parent
      inc_id     = parentid
      inc_next   = next
      inc_left   = left
      bufad = malloc(bufsize+1)    { get buffer to read source into }
      left = 0                     { trigger READ on next source line request }
      if comreg(26)&4#0 {sdb/dbx} thenstart
         if Emachine>= 4 then Psetfiles(s,INCLUDE text,0) { for DBX }          c
                          else Msetfiles(s,INCLUDE text,0) { for DBX }
      finish
      result = 0

    cant open: ID = parentid
               result = 1
    end; ! Select Include
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    externalintegerfn Checknus(stringname s)
    integer I,J,C,ad,len
    ownbyteintegerarray A(0:31)
    !*
          if options2&nus=0 then result=0 {no nus option}
          if options2&nusfile=0 then result=1 {no underscores}
          ad=optfiles_nusaddr
          len=optfiles_nuslen
          J=0
          cycle I=0,1,Len-1
             C=byteinteger(Ad+I)
    {printstring("Char:");write(C,1);newline}
             if C<=' ' or C=',' thenstart  {valid separators?}
                if J>0 thenstart
                   A(0)=J
                   if s=string(addr(A(0))) then result=1
                   J=0
                finish
             finishelsestart
                if 'A'<=C<='Z' then C=C-'A'+'a'
                if J<31 thenstart
                   J=J+1
                   A(J)=C
                finish
             finish
          repeat
          A(0)=J
          if s=string(addr(A(0))) then result=1
          result=0
    end; ! Checknus
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !
    finish

    if Target=M88000 start

        externalintegerfn Nusoption
             if options2&nus=0 then result=0
             result=1
        end; ! Nusoption

    finish
    !
    ! Copyright (c) 1991 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !

    if Compiler= Fortran thenstart

    externalroutine x alias "pow_ri"
    end
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !
    finish

    endoffile
    !
    ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd.  All Rights Reserved.
    !