-- 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[];
  
  }.