mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-10-31 17:04:42 +00:00
191 lines
6.6 KiB
ObjectPascal
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}
|