-- file PGSSymbols.mesa
-- last modified by Satterthwaite, May 28, 1982 8:46 am

DIRECTORY
  Alloc: TYPE USING [
    Handle, Notifier, TableInfo,
    AddNotify, Bounds, Create, Destroy, DropNotify, Words],
  Environment: TYPE USING [bytesPerWord],
  PGSConDefs: TYPE USING [
    objectVersion, pgsVersion, sourceVersion, AcquireZone, ReleaseZone],
  PrincOps: TYPE USING [ControlLink],
  Stream: TYPE USING [Handle, PutBlock],
  Strings: TYPE USING [String, SubStringDescriptor],
  Symbols: TYPE USING [
    Base, HashVector, SERecord, BodyRecord, StandardContext,
    SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, CBTIndex,
    ISENull, CSENull, RecordSENull, CTXNull, BTNull, lG, lZ],
  SymbolSegment: TYPE USING [
    Tables, htType, ssType, ctxType, seType, mdType, bodyType,
    VersionID, STHeader, WordOffset],
  SymbolOps: TYPE USING [
    Initialize, Finalize,
    EnterString, HashBlock, MakeCtxSe, NewCtx, MakeNonCtxSe],
  SymbolPack: TYPE,
  Table: TYPE USING [Selector];

PGSSymbols: PROGRAM
    IMPORTS Alloc, PGSConDefs, Stream, SymbolOps, SymbolPack
    EXPORTS PGSConDefs = {
  OPEN SymbolOps, Symbols;

  table: Alloc.Handle ← NIL;

  seb: Symbols.Base;	-- semantic entry base (local copy)
  ctxb: Symbols.Base;	-- context table base  (local copy)
  bb: Symbols.Base;       -- body table base     (local copy)

  Notify: Alloc.Notifier = {
    OPEN SymbolSegment;
    seb ← base[seType]; ctxb ← base[ctxType]; bb ← base[bodyType]};

  dirCtx: CTXIndex;

  EnterModule: PROC [moduleId: Strings.String, bodyCtx: CTXIndex] = { 
    tSei: CSEIndex;
    sei: ISEIndex;
    bti: CBTIndex;
   -- generate a program type
    tSei ← MakeNonCtxSe[SIZE[SERecord[cons][transfer]]];
    seb[tSei] ← SERecord[
	mark3: TRUE, mark4: TRUE,
	body: cons[transfer[
		mode: program, safe: FALSE,
		typeIn: RecordSENull, typeOut: RecordSENull]]];
   -- generate an id
    sei ← MakeConstant[moduleId, dirCtx, tSei];
    seb[sei].public ← TRUE;
    seb[sei].idValue ← PrincOps.ControlLink[
			  procedure[gfi: 1, ep: 0, tag: TRUE]];
    bti ← table.Words[SymbolSegment.bodyType, SIZE[BodyRecord[Callable][Outer]]];
    bb[bti] ← BodyRecord[
	link: [parent, BTNull], firstSon: BTNull,
	localCtx: CTXNull, type: RecordSENull, level: lG,
	sourceIndex: 0,
	info: [External[0, 0, 0]],
        extension: Callable[
	  inline: FALSE, id: ISENull, ioType: CSENull,
	  monitored: FALSE, noXfers: FALSE, resident: FALSE,
	  entry: FALSE, internal: FALSE, entryIndex: 0,
 	  hints: [FALSE, FALSE, FALSE, FALSE],
	  closure: Outer[]]];
    bb[bti].id ← sei;  bb[bti].ioType ← tSei;  bb[bti].localCtx ← bodyCtx;
    seb[sei].idInfo ← bti};

  SubStringDescriptor: TYPE = Strings.SubStringDescriptor;

  MakeConstant: PROC [name: Strings.String, ctx: CTXIndex, type: SEIndex]
      RETURNS [sei: ISEIndex] = {
    -- makes an se entry for a built-in constant
    desc: SubStringDescriptor ← [base:name, offset:0, length:name.length];
    sei ← MakeCtxSe[EnterString[@desc], ctx];
    seb[sei].idType ← type;
    seb[sei].immutable ← seb[sei].constant ← TRUE;
    seb[sei].extended ← seb[sei].public ← seb[sei].linkSpace ← FALSE;
    seb[sei].mark3 ← seb[sei].mark4 ← TRUE;
    RETURN};


  CreateSymbols: PROC [moduleId: Strings.String] = {
    ctx: CTXIndex;
    WHILE (ctx ← NewCtx[lZ]) IN StandardContext DO NULL ENDLOOP;
    dirCtx ← ctx;
    EnterModule[moduleId, NewCtx[lG]]};

  EnterHashMark: PROC = {
    -- marks end of symbols from source file in hash table
    desc: SubStringDescriptor ← [base:"  "L, offset:1, length:0];
    [] ← EnterString[@desc]};


  WriteSymbols: PUBLIC PROC [s: Stream.Handle, moduleId: Strings.String] = {
    zone: UNCOUNTED ZONE ← PGSConDefs.AcquireZone[];
    weights: ARRAY SymbolSegment.Tables OF Alloc.TableInfo ← ALL[[1]];
    table ← Alloc.Create[weights: DESCRIPTOR[weights]];
    table.AddNotify[Notify];
    SymbolOps.Initialize[table, zone];
    CreateSymbols[moduleId];
    EnterHashMark[];
    table.DropNotify[Notify];
    TableOut[s];
    SymbolOps.Finalize[];
    Alloc.Destroy[table]; table ← NIL;
    PGSConDefs.ReleaseZone[zone]};


  BytesPerWord: CARDINAL = Environment.bytesPerWord;

  TableOut: PROC [s: Stream.Handle] = {
    OPEN SymbolSegment;
    header: STHeader;
    d: WordOffset;

    WriteSubTable: PROC [selector: Table.Selector] = {
      base: Symbols.Base;
      size: CARDINAL;
      [base, size] ← table.Bounds[selector];
      s.PutBlock[[base, 0, size*BytesPerWord]]};

      BEGIN
      OPEN header;
      versionIdent ← SymbolSegment.VersionID;
      version ← LOOPHOLE[PGSConDefs.objectVersion];	-- for bootstrap
      sourceVersion ← LOOPHOLE[PGSConDefs.sourceVersion];
      creator ← LOOPHOLE[PGSConDefs.pgsVersion];
      definitionsFile ← FALSE;
      directoryCtx ← dirCtx;
      importCtx ←  outerCtx ← CTXNull;
      d ← SIZE[STHeader];
      hvBlock.offset ← d;  d ← d + (hvBlock.size ← SIZE[Symbols.HashVector]);
      htBlock.offset ← d;  d ← d + (htBlock.size ← table.Bounds[htType].size);
      ssBlock.offset ← d;  d ← d + (ssBlock.size ← table.Bounds[ssType].size);
      seBlock.offset ← d;  d ← d + (seBlock.size ← table.Bounds[seType].size);
      ctxBlock.offset ← d;
	d ← d + (ctxBlock.size ← table.Bounds[ctxType].size);  
      mdBlock.offset ← d;  d ← d + (mdBlock.size ← table.Bounds[mdType].size);
      bodyBlock.offset ← d;
	d ← d + (bodyBlock.size ←table.Bounds[bodyType].size);
      treeBlock ← litBlock ← sLitBlock ← extBlock ← [d, 0];
      constBlock ← [0, 0];
      fgRelPgBase ← fgPgCount ← 0;
      END;
    s.PutBlock[[@header, 0, SIZE[STHeader]*BytesPerWord]];
    s.PutBlock[[SymbolOps.HashBlock[], 0, header.hvBlock.size*BytesPerWord]];
    WriteSubTable[htType];
    WriteSubTable[ssType];
    WriteSubTable[seType];
    WriteSubTable[ctxType];
    WriteSubTable[mdType];
    WriteSubTable[bodyType]};

  started: BOOLEAN ← FALSE;
  IF ~started THEN {START SymbolPack; started ← TRUE};

  }.