-- file ListerUtilities.mesa 
-- last edited by Satterthwaite on May 12, 1983 12:30 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, Name, nullName, 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, name: Symbols.Name] = {
    OPEN CharIO;
    desc: Strings.SubStringDescriptor;
    s: Strings.SubString = @desc;
    IF name = Symbols.nullName THEN PutString[out, "(anonymous)"L]
    ELSE {symbols.SubStringForName[s, name]; PutSubString[out, s]}};
    
  PutSei: PUBLIC PROC [out: Stream.Handle, sei: Symbols.ISEIndex] = {
    PutHti[out, IF sei = Symbols.SENull THEN Symbols.nullName 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]};
     
  }.