-- file ModuleMaker.Mesa
-- last edited by Satterthwaite, August 26, 1980  1:43 PM

DIRECTORY
  AltoDefs: TYPE USING [BytesPerPage, BytesPerWord],
  BcdDefs: TYPE ,
  MiscDefs: TYPE USING [GetNetworkNumber, Zero],
  OsStaticDefs: TYPE USING [OsStatics],
  PGScondefs: TYPE USING [WriteSymbols],
  SegmentDefs: TYPE USING [
    FileSegmentHandle, FileHandle, OldFileOnly, Append, Read, Write, NewFile],
  StreamDefs: TYPE USING [
    StreamHandle, StreamIndex, GetIndex,
    CreateWordStream, FileLength, NewWordStream,
    ReadBlock, SetIndex, WriteBlock],
  StringDefs: TYPE USING [AppendChar, AppendString, EquivalentString, WordsForString],
  SystemDefs: TYPE USING [
    AllocateHeapNode, AllocateSegment, FreeHeapNode, FreeSegment, PagesForWords],
  TableCommand: TYPE USING [CreateTime, FindInterface, FindItem, MyBcdVersion],
  TimeDefs: TYPE USING [CurrentDayTime];

ModuleMaker: PROGRAM
    IMPORTS
      MiscDefs, PGScondefs, SegmentDefs, StreamDefs,
      StringDefs, SystemDefs, TableCommand, TimeDefs
    EXPORTS PGScondefs, TableCommand =
  BEGIN  OPEN SegmentDefs;

 -- BCD construction

  bcdHeader: BcdDefs.BCD;
  module: BcdDefs.MTRecord;
  export: POINTER TO BcdDefs.EXPRecord;
  defsFile: BcdDefs.FTRecord;
  codeSeg, symbolSeg: BcdDefs.SGRecord;
  ssbString: STRING _ [60];
  ssb: POINTER TO BcdDefs.PackedString _ LOOPHOLE[ssbString];

  pgsVersion: PUBLIC BcdDefs.VersionStamp _ TableCommand.MyBcdVersion[];
  sourceVersion: PUBLIC BcdDefs.VersionStamp _ [0, 0, 0];
  objectVersion: PUBLIC BcdDefs.VersionStamp _ [
	time: LOOPHOLE[TimeDefs.CurrentDayTime[]],
	net: MiscDefs.GetNetworkNumber[],
	host: OsStaticDefs.OsStatics.SerialNumber];

  moduleIndex, segIndex: StreamDefs.StreamIndex;	-- for fixup
  moduleId: STRING _ [40];
  out: StreamDefs.StreamHandle;

  InitializePackedString: PROC = {
    ssb.string.length _ 1;  ssb.size[1] _ 0;  moduleId.length _ 0};

  AddName: PROC [n: STRING] RETURNS [name: BcdDefs.NameRecord] = {
    StringDefs.AppendChar[@ssb.string, LOOPHOLE[n.length]];
    name _ BcdDefs.NameRecord[ssb.string.length];
    StringDefs.AppendString[@ssb.string, n];
    RETURN};

  FillInModule: PROC [
      name: BcdDefs.NameRecord, segmentSize: CARDINAL, altoCode: BOOLEAN] = {
    OPEN BcdDefs;
    module _ MTRecord[
      name: name, namedInstance: FALSE, initial: FALSE,
      file: FTSelf, links: frame, config: CTNull, code: [sgi: FIRST[SGIndex],
      linkspace: FALSE, packed: FALSE, offset: 0, length: 2*segmentSize],
      sseg: FIRST[SGIndex]+SIZE[SGRecord], framesize: 4,
      altoCode: altoCode, long: FALSE, tableCompiled: TRUE,
      packageable: TRUE,
      residentFrame: FALSE, crossJumped: FALSE, boundsChecks: FALSE, nilChecks: FALSE,
      acMap: SGNull,
      gfi: 1, variables: EVNull, ngfi: 1, frame: [length: 0, frag: ]];
    codeSeg _ SGRecord[class: code, file: FTSelf, base: 2,
      pages: SystemDefs.PagesForWords[segmentSize], extraPages: 0];
    symbolSeg _ SGRecord[class: symbols, file: FTNull, base: 0,
      pages: 0, extraPages: 0]};

  FillInExport: PROC [name: BcdDefs.NameRecord, size, entry: CARDINAL] = {
    export _ SystemDefs.AllocateHeapNode[SIZE[BcdDefs.EXPRecord]+size];
    MiscDefs.Zero[export, SIZE[BcdDefs.EXPRecord]+size];
    export^ _ BcdDefs.EXPRecord[name: name, size: size, port: interface,
      namedInstance: FALSE, typeExported: FALSE, file: FIRST[BcdDefs.FTIndex], links:];
    export.links[entry] _ BcdDefs.Link[variable[vgfi:1, var:0, vtag:var]]};

  FillInHeader: PROC = {
    OPEN bcdHeader;
    net: CARDINAL = MiscDefs.GetNetworkNumber[];
    MiscDefs.Zero[@bcdHeader, SIZE[BcdDefs.BCD]];	-- clear all fields
    versionIdent _ BcdDefs.VersionID;
    version _ objectVersion;
    sourceVersion _ sourceVersion;
    creator _ pgsVersion;
    nPages _ 1;
    nConfigs _ 0;  nModules _ 1;
    nImports _ 0;  nExports _ IF export = NIL THEN 0 ELSE 1;
    definitions _ repackaged _ typeExported _ FALSE;  tableCompiled _ TRUE;
    firstdummy _ 2;  nDummies _ 0;
    ssOffset _ ctOffset _ impOffset _ ntOffset _ SIZE[BcdDefs.BCD];
    ssLimit _ StringDefs.WordsForString[ssb.string.length];
    mtOffset _ ssOffset + LOOPHOLE[ssLimit, CARDINAL];
    mtLimit _ LOOPHOLE[SIZE[BcdDefs.MTRecord]];
    sgOffset _ mtOffset + LOOPHOLE[mtLimit, CARDINAL];
    sgLimit _ LOOPHOLE[2*SIZE[BcdDefs.SGRecord]];
    IF export # NIL
      THEN {
	ftOffset _ sgOffset + LOOPHOLE[sgLimit, CARDINAL];
	ftLimit _ LOOPHOLE[SIZE[BcdDefs.FTRecord]];
	expOffset _ ftOffset + LOOPHOLE[ftLimit, CARDINAL];
	expLimit _ LOOPHOLE[SIZE[BcdDefs.EXPRecord]+export.size]};
    source _ BcdDefs.NullName};

  WriteBcd: PROC [out: StreamDefs.StreamHandle] = {
    OPEN StreamDefs;
    [] _ WriteBlock[out, @bcdHeader, SIZE[BcdDefs.BCD]];
    [] _ WriteBlock[out, ssb, StringDefs.WordsForString[ssb.string.length]];
    moduleIndex _ StreamDefs.GetIndex[out];
    [] _ WriteBlock[out, @module, SIZE[BcdDefs.MTRecord]];
    segIndex _ StreamDefs.GetIndex[out];
    [] _ WriteBlock[out, @codeSeg, SIZE[BcdDefs.SGRecord]];
    [] _ WriteBlock[out, @symbolSeg, SIZE[BcdDefs.SGRecord]];
    IF export # NIL
      THEN {
	[] _ WriteBlock[out, @defsFile, SIZE[BcdDefs.FTRecord]];
	[] _ WriteBlock[out, export, SIZE[BcdDefs.EXPRecord]+export.size];
	SystemDefs.FreeHeapNode[export]}};

  CreateBCDStream: PUBLIC PROC [
	in: StreamDefs.StreamHandle,
	modId, interfaceId: STRING,
	count: CARDINAL,
	altoCode: BOOLEAN _ TRUE]
      RETURNS [output: StreamDefs.StreamHandle] = {
    modRoot: STRING _ [40];
    interfaceRoot: STRING _ [40];
    symbolSeg: SegmentDefs.FileSegmentHandle;
    SetSourceVersion[in];
    FOR i: CARDINAL IN [0..modId.length)
      DO
      IF modId[i] = '. THEN EXIT;
      StringDefs.AppendChar[modRoot, modId[i]];
      ENDLOOP;
    out _ output _
      StreamDefs.NewWordStream[modId, SegmentDefs.Write+SegmentDefs.Append];
    InitializePackedString[];
    StringDefs.AppendString[moduleId, modRoot];
    FillInModule[AddName[modRoot], count, altoCode];
    FOR i: CARDINAL IN [0..interfaceId.length)
      DO
      IF interfaceId[i] = '. THEN EXIT;
      StringDefs.AppendChar[interfaceRoot, interfaceId[i]];
      ENDLOOP;
    -- fill in interface info
    IF StringDefs.EquivalentString[interfaceRoot, "SELF"L]
      THEN export _ NIL
      ELSE {
	dName: BcdDefs.NameRecord _ AddName[interfaceRoot];
	size, entry: CARDINAL;
	[defsFile.version, symbolSeg] _ TableCommand.FindInterface[interfaceRoot];
	defsFile.name _ dName;
	[size, entry] _ TableCommand.FindItem[symbolSeg, modRoot];
	FillInExport[dName, size, entry]};
    FillInHeader[]; -- Do this after all strings entered
    WriteBcd[out];
    StreamDefs.SetIndex[out, [1, 0]];
    RETURN};

  -- input management

  CheckForBr: PROC [name: STRING] RETURNS [BOOLEAN] = {
    FOR i: CARDINAL IN [0..name.length) DO
      IF name[i] = '. THEN GOTO extension;
      REPEAT
	extension =>
	  IF name.length = i+3 AND
            (name[i+1] = 'b OR name[i+1] = 'B) AND
            (name[i+2] = 'r OR name[i+2] = 'R) THEN RETURN[TRUE];
      ENDLOOP;
    RETURN[FALSE]};

  FindSegmentSize: PROC [br: BOOLEAN, file: SegmentDefs.FileHandle]
      RETURNS [count: CARDINAL, in: StreamDefs.StreamHandle] = {
    OPEN StreamDefs;
    in _ CreateWordStream[file, Read];
    IF br
      THEN {
	SetIndex[in, [0, 7*AltoDefs.BytesPerWord]];  count _ in.get[in];
	SetIndex[in, [0, count*AltoDefs.BytesPerWord]];  count _ in.get[in]}
      ELSE {
	eof: StreamIndex = StreamDefs.FileLength[in];
	count _ (eof.page*AltoDefs.BytesPerPage + eof.byte)/AltoDefs.BytesPerWord;
	in.reset[in]};
    RETURN};

  CreateSegmentStream: PROC [segmentId: STRING]
      RETURNS [in: StreamDefs.StreamHandle, count: CARDINAL] = {
    OPEN SegmentDefs;
    brFile: BOOLEAN = CheckForBr[segmentId];
    file: FileHandle = NewFile[segmentId, Read, OldFileOnly];
    [count, in] _ FindSegmentSize[brFile, file];
    RETURN};

  FixupBcdHeader: PUBLIC PROC = {
    OPEN AltoDefs;
    endIndex: StreamDefs.StreamIndex _ StreamDefs.GetIndex[out];
    nBytes: CARDINAL = (endIndex.page-1)*BytesPerPage + endIndex.byte;
    IF export # NIL THEN RETURN;
    module.code.length _ nBytes;
    codeSeg.pages _ SystemDefs.PagesForWords[(nBytes + (BytesPerWord-1))/BytesPerWord];
    IF bcdHeader.nExports = 0
      THEN {
	startIndex: StreamDefs.StreamIndex;
	symbolBytes: CARDINAL;
	UNTIL (startIndex _ StreamDefs.GetIndex[out]).byte = 0 DO out.put[out, 0] ENDLOOP;
	symbolSeg _ [
            class: symbols, file: BcdDefs.FTSelf,
            base: codeSeg.base+codeSeg.pages, pages: , extraPages: 0];
	PGScondefs.WriteSymbols[out, moduleId];
	endIndex _ StreamDefs.GetIndex[out];
	symbolBytes _ (endIndex.page-startIndex.page)*BytesPerPage + endIndex.byte;
	symbolSeg.pages _
	  SystemDefs.PagesForWords[(symbolBytes + (BytesPerWord-1))/BytesPerWord]};
    StreamDefs.SetIndex[out, moduleIndex];
    [] _ StreamDefs.WriteBlock[out, @module, SIZE[BcdDefs.MTRecord]];
    StreamDefs.SetIndex[out, segIndex];
    [] _ StreamDefs.WriteBlock[out, @codeSeg, SIZE[BcdDefs.SGRecord]];
    [] _ StreamDefs.WriteBlock[out, @symbolSeg, SIZE[BcdDefs.SGRecord]];
    StreamDefs.SetIndex[out, endIndex]};

  SetSourceVersion: PROC [sh: StreamDefs.StreamHandle] = {
    sourceVersion _ [0, 0, TableCommand.CreateTime[sh]]};

 -- overall control

  WriteSegment: PROC [in, out: StreamDefs.StreamHandle, count: CARDINAL] = {
    p: POINTER _ SystemDefs.AllocateSegment[count];
    [] _ StreamDefs.ReadBlock[in, p, count];
    IF StreamDefs.WriteBlock[out, p, count] # count THEN ERROR;
    SystemDefs.FreeSegment[p]};

  MakeModule: PUBLIC PROC [
      inputFile, moduleId, interfaceId: STRING, altocode: BOOLEAN] = {
    in, output: StreamDefs.StreamHandle;
    count: CARDINAL;
    [in, count] _ CreateSegmentStream[inputFile];
    output _ CreateBCDStream[in, moduleId, interfaceId, count, altocode];
    WriteSegment[in, output, count];
    FixupBcdHeader[];
    in.destroy[in];
    output.destroy[output]};

  END.