ORCA-C/CC.pas

191 lines
6.6 KiB
ObjectPascal

{$optimize 7}
{---------------------------------------------------------------}
{ }
{ ORCA/C }
{ }
{ A C compiler for the Apple IIGS. }
{ }
{ Copyright 1989,1990 }
{ Byte Works, Inc. }
{ }
{ Mike Westerfield }
{ }
{---------------------------------------------------------------}
{$stacksize $1800}
program cc(output);
{$LibPrefix '0/obj/'}
uses CCommon, CGI, Scanner, Header, Symbol, MM, Expression, Parser, Asm;
{$segment 'CC'}
var
i: 1..maxPath; {loop/index variable}
vDCBGS: versionDCBGS; {for checking the version number}
procedure DisposeAll (userID: integer); tool($02, $11);
procedure SystemQuitFlags (flags: integer); extern;
begin {cc}
{make sure we quit with restart set}
SystemQuitFlags($4000);
{initialize file names and parameter strings}
includeFileGS.maxSize := maxPath+4;
includeFileGS.theString.size := 0;
for i := 1 to maxPath do
includeFileGS.theString.theString[i] := chr(0);
outFileGS := includeFileGS;
partialFileGS := includeFileGS;
infoStringGS := includeFileGS;
{check the version number}
vDCBGS.pCount := 1;
VersionGS(vDCBGS);
if (ToolError <> 0) or (vDCBGS.version[1] < '2') then
TermError(10);
{get the command line info}
with liDCBGS do begin
pCount := 11;
sFile := @includeFileGS;
dFile := @outFileGS;
namesList := @partialFileGS;
iString := @infoStringGS;
end; {with}
GetLInfoGS(liDCBGS);
if ToolError <> 0 then begin {check for buffTooSmall errors}
includeFileGS.theString.size := 0;
outFileGS.theString.size := 0;
partialFileGS.theString.size := 0;
infoStringGS.theString.size := 0;
enterEditor := false;
TermError(13);
end; {if}
sourceFileGS := includeFileGS;
doingPartial := partialFileGS.theString.size <> 0;
with liDCBGS do begin
enterEditor := pFlags & flag_e <> 0; {enter editor on terminal errors?}
filenamesInErrors := pFlags & flag_f <> 0; {filenames in error messages?}
ignoreSymbols := mFlags & flag_i <> 0; {ignore symbol file?}
list := pFlags & flag_l <> 0; {list the source file?}
memoryCompile := pflags & flag_m <> 0; {memory based compile?}
progress := mflags & flag_p = 0; {write progress info?}
rebuildSymbols := mflags & flag_r <> 0; {rebuild symbol file?}
printSymbols := pflags & flag_s <> 0; {print the symbol table?}
terminalErrors := pFlags & flag_t <> 0; {all errors terminal?}
wait := pFlags & flag_w <> 0; {wait when an error is found?}
cLineOptimize := pFlags & flag_o <> 0; {turn optimizations on?}
end; {liDCB}
if list then {we don't need both...}
progress := false;
{write the header}
if list or progress then begin
writeln('ORCA/C ', versionStr);
writeln;
end; {if}
{read the source file}
ReadFile;
languageNumber := long(ffDCBGS.auxType).lsw; {set the default language number}
{initialize the various modules}
LInit; {initialize the memory pools}
GInit;
useGlobalPool := true;
InitCCommon; {initialize the common module}
{initialize the scanner}
InitScanner(bofPtr,pointer(ord4(bofPtr)+ffDCBGS.fileLength));
InitParser; {initialize the parser}
InitExpression; {initialize the expression evaluator}
InitSymbol; {initialize the symbol table handler}
InitAsm; {initialize the assembler}
CodeGenScalarInit; {initialize the code generator}
with liDCBGS do {generate debug code?}
if pFlags & flag_d <> 0 then begin
debugFlag := true;
profileFlag := true;
end; {if}
{compile the program}
InitHeader(includeFileGS); {read any precompiled headers}
NextToken; {get the first token in the program}
while token.kind <> eofsy do begin {compile the program}
if doingFunction then
DoStatement
else if token.kind in topLevelDeclarationStart then
DoDeclaration(false)
else begin
Error(26);
NextToken;
end; {else}
end; {while}
if doingFunction then {check for unclosed function}
Error(23);
{init the code generator (if it needs it)}
if not codegenStarted and (liDCBGS.kFlag <> 0) then begin
CodeGenInit (@outFileGS, liDCBGS.kFlag, doingPartial);
liDCBGS.kFlag := 3;
codegenStarted := true;
end; {if}
DoGlobals; {create the ~GLOBALS and ~ARRAYS segments}
{shut down the compiler}
TermHeader; {make sure the compiled header file is closed}
CheckStaticFunctions; {check for undefined functions}
if (lint & lintUnused) <> 0 then {check for unused static vars}
CheckUnused(globalTable);
ffDCBGS.action := 7; {purge the source file}
ffDCBGS.pcount := 14;
ffDCBGS.pathName := @includeFileGS.theString;
FastFileGS(ffDCBGS);
if ToolError <> 0 then begin
sourceFileGS := includeFileGS;
TermError(2);
end; {if}
TermScanner; {shut down the scanner}
StopSpin;
if (numErrors <> 0) or list or progress then begin
writeln; {write the number of errors}
if numErrors = 1 then
writeln('1 error found.')
else
writeln(numErrors:1, ' errors found.');
end; {if}
if list or progress then {leave a blank line}
writeln;
if codegenStarted then {shut down the code generator}
CodeGenFini;
TermParser; {shut down the parser}
if numErrors = 0 then begin {set up the return parameters}
if not switchLanguages then begin
if liDCBGS.kFlag = 0 then
liDCBGS.lops := 0
else
liDCBGS.lops := liDCBGS.lops & $FFFE;
liDCBGS.sFile := @outFileGS;
end; {if}
end {if}
else begin
liDCBGS.lops := 0;
if liDCBGS.merrf = 0 then
liDCBGS.merrf := 16;
end; {else}
MMQuit; {dispose of our memory pools}
with liDCBGS do begin {return to the shell}
sFile := pointer(ord4(sFile)+2);
dFile := pointer(ord4(dFile)+2);
namesList := pointer(ord4(namesList)+2);
iString := pointer(ord4(iString)+2);
end; {with}
SetLInfoGS(liDCBGS);
StopSpin;
end. {cc}