-- ListerRoutines.mesa; 
--   edited by Bruce;  7-Jan-81 10:06:16
--   edited by Sandman; October 14, 1980  11:06 AM
--   edited by Sweet;  3-Sep-80 16:12:54
--   edited by Satterthwaite on September 20, 1982 1:35 pm

DIRECTORY
  Alloc: TYPE USING [Base, Notifier, Selector],
  BcdDefs: TYPE,
  BcdOps: TYPE USING [BcdBase, MTHandle, NameString],
  CommanderOps: TYPE USING [InitCommander, WaitCommands],
  Environment: TYPE USING [PageCount],
  Exec: TYPE USING [AddCommand, w],
  File: TYPE USING [Capability, nullCapability],
  FileSegment: TYPE USING [Pages, nullPages],
  Format: TYPE USING [NumberFormat],
  Heap: TYPE USING [systemZone],
  ListerDefs: TYPE USING [],
  OSMiscOps: TYPE USING [BcdCreateTime, FileError, FindFile],
  OutputDefs: TYPE USING [
    PutChar, PutNumber, PutLongSubString, PutString, PutTime],
  Space: TYPE USING [
    Handle, nullHandle, virtualMemory, Create, Delete, LongPointer, Map],
  Strings: TYPE USING [
    AppendString, AppendSubString, EquivalentSubStrings,
    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, PutDecimal, PutLine, PutOctal, PutString];

ListerRoutines: PROGRAM
  IMPORTS 
    CommanderOps, Exec, Heap, OSMiscOps, OutputDefs, 
    Space, Strings, Time, TTY
  EXPORTS ListerDefs = { 
  OPEN OutputDefs;
  
  NoFile: PUBLIC SIGNAL = CODE;
  IncorrectVersion: PUBLIC SIGNAL = CODE;
  NoFGT: PUBLIC SIGNAL = CODE;
  NoCode: PUBLIC SIGNAL = CODE;
  NoSymbols: PUBLIC SIGNAL = CODE;
  MultipleModules: PUBLIC SIGNAL = CODE;
  version, creator, source: BcdDefs.VersionStamp;
  Dstar: BOOLEAN;
  filename: 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 [proc: Alloc.Notifier] = {
    p: NotifyLink =
      (Heap.systemZone).NEW[NotifyNode _ [notifier: proc, link: notifyList]];
    notifyList _ p;
    proc[DESCRIPTOR[bases]]};
    
  DropNotify: PUBLIC PROC [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 [table: Alloc.Selector]
      RETURNS [base: Alloc.Base, size: CARDINAL] = {
    OPEN symbols.stHandle;
    SELECT table FROM
      SymbolSegment.treeType => RETURN [bases[table], treeBlock.size];
      Symbols.seType => RETURN [bases[table], seBlock.size];
      Symbols.htType => RETURN [bases[table], htBlock.size];
      Symbols.ssType => RETURN [bases[table], ssBlock.size];
      Symbols.ctxType => RETURN [bases[table], ctxBlock.size];
      Symbols.mdType => RETURN [bases[table], mdBlock.size];
      Symbols.bodyType => RETURN [bases[table], bodyBlock.size];
      SymbolSegment.ltType => RETURN [bases[table], litBlock.size];
      SymbolSegment.extType => RETURN [bases[table], extBlock.size];
      ENDCASE => ERROR};
    
  LoadFromConfig: PUBLIC PROC [configName, moduleName: STRING]
      RETURNS [code, symbols, bcd: FileSegment.Pages, mti: BcdDefs.MTIndex] = {
    OPEN BcdDefs;
    configFile, codeFile, symsFile: File.Capability;
    bcdSpace: Space.Handle _ Space.nullHandle;
    
    code _ symbols _ FileSegment.nullPages;  Dstar _ TRUE;
    configFile _ OSMiscOps.FindFile[configName
      ! OSMiscOps.FileError => {GOTO noFile}];
    filename _ configName;
    codeFile _ symsFile _ configFile;
    bcd _ ReadHeader[configFile];
    IF bcd # FileSegment.nullPages THEN {
      ENABLE
	UNWIND => {IF bcdSpace # Space.nullHandle THEN Space.Delete[bcdSpace]};
      bcdBase: BcdOps.BcdBase;
      sgb, mtb, ftb: BcdDefs.Base;
      ssb: BcdOps.NameString;
      mtLimit: BcdDefs.MTIndex;
      mh: BcdOps.MTHandle;
      sfi, cfi: BcdDefs.FTIndex;
      ss1, ss2: Strings.SubStringDescriptor;

      SearchModules: PROC [test: PROC [BcdDefs.MTIndex] RETURNS [BOOLEAN]]
	  RETURNS [BcdDefs.MTIndex] = {
        -- here to avoid dependencies on operations from BcdOps
        next: MTIndex;
        FOR mti _ FIRST[BcdDefs.MTIndex], next UNTIL mti = mtLimit DO
	  IF test[mti] THEN RETURN [mti];
	  next _ mti + (WITH m: mtb[mti] SELECT FROM
	    direct => SIZE[direct BcdDefs.MTRecord] + m.length*SIZE[BcdDefs.Link],
	    indirect => SIZE[indirect BcdDefs.MTRecord],
	    multiple => SIZE[multiple BcdDefs.MTRecord],
	    ENDCASE => ERROR);
	  ENDLOOP;
        RETURN [BcdDefs.MTNull]};
      
      CheckModule: PROC [mti: BcdDefs.MTIndex] RETURNS [BOOLEAN] = {
        ss2.offset _ mtb[mti].name;
        ss2.length _ ssb.size[mtb[mti].name];
        RETURN [Strings.EquivalentSubStrings[@ss1, @ss2]]};
      
      bcdSpace _ MapPages[bcd];  bcdBase _ bcdSpace.LongPointer[];
      ss1 _ [base: moduleName, offset: 0, length: moduleName.length];
      version _ bcdBase.version;
      creator _ bcdBase.creator;
      source _ bcdBase.sourceVersion;
      sgb _ LOOPHOLE[bcdBase + bcdBase.sgOffset];
      mtb _ LOOPHOLE[bcdBase + bcdBase.mtOffset]; mtLimit _ bcdBase.mtLimit;
      ssb _ LOOPHOLE[bcdBase + bcdBase.ssOffset];
      ftb _ LOOPHOLE[bcdBase + bcdBase.ftOffset];
      ss2.base _ @ssb.string;
      mti _ SearchModules[CheckModule];
      IF mti = MTNull THEN SIGNAL NoCode
      ELSE {
	mh _ @mtb[mti];
	Dstar _ ~mh.altoCode;
	cfi _ sgb[mh.code.sgi].file;
	IF cfi # FTSelf THEN {
	  codeFileName: STRING _ [40];
	  codeSpace: Space.Handle;
	  fileVersion: BcdDefs.VersionStamp;
	  cfilebase: BcdOps.BcdBase;
	  ss2.offset _ ftb[cfi].name;
	  ss2.length _ ssb.size[ftb[cfi].name];
	  Strings.AppendSubString[codeFileName, @ss2];
	  FOR i: CARDINAL IN [0..codeFileName.length) DO
	    IF codeFileName[i] = '. THEN EXIT;
	    REPEAT FINISHED => Strings.AppendString[codeFileName, ".bcd"L];
	    ENDLOOP;
	  codeFile _ OSMiscOps.FindFile[codeFileName
	    ! OSMiscOps.FileError => {GO TO noCode}];
	  code _ [codeFile, [base: 1, pages: 1]];
	  codeSpace _ MapPages[code];
	  cfilebase _ codeSpace.LongPointer;
	  fileVersion _ cfilebase.version;
	  Space.Delete[codeSpace];
	  IF fileVersion # ftb[cfi].version THEN GOTO noCode};
	code _ [
	  file: codeFile,
	  span: [base: sgb[mh.code.sgi].base, pages: sgb[mh.code.sgi].pages]];
	EXITS
	  noCode => SIGNAL NoCode};
      IF mti = MTNull OR sgb[mh.sseg].pages = 0 THEN SIGNAL NoSymbols
      ELSE {
	sfi _ sgb[mh.sseg].file;
	IF sfi # FTSelf THEN {
	  symsFileName: STRING _ [40];
	  ss2.offset _ ftb[sfi].name;
	  ss2.length _ ssb.size[ftb[sfi].name];
	  Strings.AppendSubString[symsFileName, @ss2];
	  FOR i: CARDINAL IN [0..symsFileName.length) DO
	    IF symsFileName[i] = '. THEN EXIT;
	    REPEAT FINISHED => Strings.AppendString[symsFileName, ".bcd"L];
	    ENDLOOP;
	  symsFile _ OSMiscOps.FindFile[symsFileName
	    ! OSMiscOps.FileError => {GOTO noSymbols}]};
	IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
	IF sfi # FTSelf THEN {
	  symsSpace: Space.Handle;
	  sfilebase: BcdOps.BcdBase;
	  fileVersion: BcdDefs.VersionStamp;
	  symbols _ [symsFile, [base: 1, pages: 1]];
	  symsSpace _ MapPages[symbols];
	  sfilebase _ symsSpace.LongPointer;
	  fileVersion _ sfilebase.version;
	  Space.Delete[symsSpace];
	  IF fileVersion # ftb[sfi].version THEN GOTO noSymbols};
	symbols _ [
	  file: symsFile,
	  span: [
	    base: sgb[mh.sseg].base,
	    pages: sgb[mh.sseg].pages+sgb[mh.sseg].extraPages]];
	EXITS
	  noSymbols => SIGNAL NoSymbols};
      Space.Delete[bcdSpace]};
    RETURN
    EXITS
      noFile => {SIGNAL NoFile; bcd _ FileSegment.nullPages}};
    
  Load: PUBLIC PROC [name: STRING] RETURNS [code, symbols, bcd: FileSegment.Pages] = {
    file: File.Capability;
    code _ symbols _ FileSegment.nullPages;  Dstar _ TRUE;
    file _ OSMiscOps.FindFile[name ! OSMiscOps.FileError => {GO TO noFile}];
    filename _ name;
    bcd _ ReadHeader[file];
    IF bcd # FileSegment.nullPages THEN {
      bcdSpace: Space.Handle = MapPages[bcd];
      bcdBase: BcdOps.BcdBase = bcdSpace.LongPointer[];
      mh: BcdOps.MTHandle;
      sgb: BcdDefs.Base;
      version _ bcdBase.version;
      creator _ bcdBase.creator;
      source _ bcdBase.sourceVersion;
      mh _ @LOOPHOLE[bcdBase + bcdBase.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
      Dstar _ ~mh.altoCode;
      sgb _ LOOPHOLE[bcdBase + bcdBase.sgOffset];
      IF bcdBase.nModules # 1 THEN SIGNAL MultipleModules;
      IF bcdBase.definitions THEN code _ FileSegment.nullPages
      ELSE code _ [bcd.file, [sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages]];
      IF sgb[mh.sseg].pages = 0 THEN symbols _ FileSegment.nullPages
      ELSE {
	IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
	symbols _ [
	  bcd.file,
	  [sgb[mh.sseg].base, sgb[mh.sseg].pages + sgb[mh.sseg].extraPages]]};
      DeleteSpace[bcdSpace]};
    RETURN
    EXITS
      noFile => {SIGNAL NoFile; bcd _ FileSegment.nullPages}};
    
  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]];
      DeleteHeader[];
      EXITS
	badFile => {DeleteHeader[]; bcdPages _ FileSegment.nullPages}};
    RETURN};


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

  WriteOneVersion: PROC [
      version: LONG POINTER TO BcdDefs.VersionStamp, tag: STRING] = {
    OPEN OutputDefs;
    IF version = NIL THEN RETURN;
    PutString[tag];
    PutTime[[version.time]];
    PutString["  on "L];
    PrintMachine[version^];
    PutChar['\n]};
    
  WriteVersions: PUBLIC PROC [
      version, creator, source: LONG POINTER TO BcdDefs.VersionStamp _ NIL] = {
    WriteOneVersion[version, " created "L];
    WriteOneVersion[creator, "    creator "L];
    WriteOneVersion[source, "    source "L];
    OutputDefs.PutChar['\n]};
    
  PrintMachine: PUBLIC PROC [stamp: BcdDefs.VersionStamp] = {
    octal: Format.NumberFormat = [8, FALSE, FALSE, 1];
    PutNumber[stamp.net, octal];  PutChar['#];
    PutNumber[stamp.host, octal]; PutChar['#]};
    
  WriteFileID: PUBLIC PROC = {
    PutString[filename];
    IF ~Dstar THEN PutString[" (/A)"L];
    PutString[", version "L]; WriteVersionId[version];
    PutString["\n  source  "L];  PutTime[[source.time]];
    PutString["\n  creator "L]; WriteVersionId[creator];
    PutString["\n\n"L]};
    
  PrintHti: PUBLIC PROC [hti: Symbols.HTIndex] = {
    desc: Strings.SubStringDescriptor;
    s: Strings.SubString = @desc;
    IF hti = Symbols.HTNull THEN PutString["(anonymous)"L]
    ELSE {symbols.SubStringForHash[LOOPHOLE[s], hti]; PutLongSubString[s]}};
    
  PrintSei: PUBLIC PROC [sei: Symbols.ISEIndex] = {
    PrintHti[IF sei = Symbols.SENull THEN Symbols.HTNull ELSE symbols.seb[sei].hash]};
    
  Indent: PUBLIC PROC [n: CARDINAL] = {
    PutChar['\n];
    THROUGH [1..n/8] DO PutChar['\t] ENDLOOP;
    THROUGH [1..n MOD 8] DO PutChar[' ] ENDLOOP};

  -- IODefs replacement
  
  WriteChar: PUBLIC PROC [char: CHARACTER] = {TTY.PutChar[Exec.w, char]};
  WriteString: PUBLIC PROC [s: STRING] = {TTY.PutString[Exec.w, s]};
  WriteLine: PUBLIC PROC [s: STRING] = {TTY.PutLine[Exec.w, s]};
  WriteOctal: PUBLIC PROC [u: UNSPECIFIED] = {TTY.PutOctal[Exec.w, u]};
  WriteDecimal: PUBLIC PROC [i: INTEGER] = {TTY.PutDecimal[Exec.w, i]};
 
  herald: STRING _ [50];
  
  LoadLister: PROC = {
    CommanderOps.InitCommander[herald];
    Strings.AppendString[to: herald, from: "Cedar 3 Lister of "L];
    Time.Append[herald, Time.Unpack[[OSMiscOps.BcdCreateTime[]]]];
    herald.length _ herald.length - 3;
    Exec.AddCommand["Lister.~"L, Lister]};
    
  Lister: PROC = {CommanderOps.WaitCommands[]};
  
  LoadLister[];
  
  }.