🚀 go-pugleaf

Compile the following, and store the ".lod" file as "\sys\make.lod".
----- CUT HERE ------

MODULE Make;
(* A simple version of the UNIX "make" utility.

Handles only the following input lines

file1 : file2 file3 ... ; action
file1 : file2
file1 : ; action



To use this program you must create a \SYS directory and
place "make.bat" in it.  This program
creates and executes $MAKE.BAT in the \SYS directory.

To invoke the program type

make makefile

or

make makefile/n

(The /n option may have no leading blanks, and performs no updates.
*)


IMPORT Options;

FROM SYSTEM IMPORT
   ADR,
   DOSCALL;

FROM Storage IMPORT
   ALLOCATE;



IMPORT ASCII;



FROM InOut IMPORT
   Read,
   ReadString,
   termCH,
   WriteCard,
   WriteString,
   WriteLn;



FROM ErrorCode IMPORT
   SetErrorCode;



FROM FileSystem IMPORT
   ReadChar,
   WriteChar,
   WriteNBytes,
   File,
   Close,
   Response,
   Lookup;



CONST
   MaximumNumberOfFiles = 100;
   StringLength = 100;



TYPE
   TimeStamp = RECORD
      Date:CARDINAL;
      Time:CARDINAL;
   END; (* TimeStamp *)



   StringType = ARRAY [0..StringLength] OF CHAR;

   TableIndexType = [1..MaximumNumberOfFiles];

   DependencyPointer = POINTER TO DependencyNodeType;
   DependencyNodeType = RECORD
      DependsOn:TableIndexType;
      Next:DependencyPointer;
   END; (* DependencyNodeType *)


   ActionPointer = POINTER TO ActionRecord;
   ActionRecord = RECORD
      Action:StringType;
      Next:ActionPointer;
   END; (* ActionRecord *)



   TableNode = RECORD
      FileName: StringType;
      FileDate:TimeStamp;                (* Date and time *)
      ActionList:ActionPointer;
      DependencyList:DependencyPointer;  (* files this one depends on *)
      IsARoot:BOOLEAN;                   (* No one depends on this one *)
      SubgraphChecked:BOOLEAN;
   END; (* TableNode *)



VAR
   MakeFileName:StringType;
   OutputFile:File;
   CurrentTimeStamp:TimeStamp;
   Table:ARRAY TableIndexType OF TableNode; (* Table of dependencies *)
   FreeIndex:TableIndexType;                (* Index of first free in Table *)

   (* "switch" values *)
   NoExecute:BOOLEAN;


PROCEDURE Error(S:ARRAY OF CHAR);
BEGIN (* Error *)
   WriteString(S);
   WriteLn;
   SetErrorCode(1);
END Error;






PROCEDURE Equal(S1,S2:ARRAY OF CHAR):BOOLEAN;
VAR
   I:CARDINAL;
BEGIN (* Equal *)
   I := 0;
   LOOP
      IF (I > HIGH (S1)) THEN
         IF (I > HIGH (S2)) THEN
            RETURN TRUE;
         ELSE
            RETURN FALSE;
         END; (* IF *)
      ELSIF I > HIGH (S2) THEN
         RETURN FALSE;
      END; (* IF *)
      IF S1[I] = S2[I] THEN
         IF S1[I] = 0C THEN
            RETURN TRUE;
         END; (* IF *)
         INC(I);
      ELSE
         RETURN FALSE;
      END; (* IF *)
   END; (* LOOP *)
END Equal;


PROCEDURE GetTimeStamp(Name:ARRAY OF CHAR; VAR S:TimeStamp);
VAR
   Handle:CARDINAL;
   ErrorC:CARDINAL;
BEGIN (* GetTimeStamp *)
   (* Create a file handle *)
   DOSCALL(3DH, ADR(Name), 00, Handle, ErrorC);
   IF ErrorC = 0 THEN
   ELSIF ErrorC = 2 THEN
      S.Date := 0;
      S.Time := 0;
      RETURN;
   ELSE
      HALT;
   END; (* IF *)
   (* Get time stamp *)
   DOSCALL(57H, Handle, 00, S.Date, S.Time, ErrorC);
   IF ErrorC # 0 THEN
      HALT;
   END; (* IF *)
   (* Close handle *)
   DOSCALL(3EH, Handle, ErrorC);
   IF ErrorC # 0 THEN
      HALT;
   END; (* IF *)
END GetTimeStamp;


PROCEDURE PlaceInTable (F:StringType; VAR Ix:TableIndexType);
VAR
   I:TableIndexType;
BEGIN (* PlaceInTable *)
   I := 1;
   WHILE I < FreeIndex DO
      IF Equal(F,Table[I].FileName) THEN
         Ix := I;
         RETURN;
      END; (* IF *)
      INC (I);
   END; (* WHILE *)

   WITH Table[FreeIndex] DO
      FileName := F;
      GetTimeStamp(F,FileDate);
      ActionList := NIL;
      DependencyList := NIL;
      IsARoot := TRUE;
      SubgraphChecked := FALSE;
   END; (* WITH *)
   Ix := FreeIndex;
   INC (FreeIndex);
END PlaceInTable;



PROCEDURE ProcessMakeFile(Name:StringType);
VAR
   F:File;
   Token1:StringType;
   Token2:StringType;
   Ch:CHAR;
   I:CARDINAL;

   PROCEDURE ReadName(VAR S:StringType);
   VAR
      Ix:CARDINAL;
   BEGIN (* ReadName *)
      Ix := 0;
      WHILE NOT F.eof & (Ch # ASCII.EOL) & (Ch # ':') & (Ch # ' ') DO
         S[Ix] := Ch;
         INC(Ix);
         ReadChar(F,Ch);
      END; (* WHILE *)
      S[Ix] := 0C;
   END ReadName;

BEGIN (* ProcessMakeFile *)
   Lookup(F, Name, FALSE);
   IF NOT (F.res = done) THEN
      Error('make file not found');
      RETURN;
   END; (* IF *)
   ReadChar(F,Ch);
   WHILE NOT F.eof DO
      ReadName(Token1);
      IF F.eof THEN
         Error('Illegal line in makefile (1)');
         Close(F);
         RETURN;
      END; (* IF *)

      WHILE (Ch # ':') AND (Ch # ';') AND NOT F.eof DO
         ReadChar(F,Ch);
      END; (* WHILE *)
      IF F.eof THEN
         Error('Illegal line in makefile (2)');
         Close(F);
         RETURN;
      END; (* IF *)
      IF Ch = ':' THEN
         Ch := ' ';
      END; (* IF *)
      WHILE (Ch # ASCII.EOL) AND (NOT F.eof) AND (Ch # ';') DO
         WHILE (Ch = ' ') AND (NOT F.eof) DO
            ReadChar(F,Ch);
         END; (* WHILE *)
         IF Ch # ';' THEN
            ReadName(Token2);
            AddDependency(Token1,Token2);
         END; (* IF *)
      END; (* WHILE *)
      IF Ch = ';' THEN
         Ch := ' ';
         WHILE (Ch = ' ') AND (NOT F.eof) DO
            ReadChar(F,Ch);
         END; (* WHILE *)
         I := 0;
         WHILE (Ch # ASCII.EOL) AND (NOT F.eof) DO
            Token2[I] := Ch;
            INC(I);
            ReadChar(F,Ch);
         END; (* WHILE *)
         Token2[I] := 0C;
         IF I # 0 THEN
            AddAction(Token1,Token2);
         END; (* IF *)
      END; (* IF *)
      IF Ch = ASCII.EOL THEN
         ReadChar(F,Ch);
      END; (* IF *)
   END; (* WHILE *)
   Close(F);
   TraverseAllTrees;
END ProcessMakeFile;



PROCEDURE TimeStampGreaterThan (TS1,TS2:TimeStamp):BOOLEAN;
BEGIN (* TimeStampGreaterThan *)
   IF TS1.Date > TS2.Date THEN
      RETURN TRUE;
   ELSIF TS1.Date < TS2.Date THEN
      RETURN FALSE
   ELSE
      RETURN TS1.Time > TS2.Time
   END; (* IF *)
END TimeStampGreaterThan;



PROCEDURE TraverseThisTree(Root:TableIndexType);
VAR
   I:TableIndexType;
   Tmp:DependencyPointer;
   ActionNeeded:BOOLEAN;
BEGIN (* TraverseThisTree *)
   IF Table[Root].SubgraphChecked THEN
      RETURN;
   END; (* IF *)
   Table[Root].SubgraphChecked := TRUE;
   Tmp := Table[Root].DependencyList;
   ActionNeeded := FALSE;
   WHILE Tmp # NIL DO
      TraverseThisTree(Tmp^.DependsOn);
      IF NOT TimeStampGreaterThan(Table[Root].FileDate,
                                  Table[Tmp^.DependsOn].FileDate) THEN
         Table[Root].FileDate := CurrentTimeStamp;
         ActionNeeded := TRUE;
      END; (* IF *)
      Tmp := Tmp^.Next;
   END; (* WHILE *)
   IF ActionNeeded THEN
      TakeTheseActions(Root);
   END; (* IF *)
END TraverseThisTree;


PROCEDURE AddAction(F:StringType;A:StringType);
VAR
   Ix:TableIndexType;
   Temp:ActionPointer;
BEGIN (* AddAction *)
   PlaceInTable(F,Ix);
   NEW(Temp);
   Temp^.Next := Table[Ix].ActionList;
   Temp^.Action := A;
   Table[Ix].ActionList := Temp;
END AddAction;


PROCEDURE TraverseAllTrees;
VAR
   Ix:TableIndexType;
BEGIN (* TraverseAllTrees *)
   FOR Ix := 1 TO (FreeIndex - 1) DO
      IF Table[Ix].IsARoot THEN
         TraverseThisTree(Ix);
      END; (* IF *)
   END; (* FOR *)
END TraverseAllTrees;


PROCEDURE AddDependency (F1,F2:StringType);
VAR
   Ix1:TableIndexType;
   Ix2:TableIndexType;
   Temp:DependencyPointer;
BEGIN (* AddDependency *)
   PlaceInTable(F1,Ix1);
   PlaceInTable(F2,Ix2);
   IF DependencyExists(Ix1,Ix2) THEN
      RETURN;
   END; (* IF *)
   NEW (Temp);
   Temp^.DependsOn := Ix2;
   Temp^.Next := Table[Ix1].DependencyList;
   Table[Ix1].DependencyList := Temp;
   Table[Ix2].IsARoot := FALSE;
END AddDependency; 



PROCEDURE DependencyExists(Ix1,Ix2:TableIndexType):BOOLEAN;
VAR
   Temp:DependencyPointer;
BEGIN (* DependencyExists *)
   Temp := Table[Ix1].DependencyList;
   WHILE (Temp # NIL) & (Temp^.DependsOn # Ix2) DO
      Temp := Temp^.Next;
   END; (* WHILE *)
   RETURN (Temp # NIL);
END DependencyExists;



PROCEDURE WriteCharacterString(S:ARRAY OF CHAR);
VAR
   Dummy:CARDINAL;
BEGIN (* WriteCharacterString *)
   WriteNBytes(OutputFile,ADR(S), HIGH(S)+1, Dummy);
END WriteCharacterString;


PROCEDURE TakeTheseActions(I:TableIndexType);
VAR
   Tmp:ActionPointer;
   Ix:CARDINAL;

BEGIN (* TakeTheseActions *)
   Tmp := Table[I].ActionList;
   WHILE (Tmp # NIL) DO
      Ix := 0;

      IF NoExecute THEN
         WriteChar(OutputFile,'E');
         WriteChar(OutputFile,'C');
         WriteChar(OutputFile,'H');
         WriteChar(OutputFile,'O');
         WriteChar(OutputFile,' ');
      END; (* IF *)

      WHILE Tmp^.Action[Ix] # 0C DO
         WriteChar(OutputFile,Tmp^.Action[Ix]);
         INC(Ix);
      END; (* WHILE *)
      WriteChar(OutputFile,ASCII.EOL);
      Tmp := Tmp^.Next;
      WriteCharacterString('IF NOT ERRORLEVEL 0 GOTO ERROR');
      WriteChar(OutputFile,ASCII.EOL);
   END; (* WHILE *)
END TakeTheseActions;


PROCEDURE Initialize():BOOLEAN;
VAR
   Year:CARDINAL;
   MonthDay:CARDINAL;
   HourMinute:CARDINAL;
   SecondsMilliseconds:CARDINAL;
   Ch:CHAR;
   T:Options.Termination;
   R:Options.NamePartSet;
   S:StringType;
   Len:CARDINAL;
BEGIN (* Initialize *)
   WriteString('Make begins ...');
   WriteLn;
   FreeIndex := 1;
   (* Initialize CurrentTimeStamp *)
   DOSCALL(2AH, Year, MonthDay);
   DOSCALL(2CH, HourMinute, SecondsMilliseconds);
   CurrentTimeStamp.Date := ((Year - 1980) * 200H) +
                       (MonthDay DIV 100H) * 20H +
                       (MonthDay MOD 20H);
   CurrentTimeStamp.Time := (HourMinute DIV 100H) * 800H +
                       (HourMinute MOD 100H) * 20H +
                       ((SecondsMilliseconds DIV 100H) + 2) DIV 2;

   WriteString("make file name ->");
   Options.FileNameAndOptions ("makefile",MakeFileName,T,TRUE,R);
   WriteLn;

   IF (T = Options.can) OR (T = Options.esc) THEN
      RETURN(FALSE);
   END; (* IF *)

   Options.GetOption(S,Len);
   IF Len > 0 THEN
      Ch := S[0];
   ELSE
      Ch := ' ';
   END; (* IF *)
   IF CAP(Ch) = 'N' THEN
      NoExecute := TRUE;
   ELSE
      NoExecute := FALSE;
   END; (* IF *)

   Lookup(OutputFile,'\SYS\$MAKE.BAT',TRUE);
   RETURN(TRUE);
END Initialize;



PROCEDURE Terminate;
BEGIN (* Terminate *)
   WriteCharacterString('GOTO EXIT');
   WriteChar(OutputFile,ASCII.EOL);
   WriteCharacterString(':ERROR');
   WriteChar(OutputFile,ASCII.EOL);
   WriteCharacterString('PAUSE Terminated due to non-zero return code');
   WriteChar(OutputFile,ASCII.EOL);
   WriteCharacterString(':EXIT');
   WriteChar(OutputFile,ASCII.EOL);
   Close(OutputFile);
   WriteString('Make ends');
   WriteLn;
END Terminate;



BEGIN (* Make *)
   IF Initialize() THEN
      ProcessMakeFile(MakeFileName);
      Terminate;
   END; (* IF *)
END Make.