-- CheckFrames.mesa  
-- Last edited by Daniels on 10-Sep-82 15:48:48
-- Last edited by Sweet on  8-Jan-83 19:39:58

DIRECTORY
  BcdDefs USING [Base, FTSelf, MTIndex, VersionID],
  BcdOps USING [BcdBase, MTHandle, SGHandle],
  CatchFormat USING [CatchEV, CatchEVHandle, defaultFsi, nullCatchEV],
  Environment USING [Byte, bytesPerPage, PageCount, wordsPerPage],
  Exec USING [
    AddCommand, CheckForAbort, EndOfCommandLine, ExecProc, FreeTokenString,
    GetNameandPassword, GetToken, Handle, OutputProc],
  FileTransfer USING [
    ClientProc, Close, Connection, Create, Destroy, Error, FileInfo,
    GetStreamInfo, MessageProc, ReadNextStream, ReadStream, ResetVFN,
    SetPrimaryCredentials, SetProcs, VirtualFilename, VirtualFilenameObject],
  Format USING [
    Char, CR, Decimal, LongDecimal, Number, NumberFormat, StringProc, SubString],
  Heap USING [systemZone],
  Mopcodes USING [zJ2],
  PrincOps USING [FrameSizeIndex, FrameVec, FSIndex, MaxFrameSize, PrefixHandle],
  Profile USING [userName, userPassword],
  Space USING [
    Create, CreateUniformSwapUnits, Delete, Handle, LongPointer, Map, nullHandle,
    virtualMemory],
  Storage USING [CopyString],
  Stream USING [EndOfStream, GetBlock, Handle],
  String USING [InvalidNumber, StringToDecimal, SubString, SubStringDescriptor],
  Symbols,
  SymbolSegment USING [STHeader, VersionID];

CheckFrames: PROGRAM
  IMPORTS
    Exec, Heap, FileTransfer, Format, Profile, Space, Storage, Stream, String =
  BEGIN OPEN Symbols;
  
  z: UNCOUNTED ZONE _ Heap.systemZone;

  BYTE: TYPE = Environment.Byte;
  FrameSizeIndex: TYPE = PrincOps.FrameSizeIndex;

  exec: Exec.Handle _ NIL;
  conn: FileTransfer.Connection _ NIL;
  vfn: FileTransfer.VirtualFilename _ @vfnObject;
  vfnObject: FileTransfer.VirtualFilenameObject;

  buffer: LONG POINTER _ NIL;
  bufferPages: Environment.PageCount _ 100;
  bufferSpace: Space.Handle _ Space.nullHandle;
  last: CARDINAL = bufferPages*Environment.bytesPerPage;

  localFsi: FrameSizeIndex _ LAST[FrameSizeIndex];
  globalSize: [0..PrincOps.MaxFrameSize] _ PrincOps.MaxFrameSize;

  bcd: BcdOps.BcdBase _ NIL;
  mtb, sgb: BcdDefs.Base _ NIL;
  mth: BcdOps.MTHandle _ NIL;
  sgh: BcdOps.SGHandle _ NIL;

  symHeader: LONG POINTER TO SymbolSegment.STHeader _ NIL;
  ht: LONG POINTER TO ARRAY HTIndex OF HTRecord _ NIL;
  ssb: LONG STRING _ NIL;
  seb: Symbols.Base _ NIL;
  ctxb: Symbols.Base _ NIL;
  bb: Symbols.Base _ NIL;
  bbSize: CARDINAL _ 0;
  bti: Symbols.BTIndex;
  codebase: PrincOps.PrefixHandle;
  catchEV: CatchFormat.CatchEV;
  catchEntry: CatchFormat.CatchEVHandle _ NIL;
  FSSequence: TYPE = RECORD [
    firstCatch: CARDINAL, seq: SEQUENCE max: CARDINAL OF PrincOps.FSIndex];
  frameSizes: LONG POINTER TO FSSequence _ NIL;
  countProblems: CARDINAL _ 0;
  totalProblems, totalFiles, totalBad: LONG CARDINAL _ 0;
  
  showLocals: BOOLEAN _ FALSE;

  -- Exec window output
  execProc: Format.StringProc;

  PutCR: PROC = {Format.CR[execProc]};
  PutString: PROC [s: LONG STRING] = {execProc[s]};
  PutSubString: PROC [ss: String.SubString] = {Format.SubString[execProc, ss]};
  PutLine: PROC [s: LONG STRING] = {execProc[s]; Format.CR[execProc]};
  PutChar: PROC [c: CHARACTER] = {Format.Char[execProc, c]};
  PutDecimal: PROC [n: INTEGER] = {Format.Decimal[execProc, n]};
  PutLongDecimal: PROC [n: LONG INTEGER] = {Format.LongDecimal[execProc, n]};
  PutNumber: PROC [n: INTEGER, f: Format.NumberFormat] = {
    Format.Number[execProc, n, f]};
  
  LocalDatum: TYPE = RECORD[
    offset, length, nesting: CARDINAL, hti: Symbols.HTIndex];
  LocalDataSeq: TYPE = RECORD [length: CARDINAL, data: SEQUENCE maxLength: CARDINAL OF LocalDatum];
  LocalData: TYPE = LONG POINTER TO LocalDataSeq;
  
  localData: LocalData _ NIL;
  
  -- a few procs stolen from SymbolPack
  
  FirstCtxSe: PROC [ctx: Symbols.CTXIndex] RETURNS [Symbols.ISEIndex] = {
    RETURN [IF ctx = Symbols.CTXNull THEN Symbols.ISENull ELSE ctxb[ctx].seList]};

  NextSe: PROC [sei: Symbols.ISEIndex] RETURNS [Symbols.ISEIndex] = {
    OPEN Symbols;
    RETURN [
      IF sei = SENull
	THEN ISENull
	ELSE
	  WITH id: seb[sei] SELECT FROM
	    terminal => ISENull,
	    sequential => sei + SIZE[sequential id SERecord],
	    linked => id.link,
	    ENDCASE => ISENull]};
	    
  ArgRecord: PROC [type: CSEIndex] RETURNS [RecordSEIndex] = {
    RETURN [IF type = SENull
      THEN RecordSENull
      ELSE WITH seb[type] SELECT FROM
        record => LOOPHOLE[type, RecordSEIndex],
	ENDCASE => RecordSENull]};
	
  TransferTypes: PROC [type: SEIndex] RETURNS [typeIn, typeOut: RecordSEIndex] = {
    sei: CSEIndex = UnderType[type];
    WITH t: seb[sei] SELECT FROM
      transfer => RETURN [typeIn: t.inRecord, typeOut: t.outRecord];
      ENDCASE;
    RETURN [RecordSENull, RecordSENull]};

  UnderType: PROC [type: SEIndex] RETURNS [CSEIndex] = {
    sei: SEIndex _ type;
    WHILE sei # SENull DO
      WITH se: seb[sei] SELECT FROM
	id => {IF se.idType # typeTYPE THEN ERROR; sei _ se.idInfo};
	ENDCASE => EXIT;
      ENDLOOP;
    RETURN [LOOPHOLE[sei, CSEIndex]]};

  -- end of SymbolPack stuff

  PutLocals: PROC [root: Symbols.CBTIndex] = {
    OPEN Symbols;
    in, out: RecordSEIndex;
    nesting: CARDINAL _ 0;

    AddLocal: PROC [d: LocalDatum] = {
      j: CARDINAL;
      IF localData.length = localData.maxLength THEN {
        new: LocalData _ z.NEW[LocalDataSeq[localData.length + 30]];
	FOR i: CARDINAL IN [0..localData.length) DO
	  new[i] _ localData[i];
	  ENDLOOP;
	new.length _ localData.length;
	z.FREE[@localData];
	localData _ new};
      FOR j _ localData.length, j-1 WHILE j > 0 DO
        IF localData[j-1].offset <= d.offset THEN EXIT;
	localData[j] _ localData[j-1];
	ENDLOOP;
      localData[j] _ d;
      localData.length _ localData.length + 1};

    AddContext: PROC [ctx: Symbols.CTXIndex, nesting: CARDINAL _ 0] = {
      FOR sei: Symbols.ISEIndex _ FirstCtxSe[ctx], NextSe[sei] UNTIL sei = Symbols.ISENull DO
        IF ~seb[sei].constant THEN AddLocal[[
	  offset: seb[sei].idValue/16, 
	  length: seb[sei].idInfo/16,
	  nesting: nesting,
	  hti: seb[sei].hash]];
	ENDLOOP};
	
    EnumerateBodies: PROC [bti: BTIndex, nesting: CARDINAL _ 0] = {
      DO
        WITH b: bb[bti] SELECT FROM
          Callable => WITH bi: b SELECT FROM
	    Inner => AddLocal[[
	      offset: bi.frameOffset, length: 1, nesting: nesting, 
	      hti: seb[bi.id].hash]];
	    ENDCASE;
	  Other => {
	    AddContext[b.localCtx, nesting];
	    IF b.firstSon # BTNull THEN EnumerateBodies[b.firstSon, nesting+1]};
	  ENDCASE;
	IF bb[bti].link.which = parent THEN EXIT;
	bti _ bb[bti].link.index;
	ENDLOOP};
	  
    localData.length _ 0;
    [in, out] _ TransferTypes[bb[root].ioType];
    IF in # SENull THEN AddContext[seb[in].fieldCtx];
    IF out # SENull THEN AddContext[seb[out].fieldCtx];
    IF bb[root].localCtx # CTXNull THEN AddContext[bb[root].localCtx];
    IF bb[root].firstSon # BTNull THEN EnumerateBodies[bb[root].firstSon];
    FOR i: CARDINAL IN [0..localData.length) DO
      d: LocalDatum = localData[i];
      PutNumber[d.offset, Octal4];
      PutNumber[d.length, Octal6];
      THROUGH [0..d.nesting] DO PutChar[' ] ENDLOOP;
      PutHash[d.hti];
      PutCR[];
      ENDLOOP;
      
    };
    
  Octal4: Format.NumberFormat = [
    base: 8, unsigned: TRUE, zerofill: FALSE, columns: 4];
  Octal6: Format.NumberFormat = [
    base: 8, unsigned: TRUE, zerofill: FALSE, columns: 6];

  PutHash: PROC [hti: Symbols.HTIndex] = {
    ss: String.SubStringDescriptor;
    SubStringForHash[@ss, hti];
    PutSubString[@ss]};

  CheckFrames: Exec.ExecProc = {
    ENABLE {
      ABORTED => GO TO aborted;
      FileTransfer.Error --[code]-- =>
        SELECT code FROM
          login => {LoginUser[clientData: NIL]; RETRY};
          retry => GOTO timedOut;
          unknown => GOTO fileTransferProblem;
          ENDCASE;
      UNWIND => Finalize[]};
    exec _ h;
    execProc _ exec.OutputProc[];
    Initialize[];
    OpenConnection[];
    Check[];
    Finalize[];
    outcome _ normal;
    EXITS
      aborted => {outcome _ abort; Finalize[]; PutCR[]; PutLine["...aborted"L]};
      timedOut => {
        outcome _ error;
        Finalize[];
        PutCR[];
        PutLine["...connection timed out!"L]};
      fileTransferProblem => {
        outcome _ error;
        Finalize[];
        PutCR[];
        PutLine["...unknown FileTransfer problem!"L]}};

  Initialize: PROC = {
    PutHeading[];
    localFsi _ LAST[FrameSizeIndex];
    globalSize _ PrincOps.MaxFrameSize;
    conn _ NIL;
    vfnObject _ FileTransfer.VirtualFilenameObject[
      host: NIL, directory: NIL, name: NIL, version: NIL];
    vfn _ @vfnObject;
    bufferSpace _ Space.Create[size: bufferPages, parent: Space.virtualMemory];
    totalFiles _ totalProblems _ totalBad _ 0;
    Space.Map[bufferSpace];
    Space.CreateUniformSwapUnits[parent: bufferSpace, size: 4];
    buffer _ Space.LongPointer[bufferSpace];
    localData _ z.NEW[LocalDataSeq[100]]};

  Finalize: PROC = {
    IF bufferSpace # Space.nullHandle THEN {
      Space.Delete[bufferSpace]; bufferSpace _ Space.nullHandle; buffer _ NIL};
    IF localData # NIL THEN z.FREE[@localData];
    IF frameSizes # NIL THEN Heap.systemZone.FREE[@frameSizes];
    FileTransfer.ResetVFN[vfn: vfn, h: TRUE, d: TRUE, n: TRUE, v: TRUE];
    CloseConnection[]};

  PutHeading: PROC = {PutCR[]; PutLine["Frame Size Checker"L]; PutCR[]};

  OpenConnection: PROC = {
    conn _ FileTransfer.Create[];
    conn.SetProcs[clientData: NIL, messages: PutMessages, login: LoginUser];
    conn.SetPrimaryCredentials[
      user: Profile.userName, password: Profile.userPassword];
    };
    
  PutMessages: FileTransfer.MessageProc = {
    IF level = fatal THEN {
      PutString["Fatal error: "L];
      IF s1 # NIL THEN PutString[s1];
      IF s2 # NIL THEN PutString[s2];
      IF s3 # NIL THEN PutString[s3];
      IF s4 # NIL THEN PutString[s4]}};

  LoginUser: FileTransfer.ClientProc --[clientData: LONG POINTER]--  = {
    user: STRING = [40];
    password: STRING = [40];
    exec.GetNameandPassword[user, password];
    conn.SetPrimaryCredentials[user: user, password: password]};

  CloseConnection: PROC = {
    IF conn # NIL THEN {conn.Close[]; conn.Destroy[]; conn _ NIL}};

  verbose: BOOLEAN _ FALSE;

  Check: PROC = {
    ENABLE FileTransfer.Error => IF code = skip THEN CONTINUE;
    stream: Stream.Handle _ NIL;
    token, switches: LONG STRING;
    FileTransfer.ResetVFN[vfn: vfn, h: TRUE, d: TRUE, n: TRUE, v: FALSE];
    [token: token, switches: switches] _ exec.GetToken[];
    vfn.host _ Storage.CopyString[token];
    [] _ Exec.FreeTokenString[token];
    [] _ Exec.FreeTokenString[switches];
    [token: token, switches: switches] _ exec.GetToken[];
    vfn.directory _ Storage.CopyString[token];
    verbose _ FALSE;
    IF switches # NIL AND switches.length # 0 THEN
      FOR n: CARDINAL IN [0..switches.length) DO
        SELECT switches[n] FROM 
          'v, 'V => verbose _ TRUE;
	  'a, 'A => showLocals _ TRUE;
	  ENDCASE;
	ENDLOOP;
    [] _ Exec.FreeTokenString[token];
    [] _ Exec.FreeTokenString[switches];
    vfn.name _ Storage.CopyString["*.bcd"L];
    UNTIL exec.EndOfCommandLine[] DO
      valid: BOOLEAN _ TRUE;
      num: CARDINAL;
      [token, switches] _ exec.GetToken[];
      IF token # NIL THEN
        num _ String.StringToDecimal[
          token ! String.InvalidNumber => {valid _ FALSE; CONTINUE}];
      IF valid AND switches # NIL AND switches.length # 0 THEN
        SELECT switches[0] FROM
          'l, 'L => localFsi _ GetFsi[num];
          'g, 'G => globalSize _ num;
          ENDCASE;
      [] _ Exec.FreeTokenString[token];
      [] _ Exec.FreeTokenString[switches];
      ENDLOOP;
    PutString["Checking for local frames >= "L];
    PutDecimal[PrincOps.FrameVec[localFsi]];
    PutString[", global frames >= "L];
    PutDecimal[globalSize];
    PutLine["..."L];
    stream _ conn.ReadStream[vfn, NIL, FALSE, remote];
    WHILE stream # NIL DO
      stream.options.signalEndOfStream _ TRUE;
      CheckFile[stream];
      stream _ FileTransfer.ReadNextStream[stream]
      ENDLOOP;
    FileTransfer.ResetVFN[vfn: vfn, h: TRUE, d: TRUE, n: TRUE, v: TRUE];
    PutCR[];
    PutCR[];
    PutLongDecimal[totalBad];
    PutString[" files out of "L];
    PutLongDecimal[totalFiles];
    PutString[" had "L];
    PutLongDecimal[totalProblems];
    PutLine[" problems"L]};

  CheckFile: PROC [stream: Stream.Handle] = {
    source: FileTransfer.FileInfo;
    tooLong: BOOLEAN _ TRUE;
    IF exec.CheckForAbort[] THEN ERROR ABORTED;
    source _ FileTransfer.GetStreamInfo[stream];
    IF (((totalFiles _ totalFiles + 1) MOD 10) = 0) OR verbose THEN {
      IF ~verbose THEN {
        PutString["  Checking file "L];
        PutLongDecimal[totalFiles];
        PutString[": "L]};
      PutLine[source.body]};
    [] _ stream.GetBlock[
      [buffer, 0, last] ! Stream.EndOfStream => {tooLong _ FALSE; CONTINUE}];
    IF ~tooLong THEN {
      bcd _ LOOPHOLE[buffer, BcdOps.BcdBase];
      IF bcd.versionIdent # BcdDefs.VersionID THEN GOTO obsoleteBcd;
      IF bcd.nConfigs # 0 THEN GOTO binderBcd;
      IF bcd.nPages > bufferPages 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 > bufferPages THEN GOTO tooLong;
      IF mth.tableCompiled OR sgh.file # BcdDefs.FTSelf THEN GOTO punt;  -- tablecompiled, or ...
      codebase _ LOOPHOLE[buffer + (sgh.base - 1)*Environment.wordsPerPage];
      codebase _ codebase + mth.code.offset;
      catchEV _ LOOPHOLE[codebase.entry[codebase.header.nEntries]/2];
      catchEntry _ @codebase[catchEV];
      sgh _ @sgb[mth.sseg];  -- Bcd's symbol segment table entry
      IF sgh.base + sgh.pages > bufferPages THEN GOTO tooLong;
      IF sgh.file # BcdDefs.FTSelf THEN GOTO punt;  -- tablecompiled, or ...
      symHeader _ LOOPHOLE[buffer + (sgh.base - 1)*Environment.wordsPerPage];
      IF symHeader.versionIdent # SymbolSegment.VersionID THEN GOTO badSymbols;
      bb _ LOOPHOLE[symHeader + symHeader.bodyBlock.offset];
      IF (bbSize _ symHeader.bodyBlock.size) = 0 THEN GOTO punt;
      ht _ LOOPHOLE[symHeader + symHeader.htBlock.offset];
      ssb _ LOOPHOLE[symHeader + symHeader.ssBlock.offset];
      seb _ LOOPHOLE[symHeader + symHeader.seBlock.offset];
      ctxb _ LOOPHOLE[symHeader + symHeader.ctxBlock.offset];
      IF symHeader.seBlock.size = 0 THEN GOTO punt;
      GetFrameSizes[];
      bti _ FIRST[Symbols.BTIndex];
      countProblems _ 0;
      IF mth.framesize >= globalSize THEN {
        IF verbose THEN PutString["    "L]
        ELSE {PutString[source.body]; PutString[", "L]};
        PutString["gf size = "L];
        PutDecimal[mth.framesize];
        PutCR[];
        countProblems _ 1};
      UNTIL LOOPHOLE[bti, CARDINAL] >= bbSize DO
        ok: BOOLEAN;
        ss: String.SubStringDescriptor;
        WITH b: bb[bti] SELECT FROM
          Callable => {
            WITH bi: b.info SELECT FROM
              External => ok _ ~b.inline;
              ENDCASE => ok _ FALSE;
            IF ok THEN
              WITH b SELECT FROM
                Outer, Inner =>
                  IF frameSizes[b.entryIndex] > localFsi THEN {
                    IF countProblems = 0 AND ~verbose THEN PutLine[source.body];
                    countProblems _ countProblems + 1;
                    IF b.entryIndex = 0 THEN ss _ ["MAIN"L, 0, ("MAIN"L).length]
                    ELSE SubStringForHash[@ss, seb[b.id].hash];
                    PutString["    "];
                    PutSubString[@ss];
                    PutString[", frame size = "];
                    PutDecimal[PrincOps.FrameVec[frameSizes[b.entryIndex]]];
                    PutCR[];
		    IF showLocals THEN PutLocals[LOOPHOLE[bti]]};
                Catch => {
                  IF catchEV = CatchFormat.nullCatchEV THEN GOTO punt;
                  IF frameSizes[index + frameSizes.firstCatch] > localFsi THEN {
                    IF countProblems = 0 AND ~verbose THEN PutLine[source.body];
                    countProblems _ countProblems + 1;
                    PutString["    CATCH["L];
                    PutDecimal[index];
                    PutString["], frame size = "L];
                    PutDecimal[
                      PrincOps.FrameVec[
                      frameSizes[index + frameSizes.firstCatch]]];
                    PutCR[]}};
                ENDCASE;
            WITH b SELECT FROM
              Outer => bti _ bti + SIZE[Outer Callable BodyRecord];
              Inner => bti _ bti + SIZE[Inner Callable BodyRecord];
              Catch => bti _ bti + SIZE[Catch Callable BodyRecord];
              ENDCASE};
          Other => bti _ bti + SIZE[Other BodyRecord];
          ENDCASE;
        ENDLOOP;
      IF frameSizes # NIL THEN Heap.systemZone.FREE[@frameSizes];
      IF countProblems # 0 THEN {
        totalProblems _ totalProblems + countProblems; totalBad _ totalBad + 1}};
    EXITS
      tooLong => {};
      obsoleteBcd => {};
      binderBcd => {};
      punt => {};
      badSymbols => {}};

  GetFsi: PROC [frameSize: CARDINAL] RETURNS [FrameSizeIndex] = {
    FOR fsi: FrameSizeIndex DECREASING IN FrameSizeIndex DO
      IF frameSize >= PrincOps.FrameVec[fsi] THEN RETURN[fsi];
      REPEAT FINISHED => RETURN[0]
      ENDLOOP};

  GetFrameSizes: PROC = {
    nEntries: CARDINAL = codebase.header.nEntries;
    code: LONG POINTER TO PACKED ARRAY [0..0) OF BYTE = LOOPHOLE[codebase];
    frameSizes _ Heap.systemZone.NEW[
      FSSequence [nEntries + catchEntry.count] _ [
      firstCatch: nEntries, seq: NULL]];
    FOR i: CARDINAL IN [0..nEntries) DO
      frameSizes[i] _ code[codebase.entry[i].pc] ENDLOOP;
    IF catchEV # CatchFormat.nullCatchEV THEN
      FOR i: CARDINAL IN [0..catchEntry.count) DO
        frameSizes[i + frameSizes.firstCatch] _
          IF code[catchEntry[i]] = Mopcodes.zJ2 THEN code[catchEntry[i] + 1]
          ELSE CatchFormat.defaultFsi;
        ENDLOOP;
    };

  SubStringForHash: PROC [s: String.SubString, hti: HTIndex] = {
    s.base _ ssb;
    IF hti = HTNull THEN s.offset _ s.length _ 0
    ELSE s.length _ ht[hti].ssIndex - (s.offset _ ht[hti - 1].ssIndex)};

  -- User niceness

  CheckHelp: Exec.ExecProc = {
    h.OutputProc[][
      "This command takes all bcds on a remote directory and looks for procedures with a local frame size greater than some given size.  It can also do the same for global frames.  The command line format is
    
    	CheckFrames.~ host dir localSize/l globalSize/g"L]};

  -- MAIN BODY CODE

  RegisterSelf: PROC = {
    Exec.AddCommand[name: "CheckFrames.~"L, proc: CheckFrames, help: CheckHelp]};

  RegisterSelf[];

  END.