mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-05-28 12:41:35 +00:00
245dd0a3f4
This occurs when the constant value is out of range of the type being assigned to. This is likely indicative of an error, or of code that assumes types have larger ranges than they do in ORCA/C (e.g. 32-bit int). This intentionally does not report cases where a value is assigned to a signed type but is within the range of the corresponding unsigned type, or vice versa. These may be done intentionally, e.g. setting an unsigned value to "-1" or setting a signed value using a hex constant with the high bit set. Also, only conversions to 8-bit or 16-bit integer types are currently checked.
1054 lines
41 KiB
ObjectPascal
1054 lines
41 KiB
ObjectPascal
{$optimize 7}
|
|
{---------------------------------------------------------------}
|
|
{ }
|
|
{ CCommon }
|
|
{ }
|
|
{ Common declarations and global data for the compiler. }
|
|
{ }
|
|
{ Variables: }
|
|
{ }
|
|
{ bofPtr - pointer to the start of sourceFile }
|
|
{ chPtr - pointer to the next character in the file }
|
|
{ codegenStarted - have we started the code generator? }
|
|
{ debugType - line number debug types }
|
|
{ doingFunction - true if processing a function }
|
|
{ doingParameters - are we processing parm definitions? }
|
|
{ doingPartial - are we doing a partial compile? }
|
|
{ enterEditor - enter editor on terminal errors? }
|
|
{ expandMacros - should macros be expanded? }
|
|
{ firstPtr - points to first char in current line }
|
|
{ gotoList - list of goto labels }
|
|
{ includeFile - include file name (for return from includes) }
|
|
{ infoString - language specific command line info }
|
|
{ lastLine - last line number used by pc_nam }
|
|
{ liDCB - get/set LInfo DCB }
|
|
{ lineNumber - source line number }
|
|
{ lint - lint flags }
|
|
{ list - generate source listing? }
|
|
{ memoryCompile - memory based compile? }
|
|
{ nameFound - has a pc_nam been generated? }
|
|
{ numErrors - number of errors in the program }
|
|
{ objFile - object file name }
|
|
{ oldincludeFile - previous includeFile value }
|
|
{ partialFile - partial compile list }
|
|
{ sourceFile - source file name }
|
|
{ terminalErrors - are all errors terminal? }
|
|
{ traceBack - generate traceback code? }
|
|
{ useGlobalPool - use global (or local) string pool? }
|
|
{ wait - wait for keypress after errors? }
|
|
{ }
|
|
{ doDispose - dispose of the expression tree as we go? }
|
|
{ expressionValue - the expression evaluator returns the }
|
|
{ value of constant expressions in this variable }
|
|
{ expressionType - the type of the expression }
|
|
{ expressionTree - for non-constant initializers }
|
|
{ isConstant - is the initializer expression constant? }
|
|
{ typeSpec - type given by the last declaration specifiers, }
|
|
{ specifier-qualifier list, or type name evaluated }
|
|
{ }
|
|
{ External Subroutines: }
|
|
{ }
|
|
{ CheckGotoList - Make sure all labels have been defined }
|
|
{ ClearHourGlass - Erase the hourglass from the screen }
|
|
{ CopyLongString - copy a long string }
|
|
{ CopyString - copy a string }
|
|
{ DrawHourGlass - Draw the hourglass on the screen }
|
|
{ ExitToEditor - do an error exit to the editor }
|
|
{ GetLocalLabel - get the next local label number }
|
|
{ Hash - find hash displacement }
|
|
{ InitCCommon - Initialize this module }
|
|
{ ReadFile - read a file }
|
|
{ Spin - Spin the spinner }
|
|
{ StopSpin - Stop the spinner }
|
|
{ SystemError - intercept run time compiler errors }
|
|
{ TermError - flag a terminal error }
|
|
{ }
|
|
{---------------------------------------------------------------}
|
|
|
|
unit CCommon;
|
|
|
|
interface
|
|
|
|
{$segment 'CC'}
|
|
|
|
const
|
|
{hashsize appears in CCOMMON.ASM}
|
|
hashSize = 876; {# hash buckets - 1}
|
|
{NOTE: hashsize2 is used in Symbol.asm}
|
|
hashSize2 = 1753; {# hash buckets * 2 - 1}
|
|
maxLine = 255; {max length of a line}
|
|
maxPath = 255; {max length of a path name}
|
|
{NOTE: maxPath is used in Scanner.asm}
|
|
longstringlen = 32760; {max length of a string constant}
|
|
|
|
minChar = 0; {min ordinal value of source character}
|
|
maxChar = 255; {max ordinal value of source character}
|
|
|
|
{lint masks}
|
|
{----------}
|
|
lintUndefFn = $0001; {flag use of undefined functions}
|
|
lintNoFnType = $0002; {flag functions with no type}
|
|
lintNotPrototyped = $0004; {flag functions with no prototypes}
|
|
lintPragmas = $0008; {flag unknown pragmas}
|
|
lintPrintf = $0010; {check printf/scanf format flags}
|
|
lintOverflow = $0020; {check for overflows}
|
|
lintC99Syntax = $0040; {check for syntax that C99 disallows}
|
|
lintReturn = $0080; {flag issues with how functions return}
|
|
lintUnused = $0100; {check for unused variables}
|
|
lintConstantRange = $0200; {check for out-of-range constants}
|
|
|
|
{bit masks for GetLInfo flags}
|
|
{----------------------------}
|
|
flag_d = $10000000; {generate debug code?}
|
|
flag_e = $08000000; {abort to editor on terminal error?}
|
|
flag_f = $04000000; {print filenames in error messages?}
|
|
flag_i = $00800000; {ignore symbol files?}
|
|
flag_l = $00100000; {list source lines?}
|
|
flag_m = $00080000; {memory based compile?}
|
|
flag_o = $00020000; {optimize?}
|
|
flag_p = $00010000; {print progress info?}
|
|
flag_r = $00004000; {rebuild symbol files?}
|
|
flag_s = $00002000; {list symbol tables?}
|
|
flag_t = $00001000; {treat all errors as terminal?}
|
|
flag_w = $00000200; {wait when an error is found?}
|
|
|
|
versionStr = '2.2.0 B7 dev'; {compiler version}
|
|
|
|
type
|
|
{Misc.}
|
|
{-----}
|
|
long = record lsw,msw: integer; end; {for extracting words from longints}
|
|
longlong = record lo,hi: longint; end; {64-bit integer representation}
|
|
|
|
cString = packed array [1..256] of char; {null terminated string}
|
|
cStringPtr = ^cString;
|
|
longString = record {long null terminated string}
|
|
length: integer;
|
|
str: packed array [1..longstringlen] of char;
|
|
end;
|
|
longStringPtr = ^longString;
|
|
pString = packed array [0..maxLine] of char; {length string}
|
|
stringPtr = ^pString;
|
|
ptr = ^byte; {general purpose pointer}
|
|
handle = ^ptr; {general purpose handle}
|
|
|
|
gsosInString = record
|
|
size: integer;
|
|
theString: packed array [1..maxPath] of char;
|
|
end;
|
|
gsosInStringPtr = ^gsosInString;
|
|
|
|
{GS/OS class 1 output string}
|
|
gsosOutString = record
|
|
maxSize: integer;
|
|
theString: gsosInString;
|
|
end;
|
|
gsosOutStringPtr = ^gsosOutString;
|
|
|
|
{ C language standards }
|
|
cStandardEnum = (c89,c95,c99,c11,c17,c23);
|
|
|
|
{ The base types include two main categories. The values starting }
|
|
{ with cg are defined in the code generator, and may be passed to the }
|
|
{ code generator for resolution. The cc types are used internally in }
|
|
{ the compiler. Any values whose type is cc must be resolved to one }
|
|
{ of the cg types before the code generator is called. }
|
|
|
|
baseTypeEnum = (cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,
|
|
cgReal,cgDouble,cgComp,cgExtended,cgString,
|
|
cgVoid,cgQuad,cgUQuad,ccPointer);
|
|
|
|
{ Basic types (plus the void type) as defined by the C language. }
|
|
{ This differs from baseTypeEnum in that different types with the }
|
|
{ same representation are distinguished from each other. }
|
|
{ (ctInt32/ctUInt32 are 32-bit int types when using #pragma unix 1.) }
|
|
|
|
cTypeEnum = (ctChar, ctSChar, ctUChar, ctShort, ctUShort, ctInt, ctUInt,
|
|
ctLong, ctULong, ctFloat, ctDouble, ctLongDouble, ctComp,
|
|
ctVoid, ctInt32, ctUInt32, ctBool, ctLongLong, ctULongLong);
|
|
|
|
{tokens}
|
|
{------}
|
|
{Note: tokenEnum is duplicated in }
|
|
{ Table.asm }
|
|
tokenEnum = ( {enumeration of the tokens}
|
|
ident, {identifiers}
|
|
{constants}
|
|
{Note: compconst and charconst, etc. }
|
|
{ are not found in program code. }
|
|
{ They are created only by casts. }
|
|
intconst,uintconst,longconst,ulongconst,longlongconst,
|
|
ulonglongconst,floatconst,doubleconst,extendedconst,compconst,
|
|
charconst,scharconst,ucharconst,ushortconst,stringconst,
|
|
{reserved words}
|
|
_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy,
|
|
_Genericsy,_Imaginarysy,_Noreturnsy,_Static_assertsy,_Thread_localsy,
|
|
autosy,asmsy,breaksy,casesy,charsy,
|
|
continuesy,constsy,compsy,defaultsy,dosy,
|
|
doublesy,elsesy,enumsy,externsy,extendedsy,
|
|
floatsy,forsy,gotosy,ifsy,intsy,
|
|
inlinesy,longsy,pascalsy,registersy,restrictsy,
|
|
returnsy,shortsy,sizeofsy,staticsy,structsy,
|
|
switchsy,segmentsy,signedsy,typedefsy,unionsy,
|
|
unsignedsy,voidsy,volatilesy,whilesy,
|
|
{reserved symbols}
|
|
excch,percentch,carotch,andch,asteriskch,
|
|
minusch,plusch,eqch,tildech,barch,
|
|
dotch,ltch,gtch,slashch,questionch,
|
|
lparench,rparench,lbrackch,rbrackch,lbracech,
|
|
rbracech,commach,semicolonch,colonch,poundch,
|
|
minusgtop,plusplusop,minusminusop,ltltop,gtgtop,
|
|
lteqop,gteqop,eqeqop,exceqop,andandop,
|
|
barbarop,pluseqop,minuseqop,asteriskeqop,slasheqop,
|
|
percenteqop,ltlteqop,gtgteqop,andeqop,caroteqop,
|
|
bareqop,poundpoundop,dotdotdotsy,
|
|
otherch, {other non-whitespace char (pp-token)}
|
|
eolsy,eofsy, {control characters}
|
|
typedef, {user types}
|
|
{converted operations}
|
|
uminus,uplus,uand,uasterisk,
|
|
parameteroper,castoper,opplusplus,opminusminus,compoundliteral,
|
|
macroParm); {macro language}
|
|
|
|
{Note: this enumeration also }
|
|
{ appears in TABLE.ASM, }
|
|
{ SCANNER.asm }
|
|
charEnum = {character kinds}
|
|
(illegal,ch_special,ch_dash,ch_plus,ch_lt,ch_gt,ch_eq,ch_exc,
|
|
ch_and,ch_bar,ch_dot,ch_white,ch_eol,ch_eof,ch_char,ch_string,
|
|
ch_asterisk,ch_slash,ch_percent,ch_carot,ch_pound,ch_colon,
|
|
ch_backslash,ch_other,letter,digit);
|
|
|
|
{prefixes of a character/string literal}
|
|
charStrPrefixEnum = (prefix_none,prefix_L,prefix_u16,prefix_U32,prefix_u8);
|
|
|
|
tokenSet = set of tokenEnum;
|
|
tokenClass = (reservedWord,reservedSymbol,identifier,intConstant,longConstant,
|
|
longlongConstant,realConstant,stringConstant,otherCharacter,
|
|
macroParameter);
|
|
identPtr = ^identRecord; {^ to a symbol table entry}
|
|
tokenType = record {a token}
|
|
kind: tokenEnum; {kind of token}
|
|
numString: stringPtr; {chars in number (macros only)}
|
|
case class: tokenClass of {token info}
|
|
reservedWord : ();
|
|
reservedSymbol: (isDigraph: boolean);
|
|
identifier : (name: stringPtr;
|
|
symbolPtr: identPtr);
|
|
intConstant : (ival: integer);
|
|
longConstant : (lval: longint);
|
|
longlongConstant: (qval: longlong);
|
|
realConstant : (rval: extended);
|
|
stringConstant: (sval: longstringPtr;
|
|
ispstring: boolean;
|
|
prefix: charStrPrefixEnum);
|
|
otherCharacter: (ch: char); {used for preprocessing tokens only}
|
|
macroParameter: (pnum: integer);
|
|
end;
|
|
|
|
{expressions}
|
|
{-----------}
|
|
expressionKind = ( {kinds of expressions}
|
|
preprocessorExpression, {used by preprocessor commands}
|
|
arrayExpression, {array subscripts, case labels,
|
|
bit-field lengths, enum values}
|
|
initializerExpression, {static variable initializers}
|
|
autoInitializerExpression, {auto variable initializers}
|
|
normalExpression); {for run-time evaluation}
|
|
typePtr = ^typeRecord;
|
|
tokenPtr = ^tokenRecord;
|
|
tokenRecord = record {for operation, operand stacks}
|
|
next: tokenPtr; {next token on the stack}
|
|
left,middle,right: tokenPtr; {operand paths for operations}
|
|
token: tokenType; {token at this node/leaf}
|
|
case boolean of
|
|
true : (id: identPtr;); {^symbol table entry for this operand}
|
|
false: (castType: typePtr;); {cast type (for type casts only)}
|
|
end;
|
|
|
|
{goto label list}
|
|
{---------------}
|
|
gotoPtr = ^gotoRecord;
|
|
gotoRecord = record
|
|
{Note: if the size changes, see gotoSize}
|
|
next: gotoPtr;
|
|
name: stringPtr;
|
|
lab: integer;
|
|
defined: boolean;
|
|
end;
|
|
|
|
{symbol tables}
|
|
{-------------}
|
|
{classes of variables in the sym. tbl}
|
|
spaceType = (tagSpace,variableSpace,allSpaces,fieldListSpace);
|
|
|
|
parameterPtr = ^parameterRecord; {prototype parameter list}
|
|
parameterRecord = record
|
|
next: parameterPtr;
|
|
parameter: identPtr;
|
|
parameterType: typePtr;
|
|
end;
|
|
|
|
typeQualifierEnum = (tqConst, tqVolatile, tqRestrict);
|
|
typeQualifierSet = set of typeQualifierEnum;
|
|
|
|
typeKind = (scalarType,arrayType,pointerType,functionType,enumType,
|
|
enumConst,structType,unionType,definedType);
|
|
typeRecord = record {type}
|
|
size: longint; {size of the type in bytes}
|
|
qualifiers: typeQualifierSet; {type qualifiers}
|
|
saveDisp: longint; {disp in symbol file}
|
|
case kind: typeKind of {NOTE: aType,pType and fType must overlap}
|
|
scalarType : (baseType: baseTypeEnum; {our internal type representation}
|
|
cType: cTypeEnum); {type in the C type system}
|
|
arrayType : (aType: typePtr;
|
|
elements: longint;
|
|
);
|
|
pointerType : (pType: typePtr;);
|
|
functionType: (fType: typePtr; {return type}
|
|
varargs, {are there a variable # of args?}
|
|
prototyped: boolean; {is it prototyped?}
|
|
overrideKR: boolean; {K&R overrides to prototypes?}
|
|
parameterList: parameterPtr; {prototyped parameter list}
|
|
isPascal: boolean; {pascal parameters?}
|
|
toolNum: integer; {non-zero for tool functions}
|
|
dispatcher: longint; {dispatch addr}
|
|
);
|
|
enumConst : (eval: integer;);
|
|
enumType : ();
|
|
definedType : (dType: typePtr;);
|
|
structType,
|
|
unionType : (fieldList: identPtr; {field list}
|
|
sName: stringPtr; {struct name; for forward refs}
|
|
constMember: boolean; {does it have a const member?}
|
|
flexibleArrayMember: boolean; {does it have a FAM?}
|
|
);
|
|
end;
|
|
|
|
initializerPtr = ^initializerRecord; {initializers}
|
|
initializerRecord = record
|
|
next: initializerPtr; {next record in the chain}
|
|
disp: longint; {disp within overall object being initialized}
|
|
count: integer; {# of duplicate records (>1 for bytes only)}
|
|
bitdisp: integer; {disp in byte (field lists only)}
|
|
bitsize: integer; {width in bits; 0 for byte sizes}
|
|
case isConstant: boolean of {is this a constant initializer?}
|
|
false: (
|
|
iType: typePtr; {type being initialized}
|
|
iTree: tokenPtr; {initializer expression}
|
|
);
|
|
true : ( {Note: qVal.lo must overlap iVal}
|
|
case basetype: baseTypeEnum of
|
|
cgByte,
|
|
cgUByte,
|
|
cgWord,
|
|
cgUWord,
|
|
cgLong,
|
|
cgULong : (iVal: longint);
|
|
cgQuad,
|
|
cgUQuad : (qVal: longlong);
|
|
cgString : (sVal: longstringPtr);
|
|
cgReal,
|
|
cgDouble,
|
|
cgComp,
|
|
cgExtended: (rVal: extended);
|
|
cgVoid,
|
|
ccPointer: (
|
|
pVal: longint;
|
|
pPlus: boolean;
|
|
case isName: boolean of
|
|
true : (pName: stringPtr);
|
|
false: (pStr : longstringPtr);
|
|
);
|
|
);
|
|
end;
|
|
|
|
storageType = (stackFrame,parameter,external,global,none,private);
|
|
stateKind = (declared,defined,initialized);
|
|
identRecord = record {identifier}
|
|
next: identPtr; {next symbol in this hash bucket}
|
|
saved: boolean; {has the symbol been saved (hashed) in the symbol file?}
|
|
name: stringPtr; {symbol name}
|
|
itype: typePtr; {symbol type}
|
|
disp: longint; {disp past start of struct (field lists only)}
|
|
bitDisp: integer; {disp in byte (field lists only)}
|
|
{parameter number (K&R parms only)}
|
|
bitsize: integer; {width in bits; 0 for byte sizes}
|
|
state: stateKind; {state of the definition}
|
|
iPtr: initializerPtr; {pointer to the first initializer}
|
|
isForwardDeclared: boolean; {does this var use a forward declared type?}
|
|
class: tokenEnum; {storage class}
|
|
used: boolean; {is this identifier used?}
|
|
case storage: storageType of
|
|
stackFrame: (lln: integer; {local label #}
|
|
clnext: identPtr); {next compound literal}
|
|
parameter: (pln: integer; {paramater label #}
|
|
pdisp: integer; {disp of parameter}
|
|
pnext: identPtr); {next parameter}
|
|
external: (inlineDefinition: boolean); {(potential) inline definition of function?}
|
|
global,private: ();
|
|
none: (
|
|
case anonMemberField: boolean of {field from an anonymous struct/union member?}
|
|
true : (anonMember: identPtr); {containing anonymous struct/union}
|
|
false: ();
|
|
);
|
|
end;
|
|
|
|
{mini-assembler}
|
|
{--------------}
|
|
{opcodes}
|
|
opcode = (o_adc,o_and,o_asl,o_bit,o_cmp,o_cop,o_cpx,o_cpy,o_dec,o_eor,
|
|
o_inc,o_jml,o_jmp,o_jsl,o_jsr,o_lda,o_ldx,o_ldy,o_lsr,o_ora,
|
|
o_pea,o_pei,o_rep,o_rol,o_ror,o_sbc,o_sep,o_sta,o_stx,o_sty,
|
|
o_stz,o_trb,o_tsb,
|
|
|
|
o_dcb,o_dcw,o_dcl,
|
|
|
|
o_brk,o_wdm,
|
|
|
|
o_mvn,o_mvp,
|
|
|
|
o_bcc,o_bcs,o_beq,o_bmi,o_bne,o_bpl,o_bra,o_brl,o_per,o_bvc,
|
|
o_bvs,
|
|
|
|
o_clc,o_cld,o_cli,o_clv,o_dex,o_dey,o_inx,o_iny,o_nop,o_pha,
|
|
o_phb,o_phd,o_phk,o_php,o_phx,o_phy,o_pla,o_plb,o_pld,o_plp,
|
|
o_plx,o_ply,o_rti,o_rtl,o_rts,o_sec,o_sed,o_sei,o_stp,o_tax,
|
|
o_tay,o_tcd,o_tcs,o_tdc,o_tsc,o_tsx,o_txa,o_txs,o_txy,o_tya,
|
|
o_tyx,o_wai,o_xba,o_xce);
|
|
|
|
{addressing modes}
|
|
operands = (acc,imm,dp,dp_x,dp_y,op,op_x,op_y,i_dp_x,i_dp_y,dp_s,li_dp,la,
|
|
i_dp,i_op,i_la,i_op_x,i_dp_s_y,li_dp_y,long_x);
|
|
|
|
{work variables}
|
|
{--------------}
|
|
tempPtr = ^tempRecord;
|
|
tempRecord = record
|
|
last,next: tempPtr; {doubly linked list}
|
|
labelNum: integer; {label number}
|
|
size: integer; {size of the variable}
|
|
end;
|
|
|
|
{ORCA Shell and ProDOS}
|
|
{---------------------}
|
|
timeField = array[1..8] of byte;
|
|
|
|
optionListRecord = record
|
|
totalSize: integer;
|
|
requiredSize: integer;
|
|
fileSysID: integer;
|
|
theData: packed array [1..100] of char;
|
|
end;
|
|
optionListPtr = ^optionListRecord;
|
|
|
|
fastFileDCBGS = record
|
|
pcount: integer;
|
|
action: integer;
|
|
index: integer;
|
|
flags: integer;
|
|
fileHandle: handle;
|
|
pathName: gsosInStringPtr;
|
|
access: integer;
|
|
fileType: integer;
|
|
auxType: longint;
|
|
storageType: integer;
|
|
createDate: timeField;
|
|
modDate: timeField;
|
|
option: optionListPtr;
|
|
fileLength: longint;
|
|
blocksUsed: longint;
|
|
end;
|
|
|
|
getLInfoDCBGS = record
|
|
pcount: integer;
|
|
sFile: gsosOutStringPtr;
|
|
dFile: gsosOutStringPtr;
|
|
namesList: gsosOutStringPtr;
|
|
iString: gsosOutStringPtr;
|
|
merr: byte;
|
|
merrf: byte;
|
|
lops: byte;
|
|
kFlag: byte;
|
|
mFlags: longint;
|
|
pFlags: longint;
|
|
org: longint;
|
|
end;
|
|
|
|
getPrefixOSDCB = record
|
|
pcount: integer;
|
|
prefixNum: integer;
|
|
prefix: gsosOutStringPtr;
|
|
end;
|
|
|
|
versionDCBGS = record
|
|
pcount: integer;
|
|
version: packed array[1..4] of char;
|
|
end;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
var
|
|
{misc}
|
|
{----}
|
|
bofPtr: ptr; {pointer to the start of sourceFile}
|
|
chPtr: ptr; {pointer to the next character in the file}
|
|
changedSourceFile: boolean; {source file changed in function?}
|
|
cStd: cStandardEnum; {selected C standard}
|
|
debugSourceFileGS: gsosOutString; {debug source file name}
|
|
{debugType is also in SCANNER.ASM}
|
|
debugType: (stop,break,autogo); {line number debug types}
|
|
doingParameters: boolean; {are we processing parm definitions?}
|
|
expandMacros: boolean; {should macros be expanded?}
|
|
ffDCBGS: fastFileDCBGS; {fast file DCB}
|
|
firstPtr: ptr; {points to first char in current line}
|
|
gotoList: gotoPtr; {list of goto labels}
|
|
includeFileGS: gsosOutString; {include file name (for return from includes)}
|
|
infoStringGS: gsosOutString; {language specific command line info}
|
|
intLabel: integer; {last used label number}
|
|
languageNumber: integer; {our language number}
|
|
lastLine: 0..maxint4; {last line number used by pc_nam}
|
|
liDCBGS: getLInfoDCBGS; {get/set LInfo DCB}
|
|
lineNumber: 0..maxint4; {source line number}
|
|
nameFound: boolean; {has a pc_nam been generated?}
|
|
nextLocalLabel: integer; {next available local data label number}
|
|
numErrors: integer; {number of errors in the program}
|
|
objFile: gsosOutString; {object file name}
|
|
oldincludeFileGS: gsosOutString; {previous includeFile value}
|
|
outFileGS: gsosOutString; {keep file name}
|
|
partialFileGS: gsosOutString; {partial compile list}
|
|
pragmaKeepFile: gsosOutStringPtr; {filename specified in #pragma keep}
|
|
sourceFileGS: gsosOutString; {presumed source file name}
|
|
strictMode: boolean; {strictly follow standard, without extensions?}
|
|
tempList: tempPtr; {list of temp work variables}
|
|
longlong0: longlong; {the value 0 as a longlong}
|
|
longlong1: longlong; {the value 1 as a longlong}
|
|
|
|
{expression results}
|
|
{------------------}
|
|
doDispose: boolean; {dispose of the expression tree as we go?}
|
|
realExpressionValue: extended; {value of the last real constant expression}
|
|
llExpressionValue: longlong; {value of the last long long constant expression}
|
|
expressionValue: longint; {value of the last constant expression}
|
|
expressionType: typePtr; {the type of the expression}
|
|
initializerTree: tokenPtr; {for non-constant initializers}
|
|
isConstant: boolean; {is the initializer expression constant?}
|
|
expressionIsLongLong: boolean; {is the last constant expression long long?}
|
|
|
|
{flags}
|
|
{-----}
|
|
codegenStarted: boolean; {have we started the code generator?}
|
|
doingFunction: boolean; {are we processing a function?}
|
|
doingPartial: boolean; {are we doing a partial compile?}
|
|
enterEditor: boolean; {enter editor on terminal errors?}
|
|
filenamesInErrors: boolean; {print filenames in error messages?}
|
|
foundFunction: boolean; {has a function been found?}
|
|
lint: integer; {lint flags}
|
|
list: boolean; {generate source listing?}
|
|
ignoreSymbols: boolean; {ignore .sym file?}
|
|
memoryCompile: boolean; {memory based compile?}
|
|
printSymbols: boolean; {+s flag set?}
|
|
progress: boolean; {write progress info?}
|
|
rebuildSymbols: boolean; {rebuild .sym file?}
|
|
switchLanguages: boolean; {switch languages on exit?}
|
|
terminalErrors: boolean; {are all errors terminal?}
|
|
traceBack: boolean; {generate traceback code?}
|
|
unix_1: boolean; {is int 32 bits? (or 16 bits)}
|
|
useGlobalPool: boolean; {use global (or local) string pool?}
|
|
wait: boolean; {wait for keypress after errors?}
|
|
lintIsError: boolean; {treat lint messages as errors?}
|
|
fIsNoreturn: boolean; {is the current function _Noreturn?}
|
|
doingMain: boolean; {are we processing the main function?}
|
|
fenvAccess: boolean; {is the FENV_ACCESS pragma on?}
|
|
fenvAccessInFunction: boolean; {was FENV_ACCESS on anywhere in current function?}
|
|
|
|
{syntactic classes of tokens}
|
|
{---------------------------}
|
|
specifierQualifierListElement: tokenSet;
|
|
topLevelDeclarationStart: tokenSet;
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
{ORCA Shell and ProDOS}
|
|
{---------------------}
|
|
|
|
procedure GetLInfoGS (var parms: getLInfoDCBGS); prodos ($0141);
|
|
|
|
procedure FastFileGS (var parms: fastFileDCBGS); prodos ($014E);
|
|
|
|
procedure SetLInfoGS (var parms: getLInfoDCBGS); prodos ($0142);
|
|
|
|
procedure GetPrefixGS (var parms: getPrefixOSDCB); prodos ($200A);
|
|
|
|
procedure VersionGS (var parms: versionDCBGS); prodos ($0147);
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure CheckGotoList;
|
|
|
|
{ Make sure all labels have been defined }
|
|
|
|
|
|
procedure ClearHourGlass;
|
|
|
|
{ Erase the hourglass from the screen }
|
|
|
|
|
|
procedure CopyLongString (toPtr, fromPtr: longStringptr);
|
|
|
|
{ copy a long string }
|
|
{ }
|
|
{ parameters: }
|
|
{ toPtr - location to copy to }
|
|
{ fromPtr - location to copy from }
|
|
|
|
|
|
procedure CopyString (toPtr, fromPtr: ptr); extern;
|
|
|
|
{ copy a string }
|
|
{ }
|
|
{ parameters: }
|
|
{ toPtr - location to copy to }
|
|
{ fromPtr - location to copy from }
|
|
|
|
|
|
procedure DrawHourGlass;
|
|
|
|
{ Draw the hourglass on the screen }
|
|
|
|
|
|
procedure ExitToEditor (msg: stringPtr; disp: longint);
|
|
|
|
{ do an error exit to the editor }
|
|
{ }
|
|
{ parameters: }
|
|
{ msg - pointer to the error message }
|
|
{ disp - displacement into the error file }
|
|
{ }
|
|
{ variables: }
|
|
{ includeFile - source file name }
|
|
|
|
|
|
function GenLabel: integer;
|
|
|
|
{ generate the next local label, checking for too many }
|
|
|
|
|
|
function GetLocalLabel: integer;
|
|
|
|
{ get the next local label number }
|
|
|
|
|
|
function Hash (sPtr: stringPtr): integer; extern;
|
|
|
|
{ find hash displacement }
|
|
{ }
|
|
{ Finds the displacement into an array of pointers using a }
|
|
{ hash function. }
|
|
{ }
|
|
{ parameters: }
|
|
{ sPtr - points to string to find hash for }
|
|
|
|
|
|
procedure InitCCommon;
|
|
|
|
{ Initialize this module }
|
|
|
|
|
|
procedure ReadFile;
|
|
|
|
{ read a file }
|
|
{ }
|
|
{ variables: }
|
|
{ bofPtr - pointer to the start of the file }
|
|
{ ffDCB.file_length - length of the file }
|
|
{ includeFile - source file name }
|
|
|
|
|
|
procedure Spin;
|
|
|
|
{ Spin the spinner }
|
|
{ }
|
|
{ Notes: Starts the spinner if it is not already in use }
|
|
|
|
|
|
procedure StopSpin;
|
|
|
|
{ Stop the spinner }
|
|
{ }
|
|
{ Notes: The call is safe, and ignored, if the spinner is }
|
|
|
|
|
|
procedure SystemError (errNo: integer);
|
|
|
|
{ intercept run time compiler errors }
|
|
|
|
|
|
procedure TermError (errnum: integer);
|
|
|
|
{ flag a terminal error }
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
implementation
|
|
|
|
const
|
|
{Note: maxLabel is also defined in cgi.pas}
|
|
{Note: maxlabel is also defined in CGC.asm}
|
|
maxLabel = 3275; {max # compiler generated labels}
|
|
|
|
{spinner}
|
|
{-------}
|
|
spinSpeed = 8; {calls before one spinner move}
|
|
|
|
type
|
|
consoleOutDCBGS = record
|
|
pcount: integer;
|
|
ch: char;
|
|
end;
|
|
|
|
var
|
|
{spinner}
|
|
{-------}
|
|
|
|
spinning: boolean; {are we spinning now?}
|
|
spinDisp: integer; {disp to the spinner character}
|
|
spinCount: integer; {spin loop counter}
|
|
|
|
spinner: array[0..3] of char; {spinner characters}
|
|
|
|
|
|
procedure Error (err: integer); extern; {in scanner.pas}
|
|
|
|
{ flag an error }
|
|
{ }
|
|
{ err - error number }
|
|
|
|
|
|
{procedure Error2 (loc, err: integer); extern; {debug} {in scanner.pas}
|
|
|
|
{ flag an error }
|
|
{ }
|
|
{ loc - error location }
|
|
{ err - error number }
|
|
|
|
|
|
procedure MMQuit; extern; {in mm.pas}
|
|
|
|
{ Dispose of memory allocated with private user IDs }
|
|
|
|
|
|
procedure ConsoleOutGS (var parms: consoleOutDCBGS); prodos ($015A);
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
procedure CheckGotoList;
|
|
|
|
{ Make sure all labels have been defined }
|
|
|
|
var
|
|
gt: gotoPtr; {work pointer}
|
|
msg: stringPtr; {work string}
|
|
|
|
begin {CheckGotoList}
|
|
gt := gotoList;
|
|
while gt <> nil do begin
|
|
if not gt^.defined then begin
|
|
numErrors := numErrors+1;
|
|
new(msg);
|
|
msg^ := concat('Undefined label: ', gt^.name^);
|
|
writeln(msg^);
|
|
if terminalErrors then begin
|
|
if enterEditor then
|
|
ExitToEditor(msg, ord4(firstPtr)-ord4(bofPtr))
|
|
else
|
|
TermError(0);
|
|
end; {if}
|
|
dispose(msg);
|
|
end; {if}
|
|
gt := gt^.next;
|
|
end; {while}
|
|
end; {CheckGotoList}
|
|
|
|
|
|
procedure ClearHourGlass;
|
|
|
|
{ Erase the hourglass from the screen }
|
|
|
|
var
|
|
coRec: consoleOutDCBGS; {Console out record}
|
|
|
|
begin {ClearHourGlass}
|
|
coRec.pcount := 1;
|
|
coRec.ch := ' '; ConsoleOutGS(coRec);
|
|
coRec.ch := chr(8); ConsoleOutGS(coRec);
|
|
end; {ClearHourGlass}
|
|
|
|
|
|
procedure CopyLongString {toPtr, fromPtr: longStringPtr};
|
|
|
|
{ copy a long string }
|
|
{ }
|
|
{ parameters: }
|
|
{ toPtr - location to copy to }
|
|
{ fromPtr - location to copy from }
|
|
|
|
var
|
|
i: integer; {loop variable}
|
|
|
|
begin {CopyLongString}
|
|
toPtr^.length := fromPtr^.length; {set the length}
|
|
for i := 1 to fromPtr^.length do
|
|
toPtr^.str[i] := fromPtr^.str[i];
|
|
end; {CopyLongString}
|
|
|
|
|
|
procedure DrawHourGlass;
|
|
|
|
{ Draw the hourglass on the screen }
|
|
|
|
var
|
|
coRec: consoleOutDCBGS; {Console out record}
|
|
|
|
begin {DrawHourGlass}
|
|
coRec.pcount := 1;
|
|
coRec.ch := chr(27); ConsoleOutGS(coRec);
|
|
coRec.ch := chr(15); ConsoleOutGS(coRec);
|
|
coRec.ch := 'C'; ConsoleOutGS(coRec);
|
|
coRec.ch := chr(24); ConsoleOutGS(coRec);
|
|
coRec.ch := chr(14); ConsoleOutGS(coRec);
|
|
coRec.ch := chr(8); ConsoleOutGS(coRec);
|
|
end; {DrawHourGlass}
|
|
|
|
|
|
procedure ExitToEditor {msg: stringPtr; disp: longint};
|
|
|
|
{ do an error exit to the editor }
|
|
{ }
|
|
{ parameters: }
|
|
{ msg - pointer to the error message }
|
|
{ disp - displacement into the error file }
|
|
{ }
|
|
{ variables: }
|
|
{ includeFile - source file name }
|
|
|
|
var
|
|
msgGS: gsosInString; {message}
|
|
|
|
begin {ExitToEditor}
|
|
if disp < 0 then {sanity check disp}
|
|
disp := 0;
|
|
msgGS.size := length(msg^); {set up the error message}
|
|
msgGS.theString := msg^;
|
|
liDCBGS.org := disp; {mark the error}
|
|
liDCBGS.namesList := @msgGS;
|
|
liDCBGS.lops := 0; {prevent re-entry}
|
|
liDCBGS.merrf := 255;
|
|
with liDCBGS do begin
|
|
sFile := pointer(ord4(sFile)+2);
|
|
dFile := pointer(ord4(dFile)+2);
|
|
iString := pointer(ord4(iString)+2);
|
|
end; {with}
|
|
SetLInfoGS(liDCBGS);
|
|
StopSpin; {stop the spinner}
|
|
MMQuit; {dispose of the memory pools}
|
|
halt(-1); {return to the shell}
|
|
end; {ExitToEditor}
|
|
|
|
|
|
function GenLabel{: integer};
|
|
|
|
{ generate the next local label, checking for too many }
|
|
|
|
begin {GenLabel}
|
|
if intLabel < maxLabel then
|
|
intLabel := intLabel+1
|
|
else begin
|
|
intLabel := 0;
|
|
Error(58);
|
|
end;
|
|
GenLabel := intLabel;
|
|
end; {GenLabel}
|
|
|
|
|
|
function GetLocalLabel{: integer};
|
|
|
|
{ get the next local label number }
|
|
|
|
begin {GetLocalLabel}
|
|
GetLocalLabel := nextLocalLabel;
|
|
nextLocalLabel := nextLocalLabel+1;
|
|
end; {GetLocalLabel}
|
|
|
|
|
|
procedure InitCCommon;
|
|
|
|
{ Initialize this module }
|
|
|
|
begin {InitCCommon}
|
|
spinning := false; {not spinning the spinner}
|
|
spinDisp := 0; {start spinning with the first character}
|
|
spinner[0] := '|'; {set up the spinner characters}
|
|
spinner[1] := '/';
|
|
spinner[2] := '-';
|
|
spinner[3] := '\';
|
|
longlong0.hi := 0;
|
|
longlong0.lo := 0;
|
|
longlong1.hi := 0;
|
|
longlong1.lo := 1;
|
|
end; {InitCCommon}
|
|
|
|
|
|
procedure ReadFile;
|
|
|
|
{ read a file }
|
|
{ }
|
|
{ variables: }
|
|
{ bofPtr - pointer to the start of the file }
|
|
{ ffDCB.file_length - length of the file }
|
|
{ includeFile - source file name }
|
|
|
|
const
|
|
SRC = $B0; {source file type}
|
|
|
|
begin {ReadFile}
|
|
with ffDCBGS do begin {read the source file}
|
|
pCount := 14;
|
|
action := 0;
|
|
flags := $C000;
|
|
pathName := @includeFileGS.theString;
|
|
end; {with}
|
|
FastFileGS(ffDCBGS);
|
|
if ToolError <> 0 then begin
|
|
sourceFileGS := includeFileGS;
|
|
includeFileGS := oldincludeFileGS;
|
|
TermError(1);
|
|
end; {if}
|
|
if ffDCBGS.fileType <> SRC then begin
|
|
includeFileGS := oldincludeFileGS;
|
|
TermError(6);
|
|
end; {if}
|
|
bofPtr := ffDCBGS.fileHandle^; {set beginning of file pointer}
|
|
end; {ReadFile}
|
|
|
|
|
|
procedure Spin;
|
|
|
|
{ Spin the spinner }
|
|
{ }
|
|
{ Notes: Starts the spinner if it is not already in use }
|
|
|
|
var
|
|
coRec: consoleOutDCBGS; {Console out record}
|
|
|
|
begin {Spin}
|
|
if not spinning then begin
|
|
spinning := true;
|
|
spinCount := spinSpeed;
|
|
end; {if}
|
|
spinCount := spinCount - 1;
|
|
if spinCount = 0 then begin
|
|
spinCount := spinSpeed;
|
|
spinDisp := spinDisp - 1;
|
|
if spinDisp < 0 then
|
|
spinDisp := 3;
|
|
coRec.pcount := 1;
|
|
coRec.ch := spinner[spinDisp];
|
|
ConsoleOutGS(coRec);
|
|
coRec.ch := chr(8);
|
|
ConsoleOutGS(coRec);
|
|
end; {if}
|
|
end; {Spin}
|
|
|
|
|
|
procedure StopSpin;
|
|
|
|
{ Stop the spinner }
|
|
{ }
|
|
{ Notes: The call is safe, and ignored, if the spinner is }
|
|
{ inactive. }
|
|
|
|
var
|
|
coRec: consoleOutDCBGS; {Console out record}
|
|
|
|
begin {StopSpin}
|
|
if spinning then begin
|
|
spinning := false;
|
|
coRec.pcount := 1;
|
|
coRec.ch := ' ';
|
|
ConsoleOutGS(coRec);
|
|
coRec.ch := chr(8);
|
|
ConsoleOutGS(coRec);
|
|
end; {if}
|
|
end; {StopSpin}
|
|
|
|
|
|
procedure SystemError {errNo: integer};
|
|
|
|
{ intercept run time compiler errors }
|
|
|
|
begin {SystemError}
|
|
if errNo = 5 then
|
|
TermError(5)
|
|
else
|
|
TermError(3);
|
|
end; {SystemError}
|
|
|
|
|
|
procedure TermError {errnum: integer};
|
|
|
|
{ flag a terminal error }
|
|
|
|
var
|
|
msg: pString; {terminal error message}
|
|
|
|
begin {TermError}
|
|
case errnum of {print the error}
|
|
0 : msg := '' ;
|
|
1 : msg := concat('Error reading ', sourceFileGS.theString.theString);
|
|
2 : msg := concat('Error purging ', sourceFileGS.theString.theString);
|
|
3 : msg := 'terminal compiler error';
|
|
4 : msg := 'user termination';
|
|
5 : msg := 'out of memory';
|
|
6 : msg := 'source files must have a file type of SRC';
|
|
7 : msg := 'you cannot change languages with an include directive';
|
|
8 : msg := 'you cannot change languages from an included file';
|
|
9 : msg := concat('Error writing ', objFile.theString.theString);
|
|
10: msg := 'ORCA/C requires version 2.0 or later of the shell';
|
|
{11: msg := 'The program is too large to compile to memory -- use Compile to Disk';}
|
|
12: msg := 'Invalid sym file detected. Re-run ORCA/C to proceed.';
|
|
13: msg := 'file name or command-line parameter is too long';
|
|
otherwise: begin
|
|
msg := '';
|
|
Error(57);
|
|
end;
|
|
end; {case}
|
|
with ffDCBGS do begin {purge the source file}
|
|
pCount := 5;
|
|
action := 7;
|
|
pathName := @includeFileGS.theString;
|
|
end; {with}
|
|
FastFileGS(ffDCBGS);
|
|
writeln('Terminal error: ', msg); {write the error to stdout}
|
|
if enterEditor then {error exit to editor}
|
|
ExitToEditor(@msg, ord4(chPtr) - ord4(bofPtr))
|
|
else begin
|
|
liDCBGS.lops := 0; {prevent re-entry}
|
|
liDCBGS.merrf := 127;
|
|
with liDCBGS do begin
|
|
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; {stop the spinner}
|
|
MMQuit; {dispose of the memory pools}
|
|
halt(-1); {return to the shell}
|
|
end; {else}
|
|
end; {TermError}
|
|
|
|
end.
|
|
|
|
{$append 'ccommon.asm'}
|