-- file ListerUtilities.mesa 
-- last edited by Satterthwaite on September 15, 1982 5:36 pm

DIRECTORY
  Alloc: TYPE USING [Base, Handle, Notifier, Selector],
  BcdDefs: TYPE,
  BcdOps: TYPE USING [BcdBase, NameString],
  CharIO: TYPE USING [PutChar, PutNumber, PutString, PutSubString],
  Environment: TYPE USING [PageCount],
  Exec: TYPE USING [w],
  File: TYPE USING [Capability, nullCapability],
  FileSegment: TYPE USING [Pages, nullPages],
  FileStream: TYPE USING [Create],
  Format: TYPE USING [NumberFormat],
  Heap: TYPE USING [systemZone],
  ListerUtil: TYPE USING [],
  OSMiscOps: TYPE USING [FileError, FindFile],
  Space: TYPE USING [
    Handle, nullHandle, virtualMemory, Create, Delete, LongPointer, Map],
  Stream: TYPE USING [
    DeleteProcedure, Handle, Object, PutByteProcedure, defaultObject],
  Strings: TYPE USING [
    AppendChar, AppendString, AppendSubString, EquivalentSubStrings,
    String, SubString, SubStringDescriptor],
  Symbols: TYPE USING [
    bodyType, ctxType, HTIndex, HTNull, htType, ISEIndex, mdType,
    SENull, seType, ssType],
  SymbolSegment: TYPE USING [Base, extType, ltType, treeType, Tables],
  SymbolTable: TYPE USING [Base],
  Time: TYPE USING [Append, Unpack],
  TTY: TYPE USING [PutChar];

ListerUtilities: PROGRAM
  IMPORTS 
    CharIO, Exec, FileStream, Heap, OSMiscOps, Space, Stream, Strings, Time, TTY
  EXPORTS Alloc, ListerUtil = { 
  
  UnknownModule: PUBLIC ERROR = CODE;
  version, creator, source: BcdDefs.VersionStamp;
  filename: Strings.String;
  
  symbols: SymbolTable.Base;
  bases: PRIVATE ARRAY SymbolSegment.Tables OF Alloc.Base;
  
  SetRoutineSymbols: PUBLIC PROC [s: SymbolTable.Base] = {
    OPEN s.stHandle;
    symbase: SymbolSegment.Base _ LOOPHOLE[s.stHandle];
    symbols _ s;
    bases[SymbolSegment.treeType] _ symbase + treeBlock.offset;
    bases[Symbols.seType] _ symbase + seBlock.offset;
    bases[Symbols.htType] _ symbase + htBlock.offset;
    bases[Symbols.ssType] _ symbase + ssBlock.offset;
    bases[Symbols.ctxType] _ symbase + ctxBlock.offset;
    bases[Symbols.mdType] _ symbase + mdBlock.offset;
    bases[Symbols.bodyType] _ symbase + bodyBlock.offset;
    bases[SymbolSegment.ltType] _ symbase + litBlock.offset;
    bases[SymbolSegment.extType] _ symbase + extBlock.offset;
    UpdateBases[]};
    
  NotifyLink: TYPE = LONG POINTER TO NotifyNode;
  NotifyNode: TYPE = RECORD [notifier: Alloc.Notifier, link: NotifyLink];
  
  notifyList: NotifyLink _ NIL;
  
  AddNotify: PUBLIC PROC [h: Alloc.Handle, proc: Alloc.Notifier] = {
    p: NotifyLink =
      (Heap.systemZone).NEW[NotifyNode _ [notifier: proc, link: notifyList]];
    notifyList _ p;
    proc[DESCRIPTOR[bases]]};
    
  DropNotify: PUBLIC PROC [h: Alloc.Handle, proc: Alloc.Notifier] = {
    p, q: NotifyLink;
    IF notifyList = NIL THEN RETURN;
    p _ notifyList;
    IF p.notifier = proc THEN notifyList _ p.link
    ELSE {
      DO
	q _ p;
	p _ p.link;
	IF p = NIL THEN RETURN;
	IF p.notifier = proc THEN EXIT
	ENDLOOP;
      q.link _ p.link};
    (Heap.systemZone).FREE[@p]};
    
  UpdateBases: PROC = {
    FOR p: NotifyLink _ notifyList, p.link UNTIL p = NIL DO
      p.notifier[DESCRIPTOR[bases]] ENDLOOP};
    
  Bounds: PUBLIC PROC [h: Alloc.Handle, table: Alloc.Selector]
      RETURNS [base: Alloc.Base, size: CARDINAL] = {
    OPEN symbols.stHandle;
    RETURN [bases[table], SELECT table FROM
      SymbolSegment.treeType => treeBlock.size,
      Symbols.seType => seBlock.size,
      Symbols.htType => htBlock.size,
      Symbols.ssType => ssBlock.size,
      Symbols.ctxType => ctxBlock.size,
      Symbols.mdType => mdBlock.size,
      Symbols.bodyType => bodyBlock.size,
      SymbolSegment.ltType => litBlock.size,
      SymbolSegment.extType => extBlock.size,
      ENDCASE => ERROR]};
    

  SetFileName: PUBLIC PROC [name, root, extension: Strings.String] = {
    name.length _ 0;
    FOR i: CARDINAL IN [0 .. root.length) DO
      IF root[i] = '. THEN EXIT;
      Strings.AppendChar[name, root[i]];
      ENDLOOP;
    IF extension # NIL THEN {
      Strings.AppendChar[name, '.]; Strings.AppendString[name, extension]}};
    
  CreateStream: PUBLIC PROC [name: Strings.String] RETURNS [Stream.Handle] = {
    RETURN [FileStream.Create[OSMiscOps.FindFile[name, $write]]]};
    
    
  LoadBcd: PUBLIC PROC [fileId: Strings.String] RETURNS [bcd: FileSegment.Pages] = {
    file: File.Capability;
    file _ OSMiscOps.FindFile[fileId, $read ! OSMiscOps.FileError => {GO TO noFile}];
    filename _ fileId;
    bcd _ ReadHeader[file];
    RETURN
    EXITS
      noFile => bcd _ FileSegment.nullPages};
    
  LoadModule: PUBLIC PROC [bcd: FileSegment.Pages, typeId: Strings.String]
      RETURNS [mti: BcdDefs.MTIndex, code, symbols: FileSegment.Pages] = {
    mti _ BcdDefs.MTNull;  code _ symbols _ FileSegment.nullPages;
    IF bcd # FileSegment.nullPages THEN {
      BcdBase: PROC [p: LONG POINTER] RETURNS [BcdDefs.Base] = INLINE {
	RETURN [LOOPHOLE[p, BcdDefs.Base]]};
      bcdSpace: Space.Handle = MapPages[bcd];
      bcdBase: BcdOps.BcdBase = bcdSpace.LongPointer[];
      mtb: BcdDefs.Base = BcdBase[bcdBase + bcdBase.mtOffset];
      ftb: BcdDefs.Base = BcdBase[bcdBase + bcdBase.ftOffset];
      sgb: BcdDefs.Base = BcdBase[bcdBase + bcdBase.sgOffset];
      nString: BcdOps.NameString = LOOPHOLE[bcdBase + bcdBase.ssOffset];

      AcquireFile: PROC [fti: BcdDefs.FTIndex] RETURNS [file: File.Capability] = {
	IF fti = BcdDefs.FTSelf THEN file _ bcd.file
	ELSE {
	  d: Strings.SubStringDescriptor _ [@nString.string, TRASH, TRASH];
	  fileName: STRING _ [100];
	  fileSpace: Space.Handle;
	  fileBase: BcdOps.BcdBase;
	  d.offset _ ftb[fti].name;  d.length _ nString.size[ftb[fti].name];
	  Strings.AppendSubString[fileName, @d];
	  FOR i: CARDINAL IN [0..fileName.length) DO
	    IF fileName[i] = '. THEN EXIT;
	    REPEAT
	      FINISHED => Strings.AppendString[fileName, ".bcd"L];
	    ENDLOOP;
	  file _ OSMiscOps.FindFile[fileName, $read
	    ! OSMiscOps.FileError => {GO TO NoFile}];
	  fileSpace _ MapPages[[file, [base: 1, pages: 1]]];
	  fileBase _ fileSpace.LongPointer;
	  IF fileBase.versionIdent # BcdDefs.VersionID
	   OR fileBase.version # ftb[fti].version THEN {
	    Space.Delete[fileSpace]; GO TO BadFile};
	  Space.Delete[fileSpace];
	  EXITS
	    NoFile, BadFile => file _ File.nullCapability};
	RETURN};

      d1: Strings.SubStringDescriptor _ [typeId, 0, typeId.length];
      d2: Strings.SubStringDescriptor _ [@nString.string, TRASH, TRASH];
      mti _ BcdDefs.MTIndex.FIRST;
      UNTIL mti = bcdBase.mtLimit DO
	d2.offset _ mtb[mti].name;  d2.length _ nString.size[mtb[mti].name];
	IF Strings.EquivalentSubStrings[@d1, @d2] THEN EXIT;
	mti _ mti + (WITH m: mtb[mti] SELECT FROM
		  direct => BcdDefs.MTRecord.direct.SIZE + m.length*BcdDefs.Link.SIZE,
		  indirect => BcdDefs.MTRecord.indirect.SIZE,
		  multiple => BcdDefs.MTRecord.multiple.SIZE,
		  ENDCASE => ERROR);
	REPEAT
	  FINISHED =>
	    IF bcdBase.nModules = 1 THEN mti _ BcdDefs.MTIndex.FIRST
	    ELSE {DeleteSpace[bcdSpace]; ERROR UnknownModule};
	ENDLOOP;
      IF ~bcdBase.definitions THEN {
        code.file _ AcquireFile[sgb[mtb[mti].code.sgi].file];
	IF code.file # File.nullCapability THEN
	  code.span _ [sgb[mtb[mti].code.sgi].base, sgb[mtb[mti].code.sgi].pages]};
      IF sgb[mtb[mti].sseg].pages # 0 THEN {
      	symbols.file _ AcquireFile[sgb[mtb[mti].sseg].file];
	IF symbols.file # File.nullCapability THEN
	  symbols.span _ [
	      sgb[mtb[mti].sseg].base,
	      sgb[mtb[mti].sseg].pages + sgb[mtb[mti].sseg].extraPages]};
      DeleteSpace[bcdSpace]};
    RETURN};
    

  MapPages: PUBLIC PROC [pages: FileSegment.Pages] RETURNS [s: Space.Handle] = {
    IF pages = FileSegment.nullPages THEN s _ Space.nullHandle
    ELSE {
      s _ Space.Create[size: pages.span.pages, parent: Space.virtualMemory];
      s.Map[window: [file: pages.file, base: pages.span.base]]};
    RETURN};
    
  DeleteSpace: PUBLIC PROC [s: Space.Handle] = {
    IF s # Space.nullHandle THEN Space.Delete[s]};
    
    
  ReadHeader: PROC [file: File.Capability] RETURNS [
      bcdPages: FileSegment.Pages _ FileSegment.nullPages] = {
    headerSpace: Space.Handle _ Space.nullHandle;

    DeleteHeader: PROC = {
      IF headerSpace # Space.nullHandle THEN {
	Space.Delete[headerSpace];
	headerSpace _ Space.nullHandle}};

    IF file # File.nullCapability THEN {
      ENABLE {
	UNWIND => {NULL};
	ANY => {GO TO badFile}};
      BcdBase: PROC [p: LONG POINTER] RETURNS [BcdDefs.Base] = INLINE {
	RETURN [LOOPHOLE[p, BcdDefs.Base]]};
      bcd: BcdOps.BcdBase;
      nPages: CARDINAL _ 8;
      DO
	headerSpace _ Space.Create[size: nPages, parent: Space.virtualMemory];
	headerSpace.Map[window: [file: file, base: 1]];
	bcd _ headerSpace.LongPointer[];
	IF bcd.versionIdent # BcdDefs.VersionID THEN GO TO badFile;
	IF nPages >= bcd.nPages THEN EXIT;
	nPages _ bcd.nPages;
	Space.Delete[headerSpace];  headerSpace _ Space.nullHandle
	ENDLOOP;
      bcdPages _ [file, [1, bcd.nPages]];
      version _ bcd.version;
      creator _ bcd.creator;
      source _ bcd.sourceVersion;
      DeleteHeader[];
      EXITS
	badFile => {DeleteHeader[]; bcdPages _ FileSegment.nullPages}};
    RETURN};


  PutVersionId: PUBLIC PROC [out: Stream.Handle, stamp: BcdDefs.VersionStamp] = {
    OPEN CharIO;
    StampWords: CARDINAL = BcdDefs.VersionStamp.SIZE;
    str: PACKED ARRAY [0..4*StampWords) OF [0..16) = LOOPHOLE[stamp];
    digit: STRING = "0123456789abcdef"L;
    PutChar[out, '"];
    FOR i: NAT IN [0..4*StampWords) DO PutChar[out, digit[str[i]]] ENDLOOP;
    PutString[out, "\" ("L];
    PutTime[out, stamp.time];
    PutString[out, ", "L]; PutMachine[out, stamp];
    PutChar[out, ')]};

  WriteOneVersion: PROC [
      out: Stream.Handle,
      version: LONG POINTER TO BcdDefs.VersionStamp, tag: Strings.String] = {
    OPEN CharIO;
    IF version = NIL THEN RETURN;
    PutString[out, tag];
    PutTime[out, version.time];
    PutString[out, "  on "L];
    PutMachine[out, version^];
    PutChar[out, '\n]};
    
  PutVersions: PUBLIC PROC [
      out: Stream.Handle,
      version, creator, source: LONG POINTER TO BcdDefs.VersionStamp _ NIL] = {
    WriteOneVersion[out, version, " created "L];
    WriteOneVersion[out, creator, "    creator "L];
    WriteOneVersion[out, source, "    source "L];
    CharIO.PutChar[out, '\n]};
    
  PutTime: PUBLIC PROC [out: Stream.Handle, time: LONG CARDINAL] = {
    s: STRING = [40];
    Time.Append[s, Time.Unpack[[time]]];
    CharIO.PutString[out, s]};
    
  PutMachine: PUBLIC PROC [out: Stream.Handle, stamp: BcdDefs.VersionStamp] = {
    OPEN CharIO;
    octal: Format.NumberFormat = [8, FALSE, FALSE, 1];
    PutNumber[out, stamp.net, octal];  PutChar[out, '#];
    PutNumber[out, stamp.host, octal]; PutChar[out, '#]};
    
  PutFileID: PUBLIC PROC [out: Stream.Handle] = {
    OPEN CharIO;
    PutString[out, filename];
    PutString[out, ", version "L]; PutVersionId[out, version];
    PutString[out, "\n  source  "L];  PutTime[out, source.time];
    PutString[out, "\n  creator "L]; PutVersionId[out, creator];
    PutString[out, "\n\n"L]};
    
  PutHti: PUBLIC PROC [out: Stream.Handle, hti: Symbols.HTIndex] = {
    OPEN CharIO;
    desc: Strings.SubStringDescriptor;
    s: Strings.SubString = @desc;
    IF hti = Symbols.HTNull THEN PutString[out, "(anonymous)"L]
    ELSE {symbols.SubStringForHash[LOOPHOLE[s], hti]; PutSubString[out, s]}};
    
  PutSei: PUBLIC PROC [out: Stream.Handle, sei: Symbols.ISEIndex] = {
    PutHti[out, IF sei = Symbols.SENull THEN Symbols.HTNull ELSE symbols.seb[sei].hash]};
    
  -- TTY interface
  
  Message: PUBLIC PROC [s: Strings.String] = {
    FOR i: CARDINAL IN [0..s.length) DO (Exec.w).PutChar[s[i]] ENDLOOP};

  ttyObject: Stream.Object _ Stream.defaultObject;
  
  TTYPutByte: Stream.PutByteProcedure = {
    (Exec.w).PutChar[0c + byte]};
    
  TTYReset: Stream.DeleteProcedure = {
    ttyObject _ Stream.defaultObject};
    
  TTYStream: PUBLIC PROC RETURNS [Stream.Handle] = {
    ttyObject.putByte _ TTYPutByte;
    ttyObject.delete _ TTYReset;
    RETURN [@ttyObject]};
     
  }.