-- FindBadModules.mesa  
-- Last modified by Sandman on 24-Feb-83 11:11:29

DIRECTORY
  BcdDefs,
  BcdOps,
  Environment,
  Exec,
  FileName,
  FileTransfer,
  Format,
  MSegment USING [Address, Create, Delete, Handle],
  MStream,
  PrincOps,
  Stream;

FindBadModules: PROGRAM
    IMPORTS Exec, FileName, FileTransfer, Format, MSegment, MStream, Stream =
  BEGIN
  
  BYTE: TYPE = PrincOps.BYTE;
  PrefixHandle: TYPE = PrincOps.PrefixHandle;
  BcdBase: TYPE = BcdOps.BcdBase;
  
  
  pagesPerBuffer: CARDINAL = 100;
  buffer: LONG POINTER;
  conn: FileTransfer.Connection _ NIL;
  execOut: Format.StringProc;
  exec: Exec.Handle;
  
  Run: Exec.ExecProc = {
    name, switches: LONG STRING _ NIL;
    pagesPerBuffer: Environment.PageCount = 100;
    bufferSegment: MSegment.Handle _ NIL;
    Finalize: PROC = {
      IF bufferSegment # NIL THEN {
        MSegment.Delete[bufferSegment];  bufferSegment _ buffer _ NIL};
      IF conn # NIL THEN {
        FileTransfer.Close[conn];  FileTransfer.Destroy[conn];  conn _ NIL};
      IF name # NIL THEN name _ Exec.FreeTokenString[name];
      IF switches # NIL THEN switches _ Exec.FreeTokenString[switches]};
    BEGIN
        ENABLE {
      ABORTED => GO TO aborted; 
      FileTransfer.Error --[code]-- => 
        SELECT code FROM
	  retry   => GOTO timedOut;
	  unknown => GOTO fileTransferProblem;
	  ENDCASE;
      UNWIND => Finalize[]};
    exec _ h;
    execOut _ Exec.OutputProc[h];
    bufferSegment _ MSegment.Create[pages: pagesPerBuffer, release: []];
    buffer _ MSegment.Address[bufferSegment];
    conn _ FileTransfer.Create[];
    FileTransfer.SetProcs[
      conn: conn, clientData: NIL, messages: PutMessages];
    DO
      [name, switches] _ Exec.GetToken[h];
      switches _ Exec.FreeTokenString[switches];
      IF name = NIL THEN EXIT;
      Collect[name];
      IF Exec.CheckForAbort[h] THEN {outcome _ abort; EXIT};
      ENDLOOP;
    outcome _ normal;
    EXITS
      aborted => {
        outcome _ abort;
        Format.CR[execOut];  Format.Line[execOut, "...aborted"L]};  
      timedOut => {
        outcome _ error;
        Format.CR[execOut];  Format.Line[execOut, "...connection timed out!"L]};  
      fileTransferProblem => {
        outcome _ error;
        Format.CR[execOut];
	Format.Line[execOut, "...unknown FileTransfer problem!"L]};  
    END; -- of ENABLE
    Finalize[]};
      
  PutMessages: FileTransfer.MessageProc = {
    IF level = fatal THEN { 
      execOut["Fatal error: "L];
      IF s1 # NIL THEN execOut[s1];
      IF s2 # NIL THEN execOut[s2];
      IF s3 # NIL THEN execOut[s3];
      IF s4 # NIL THEN execOut[s4]}};
    
  Collect: PROC [name: LONG STRING] = {
    OPEN FileTransfer;
    ENABLE Error => IF code = skip THEN CONTINUE;
    vfn: FileName.VFN _ FileName.AllocVFN[name];
    stream: Stream.Handle;
    stream _ ReadStream[conn, vfn ! UNWIND => FileName.FreeVFN[vfn]];
    WHILE stream # NIL DO
      ENABLE UNWIND => FileName.FreeVFN[vfn];
      stream.options.signalEndOfStream _ TRUE;
      Format.Char[execOut, '.];
      CheckFile[stream ! BadFile => {
        Format.Text[execOut, "\n*** "L];
	Format.Line[execOut, FileTransfer.GetStreamName[stream]];
	CONTINUE}];
      stream _ ReadNextStream[stream ! Error => IF code = skip THEN CONTINUE]
      ENDLOOP;
    FileName.FreeVFN[vfn]};
    
  CheckFile: PROC [stream: Stream.Handle] = {
    tooLong: BOOLEAN _ TRUE;
    bcd: BcdOps.BcdBase _ buffer;
    mtb, sgb: BcdDefs.Base;
    codebase: PrincOps.PrefixHandle;
    mth: BcdOps.MTHandle;
    sgh: BcdOps.SGHandle;
    IF Exec.CheckForAbort[exec] THEN ERROR ABORTED;
    [] _ Stream.GetBlock[
      stream, [buffer, 0, pagesPerBuffer*Environment.bytesPerPage] 
      ! Stream.EndOfStream => {tooLong _ FALSE;  CONTINUE}];
    IF ~tooLong THEN {
      bcd _ LOOPHOLE[buffer, BcdOps.BcdBase];
      IF bcd.versionIdent # BcdDefs.VersionID THEN GOTO obsoleteBcd;
      IF bcd.definitions THEN GOTO definitions;
      IF bcd.tableCompiled THEN GOTO tableCompiled;
      IF bcd.nConfigs # 0 THEN GOTO binderBcd;
      IF bcd.nPages > pagesPerBuffer THEN GOTO tooLong;
      mtb _ LOOPHOLE[bcd + bcd.mtOffset];
      mth _ @mtb[FIRST[BcdDefs.MTIndex]];
      sgb _ LOOPHOLE[bcd + bcd.sgOffset];
      sgh _ @sgb[mth.code.sgi];  -- Bcd's code segment table entry
      IF sgh.pages + sgh.base > pagesPerBuffer THEN GOTO tooLong;
      IF sgh.file # BcdDefs.FTSelf THEN GOTO punt;  -- tablecompiled, or ...
      codebase _ LOOPHOLE[buffer + (sgh.base-1)*Environment.wordsPerPage];
      sgh _ @sgb[mth.sseg];  -- Bcd's symbol segment table entry
      IF sgh.file # BcdDefs.FTSelf THEN GOTO punt;  -- tablecompiled, or ...
      IF sgh.pages + sgh.base > pagesPerBuffer THEN GOTO tooLong;
      IF mth.linkLoc # dontcare THEN ERROR BadFile};
    EXITS
      tooLong => {};
      definitions => {};
      tableCompiled => {};
      obsoleteBcd => {};
      binderBcd => {};
      punt => {}};
      
  BadFile: ERROR = CODE;
  
  -- MAIN BODY CODE
  
  Exec.AddCommand[name: "FindBadModules.~", proc: Run];
  
  END.