home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / modu1096.zip / sample / build.mod next >
Text File  |  1995-05-12  |  7KB  |  205 lines
  1. (****************************************************************)
  2. (*                                                              *)
  3. (*              Modula-2 Compiler Source Module                 *)
  4. (*                                                              *)
  5. (*                Load-builder driver program                   *)
  6. (*                                                              *)
  7. (*     (c) copyright 1990 Faculty of Information Technology     *)
  8. (*              Queensland University of Technology             *)
  9. (*                                                              *)
  10. (*     Permission is granted to use, copy and change this       *)
  11. (*     program as long as the copyright message is left intact  *)
  12. (*                                                              *)
  13. (****************************************************************)
  14.  
  15. MODULE Build;
  16.  
  17.   IMPORT UxFiles, StdStrings, IntStr, StdError;
  18.   
  19.   FROM SYSTEM IMPORT CAST, ADDRESS;
  20.   FROM Ascii  IMPORT lf;
  21.   FROM ProgArgs IMPORT 
  22.         UNIXexit, ArgNumber, GetArg, VersionTime, EnvironString;
  23.   FROM BuildArgs IMPORT 
  24.     Arg2, Arg3, ArgBlock, ArgPtr, ArgsOf, NewArgBlock, AppendArg;
  25.   FROM PcProcesses IMPORT Spawnv, System, PSP;
  26.   FROM GpFiles IMPORT GpFindLocal;
  27.  
  28.   CONST usage =
  29. "usage : build  [-options] [-Ldir] [-Wapp.def] [-Ydll.def] name" + lf +
  30. " name should not have the '.mod' extension, options are --"  + lf +
  31. "   -D Debug: automatic stack unwind on crash" + lf +
  32. "   -g include information for the debugger" + lf +
  33. "   -Ldirname - directory 'dirname' is searched for archive libraries" + lf +
  34. "   -S Script: no link, startup and script in 'modbase' and 'modbase.c'" + lf +
  35. "   -v verbose: filenames are traced" + lf +
  36. "   -V Version number (and more verbose)" + lf +
  37. "   -W build as PM application" + lf +
  38. "   -Y build as DLL (combine with -S if you require non-default switches)";
  39.  
  40.   CONST greetStr = "BUILD (OS/2) version of ";
  41.  
  42.   TYPE  NameString = ARRAY [0 .. 79] OF CHAR;
  43.         LongString = ARRAY [0 .. 255] OF CHAR;
  44.  
  45.   VAR    tmpNam : NameString;    (* name of temporary file  *)
  46.     modNam : NameString;    (* name of the base module *)
  47.         bldNam : NameString;    (* name of sym/rfx file    *)
  48.         exeNam : NameString;    (* name of build2/o2build3to call *)
  49.         blk    : ArgBlock;    (* arg. block for build2   *)
  50.     pidStr : ARRAY [0 .. 15] OF CHAR;
  51.  
  52.  
  53.   VAR   argString : LongString;
  54.     result : CARDINAL;    (* result of "wait" call   *)
  55.  
  56.   VAR   child  : INTEGER;    (* the child process ident *)
  57.  
  58.     persistent : BOOLEAN;    (* ==> do not delete files *)
  59.     hasOptions : BOOLEAN;   (* ==> pass options to b2  *)
  60.     hasLinkDir : BOOLEAN;   (* ==> pass linkdir to b2  *)
  61.     hasFileNam : BOOLEAN;   (* ==> has a single file   *)
  62.     ok : BOOLEAN;
  63.  
  64.   VAR    argc, argIx, optIx, index : CARDINAL;
  65.     optCh   : CHAR;
  66.         bldFile : UxFiles.File;
  67.  
  68.   VAR    str0,            (* arg[0]    *)
  69.     argN,            (* curr-arg  *)
  70.     dirStr,            (* -Ldirname *)
  71.     optStr    : NameString;   (* options   *)
  72.  
  73.  
  74.   PROCEDURE Abort(str : ARRAY OF CHAR; cmd : ARRAY OF CHAR);
  75.   BEGIN
  76.     StdError.WriteString("build: ");
  77.     StdError.WriteString(str); StdError.WriteString(cmd);
  78.     StdError.WriteLn;
  79.     UNIXexit(1);
  80.   END Abort;
  81.  
  82.   PROCEDURE Spawn(path : ARRAY OF CHAR; argv : ArgPtr) : INTEGER;
  83.     VAR id     : INTEGER;
  84.         result : CARDINAL;
  85.   BEGIN
  86.     id := Spawnv(path,argv);
  87.     IF id = -1 THEN
  88.       Abort("Couldn't exec ",path);
  89.     END;
  90.     RETURN CAST(CARDINAL,id);
  91.   END Spawn;
  92.  
  93. BEGIN
  94.   hasOptions := FALSE;        (* init option str  *)
  95.   persistent := FALSE;
  96.   optStr := "-";
  97.   optIx  := 1;
  98.  
  99.   hasFileNam := FALSE;
  100.   hasLinkDir := FALSE;
  101.  
  102.   ok := TRUE;            (* the sticky flag  *)
  103.   argc := ArgNumber();
  104.   IF argc >= 1 THEN GetArg(0,str0) END;
  105.   argIx := 1;
  106.   WHILE argIx < argc DO
  107.     GetArg(argIx,argN);
  108.     IF argN[0] = "-" THEN
  109.       IF argN[1] = "L" THEN
  110.     IF hasLinkDir THEN ok := FALSE END; (* only one allowed *)
  111.     hasLinkDir := TRUE;
  112.         dirStr := argN;
  113.       ELSE (* some other option *)
  114.     hasOptions := TRUE;
  115.         index := 1;
  116.     optCh := argN[index];
  117.     WHILE optCh <> "" DO
  118.       optStr[optIx] := optCh;
  119.       IF optCh = "S" THEN persistent := TRUE END;
  120.       INC(optIx); INC(index);
  121.       optCh := argN[index];
  122.     END;
  123.       END; (* else some other option *)
  124.     ELSE (* must be the filename *)
  125.       IF hasFileNam THEN ok := FALSE END; (* only one allowed *)
  126.       hasFileNam := TRUE;
  127.       modNam := argN;
  128.     END; (* if arg is option *)
  129.     INC(argIx);
  130.   END; (* for all args do ... *)
  131.   IF hasOptions THEN optStr[optIx] := "" END;
  132.   IF NOT ok OR NOT hasFileNam THEN (* bad args ... *)
  133.     StdError.WriteString(greetStr); 
  134.     VersionTime(argString);
  135.     StdError.WriteString(argString); StdError.WriteLn;
  136.     StdError.WriteString(usage); StdError.WriteLn;
  137.     UNIXexit(1);
  138.   END;
  139.   IF persistent THEN tmpNam := "modbase";
  140.   ELSE
  141.     EnvironString("TEMP",tmpNam);
  142.     index := LENGTH(tmpNam);
  143.     IF (index > 0) AND (tmpNam[index-1] <> "\") THEN
  144.       tmpNam[index] := "\";
  145.       INC(index);
  146.     END;
  147.     tmpNam[index]   := "b"; tmpNam[index+1] := "l";
  148.     tmpNam[index+2] := "d"; tmpNam[index+3] := "";
  149.     IntStr.Give(pidStr,CAST(CARDINAL,PSP()),1,IntStr.left);
  150.     StdStrings.Append(pidStr,tmpNam);
  151.   END;
  152.   (* ************************************************************ *)
  153.   (*
  154.         New code added to allow search for GPM or GPO build
  155.         files.
  156.         pms Jun 93 (from D.Corney)
  157.   *)
  158.   GpFindLocal (modNam,"rfx",bldNam,bldFile);
  159.   IF bldFile = NIL THEN           (* try for oberon build *)
  160.      GpFindLocal (modNam,"sym",bldNam,bldFile);
  161.      IF bldFile = NIL THEN        (* not modula or oberon *)
  162.         StdError.WriteString ("** Base file not found **");
  163.         StdError.WriteLn;
  164.         UNIXexit (1);
  165.      ELSE                         (* build oberon file    *)
  166.         exeNam := "o2build3";
  167.      END;
  168.   ELSE                            (* build modula file    *)
  169.      exeNam := "build2";
  170.   END;
  171.   (* ************************************************************ 
  172.                           End Modula/Oberon check
  173.      ************************************************************ *)
  174.  
  175.   IF argc = 2 THEN
  176.     result := Spawn(exeNam,Arg3(str0,tmpNam,bldNam));
  177.   ELSE 
  178.     NewArgBlock(blk,9);
  179.     AppendArg(blk,str0);
  180.     IF hasOptions THEN AppendArg(blk,optStr) END;
  181.     IF hasLinkDir THEN AppendArg(blk,dirStr) END;
  182.     AppendArg(blk,tmpNam);
  183.     AppendArg(blk,bldNam);
  184.     result := Spawn(exeNam,ArgsOf(blk));
  185.   END;
  186.   IF (result = 0) AND NOT persistent THEN
  187.     StdStrings.Assign(tmpNam, argString);
  188.     StdStrings.Append(" >nul",argString);
  189.    IF System(argString) <> 0 THEN
  190.       Abort("can't exec: ",tmpNam)
  191.     END;
  192.   ELSE UNIXexit(result);
  193.   END;
  194.  
  195.   IF NOT persistent THEN             (* script deletes the .o & .s file *)
  196.     UxFiles.Delete(tmpNam,ok);         (* delete bldNNN  *)
  197.     modNam := tmpNam;
  198.     StdStrings.Append(".dcf",modNam);
  199.     UxFiles.Delete(modNam,ok);         (* delete bldNNN.dcf *)
  200.     StdStrings.Append(".cmd",tmpNam);
  201.     UxFiles.Delete(tmpNam,ok);       (* delete bldNNN.bat *)
  202.   END;
  203.   UNIXexit(0);
  204. END Build.
  205.