-- file: CodeCompare.mesa 
-- Edited by: Loretta, 24-Feb-81 18:45:50  
-- Edited by: Satterthwaite, November 26, 1985 1:01:40 pm PST  
  
DIRECTORY
  Basics: TYPE USING [bytesPerWord],
  BasicTime: TYPE USING [FromNSTime], 
  BcdDefs: TYPE USING [Base, BCD, BcdBase, MTHandle, MTRecord, SGHandle, VersionStamp],
  Commander: TYPE USING [CommandProc, Handle, Register],
  Convert: TYPE USING [IntFromRope],
  FS: TYPE USING [Error, StreamOpen], 
  IO: TYPE USING [
    STREAM, card, Close, Error, GetChar, Put, PutChar, PutRope, rope, time, UnsafeGetBlock],
  Loader: TYPE USING [BCDBuildTime],
  Rope: TYPE USING [ROPE, Cat, Fetch, Length, Substr],
  VM: TYPE USING [
    Interval, AddressForPageNumber, Allocate, Free, PagesForWords, wordsPerPage];
      
CodeCompare: CEDAR PROGRAM
    IMPORTS BasicTime, Commander, Convert, FS, IO, Loader, Rope, VM = {
  
  bytesPerWord: CARDINAL = Basics.bytesPerWord;
  bytesPerPage: CARDINAL = bytesPerWord*VM.wordsPerPage;

  MaxDiffs: CARDINAL _ 20;
  bufferPages: NAT = 20;
  bufferSize: CARDINAL = bufferPages*VM.wordsPerPage;
  block1, block2: VM.Interval;
  hBlock: VM.Interval;

-- Utilities

  CompareStreams: PROC[
        log, stream1, stream2: IO.STREAM, length1, length2: CARDINAL]
      RETURNS[BOOL] = TRUSTED {
    buffer1: LONG POINTER = VM.AddressForPageNumber[block1.page];
    buffer2: LONG POINTER = VM.AddressForPageNumber[block2.page];
    bufcount1, bufcount2: CARDINAL _ 0;
    code1, code2: LONG POINTER TO ARRAY [0..bufferSize) OF WORD;

    BuffersFilled: PROC[f1, f2: IO.STREAM, l1, l2: CARDINAL] RETURNS[BOOL] = TRUSTED {
      IF MIN[l1, l2] = 0 THEN RETURN[FALSE];
      SELECT bufcount1 FROM
       = bufcount2 => {
          code1 _ buffer1;
          code2 _ buffer2;
          bufcount1 _ f1.UnsafeGetBlock[[base~buffer1, startIndex~0, count~l1*bytesPerWord]]; 
          bufcount2 _ f2.UnsafeGetBlock[[base~buffer2, startIndex~0, count~l2*bytesPerWord]];
          bufcount1 _ bufcount1/bytesPerWord;
          bufcount2 _ bufcount2/bytesPerWord;
          RETURN[MIN[bufcount1, bufcount2] # 0]};
       > bufcount2 => {
          code1 _ buffer1;
          code2 _ code2+bufcount1; --change array origin
          bufcount2 _ bufcount2 - bufcount1;
          bufcount1 _ f1.UnsafeGetBlock[[base~buffer1, startIndex~0, count~l1*bytesPerWord]]; 
          bufcount1 _ bufcount1/bytesPerWord;
          RETURN[bufcount1 # 0]};
       < bufcount2 => {
          code1 _ code1+bufcount2; --change array origin
          code2 _ buffer2;
          bufcount1 _ bufcount1 - bufcount2;
          bufcount2 _ f2.UnsafeGetBlock[[base~buffer2, startIndex~0, count~l2*bytesPerWord]]; 
          bufcount2 _ bufcount2/bytesPerWord;
          RETURN[bufcount2 # 0]};
       ENDCASE;
      RETURN[FALSE]};

    PutOctal: PROC[n: CARDINAL, columns: NAT, last: BOOL_TRUE] = CHECKED {
      IF columns > 1 THEN PutOctal[n/8, columns-1, FALSE];
      log.PutChar[IF ~last AND n=0 THEN '  ELSE VAL['0.ORD + (n MOD 8)]]};

    difcount: NAT _ 0;
    WHILE BuffersFilled[stream1, stream2, length1, length2] DO
      length1 _ length1 - bufcount1; length2 _ length2 - bufcount2;
      FOR i: CARDINAL IN [0..MIN[bufcount1, bufcount2]) DO
        IF code1[i] # code2[i] THEN {
          w: RECORD[left, right: [0..0FFh]];
          PutOctal[i, 8];
          PutOctal[code1[i], 8];
          log.PutChar['[]; 
          w _ LOOPHOLE[code1[i]];
          PutOctal[w.left, 3]; log.PutChar[',]; PutOctal[w.right, 3];
          log.PutChar[']];
          PutOctal[code2[i], 8];
          log.PutChar['[];
          w _ LOOPHOLE[code2[i]];
          PutOctal[w.left, 3]; log.PutChar[',]; PutOctal[w.right, 3];
          log.PutChar[']];
          log.PutChar['\n];
          IF difcount = MaxDiffs THEN { 
            log.PutRope["Too many differences encountered. Quitting.\n"];
            GOTO quit};
          difcount _ difcount + 1};
        ENDLOOP;
        REPEAT quit => NULL;
      ENDLOOP;

    IF difcount = MaxDiffs THEN log.PutRope["More than "];
    log.Put[IO.card[difcount], IO.rope[" differences\n"]];
    RETURN[difcount = 0]};

  Config: SIGNAL = CODE;
  NoCode: SIGNAL = CODE;

  FindCode: PROC[stream: IO.STREAM, block: VM.Interval] RETURNS[
    codeCount: CARDINAL, dateStamp, sourceStamp: BcdDefs.VersionStamp] = TRUSTED {
    -- positions stream to start of code
    -- FindCode returns size in words (codeCount)
    OPEN BcdDefs;
    ENABLE
      UNWIND => {NULL};
    buf: LONG POINTER _ VM.AddressForPageNumber[block.page];
    header: BcdBase = LOOPHOLE[VM.AddressForPageNumber[hBlock.page]];
    streamPos: INT;
    sgPointer: BcdDefs.Base;
    mtPos, sgPos: CARDINAL;
    codeBase: CARDINAL;
    mOffset: CARDINAL;
    mth: BcdDefs.MTHandle;
    sgh: BcdDefs.SGHandle;

    AdvanceStream: PROC [newPos: INT] = TRUSTED {
      -- positions stream to byte position newPos
      incr: INT;
      WHILE newPos > streamPos DO
        incr _ stream.UnsafeGetBlock[block~[buf, 0, MIN[bufferSize, newPos-streamPos]]];
        streamPos _ streamPos + incr;
        ENDLOOP
      };

    streamPos _ stream.UnsafeGetBlock[[LOOPHOLE[header], 0, BCD.SIZE*bytesPerWord]];
    -- get module table, which contains index of code segment, 
    -- starting offset in segment (in words) 
    -- and length of code (in bytes)
    IF header.nConfigs > 0 THEN SIGNAL Config;
    mtPos _ header.mtOffset*bytesPerWord;
    sgPos _ header.sgOffset*bytesPerWord;
    dateStamp _ header.version;
    sourceStamp _ header.sourceVersion;
    IF mtPos < sgPos THEN { 
     -- read module table first, record fields, then overwrite with segment table
      AdvanceStream[mtPos];
      mth _ LOOPHOLE[buf, BcdDefs.MTHandle];
      AdvanceStream[mtPos + LOOPHOLE[header.mtLimit,CARDINAL]*bytesPerWord];
      mOffset _ mth.code.offset;
      codeCount _ mth.code.length;
      sgPos _ sgPos + LOOPHOLE[mth.code.sgi,CARDINAL]*bytesPerWord;
      AdvanceStream[sgPos];
      sgh _ LOOPHOLE[buf, BcdDefs.SGHandle];
      AdvanceStream[sgPos + LOOPHOLE[header.sgLimit,CARDINAL]*bytesPerWord]}
    ELSE { 
     -- must read segment table before module table, but don't know which part of 
     --segment table! store segment table in first part of buffer, advance buffer 
     -- pointer to read module table behind it, access both at once
      AdvanceStream[sgPos];
      sgPointer _ LOOPHOLE[buf,BcdDefs.Base];
      AdvanceStream[sgPos + LOOPHOLE[header.sgLimit,CARDINAL]*bytesPerWord];
      buf _ LOOPHOLE[LOOPHOLE[buf,LONG CARDINAL] +
                     LOOPHOLE[header.sgLimit,CARDINAL],LONG POINTER];
      AdvanceStream[mtPos];
      mth _ LOOPHOLE[buf, BcdDefs.MTHandle];
      AdvanceStream[mtPos + LOOPHOLE[header.mtLimit,CARDINAL]*bytesPerWord];
      sgh _ @sgPointer[mth.code.sgi];
      mOffset _ mth.code.offset;
      codeCount _ mth.code.length};
    IF codeCount = 0 THEN SIGNAL NoCode;
  -- compute starting address of code (StreamPosition)
    codeBase _ (sgh.base-1)*bytesPerPage + mOffset*bytesPerWord;
    AdvanceStream[codeBase];
  -- round codeCount up to nearest work boundary and convert to word count
    IF codeCount MOD 2 # 0 THEN codeCount _ codeCount + 1;
    codeCount _ codeCount/bytesPerWord;
    RETURN};

  ForceBCDExtension: PROC[name: Rope.ROPE] RETURNS[Rope.ROPE] = {
    root: Rope.ROPE;
    FOR i: INT IN [0..name.Length) DO
      IF name.Fetch[i] = '. THEN {root _ name.Substr[0, i]; EXIT};
      REPEAT
        FINISHED => root _ name;
      ENDLOOP;
    RETURN[root.Cat[".bcd"]]};


  DoCompares: PROC[commands: Rope.ROPE, log: IO.STREAM]  RETURNS[BOOL] = {
    differences: BOOL _ FALSE;
    name, remoteName: Rope.ROPE;

    PrintDirectories: PROC = {
      log.PutRope["\n* Local directory: "]; log.PutRope[localDir];
      log.PutRope["\n* Remote directory: "]; log.PutRope[remoteDir];
      log.PutChar['\n]};

    PrintVersion: PROC[stamp: BcdDefs.VersionStamp] = {
      stampWords: CARDINAL = BcdDefs.VersionStamp.SIZE;
      str: PACKED ARRAY [0..4*stampWords) OF [0..16) = LOOPHOLE[stamp];
      digit: PACKED ARRAY [0..15] OF CHAR =
        ['0, '1, '2, '3, '4, '5, '6, '7, '8, '9, 'a, 'b, 'c, 'd, 'e, 'f];
      FOR i: CARDINAL IN [0..4*stampWords) DO
        log.PutChar[digit[str[i]]] ENDLOOP
      };
  
    ProcessSwitches: PROC[switches: Rope.ROPE] = {
      IF switches.Length > 1 THEN
        SELECT switches.Fetch[1] FROM
          'c,'C => {
              lName, rName: Rope.ROPE;
              [lName, rName] _ GetToken[];
              IF lName.Length # 0 THEN localDir _ lName;
              IF rName.Length # 0 THEN remoteDir _ rName;
              PrintDirectories[]};
          'm,'M => MaxDiffs _ Convert.IntFromRope[GetToken[].token];
          ENDCASE;
        };
  
    TrimFileName: PROC[name: Rope.ROPE] RETURNS[Rope.ROPE] = {
      first: INT _ 0;
      IF name.Fetch[0] = '< THEN {
        i: INT _ name.Length - 1;
        WHILE i > 0 DO
          IF name.Fetch[i] = '> THEN {
            i _ i+1;
            RETURN[name.Substr[i, name.Length-i]]};
          i _ i - 1;
          ENDLOOP;
        RETURN[NIL]};
      RETURN[name]};
  
    cI: INT _ 0;
    cLength: INT = commands.Length;
    
    GetToken: PROC RETURNS[token, altToken: Rope.ROPE_NIL] = {
      colon: BOOL _ FALSE;
      start: INT _ cI;
      c: CHAR;
  
      Get: PROC RETURNS[c: CHAR] = INLINE { 
        IF cI >= cLength THEN c _ '\000
        ELSE {c _ commands.Fetch[cI];  cI _ cI+1};
        RETURN};
  
      WHILE (c _ Get[]) # '\000 DO
        SELECT c FROM
          ' , '\n =>
            IF cI = start+1 THEN start _ cI
            ELSE {
              IF colon THEN altToken _ commands.Substr[start, cI-start-1]
              ELSE token _ commands.Substr[start, cI-start-1];
              RETURN};
          ': => {
            token _ commands.Substr[start, cI-start-1];
            colon _ TRUE;  start _ cI};
          ENDCASE => NULL;
        ENDLOOP;
      RETURN};

    WriteError: PROC[s: Rope.ROPE] = {
      differences _ TRUE; log.PutRope[s]; log.PutChar['\n]};
    
    localDir, remoteDir: Rope.ROPE _ NIL;  
    oldStream, newStream: IO.STREAM _ NIL;
    oldSize, newSize: CARDINAL;
    
    block1 _ VM.Allocate[bufferPages];
    block2 _ VM.Allocate[bufferPages];
    hBlock _ VM.Allocate[VM.PagesForWords[BcdDefs.BCD.SIZE]];

    [localDir,  remoteDir] _ GetToken[];
    IF remoteDir.Length = 0 THEN remoteDir _ localDir;
    PrintDirectories[];
    DO
      BEGIN     
      ENABLE {
        UNWIND => TRUSTED { --give buffers back
          VM.Free[block1]; VM.Free[block2]; VM.Free[hBlock]};
        Config => {
          log.PutRope["Bound configuration; not a module."];
          newStream.Close[]; oldStream.Close[]; 
          LOOP};
        NoCode => {
          log.PutRope["No code!"];
          newStream.Close[]; oldStream.Close[]; 
          LOOP}
        };
      -- IF TTY.UserAbort[] THEN {log.PutRope[" ...aborted."]; TTY.ResetUserAbort[]; EXIT};
      [name, remoteName] _ GetToken[];
      IF name.Length = 0 THEN EXIT;
      IF name.Fetch[1] = '- THEN ProcessSwitches[name]
      ELSE {
        version, sourceVersion: BcdDefs.VersionStamp;
        log.PutChar['\n];
        name _ ForceBCDExtension[TrimFileName[name]];
        log.PutRope["Comparing "];  log.PutRope[name];
        IF remoteName.Length # 0 THEN {
          remoteName _ ForceBCDExtension[TrimFileName[remoteName]];
          log.PutRope[" to "];  log.PutRope[remoteName]}
        ELSE remoteName _ name;
        log.PutRope["... "];
        oldStream _ FS.StreamOpen[localDir.Cat[name] 
                      ! FS.Error => {
                          IF error.group # $bug THEN {
                            log.PutRope["No local file.\n"]; GOTO problems}}];
        newStream _ FS.StreamOpen[remoteDir.Cat[remoteName]
                      ! FS.Error => {
                          oldStream.Close[];
                          IF error.group # $bug THEN {
                            log.PutRope["No remote file.\n"]; GOTO problems}}];
        log.PutChar['\n];

          BEGIN
          ENABLE
            IO.Error => {
              log.PutRope["Error on local file: "];  log.PutRope[name];  log.PutChar['\n];
              newStream.Close[];  oldStream.Close[]; 
              GOTO problems};
          [oldSize, version, sourceVersion] _ FindCode[oldStream, block1];
          log.PutRope["Local:  "];  PrintVersion[version];
          log.Put[IO.rope[" (from "], IO.time[BasicTime.FromNSTime[sourceVersion.time]]];
          log.PutRope[", "];
          log.Put[IO.card[oldSize], IO.rope[" words)\n"]];
          END;
    
          BEGIN
          ENABLE
            IO.Error => {
              log.PutRope["Error on remote file: "];  log.PutRope[remoteName];  log.PutChar['\n];
              newStream.Close[];  oldStream.Close[]; 
              GOTO problems};
          [newSize, version, sourceVersion] _ FindCode[newStream, block2];
          log.PutRope["Remote: "];  PrintVersion[version];
          log.Put[IO.rope[" (from "], IO.time[BasicTime.FromNSTime[sourceVersion.time]]];
          log.PutRope[", "];
          log.Put[IO.card[newSize], IO.rope[" words)\n"]];
          END;

          BEGIN
          ENABLE IO.Error => {GOTO problems};
          IF ~CompareStreams[log, oldStream,newStream, oldSize,newSize] THEN
            differences _ TRUE;
          END;
    
        oldStream.Close[];  newStream.Close[]};
      EXITS
        problems => differences _ TRUE;
      END;
      ENDLOOP;

    --give buffers back
    TRUSTED {VM.Free[block1]; VM.Free[block2]; VM.Free[hBlock]};
    RETURN[differences]};


  Compare: Commander.CommandProc = {
    differences: BOOL;
    (cmd.out).Put[IO.rope["Cedar 6.0 Code Compare of "], IO.time[Loader.BCDBuildTime[]]];
    (cmd.out).PutChar['\n];
    differences _ DoCompares[cmd.commandLine, cmd.out
        ! IO.Error => {differences _ TRUE; CONTINUE}];
    (cmd.out).PutChar['\n];
    IF differences THEN {
      (cmd.out).PutRope["Differences or problems noted. Type any character to exit.\n"];
      [] _ (cmd.in).GetChar[]}
    ELSE (cmd.out).PutRope["No differences detected.\n"]};
      
  Init: PROC = {Commander.Register["CodeCompare", Compare]};

  Init[];
  
  }.
  
