%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 Malloc%alias "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 ! NoTrace%c
                                %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.
!
