-- file Sequencer.Mesa
-- last modified by Sandman, Jan 15, 1980 1:54 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [PageSize],
  AltoFileDefs: FROM "altofiledefs" USING [LD, TIME],
  CharIO: FROM "chario" USING [CR, PutChar, PutOctal, PutString],
  CompilerOps: FROM "compilerops" USING [TableId, Transaction],
  CompilerUtil: FROM "compilerutil"
    USING [
      Pass1, Pass2, Pass3, Pass4, Code, PassIndex,
      P1Unit, P2Unit, P3Unit, P4Unit, P5module,
      EndObjectFile, PrintBodies, PrintSymbols, PrintTree, SetObjectStamp,
      StartObjectFile, TableOut],
  ComData: FROM "comdata"
    USING [
      compilerVersion, definitionsOnly, errorFile, errorStream,
      linkCount, netNumber, nErrors, nWarnings, objectBytes, objectFile,
      objectFrameSize, objectStream, objectVersion, ownSymbols,
      sourceFile, sourceStream, sourceTokens, sourceVersion, switches],
--ControlDefs: FROM "controldefs" USING [GlobalFrameHandle],
  Copier: FROM "copier" USING [FileInit, FileReset, OwnFile],
  FrameDefs: FROM "framedefs" USING [SwapOutCode],
  FrameOps: FROM "frameops" USING [CodeHandle],
  ImageDefs: FROM "imagedefs" USING [ImageVersion],
  LiteralOps: FROM "literalops" USING [Initialize, Finalize],
  Log: FROM "log" USING [Error],
  MiscDefs: FROM "miscdefs" USING [GetNetworkNumber],
  Mopcodes: FROM "mopcodes" USING [zEXCH],
  SegmentDefs: FROM "segmentdefs"
    USING [
      FileHandle, DataSegmentHandle, FileSegmentHandle, PageCount,
      Read, Write, Append, DefaultVersion, OldFileOnly, DefaultBase,
      CopyDataToFileSegment, DeleteDataSegment, DeleteFileSegment,
      FileSegmentAddress, InsufficientVM, MoveFileSegment, NewFile,
      NewFileSegment, SegmentAddress, SegmentFault, SetEndOfFile,
      SwapError, SwapIn, SwapOut, Unlock, MakeDataSegment, EasyUp],
  StreamDefs: FROM "streamdefs"
    USING [StreamHandle, StreamObject, CloseDiskStream, CreateByteStream],
  SystemDefs: FROM "systemdefs"
    USING [AllocateHeapNode, FreeHeapNode, PruneHeap],
  SymbolPack: FROM "symbolpack",
  SymbolTable: FROM "symboltable" USING [RestartCache, SuspendCache],
  SymbolOps: FROM "symbolops" USING [Finalize, Initialize],
  SymbolSegment: FROM "symbolsegment" USING [Tables],
  Table: FROM "table" USING [Region, Create, Destroy, Failure, Overflow],
  TrapDefs: FROM "trapdefs" USING [SendMsgSignal],
  Tree: FROM "tree" USING [Link],
  TreeOps: FROM "treeops" USING [Finalize, Initialize, PopTree];

Sequencer: PROGRAM [
    explicitSwapping: BOOLEAN,
    scratchFile: SegmentDefs.FileHandle,
    tableSegment: ARRAY CompilerOps.TableId OF SegmentDefs.FileSegmentHandle]
    IMPORTS
	CompilerUtil, Copier, Log, FrameDefs, FrameOps, ImageDefs,
	CharIO, LiteralOps, MiscDefs, SegmentDefs, StreamDefs,
	SymbolTable, SymbolOps, SystemDefs, Table, TrapDefs, TreeOps, 
	ownSymbols: SymbolPack, dataPtr: ComData
    EXPORTS CompilerOps, CompilerUtil = 
  BEGIN

-- overlay control

  PassIndex: TYPE = CompilerUtil.PassIndex;
  GlobalFrameHandle: TYPE = POINTER --ControlDefs.GlobalFrameHandle--;

  PassLink: TYPE = RECORD [
    frame: GlobalFrameHandle,
    link: POINTER TO PassLink];

  passRoot: ARRAY PassIndex OF POINTER TO PassLink _ ALL[NIL];

  LoadPass: PROCEDURE [pass: PassIndex] =
    BEGIN
    p: POINTER TO PassLink;
    handle: SegmentDefs.FileSegmentHandle;
    IF explicitSwapping THEN
      FOR p _ passRoot[pass], p.link UNTIL p = NIL
	DO
	IF (handle _ FrameOps.CodeHandle[p.frame]) # NIL
	  THEN
	    BEGIN	-- Don't use SwapInCode, it will mess up Start Traps
	    SegmentDefs.SwapIn[handle];  SegmentDefs.Unlock[handle];
	    END;
	ENDLOOP;
    END;

  UnloadPass: PROCEDURE [pass: PassIndex] =
    BEGIN
    p: POINTER TO PassLink;
    IF explicitSwapping THEN
      FOR p _ passRoot[pass], p.link UNTIL p = NIL
	DO
	FrameDefs.SwapOutCode[p.frame !SegmentDefs.SwapError => CONTINUE];
	ENDLOOP;
    [] _ SystemDefs.PruneHeap[];
    END;

  MakeSwappable: PUBLIC PROCEDURE [module: PROGRAM, pass: PassIndex] =
    BEGIN
    IF explicitSwapping THEN
      BEGIN
      frame: GlobalFrameHandle = LOOPHOLE[module];
      p: POINTER TO PassLink = SystemDefs.AllocateHeapNode[SIZE[PassLink]];
      q: POINTER TO PassLink;
      p^ _ PassLink[frame:frame, link:NIL];
      IF passRoot[pass] = NIL
	THEN passRoot[pass] _ p
	ELSE
	  BEGIN  q _ passRoot[pass];
	  UNTIL q.link = NIL DO q _ q.link ENDLOOP;
	  q.link _ p;
	  END;
      END;
    END;


-- cursor control

  Cursor: TYPE = MACHINE DEPENDENT RECORD [
    top: PRIVATE CursorRow,
    row1: CursorRow,
    m12: PRIVATE CursorFill,
    row2: CursorRow,
    m23: PRIVATE CursorFill,
    row3: CursorRow,
    bottom: PRIVATE CursorRow];

  TheCursor: POINTER TO Cursor = LOOPHOLE[431B];
  savedCursor: Cursor;

  CursorRow: TYPE = ARRAY [0..2) OF WORD;
  CursorFill: TYPE = ARRAY [0..3) OF WORD;

  Two: CursorRow = [147763B, 147763B];
  L1: CursorRow = [147777B, 147777B];
  R1: CursorRow = [177763B, 177763B];
  M1: CursorRow = [177177B, 177177B];

  ClearCursor: PROCEDURE =
    BEGIN
    CursorBase: POINTER = TheCursor;
    i: CARDINAL;
    FOR i IN [0 .. 16) DO (CursorBase+i)^ _ -1 ENDLOOP;
    END;


-- table storage management
  
  PageCount: TYPE = SegmentDefs.PageCount;

  TablePageStart: PageCount = 64;
  TablePageStep:  PageCount = 8;
  TablePageLimit: PageCount = 128;

  tableDataSegment: SegmentDefs.DataSegmentHandle;
  scratchFileSegment: SegmentDefs.FileSegmentHandle;
  tablePages: PageCount;

  tableRegion: Table.Region;

  LoadTable: PROCEDURE [nPages: PageCount] =
    BEGIN
    OPEN SegmentDefs;
    IF nPages # tablePages
      THEN
	BEGIN
	IF scratchFileSegment = NIL
	  THEN
	    BEGIN
	    scratchFileSegment _ NewFileSegment[
		file: scratchFile,
		base: DefaultBase,
		pages: tablePages,
		access: Read+Write];
	    CopyDataToFileSegment[tableDataSegment, scratchFileSegment
	      ! SegmentFault =>
		BEGIN
		SetEndOfFile[scratchFile, scratchFileSegment.base+nPages, 0];
		RETRY
		END];
	    DeleteDataSegment[tableDataSegment];  tableDataSegment _ NIL;
	    END
	  ELSE
	    BEGIN Unlock[scratchFileSegment]; SwapOut[scratchFileSegment] END;
	MoveFileSegment[scratchFileSegment, DefaultBase, nPages];
	tablePages _ nPages;
	SwapIn[scratchFileSegment ! SegmentFault =>
	  BEGIN
	  SetEndOfFile[scratchFile, scratchFileSegment.base+nPages, 0];
	  RETRY
	  END];
	END;
    tableRegion _ [
	origin: LOOPHOLE[SegmentAddress[IF tableDataSegment # NIL
		    THEN tableDataSegment ELSE scratchFileSegment]],
	size: tablePages*AltoDefs.PageSize];
    END;
    

-- table segments

  TableSegment: PUBLIC PROCEDURE [id: CompilerOps.TableId]
      RETURNS [SegmentDefs.FileSegmentHandle] =
    BEGIN  RETURN [tableSegment[id]]  END;


-- compiler sequencing

  pass: CHARACTER ['1..'5];

  Initialize: PROCEDURE =
    BEGIN
    weights: ARRAY SymbolSegment.Tables OF CARDINAL _
      [20, 8, 2, 4, 2, 2, 2, 1, 1, 1];  -- relative sizes (empirical)
    savedCursor _ TheCursor^;  ClearCursor[];
    LoadTable[TablePageStart];
    Table.Create[tableRegion, DESCRIPTOR[weights]];
    SymbolOps.Initialize[];  LiteralOps.Initialize[];  TreeOps.Initialize[];
    END;

  Finalize: PROCEDURE [parms: POINTER TO CompilerOps.Transaction] =
    BEGIN
    parms.sourceTokens _ dataPtr.sourceTokens;
    parms.nErrors _ dataPtr.nErrors;  parms.nWarnings _ dataPtr.nWarnings;
    parms.objectBytes _ dataPtr.objectBytes;
    parms.objectFrameSize _ dataPtr.objectFrameSize;  
    parms.linkCount _ dataPtr.linkCount;
    IF dataPtr.objectStream # NIL
      THEN CompilerUtil.EndObjectFile[dataPtr.nErrors=0];
    TreeOps.Finalize[];  LiteralOps.Finalize[];  SymbolOps.Finalize[];
    Table.Destroy[];
    TheCursor^ _ savedCursor;
    END;

  Debug: PROCEDURE [tree, symbols: PROCEDURE] =
    BEGIN  LoadPass[debug];  tree[];  symbols[];  UnloadPass[debug]  END;


  ErrorPut: PROCEDURE [s: StreamDefs.StreamHandle, c: CHARACTER] =
    BEGIN OPEN SegmentDefs;
    s.destroy[s];
    dataPtr.errorStream _ StreamDefs.CreateByteStream[
		NewFile[dataPtr.errorFile, Write+Append, DefaultVersion],
		Write+Append];
    dataPtr.errorStream.put[dataPtr.errorStream, c];
    END;

  ErrorDestroy: PROCEDURE [s: StreamDefs.StreamHandle] =
    BEGIN SystemDefs.FreeHeapNode[s] END;

  NoSource: PUBLIC ERROR = CODE;
  Punt: PUBLIC ERROR = CODE;

  CreateTime: PROCEDURE [s: StreamDefs.StreamHandle] RETURNS [time: LONG INTEGER] =
    BEGIN
    WITH s: s SELECT FROM
      Disk =>
	BEGIN  OPEN SegmentDefs;
	Exch: PROCEDURE [AltoFileDefs.TIME] RETURNS [LONG INTEGER] =
	  MACHINE CODE BEGIN  Mopcodes.zEXCH  END;
	seg: FileSegmentHandle _ NewFileSegment[s.file, 0, 1, Read];
	p: POINTER TO AltoFileDefs.LD;
	SwapIn[seg];  p _ FileSegmentAddress[seg];
	time _ Exch[p.created];
	Unlock[seg];  DeleteFileSegment[seg];
	END;
      ENDCASE =>  time _ 0;
    END;


  Compile: PUBLIC PROCEDURE [parms: POINTER TO CompilerOps.Transaction] =
    BEGIN
    root: Tree.Link;
    objectFileHint: SegmentDefs.FileHandle;
    msg, signal: UNSPECIFIED;
    nParseErrors: CARDINAL;
    parsed, aborted: BOOLEAN;

    PrintTreeRoot: PROCEDURE = BEGIN CompilerUtil.PrintTree[root] END;

    IF parms.source.stream = NIL
      THEN
	BEGIN  OPEN SegmentDefs;
	ENABLE ANY => GO TO noSource;
	parms.source.stream _ StreamDefs.CreateByteStream[
		NewFile[parms.source.name, Read, OldFileOnly],
		Read];
	EXITS
	  noSource => ERROR NoSource;
	END;
    IF parms.error.stream = NIL
      THEN
	BEGIN
	parms.error.stream _
	  SystemDefs.AllocateHeapNode[SIZE[Other StreamDefs.StreamObject]];
	parms.error.stream^ _ 
	  [NULL, NULL, NULL, ErrorPut, NULL, ErrorDestroy, NIL, Other[,]];
	END;
    [dataPtr.sourceFile, dataPtr.sourceStream] _ parms.source;
    [dataPtr.objectFile, dataPtr.objectStream] _ parms.object;
    [dataPtr.errorFile, dataPtr.errorStream] _ parms.error;
    dataPtr.switches _ parms.switches;

    dataPtr.sourceVersion _ [0, 0, CreateTime[parms.source.stream]];
    dataPtr.nErrors _ dataPtr.nWarnings _ 0;  aborted _ FALSE;
    Initialize[];

      BEGIN
      ENABLE 
	BEGIN
	Table.Overflow => 
	  BEGIN
	  IF tablePages < TablePageLimit THEN
	    BEGIN 
	    LoadTable[tablePages+TablePageStep
	      ! SegmentDefs.InsufficientVM => IF ~dataPtr.switches['d] THEN
		GO TO storageFragmented];
	    RESUME[tableRegion]
	    END;
	  IF ~dataPtr.switches['d] THEN GO TO storageFull;
	  END;
	Table.Failure =>  IF ~dataPtr.switches['d] THEN GO TO storageFull;
	UNWIND =>  Finalize[parms];
	ANY =>
	  IF ~dataPtr.switches['d] THEN
	    BEGIN
	    [msg, signal] _ TrapDefs.SendMsgSignal[]; GO TO uncaughtSignal
	    END
	END;

    -- first pass
      pass _ '1;  LoadPass[pass1];
      TheCursor.row2 _ M1;
      parsed _ CompilerUtil.P1Unit[];
      nParseErrors _ dataPtr.nErrors;
      ClearCursor[];  UnloadPass[pass1];
      IF ~parsed THEN GO TO failed;
      root _ TreeOps.PopTree[];
      StreamDefs.CloseDiskStream[dataPtr.sourceStream];
      IF parms.debugPass <= 1
	THEN Debug[PrintTreeRoot, CompilerUtil.PrintSymbols];

    -- second pass
      pass _ '2;  LoadPass[pass2];
      TheCursor.row1 _ L1; TheCursor.row3 _ R1;
      root _ CompilerUtil.P2Unit[root];
      ClearCursor[];  UnloadPass[pass2];
      IF parms.debugPass <= 2
	THEN Debug[PrintTreeRoot, CompilerUtil.PrintSymbols];
      IF dataPtr.nErrors # 0 THEN dataPtr.switches['x] _ FALSE;

    -- third and fourth passes
      CompilerUtil.SetObjectStamp[];
      Copier.FileInit[dataPtr.objectFile, dataPtr.objectVersion];
      objectFileHint _ NIL;

	BEGIN
	  ENABLE
	    BEGIN
	    Table.Overflow =>
	      BEGIN
	      IF tablePages >= TablePageLimit THEN GO TO noSpace;
	      SymbolTable.SuspendCache[];
	      LoadTable[tablePages+TablePageStep
		! SegmentDefs.InsufficientVM => GO TO noVM];
	      SymbolTable.RestartCache[];
	      RESUME[tableRegion]
	      END;
	    Table.Failure => GO TO noSpace;
	    Copier.OwnFile => BEGIN objectFileHint _ file; RESUME END;
	    END;

	pass _ '3;  LoadPass[pass3];
	TheCursor.row1 _ R1; TheCursor.row2 _ M1; TheCursor.row3 _ L1; 
	root _ CompilerUtil.P3Unit[root];
	ClearCursor[];  UnloadPass[pass3];

	IF parms.debugPass <= 3
	  THEN Debug[PrintTreeRoot, CompilerUtil.PrintSymbols];
	IF dataPtr.nErrors > nParseErrors THEN GO TO DeleteFiles;

	IF dataPtr.objectStream = NIL
	  THEN  parms.object.stream _ dataPtr.objectStream _
		  CompilerUtil.StartObjectFile[objectFileHint];

	pass _ '4;  LoadPass[pass4];
	TheCursor.row1 _ TheCursor.row3 _ Two;
	CompilerUtil.P4Unit[root];
	ClearCursor[];  UnloadPass[pass4];
	IF parms.debugPass <= 4
	  THEN Debug[CompilerUtil.PrintBodies, CompilerUtil.PrintSymbols];
	GO TO DeleteFiles;

	EXITS
	  DeleteFiles => Copier.FileReset[];
	  noSpace =>  BEGIN Copier.FileReset[]; GO TO storageFull END;
	  noVM =>  BEGIN Copier.FileReset[]; GO TO storageFragmented END;
	END;

      IF dataPtr.nErrors # 0 THEN GO TO failed;

    -- fifth pass
      IF ~dataPtr.definitionsOnly THEN
	BEGIN
	ENABLE  UNWIND =>  CompilerUtil.EndObjectFile[FALSE];
	pass _ '5;  LoadPass[pass5];
	TheCursor.row1 _ TheCursor.row3 _ Two; TheCursor.row2 _ M1;
	CompilerUtil.P5module[];
	ClearCursor[];  UnloadPass[pass5];
	END;

      TheCursor.row1 _ TheCursor.row2 _ TheCursor.row3 _ Two;
      CompilerUtil.TableOut[dataPtr.sourceFile];
      IF dataPtr.nErrors # 0 THEN GO TO failed;

      EXITS
	failed =>  aborted _ TRUE;
	uncaughtSignal =>
	  BEGIN  OPEN CharIO;
	  Log.Error[compilerError];  aborted _ TRUE;
	  PutString[dataPtr.errorStream, "Pass = "L];
	  PutChar[dataPtr.errorStream, pass];
	  PutString[dataPtr.errorStream, ", signal = "L];
	  PutOctal[dataPtr.errorStream, signal];
	  PutString[dataPtr.errorStream, ", message = "L];
	  PutOctal[dataPtr.errorStream, msg];
	  PutChar[dataPtr.errorStream, CR];
	  Finalize[parms];  ERROR Punt[]
	  END;
	storageFragmented =>  StorageProblem["Too Fragmented"L];
	storageFull =>  StorageProblem["Overflow"L];
      END;

    Finalize[parms];

    END;

  StorageProblem: PROCEDURE [message: STRING] =
    BEGIN  OPEN CharIO;
    dataPtr.nErrors _ dataPtr.nErrors+1;
    PutChar[dataPtr.errorStream, CR];
    PutString[dataPtr.errorStream, "Storage "L];
    PutString[dataPtr.errorStream, message];
    PutString[dataPtr.errorStream, " in Pass "L];
    PutChar[dataPtr.errorStream, pass];
    PutChar[dataPtr.errorStream, CR];
    END;


-- * * * * * *  M A I N   B O D Y   C O D E  * * * * * *

  START dataPtr; 	-- initialize STRING variables, etc.
  START ownSymbols;
  dataPtr.ownSymbols _ ownSymbols;

-- set up swapping
  BEGIN  OPEN CompilerUtil;
  MakeSwappable[Pass1, pass1];  --START Pass1;  UnloadPass[pass1];
  MakeSwappable[Pass2, pass2];  --START Pass2;  UnloadPass[pass2];
  MakeSwappable[Pass3, pass3];  --START Pass3;  UnloadPass[pass3];
  MakeSwappable[Pass4, pass4];  --START Pass4;  UnloadPass[pass4];
  MakeSwappable[Code, pass5];   --START Code;   UnloadPass[pass5];
  END;

  dataPtr.compilerVersion _ ImageDefs.ImageVersion[];
  dataPtr.netNumber _ MiscDefs.GetNetworkNumber[];

-- obtain the scratch area
  tableDataSegment _ SegmentDefs.MakeDataSegment[
	base: SegmentDefs.DefaultBase,
	pages: TablePageStart,
	info: SegmentDefs.EasyUp];
  tablePages _ TablePageStart;
  scratchFileSegment _ NIL;

  END.