-- ListerRoutines.mesa; 
--   edited by Sandman; October 14, 1980  11:06 AM
--   edited by Sweet;  3-Sep-80 16:12:54

DIRECTORY
  AltoDefs USING [PageCount],
  BcdDefs,
  BcdOps,
  CommanderDefs USING [InitCommander, WaitCommands],
  ControlDefs USING [CSegPrefix],
  ImageDefs USING [BcdTime],
  InlineDefs USING [LowHalf],
  IODefs USING [NumberFormat, TAB],
  ListerDefs: FROM "listerdefs",
  OutputDefs USING [PutChar, PutCR, PutNumber, PutString, PutTime],
  SegmentDefs USING [
    DefaultVersion, DeleteFileSegment, FileHandle, FileSegmentAddress,
    FileSegmentHandle, MoveFileSegment, NewFile, NewFileSegment, Read, SwapIn,
    Unlock],
  String,
  Symbols USING [
    bodyType, ctxType, HTIndex, HTNull, htType, ISEIndex, mdType, SENull, seType,
    ssType],
  SymbolSegment USING [extType, ltType, treeType],
  SymbolTable USING [Base],
  Storage USING [Node, Free],
  Table USING [Base, Index, Notifier, Selector],
  TimeDefs USING [AppendDayTime, UnpackDT],
  Tree USING [Node];

ListerRoutines: PROGRAM
  IMPORTS
    BcdOps, CommanderDefs, OutputDefs, ImageDefs, SegmentDefs, String, Storage,
    InlineDefs, TimeDefs
  EXPORTS ListerDefs, Table
  SHARES SymbolTable =PUBLIC
  
  BEGIN OPEN OutputDefs;
  
  NumberFormat: TYPE = IODefs.NumberFormat;
  PageCount: TYPE = AltoDefs.PageCount;
  
  IncorrectVersion: SIGNAL = CODE;
  NoFGT: SIGNAL = CODE;
  NoCode: SIGNAL = CODE;
  NoSymbols: SIGNAL = CODE;
  MultipleModules: SIGNAL = CODE;
  version, creator, source: BcdDefs.VersionStamp;
  Dstar: BOOLEAN;
  filename: STRING;
  
  symbols: SymbolTable.Base;
  bases: PRIVATE ARRAY [0..16) OF Table.Base;
  
  SetRoutineSymbols: PROCEDURE [s: SymbolTable.Base] =
    BEGIN OPEN s.stHandle;
    symbase: Table.Base _ InlineDefs.LowHalf[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[];
    END;
    
  -- Tree
  
  NotifyNode: TYPE = RECORD [
    notifier: Table.Notifier, link: POINTER TO NotifyNode];
  
  notifyList: POINTER TO NotifyNode _ NIL;
  
  AddNotify: PUBLIC PROCEDURE [proc: Table.Notifier] =
    BEGIN
    p: POINTER TO NotifyNode = Storage.Node[SIZE[NotifyNode]];
    p^ _ [notifier: proc, link: notifyList];
    notifyList _ p;
    proc[DESCRIPTOR[bases]];
    RETURN
    END;
    
  DropNotify: PUBLIC PROCEDURE [proc: Table.Notifier] =
    BEGIN
    p, q: POINTER TO NotifyNode;
    IF notifyList = NIL THEN RETURN;
    p _ notifyList;
    IF p.notifier = proc THEN notifyList _ p.link
    ELSE
      BEGIN
      DO
	q _ p;
	p _ p.link;
	IF p = NIL THEN RETURN;
	IF p.notifier = proc THEN EXIT
	ENDLOOP;
      q.link _ p.link;
      END;
    Storage.Free[p];
    RETURN
    END;
    
  UpdateBases: PROCEDURE =
    BEGIN
    p: POINTER TO NotifyNode;
    FOR p _ notifyList, p.link UNTIL p = NIL DO
      p.notifier[DESCRIPTOR[bases]] ENDLOOP;
    RETURN
    END;
    
  -- to make TreeInit happy
  
  
  GetChunk: PROCEDURE [size: CARDINAL] RETURNS [Table.Index] =
    BEGIN
    IF size # SIZE[Tree.Node] THEN ERROR; -- called to reserve empty
    RETURN[LOOPHOLE[0]];
    END;
    
  -- to make LiteralPack.Initialize happy
  
  
  Bounds: PROCEDURE [table: Table.Selector]
    RETURNS [base: Table.Base, size: CARDINAL] =
    BEGIN 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;
    END;
    
  LoadFromConfig: PROCEDURE [
    configName, moduleName: STRING, saveBcdSeg: BOOLEAN _ FALSE]
    RETURNS [
      code, symbols, bcdseg: SegmentDefs.FileSegmentHandle,
      mti: BcdDefs.MTIndex] =
    BEGIN OPEN BcdDefs, SegmentDefs;
    bcd: POINTER TO BcdDefs.BCD;
    sgb, mtb, ftb: BcdDefs.Base;
    ssb: BcdOps.NameString;
    pages: AltoDefs.PageCount;
    configFile, codeFile, symsFile: FileHandle;
    codeFileName: STRING _ [40];
    symsFileName: STRING _ [40];
    mh: BcdOps.MTHandle;
    sfi, cfi: BcdDefs.FTIndex;
    ss1, ss2: String.SubStringDescriptor;
    
    CheckModule: PROC [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
      RETURNS [BOOLEAN] =
      BEGIN
      ss2.offset _ mth.name;
      ss2.length _ ssb.size[mth.name];
      RETURN[String.EquivalentSubStrings[@ss1, @ss2]];
      END;
      
    ss1 _ [base: moduleName, offset: 0, length: moduleName.length];
    code _ symbols _ NIL;
    Dstar _ FALSE;
    filename _ configName;
    codeFile _ symsFile _ configFile _ NewFile[configName, Read, DefaultVersion];
    bcdseg _ NewFileSegment[configFile, 1, 1, Read];
    SwapIn[bcdseg];
    bcd _ FileSegmentAddress[bcdseg];
    IF (pages _ bcd.nPages) # 1 THEN
      BEGIN
      Unlock[bcdseg];
      MoveFileSegment[bcdseg, 1, pages];
      SwapIn[bcdseg];
      bcd _ FileSegmentAddress[bcdseg];
      END;
    BEGIN
    ENABLE UNWIND => BEGIN Unlock[bcdseg]; DeleteFileSegment[bcdseg] END;
    IF bcd.versionIdent # BcdDefs.VersionID THEN SIGNAL IncorrectVersion;
    version _ bcd.version;
    creator _ bcd.creator;
    source _ bcd.sourceVersion;
    sgb _ LOOPHOLE[bcd + bcd.sgOffset];
    mtb _ LOOPHOLE[bcd + bcd.mtOffset];
    ssb _ LOOPHOLE[bcd + bcd.ssOffset];
    ftb _ LOOPHOLE[bcd + bcd.ftOffset];
    ss2.base _ @ssb.string;
    mti _ BcdOps.ProcessModules[bcd, CheckModule].mti;
    IF mti = MTNull THEN SIGNAL NoCode
    ELSE
      BEGIN
      mh _ @mtb[mti];
      cfi _ sgb[mh.code.sgi].file;
      IF cfi # FTSelf THEN
	BEGIN
	fileVersion: BcdDefs.VersionStamp;
	cfilebase: POINTER TO BcdDefs.BCD;
	ss2.offset _ ftb[cfi].name;
	ss2.length _ ssb.size[ftb[cfi].name];
	String.AppendSubString[codeFileName, @ss2];
	FOR i: CARDINAL IN [0..codeFileName.length) DO
	  IF codeFileName[i] = '. THEN EXIT;
	  REPEAT FINISHED => String.AppendString[codeFileName, ".bcd"L];
	  ENDLOOP;
	codeFile _ NewFile[codeFileName, SegmentDefs.Read];
	code _ NewFileSegment[codeFile, 1, 1, SegmentDefs.Read];
	SwapIn[code];
	cfilebase _ FileSegmentAddress[code];
	fileVersion _ cfilebase.version;
	Unlock[code];
	IF fileVersion # ftb[cfi].version THEN
	  SIGNAL NoSymbols[ ! UNWIND => DeleteFileSegment[code]];
	MoveFileSegment[code, sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages];
	END
      ELSE
	code _ NewFileSegment[
	  codeFile, sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages,
	  SegmentDefs.Read];
      code.class _ code;
      END;
    IF mti = MTNull OR sgb[mh.sseg].pages = 0 THEN SIGNAL NoSymbols
    ELSE
      BEGIN
      sfi _ sgb[mh.sseg].file;
      IF sfi # FTSelf THEN
	BEGIN
	ss2.offset _ ftb[sfi].name;
	ss2.length _ ssb.size[ftb[sfi].name];
	String.AppendSubString[symsFileName, @ss2];
	FOR i: CARDINAL IN [0..symsFileName.length) DO
	  IF symsFileName[i] = '. THEN EXIT;
	  REPEAT FINISHED => String.AppendString[symsFileName, ".bcd"L];
	  ENDLOOP;
	symsFile _ NewFile[symsFileName, SegmentDefs.Read];
	END;
      IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
      IF sfi # FTSelf THEN
	BEGIN
	sfilebase: POINTER TO BcdDefs.BCD;
	fileVersion: BcdDefs.VersionStamp;
	symbols _ NewFileSegment[symsFile, 1, 1, SegmentDefs.Read];
	SwapIn[symbols];
	sfilebase _ FileSegmentAddress[symbols];
	fileVersion _ sfilebase.version;
	Unlock[symbols];
	IF fileVersion # ftb[sfi].version THEN
	  SIGNAL NoSymbols[ ! UNWIND => DeleteFileSegment[symbols]];
	MoveFileSegment[
	  symbols, sgb[mh.sseg].base,
	  sgb[mh.sseg].pages + sgb[mh.sseg].extraPages];
	END
      ELSE
	symbols _ NewFileSegment[
	  symsFile, sgb[mh.sseg].base,
	  sgb[mh.sseg].pages + sgb[mh.sseg].extraPages, Read];
      END;
    END;
    IF code # NIL THEN
      BEGIN
      p: POINTER TO ControlDefs.CSegPrefix;
      SwapIn[code];
      p _ FileSegmentAddress[code];
      Dstar _ ~p.header.info.altoCode;
      Unlock[code];
      END;
    Unlock[bcdseg];
    IF saveBcdSeg THEN RETURN;
    DeleteFileSegment[bcdseg];
    bcdseg _ NIL;
    RETURN
    END;
    
  Load: PROCEDURE [name: STRING, saveBcdSeg: BOOLEAN _ FALSE]
    RETURNS [code, symbols, bcdseg: SegmentDefs.FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    bcd: POINTER TO BcdDefs.BCD;
    sgb: BcdDefs.Base;
    pages: AltoDefs.PageCount;
    codefile: FileHandle;
    mh: BcdOps.MTHandle;
    code _ symbols _ NIL;
    Dstar _ FALSE;
    filename _ name;
    codefile _ NewFile[name, Read, DefaultVersion];
    bcdseg _ NewFileSegment[codefile, 1, 1, Read];
    SwapIn[bcdseg];
    bcd _ FileSegmentAddress[bcdseg];
    IF (pages _ bcd.nPages) # 1 THEN
      BEGIN
      Unlock[bcdseg];
      MoveFileSegment[bcdseg, 1, pages];
      SwapIn[bcdseg];
      bcd _ FileSegmentAddress[bcdseg];
      END;
    BEGIN
    ENABLE UNWIND => BEGIN Unlock[bcdseg]; DeleteFileSegment[bcdseg] END;
    IF bcd.versionIdent # BcdDefs.VersionID THEN SIGNAL IncorrectVersion;
    version _ bcd.version;
    creator _ bcd.creator;
    source _ bcd.sourceVersion;
    mh _ @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
    sgb _ LOOPHOLE[bcd + bcd.sgOffset];
    IF bcd.nModules # 1 THEN SIGNAL MultipleModules;
    IF bcd.definitions THEN SIGNAL NoCode
    ELSE
      BEGIN
      code _ NewFileSegment[
	codefile, sgb[mh.code.sgi].base, sgb[mh.code.sgi].pages, Read];
      code.class _ code;
      END;
    IF sgb[mh.sseg].pages = 0 THEN SIGNAL NoSymbols
    ELSE
      BEGIN
      IF sgb[mh.sseg].extraPages = 0 THEN SIGNAL NoFGT;
      symbols _ NewFileSegment[
	codefile, sgb[mh.sseg].base, sgb[mh.sseg].pages + sgb[mh.sseg].extraPages,
	Read];
      END;
    END;
    IF code # NIL THEN
      BEGIN
      p: POINTER TO ControlDefs.CSegPrefix;
      SwapIn[code];
      p _ FileSegmentAddress[code];
      Dstar _ ~p.header.info.altoCode;
      Unlock[code];
      END;
    Unlock[bcdseg];
    IF saveBcdSeg THEN RETURN;
    DeleteFileSegment[bcdseg];
    bcdseg _ NIL;
    RETURN
    END;
    
  WriteOneVersion: PROCEDURE [
    version: POINTER TO BcdDefs.VersionStamp, tag: STRING] =
    BEGIN OPEN OutputDefs;
    IF version = NIL THEN RETURN;
    PutString[tag];
    PutTime[LOOPHOLE[version.time]];
    PutString["  on "L];
    PrintMachine[version^];
    PutCR[];
    END;
    
  WriteVersions: PROCEDURE [
    version, creator, source: POINTER TO BcdDefs.VersionStamp _ NIL] =
    BEGIN
    WriteOneVersion[version, " created "L];
    WriteOneVersion[creator, "    creator "L];
    WriteOneVersion[source, "    source "L];
    OutputDefs.PutCR[];
    RETURN
    END;
    
  PrintMachine: PROCEDURE [stamp: BcdDefs.VersionStamp] =
    BEGIN
    octal: NumberFormat = [8, FALSE, FALSE, 1];
    PutNumber[stamp.net, octal];
    PutChar['#];
    PutNumber[stamp.host, octal];
    PutChar['#];
    RETURN
    END;
    
  WriteFileID: PROCEDURE =
    BEGIN
    PutString[filename];
    IF Dstar THEN PutString[" (/-A)"L];
    Dstar _ FALSE;
    WriteVersions[@version, @creator, @source];
    RETURN
    END;
    
  PrintHti: PROCEDURE [hti: Symbols.HTIndex] =
    BEGIN
    desc: String.SubStringDescriptor;
    s: String.SubString = @desc;
    IF hti = Symbols.HTNull THEN PutString["(anonymous)"]
    ELSE BEGIN symbols.SubStringForHash[s, hti]; PutSubString[s]; END;
    RETURN
    END;
    
  PrintSei: PROCEDURE [sei: Symbols.ISEIndex] =
    BEGIN
    PrintHti[
      IF sei = Symbols.SENull THEN Symbols.HTNull ELSE symbols.seb[sei].hash];
    RETURN
    END;
    
  Indent: PROCEDURE [n: CARDINAL] =
    BEGIN
    PutCR[];
    THROUGH [1..n/8] DO PutChar[IODefs.TAB] ENDLOOP;
    THROUGH [1..n MOD 8] DO PutChar[' ] ENDLOOP;
    RETURN
    END;
    
  PutSubString: PROCEDURE [ss: String.SubString] =
    BEGIN
    i: CARDINAL;
    FOR i IN [ss.offset..ss.offset + ss.length) DO PutChar[ss.base[i]] ENDLOOP;
    RETURN
    END;
    
  herald: STRING _ [50];
  
  LoadLister: PROCEDURE =
    BEGIN OPEN TimeDefs;
    CommanderDefs.InitCommander[herald];
    String.AppendString[to: herald, from: "Alto/Mesa Lister 6.0 of "L];
    AppendDayTime[herald, UnpackDT[ImageDefs.BcdTime[]]];
    herald.length _ herald.length - 3;
    END;
    
  LoadLister[];
  CommanderDefs.WaitCommands[];
  
  END..