home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / oc / oc.mod < prev    next >
Encoding:
Text File  |  1994-08-20  |  8.7 KB  |  323 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: OC.mod $
  4.   Description: Main entry point for Oberon-A compiler.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 4.9 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/14 10:36:42 $
  10.  
  11.   Copyright © 1993-1994, Frank Copeland
  12.   This module forms part of the OC program
  13.   See OC.doc for conditions of use and distribution
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. ***************************************************************************)
  18.  
  19. MODULE OC;
  20.  
  21. (*
  22. ** $C= CaseChk       $I= IndexChk  $L= LongAdr   $N= NilChk
  23. ** $P- PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  24. ** $V= OvflChk       $Z= ZeroVars
  25. *)
  26.  
  27. IMPORT
  28.   OCRev, Errors, E := Exec, Ti := Timer, TU := TimerUtil, U := Utility,
  29.   Dos, DU := DosUtil, Args, IU := IntuiUtil, Files, IO := StdIO,
  30.   Str := Strings, OCG, OCS, OCT, OCC, OCE, Compiler, SYS := SYSTEM;
  31.  
  32. CONST
  33.   CopyrightStr = "Copyright © 1993-94 Frank Copeland\n";
  34.   UsageStr = "See OC.doc for conditions of use\n";
  35.  
  36. VAR
  37.   file, batchFile : Files.File;
  38.   r : Files.Rider;
  39.   TimerBase : Ti.TimerBasePtr;
  40.   tr : Ti.TimeRequestPtr;
  41.   returnError : BOOLEAN;
  42.  
  43.  
  44. (*------------------------------------*)
  45. PROCEDURE* Cleanup ();
  46.  
  47. BEGIN (* Cleanup *)
  48.   IF file # NIL THEN Files.Close (file); file := NIL END;
  49.   IF batchFile # NIL THEN Files.Close (batchFile); batchFile := NIL END;
  50.   IF TimerBase # NIL THEN E.base.CloseDevice (tr); TimerBase := NIL END;
  51. END Cleanup;
  52.  
  53. (*------------------------------------*)
  54. PROCEDURE Init ();
  55.  
  56. BEGIN (* Init *)
  57.   file := NIL; TimerBase := NIL; returnError := FALSE; NEW (tr);
  58.   Errors.Assert
  59.     ( E.base.OpenDevice (Ti.name, Ti.unitVBlank, tr, {}) = 0,
  60.       "OC -- failed to open timer.device" );
  61.   TimerBase := SYS.VAL (Ti.TimerBasePtr, tr.device);
  62.  
  63.   SYS.SETCLEANUP (Cleanup);
  64. END Init;
  65.  
  66.  
  67. (*------------------------------------*)
  68. PROCEDURE Main ();
  69.  
  70.   VAR newsymfile : BOOLEAN;
  71.  
  72.   (*------------------------------------*)
  73.   PROCEDURE ReportTime (VAR t1, t2 : Ti.TimeVal);
  74.  
  75.   BEGIN (* ReportTime *)
  76.     TimerBase.SubTime (t2, t1);
  77.     IO.WriteF3
  78.       ( "    Elapsed time = %02.ld:%02.ld.%ld\n\n",
  79.         t2.secs DIV 60, t2.secs MOD 60,
  80.         (t2.micro + 50000) DIV 100000 )
  81.   END ReportTime;
  82.  
  83.   (*------------------------------------*)
  84.   (*$D-*)
  85.   PROCEDURE DoCompile (source : ARRAY OF CHAR);
  86.  
  87.     VAR
  88.       t1, t2 : Ti.TimeVal;
  89.  
  90.   BEGIN (* DoCompile *)
  91.     TU.GetSysTime (tr, t1);
  92.     file := Files.Old (source);
  93.     IF file = NIL THEN
  94.       IO.WriteF1 ("Failed to open : %s\n\n", SYS.ADR (source));
  95.     ELSE
  96.       IO.WriteF1 ("Compiling %s...\n\n", SYS.ADR (source));
  97.       Compiler.newSF := newsymfile;
  98.       Compiler.CompilationUnit (file);
  99.       IF OCS.scanerr THEN returnError := TRUE END;
  100.       Files.Close (file); file := NIL
  101.     END;
  102.     TU.GetSysTime (tr, t2);
  103.     ReportTime (t1, t2);
  104.   END DoCompile;
  105.  
  106.   (*------------------------------------*)
  107.   PROCEDURE DoCleanup ();
  108.  
  109.     VAR
  110.       t1, t2 : Ti.TimeVal;
  111.  
  112.   BEGIN (* DoCleanup *)
  113.     IO.WriteStr ("Garbage collecting...\n");
  114.     TU.GetSysTime (tr, t1);
  115.     OCC.Close (); OCT.Close ();
  116.     SYS.GC;
  117.     TU.GetSysTime (tr, t2);
  118.     ReportTime (t1, t2)
  119.   END DoCleanup;
  120.  
  121.   (*------------------------------------*)
  122.   PROCEDURE DoInteractive ();
  123.  
  124.     CONST prompt = "Source file ? : ";
  125.  
  126.     VAR nameBuffer : ARRAY 256 OF CHAR;
  127.  
  128.   BEGIN (* DoInteractive *)
  129.     IO.WriteStr (prompt); IO.ReadStr (nameBuffer);
  130.     IF nameBuffer [0] # 0X THEN
  131.       DoCompile (nameBuffer);
  132.       LOOP
  133.         IO.WriteStr (prompt); IO.ReadStr (nameBuffer);
  134.         IF nameBuffer [0] = 0X THEN EXIT END;
  135.         DoCleanup ();
  136.         DoCompile (nameBuffer)
  137.       END
  138.     END
  139.   END DoInteractive;
  140.  
  141.   (*------------------------------------*)
  142.   (*$D-*)
  143.   PROCEDURE DoBatch (batchName : ARRAY OF CHAR);
  144.  
  145.     VAR
  146.       sourceName : ARRAY 256 OF CHAR;
  147.       i : INTEGER;
  148.       ch : CHAR;
  149.       t1, t2 : Ti.TimeVal;
  150.  
  151.   BEGIN (* DoBatch *)
  152.     batchFile := Files.Old (batchName);
  153.     IF batchFile # NIL THEN
  154.       TU.GetSysTime (tr, t1);
  155.       Files.Set (r, batchFile, 0);
  156.       LOOP
  157.         Files.Read (r, ch);
  158.         IF r.eof THEN EXIT END;
  159.         WHILE ch <= " " DO (* Skip whitespace *)
  160.           Files.Read (r, ch); IF r.eof THEN EXIT END;
  161.         END;
  162.         i := 0;
  163.         REPEAT
  164.           sourceName [i] := ch; INC (i); Files.Read (r, ch)
  165.         UNTIL r.eof OR (ch = "\n");
  166.         sourceName [i] := 0X;
  167.         DoCompile (sourceName);
  168.         IF r.eof THEN EXIT END;
  169.         DoCleanup ()
  170.       END;
  171.       Files.Close (batchFile); batchFile := NIL;
  172.       TU.GetSysTime (tr, t2);
  173.       IO.WriteStr ("Finished batch compile\n");
  174.       ReportTime (t1, t2)
  175.     ELSE
  176.       IO.WriteF1 (" !! Could not open %s\n", SYS.ADR (batchName))
  177.     END;
  178.   END DoBatch;
  179.  
  180.   (*------------------------------------*)
  181.   PROCEDURE WbMain ();
  182.  
  183.   BEGIN (* WbMain *)
  184.     IU.SimpleNotice
  185.       (NIL, SYS.ADR ("Sorry, no support for Workbench yet :-("));
  186.     HALT (Dos.returnWarn)
  187.   END WbMain;
  188.  
  189.   (*------------------------------------*)
  190.   PROCEDURE CliMain ();
  191.  
  192.     VAR
  193.       argStr : ARRAY 256 OF CHAR;
  194.       arg : INTEGER;
  195.       batch : BOOLEAN;
  196.       ch : CHAR;
  197.  
  198.     (*------------------------------------*)
  199.     PROCEDURE Usage ();
  200.  
  201.     BEGIN (* Usage *)
  202.       IO.WriteStr ("Usage   : OC {option} {<filename>}\n");
  203.       IO.WriteStr ("Options : NS | NEWSYMFILE, DEBUG, VERBOSE, BATCH\n");
  204.       IO.WriteStr ("          SYM | SYMBOLS <directory>\n");
  205.       IO.WriteStr ("          DST | DESTINATION <directory>\n");
  206.       IO.WriteStr ("\nSee OC.doc for details\n\n");
  207.     END Usage;
  208.  
  209.   BEGIN (* CliMain *)
  210.     OCT.DestPath := ""; arg := 1; batch := FALSE; newsymfile := FALSE;
  211.     LOOP
  212.       IF arg >= Args.argc THEN EXIT END;
  213.       COPY (Args.argv [arg]^, argStr); Str.ToUpper (argStr);
  214.       IF (argStr = "SYM") OR (argStr = "SYMBOLS") THEN
  215.         INC (arg);
  216.         IF arg >= Args.argc THEN Usage (); HALT (Dos.returnWarn) END;
  217.         IF DU.DirExists (Args.argv [arg]^) THEN
  218.           OCT.AddPath (Args.argv [arg])
  219.         ELSE
  220.           IO.WriteF1
  221.             (" !! SYM directory %s doesn't exist\n", Args.argv [arg]);
  222.           HALT (Dos.returnWarn)
  223.         END
  224.       ELSIF (argStr = "DST") OR (argStr = "DESTINATION") THEN
  225.         IF OCT.DestPath # "" THEN Usage (); HALT (Dos.returnWarn) END;
  226.         INC (arg);
  227.         IF arg >= Args.argc THEN Usage (); HALT (Dos.returnWarn) END;
  228.         IF DU.DirExists (Args.argv [arg]^) THEN
  229.           COPY (Args.argv [arg]^, OCT.DestPath);
  230.           IF OCT.DestPath # "" THEN
  231.             ch := OCT.DestPath [Str.Length (OCT.DestPath) - 1];
  232.             IF (ch # ":") & (ch # "/") THEN Str.Append (OCT.DestPath, "/")
  233.             END
  234.           END
  235.         ELSE
  236.           IO.WriteF1
  237.             (" !! DST directory %s doesn't exist\n", Args.argv [arg]);
  238.           HALT (Dos.returnWarn)
  239.         END
  240.       ELSIF (argStr = "NS") OR (argStr = "NEWSYMFILE") THEN
  241.         newsymfile := TRUE
  242.       ELSIF argStr = "FORCE" THEN
  243.         Compiler.forceCode := TRUE
  244.       ELSIF argStr = "VERBOSE" THEN
  245.         OCG.Verbose := TRUE;
  246.       ELSIF argStr = "DEBUG" THEN
  247.         OCC.Debug := TRUE
  248.       ELSIF argStr = "TRACE" THEN
  249.         OCG.StartTrace ()
  250.       ELSIF argStr = "BATCH" THEN
  251.         batch := TRUE
  252.       ELSIF argStr = "TEXTERR" THEN
  253.         OCS.binErrFile := FALSE
  254.       ELSE
  255.         EXIT
  256.       END;
  257.       INC (arg);
  258.     END; (* LOOP *)
  259.     OCT.AddPath (SYS.ADR ("OLIB:"));
  260.  
  261.     IF arg < Args.argc THEN
  262.       WHILE arg < Args.argc DO
  263.         COPY (Args.argv [arg]^, argStr); INC (arg);
  264.         IF batch THEN DoBatch (argStr)
  265.         ELSE DoCompile (argStr)
  266.         END
  267.       END
  268.     ELSIF Dos.base.IsInteractive (Dos.base.Input ()) THEN
  269.       DoInteractive ()
  270.     END;
  271.     OCG.EndTrace ()
  272.   END CliMain;
  273.  
  274. BEGIN (* Main *)
  275.   Compiler.newSF := FALSE; Compiler.forceCode := FALSE;
  276.   OCG.Verbose := FALSE; OCS.binErrFile := TRUE;
  277.  
  278.   IF Args.IsCLI THEN
  279.     CliMain ()
  280.   ELSE
  281.     WbMain ()
  282.   END
  283. END Main;
  284.  
  285. BEGIN (* OC *)
  286.   IO.WriteStr (OCRev.vString);
  287.   IO.WriteStr (CopyrightStr);
  288.   IO.WriteStr (UsageStr);
  289.   IO.WriteLn ();
  290.  
  291.   IF E.base.version >= 37 THEN
  292.     Init();
  293.     Main();
  294.     IF returnError THEN HALT (Dos.returnError) END;
  295.   ELSE
  296.     IO.WriteStr (" !! OC requires AmigaOS 2.04+\n");
  297.     HALT (Dos.returnWarn)
  298.   END
  299. END OC.
  300.  
  301. (***************************************************************************
  302.  
  303.   $Log: OC.mod $
  304.   Revision 4.9  1994/08/14  10:36:42  fjc
  305.   - Argument parsing code now checks that SYM and DST
  306.     directories actually exist.
  307.  
  308.   Revision 4.8  1994/08/03  11:51:34  fjc
  309.   - Added TEXTERR option.
  310.  
  311.   Revision 4.5  1994/07/10  13:37:06  fjc
  312.   - Changed to use new SETCLEANUP format.
  313.  
  314.   Revision 4.2  1994/06/05  22:35:47  fjc
  315.   - Changed to use new Amiga interface.
  316.   - Added FORCE argument.
  317.  
  318.   Revision 4.1  1994/06/01  09:33:44  fjc
  319.   - Bumped version number
  320.  
  321. ***************************************************************************)
  322.  
  323.