home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / obrn-a_1.5_src.lha / oberon-a / source3.lha / Source / OC / OCM.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  19.7 KB  |  703 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OCM.mod $
  4.   Description: Machine-specific declarations and operations.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.10 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:17:17 $
  10.  
  11.   Copyright © 1993-1995, 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. <* STANDARD- *> <* MAIN- *>
  20.  
  21. MODULE OCM;
  22.  
  23. IMPORT
  24.   SYS := SYSTEM, Kernel, e := Exec, d := Dos, du := DosUtil,
  25.   str := Strings, WbConsole, s := OCStrings, wb := Workbench, i := Icon;
  26.  
  27. CONST
  28.  
  29.   (* Sizes in bytes of basic data types. *)
  30.  
  31.   ByteSize * = 1; BoolSize * = 1; CharSize * = 1;
  32.   SIntSize * = 1; IntSize * = 2; LIntSize * = 4;
  33.   RealSize * = 4; LRealSize * = RealSize;
  34.   BSetSize * = 1; WSetSize * = 2; SetSize * = 4;
  35.   PtrSize * = 4; ProcSize * = 4;
  36.  
  37.   (*
  38.   ** Maximum size of a procedure's parameter list. This must correspond
  39.   ** to the constant used by the stack checking code. See STACKCHK.asm.
  40.   ** *Must* be at least 1500, to allow for the stack requirements of
  41.   ** dos.library functions.
  42.   *)
  43.  
  44.   ParLimit * = 1500;
  45.  
  46.   (* Minima and Maxima of basic data types. *)
  47.  
  48.   MinBool * = 0; MaxBool * = 1; MinChar * = 0; MaxChar * = 0FFH;
  49.   MinSInt * = -80H; MaxSInt * = 7FH;
  50.   MinInt * = -8000H; MaxInt * = 7FFFH;
  51.   MinLInt * = 80000000H; MaxLInt * = 7FFFFFFFH;
  52.   MinSet * = 0; MaxBSet * = 7; MaxWSet * = 15; MaxSet * = 31;
  53.  
  54.   (* REALs are implemented as Motorola FFP Single-Precision reals. *)
  55.   MinReal * = MIN (REAL); (*-9.22337177E18*)
  56.   MaxReal * = MAX (REAL); (*+9.22337177E18*)
  57.   MaxExp * = 18;
  58.  
  59.   (*
  60.     For now, LONGREALs are the same as REALs.  In future, they will be
  61.     implemented as IEEE double-precision reals.
  62.   *)
  63.   MinLReal * = MinReal; MaxLReal * = MaxReal; MaxLExp * = MaxExp;
  64.  
  65.   (*
  66.    * Object and item modes, used by Module OCT and others. These are
  67.    * subject to change.
  68.    *)
  69.  
  70.   Undef   * =  0;
  71.   Var     * =  1; (* local and global variables and value parameters *)
  72.   VarX    * =  2; (* indexed array variables *)
  73.   VarArg  * =  3; (* C-style vararg pushed on stack *)
  74.   Ind     * =  4; (* variable parameters *)
  75.   IndX    * =  5; (* indexed dynamic array parameters *)
  76.   RegI    * =  6; (* register indirect mode with displacement *)
  77.   RegX    * =  7; (* register indirect mode with displacement and index *)
  78.   Lab     * =  8; (* absolute mode, the address of a label *)
  79.   LabI    * =  9; (* immediate mode, the address of a label *)
  80.   Abs     * = 10; (* absolute mode *)
  81.   Con     * = 11; (* constants *)
  82.   Push    * = 12; (* register indirect mode with predecrement *)
  83.   Pop     * = 13; (* register indirect mode with postincrement *)
  84.   Coc     * = 14; (* condition code *)
  85.   Reg     * = 15; (* register direct mode *)
  86.   Fld     * = 16; (* record fields *)
  87.   Typ     * = 17; (* types *)
  88.   LProc   * = 18; (* local (non-exportable) procedures *)
  89.   XProc   * = 19; (* exportable procedures *)
  90.   TProc   * = 20; (* Type-bound procedures *)
  91.   SProc   * = 21; (* standard procedures *)
  92.   LibCall * = 22; (* Amiga library functions *)
  93.   M2Proc  * = 23; (* External procedure (Modula-2 conventions) *)
  94.   CProc   * = 24; (* External procedure (C conventions) *)
  95.   AProc   * = 25; (* External procedure (Assembly conventions) *)
  96.   Mod     * = 26; (* Modules *)
  97.   Head    * = 27; (* symbol scope header *)
  98.   RList   * = 28; (* Register list for MOVEM *)
  99.  
  100. (* System flags, used in the foreign code interface *)
  101.  
  102.   DefaultFlag * = -1; (* Use current default *)
  103.   OberonFlag  * =  0; (* Use Oberon conventions (default) *)
  104.   M2Flag      * =  1; (* Use Modula-2 conventions *)
  105.   CFlag       * =  2; (* Use C conventions *)
  106.   BCPLFlag    * =  3; (* Use BCPL conventions *)
  107.   AsmFlag     * =  4; (* Use Assembler conventions *)
  108.  
  109. (* Preferences settings *)
  110.  
  111. CONST
  112.  
  113.   PathLen = 256;                     (* Max length of a path name.      *)
  114.   ExtLen = 16;                       (* Max length of an extension.     *)
  115.   maxPaths = 10;                     (* Max number of search paths.     *)
  116.   OCPF = 04F435046H; (* "OCPF" *)    (* Tag for preferences file.       *)
  117.   PrefsVersion = 1;                  (* Preferences file version.       *)
  118.  
  119.   (* Icon types *)
  120.   iconSym* = 0; iconObj* = 1; iconErr* = 2;
  121.  
  122. TYPE
  123.   Path = ARRAY PathLen OF CHAR;
  124.   Extension = ARRAY ExtLen OF CHAR;
  125.  
  126. VAR
  127.   SymPath*,                          (* Destination for symbol files.   *)
  128.   ObjPath*,                          (* Destination for object files.   *)
  129.   ErrPath*,                          (* Destination for error files.    *)
  130.   SetNames*,                         (* Pragmas, options and selectors
  131.                                      ** to be set.
  132.                                      *)
  133.   ClearNames*                        (* Pragmas, options and selectors
  134.                                      ** to be cleared.
  135.                                      *)
  136.     : Path;
  137.   SymExt*,                           (* Extension for symbol files      *)
  138.   ObjExt*,                           (* Extension for object files      *)
  139.   ErrExt*                            (* Extension for error files       *)
  140.     : Extension;
  141.   Verbose*,                          (* Verbose compiler output.        *)
  142.   Debug*,                            (* Output symbol hunks             *)
  143.   MakeIcons* : BOOLEAN;              (* Create icons for symbol, object
  144.                                      ** and error files.
  145.                                      *)
  146.  
  147.   searchPath-                        (* Array of search paths.          *)
  148.     : ARRAY maxPaths + 1 OF e.LSTRPTR;
  149.   pathx- : INTEGER;                  (* Current # of search paths.      *)
  150.  
  151. CONST
  152.  
  153.   defSymPath = "";                   (* Default symbol file path.       *)
  154.   defObjPath = "";                   (* Default object file path.       *)
  155.   defErrPath = "T:";                 (* Default error file path.        *)
  156.   defSymExt = ".sym";                (* Default symbol file extension.  *)
  157.   defObjExt = ".obj";                (* Default object file extension.  *)
  158.   defErrExt = ".err";                (* Default error file extension.   *)
  159.  
  160. (* Force generation of symbol and object files *)
  161.  
  162. VAR
  163.  
  164.   Force* : BOOLEAN;
  165.  
  166. (* Tracing code -- to be removed *)
  167.  
  168. VAR
  169.   Trace-  : BOOLEAN;          (* Trace procedure calls *)
  170.   indent  : INTEGER;          (* Indent level for tracing *)
  171.   logFile : d.FileHandlePtr;
  172.   Digit   : ARRAY 17 OF CHAR;
  173.  
  174. CONST
  175.   logFileName = "CON:100/56/540/189/Oberon.log/CLOSE/WAIT";
  176.   DigitString = "0123456789ABCDEF";
  177.  
  178. (*------------------------------------*)
  179. PROCEDURE Write * (ch : CHAR);
  180.  
  181.   VAR ignore : LONGINT;
  182.  
  183. BEGIN (* Write *)
  184.   IF Trace THEN ignore := d.Write (logFile, ch, 1) END
  185. END Write;
  186.  
  187. (*------------------------------------*)
  188. PROCEDURE WriteStr * (s : ARRAY OF CHAR);
  189.  
  190.   VAR ignore : LONGINT;
  191.  
  192. <*$CopyArrays-*>
  193. BEGIN (* WriteStr *)
  194.   IF Trace THEN ignore := d.Write (logFile, s, SYS.STRLEN (s)) END
  195. END WriteStr;
  196.  
  197. (*------------------------------------*)
  198. PROCEDURE WriteInt * (i : LONGINT);
  199.  
  200.   VAR ignore : LONGINT;
  201.  
  202.   (*------------------------------------*)
  203.   PROCEDURE WriteDigit (i : LONGINT);
  204.  
  205.     VAR ignore : LONGINT;
  206.  
  207.   BEGIN (* WriteDigit *)
  208.     IF i > 0 THEN WriteDigit (i DIV 10); Write (Digit [i MOD 10]) END
  209.   END WriteDigit;
  210.  
  211. BEGIN (* WriteInt *)
  212.   IF Trace THEN
  213.     IF i = 0 THEN Write ("0")
  214.     ELSE IF i < 0 THEN Write ("-") END; WriteDigit (ABS (i))
  215.     END
  216.   END
  217. END WriteInt;
  218.  
  219. (*------------------------------------*)
  220. PROCEDURE TraceIn * (mod, proc : ARRAY OF CHAR);
  221.  
  222.   VAR i : INTEGER;
  223.  
  224. <*$CopyArrays-*>
  225. BEGIN (* TraceIn *)
  226.   IF Trace THEN
  227.     i := 0; WHILE i < indent DO WriteStr ("  "); INC (i) END;
  228.     WriteStr (">>"); WriteStr (mod); Write ("."); WriteStr (proc);
  229.     Write ("\n");
  230.     INC (indent)
  231.   END
  232. END TraceIn;
  233.  
  234. (*------------------------------------*)
  235. PROCEDURE TraceOut * (mod, proc : ARRAY OF CHAR);
  236.  
  237.   VAR i : INTEGER;
  238.  
  239. <*$CopyArrays-*>
  240. BEGIN (* TraceOut *)
  241.   IF Trace THEN
  242.     DEC (indent);
  243.     i := 0; WHILE i < indent DO WriteStr ("  "); INC (i) END;
  244.     WriteStr ("<<"); WriteStr (mod); Write ("."); WriteStr (proc);
  245.     Write ("\n");
  246.   END
  247. END TraceOut;
  248.  
  249. (*------------------------------------*)
  250. PROCEDURE StartTrace * ();
  251.  
  252. BEGIN (* StartTrace *)
  253.   logFile := d.Open (logFileName, d.newFile);
  254.   Trace := TRUE;
  255. END StartTrace;
  256.  
  257. (*------------------------------------*)
  258. PROCEDURE EndTrace * ();
  259.  
  260. BEGIN (* EndTrace *)
  261.   IF Trace THEN
  262.     d.OldClose (logFile); Trace := FALSE; logFile := NIL
  263.   END
  264. END EndTrace;
  265.  
  266. (*
  267. ** Console I/O
  268. *)
  269.  
  270. (*------------------------------------*)
  271. PROCEDURE OutStr* ( string : ARRAY OF CHAR );
  272. <*$CopyArrays-*>
  273. BEGIN (* OutStr *)
  274.   du.HaltIfBreak ({d.ctrlC});
  275.   IF d.PutStr (string) = 0 THEN END;
  276.   IF d.Flush (d.Output()) THEN END
  277. END OutStr;
  278.  
  279.  
  280. (*------------------------------------*)
  281. PROCEDURE OutLn*;
  282. BEGIN (* OutLn *)
  283.   du.HaltIfBreak ({d.ctrlC});
  284.   IF d.PutStr ("\n") = 0 THEN END;
  285. END OutLn;
  286.  
  287.  
  288. (*------------------------------------*)
  289. PROCEDURE OutChar* ( c : CHAR );
  290. BEGIN (* OutChar *)
  291.   du.HaltIfBreak ({d.ctrlC});
  292.   d.PrintF ("%lc", c);
  293.   IF d.Flush (d.Output()) THEN END
  294. END OutChar;
  295.  
  296.  
  297. (*------------------------------------*)
  298. PROCEDURE OutInt* ( i : LONGINT );
  299. BEGIN (* OutInt *)
  300.   du.HaltIfBreak ({d.ctrlC});
  301.   d.PrintF ("%ld", i);
  302.   IF d.Flush (d.Output()) THEN END
  303. END OutInt;
  304.  
  305.  
  306. (*------------------------------------*)
  307. PROCEDURE OutStr0* ( n : LONGINT );
  308.   VAR string : e.LSTRPTR;
  309. BEGIN (* OutStr0 *)
  310.   du.HaltIfBreak ({d.ctrlC});
  311.   string := s.GetString (n);
  312.   IF d.PutStr (string^) = 0 THEN END;
  313.   IF d.Flush (d.Output()) THEN END
  314. END OutStr0;
  315.  
  316.  
  317. (*------------------------------------*)
  318. PROCEDURE OutStr1* ( n : LONGINT; string : ARRAY OF CHAR );
  319.   VAR format : e.LSTRPTR;
  320. <*$CopyArrays-*>
  321. BEGIN (* OutStr1 *)
  322.   du.HaltIfBreak ({d.ctrlC});
  323.   format := s.GetString (n);
  324.   d.PrintF (format^, SYS.ADR (string));
  325.   IF d.Flush (d.Output()) THEN END
  326. END OutStr1;
  327.  
  328.  
  329. (*------------------------------------*)
  330. PROCEDURE OutInt3* ( n, i1, i2, i3 : LONGINT );
  331.   VAR format : e.LSTRPTR;
  332. BEGIN (* OutInt3 *)
  333.   du.HaltIfBreak ({d.ctrlC});
  334.   format := s.GetString (n);
  335.   d.PrintF (format^, i1, i2, i3);
  336.   IF d.Flush (d.Output()) THEN END
  337. END OutInt3;
  338.  
  339.  
  340. (*------------------------------------*)
  341. PROCEDURE OutInt4* ( n, i1, i2, i3, i4 : LONGINT );
  342.   VAR format : e.LSTRPTR;
  343. BEGIN (* OutInt4 *)
  344.   du.HaltIfBreak ({d.ctrlC});
  345.   format := s.GetString (n);
  346.   d.PrintF (format^, i1, i2, i3, i4);
  347.   IF d.Flush (d.Output()) THEN END
  348. END OutInt4;
  349.  
  350.  
  351. (*------------------------------------*)
  352. PROCEDURE* PutCh ();
  353.  
  354. <*$EntryExitCode-*>
  355. BEGIN (* PutCh *)
  356.   SYS.INLINE (16C0H,   (* MOVE.B D0,(A3)+ *)
  357.               4E75H)   (* RTS             *)
  358. END PutCh;
  359.  
  360.  
  361. (*------------------------------------*)
  362. PROCEDURE FmtInt3* ( n, i1, i2, i3 : LONGINT; VAR string : ARRAY OF CHAR );
  363.   VAR format : e.LSTRPTR; t : LONGINT;
  364. BEGIN (* FmtInt3 *)
  365.   t := i1; i1 := i3; i3 := t;
  366.   e.OldRawDoFmtL (format^, i3, PutCh, SYS.ADR (string));
  367. END FmtInt3;
  368.  
  369.  
  370. (*------------------------------------*)
  371. PROCEDURE LoadPrefs* ( fileName : ARRAY OF CHAR ) : BOOLEAN;
  372.  
  373.   VAR
  374.     pf   : d.FileHandlePtr;
  375.     s    : ARRAY PathLen OF CHAR;
  376.     dir  : ARRAY 3 OF e.LSTRPTR;
  377.     tag  : LONGINT; i, ver : INTEGER;
  378.     c    : CHAR;
  379.  
  380.   PROCEDURE Read ( fh : d.FileHandlePtr; VAR x : SYS.BYTE );
  381.     VAR i : LONGINT;
  382.   BEGIN (* Read *)
  383.     i := d.FGetC (fh); x := CHR (i)
  384.   END Read;
  385.  
  386.   PROCEDURE ReadBytes
  387.     ( fh : d.FileHandlePtr; VAR x : ARRAY OF SYS.BYTE; n : LONGINT );
  388.     VAR i : LONGINT;
  389.   BEGIN (* ReadBytes *)
  390.     i := d.FRead (fh, x, 1, n)
  391.   END ReadBytes;
  392.  
  393.   PROCEDURE ReadString ( fh : d.FileHandlePtr; VAR x : ARRAY OF CHAR );
  394.     VAR ch : CHAR; i : INTEGER;
  395.   BEGIN (* ReadString *)
  396.     i := 0;
  397.     REPEAT
  398.       Read (fh, ch); x [i] := ch; INC (i)
  399.     UNTIL ch = 0X
  400.   END ReadString;
  401.  
  402.   PROCEDURE ReadBool ( fh : d.FileHandlePtr; VAR x : BOOLEAN );
  403.     VAR i : SHORTINT;
  404.   BEGIN (* ReadBool *)
  405.     Read (fh, i); x := (i # 0)
  406.   END ReadBool;
  407.  
  408. <*$CopyArrays-*>
  409. BEGIN (* LoadPrefs *)
  410.   dir [0] := SYS.ADR ("PROGDIR:");
  411.   dir [1] := SYS.ADR ("ENV:OC");
  412.   dir [2] := NIL;
  413.   IF du.Search (dir, fileName, s) THEN
  414.     pf := d.Open (s, d.oldFile);
  415.     IF pf # NIL THEN
  416.       ReadBytes (pf, tag, 4);
  417.       IF tag = OCPF THEN
  418.         Read (pf, c); ver := ORD (c);
  419.         IF ver >= 1 THEN
  420.           ReadString (pf, SymPath);
  421.           ReadString (pf, ObjPath);
  422.           ReadString (pf, ErrPath);
  423.           ReadString (pf, SetNames);
  424.           ReadString (pf, ClearNames);
  425.           ReadString (pf, SymExt);
  426.           ReadString (pf, ObjExt);
  427.           ReadString (pf, ErrExt);
  428.  
  429.           LOOP
  430.             ReadString (pf, s);
  431.             IF s = "" THEN EXIT END;
  432.             SYS.NEW (searchPath [pathx], str.Length (s) + 1);
  433.             COPY (s, searchPath [pathx]^); INC (pathx)
  434.           END;
  435.           searchPath [pathx] := NIL;
  436.  
  437.           ReadBool (pf, Verbose);
  438.           ReadBool (pf, MakeIcons);
  439.           ReadBool (pf, Debug);
  440.  
  441.           d.OldClose (pf);
  442.           RETURN TRUE
  443.         ELSE
  444.           d.OldClose (pf);
  445.           RETURN FALSE
  446.         END;
  447.       ELSE
  448.         d.OldClose (pf);
  449.         RETURN FALSE
  450.       END;
  451.     ELSE
  452.       RETURN FALSE
  453.     END;
  454.   ELSE
  455.     RETURN FALSE
  456.   END;
  457. END LoadPrefs;
  458.  
  459. (*------------------------------------*)
  460. PROCEDURE SavePrefs* ( fileName : ARRAY OF CHAR ) : BOOLEAN;
  461.  
  462.   VAR pf : d.FileHandlePtr; tag : LONGINT; i : INTEGER; ver : CHAR;
  463.  
  464.   PROCEDURE Write ( fh : d.FileHandlePtr; x : SYS.BYTE );
  465.     VAR i : LONGINT;
  466.   BEGIN (* Write *)
  467.     i := d.FPutC (fh, ORD (x))
  468.   END Write;
  469.  
  470.   PROCEDURE WriteBytes
  471.     ( fh : d.FileHandlePtr; VAR x : ARRAY OF SYS.BYTE; n : LONGINT );
  472.     VAR i : LONGINT;
  473.   BEGIN (* WriteBytes *)
  474.     i := d.FWrite (fh, x, 1, n)
  475.   END WriteBytes;
  476.  
  477.   PROCEDURE WriteString ( fh : d.FileHandlePtr; x : ARRAY OF CHAR );
  478.   <*$CopyArrays-*>
  479.   BEGIN (* WriteString *)
  480.     WriteBytes (fh, x, str.Length (x)); Write (fh, 0X)
  481.   END WriteString;
  482.  
  483.   PROCEDURE WriteBool ( fh : d.FileHandlePtr; x : BOOLEAN );
  484.     VAR i : SHORTINT;
  485.   BEGIN (* WriteBool *)
  486.     IF x THEN i := 1 ELSE i := 0 END; Write (fh, i)
  487.   END WriteBool;
  488.  
  489. <*$CopyArrays-*>
  490. BEGIN (* SavePrefs *)
  491.   pf := d.Open (fileName, d.newFile);
  492.   IF pf # NIL THEN
  493.     tag := OCPF; WriteBytes (pf, tag, 4);
  494.     Write (pf, CHR (PrefsVersion));
  495.     WriteString (pf, SymPath);
  496.     WriteString (pf, ObjPath);
  497.     WriteString (pf, ErrPath);
  498.     WriteString (pf, SetNames);
  499.     WriteString (pf, ClearNames);
  500.     WriteString (pf, SymExt);
  501.     WriteString (pf, ObjExt);
  502.     WriteString (pf, ErrExt);
  503.     FOR i := 0 TO pathx - 1 DO WriteString (pf, searchPath [i]^) END;
  504.     WriteString (pf, "");
  505.     WriteBool (pf, Verbose);
  506.     WriteBool (pf, MakeIcons);
  507.     WriteBool (pf, Debug);
  508.  
  509.     d.OldClose (pf);
  510.     RETURN TRUE
  511.   ELSE
  512.     RETURN FALSE
  513.   END
  514. END SavePrefs;
  515.  
  516. (*------------------------------------*)
  517. PROCEDURE ClearSearchPaths*;
  518. BEGIN (* ClearSearchPaths *)
  519.   pathx := 0; searchPath [0] := NIL
  520. END ClearSearchPaths;
  521.  
  522. (*------------------------------------*)
  523. PROCEDURE AddSearchPath * (newPath : e.LSTRPTR);
  524.  
  525. BEGIN (* AddSearchPath *)
  526.   IF pathx >= maxPaths THEN
  527.     HALT (922)
  528.   ELSE
  529.     searchPath [pathx] := newPath; INC (pathx); searchPath [pathx] := NIL
  530.   END;
  531. END AddSearchPath;
  532.  
  533. (*------------------------------------*)
  534. PROCEDURE FindSymbolFile *
  535.   ( module   : ARRAY OF CHAR;
  536.     VAR path : ARRAY OF CHAR )
  537.   : BOOLEAN;
  538.  
  539.   VAR name : ARRAY 32 OF CHAR;
  540.  
  541. <*$CopyArrays-*>
  542. BEGIN (* FindSymbolFile *)
  543.   COPY (module, name); str.Append (SymExt, name);
  544.   RETURN du.Search (searchPath, name, path)
  545. END FindSymbolFile;
  546.  
  547. (*------------------------------------*)
  548. PROCEDURE MakeFileName
  549.   ( module, ext : ARRAY OF CHAR;
  550.     VAR path    : ARRAY OF CHAR );
  551.  
  552.   VAR name : ARRAY 32 OF CHAR;
  553.  
  554. <*$CopyArrays-*>
  555. BEGIN (* MakeFileName *)
  556.   COPY (module, name); str.Append (ext, name);
  557.   IF d.AddPart (path, name, LEN (path)) THEN END
  558. END MakeFileName;
  559.  
  560. (*------------------------------------*)
  561. PROCEDURE SymbolFileName *
  562.   ( module   : ARRAY OF CHAR;
  563.     VAR path : ARRAY OF CHAR;
  564.     fullPath : BOOLEAN );
  565.  
  566. <*$CopyArrays-*>
  567. BEGIN (* SymbolFileName *)
  568.   IF fullPath THEN
  569.     IF ~du.DirExists (SymPath) THEN OutStr1 (s.OCM3, SymPath) END;
  570.     COPY (SymPath, path); MakeFileName (module, SymExt, path)
  571.   ELSE
  572.     COPY (module, path); str.Append (SymExt, path)
  573.   END;
  574. END SymbolFileName;
  575.  
  576. (*------------------------------------*)
  577. PROCEDURE ObjectFileName *
  578.   ( module   : ARRAY OF CHAR;
  579.     VAR path : ARRAY OF CHAR );
  580.  
  581. <*$CopyArrays-*>
  582. BEGIN (* ObjectFileName *)
  583.   IF ~du.DirExists (ObjPath) THEN OutStr1 (s.OCM3, ObjPath) END;
  584.   COPY (ObjPath, path); MakeFileName (module, ObjExt, path)
  585. END ObjectFileName;
  586.  
  587. (*------------------------------------*)
  588. PROCEDURE ErrorFileName *
  589.   ( module   : ARRAY OF CHAR;
  590.     VAR path : ARRAY OF CHAR );
  591.  
  592. <*$CopyArrays-*>
  593. BEGIN (* ErrorFileName *)
  594.   IF ~du.DirExists (ErrPath) THEN OutStr1 (s.OCM3, ErrPath) END;
  595.   COPY (ErrPath, path); MakeFileName (module, ErrExt, path)
  596. END ErrorFileName;
  597.  
  598.  
  599. (*------------------------------------*)
  600. PROCEDURE MakeIcon* ( file : ARRAY OF CHAR; type : INTEGER );
  601.  
  602.   VAR
  603.     icon : Path;
  604.     diskObj : wb.DiskObjectPtr;
  605.     filePart : e.LSTRPTR;
  606.  
  607. <*$CopyArrays-*>
  608. BEGIN (* MakeIcon *)
  609.   IF MakeIcons THEN
  610.     ASSERT (i.base # NIL, 100);
  611.     COPY (file, icon); str.Append (".info", icon);
  612.     IF ~du.FileExists (icon) THEN
  613.       CASE type OF
  614.         iconSym : icon := "ENV:OC/def_sym" |
  615.         iconObj : icon := "ENV:OC/def_obj" |
  616.         iconErr : icon := "ENV:OC/def_err" |
  617.       END;
  618.       diskObj := i.GetDiskObject (icon);
  619.       IF diskObj = NIL THEN diskObj := i.GetDefDiskObject (wb.project) END;
  620.       IF diskObj # NIL THEN
  621.         diskObj.currentX := wb.noIconPosition;
  622.         diskObj.currentY := wb.noIconPosition;
  623.         IF ~i.PutDiskObject (file, diskObj) THEN
  624.           IF d.PrintFault (d.IoErr(), "PutDiskObject") THEN END;
  625.           OutStr1 (s.OCM1, file)
  626.         END;
  627.         i.FreeDiskObject (diskObj)
  628.       ELSE
  629.         IF d.PrintFault (d.IoErr(), "GetDiskObject") THEN END;
  630.         OutStr0 (s.OCM2)
  631.       END
  632.     END
  633.   END
  634. END MakeIcon;
  635.  
  636.  
  637. (*------------------------------------*)
  638. PROCEDURE* Cleanup (VAR rc : LONGINT);
  639.  
  640. BEGIN (* Cleanup *)
  641.   IF logFile # NIL THEN d.OldClose (logFile); logFile := NIL END;
  642.   s.CloseCatalog()
  643. END Cleanup;
  644.  
  645. BEGIN
  646.   Kernel.SetCleanup (Cleanup);
  647.   s.OpenCatalog (NIL, "");
  648.   Digit := DigitString; indent := 0; Trace := FALSE; logFile := NIL;
  649.  
  650.   SymPath := defSymPath; ObjPath := defObjPath; ErrPath := defErrPath;
  651.   SymExt := defSymExt; ObjExt := defObjExt; ErrExt := defErrExt;
  652.   Verbose := TRUE; MakeIcons := FALSE; Debug := FALSE; Force := FALSE;
  653.   searchPath [0] := NIL; pathx := 0
  654. END OCM.
  655.  
  656. (***************************************************************************
  657.  
  658.   $Log: OCM.mod $
  659.   Revision 5.10  1995/01/26  00:17:17  fjc
  660.   - Release 1.5
  661.  
  662.   Revision 5.9  1995/01/16  10:30:02  fjc
  663.   - Uses direct calls to AmigaDOS for reading and writing
  664.     preferences files.
  665.  
  666.   Revision 5.8  1995/01/09  13:44:53  fjc
  667.   - Deleted icon names from preferences file format.
  668.   - Added MakeIcon().
  669.   - Added checks for the existence of directories when
  670.     constructing file names.
  671.  
  672.   Revision 5.7  1995/01/05  11:27:26  fjc
  673.   - Added check for Ctrl-C break to console I/O procedures.
  674.  
  675.   Revision 5.6  1995/01/03  21:00:03  fjc
  676.   - Renamed from OCG to OCM.
  677.   - Added support for preferences settings:
  678.     - Added variables to hold current settings.
  679.     - Added LoadPrefs() and SavePrefs().
  680.   - Added ClearSearchPaths().
  681.   - Added console I/O procedures to replace module Out.
  682.   - Added support for catalogs using module OCStrings.
  683.  
  684.   Revision 5.5  1994/12/16  16:59:59  fjc
  685.   - Added code for constructing file names and searching for
  686.     symbol files.
  687.  
  688.   Revision 5.4  1994/09/25  17:30:29  fjc
  689.   - Overhauled object modes.
  690.   - Added system flag declarations.
  691.  
  692.   Revision 5.3  1994/09/19  23:10:05  fjc
  693.   - Re-implemented Amiga library calls
  694.  
  695.   Revision 5.2  1994/09/15  10:10:58  fjc
  696.   - Replaced switches with pragmas.
  697.   - Uses Kernel instead of SYSTEM.
  698.  
  699.   Revision 5.1  1994/09/03  19:29:08  fjc
  700.   - Bumped version number
  701.  
  702. ***************************************************************************)
  703.