Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/375.lha/m2make_v1.02/m2make.mod

Text File | 1990-05-02 | 30KB | 1,031 lines

MODULE  M2Make;
(*$D-*)

FROM    SYSTEM      IMPORT
    ADR,                ADDRESS,        SHORT,              LONG,
    TSIZE;

FROM    System      IMPORT
    argc,               argv;

FROM    Conversions IMPORT
    ConvStringToNumber, ConvNumberToString;

FROM    Strings     IMPORT
    ConcatString,       CompareString,  CopyString,         ExtractSubString,
    LocateSubString,    Relation,       CompareStringCAP,   LocateChar,
    DeleteSubString,    StringLength;

FROM    AmigaDOS    IMPORT
    FileHandle,         FileLock,       FileInfoBlock,      FileInfoBlockPtr,
    DateStampRecord,    Open,           Close,              Lock,
    UnLock,             Examine,        AccessRead,         ModeOldFile,
    DateStampPtr,       Read,           ModeNewFile,        Execute;

FROM    Memory      IMPORT
    AllocMem,           FreeMem,        MemReqSet,          MemChip,
    MemClear,           MemPublic;

FROM    Tasks       IMPORT
    TaskPtr,            FindTask,       SignalSet;

FROM    AmigaDOSProcess IMPORT
    ProcessPtr;

IMPORT  TermInOut,
        InOut;

CONST
    FileNameSize        =25;
    BufferSize          =500;
    Null                =CHAR( 0 );
    IndentSize          =6;

TYPE
    ReadBuffer          =ARRAY[ 0..BufferSize ] OF CHAR;
    ReadBufferPtr       =POINTER TO ReadBuffer;

    FileName            =ARRAY[ 0..FileNameSize ] OF CHAR;
    FileNamePtr         =POINTER TO FileName;

    UserFile            =RECORD
                            ufDate          :DateStampRecord;
                            ufName          :FileName;
                            ufHandle        :FileHandle;
                            ufDef,
                            ufFROM,
                            ufIMPORT,
                            ufScanned,
                            ufStamped,
                            ufMade,
                            ufUpdated       :BOOLEAN;
                            ufLinePtr,
                            ufBufPtr        :INTEGER;
                            ufLine,
                            ufBuffer        :ReadBufferPtr;

                         END;
    UserFilePtr         =POINTER TO UserFile;
    UserFileArray       =ARRAY[ 0..0 ] OF UserFile;
    UserFileArrayPtr    =POINTER TO UserFileArray;

    LibName             =FileName;
    LibNamePtr          =POINTER TO LibName;
    LibFileArray        =ARRAY[ 0..0 ] OF LibName;
    LibFileArrayPtr     =POINTER TO LibFileArray;

    RunTypes            =(  Initial,
                            Batch,
                            Immediate,
                            Xecute,
                            Show
                         );

VAR
    IndentChar      :ARRAY[ 0..IndentSize ] OF CHAR;
    ThisTask        :TaskPtr;
    UserFiles       :UserFileArrayPtr;
    LibFiles        :LibFileArrayPtr;
    ModUpdated,
    DefUpdated,
    UserSize,
    LibSize,
    UserIndex,
    LibIndex        :INTEGER;
    FIB             :FileInfoBlockPtr;
    IndentNum       :INTEGER;
    LnkOutOfSync,
    NewLineLast     :BOOLEAN;

    MsgLevel        :INTEGER;

    BatchFile,
    ExecuteFile,
    MainFile        :FileName;

    ModExt,
    DefExt,
    SymExt,
    LnkExt          :ARRAY[ 0..6 ] OF CHAR;

    CompilerName,
    LinkerName      :ARRAY[ 0..15 ] OF CHAR;

    RunType         :RunTypes;

    CompilerFlags,
    LinkerFlags,
    UpdateFlags     :ARRAY[ 0..8 ] OF CHAR;

PROCEDURE Indent;
VAR
    i:INTEGER;
BEGIN
    FOR i := 1 TO IndentNum DO
        TermInOut.WriteString( IndentChar );
    END;
END Indent;

PROCEDURE Info ( Message   :ARRAY OF CHAR;
                NewLine   :BOOLEAN
              );
BEGIN
    IF MsgLevel < 1 THEN
        RETURN;
    END;
    IF ( NewLineLast ) AND ( MsgLevel > 1 ) THEN
        Indent;
        NewLineLast := FALSE;
    END;
    TermInOut.WriteString( Message );
    IF NewLine THEN
        TermInOut.WriteLn;
        NewLineLast := TRUE;
    END;
END Info;

PROCEDURE Msg ( Message   :ARRAY OF CHAR;
                NewLine   :BOOLEAN
              );
BEGIN
    IF MsgLevel < 2 THEN
        RETURN;
    END;
    IF NewLineLast THEN
        Indent;
        NewLineLast := FALSE;
    END;
    TermInOut.WriteString( Message );
    IF NewLine THEN
        TermInOut.WriteLn;
        NewLineLast := TRUE;
    END;
END Msg;

PROCEDURE DebugMsg ( Message   :ARRAY OF CHAR;
                     NewLine   :BOOLEAN
                   );
BEGIN
    IF MsgLevel < 3 THEN
        RETURN;
    END;
    IF NewLineLast THEN
        Indent;
        NewLineLast := FALSE;
    END;
    TermInOut.WriteString( Message );
    IF NewLine THEN
        TermInOut.WriteLn;
        NewLineLast := TRUE;
    END;
END DebugMsg;

PROCEDURE Free ( VAR Base    :ADDRESS;
                     Size    :CARDINAL
               );
BEGIN
    FreeMem( Base , LONG( Size ) );
    Base := NIL;
END Free;

PROCEDURE Stop ( Message:ARRAY OF CHAR );
VAR
    i   :INTEGER;
BEGIN
    InOut.CloseOutput;
    IndentNum := 0;
    TermInOut.WriteString( Message ); TermInOut.WriteLn;
    IF FIB # NIL THEN
        Free( FIB , TSIZE( FileInfoBlock ) );
    END;
    IF LibFiles # NIL THEN
        DebugMsg( 'Library files found' , TRUE );
        FOR i := 0 TO LibIndex DO
            DebugMsg( LibFiles^[ i ] , TRUE );
        END;
        DebugMsg( '' , TRUE );
        Free( LibFiles , TSIZE( LibFileArray )*LibSize*4 );
    END;
    IF UserFiles # NIL THEN
        DebugMsg( 'User files found' , TRUE );
        FOR i := 0 TO UserIndex DO
            WITH UserFiles^[ i ] DO
                DebugMsg( ufName , TRUE );
                IF ufHandle # NIL THEN
                    Close( ufHandle );
                END;
                IF ufLine # NIL THEN
                    Free( ufLine , TSIZE( ReadBuffer ) );
                END;
                IF ufBuffer # NIL THEN
                    Free( ufBuffer , TSIZE( ReadBuffer ) );
                END;
            END;
        END;
        DebugMsg( '' , TRUE );
        Free( UserFiles , TSIZE( UserFileArray )*UserSize*4 );
    END;
    HALT;
END Stop;

PROCEDURE CheckAbort;
BEGIN
    WITH ThisTask^ DO
        IF ( 12 IN tcSigRecvd ) THEN
            Stop( 'M2Make - canceled' );
        END;
    END;
END CheckAbort;

PROCEDURE Updating( Update:CHAR ):BOOLEAN;
BEGIN
    RETURN( LocateChar( UpdateFlags , Update , 0 , SIZE( UpdateFlags ) ) # -1 );
END Updating;

PROCEDURE Alloc ( VAR Base    :ADDRESS;
                      Size    :CARDINAL;
                      Type    :CARDINAL
                );
VAR
    type    :MemReqSet;
BEGIN
    type     := MemReqSet{ MemClear };
    INCL( type , Type );
    Base     := AllocMem( LONG( Size ) , type );
    IF Base = NIL THEN
        Stop( 'Abort - Out of memory' );
    END;
END Alloc;

PROCEDURE FindUserFile( FileName:ARRAY OF CHAR ):INTEGER;
VAR
    i:INTEGER;
BEGIN
    IF UserIndex = -1 THEN
        RETURN( -1 );
    END;
    FOR i := 0 TO UserIndex DO
        WITH UserFiles^[ i ] DO
            IF CompareString( FileName , ufName ) = equal THEN
                RETURN( i );
            END;
        END;
    END;
    RETURN( -1 );
END FindUserFile;

PROCEDURE FindLibFile( FileName:ARRAY OF CHAR ):INTEGER;
VAR
    i:INTEGER;
BEGIN
    IF LibIndex = -1 THEN
        RETURN( -1 );
    END;
    FOR i := 0 TO LibIndex DO
        IF CompareString( FileName , LibFiles^[ i ] ) = equal THEN
            RETURN( i );
        END;
    END;
    RETURN( -1 );
END FindLibFile;

PROCEDURE AddFile( FileName:ARRAY OF CHAR );
BEGIN
    INC( UserIndex );
    IF UserIndex > UserSize*4 THEN
        Stop( 'Abort - User file buffer overflow' );
    END;
    WITH UserFiles^[ UserIndex ] DO
        CopyString( ufName , FileName );
        ufDef     := FALSE;
        ufStamped := FALSE;
        ufScanned := FALSE;
        ufUpdated := FALSE;
        ufMade    := FALSE;
        ufFROM    := FALSE;
        ufIMPORT  := FALSE;
        WITH ufDate DO
            dsDays := 0D;
        END;
    END;
END AddFile;

PROCEDURE AddLibFile( FileName:ARRAY OF CHAR );
BEGIN
    INC( LibIndex );
    IF LibIndex > LibSize*4 THEN
        Stop( 'Abort - Library file buffer overflow' );
    END;
    CopyString( LibFiles^[ LibIndex ] , FileName );
END AddLibFile;

PROCEDURE GetStamp( FileName:ARRAY OF CHAR; Add:BOOLEAN ):DateStampPtr;
VAR
    i       :INTEGER;
    lock    :FileLock;
BEGIN
    i := FindUserFile( FileName );
    IF i # -1 THEN
        WITH UserFiles^[ i ] DO
            IF NOT ufStamped THEN
                lock := Lock( ADR( FileName ) , AccessRead );
                IF lock = NIL THEN
                    ufStamped := TRUE;
                    RETURN( DateStampPtr( ADR( ufDate ) ) );
                END;
                IF Examine( lock , FIB^ ) THEN
                    ufStamped := TRUE;
                    ufDate    := FIB^.fibDate;
                    UnLock( lock );
                    RETURN( DateStampPtr( ADR( ufDate ) ) );
                ELSE
                    Info( FileName , TRUE );
                    Stop( 'Abort - Examine failed ' );
                END;
            ELSE
                RETURN( DateStampPtr( ADR( ufDate ) ) );
            END;
        END;
    END;
    IF Add THEN
        AddFile( FileName );
    END;
    lock := Lock( ADR( FileName ) , AccessRead );
    IF lock = NIL THEN
        WITH UserFiles^[ UserIndex ] DO
            ufStamped := TRUE;
            RETURN( DateStampPtr( ADR( ufDate ) ) );
        END;
    END;
    IF Examine( lock , FIB^ ) THEN
        UnLock( lock );
        IF Add THEN
            WITH UserFiles^[ UserIndex ] DO
                ufStamped := TRUE;
                ufDate    := FIB^.fibDate;
            END;
        END;
        RETURN( DateStampPtr( ADR( FIB^.fibDate ) ) );
    ELSE
        Info( FileName , TRUE );
        Stop( 'Abort - Examine failed ' );
    END;
END GetStamp;

PROCEDURE FormFileName( Into,Name,Ext:ARRAY OF CHAR );
BEGIN
    CopyString( Into , Name );
    ConcatString( Into , '.' );
    ConcatString( Into , Ext );
END FormFileName;

PROCEDURE OutOfSync( Name1,Name2:ARRAY OF CHAR; Add1,Add2:BOOLEAN ):BOOLEAN;
VAR
    date1,date2:DateStampPtr;
BEGIN
    Msg( '  Check sync: ' , FALSE );
    Msg( Name1 , FALSE );Msg( ',',FALSE ); Msg( Name2 , FALSE );
    date1 := GetStamp( Name1 , Add1 );
    date2 := GetStamp( Name2 , Add2 );
    IF ( date1^.dsDays > date2^.dsDays )
       OR
       ( ( date1^.dsDays = date2^.dsDays )
         AND
         ( date1^.dsMinute > date2^.dsMinute )
       )
       OR
       ( ( date1^.dsDays = date2^.dsDays )
         AND
         ( date1^.dsMinute = date2^.dsMinute )
         AND
         ( date1^.dsTick > date2^.dsTick )
       ) THEN
        Msg( ' - Out of sync: ' , TRUE );
        RETURN( TRUE );
    ELSE
        Msg( '' , TRUE );
        RETURN( FALSE );
    END;
END OutOfSync;

PROCEDURE Whitespace( c:CHAR ):BOOLEAN;
BEGIN
    RETURN( c <= ' ' );
END Whitespace;

PROCEDURE Terminator( c:CHAR ):BOOLEAN;
BEGIN
    RETURN( ( c <= ' ' ) OR ( c = ',' ) OR ( c = ';' ) OR ( c = '.' ) );
END Terminator;

PROCEDURE GetNextChar( Index:INTEGER ):CHAR;
VAR
    c:CHAR;
BEGIN
    WITH UserFiles^[ Index ] DO
        IF ufBufPtr = -1 THEN
            IF Read( ufHandle , ufBuffer ,
                     LONG( TSIZE( ReadBuffer ) ) ) = 0D THEN
            END;
        END;
        INC( ufBufPtr );
        c := ufBuffer^[ ufBufPtr ];
        IF ufBufPtr = BufferSize THEN
            ufBufPtr := -1;
        END;
    END;
    RETURN( c );
END GetNextChar;

PROCEDURE GetNextLine( Index:INTEGER );
VAR
    i:INTEGER;
    char,last:CHAR;
    comment:INTEGER;
    done:BOOLEAN;
BEGIN
    WITH UserFiles^[ Index ] DO
        i := 0;
        char := ' ';
        last := ' ';
        comment := 0;
        done := FALSE;
        WHILE NOT ( done ) DO
            CheckAbort;
            ufLine^[ i ] := Null;
            last := char;
            char := GetNextChar( Index );
            IF ( char = '*' ) AND ( last = '(' ) THEN
                INC( comment );
            END;
            IF ( char = ')' ) AND ( last = '*' ) THEN
                DEC( comment );
                IF comment = 0 THEN
                    char := ' ';
                    last := ' ';
                    DEC( i );
                    ufLine^[ i ] := ' ';
                END;
            END;
            ufLine^[ i ] := char;
            IF ( comment = 0 ) AND ( ( char = ';' ) OR ( char = '.' ) ) THEN
                INC( i );
                done := TRUE;
            ELSIF ( ( Whitespace( char ) ) AND ( Whitespace( last ) ) )
                  OR
                  ( comment > 0 ) THEN
            ELSE
                INC( i );
                IF i > BufferSize THEN
                    done := TRUE;
                END;
            END;
        END;
        ufLine^[ i ] := Null;
        ufLinePtr := 0;
        DebugMsg('line=',FALSE);DebugMsg(ufLine^,TRUE);
    END;
END GetNextLine;

PROCEDURE GetNextWord( Index:INTEGER; NextWord:ARRAY OF CHAR ):BOOLEAN;
VAR
    c:CHAR;
    i:INTEGER;
    done:BOOLEAN;
BEGIN
    WITH UserFiles^[ Index ] DO
        IF ufLinePtr = -1 THEN
            GetNextLine( Index );
        END;
        i := -1;
        WHILE Terminator( ufLine^[ ufLinePtr ] ) DO
            INC( ufLinePtr );
        END;
        done := FALSE;
        WHILE NOT ( done ) DO
            CheckAbort;
            c := ufLine^[ ufLinePtr ];
            INC( ufLinePtr );
            INC( i );
            NextWord[ i ] := c;
            done := Terminator( c );
        END;
        IF c = ';' THEN
            ufLinePtr := -1;
        END;
        NextWord[ i ] := Null;
    END;
    RETURN( FALSE );
END GetNextWord;

PROCEDURE LibraryFile( FileName:ARRAY OF CHAR ):BOOLEAN;
VAR
    lock:FileLock;
    name:ARRAY[ 0..25 ] OF CHAR;
BEGIN
    DebugMsg(FileName,FALSE);
    IF FindLibFile( FileName ) = -1 THEN
        FormFileName( name , FileName , DefExt );
        lock := Lock( ADR( name ) , AccessRead );
        IF lock # NIL THEN
            UnLock( lock );
            DebugMsg(' user file',TRUE);
            RETURN( FALSE );
        ELSE
            AddLibFile( FileName );
            DebugMsg(' library file',TRUE);
            RETURN( TRUE );
        END;
    ELSE
        DebugMsg(' library file',TRUE);
        RETURN( TRUE );
    END;
END LibraryFile;

PROCEDURE GetNextImport( Index:INTEGER; ImportName:ARRAY OF CHAR ):BOOLEAN;
VAR
    done,eol,gotname:BOOLEAN;
    nextword:FileName;
BEGIN
    done := FALSE;
    WHILE NOT ( done ) DO
        CheckAbort;
        gotname := FALSE;
        WITH UserFiles^[ Index ] DO
            eol := GetNextWord( Index , nextword );
            DebugMsg('word=' , FALSE );DebugMsg( nextword , TRUE );
            IF ( CompareString( nextword , 'CONST' ) = equal ) THEN
                done := TRUE;
            ELSIF ( CompareString( nextword , 'TYPE' ) = equal ) THEN
                done := TRUE;
            ELSIF ( CompareString( nextword , 'VAR' ) = equal ) THEN
                done := TRUE;
            ELSIF ( CompareString( nextword , 'PROCEDURE' ) = equal ) THEN
                done := TRUE;
            ELSIF ( CompareString( nextword , 'BEGIN' ) = equal ) THEN
                done := TRUE;
            ELSIF ( CompareString( nextword , 'END' ) = equal ) THEN
                done := TRUE;
            ELSIF CompareString( nextword , 'FROM' ) = equal THEN
                ufFROM := TRUE;
                ufIMPORT := FALSE;
            ELSIF ( CompareString( nextword , 'IMPORT' ) = equal ) THEN
                IF ufFROM THEN
                    ufFROM := FALSE;
                ELSE
                    ufIMPORT := TRUE;
                END;
            ELSIF ufFROM THEN
                CopyString( ImportName , nextword );
                gotname := TRUE;
            ELSIF ufIMPORT THEN
                 CopyString( ImportName , nextword );
                 gotname := TRUE;
            END;
            IF gotname THEN
                DebugMsg('gotname',TRUE);
                IF NOT ( LibraryFile( ImportName ) ) THEN
                    done := TRUE;
                END;
            END;
        END;
    END;
    RETURN( gotname );
END GetNextImport;

PROCEDURE DefModule( Ext:ARRAY OF CHAR ):BOOLEAN;
BEGIN
    RETURN( CompareStringCAP( Ext , DefExt ) = equal );
END DefModule;

PROCEDURE Compile( Index:INTEGER );
VAR
    cmd:ARRAY[ 0..100 ] OF CHAR;
    stdin,stdout:FileHandle;
BEGIN
    WITH UserFiles^[ Index ] DO
        cmd[ 0 ] := Null;
        IF RunType # Batch THEN
            ConcatString( cmd , CompilerName );
            ConcatString( cmd , ' ' );
        END;
        ConcatString( cmd , ufName );
        ConcatString( cmd , ' ' );
        ConcatString( cmd , CompilerFlags );
        IF ( RunType = Batch ) OR ( RunType = Xecute ) THEN
            InOut.WriteString( cmd );
            InOut.WriteLn;
        ELSIF RunType = Immediate THEN
            stdin := NIL;
            stdout := Open( ADR( 'CON:0/0/320/200/Compile' ) , ModeNewFile );
            IF Execute( ADR( cmd ) , stdin , stdout ) THEN
            END;
            Close( stdout );
            ufStamped := FALSE;
        ELSIF RunType = Show THEN
            Info( 'Compile:' , FALSE );Info( ufName , TRUE );
        END;
    END;
END Compile;

PROCEDURE MakeFile( Index:INTEGER );
VAR
    made:BOOLEAN;
BEGIN
    WITH UserFiles^[ Index ] DO
        ufMade := TRUE;
        made := FALSE;
        IF Updating( 'a' ) THEN
            made := TRUE;
        ELSIF ( Updating( 'm' ) ) AND NOT ( ufDef ) THEN
            made := TRUE;
        ELSIF ( Updating( 'd' ) ) AND ( ufDef ) THEN
            made := TRUE;
        END;
        IF made THEN
            IF ufDef THEN
                INC( DefUpdated );
            ELSE
                INC( ModUpdated );
            END;
            Compile( Index );
        END;
    END;
END MakeFile;

PROCEDURE NeedsUpdate( Name,Ext,Bin:ARRAY OF CHAR ):BOOLEAN;
VAR
    update,make,baseoutofsync,defoutofsync,impoutofsync:BOOLEAN;
    basename,binname,defname,defimport,import:FileName;
    basehandle:FileHandle;
    i:INTEGER;
BEGIN
    CheckAbort;
    FormFileName( basename , Name , Ext );
    i := FindUserFile( basename );
    IF i # -1 THEN
        WITH UserFiles^[ i ] DO
            RETURN( ufUpdated );
        END;
    END;
    INC( IndentNum );
    AddFile( basename );
    i := UserIndex;
    basehandle := Open( ADR( basename ) , ModeOldFile );
    IF basehandle = NIL THEN
        IF ( CompareString( Name , MainFile ) = equal ) AND
           ( DefModule( Ext ) ) THEN
            RETURN( FALSE );
        ELSE
            Info( basename , TRUE );
            Stop( 'Abort - Missing source file' );
        END;
    END;
    Msg( 'Scanning:' , FALSE );Msg( basename , TRUE );
    WITH UserFiles^[ i ] DO
        ufLinePtr := -1;
        ufBufPtr := -1;
        ufHandle   := basehandle;
        Alloc( ufLine , TSIZE( ReadBuffer ) , MemChip );
        Alloc( ufBuffer , TSIZE( ReadBuffer ) , MemChip );
    END;
    FormFileName( binname , Name , Bin );
    baseoutofsync := OutOfSync( basename , binname , TRUE , TRUE );
    FormFileName( defname , Name , DefExt );
    defoutofsync := ( NOT ( DefModule( Ext ) ) ) AND
                    ( NeedsUpdate( Name , DefExt , SymExt ) );
    impoutofsync := FALSE;
    WHILE GetNextImport( i , import ) DO
        FormFileName( defimport , import , DefExt );
        Msg( basename , FALSE );Msg( ' imports:' , FALSE ); Msg( import , TRUE );
        impoutofsync := ( NeedsUpdate( import , ModExt , LnkExt ) )
                        OR
                        ( OutOfSync( defimport , binname , TRUE , TRUE ) )
                        OR
                        ( impoutofsync );

    END;
    Close( basehandle );
    make := ( baseoutofsync ) OR ( defoutofsync ) OR
            ( impoutofsync ) OR ( Updating( 'a' ) );
    update := ( DefModule( Ext ) ) AND ( make );
    IF make THEN
        IF DefModule( Ext ) THEN
            UserFiles^[ i ].ufDef := TRUE;
            UserFiles^[ i ].ufDate.dsDays := MAX( LONGINT );
        END;
        MakeFile( i );
    END;
    IF NOT ( DefModule( Ext ) ) THEN
        LnkOutOfSync := ( OutOfSync( binname , MainFile , TRUE , TRUE ) )
                        OR
                        ( LnkOutOfSync );
    END;
    WITH UserFiles^[ i ] DO
        Free( ufLine , TSIZE( ReadBuffer ) );
        Free( ufBuffer , TSIZE( ReadBuffer ) );
        ufHandle := NIL;
        ufScanned := TRUE;
        ufUpdated := update;
        ufMade := make;
    END;
    DEC( IndentNum );
    RETURN( update );
END NeedsUpdate;

PROCEDURE ProcessFlag( Flag:ARRAY OF CHAR; Parm:ARRAY OF CHAR ):BOOLEAN;
VAR
    size:LONGINT;
BEGIN
    IF HIGH( Parm ) = 0 THEN
        IF CompareString( Flag , 'q' ) = equal THEN
            MsgLevel := 0;
        ELSIF CompareString( Flag , 't' ) = equal THEN
            MsgLevel := 1;
        ELSIF CompareString( Flag , 'v' ) = equal THEN
            MsgLevel := 2;
        ELSIF CompareString( Flag , 'z' ) = equal THEN
            MsgLevel := 3;
        ELSIF CompareString( Flag , 'i' ) = equal THEN
            RunType := Immediate;
        ELSIF CompareString( Flag , 's' ) = equal THEN
            RunType := Show;
        ELSE
            RETURN( FALSE );
        END;
        RETURN( TRUE );
    ELSE
        IF ( CompareString( Flag , 'b' ) = equal ) AND ( RunType = Initial ) THEN
            RunType := Batch;
            CopyString( BatchFile , Parm );
        ELSIF ( CompareString( Flag , 'x' ) = equal ) AND ( RunType = Initial ) THEN
            RunType := Xecute;
            CopyString( ExecuteFile , Parm );
        ELSIF CompareString( Flag , 'cn' ) = equal THEN
            CopyString( CompilerName , Parm );
        ELSIF CompareString( Flag , 'ln' ) = equal THEN
            CopyString( LinkerName , Parm );
        ELSIF CompareString( Flag , 'cf' ) = equal THEN
            CopyString( CompilerFlags , Parm );
        ELSIF CompareString( Flag , 'lf' ) = equal THEN
            CopyString( LinkerFlags , Parm );
        ELSIF CompareString( Flag , 'm' ) = equal THEN
            CopyString( ModExt , Parm );
        ELSIF CompareString( Flag , 'd' ) = equal THEN
            CopyString( DefExt , Parm );
        ELSIF CompareString( Flag , 's' ) = equal THEN
            CopyString( SymExt , Parm );
        ELSIF CompareString( Flag , 'l' ) = equal THEN
            CopyString( LnkExt , Parm );
        ELSIF CompareString( Flag , 'u' ) = equal THEN
            CopyString( UpdateFlags , Parm );
        ELSIF CompareString( Flag , 'us' ) = equal THEN
            IF ConvStringToNumber( Parm , size , FALSE , 10 ) THEN
                UserSize := SHORT( size );
            ELSE
                UserSize := -1;
            END;
        ELSIF CompareString( Flag , 'ls' ) = equal THEN
            IF ConvStringToNumber( Parm , size , FALSE , 10 ) THEN
                LibSize := SHORT( size );
            ELSE
                LibSize := -1;
            END;
        END;
        RETURN( TRUE );
    END;
END ProcessFlag;

PROCEDURE CheckParms;
VAR
    num:ARRAY[0..10] OF CHAR;
BEGIN
    IF ( UserSize = -1 ) OR ( LibSize = -1 ) THEN
        Stop( 'File number invalid' );
    END;
    IndentNum := 0;

    ConvNumberToString( num , LONG( UserSize ) , FALSE , 10 , 3 , ' ');
    Info( 'User file size=' , FALSE );Info( num , TRUE );
    ConvNumberToString( num , LONG( LibSize ) , FALSE , 10 , 3 , ' ');
    Info( 'Lib file size=' , FALSE );Info( num , TRUE );

    Info( 'Message level= ' , FALSE );
    CASE MsgLevel OF
        0:
            |
        1:
            Info( 'Terse' , TRUE );
            |
        2:
            Info( 'Verbose' , TRUE );
            |
        3:
            Info( 'Debug' , TRUE );
            |
    END;
    IF ( Updating( 'n' ) ) OR ( RunType = Initial ) THEN
        RunType := Show;
    END;
    CASE RunType OF
        Initial:
            Info( 'Mode=Batch' , TRUE );
            Info( 'Batch file=' , FALSE );Info( BatchFile , TRUE );
            RunType := Batch;
            InOut.OpenOutputFile( BatchFile );
            |
        Immediate:
            Info( 'Mode=Immediate' , TRUE );
            |
        Xecute:
            Info( 'Mode=Execute' , TRUE );
            Info( 'Execute file=' , FALSE );Info( ExecuteFile , TRUE );
            InOut.OpenOutputFile( ExecuteFile );
            |
        Batch:
            Info( 'Mode=Batch' , TRUE );
            Info( 'Batch file=' , FALSE );Info( BatchFile , TRUE );
            InOut.OpenOutputFile( BatchFile );
            |
        Show:
            Info( 'Mode=Show' , TRUE );
            |
    END;

    Info( 'Updating: ' , TRUE );
    IF Updating( 'n' ) THEN
        Info( '   No modules ' , TRUE );
    ELSIF Updating( 'a' ) THEN
        Info( '   All modules ' , TRUE );
    ELSE
        IF Updating( 'm' ) THEN
            Info( '   Code modules ' , TRUE );
        END;
        IF Updating( 'd' ) THEN
            Info( '   Definition modules ' , TRUE );
        END;
        IF Updating( 'l' ) THEN
            Info( '   With re-link ' , TRUE );
        END;
    END;
    Info( 'Mod ext=' , FALSE );Info( ModExt , FALSE );
    Info( '  Def ext=' , FALSE );Info( DefExt , FALSE );
    Info( '  Sym ext=' , FALSE );Info( SymExt , FALSE );
    Info( '  Lnk ext=' , FALSE );Info( LnkExt , TRUE );

    Info( 'Compiler=' , FALSE );Info( CompilerName , TRUE );
    Info( 'Compiler Flags=' , FALSE );Info( CompilerFlags , TRUE );
    Info( 'Linker=' , FALSE );Info( LinkerName , TRUE );
    Info( 'Linker Flags=' , FALSE );Info( LinkerFlags , TRUE );
END CheckParms;

PROCEDURE ProcessParms;
CONST
    DefaultUpdateFlags          ='cdm';
    DefaultModExt               ='mod';
    DefaultDefExt               ='def';
    DefaultSymExt               ='sbm';
    DefaultLnkExt               ='obm';
    Quote                       ="'";
VAR
    i,l:CARDINAL;
    lastsingle,quote:BOOLEAN;
    flag:ARRAY[ 0..1 ] OF CHAR;
    parm:ARRAY[ 0..50 ] OF CHAR;
BEGIN
    IF argc <2 THEN
        Stop( 'Too few parameters' );
    END;
    UserSize := 25;
    LibSize  := 25;
    CopyString( MainFile , argv^[ 1 ]^ );
    CopyString( UpdateFlags , DefaultUpdateFlags );
    CopyString( ModExt , DefaultModExt );
    CopyString( DefExt , DefaultDefExt );
    CopyString( SymExt , DefaultSymExt );
    CopyString( LnkExt , DefaultLnkExt );
    RunType := Initial;
    CopyString( CompilerName , 'm2' );
    CopyString( LinkerName , 'm2lk' );

    i := 2;
    lastsingle := TRUE;
    quote      := FALSE;

    WHILE i <= argc-1 DO
        IF ( argv^[ i ]^[ 0 ] = '<' ) OR ( argv^[ i ]^[ 0 ] = '>' ) THEN
        ELSIF ( argv^[ i ]^[ 0 ] = '-' ) AND ( lastsingle ) AND NOT ( quote ) THEN
            flag[ 0 ] := argv^[ i ]^[ 1 ];
            flag[ 1 ] := argv^[ i ]^[ 2 ];
            lastsingle := ProcessFlag( flag , '' );
        ELSIF quote THEN
            ConcatString( parm , ' ' );
            ConcatString( parm , argv^[ i ]^ );
            quote := LocateChar( argv^[ i ]^ , Quote , 0 , 50 ) = -1;
            IF NOT quote THEN
                DeleteSubString( parm , 0 , 1 );
                l := StringLength( parm );
                DeleteSubString( parm , l-1 , 1 );
                lastsingle := ProcessFlag( flag , parm );
            END;
        ELSIF ( argv^[ i ]^[ 0 ] # '-' ) AND NOT ( lastsingle ) THEN
            CopyString( parm , argv^[ i ]^ );
            IF argv^[ i ]^[ 0 ] # Quote THEN
                lastsingle := ProcessFlag( flag , parm );
            ELSE
                l := StringLength( parm );
                IF parm[ l-1 ] # Quote THEN
                    quote := TRUE;
                ELSE
                    DeleteSubString( parm , 0 , 1 );
                    DeleteSubString( parm , l-1 , 1 );
                    lastsingle := ProcessFlag( flag , parm );
                    quote := FALSE;
                END;
            END;
        ELSE
            Stop( 'Parameters incorrect' );
        END;
        INC( i );
    END;
    CheckParms;
END ProcessParms;

PROCEDURE Link;
VAR
    num:ARRAY[ 0..10 ] OF CHAR;
    cmd:ARRAY[ 0..100 ] OF CHAR;
    stdin,stdout:FileHandle;
BEGIN
    IF ModUpdated + DefUpdated > 0 THEN
        ConvNumberToString( num , LONG( ModUpdated ) , FALSE , 10 , 3 , ' ');
        Info( num , FALSE );
        Info( ' MOD files require re-compilation' , TRUE );
        ConvNumberToString( num , LONG( DefUpdated ) , FALSE , 10 , 3 , ' ');
        Info( num , FALSE );
        Info( ' DEF files require re-compilation' , TRUE );
    ELSE
        Info( 'No re-compiles necessary' , TRUE );
    END;
    IF LnkOutOfSync THEN
        Info( 'Re-link of ' , FALSE );
        Info( MainFile , FALSE );
        Info( ' necessary' , TRUE );
    ELSE
        Info( 'No re-link necessary' , TRUE );
    END;
    IF ( Updating( 'l' ) )
       AND
       ( ( ModUpdated+DefUpdated > 0 ) OR ( LnkOutOfSync ) )
       AND
       ( RunType # Batch ) THEN
        cmd[ 0 ] := Null;
        ConcatString( cmd , LinkerName );
        ConcatString( cmd , ' ' );
        ConcatString( cmd , MainFile );
        ConcatString( cmd , ' ' );
        ConcatString( cmd , LinkerFlags );
        IF RunType = Xecute THEN
            InOut.WriteString( cmd );
            InOut.WriteLn;
        ELSIF RunType = Immediate THEN
            stdin := NIL;
            stdout := Open( ADR( 'CON:0/0/320/200/Link' ) , ModeNewFile );
            IF Execute( ADR( cmd ) , stdin , stdout ) THEN
            END;
            Close( stdout );
        ELSIF RunType = Show THEN
            Info( 'Linking:' , FALSE );Info( MainFile , TRUE );
        END;
    END;
END Link;

PROCEDURE CopyRight;
BEGIN
    Info( 'M2Make ' , FALSE );
    Info( CHAR( 0A9H ) , FALSE );
    Info( ' 1990 by Tim Coffey. All Rights Reserved.' , TRUE );
END CopyRight;

BEGIN
    MsgLevel := 1;
    ThisTask := FindTask( NIL );
    CopyRight;
    ProcessParms;
    CopyString( IndentChar , '          ' );
    UserIndex   :=  -1;
    LibIndex    :=  -1;
    DefUpdated := 0;
    ModUpdated := 0;
    LnkOutOfSync := FALSE;
    Alloc( UserFiles , TSIZE( UserFileArray )*UserSize*4 , MemPublic );
    Alloc( LibFiles , TSIZE( LibFileArray )*LibSize*4 , MemPublic );
    Alloc( FIB , TSIZE( FileInfoBlock ) , MemPublic );
    IndentNum := -1;
    NewLineLast := TRUE;
    IF NeedsUpdate( MainFile , ModExt , LnkExt ) THEN
    END;
    Link;
    Stop( 'Done' );
END M2Make.