ORCA-C/Header.pas

{$optimize 7}
{---------------------------------------------------------------}
{								}
{  Header							}
{								}
{  Handles saving and reading precompiled headers.		}
{								}
{---------------------------------------------------------------}

unit Header;

interface

{$LibPrefix '0/obj/'}

uses CCommon, MM, Scanner, Symbol, CGI;

{$segment 'SCANNER'}

const
   symFileVersion = 10;                 {version number of .sym file format}

var
   inhibitHeader: boolean;		{should .sym includes be blocked?}


procedure EndInclude (chPtr: ptr);

{ Saves symbols created by the include file			}
{								}
{ Parameters:							}
{    chPtr - chPtr when the file returned			}
{								}
{ Notes:							}
{    1. Call this subroutine right after processing an		}
{       include file.						}
{    2. Declared externally in Symbol.pas			}


procedure FlagPragmas (pragma: pragmas);

{ record the effects of a pragma				}
{								}
{ parameters:							}
{    pragma - pragma to record					}
{								}
{ Notes:							}
{    1. Defined as extern in Scanner.pas			}
{    2. For the purposes of this unit, the segment statement is	}
{	treated as a pragma.					}


procedure InitHeader (var fName: gsosOutString);

{ look for a header file, reading it if it exists		}
{								}
{ parameters:							}
{    fName - source file name (var for efficiency)		}


procedure TermHeader;

{ Stop processing the header file				}
{								}
{ Note: This is called when the first code-generating		}
{    subroutine is found, and again when the compile ends.  It	}
{    closes any open symbol file, and should take no action if	}
{    called twice.						}


procedure StartInclude (name: gsosOutStringPtr);

{ Marks the start of an include file				}
{								}
{ Notes:							}
{    1. Call this subroutine right after opening an include	}
{       file.							}
{    2. Defined externally in Scanner.pas			}

{---------------------------------------------------------------}

implementation

const
   symFiletype = $5E;			{symbol file type}
   symAuxtype = $008008;

					{file buffer}
                                        {-----------}
   bufSize = 1024;			{size of output buffer}

type                   
   closeOSDCB = record
      pcount: integer;
      refNum: integer;
      end;

   createOSDCB = record
      pcount: integer;
      pathName: gsosInStringPtr;
      access: integer;
      fileType: integer;
      auxType: longint;
      storageType: integer;
      dataEOF: longint;
      resourceEOF: longint;
      end;

   destroyOSDCB = record
      pcount: integer;
      pathName: gsosInStringPtr;
      end;

   getFileInfoOSDCB = record
      pcount: integer;
      pathName: gsosInStringPtr;
      access: integer;
      fileType: integer;
      auxType: longint;
      storageType: integer;
      createDateTime: timeField;
      modDateTime: timeField;
      optionList: optionListPtr;
      dataEOF: longint;
      blocksUsed: longint;
      resourceEOF: longint;
      resourceBlocks: longint;
      end;

   getMarkOSDCB = record
      pcount: integer;
      refNum: integer;
      displacement: longint;
      end;

   openOSDCB = record
      pcount: integer;
      refNum: integer;
      pathName: gsosInStringPtr;
      requestAccess: integer;
      resourceNumber: integer;
      access: integer;
      fileType: integer;
      auxType: longint;
      storageType: integer;
      createDateTime: timeField;
      modDateTime: timeField;
      optionList: optionListPtr;
      dataEOF: longint;
      blocksUsed: longint;
      resourceEOF: longint;
      resourceBlocks: longint;
      end;

   readWriteOSDCB = record
      pcount: integer;
      refNum: integer;
      dataBuffer: ptr;
      requestCount: longint;
      transferCount: longint;
      cachePriority: integer;
      end;

   setMarkOSDCB = record
      pcount: integer;
      refNum: integer;
      base: integer;
      displacement: longint;
      end;

					{file buffer}
                                        {-----------}
   bufferType = array[0..bufSize] of byte; {output buffer}

var
   codeStarted: boolean;		{has code generation started?}
   includeLevel: 0..maxint;		{nested include level}
   includeMark: boolean;		{has the mark field been written?}
   savePragmas: set of pragmas;		{pragmas to record}
   saveSource: boolean;			{save source streams?}
   symChPtr: ptr;			{chPtr at start of current source sequence}
   symEndPtr: ptr;			{points to first byte past end of file}
   symMark: longint;			{start of current block}
   symName: gsosOutString;		{symbol file name}
   symStartPtr: ptr;			{first byte in the symbol file}
   symPtr: ptr;				{next byte in the symbol file}
   symRefnum: integer;			{symName reference number}
   tokenMark: longint;			{start of last token list}

					{file buffer}
                                        {-----------}
   buffer: ^bufferType;			{output buffer}
   bufPtr: ^byte;			{next available byte}
   bufLen: 0..bufSize;			{bytes left in buffer}

{---------------------------------------------------------------}

procedure BlockMove (sourcPtr, destPtr: ptr; count: longint); tool ($02, $2B);

procedure CloseGS (var parms: closeOSDCB); prodos ($2014);

procedure CreateGS (var parms: createOSDCB); prodos ($2001);

procedure DestroyGS (var parms: destroyOSDCB); prodos ($2002);

procedure GetFileInfoGS (var parms: getFileInfoOSDCB); prodos ($2006);

procedure GetMarkGS (var parms: getMarkOSDCB); prodos ($2017);

procedure OpenGS (var parms: openOSDCB); prodos ($2010);

procedure SetEOFGS (var parms: setMarkOSDCB); prodos ($2018);

procedure SetMarkGS (var parms: setMarkOSDCB); prodos ($2016);

procedure WriteGS (var parms: readWriteOSDCB); prodos ($2013);

{---------------------------------------------------------------}

procedure DestroySymbolFile;

{ Delete any existing symbol file				}

var
   dsRec: destroyOSDCB;			{DestroyGS record}
   giRec: getFileInfoOSDCB;		{GetFileInfoGS record}

begin {DestroySymbolFile}
giRec.pCount := 4;
giRec.pathname := @symName.theString;
GetFileInfoGS(giRec);
if (giRec.filetype = symFiletype) and (giRec.auxtype = symAuxtype) then begin
   dsRec.pCount := 1;			
   dsRec.pathname := @symName.theString;
   DestroyGS(dsRec);
   end; {if}
end; {DestroySymbolFile}


procedure Purge;

{ Purge the output buffer					}

var
   clRec: closeOSDCB;			{CloseGS record}
   wrRec: readWriteOSDCB;		{WriteGS record}

begin {Purge}
wrRec.pcount := 4;
wrRec.refnum := symRefnum;
wrRec.dataBuffer := pointer(buffer);
wrRec.requestCount := (bufSize - bufLen);
WriteGS(wrRec);
if ToolError <> 0 then begin
   clRec.pCount := 1;
   clRec.refnum := symRefnum;
   CloseGS(clRec);
   DestroySymbolFile;
   saveSource := false;
   end; {if}
bufLen := bufSize;
bufPtr := pointer(buffer);
end; {Purge}


procedure CloseSymbols;

{ Close the symbol file						}

var
   clRec: closeOSDCB;			{CloseGS record}

begin {CloseSymbols}
Purge;
clRec.pCount := 1;
clRec.refnum := symRefnum;
CloseGS(clRec);
if numErrors <> 0 then
   DestroySymbolFile;
end; {CloseSymbols}


function ReadDouble: double;

{ Read a double precision real from the symbol file		}
{								}
{ Returns: value read						}

type
   doubleptr = ^double;

begin {ReadDouble}
ReadDouble := doubleptr(symPtr)^;
symPtr := pointer(ord4(symPtr)+8);
end; {ReadDouble}


function ReadLong: longint;

{ Read a long word from the symbol file				}
{								}
{ Returns: long word read					}

type
   longptr = ^longint;

begin {ReadLong}
ReadLong := longptr(symPtr)^;
symPtr := pointer(ord4(symPtr)+4);
end; {ReadLong}


function ReadLongString: longStringPtr;

{ Read a long string from the symbol file			}
{								}
{ Returns: string read						}

var
   len: 0..maxint;			{string buffer length}
   sp1, sp2: longStringPtr;		{work pointers}

begin {ReadLongString}
sp1 := longStringPtr(symPtr);
len := sp1^.length + 2;
symPtr := pointer(ord4(symPtr) + len);
sp2 := pointer(GMalloc(len));
BlockMove(sp1, sp2, len);
ReadLongString := sp2;
end; {ReadLongString}


function ReadString: stringPtr;

{ Read a string from the symbol file				}
{								}
{ Returns: string read						}

var
   len: 0..255;				{string buffer length}
   sp1, sp2: stringPtr;			{work pointers}

begin {ReadString}
sp1 := stringptr(symPtr);
len := length(sp1^) + 1;
symPtr := pointer(ord4(symPtr) + len);
sp2 := pointer(GMalloc(len));
BlockMove(sp1, sp2, len);
ReadString := sp2;
end; {ReadString}


function ReadByte: integer;

{ Read a byte from the symbol file				}
{								}
{ Returns: byte read						}

type
   intptr = ^integer;

begin {ReadByte}
ReadByte := (intptr(symPtr)^) & $00FF;
symPtr := pointer(ord4(symPtr)+1);
end; {ReadByte}


function ReadWord: integer;

{ Read a word from the symbol file				}
{								}
{ Returns: word read						}

type
   intptr = ^integer;

begin {ReadWord}
ReadWord := intptr(symPtr)^;
symPtr := pointer(ord4(symPtr)+2);
end; {ReadWord}


procedure ReadChars (var p1, p2: ptr);

{ Read a character stream from the file				}
{								}
{ parameters:							}
{    p1 - (output) pointer to first char in stream		}
{    p2 - (output) points one past last char in stream		}

var
   len: integer;			{length of the stream}

begin {ReadChars}
len := ReadWord;
p1 := pointer(GMalloc(len));
p2 := pointer(ord4(p1) + len);
BlockMove(symPtr, p1, len);
symPtr := pointer(ord4(symPtr) + len);
end; {ReadChars}


procedure WriteDouble (d: double);

{ Write a double constant to the symbol file			}
{								}
{ parameters:							}
{    d - constant to write					}

var
   dPtr: ^double;			{work pointer}

begin {WriteDouble}
if bufLen < 8 then
   Purge;
dPtr := pointer(bufPtr);
dPtr^ := d;
bufPtr := pointer(ord4(bufPtr) + 8);
bufLen := bufLen - 8;
end; {WriteDouble}


procedure WriteLong (i: longint);

{ Write a long word to the symbol file				}
{								}
{ parameters:							}
{    i - long word to write					}

var
   lPtr: ^longint;			{work pointer}

begin {WriteLong}
if bufLen < 4 then
   Purge;
lPtr := pointer(bufPtr);
lPtr^ := i;
bufPtr := pointer(ord4(bufPtr) + 4);
bufLen := bufLen - 4;
end; {WriteLong}


procedure WriteByte (i: integer);

{ Write a byte to the symbol file				}
{								}
{ parameters:							}
{    i - byte to write						}

var
   iPtr: ^byte;				{work pointer}
    
begin {WriteByte}
if bufLen = 0 then
   Purge;
iPtr := pointer(bufPtr);
iPtr^ := i;
bufPtr := pointer(ord4(bufPtr) + 1);
bufLen := bufLen - 1;
end; {WriteByte}


procedure WriteWord (i: integer);

{ Write a word to the symbol file				}
{								}
{ parameters:							}
{    i - word to write						}

var
   iPtr: ^integer;			{work pointer}
    
begin {WriteWord}
if bufLen < 2 then
   Purge;
iPtr := pointer(bufPtr);
iPtr^ := i;
bufPtr := pointer(ord4(bufPtr) + 2);
bufLen := bufLen - 2;
end; {WriteWord}


procedure WriteLongString (s: longStringPtr);

{ Write a long string to the symbol file			}
{								}
{ parameters:							}
{    s - pointer to the string to write				}

var
   i: 0..maxint;			{loop/index variables}
   len: 0..maxint;			{string length}
   wrRec: readWriteOSDCB;		{WriteGS record}
     
begin {WriteLongString}
len := s^.length;
if bufLen < len+2 then
   Purge;
if bufLen < len+2 then begin
   wrRec.pcount := 4;
   wrRec.refnum := symRefnum;
   wrRec.dataBuffer := pointer(s);
   wrRec.requestCount := s^.length + 2;
   WriteGS(wrRec);
   if ToolError <> 0 then begin
      CloseSymbols;
      DestroySymbolFile;
      saveSource := false;
      end; {if}
   end {if}
else begin
   WriteWord(len);
   for i := 1 to len do begin
      bufPtr^ := ord(s^.str[i]);
      bufPtr := pointer(ord4(bufPtr) + 1);
      end; {for}
   bufLen := bufLen - len;
   end; {else}
end; {WriteLongString}


procedure WriteChars (p1, p2: ptr);

{ Write a stream of chars as a longString			}
{								}
{ parameters:							}
{    p1 - points to the first char to write			}
{    p2 - points to the byte following the last char		}

var
   i: 0..maxint;			{loop/index variables}
   len: 0..maxint;			{char length}
   wrRec: readWriteOSDCB;		{WriteGS record}

begin {WriteChars}
len := ord(ord4(p2) - ord4(p1));
WriteWord(len);
if bufLen < len then
   Purge;
if bufLen < len then begin
   if saveSource then begin
      wrRec.pcount := 4;
      wrRec.refnum := symRefnum;
      wrRec.dataBuffer := pointer(p1);
      wrRec.requestCount := ord4(p2) - ord4(p1);
      WriteGS(wrRec);
      if ToolError <> 0 then begin
	 CloseSymbols;
	 DestroySymbolFile;
	 saveSource := false;
	 end; {if}
      end; {if}
   end {if}
else begin
   for i := 1 to len do begin
      bufPtr^ := p1^;
      bufPtr := pointer(ord4(bufPtr)+1);
      p1 := pointer(ord4(p1)+1);
      end; {for}
   bufLen := bufLen - len;
   end; {else}
end; {WriteChars}


procedure WriteString (s: stringPtr);

{ Write a string to the symbol file				}
{								}
{ parameters:							}
{    s - pointer to the string to write				}

var
   i: 0..255;				{loop/index variable}
   len: 0..255;				{length of the string}

begin {WriteString}
len := length(s^);
if bufLen < len+1 then
   Purge;
for i := 0 to len do begin
   bufPtr^ := ord(s^[i]);
   bufPtr := pointer(ord4(bufPtr)+1);
   end; {for}
bufLen := bufLen - (len + 1);
end; {WriteString}


procedure MarkBlock;

{ Mark the length of the current block				}

var
   l: longint;				{block length}
   smRec: setMarkOSDCB;			{SetMarkGS record}
   gmRec: getMarkOSDCB;			{GetMarkGS record}
   wrRec: readWriteOSDCB;		{WriteGS record}
      
begin {MarkBlock}
Purge;					{purge the buffer}
gmRec.pCount := 2;			{get the current EOF}
gmRec.refnum := symRefnum;
GetMarkGS(gmRec);
if ToolError = 0 then begin
   smRec.pcount := 3;			{set the mark to the block length field}
   smRec.refnum := symRefnum;
   smRec.base := 0;
   smRec.displacement := symMark;
   SetMarkGS(smRec);
   if ToolError = 0 then begin
      l := gmRec.displacement - smRec.displacement - 4;
      wrRec.pcount := 4;
      wrRec.refnum := symRefnum;
      wrRec.dataBuffer := @l;
      wrRec.requestCount := 4;
      WriteGS(wrRec);
      if ToolError <> 0 then begin
	 CloseSymbols;
	 DestroySymbolFile;
	 saveSource := false;
	 end; {if}
      smRec.displacement := gmRec.displacement;
      SetMarkGS(smRec);
      end; {if}
   end; {if}
if ToolError <> 0 then begin		{for errors, delete the symbol file}
   CloseSymbols;
   DestroySymbolFile;
   saveSource := false;
   end; {if}
end; {MarkBlock}


function GetMark: longint;

{ Find the current file mark					}
{								}
{ Returns: file mark						}

var
   gmRec: getMarkOSDCB;			{GetMarkGS record}

begin {GetMark}
gmRec.pCount := 2;
gmRec.refnum := symRefnum;
GetMarkGS(gmRec);
GetMark := gmRec.displacement + (bufSize - bufLen);
if ToolError <> 0 then begin
   CloseSymbols;
   DestroySymbolFile;
   saveSource := false;
   end; {else}
end; {GetMark}


procedure SetMark;

{ Mark the start of a block					}

begin {SetMark}
symMark := GetMark;
WriteLong(0);
end; {SetMark}

{---------------------------------------------------------------}

procedure EndInclude {chPtr: ptr};

{ Saves symbols created by the include file			}
{								}
{ Parameters:							}
{    chPtr - chPtr when the file returned			}
{								}
{ Notes:							}
{    1. Call this subroutine right after processing an		}
{       include file.						}
{    2. Declared externally in Scanner.pas			}


   procedure SaveMacroTable;

   { Save macros to the symbol file				}


      procedure SaveMacros;

      { Write the macros to the symbol file			}

      var
         i: 0..hashSize;		{loop/index variable}
         mp: macroRecordPtr;		{used to trace macro lists}
         tp: tokenListRecordPtr;	{used to trace token lists}


	 procedure WriteToken (var token: tokenType);

	 { Write a token in the header file				}
	 {								}
	 { parameters:							}
	 {    token - token to write					}

	 begin {WriteToken}
	 WriteByte(ord(token.kind));
	 WriteByte(ord(token.class));
         if token.numstring = nil then
            WriteByte(0)
         else begin
            WriteByte(1);
            WriteString(token.numstring);
            end; {else}
	 case token.class of
	    identifier:		WriteString(token.name);
	    intConstant:	WriteWord(token.ival);
	    longConstant:	WriteLong(token.lval);
	    longlongConstant:	begin
                		WriteLong(token.qval.lo);
                		WriteLong(token.qval.hi);
                		end;
	    doubleConstant:	WriteDouble(token.rval);
	    stringConstant:	begin
				WriteLongString(token.sval);
                		WriteByte(ord(token.ispstring));
                		end;
            macroParameter:	WriteWord(token.pnum);
            reservedSymbol:	if token.kind in [lbracech,rbracech,lbrackch,
                                   rbrackch,poundch,poundpoundop] then 
                                   WriteByte(ord(token.isDigraph));
	    otherwise:	;
	    end; {case}
	 end; {WriteToken}


      begin {SaveMacros}
      for i := 0 to hashSize do begin	{loop over hash buckets}
         mp := macros^[i];		{loop over macro records in hash bucket}
         while mp <> nil do begin
            if not mp^.saved then begin
               mp^.saved := true;	{mark this one as saved}
               WriteString(mp^.name);	{write the macroRecord}
               WriteByte(mp^.parameters);
               WriteByte(ord(mp^.isVarargs));
               WriteByte(ord(mp^.readOnly));
               WriteByte(mp^.algorithm);
               tp := mp^.tokens;	{loop over token list}
               while tp <> nil do begin
		  WriteByte(1);		{write tokenListRecord}
        	  WriteLongString(tp^.tokenString);
        	  WriteToken(tp^.token);
        	  WriteByte(ord(tp^.expandEnabled));
        	  WriteChars(tp^.tokenStart, tp^.tokenEnd);
        	  tp := tp^.next;
        	  end; {while}
               WriteByte(0);		{mark end of token list}
               end; {if}
            mp := mp^.next;
            end; {while}
         end; {for}
      end; {SaveMacros}


   begin {SaveMacroTable}
   SetMark;				{set the macro table length mark}
   if saveSource then			{write the macro table}
      SaveMacros;
   if saveSource then			{mark the length of the table}
      MarkBlock;
   end; {SaveMacroTable}


   procedure SavePragmaEffects;

   { Save the variables effected by any pragmas encountered	}

   var
      count: 0..maxint;			{number of path names}
      i: 1..10;				{loop/index variable}
      p: pragmas;			{loop variable}
      pp: pathRecordPtr;		{used to trace pathname list}

   begin {SavePragmaEffects}
   SetMark;
   if saveSource then
      for p := succ(p_startofenum) to pred(p_endofenum) do
         if p in savePragmas then
            if saveSource then begin
               WriteByte(ord(p));
               case p of
                  p_cda: begin
                     WriteString(@menuLine);
                     WriteString(openName);
                     WriteString(closeName);
                     end;

                  p_cdev: WriteString(openName);

                  p_float: begin
                     WriteWord(floatCard);
                     WriteWord(floatSlot);
                     end;

                  p_keep: WriteLongString(@outFileGS.theString);

                  p_line: begin
                     WriteWord(lineNumber);
                     WriteLongString(@sourceFileGS.theString);
                     end;

                  p_nda: begin
                     WriteString(openName);
                     WriteString(closeName);
                     WriteString(actionName);
                     WriteString(initName);
                     WriteWord(refreshPeriod);
                     WriteWord(eventMask);
                     WriteString(@menuLine);
                     end;

                  p_nba:
                     WriteString(openName);

                  p_xcmd:
                     WriteString(openName);

                  p_debug:
                     WriteWord(ord(rangeCheck)
                        | (ord(debugFlag) << 1)
                        | (ord(profileFlag) << 2)
                        | (ord(traceBack) << 3)
                        | (ord(checkStack) << 4)
                        | (ord(debugStrFlag) << 15));

                  p_lint: begin
                     WriteWord(lint);
                     WriteByte(ord(lintIsError));
                     end;

                  p_memorymodel: WriteByte(ord(smallMemoryModel));

                  p_expand: WriteByte(ord(printMacroExpansions));

                  p_optimize:
                     WriteByte(ord(peepHole)
                        | (ord(npeepHole) << 1)
                        | (ord(registers) << 2)
                        | (ord(saveStack) << 3)
                        | (ord(commonSubexpression) << 4)
                        | (ord(loopOptimizations) << 5)
                        | (ord(strictVararg) << 6));

                  p_stacksize: WriteWord(stackSize);

                  p_toolparms: WriteByte(ord(toolParms));

                  p_databank: WriteByte(ord(dataBank));

                  p_rtl: ;

                  p_noroot: ;

                  p_path: begin
                     pp := pathList;
                     count := 0;
                     while pp <> nil do begin
                        count := count+1;
                        pp := pp^.next;
                        end; {while}
                     WriteWord(count);
                     pp := pathList;
                     while pp <> nil do begin
                        WriteString(pp^.path);
                        pp := pp^.next;
                        end; {while}
                     end; {p_path}

                  p_ignore:
                     WriteByte(ord(skipIllegalTokens)
                        | (ord(allowLongIntChar) << 1)
                        | (ord(allowTokensAfterEndif) << 2)
                        | (ord(allowSlashSlashComments) << 3)
                        | (ord(allowMixedDeclarations) << 4)
                        | (ord(looseCharTypeChecks) << 5));

                  p_segment: begin
                     for i := 1 to 10 do begin
                        WriteByte(defaultSegment[i]);
                        WriteByte(currentSegment[i]);
                        end; {for}
                     WriteWord(segmentKind);
                     end;

                  p_unix: WriteByte(ord(unix_1));

                  end; {case}
               end; {if}
   if saveSource then
      MarkBlock;
   savePragmas := [];
   end; {SavePragmaEffects}


   procedure SaveSourceStream;

   { Save the source stream for later compares			}

   var
      wrRec: readWriteOSDCB;		{WriteGS record}

   begin {SaveSourceStream}
   WriteLong(ord4(chPtr) - ord4(symChPtr));
   Purge;
   wrRec.pcount := 4;
   wrRec.refnum := symRefnum;
   wrRec.dataBuffer := pointer(symChPtr);
   wrRec.requestCount := ord4(chPtr) - ord4(symChPtr);
   WriteGS(wrRec);
   symChPtr := chPtr;
   if ToolError <> 0 then begin
      CloseSymbols;
      DestroySymbolFile;
      saveSource := false;
      end; {if}
   end; {SaveSourceStream}


   procedure SaveSymbolTable;

   { Save symbols to the symbol file				}


      procedure SaveSymbol;

      { Write the symbols to the symbol file			}

      var
         abort: boolean;		{abort due to initialized var?}
         efRec: setMarkOSDCB;		{SetEOFGS record}
         i: 0..hashSize;		{loop/index variable}
         sp: identPtr;			{used to trace symbol lists}


         procedure WriteIdent (ip: identPtr);

         { write a symbol to the symbol file				}
         {								}
         { parameters:							}
         {    ip - pointer to symbol entry				}


            procedure WriteType (tp: typePtr);

            { write a type entry to the symbol file			}
            {								}
            { parameters:						}
            {    tp - pointer to type entry				}

            var
               ip: identPtr;			{for tracing field list}


               procedure WriteParm (pp: parameterPtr);

               { write a parameter list to the symbol file		}
               {							}
               { parameters:						}
               {    pp - parameter pointer				}

               begin {WriteParm}
               while pp <> nil do begin
                  WriteByte(1);
                  WriteType(pp^.parameterType);
                  pp := pp^.next;
                  end; {while}
               WriteByte(0);
               end; {WriteParm}


            begin {WriteType}
            if tp = sCharPtr then
               WriteByte(2)
            else if tp = charPtr then
               WriteByte(3)
            else if tp = intPtr then
               WriteByte(4)
            else if tp = uIntPtr then
               WriteByte(5)
            else if tp = longPtr then
               WriteByte(6)
            else if tp = uLongPtr then
               WriteByte(7)
            else if tp = floatPtr then
               WriteByte(8)
            else if tp = doublePtr then
               WriteByte(9)
            else if tp = extendedPtr then
               WriteByte(10)
            else if tp = stringTypePtr then
               WriteByte(11)
            else if tp = voidPtr then
               WriteByte(12)
            else if tp = voidPtrPtr then
               WriteByte(13)
            else if tp = defaultStruct then
               WriteByte(14)
            else if tp = uCharPtr then
               WriteByte(15)
            else if tp = shortPtr then
               WriteByte(16)
            else if tp = uShortPtr then
               WriteByte(17)
            else if tp^.saveDisp <> 0 then begin
               WriteByte(1);
               WriteLong(tp^.saveDisp);
               end {if}
            else begin
               WriteByte(0);
               tp^.saveDisp := GetMark;
               WriteLong(tp^.size);
               WriteByte(ord(tp^.isConstant));
               WriteByte(ord(tp^.kind));
               case tp^.kind of
        	  scalarType: begin
        	     WriteByte(ord(tp^.baseType));
        	     WriteByte(ord(tp^.cType));
        	     end;

        	  arrayType: begin
        	     WriteLong(tp^.elements);
        	     WriteType(tp^.aType);
        	     end;

        	  pointerType:
        	     WriteType(tp^.pType);

        	  functionType: begin
        	     WriteByte((ord(tp^.varargs) << 2)
                        | (ord(tp^.prototyped) << 1) | ord(tp^.isPascal));
        	     WriteWord(tp^.toolnum);
        	     WriteLong(tp^.dispatcher);
        	     WriteType(tp^.fType);
        	     WriteParm(tp^.parameterList);
        	     end;

        	  enumConst:
        	     WriteWord(tp^.eval);

        	  definedType:
        	     WriteType(tp^.dType);

        	  structType, unionType: begin
        	     ip := tp^.fieldList;
        	     while ip <> nil do begin
                	WriteByte(1);
                	WriteIdent(ip);
                	ip := ip^.next;
                	end; {while}
        	     WriteByte(0);
        	     end;

		  otherwise: ;
               
        	  end; {case}
               end; {else}
            end; {WriteType}


	 begin {WriteIdent}
         WriteString(ip^.name);	
         WriteType(ip^.itype);
         if (ip^.disp = 0) and (ip^.bitDisp = 0) and (ip^.bitSize = 0) then
            WriteByte(0)
         else if (ip^.bitSize = 0) and (ip^.bitDisp = 0) then begin
            if ip^.disp < maxint then begin
               WriteByte(1);
               WriteWord(ord(ip^.disp));
               end {if}
            else begin
               WriteByte(2);
               WriteLong(ip^.disp);
               end; {else}
            end {else if}
         else begin
            WriteByte(3);
            WriteLong(ip^.disp);
            WriteByte(ip^.bitDisp);
            WriteByte(ip^.bitSize);
            end; {else}
         if ip^.iPtr <> nil then
            abort := true;
         WriteByte(ord(ip^.state));
         WriteByte(ord(ip^.isForwardDeclared));
         WriteByte(ord(ip^.class));
         WriteByte(ord(ip^.storage));
	 end; {WriteIdent}
         

      begin {SaveSymbol}
      abort := false;			{no reason to abort, yet}
      for i := 0 to hashSize2 do begin	{loop over hash buckets}
         sp := globalTable^.buckets[i];	{loop over symbol records in hash bucket}
         while sp <> nil do begin
            if not sp^.saved then begin
               sp^.saved := true;	{mark this one as saved}
               WriteWord(i);		{save the symbol}
               WriteIdent(sp);
               end; {if}
            sp := sp^.next;
            end; {while}
         end; {for}
      if abort then begin
         Purge;
	 efRec.pcount := 3;
	 efRec.refnum := symRefnum;
	 efRec.base := 0;
	 efRec.displacement := tokenMark;
	 SetEOFGS(efRec);
	 if ToolError <> 0 then begin
	    CloseSymbols;
	    DestroySymbolFile;
	    end; {if}
         saveSource := false;
         end; {if}
      end; {SaveSymbol}


   begin {SaveSymbolTable}
   SetMark;				{set the symbol table length mark}
   if saveSource then			{write the symbol table}
      if globalTable <> nil then
         SaveSymbol;
   if saveSource then			{mark the length of the table}
      MarkBlock;
   end; {SaveSymbolTable}


begin {EndInclude}
if not ignoreSymbols then begin
   includeLevel := includeLevel-1;
   if includeLevel = 0 then
      if saveSource then begin
	 MarkBlock;			{set the include name mark}
	 SaveSourceStream;		{save the source stream}
	 SaveMacroTable;		{save the macro table}
	 SaveSymbolTable;		{save the symbol table}
	 SavePragmaEffects;		{save the effects of pragmas}
	 tokenMark := GetMark;		{record mark for early exit}
	 includeMark := false;		{no include mark, yet}
	 end; {if}
   end; {if}
end; {EndInclude}                


procedure FlagPragmas {pragma: pragmas};

{ record the effects of a pragma				}
{								}
{ parameters:							}
{    pragma - pragma to record					}
{								}
{ Notes:							}
{    1. Defined as extern in Scanner.pas			}
{    2. For the purposes of this unit, the segment statement	}
{	and #line directive are treated as pragmas.		}

begin {FlagPragmas}
savePragmas := savePragmas + [pragma];
end; {FlagPragmas}


procedure InitHeader {var fName: gsosOutString};

{ look for a header file, reading it if it exists		}
{								}
{ parameters:							}
{    fName - source file name (var for efficiency)		}

type
   typeDispPtr = ^typeDispRecord;	{type displacement/pointer table}
   typeDispRecord = record
      next: typeDispPtr;
      saveDisp: longint;
      tPtr: typePtr;
      end;

var
   done: boolean;			{for loop termination test}
   typeDispList: typeDispPtr;		{type displacement/pointer table}


   procedure DisposeTypeDispList;

   { Dispose of the type displacement list			}

   var
      tp: typeDispPtr;			{work pointer}

   begin {DisposeTypeDispList}
   while typeDispList <> nil do begin
      tp := typeDispList;
      typeDispList := tp^.next;
      dispose(tp);
      end; {while}
   end; {DisposeTypeDispList}


   function EndOfSymbols: boolean;

   { See if we're at the end of the symbol file			}
   {								}
   { Returns: True if at the end, else false			}

   begin {EndOfSymbols}
   EndOfSymbols := ord4(symPtr) >= ord4(symEndPtr);
   end; {EndOfSymbols}


   function OpenSymbols: boolean;

   { open and initialize the symbol file			}
   {								}
   { Returns: True if successful, else false			}

   var
      crRec: createOSDCB;		{CreateGS record}
      opRec: openOSDCB;			{OpenGS record}

   begin {OpenSymbols}
   OpenSymbols := false;		{assume we will fail}
   DestroySymbolFile;			{destroy any existing file}
   crRec.pCount := 5;			{create a symbol file}
   crRec.pathName := @symName.theString;
   crRec.access := $C3;
   crRec.fileType := symFiletype;
   crRec.auxType := symAuxtype;
   crRec.storageType := 1;
   CreateGS(crRec);
   if ToolError = 0 then begin
      opRec.pCount := 3;
      opRec.pathname := @symName.theString;
      opRec.requestAccess := 3;
      OpenGS(opRec);
      if ToolError = 0 then begin           
         symRefnum := opRec.refnum;
         OpenSymbols := true;
         WriteWord(symFileVersion);
         tokenMark := GetMark;
         includeMark := false;
         end; {if}
      end; {if}
   end; {OpenSymbols}


   procedure PurgeSymbols;

   { Purge the symbol input file				}

   var
      ffDCBGS: fastFileDCBGS;		{fast file DCB}
   
   begin {PurgeSymbols}
   with ffDCBGS do begin		{purge the file}
      pCount := 5;
      action := 7;
      pathName := @symName.theString;
      end; {with}
   FastFileGS(ffDCBGS);
   end; {PurgeSymbols}                                      


   function DatesMatch: boolean;

   { Make sure the create/mod dates have not changed		}

   var
      giRec: getFileInfoOSDCB;		{GetFileInfoGS record}
      i: 1..maxint;			{loop/index variable}
      len: longint;			{length of names}
      match: boolean;			{do the dates match?}

   begin {DatesMatch}
   match := true;
   len := ReadLong;
   while len > 0 do begin
      giRec.pCount := 7;
      giRec.pathname := pointer(ReadLongString);
      len := len - (giRec.pathname^.size + 18);
      GetFileInfoGS(giRec);
      if ToolError = 0 then begin
	 for i := 1 to 8 do
	    match := match and (giRec.createDateTime[i] = ReadByte);
	 for i := 1 to 8 do
	    match := match and (giRec.modDateTime[i] = ReadByte);
         end {if}
      else begin
         match := false;
         len := 0;
         end; {else}
      if match and progress then begin
	 write('Including ');
	 for i := 1 to giRec.pathname^.size do
            write(giRec.pathname^.theString[i]);
	 writeln;
	 end; {if}
      end; {while}
   DatesMatch := match;
   end; {DatesMatch}


   procedure ReadMacroTable;

   { Read macros from the symbol file				}

   var
      bp: ^macroRecordPtr;		{pointer to head of hash bucket}
      ep: tokenListRecordPtr;		{last token record}
      mePtr: ptr;			{end of macro table}
      mp: macroRecordPtr;		{new macro record}
      tlen: integer;			{length of the token name}
      tp: tokenListRecordPtr;		{new token record}
        

      procedure ReadToken (var token: tokenType);

      { read a token						}
      {								}
      { parameters:						}
      {    token - (output) token read)				}

      begin {ReadToken}
      token.kind := tokenEnum(ReadByte);
      token.class := tokenClass(ReadByte);
      if ReadByte = 0 then
         token.numString := nil
      else
         token.numstring := ReadString;
      case token.class of 
	 identifier:		token.name := ReadString;
	 intConstant:		token.ival := ReadWord;
	 longConstant:		token.lval := ReadLong;
	 longlongConstant:	begin
			        token.qval.lo := ReadLong;
                	        token.qval.hi := ReadLong;
                	        end;
	 doubleConstant:	token.rval := ReadDouble;
	 stringConstant:	begin
			        token.sval := ReadLongString;
                	        token.ispstring := ReadByte <> 0;
                	        end;
         macroParameter:	token.pnum := ReadWord;
         reservedSymbol:	if token.kind in [lbracech,rbracech,lbrackch,
                                   rbrackch,poundch,poundpoundop] then 
                                   token.isDigraph := boolean(ReadByte);
	 otherwise:		;
	 end; {case}
      end; {ReadToken}


   begin {ReadMacroTable}
   mePtr := symPtr;			{read the block length}
   mePtr := pointer(ord4(mePtr) + ReadLong + 4);
   while ord4(symPtr) < ord4(mePtr) do	{process the macros}
      begin
      Spin;
      mp := pointer(GMalloc(sizeof(macroRecord)));
      mp^.saved := false;
      mp^.name := ReadString;
      bp := pointer(ord4(macros) + Hash(mp^.name));
      mp^.next := bp^;
      bp^ := mp;
      mp^.parameters := ReadByte;
      if mp^.parameters & $0080 <> 0 then
         mp^.parameters := mp^.parameters | $FF00;
      mp^.isVarargs := boolean(ReadByte);
      mp^.readOnly := boolean(ReadByte);
      mp^.algorithm := ReadByte;
      mp^.tokens := nil;
      ep := nil;
      while ReadByte <> 0 do begin
         tp := pointer(GMalloc(sizeof(tokenListRecord)));
         tp^.next := nil;
         tp^.tokenString := ReadLongString;
         ReadToken(tp^.token);
         tp^.expandEnabled := boolean(ReadByte);
         ReadChars(tp^.tokenStart, tp^.tokenEnd);
         if ep = nil then
            mp^.tokens := tp
         else
            ep^.next := tp;
         ep := tp;
         end; {while}
      end; {while}
   symPtr := mePtr;
   end; {ReadMacroTable}


   procedure ReadPragmas;

   { Read pragma effects					}

   var
      i: 0..maxint;			{loop/index variable}
      lsPtr: longStringPtr;		{work pointer}
      p: pragmas;			{kind of pragma being processed}
      pePtr: ptr;			{end of pragma table}
      pp, ppe: pathRecordPtr;		{used to create a path name list}
      sPtr: stringPtr;			{work pointer}
      val: integer;			{temp value}
      
   begin {ReadPragmas}
   pePtr := symPtr;			{read the block length}
   pePtr := pointer(ord4(pePtr) + ReadLong + 4);
   while ord4(symPtr) < ord4(pePtr) do	{process the pragmas}
      begin
      Spin;
      p := pragmas(ReadByte);
      case p of
         p_cda: begin
            isClassicDeskAcc := true;
            sPtr := ReadString;
            menuLine := sPtr^;
            openName := ReadString;
            closeName := ReadString;
            end;

         p_cdev: begin
            isCDev := true;
            openName := ReadString;
            end;

         p_float: begin
            floatCard := ReadWord;
            floatSlot := ReadWord;
            end;

         p_keep: begin
            liDCBGS.kFlag := 1;
            lsPtr := ReadLongString;
            outFileGS.theString.size := lsPtr^.length;
            for i := 1 to outFileGS.theString.size do
               outFileGS.theString.theString[i] := lsPtr^.str[i];
            end;

         p_line: begin
            lineNumber := ReadWord;
            lsPtr := ReadLongString;
            sourceFileGS.theString.size := lsPtr^.length;
            for i := 1 to sourceFileGS.theString.size do
               sourceFileGS.theString.theString[i] := lsPtr^.str[i];
            end;

         p_nda: begin
            isNewDeskAcc := true;
            openName := ReadString;
            closeName := ReadString;
            actionName := ReadString;
            initName := ReadString;
            refreshPeriod := ReadWord;
            eventMask := ReadWord;
            sPtr := ReadString;
            menuLine := sPtr^;
            end;

         p_nba: begin
            isNBA := true;
            openName := ReadString;
            end;

         p_xcmd: begin
            isXCMD := true;
            openName := ReadString;
            end;

         p_debug: begin
            val := ReadWord;
            rangeCheck := odd(val);
            debugFlag := odd(val >> 1);
            profileFlag := odd(val >> 2);
            traceback := odd(val >> 3);
            checkStack := odd(val >> 4);
            debugStrFlag := odd(val >> 15);
            end;

         p_lint: begin
            lint := ReadWord;
            lintIsError := boolean(ReadByte);
            end;

         p_memorymodel: smallMemoryModel := boolean(ReadByte);

         p_expand: printMacroExpansions := boolean(ReadByte);

         p_optimize: begin
            val := ReadByte;
            peepHole := odd(val);
            npeepHole := odd(val >> 1);
            registers := odd(val >> 2);
            saveStack := odd(val >> 3);
            commonSubexpression := odd(val >> 4);
            loopOptimizations := odd(val >> 5);
            strictVararg := odd(val >> 6);
            end;

         p_stacksize: stackSize := ReadWord;

         p_toolparms: toolParms := boolean(ReadByte);

         p_databank: dataBank := boolean(ReadByte);

         p_rtl: rtl := true;

         p_noroot: noroot := true;

         p_path: begin
            i := ReadWord;
            pathList := nil;
            ppe := nil;
            while i <> 0 do begin
               pp := pathRecordPtr(GMalloc(sizeof(pathRecord)));
               pp^.path := ReadString;
               pp^.next := nil;
               if pathList = nil then
                  pathList := pp
               else
                  ppe^.next := pp;
               ppe := pp;
               i := i-1;
               end; {while}
            end; {p_path}

         p_ignore: begin
            i := ReadByte;
            skipIllegalTokens := odd(i);
            allowLongIntChar := odd(i >> 1);
            allowTokensAfterEndif := odd(i >> 2);
            allowSlashSlashComments := odd(i >> 3);
            allowMixedDeclarations := odd(i >> 4);
            c99Scope := allowMixedDeclarations;
            looseCharTypeChecks := odd(i >> 5);
            end;
         
         p_segment: begin
            for i := 1 to 10 do begin
               defaultSegment[i] := chr(ReadByte);
               currentSegment[i] := chr(ReadByte);
               end; {for}
            segmentKind := ReadWord;
            end;

         p_unix: unix_1 := boolean(ReadByte);

         end; {case}
      end; {while}
   symPtr := pePtr;
   end; {ReadPragmas}


   procedure ReadSymbolTable;

   { Read symbols from the symbol file				}

   var
      hashPtr: ^identPtr;		{pointer to hash bucket in symbol table}
      sePtr: ptr;			{end of symbol table}
      sp: identPtr;			{identifier being constructed}


      function ReadIdent: identPtr;

      { Read an identifier from the file			}
      {								}
      { Returns: Pointer to the new identifier			}

      var
         format: 0..3;			{storage format}
	 sp: identPtr;			{identifier being constructed}


	 procedure ReadType (var tp: typePtr);

	 { read a type from the symbol file				}
	 {								}
	 { parameters:							}
	 {    tp - (output) type entry					}

	 var
            disp: longint;			{disp read from symbol file}
            ep: identPtr;			{end of list of field names}
            ip: identPtr;			{for tracing field list}
            tdisp: typeDispPtr;			{used to trace, add to typeDispList}
            val: integer;			{temp word}


            procedure ReadParm (var pp: parameterPtr);

            { read a parameter list from the symbol file		}
            {								}
            { parameters:						}
            {    pp - (output) parameter pointer			}

            var
               ep: parameterPtr;		{last parameter in list}
               np: parameterPtr;		{new parameter}

            begin {ReadParm}
            pp := nil;
            ep := nil;
            while ReadByte = 1 do begin
               np := parameterPtr(GMalloc(sizeof(parameterRecord)));
               np^.next := nil;
               np^.parameter := nil;
               ReadType(np^.parameterType);
               if ep = nil then
                  pp := np
               else
                  ep^.next := np;
               ep := np;
               end; {while}
            end; {ReadParm}


	 begin {ReadType}
         case ReadByte of
            0: begin			{read a new type}
	       tp := typePtr(GMalloc(sizeof(typeRecord)));
               new(tdisp);
               tdisp^.next := typeDispList;
               typeDispList := tdisp;
               tdisp^.saveDisp := ord4(symPtr) - ord4(symStartPtr);
               tdisp^.tPtr := tp;
	       tp^.size := ReadLong;
               tp^.saveDisp := 0;
	       tp^.isConstant := boolean(ReadByte);
	       tp^.kind := typeKind(ReadByte);
	       case tp^.kind of
        	  scalarType: begin
        	     tp^.baseType := baseTypeEnum(ReadByte);
        	     tp^.cType := cTypeEnum(ReadByte);
        	     end;

        	  arrayType: begin
        	     tp^.elements := ReadLong;
        	     ReadType(tp^.aType);
        	     end;

        	  pointerType: 
        	     ReadType(tp^.pType);

        	  functionType: begin
        	     val := ReadByte;
        	     tp^.varargs := odd(val >> 2);
        	     tp^.prototyped := odd(val >> 1);
        	     tp^.isPascal := odd(val);
        	     tp^.toolnum := ReadWord;
        	     tp^.dispatcher := ReadLong;
        	     ReadType(tp^.fType);
        	     ReadParm(tp^.parameterList);
        	     end;

        	  enumConst:
        	     tp^.eval := ReadWord;

        	  definedType:
        	     ReadType(tp^.dType);

        	  structType, unionType: begin
        	     tp^.fieldList := nil;
        	     ep := nil;
        	     while ReadByte = 1 do begin
        		ip := ReadIdent;
        		if ep = nil then
                	   tp^.fieldList := ip
        		else
                	   ep^.next := ip;
        		ep := ip;
        		end; {while}
        	     end;

		  otherwise: ;
         
        	  end; {case}
               end; {case 0}

            1: begin			{read a type displacement}
               tdisp := typeDispList;
               disp := ReadLong;
               tp := nil;
               while tdisp <> nil do
        	  if tdisp^.saveDisp = disp then begin
                     tp := tdisp^.tPtr;
                     tdisp := nil;
                     end {if}
        	  else 
                     tdisp := tdisp^.next;
               if tp = nil then begin
                  PurgeSymbols;
                  DestroySymbolFile;
                  TermError(12);
                  end; {if}
               end; {case 1}

            2: tp := sCharPtr;
            3: tp := charPtr;
            4: tp := intPtr;
            5: tp := uIntPtr;
            6: tp := longPtr;
            7: tp := uLongPtr;
            8: tp := floatPtr;
            9: tp := doublePtr;
            10: tp := extendedPtr;
            11: tp := stringTypePtr;
            12: tp := voidPtr;
            13: tp := voidPtrPtr;
            14: tp := defaultStruct;
            15: tp := uCharPtr;
            16: tp := shortPtr;
            17: tp := uShortPtr;
            end; {case}
	 end; {ReadType}


      begin {ReadIdent}
      sp := pointer(GMalloc(sizeof(identRecord)));
      sp^.next := nil;
      sp^.saved := false;
      sp^.name := ReadString;
      ReadType(sp^.itype);
      format := ReadByte;
      if format = 0 then begin
         sp^.disp := 0;
         sp^.bitDisp := 0;
         sp^.bitSize := 0;
         end {if}
      else if format = 1 then begin
         sp^.disp := ReadWord;
         sp^.bitDisp := 0;
         sp^.bitSize := 0;
         end {else if}
      else if format = 2 then begin
         sp^.disp := ReadLong;
         sp^.bitDisp := 0;
         sp^.bitSize := 0;
         end {else if}
      else begin
	 sp^.disp := ReadLong;
	 sp^.bitDisp := ReadByte;
	 sp^.bitSize := ReadByte;
         end; {else}
      sp^.iPtr := nil;
      sp^.state := stateKind(ReadByte);
      sp^.isForwardDeclared := boolean(ReadByte);
      sp^.class := tokenEnum(ReadByte);
      sp^.storage := storageType(ReadByte);
      ReadIdent := sp;
      end; {ReadIdent}


   begin {ReadSymbolTable}
   sePtr := symPtr;			{read the block length}
   sePtr := pointer(ord4(sePtr) + ReadLong + 4);
   while ord4(symPtr) < ord4(sePtr) do	{process the symbols}
      begin
      Spin;
      hashPtr := pointer(ord4(globalTable) + ReadWord*4);
      sp := ReadIdent;
      sp^.next := hashPtr^;
      hashPtr^ := sp;
      end; {while}
   symPtr := sePtr;
   end; {ReadSymbolTable}


   function OpenSymbolFile (var fName: gsosOutString): boolean;

   { Look for and open a symbol file				}
   {								}
   { parameters:						}
   {    fName - source file name (var for efficiency)		}
   {								}
   { Returns: True if the file was found and opened, else false	}
   {								}
   { Notes: As a side effect, this subroutine creates the	}
   {    pathname for the symbol file (symName).			}

   var
      ffDCBGS: fastFileDCBGS;		{fast file DCB}
      i: integer;			{loop/index variable}

   begin {OpenSymbolFile}
   symName := fName;			{create the symbol file name}
   i := symName.theString.size - 1;
   while not (symName.theString.theString[i] in [':', '/', '.']) do
      i := i-1;
   if symName.theString.theString[i] <> '.' then
      i := symName.theString.size;
   if i > maxPath-5 then
      i := maxPath-5;
   symName.theString.theString[i] := '.';
   symName.theString.theString[i+1] := 's';
   symName.theString.theString[i+2] := 'y';
   symName.theString.theString[i+3] := 'm';
   symName.theString.theString[i+4] := chr(0);
   symName.theString.size := i+3;
   if rebuildSymbols then begin		{rebuild any existing symbol file}
      DestroySymbolFile;
      OpenSymbolFile := false;
      end {if}
   else begin
      with ffDCBGS do begin		{read the symbol file}
	 pCount := 14;
	 action := 0;
	 flags := $C000;
	 pathName := @symName.theString;
	 end; {with}
      FastFileGS(ffDCBGS);
      if ToolError = 0 then begin
	 if (ffDCBGS.filetype = symFiletype) and (ffDCBGS.auxtype = symAuxtype) then
            OpenSymbolFile := true
	 else begin
            OpenSymbolFile := false;
            PurgeSymbols;
            end; {else}
	 symPtr := ffDCBGS.fileHandle^;
	 symStartPtr := symPtr;
	 symEndPtr := pointer(ord4(symPtr) + ffDCBGS.fileLength);
	 end {if}
      else
	 OpenSymbolFile := false;
      end; {else}
   end; {OpenSymbolFile}


   function SymbolVersion: integer;

   { Read the symbol file version number			}
   {								}
   { Returns: version number					}

   begin {SymbolVersion}
   SymbolVersion := ReadWord;
   end; {SymbolVersion}


   function SourceMatches: boolean;

   { Make sure the token streams match up to the next include	}

   type
      intPtr = ^integer;		{for faster compares}

   var
      len, len2: longint;		{size of stream to compare}
      match: boolean;			{result flag}
      p1, p2: ptr;			{work pointers}

   begin {SourceMatches}
   match := true;
   len := ReadLong;
   len2 := len;
   p1 := symPtr;
   p2 := chPtr;
   while len > 1 do
      if intPtr(p1)^ <> intPtr(p2)^ then begin
         match := false;
         len := 0;
         end {if}
      else begin
	 len := len-2;
	 p1 := pointer(ord4(p1)+2);
	 p2 := pointer(ord4(p2)+2);
         end; {else}
   if len = 1 then
      if p1^ <> p2^ then
         match := false;
   if match then begin
      symPtr := pointer(ord4(symPtr)+len2);
      symChPtr := pointer(ord4(chPtr)+len2);
      while chPtr <> symChPtr do
         NextCh;
      end; {if}
   SourceMatches := match;
   end; {SourceMatches}


begin {InitHeader}
inhibitHeader := false;			{don't block .sym files}
if not ignoreSymbols then begin
   codeStarted := false;		{code generation has not started}
   new(buffer);				{allocate an output buffer}
   bufPtr := pointer(buffer);
   bufLen := bufSize;
   includeLevel := 0;			{no nested includes}
   symChPtr := chPtr;			{record initial source location}
   if OpenSymbolFile(fName) then begin	{check for symbol file}
      if SymbolVersion = symFileVersion then begin
	 done := EndOfSymbols;		{valid file found - process it}
	 if done then
            PurgeSymbols;
	 typeDispList := nil;
	 while not done do begin
            if DatesMatch then begin
               if SourceMatches then begin
        	  ReadMacroTable;
        	  ReadSymbolTable;
        	  ReadPragmas;
        	  if EndOfSymbols then begin
        	     done := true;
        	     PurgeSymbols;
        	     end; {if}
        	  end {if}
               else begin
        	  PurgeSymbols;
        	  DestroySymbolFile;
        	  done := true;
        	  end; {else}
               end {if}
            else begin
               PurgeSymbols;
               DestroySymbolFile;
               done := true;
               end; {else}
            end; {while}
	 DisposeTypeDispList;
	 saveSource := false;
         if ord4(symPtr) > ord4(symEndPtr) then begin
            PurgeSymbols;
            DestroySymbolFile;
            TermError(12);
            end; {if}
	 end {if}
      else begin
	 PurgeSymbols;			{no file found}
	 saveSource := true;
	 end; {else}
      end {if}
   else 
      saveSource := true;
   if saveSource then begin		{start saving source}
      saveSource := OpenSymbols;
      savePragmas := [];
      DoDefaultsDotH;
      end; {if}
   end {if}
else
   DoDefaultsDotH;
end; {InitHeader}


procedure StartInclude {name: gsosOutStringPtr};

{ Marks the start of an include file				}
{								}
{ Notes:							}
{    1. Call this subroutine right after opening an include	}
{       file.							}
{    2. Defined externally in Scanner.pas			}

var
   giRec: getFileInfoOSDCB;		{GetFileInfoGS record}
   i: 1..8;				{loop/index counter}

begin {StartInclude}
if inhibitHeader then   
   TermHeader;
if not ignoreSymbols then begin
   includeLevel := includeLevel+1;
   if saveSource then begin
      if not includeMark then begin
	 includeMark := true;
	 SetMark;
	 end; {if}
      giRec.pCount := 7;
      giRec.pathname := pointer(ord4(name)+2);
      GetFileInfoGS(giRec);
      WriteLongString(pointer(giRec.pathname));
      for i := 1 to 8 do
	 WriteByte(giRec.createDateTime[i]);
      for i := 1 to 8 do
	 WriteByte(giRec.modDateTime[i]);
      end {if}
   else if not codeStarted then
      DestroySymbolFile;
   end; {if}
end; {StartInclude}


procedure TermHeader;

{ Stop processing the header file				}
{								}
{ Note: This is called when the first code-generating		}
{    subroutine is found, and again when the compile ends.  It	}
{    closes any open symbol file, and should take no action if	}
{    called twice.						}

begin {TermHeader}
if not ignoreSymbols then begin
   codeStarted := true;
   if saveSource then begin
      CloseSymbols;
      saveSource := false;
      dispose(buffer);
      end; {if}
   end; {if}
end; {TermHeader}

end.