home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / COMPILER / OPTIONS.SA < prev    next >
Text File  |  1995-02-13  |  23KB  |  718 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. class OPTIONS is
  9.  
  10.     attr sather_files:FSET{STR};     -- Sather source files
  11.     private attr paths:FSET{STR};    
  12.     -- Resolved Sather source paths (to allow redundancy in on command line)
  13.     attr c_files:FSET{STR};          -- C source files
  14.     attr object_files:FSET{STR};     -- object files
  15.     attr archive_files:FLIST{STR};    -- `library' archive files
  16.  
  17.     attr main_class:STR;             -- The class with main
  18.     attr executable:STR;             -- The executable to output, or void
  19.     attr home:STR;             -- home
  20.     attr gen_c:BOOL;                 -- If true, generate C files
  21.     attr pretty:BOOL;             -- Make generated C look nice
  22.     attr verbose:BOOL;                 -- Be noisy
  23.     attr psather:BOOL;             -- Accept pSather code
  24.     attr only_parse:BOOL;         -- Stop after parsing
  25.     attr only_check:BOOL;         -- Don't do code generation
  26.     attr only_C:BOOL;             -- Stop after making C
  27.     attr only_reachable:BOOL;         -- Don't check unreachable code
  28.  
  29.     attr optimize:BOOL;              -- Attempt optimizations
  30.     attr debug:BOOL;                 -- Generate debugging information
  31.     attr deterministic:BOOL;         -- generate id determinism
  32.  
  33.     -- because we don't know the class names at the time
  34.     -- that the command line is parsed, there is a special
  35.     -- representation for sets of classes with given checking
  36.     -- on or off.  *.union(chk_in).difference(chk_out), where
  37.     -- chk is the check name and * is all classes if chk_all
  38.     -- is true or the empty set if chk_all is false.
  39.  
  40.     attr pre_all, post_all, invariant_all, assert_all, arith_all,
  41.      bounds_all, void_all, when_all, destroy_all, return_all:BOOL;
  42.  
  43.     attr pre_in, post_in, invariant_in, assert_in,
  44.      arith_in, bounds_in, void_in, when_in,
  45.      destroy_in, return_in:FSET{STR};
  46.  
  47.     attr pre_out, post_out, invariant_out, assert_out,
  48.      arith_out, bounds_out, void_out, when_out,
  49.      destroy_out, return_out:FSET{STR};
  50.  
  51.     attr force_routines:FSET{STR};   -- Routines to be generated no matter what
  52.     attr force_all:BOOL;         -- Force all generation
  53.     attr c_flags:FLIST{STR};         -- Flags to pass to C compiler
  54.     attr externals:FMAP{STR,FSET{STR}}; -- Files linked if class reachable
  55.     attr has:FMAP{STR,STR};          -- Files containing classes given by -has
  56.     attr known_files:FSET{STR};      -- Files that we know all classes by -has
  57.  
  58.     attr c_compile1, c_compile2, c_opt, c_debug, c_verbose, c_exec:STR;
  59.     attr make_command, make_silent:STR;
  60.     attr null_segfaults:BOOL;
  61.     -- Options garnered from CONFIG file
  62.  
  63.     create:SAME is 
  64.     r::=new;
  65.     r.bounds_all:=true;
  66.     r.void_all:=true;
  67.     r.when_all:=true;
  68.     r.return_all:=true;
  69.     r.main_class:="MAIN";
  70.      -- r.executable:="a.out";                                                  -- NLP
  71.     return r;
  72.     end;
  73.  
  74.     pre_chk(n:STR):BOOL is 
  75.     return (pre_all or pre_in.test(n)) and ~pre_out.test(n);
  76.     end;
  77.  
  78.     post_chk(n:STR):BOOL is 
  79.     return (post_all or post_in.test(n)) and ~post_out.test(n);
  80.     end;
  81.  
  82.     invariant_chk(n:STR):BOOL is 
  83.     return (invariant_all or invariant_in.test(n)) and ~invariant_out.test(n);
  84.     end;
  85.  
  86.     assert_chk(n:STR):BOOL is 
  87.     return (assert_all or assert_in.test(n)) and ~assert_out.test(n);
  88.     end;
  89.  
  90.     arith_chk(n:STR):BOOL is 
  91.     return (arith_all or arith_in.test(n)) and ~arith_out.test(n);
  92.     end;
  93.  
  94.     bounds_chk(n:STR):BOOL is 
  95.     return (bounds_all or bounds_in.test(n)) and ~bounds_out.test(n);
  96.     end;
  97.  
  98.     void_chk(n:STR):BOOL is 
  99.     return (void_all or void_in.test(n)) and ~void_out.test(n);
  100.     end;
  101.  
  102.     when_chk(n:STR):BOOL is 
  103.     return (when_all or when_in.test(n)) and ~when_out.test(n);
  104.     end;
  105.  
  106.     destroy_chk(n:STR):BOOL is 
  107.     return (destroy_all or destroy_in.test(n)) and ~destroy_out.test(n);
  108.     end;
  109.  
  110.     return_chk(n:STR):BOOL is 
  111.     return (return_all or return_in.test(n)) and ~return_out.test(n);
  112.     end;
  113.  
  114.     private mention(name,s1,s2:STR):STR is
  115.     if s2/="" then return s1+'\n'+name+": "+s2;
  116. --      else return s1;                                                         -- NLP
  117.         end; return s1;                                                         -- NLP
  118. --      end;                                                                    -- NLP
  119.     end;
  120.  
  121.     str:STR is
  122.     -- diagnostic for printing the state of a command line parse
  123.     r,s:STR;
  124.     r:=""; loop r:=r+' '+sather_files.elt!; end;
  125.     s:=mention("Sather files","",r);
  126.     r:=""; loop r:=r+' '+c_files.elt!; end;
  127.     s:=mention("C files",s,r);
  128.     r:=""; loop r:=r+' '+object_files.elt!; end;
  129.     s:=mention("object files",s,r);
  130.     r:=""; loop r:=r+' '+archive_files.elt!; end;
  131.         s:=mention("archive files",s,r);
  132.  
  133.     s:=mention("Main class",s,main_class);
  134.     s:=mention("Executable",s,executable);
  135.         
  136.     s:=s+"\nHome directory: "+home;
  137.  
  138.     if gen_c then s:=s+"\nGenerate C."; end;
  139.     if pretty then s:=s+"\nPretty C."; end;
  140.     if verbose then s:=s+"\nVerbose."; end;
  141.     if optimize then s:=s+"\nOptimize."; end;
  142.     if debug then s:=s+"\nGenerate debugging info."; end;
  143.     if psather then s:=s+"\nAccept pSather code."; end;
  144.     if deterministic then s:=s+"\nGenerate deterministic ob ids."; end;
  145.     if only_parse then s:=s+"\nStop after parsing."; end;
  146.     if only_check then s:=s+"\nDon't generate code."; end;
  147.     if only_C then s:=s+"\nDon't compile C."; end;
  148.     if only_reachable then s:=s+"\nDon't check unreachable code."; end;
  149.  
  150.     r:="";
  151.     if pre_all then r:=r+"All";
  152.     else loop r:=r+'+'+pre_in.elt!; end;
  153.     end;
  154.     loop r:=r+'-'+pre_out.elt!; end;
  155.     s:=mention("Preconditions",s,r);
  156.  
  157.     r:="";
  158.     if post_all then r:=r+"All";
  159.     else loop r:=r+'+'+post_in.elt!; end;
  160.     end;
  161.     loop r:=r+'-'+post_out.elt!; end;
  162.     s:=mention("Postconditions",s,r);
  163.  
  164.     r:="";
  165.     if invariant_all then r:=r+"All";
  166.     else loop r:=r+'+'+invariant_in.elt!; end;
  167.     end;
  168.     loop r:=r+'-'+invariant_out.elt!; end;
  169.     s:=mention("Invariants",s,r);
  170.  
  171.     r:="";
  172.     if assert_all then r:=r+"All";
  173.     else loop r:=r+'+'+assert_in.elt!; end;
  174.     end;
  175.     loop r:=r+'-'+assert_out.elt!; end;
  176.     s:=mention("Asserts",s,r);
  177.  
  178.     r:="";
  179.     if void_all then r:=r+"All";
  180.     else loop r:=r+'+'+void_in.elt!; end;
  181.     end;
  182.     loop r:=r+'-'+void_out.elt!; end;
  183.     s:=mention("Void checks",s,r);
  184.  
  185.     r:="";
  186.     if when_all then r:=r+"All";
  187.     else loop r:=r+'+'+when_in.elt!; end;
  188.     end;
  189.     loop r:=r+'-'+when_out.elt!; end;
  190.     s:=mention("When clause",s,r);
  191.  
  192.     r:="";
  193.     if bounds_all then r:=r+"All";
  194.     else loop r:=r+'+'+bounds_in.elt!; end;
  195.     end;
  196.     loop r:=r+'-'+bounds_out.elt!; end;
  197.     s:=mention("Bounds",s,r);
  198.  
  199.     r:="";
  200.     if destroy_all then r:=r+"All";
  201.     else loop r:=r+'+'+destroy_in.elt!; end;
  202.     end;
  203.     loop r:=r+'-'+destroy_out.elt!; end;
  204.     s:=mention("Destroy",s,r);
  205.  
  206.     r:="";
  207.     if arith_all then r:=r+"All";
  208.     else loop r:=r+'+'+arith_in.elt!; end;
  209.     end;
  210.     loop r:=r+'-'+arith_out.elt!; end;
  211.     s:=mention("Arith",s,r);
  212.  
  213.     r:="";
  214.     if return_all then r:=r+"All";
  215.     else loop r:=r+'+'+return_in.elt!; end;
  216.     end;
  217.     loop r:=r+'-'+return_out.elt!; end;
  218.     s:=mention("Return",s,r);
  219.  
  220.         r:="";
  221.     if force_all then r:=r+"All";
  222.     elsif ~force_routines.is_empty then
  223.         loop r:=r+' '+force_routines.elt!; end;
  224.     end;
  225.     s:=mention("Forced routines",s,r);
  226.  
  227.         r:="";
  228.         if ~c_flags.is_empty then loop r:=r+' '+c_flags.elt!; end; end;
  229.     s:=mention("C flags",s,r);
  230.  
  231.     if ~externals.is_empty then
  232.         s:=s+"\nExternals:";
  233.         loop p::=externals.pairs!;
  234.         s:=s+"\n   "+p.t1+" -> {";
  235.         loop r:=r+",".separate!(p.t2.elt!); end;
  236.         s:=s+"}\n";
  237.         end;
  238.     end;
  239.  
  240.     if ~has.is_empty then
  241.         s:=s+"\nHas:";
  242.         loop p::=has.pairs!; s:=s+"\n   "+p.t1+" in "+p.t2; end;
  243.         s:=s+"\n";
  244.     end;
  245.  
  246.         return s;
  247.     end;
  248.  
  249.     private attr args:ARRAY{STR};
  250.     private attr next:INT;
  251.  
  252.     private attr classes:FSET{STR};
  253.     private attr all:BOOL;
  254.  
  255.     interpret(a:ARRAY{STR}) is
  256.     -- interpret command lines.
  257.  
  258.         args:=a;
  259.     next:=1;
  260.  
  261.     get_files;
  262.     insert_here(args_from_env);
  263.     loop while!(more_args);
  264.         s::=next_arg;
  265.         case s
  266.         when "-main" then main_class:=next_arg;
  267.         when "-o" then executable:=next_arg;
  268.         when "-home" then home:=next_arg;
  269.         when "-output_C" then gen_c:=true;
  270.         when "-pretty" then pretty:=true;
  271.         when "-verbose" then verbose:=true;
  272.         when "-psather" then psather:=true;
  273.         when "-only_parse" then only_parse:=true;
  274.         when "-only_check" then only_check:=true;
  275.         when "-only_C" then only_C:=true; gen_c:=true;
  276.         when "-only_reachable" then only_reachable:=true;
  277.  
  278.         when "-check" then
  279.             get_classes;
  280.             if all then
  281.             arith_all:=true; arith_out:=#;
  282.             bounds_all:=true; bounds_out:=#;
  283.             void_all:=true; void_out:=#;
  284.             pre_all:=true; pre_out:=#;
  285.             post_all:=true; post_out:=#;
  286.             assert_all:=true; assert_out:=#;
  287.             invariant_all:=true; invariant_out:=#;
  288.             when_all:=true; when_out:=#;
  289.             destroy_all:=true; destroy_out:=#;
  290.             return_all:=true; return_out:=#;
  291.             else
  292.             arith_in:=arith_in.union(classes);
  293.             bounds_in:=bounds_in.union(classes);
  294.             void_in:=void_in.union(classes);
  295.             pre_in:=pre_in.union(classes);
  296.             post_in:=post_in.union(classes);
  297.             assert_in:=assert_in.union(classes);
  298.             invariant_in:=invariant_in.union(classes);
  299.             when_in:=when_in.union(classes);
  300.             destroy_in:=destroy_in.union(classes);
  301.             return_in:=return_in.union(classes);
  302.  
  303.             arith_out:=arith_out.difference(classes);
  304.             bounds_out:=bounds_out.difference(classes);
  305.             void_out:=void_out.difference(classes);
  306.             pre_out:=pre_out.difference(classes);
  307.             post_out:=post_out.difference(classes);
  308.             assert_out:=assert_out.difference(classes);
  309.             invariant_out:=invariant_out.difference(classes);
  310.             when_out:=when_out.difference(classes);
  311.             destroy_out:=destroy_out.difference(classes);
  312.             return_out:=return_out.difference(classes);
  313.             end;
  314.         when "-arith" then
  315.             get_classes;
  316.             if all then arith_all:=true; arith_out:=#;
  317.             else
  318.             arith_in:=arith_in.union(classes);
  319.             arith_out:=arith_out.difference(classes);
  320.             end;
  321.         when "-bounds" then
  322.             get_classes;
  323.             if all then bounds_all:=true; bounds_out:=#; 
  324.             else
  325.             bounds_in:=bounds_in.union(classes);
  326.             bounds_out:=bounds_out.difference(classes);
  327.             end;
  328.         when "-void" then
  329.             get_classes;
  330.             if all then void_all:=true; void_out:=#; 
  331.             else
  332.             void_in:=void_in.union(classes);
  333.             void_out:=void_out.difference(classes);
  334.             end;
  335.         when "-pre" then
  336.             get_classes;
  337.             if all then pre_all:=true; pre_out:=#; 
  338.             else
  339.             pre_in:=pre_in.union(classes);
  340.             pre_out:=pre_out.difference(classes);
  341.             end;
  342.         when "-post" then
  343.             get_classes;
  344.             if all then post_all:=true; post_out:=#; 
  345.             else
  346.             post_in:=post_in.union(classes);
  347.             post_out:=post_out.difference(classes);
  348.             end;
  349.         when "-assert" then
  350.             get_classes;
  351.             if all then assert_all:=true; assert_out:=#; 
  352.             else
  353.             assert_in:=assert_in.union(classes);
  354.             assert_out:=assert_out.difference(classes);
  355.             end;
  356.         when "-invariant" then
  357.             get_classes;
  358.             if all then invariant_all:=true; invariant_out:=#; 
  359.             else
  360.             invariant_in:=invariant_in.union(classes);
  361.             invariant_out:=invariant_out.difference(classes);
  362.             end;
  363.         when "-when" then
  364.             get_classes;
  365.             if all then when_all:=true; when_out:=#; 
  366.             else
  367.             when_in:=when_in.union(classes);
  368.             when_out:=when_out.difference(classes);
  369.             end;
  370.         when "-destroy" then
  371.             get_classes;
  372.             if all then destroy_all:=true; destroy_out:=#; 
  373.             else
  374.             destroy_in:=destroy_in.union(classes);
  375.             destroy_out:=destroy_out.difference(classes);
  376.             end;
  377.         when "-return" then
  378.             get_classes;
  379.             if all then return_all:=true; return_out:=#; 
  380.             else
  381.             return_in:=return_in.union(classes);
  382.             return_out:=return_out.difference(classes);
  383.             end;
  384.         when "-when" then
  385.             get_classes;
  386.             if all then when_all:=true; when_out:=#; 
  387.             else
  388.             when_in:=when_in.union(classes);
  389.             when_out:=when_out.difference(classes);
  390.             end;
  391.  
  392.         when "-no_check" then
  393.             get_classes;
  394.             if all then
  395.             arith_in:=#; arith_all:=false;
  396.             bounds_in:=#; bounds_all:=false;
  397.             void_in:=#; void_all:=false;
  398.             pre_in:=#; pre_all:=false;
  399.             post_in:=#; post_all:=false;
  400.             assert_in:=#; assert_all:=false;
  401.             invariant_in:=#; invariant_all:=false;
  402.             when_in:=#; when_all:=false;
  403.             destroy_in:=#; destroy_all:=false;
  404.             return_in:=#; return_all:=false;
  405.             else
  406.             arith_out:=arith_out.union(classes);
  407.             bounds_out:=bounds_out.union(classes);
  408.             void_out:=void_out.union(classes);
  409.             pre_out:=pre_out.union(classes);
  410.             post_out:=post_out.union(classes);
  411.             assert_out:=assert_out.union(classes);
  412.             invariant_out:=invariant_out.union(classes);
  413.             when_out:=when_out.union(classes);
  414.             destroy_out:=destroy_out.union(classes);
  415.             return_out:=return_out.union(classes);
  416.             end;
  417.         when "-no_arith" then
  418.             get_classes;
  419.             if all then arith_in:=#; arith_all:=false; 
  420.                     else arith_out:=arith_out.union(classes);
  421.             end;
  422.         when "-no_bounds" then
  423.             get_classes;
  424.             if all then bounds_in:=#; bounds_all:=false; 
  425.                     else bounds_out:=bounds_out.union(classes);
  426.             end;
  427.         when "-no_void" then
  428.             get_classes;
  429.             if all then void_in:=#; void_all:=false; 
  430.                     else void_out:=void_out.union(classes);
  431.             end;
  432.         when "-no_pre" then
  433.             get_classes;
  434.             if all then pre_in:=#; pre_all:=false; 
  435.                     else pre_out:=pre_out.union(classes);
  436.             end;
  437.         when "-no_post" then
  438.             get_classes;
  439.             if all then post_in:=#; post_all:=false; 
  440.                     else post_out:=post_out.union(classes);
  441.             end;
  442.         when "-no_assert" then
  443.             get_classes;
  444.             if all then assert_in:=#; assert_all:=false; 
  445.                     else assert_out:=assert_out.union(classes);
  446.             end;
  447.         when "-no_invariant" then
  448.             get_classes;
  449.             if all then invariant_in:=#; invariant_all:=false; 
  450.                     else invariant_out:=invariant_out.union(classes);
  451.             end;
  452.         when "-no_destroy" then
  453.             get_classes;
  454.             if all then destroy_in:=#; destroy_all:=false; 
  455.                     else destroy_out:=destroy_out.union(classes);
  456.             end;
  457.         when "-no_return" then
  458.             get_classes;
  459.             if all then return_in:=#; return_all:=false; 
  460.                     else return_out:=return_out.union(classes);
  461.             end;
  462.         when "-no_when" then
  463.             get_classes;
  464.             if all then when_in:=#; when_all:=false; 
  465.                     else when_out:=when_out.union(classes);
  466.             end;
  467.  
  468.         when "-optimize", "-O" then optimize:=true;
  469.         when "-fast" then
  470.             optimize:=true;
  471.             arith_in:=#; arith_all:=false;
  472.             bounds_in:=#; bounds_all:=false;
  473.             void_in:=#; void_all:=false;
  474.             pre_in:=#; pre_all:=false;
  475.             post_in:=#; post_all:=false;
  476.             assert_in:=#; assert_all:=false;
  477.             invariant_in:=#; invariant_all:=false;
  478.             when_in:=#; when_all:=false;
  479.             destroy_in:=#; destroy_all:=false;
  480.             return_in:=#; return_all:=false;
  481.         when "-debug", "-g" then debug:=true; gen_c:=true;
  482.                 when "-deterministic" then deterministic:=true;
  483.         when "-force" then force_routines:=force_routines.insert(next_arg);
  484.         when "-force_all" then force_all:=true;
  485.         when "-C_flag" then c_flags:=c_flags.push(next_arg);
  486.         when "-external" then externals:=externals.insert(next_arg,files);
  487.         when "-has" then
  488.             fn::=next_arg;
  489.             known_files:=known_files.insert(fn);
  490.             get_classes;
  491.             loop has:=has.insert(classes.elt!,fn); end;
  492.         when "-com" then insert_here(args_from_file(next_arg));
  493.         else if is_filename(s) then rewind; get_files;
  494.             else rewind; usage; return;
  495.             end;
  496.         end;
  497.     end;
  498.     if void(home) then
  499.         barf("No home directory specified.  Use -home <dir> or make sure SATHER_COMMANDS is set correctly.");
  500.     end;
  501.         if void(executable) then                                                                 -- NLP
  502.             barf("No executable specified.  Use -o <name> -- the compiler will append '.exe'."); -- NLP
  503.         end;                                                                                     -- NLP
  504.     l::=#BE_LEX(home+"/System/CONFIG");
  505.     if void(l) then barf("Could not open CONFIG file.\n"); end;
  506.     c_compile1:=l.get_str;
  507.     if void(c_compile1) then barf("Could not read CONFIG:c1."); end;
  508.     t::=l.get_str;
  509.     if void(t) then barf("Could not read CONFIG:c2."); end;
  510.     c_compile2:="";
  511.     loop c::=t.elt!;
  512.             if c='\\' then c:='/'; end;                                         -- NLP
  513.         if c/='#' then c_compile2:=c_compile2+c;
  514.         elsif home=".." then -- for the bootstrap
  515.         c_compile2:=c_compile2+"../..";
  516.         else
  517.         c_compile2:=c_compile2+home;
  518.         end;
  519.     end;
  520.     c_opt:=l.get_str;
  521.     if void(c_opt) then barf("Could not read CONFIG:c_opt."); end;
  522.     c_debug:=l.get_str;
  523.     if void(c_debug) then barf("Could not read CONFIG:c_dbg."); end;
  524.     c_verbose:=l.get_str;
  525.     if void(c_verbose) then barf("Could not read CONFIG:vbs."); end;
  526.     make_command:=l.get_str;
  527.     if void(make_command) then barf("Could not read CONFIG:make_com."); end;
  528.     make_silent:=l.get_str;
  529.     if void(make_silent) then barf("Could not read CONFIG:mk_silent."); end;
  530.     c_exec:=l.get_str;
  531.     if void(c_exec) then barf("Could not read CONFIG:exec."); end;
  532.     t:=l.get_str;
  533.     if void(t) then barf("Could not read CONFIG:null_segf."); end;
  534.     null_segfaults:=BOOL::from_str(t);
  535.     end;
  536.  
  537.     private barf(msg:STR) is
  538.     #ERR + msg + '\n';
  539.     UNIX::exit(1);
  540.     end;
  541.  
  542.     private more_args:BOOL is return next<args.size end;
  543.  
  544.     private next_arg:STR is
  545.     if more_args then res::=args[next]; next:=next+1; return res;
  546. --      else usage; return "";                                                  -- NLP
  547.         end; usage; return "";                                                  -- NLP
  548. --      end;                                                                    -- NLP
  549.     end;
  550.  
  551.     rewind is next:=next-1; end;
  552.  
  553.     private get_classes is
  554.     -- get a list of classes from the argument list
  555.     classes:=#;
  556.     loop while!(more_args);
  557.         arg::=next_arg;
  558.         all:=arg="all";
  559.         if all then return;
  560.         elsif is_class_name(arg) then classes:=classes.insert(arg);
  561.         else rewind; return;
  562.         end;
  563.     end;
  564.     end;
  565.  
  566.     private is_class_name(nm:STR):BOOL is
  567.     -- is this string a viable class name?
  568.     if nm[0]/='$' and ~nm[0].is_upper then return false; end;
  569.     loop c::=nm.elt!(1);
  570.         case c
  571.         when 'A','B','C','D','E','F','G','H','I','J',
  572.              'K','L','M','N','O','P','Q','R','S','T',
  573.              'U','V','W','X','Y','Z','0','1','2','3',
  574.              '4','5','6','7','8','9','_' then
  575.         else return false;
  576.         end;
  577.     end;
  578.     return true;
  579.     end;
  580.  
  581.     private files:FSET{STR} is
  582.     -- get a list of files from the command line
  583.     r::=#FSET{STR};
  584.     loop while!(more_args);
  585.         arg::=next_arg;
  586.         if is_filename(arg) then r:=r.insert(arg);
  587.         else rewind; return r;
  588.         end;
  589.     end;
  590.     return r;
  591.     end;
  592.  
  593.     private get_files is
  594.     -- get list of files from the command line and put in appropriate set
  595.     loop while!(more_args);
  596.         arg::=next_arg;
  597.         suf::=suffix(arg);
  598.         if suf=".c" then c_files:=c_files.insert(arg);
  599.         --  elsif suf=".o" then object_files:=object_files.insert(arg);         -- NLP
  600.             elsif suf=".obj" then object_files:=object_files.insert(arg);       -- NLP
  601.         elsif suf=".sa" then
  602.         -- make sure isn't found by a different name already
  603.         path::=FILE::resolve_path(arg);
  604.         if ~paths.test(path) then
  605.             sather_files:=sather_files.insert(arg);
  606.             paths:=paths.insert(path);
  607.         end;
  608.         --  elsif suf=".a" then archive_files:=archive_files.push(arg);         -- NLP
  609.             elsif suf=".lib" then archive_files:=archive_files.push(arg);       -- NLP
  610.         else rewind; return;
  611.         end;
  612.     end;
  613.     end;
  614.  
  615.     private usage is
  616.     #ERR + "Command line error near: " + args[next.min(args.size-1)] + '\n';
  617.     #ERR + "(See man page.)\n";
  618.     UNIX::exit(1);
  619.     end;
  620.  
  621.     private suffix(a:STR):STR is
  622.     pos:INT;
  623.     loop pos:=(a.length-1).downto!(0); until!(a[pos]='.'); end;
  624.     return a.tail(a.length-pos);
  625.     end;
  626.  
  627.     private is_filename(fn:STR):BOOL is
  628.     if fn[0]='-' then return false; end;
  629.     case suffix(fn)
  630.      --     when ".c", ".sa", ".o", ".a" then return true;                      -- NLP
  631.             when ".c", ".sa", ".obj", ".lib" then return true;                  -- NLP
  632. --          else return false;                                                  -- NLP
  633.             else; end; return false;                                            -- NLP
  634. --      end;                                                                    -- NLP
  635.     end;
  636.  
  637.     private insert_here(cl:FLIST{STR}) is
  638.     -- insert a list of args so it will be read next
  639.     tail:ARRAY{STR};
  640.     if more_args then tail:=args.subarr(next,args.size-next);
  641.     else tail:=#(0);
  642.     end;
  643.     args:=cl.array.append(tail);
  644.     next:=0;
  645.     end;
  646.  
  647.  -- private args_from_file(name:STR):FLIST{STR} is                              -- NLP
  648.     private args_from_file(fname:STR):FLIST{STR} is                             -- NLP
  649.         name::=fname.replace('\\','/');                                         -- NLP
  650.         wd::=directory(name);
  651.     cl::=#FLIST{STR};
  652.     f::=FILE::open_for_read(name);
  653.     if f.error then #ERR + "Couldn't open file: " + name + '\n'; usage; end;
  654.     fs::=f.fstr+' ';
  655.     f.close;
  656.     tok::="";
  657.     pos::=0;
  658.         loop
  659.         until!(pos>=fs.size);
  660.         c::=fs[pos];
  661.             if c='\\' then c:='/'; end;                                         -- NLP
  662.         if c='-' then
  663.         if fs[pos+1]='-' then
  664.             loop
  665.              pos:=pos+1;
  666.              until!(pos>=fs.size or fs[pos]='\n' or fs[pos]='\r');
  667.             end;
  668.         else tok:=tok+'-';
  669.         end;
  670.         elsif ~c.is_space then tok:=tok+c;
  671.         elsif tok/="" then
  672.                 if is_filename(tok) and tok[0]/='/' then tok:=wd+'/'+tok; end;
  673.         cl:=cl.push(tok);
  674.         tok:="";
  675.         end;
  676.         pos:=pos+1;
  677.     end;
  678.     return cl;
  679.     end;
  680.  
  681.     private directory(nm:STR):STR is
  682.     -- The directory in which nm resides
  683.     pos:INT;
  684.         loop pos:=(nm.size-1).downto!(0); if nm[pos]='/' then break!; end; end;
  685.     r::=nm.head(pos);
  686.     if r="" then r:="."; end;
  687.     return r;
  688.     end;
  689.  
  690.     private args_from_env:FLIST{STR} is
  691.     cl::=#FLIST{STR};
  692.     sc::=UNIX::get_env("SATHER_COMMANDS");
  693.     if void(sc) then sc:=""; end;
  694.     tok::="";
  695.     loop c::=sc.elt!;
  696.            if c = '\\' then c := '/'; end;                                      -- NLP
  697.        if ~c.is_space then tok:=tok+c;
  698.        elsif tok/="" then cl:=cl.push(tok); tok:="";
  699.        end;
  700.     end;
  701.     if tok/="" then cl:=cl.push(tok); end;
  702.     return cl;
  703.     end;
  704.  
  705. end;
  706.  
  707. -----------------------------------------------------------------
  708. class OPTIONS_TEST is
  709.  
  710.     main(a:ARRAY{STR}) is
  711.  
  712.         op::=#OPTIONS;
  713.     op.interpret(a);
  714.     #OUT + op.str + '\n';
  715.     
  716.     end;
  717. end;
  718.