-- file PGSSymbols.Mesa
-- last modified by Satterthwaite,  August 26, 1980  1:50 PM

DIRECTORY
  ControlDefs: TYPE USING [ControlLink],
  PGScondefs: TYPE USING [objectVersion, pgsVersion, sourceVersion],
  StreamDefs: TYPE USING [StreamHandle, WriteBlock],
  StringDefs: TYPE USING [SubStringDescriptor],
  Symbols: TYPE USING [
    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 ,
  SystemDefs: TYPE USING [AllocateSegment, FreeSegment],
  Table: TYPE USING [
    Base, Notifier, Region, Selector,
    AddNotify, Allocate, Bounds, Create, Destroy, DropNotify];

PGSSymbols: PROGRAM
    IMPORTS PGScondefs, StreamDefs, SymbolOps, SymbolPack, SystemDefs, Table
    EXPORTS PGScondefs =
  BEGIN
  OPEN SymbolOps, Symbols;

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

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

  dirCtx: CTXIndex;

  EnterModule: PROC [moduleId: STRING, bodyCtx: CTXIndex] = { 
    tSei: CSEIndex;
    sei: ISEIndex;
    bti: CBTIndex;
   -- generate a program type
    tSei _ MakeNonCtxSe[SIZE[transfer cons SERecord]];
    seb[tSei] _ SERecord[
	mark3: TRUE, mark4: TRUE,
	body: cons[transfer[
		mode: program, inRecord: RecordSENull, outRecord: RecordSENull]]];
   -- generate an id
    sei _ MakeConstant[moduleId, dirCtx, tSei];
    seb[sei].public _ TRUE;
    seb[sei].idValue _ ControlDefs.ControlLink[
			  procedure[gfi: 1, ep: 0, tag: procedure]];
    bti _ Table.Allocate[SymbolSegment.bodyType, SIZE[Outer Callable BodyRecord]];
    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, stopping: 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 = StringDefs.SubStringDescriptor;

  MakeConstant: PROC [name: 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];
      BEGIN  OPEN seb[sei];
      idType _ type;
      immutable _ constant _ TRUE;
      extended _ public _ linkSpace _ FALSE;
      mark3 _ mark4 _ TRUE;
      END;
    RETURN};


  CreateSymbols: PROC [moduleId: 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: StreamDefs.StreamHandle, moduleId: STRING] = {
    weights: ARRAY SymbolSegment.Tables OF CARDINAL _ ALL[1];
    tableRegion: Table.Region = [
      origin: LOOPHOLE[SystemDefs.AllocateSegment[256]],
      size: 256];
    Table.Create[tableRegion, DESCRIPTOR[weights]]; Table.AddNotify[Notify];
    SymbolOps.Initialize[];
    CreateSymbols[moduleId];
    EnterHashMark[];
    Table.DropNotify[Notify];
    TableOut[s];
    SymbolOps.Finalize[];  Table.Destroy[];
    SystemDefs.FreeSegment[LOOPHOLE[tableRegion.origin]]};


  TableOut: PROC [s: StreamDefs.StreamHandle] = {
    OPEN Table, SymbolSegment;
    header: STHeader;
    d: WordOffset;

    WriteSubTable: PROC [table: Table.Selector] = {
      OPEN Table;
      base: Table.Base;
      size: CARDINAL;
      [base, size] _ Table.Bounds[table];
      [] _ StreamDefs.WriteBlock[s, LOOPHOLE[base], size]};

      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 _ SymbolOps.HashBlock[].length);
      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;
    [] _ StreamDefs.WriteBlock[s, @header, SIZE[STHeader]];
    [] _ StreamDefs.WriteBlock[s, SymbolOps.HashBlock[].base, header.hvBlock.size];
    WriteSubTable[htType];
    WriteSubTable[ssType];
    WriteSubTable[seType];
    WriteSubTable[ctxType];
    WriteSubTable[mdType];
    WriteSubTable[bodyType]};

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

  END.