PR modula2/113889 Incorrect constant string value if declared in a definition module
This patch fixes a bug exposed when a constant string is declared in a definition module and imported by a program module. The bug fix was to defer the string assignment and concatenation until quadruples were generated. The conststring symbol has a known field which must be checked prior to retrieving the string contents. gcc/m2/ChangeLog: PR modula2/113889 * gm2-compiler/M2ALU.mod (StringFitsArray): Add tokeno parameter to GetStringLength. (InitialiseArrayOfCharWithString): Add tokeno parameter to GetStringLength. (CheckGetCharFromString): Add tokeno parameter to GetStringLength. * gm2-compiler/M2Const.mod (constResolveViaMeta): Replace PutConstString with PutConstStringKnown. * gm2-compiler/M2GCCDeclare.mod (DeclareCharConstant): Add tokenno parameter and add assert. Use tokenno to generate location. (DeclareStringConstant): Add tokenno and add asserts. Add tokenno parameter to calls to GetStringLength. (PromoteToString): Add assert and add tokenno parameter to GetStringLength. (PromoteToCString): Add assert and add tokenno parameter to GetStringLength. (DeclareConstString): New procedure function. (TryDeclareConst): Remove size local variable. Check IsConstStringKnown. Call DeclareConstString. (PrintString): New procedure. (PrintVerboseFromList): Call PrintString. (CheckResolveSubrange): Check IsConstStringKnown before creating subrange for char or issuing an error. * gm2-compiler/M2GenGCC.mod (ResolveConstantExpressions): Add StringLengthOp, StringConvertM2nulOp, StringConvertCnulOp case clauses. (FindSize): Add assert IsConstStringKnown. (StringToChar): New variable tokenno. Add tokenno parameter to GetStringLength. (FoldStringLength): New procedure. (FoldStringConvertM2nul): New procedure. (FoldStringConvertCnul): New procedure. (CodeAddr): Add tokenno parameter. Replace CurrentQuadToken with tokenno. Add tokenno parameter to GetStringLength. (PrepareCopyString): Rewrite. (IsConstStrKnown): New procedure function. (FoldAdd): Detect conststring op2 and op3 which are known and concat. Place result into op1. (FoldStandardFunction): Pass tokenno as a parameter to GetStringLength. (CodeXIndr): Rewrite comment. Rename op1 to left, op3 to right. Pass rightpos to GetStringLength. * gm2-compiler/M2Quads.def (QuadrupleOp): Add StringConvertCnulOp, StringConvertM2nulOp and StringLengthOp. * gm2-compiler/M2Quads.mod (import): Remove MakeConstLitString. Add CopyConstString and PutConstStringKnown. (IsInitialisingConst): Add StringConvertCnulOp, StringConvertM2nulOp and StringLengthOp. (callRequestDependant): Replace MakeConstLitString with MakeConstString. (DeferMakeConstStringCnul): New procedure function. (DeferMakeConstStringM2nul): New procedure function. (CheckParameter): Add early return if the string const is unknown. (DescribeType): Add token parameter to GetStringLength. Check for IsConstStringKnown. (ManipulateParameters): Use DeferMakeConstStringCnul and DeferMakeConstStringM2nul. (MakeLengthConst): Remove and replace with... (DeferMakeLengthConst): ... this. (doBuildBinaryOp): Create ConstString and set it to contents unknown. Check IsConstStringKnown before generating error message. (WriteQuad): Add StringConvertCnulOp, StringConvertM2nulOp and StringLengthOp. (WriteOperator): Add StringConvertCnulOp, StringConvertM2nulOp and StringLengthOp. * gm2-compiler/M2SymInit.mod (CheckReadBeforeInitQuad): Add StringConvertCnulOp, StringConvertM2nulOp and StringLengthOp. * gm2-compiler/NameKey.mod (LengthKey): Allow NulName to return 0. * gm2-compiler/P2SymBuild.mod (BuildString): Replace MakeConstLitString with MakeConstString. (DetermineType): Replace PutConstString with PutConstStringKnown. * gm2-compiler/SymbolTable.def (MakeConstVar): Tidy up comment. (MakeConstLitString): Remove. (MakeConstString): New procedure function. (MakeConstStringCnul): New procedure function. (MakeConstStringM2nul): New procedure function. (PutConstStringKnown): New procedure. (CopyConstString): New procedure. (IsConstStringKnown): New procedure function. (IsConstStringM2): New procedure function. (IsConstStringC): New procedure function. (IsConstStringM2nul): New procedure function. (IsConstStringCnul): New procedure function. (GetStringLength): Add token parameter. (PutConstString): Remove. (GetConstStringM2): Remove. (GetConstStringC): Remove. (GetConstStringM2nul): Remove. (GetConstStringCnul): Remove. (MakeConstStringC): Remove. * gm2-compiler/SymbolTable.mod (SymConstString): Remove M2Variant, NulM2Variant, CVariant, NulCVariant. Add Known. (CheckAnonymous): Replace $$ with __anon. (IsNameAnonymous): Replace $$ with __anon. (MakeConstVar): Detect whether the name is nul and treat as a temporary constant. (MakeConstLitString): Remove. (BackFillString): Remove. (InitConstString): Rewrite. (GetConstStringM2): Remove. (GetConstStringC): Remove. (GetConstStringContent): New procedure function. (GetConstStringM2nul): Remove. (GetConstStringCnul): Remove. (MakeConstStringCnul): Rewrite. (MakeConstStringM2nul): Rewrite. (MakeConstStringC): Remove. (MakeConstString): Rewrite. (PutConstStringKnown): New procedure. (CopyConstString): New procedure. (PutConstString): Remove. (IsConstStringKnown): New procedure function. (IsConstStringM2): New procedure function. (IsConstStringC): Rewrite. (IsConstStringM2nul): Rewrite. (IsConstStringCnul): Rewrite. (GetConstStringKind): New procedure function. (GetString): Check Known. (GetStringLength): Add token parameter and check Known. gcc/testsuite/ChangeLog: PR modula2/113889 * gm2/pim/run/pass/pim-run-pass.exp: Add filter for constdef.mod. * gm2/extensions/run/pass/callingc2.mod: New test. * gm2/extensions/run/pass/callingc3.mod: New test. * gm2/extensions/run/pass/callingc4.mod: New test. * gm2/extensions/run/pass/callingc5.mod: New test. * gm2/extensions/run/pass/callingc6.mod: New test. * gm2/extensions/run/pass/callingc7.mod: New test. * gm2/extensions/run/pass/callingc8.mod: New test. * gm2/extensions/run/pass/fixedarray.mod: New test. * gm2/extensions/run/pass/fixedarray2.mod: New test. * gm2/pim/run/pass/constdef.def: New test. * gm2/pim/run/pass/constdef.mod: New test. * gm2/pim/run/pass/testimportconst.mod: New test. Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley
parent
eb17bdc211
commit
78b72ee5a8
24 changed files with 775 additions and 984 deletions
|
|
@ -4700,7 +4700,7 @@ BEGIN
|
|||
PushIntegerTree(BuildNumberOfArrayElements(location, Mod2Gcc(arrayType))) ;
|
||||
IF IsConstString(el)
|
||||
THEN
|
||||
PushCard(GetStringLength(el))
|
||||
PushCard(GetStringLength(tokenno, el))
|
||||
ELSIF IsConst(el) AND (SkipType(GetType(el))=Char) AND IsValueSolved(el)
|
||||
THEN
|
||||
PushCard(1)
|
||||
|
|
@ -4755,7 +4755,7 @@ BEGIN
|
|||
THEN
|
||||
isChar := FALSE ;
|
||||
s := InitStringCharStar(KeyToCharStar(GetString(el))) ;
|
||||
l := GetStringLength(el)
|
||||
l := GetStringLength(tokenno, el)
|
||||
ELSIF IsConst(el) AND (SkipType(GetType(el))=Char) AND IsValueSolved(el)
|
||||
THEN
|
||||
isChar := TRUE
|
||||
|
|
@ -4905,7 +4905,7 @@ BEGIN
|
|||
offset := totalLength ;
|
||||
IF IsConstString (element)
|
||||
THEN
|
||||
INC (totalLength, GetStringLength (element)) ;
|
||||
INC (totalLength, GetStringLength (tokenno, element)) ;
|
||||
IF totalLength > arrayIndex
|
||||
THEN
|
||||
key := GetString (element) ;
|
||||
|
|
|
|||
|
|
@ -373,7 +373,7 @@ BEGIN
|
|||
WITH h^ DO
|
||||
IF findConstMetaExpr(h)=str
|
||||
THEN
|
||||
PutConstString(constsym, MakeKey('')) ;
|
||||
PutConstStringKnown (constsym, MakeKey(''), FALSE, FALSE) ;
|
||||
IF DebugConsts
|
||||
THEN
|
||||
n := GetSymName(constsym) ;
|
||||
|
|
|
|||
|
|
@ -98,7 +98,7 @@ FROM SymbolTable IMPORT NulSym,
|
|||
IsGnuAsm, IsGnuAsmVolatile, IsObject, IsTuple,
|
||||
IsError, IsHiddenType, IsVarHeap,
|
||||
IsComponent, IsPublic, IsExtern, IsCtor,
|
||||
IsImport, IsImportStatement,
|
||||
IsImport, IsImportStatement, IsConstStringKnown,
|
||||
GetMainModule, GetBaseModule, GetModule, GetLocalSym,
|
||||
PutModuleFinallyFunction,
|
||||
GetProcedureScope, GetProcedureQuads,
|
||||
|
|
@ -1677,11 +1677,12 @@ END DeclareConstantFromTree ;
|
|||
DeclareCharConstant - declares a character constant.
|
||||
*)
|
||||
|
||||
PROCEDURE DeclareCharConstant (sym: CARDINAL) ;
|
||||
PROCEDURE DeclareCharConstant (tokenno: CARDINAL; sym: CARDINAL) ;
|
||||
VAR
|
||||
location: location_t ;
|
||||
BEGIN
|
||||
location := TokenToLocation(GetDeclaredMod(sym)) ;
|
||||
Assert (IsConstStringKnown (sym)) ;
|
||||
location := TokenToLocation(tokenno) ;
|
||||
PreAddModGcc(sym, BuildCharConstant(location, KeyToCharStar(GetString(sym)))) ;
|
||||
WatchRemoveList(sym, todolist) ;
|
||||
WatchIncludeList(sym, fullydeclared)
|
||||
|
|
@ -1689,23 +1690,24 @@ END DeclareCharConstant ;
|
|||
|
||||
|
||||
(*
|
||||
DeclareStringConstant - declares a string constant.
|
||||
DeclareStringConstant - declares a string constant the sym will be known.
|
||||
*)
|
||||
|
||||
PROCEDURE DeclareStringConstant (sym: CARDINAL) ;
|
||||
PROCEDURE DeclareStringConstant (tokenno: CARDINAL; sym: CARDINAL) ;
|
||||
VAR
|
||||
symtree : Tree ;
|
||||
BEGIN
|
||||
Assert (IsConstStringKnown (sym)) ;
|
||||
IF IsConstStringM2nul (sym) OR IsConstStringCnul (sym)
|
||||
THEN
|
||||
(* in either case the string needs a nul terminator. If the string
|
||||
is a C variant it will already have had any escape characters applied.
|
||||
The BuildCStringConstant only adds the nul terminator. *)
|
||||
symtree := BuildCStringConstant (KeyToCharStar (GetString (sym)),
|
||||
GetStringLength (sym))
|
||||
GetStringLength (tokenno, sym))
|
||||
ELSE
|
||||
symtree := BuildStringConstant (KeyToCharStar (GetString (sym)),
|
||||
GetStringLength (sym))
|
||||
GetStringLength (tokenno, sym))
|
||||
END ;
|
||||
PreAddModGcc (sym, symtree) ;
|
||||
WatchRemoveList (sym, todolist) ;
|
||||
|
|
@ -1733,14 +1735,15 @@ BEGIN
|
|||
ch := PopChar (tokenno) ;
|
||||
RETURN BuildCStringConstant (string (InitStringChar (ch)), 1)
|
||||
ELSE
|
||||
size := GetStringLength (sym) ;
|
||||
Assert (IsConstStringKnown (sym)) ;
|
||||
size := GetStringLength (tokenno, sym) ;
|
||||
IF size > 1
|
||||
THEN
|
||||
(* will be a string anyway *)
|
||||
(* It will be already be declared as a string, so return it. *)
|
||||
RETURN Tree (Mod2Gcc (sym))
|
||||
ELSE
|
||||
RETURN BuildStringConstant (KeyToCharStar (GetString (sym)),
|
||||
GetStringLength (sym))
|
||||
GetStringLength (tokenno, sym))
|
||||
END
|
||||
END
|
||||
END PromoteToString ;
|
||||
|
|
@ -1760,13 +1763,14 @@ VAR
|
|||
ch : CHAR ;
|
||||
BEGIN
|
||||
DeclareConstant (tokenno, sym) ;
|
||||
Assert (IsConstStringKnown (sym)) ;
|
||||
IF IsConst (sym) AND (GetSType (sym) = Char)
|
||||
THEN
|
||||
PushValue (sym) ;
|
||||
ch := PopChar (tokenno) ;
|
||||
RETURN BuildCStringConstant (string (InitStringChar (ch)), 1)
|
||||
ELSE
|
||||
size := GetStringLength (sym) ;
|
||||
size := GetStringLength (tokenno, sym) ;
|
||||
RETURN BuildCStringConstant (KeyToCharStar (GetString (sym)),
|
||||
size)
|
||||
END
|
||||
|
|
@ -1971,6 +1975,29 @@ BEGIN
|
|||
END DeclareConstant ;
|
||||
|
||||
|
||||
(*
|
||||
DeclareConstString -
|
||||
*)
|
||||
|
||||
PROCEDURE DeclareConstString (tokenno: CARDINAL; sym: CARDINAL) : BOOLEAN ;
|
||||
VAR
|
||||
size: CARDINAL ;
|
||||
BEGIN
|
||||
IF IsConstStringKnown (sym)
|
||||
THEN
|
||||
size := GetStringLength (tokenno, sym) ;
|
||||
IF size=1
|
||||
THEN
|
||||
DeclareCharConstant (tokenno, sym)
|
||||
ELSE
|
||||
DeclareStringConstant (tokenno, sym)
|
||||
END ;
|
||||
RETURN TRUE
|
||||
END ;
|
||||
RETURN FALSE
|
||||
END DeclareConstString ;
|
||||
|
||||
|
||||
(*
|
||||
TryDeclareConst - try to declare a const to gcc. If it cannot
|
||||
declare the symbol it places it into the
|
||||
|
|
@ -1979,8 +2006,7 @@ END DeclareConstant ;
|
|||
|
||||
PROCEDURE TryDeclareConst (tokenno: CARDINAL; sym: CARDINAL) ;
|
||||
VAR
|
||||
type,
|
||||
size: CARDINAL ;
|
||||
type: CARDINAL ;
|
||||
BEGIN
|
||||
IF NOT GccKnowsAbout(sym)
|
||||
THEN
|
||||
|
|
@ -2001,14 +2027,10 @@ BEGIN
|
|||
RETURN
|
||||
END
|
||||
END ;
|
||||
IF IsConstString(sym)
|
||||
IF IsConstString(sym) AND IsConstStringKnown (sym)
|
||||
THEN
|
||||
size := GetStringLength(sym) ;
|
||||
IF size=1
|
||||
IF DeclareConstString (tokenno, sym)
|
||||
THEN
|
||||
DeclareCharConstant(sym)
|
||||
ELSE
|
||||
DeclareStringConstant (sym)
|
||||
END
|
||||
ELSIF IsValueSolved(sym)
|
||||
THEN
|
||||
|
|
@ -2050,7 +2072,6 @@ END TryDeclareConst ;
|
|||
PROCEDURE DeclareConst (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
|
||||
VAR
|
||||
type: CARDINAL ;
|
||||
size: CARDINAL ;
|
||||
BEGIN
|
||||
IF GccKnowsAbout(sym)
|
||||
THEN
|
||||
|
|
@ -2062,12 +2083,8 @@ BEGIN
|
|||
END ;
|
||||
IF IsConstString(sym)
|
||||
THEN
|
||||
size := GetStringLength(sym) ;
|
||||
IF size=1
|
||||
IF DeclareConstString (tokenno, sym)
|
||||
THEN
|
||||
DeclareCharConstant(sym)
|
||||
ELSE
|
||||
DeclareStringConstant (sym)
|
||||
END
|
||||
ELSIF IsValueSolved(sym)
|
||||
THEN
|
||||
|
|
@ -4054,13 +4071,45 @@ BEGIN
|
|||
END PrintProcedure ;
|
||||
|
||||
|
||||
(*
|
||||
PrintString -
|
||||
*)
|
||||
|
||||
PROCEDURE PrintString (sym: CARDINAL) ;
|
||||
VAR
|
||||
len : CARDINAL ;
|
||||
tokenno: CARDINAL ;
|
||||
BEGIN
|
||||
IF IsConstStringKnown (sym)
|
||||
THEN
|
||||
IF IsConstStringM2 (sym)
|
||||
THEN
|
||||
printf0 ('a Modula-2 string')
|
||||
ELSIF IsConstStringC (sym)
|
||||
THEN
|
||||
printf0 (' a C string')
|
||||
ELSIF IsConstStringM2nul (sym)
|
||||
THEN
|
||||
printf0 (' a nul terminated Modula-2 string')
|
||||
ELSIF IsConstStringCnul (sym)
|
||||
THEN
|
||||
printf0 (' a nul terminated C string')
|
||||
END ;
|
||||
tokenno := GetDeclaredMod (sym) ;
|
||||
len := GetStringLength (tokenno, sym) ;
|
||||
printf1 (' length %d', len)
|
||||
ELSE
|
||||
printf0 ('is not currently known')
|
||||
END
|
||||
END PrintString ;
|
||||
|
||||
|
||||
(*
|
||||
PrintVerboseFromList - prints the, i, th element in the list, l.
|
||||
*)
|
||||
|
||||
PROCEDURE PrintVerboseFromList (l: List; i: CARDINAL) ;
|
||||
VAR
|
||||
len,
|
||||
type,
|
||||
low,
|
||||
high,
|
||||
|
|
@ -4215,22 +4264,8 @@ BEGIN
|
|||
printf2('sym %d IsConst (%a)', sym, n) ;
|
||||
IF IsConstString(sym)
|
||||
THEN
|
||||
printf1(' also IsConstString (%a)', n) ;
|
||||
IF IsConstStringM2 (sym)
|
||||
THEN
|
||||
printf0(' a Modula-2 string')
|
||||
ELSIF IsConstStringC (sym)
|
||||
THEN
|
||||
printf0(' a C string')
|
||||
ELSIF IsConstStringM2nul (sym)
|
||||
THEN
|
||||
printf0(' a nul terminated Modula-2 string')
|
||||
ELSIF IsConstStringCnul (sym)
|
||||
THEN
|
||||
printf0(' a nul terminated C string')
|
||||
END ;
|
||||
len := GetStringLength (sym) ;
|
||||
printf1(' length %d', len)
|
||||
printf1 (' also IsConstString (%a) ', n) ;
|
||||
PrintString (sym)
|
||||
ELSIF IsConstructor(sym)
|
||||
THEN
|
||||
printf0(' constant constructor ') ;
|
||||
|
|
@ -5419,23 +5454,25 @@ END DeclareSet ;
|
|||
|
||||
PROCEDURE CheckResolveSubrange (sym: CARDINAL) ;
|
||||
VAR
|
||||
tokenno : CARDINAL;
|
||||
size, high, low, type: CARDINAL ;
|
||||
BEGIN
|
||||
GetSubrange(sym, high, low) ;
|
||||
tokenno := GetDeclaredMod (sym) ;
|
||||
type := GetSType(sym) ;
|
||||
IF type=NulSym
|
||||
THEN
|
||||
IF GccKnowsAbout(low) AND GccKnowsAbout(high)
|
||||
THEN
|
||||
IF IsConstString(low)
|
||||
IF IsConstString (low) AND IsConstStringKnown (low)
|
||||
THEN
|
||||
size := GetStringLength(low) ;
|
||||
size := GetStringLength (tokenno, low) ;
|
||||
IF size=1
|
||||
THEN
|
||||
PutSubrange(sym, low, high, Char)
|
||||
ELSE
|
||||
MetaError1('cannot have a subrange of a string type {%1Uad}',
|
||||
sym)
|
||||
MetaError1 ('cannot have a subrange of a string type {%1Uad}',
|
||||
sym)
|
||||
END
|
||||
ELSIF IsFieldEnumeration(low)
|
||||
THEN
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
|
|||
PushVarSize,
|
||||
PushSumOfLocalVarSize,
|
||||
PushSumOfParamSize,
|
||||
MakeConstLit, MakeConstLitString,
|
||||
MakeConstLit,
|
||||
RequestSym, FromModuleGetSym,
|
||||
StartScope, EndScope, GetScope,
|
||||
GetMainModule, GetModuleScope,
|
||||
|
|
@ -57,6 +57,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
|
|||
IsValueSolved, IsSizeSolved,
|
||||
IsProcedureNested, IsInnerModule, IsArrayLarge,
|
||||
IsComposite, IsVariableSSA, IsPublic, IsCtor,
|
||||
IsConstStringKnown,
|
||||
ForeachExportedDo,
|
||||
ForeachImportedDo,
|
||||
ForeachProcedureDo,
|
||||
|
|
@ -74,10 +75,10 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
|
|||
GetProcedureQuads,
|
||||
GetProcedureBuiltin,
|
||||
GetPriority, GetNeedSavePriority,
|
||||
PutConstString,
|
||||
PutConstStringKnown,
|
||||
PutConst, PutConstSet, PutConstructor,
|
||||
GetSType, GetTypeMode,
|
||||
HasVarParameters,
|
||||
HasVarParameters, CopyConstString,
|
||||
NulSym ;
|
||||
|
||||
FROM M2Batch IMPORT MakeDefinitionSource ;
|
||||
|
|
@ -522,7 +523,7 @@ BEGIN
|
|||
CallOp : CodeCall (CurrentQuadToken, op3) |
|
||||
ParamOp : CodeParam (q) |
|
||||
FunctValueOp : CodeFunctValue (location, op1) |
|
||||
AddrOp : CodeAddr (q, op1, op3) |
|
||||
AddrOp : CodeAddr (CurrentQuadToken, q, op1, op3) |
|
||||
SizeOp : CodeSize (op1, op3) |
|
||||
UnboundedOp : CodeUnbounded (op1, op3) |
|
||||
RecordFieldOp : CodeRecordField (op1, op2, op3) |
|
||||
|
|
@ -628,7 +629,10 @@ BEGIN
|
|||
LogicalRotateOp : FoldSetRotate (tokenno, p, quad, op1, op2, op3) |
|
||||
ParamOp : FoldBuiltinFunction (tokenno, p, quad, op1, op2, op3) |
|
||||
RangeCheckOp : FoldRange (tokenno, quad, op3) |
|
||||
StatementNoteOp : FoldStatementNote (op3)
|
||||
StatementNoteOp : FoldStatementNote (op3) |
|
||||
StringLengthOp : FoldStringLength (quad, p) |
|
||||
StringConvertM2nulOp: FoldStringConvertM2nul (quad, p) |
|
||||
StringConvertCnulOp : FoldStringConvertCnul (quad, p)
|
||||
|
||||
ELSE
|
||||
(* ignore quadruple as it is not associated with a constant expression *)
|
||||
|
|
@ -650,8 +654,8 @@ END ResolveConstantExpressions ;
|
|||
|
||||
|
||||
(*
|
||||
FindSize - given a Modula-2 symbol, sym, return the GCC Tree
|
||||
(constant) representing the storage size in bytes.
|
||||
FindSize - given a Modula-2 symbol sym return a gcc tree
|
||||
constant representing the storage size in bytes.
|
||||
*)
|
||||
|
||||
PROCEDURE FindSize (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
|
||||
|
|
@ -661,7 +665,8 @@ BEGIN
|
|||
location := TokenToLocation (tokenno) ;
|
||||
IF IsConstString (sym)
|
||||
THEN
|
||||
PushCard (GetStringLength (sym)) ;
|
||||
Assert (IsConstStringKnown (sym)) ;
|
||||
PushCard (GetStringLength (tokenno, sym)) ;
|
||||
RETURN PopIntegerTree ()
|
||||
ELSIF IsSizeSolved (sym)
|
||||
THEN
|
||||
|
|
@ -2040,18 +2045,21 @@ PROCEDURE StringToChar (t: Tree; type, str: CARDINAL) : Tree ;
|
|||
VAR
|
||||
s: String ;
|
||||
n: Name ;
|
||||
tokenno : CARDINAL ;
|
||||
location: location_t ;
|
||||
BEGIN
|
||||
location := TokenToLocation(GetDeclaredMod(str)) ;
|
||||
type := SkipType(type) ;
|
||||
tokenno := GetDeclaredMod(str) ;
|
||||
location := TokenToLocation(tokenno) ;
|
||||
type := SkipType (type) ;
|
||||
IF (type=Char) AND IsConstString(str)
|
||||
THEN
|
||||
IF GetStringLength(str)=0
|
||||
Assert (IsConstStringKnown (str)) ;
|
||||
IF GetStringLength (tokenno, str) = 0
|
||||
THEN
|
||||
s := InitString('') ;
|
||||
t := BuildCharConstant(location, s) ;
|
||||
s := KillString(s) ;
|
||||
ELSIF GetStringLength(str)>1
|
||||
ELSIF GetStringLength (tokenno, str)>1
|
||||
THEN
|
||||
n := GetSymName(str) ;
|
||||
WriteFormat1("type incompatibility, attempting to use a string ('%a') when a CHAR is expected", n) ;
|
||||
|
|
@ -2590,15 +2598,99 @@ END CodeFunctValue ;
|
|||
|
||||
|
||||
(*
|
||||
Addr Operator - contains the address of a variable.
|
||||
|
||||
Yields the address of a variable - need to add the frame pointer if
|
||||
a variable is local to a procedure.
|
||||
|
||||
Sym1<X> Addr Sym2<X> meaning Mem[Sym1<I>] := Sym2<I>
|
||||
FoldStringLength -
|
||||
*)
|
||||
|
||||
PROCEDURE CodeAddr (quad: CARDINAL; op1, op3: CARDINAL) ;
|
||||
PROCEDURE FoldStringLength (quad: CARDINAL; p: WalkAction) ;
|
||||
VAR
|
||||
op : QuadOperator ;
|
||||
des, none, expr : CARDINAL ;
|
||||
stroppos,
|
||||
despos, nonepos,
|
||||
exprpos : CARDINAL ;
|
||||
overflowChecking: BOOLEAN ;
|
||||
location : location_t ;
|
||||
BEGIN
|
||||
GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
|
||||
despos, nonepos, exprpos) ;
|
||||
IF IsConstStr (expr) AND IsConstStrKnown (expr)
|
||||
THEN
|
||||
location := TokenToLocation (stroppos) ;
|
||||
PushCard (GetStringLength (exprpos, expr)) ;
|
||||
AddModGcc (des, BuildConvert (location, Mod2Gcc (GetType (des)), PopIntegerTree (), FALSE)) ;
|
||||
RemoveQuad (p, des, quad)
|
||||
END
|
||||
END FoldStringLength ;
|
||||
|
||||
|
||||
(*
|
||||
FoldStringConvertM2nul - attempt to assign the des with the string contents from expr.
|
||||
It also marks the des as a m2 string which must be nul terminated.
|
||||
The front end uses double book keeping and it is easier to have
|
||||
different m2 string symbols each of which map onto a slightly different
|
||||
gcc string tree.
|
||||
*)
|
||||
|
||||
PROCEDURE FoldStringConvertM2nul (quad: CARDINAL; p: WalkAction) ;
|
||||
VAR
|
||||
op : QuadOperator ;
|
||||
des, none, expr : CARDINAL ;
|
||||
stroppos,
|
||||
despos, nonepos,
|
||||
exprpos : CARDINAL ;
|
||||
s : String ;
|
||||
overflowChecking: BOOLEAN ;
|
||||
BEGIN
|
||||
GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
|
||||
despos, nonepos, exprpos) ;
|
||||
IF IsConstStr (expr) AND IsConstStrKnown (expr)
|
||||
THEN
|
||||
s := GetStr (exprpos, expr) ;
|
||||
PutConstStringKnown (stroppos, des, makekey (string (s)), FALSE, TRUE) ;
|
||||
TryDeclareConstant (despos, des) ;
|
||||
p (des) ;
|
||||
NoChange := FALSE ;
|
||||
SubQuad (quad) ;
|
||||
s := KillString (s)
|
||||
END
|
||||
END FoldStringConvertM2nul ;
|
||||
|
||||
|
||||
(*
|
||||
FoldStringConvertCnul -attempt to assign the des with the string contents from expr.
|
||||
It also marks the des as a C string which must be nul terminated.
|
||||
*)
|
||||
|
||||
PROCEDURE FoldStringConvertCnul (quad: CARDINAL; p: WalkAction) ;
|
||||
VAR
|
||||
op : QuadOperator ;
|
||||
des, none, expr : CARDINAL ;
|
||||
stroppos,
|
||||
despos, nonepos,
|
||||
exprpos : CARDINAL ;
|
||||
s : String ;
|
||||
overflowChecking: BOOLEAN ;
|
||||
BEGIN
|
||||
GetQuadOtok (quad, stroppos, op, des, none, expr, overflowChecking,
|
||||
despos, nonepos, exprpos) ;
|
||||
IF IsConstStr (expr) AND IsConstStrKnown (expr)
|
||||
THEN
|
||||
s := GetStr (exprpos, expr) ;
|
||||
PutConstStringKnown (stroppos, des, makekey (string (s)), TRUE, TRUE) ;
|
||||
TryDeclareConstant (despos, des) ;
|
||||
p (des) ;
|
||||
NoChange := FALSE ;
|
||||
SubQuad (quad) ;
|
||||
s := KillString (s)
|
||||
END
|
||||
END FoldStringConvertCnul ;
|
||||
|
||||
|
||||
(*
|
||||
Addr Operator - generates the address of a variable (op1 = &op3).
|
||||
*)
|
||||
|
||||
PROCEDURE CodeAddr (tokenno: CARDINAL; quad: CARDINAL; op1, op3: CARDINAL) ;
|
||||
VAR
|
||||
value : Tree ;
|
||||
type : CARDINAL ;
|
||||
|
|
@ -2606,15 +2698,19 @@ VAR
|
|||
BEGIN
|
||||
IF IsConst(op3) AND (NOT IsConstString(op3))
|
||||
THEN
|
||||
MetaErrorT1 (CurrentQuadToken, 'error in expression, trying to find the address of a constant {%1Ead}', op3)
|
||||
MetaErrorT1 (tokenno, 'error in expression, trying to find the address of a constant {%1Ead}', op3)
|
||||
ELSE
|
||||
location := TokenToLocation (CurrentQuadToken) ;
|
||||
IF IsConstString (op3) AND (NOT IsConstStringKnown (op3))
|
||||
THEN
|
||||
printf1 ("failure in quad: %d\n", quad)
|
||||
END ;
|
||||
location := TokenToLocation (tokenno) ;
|
||||
type := SkipType (GetType (op3)) ;
|
||||
DeclareConstant (CurrentQuadToken, op3) ; (* we might be asked to find the address of a constant string *)
|
||||
DeclareConstructor (CurrentQuadToken, quad, op3) ;
|
||||
DeclareConstant (tokenno, op3) ; (* we might be asked to find the address of a constant string *)
|
||||
DeclareConstructor (tokenno, quad, op3) ;
|
||||
IF (IsConst (op3) AND (type=Char)) OR IsConstString (op3)
|
||||
THEN
|
||||
value := BuildStringConstant (KeyToCharStar (GetString (op3)), GetStringLength (op3))
|
||||
value := BuildStringConstant (KeyToCharStar (GetString (op3)), GetStringLength (tokenno, op3))
|
||||
ELSE
|
||||
value := Mod2Gcc (op3)
|
||||
END ;
|
||||
|
|
@ -2754,7 +2850,9 @@ END TypeCheckBecomes ;
|
|||
|
||||
|
||||
(*
|
||||
PerformFoldBecomes -
|
||||
PerformFoldBecomes - attempts to fold quad. It propagates constant strings
|
||||
and attempts to declare des providing it is a constant
|
||||
and expr is resolved.
|
||||
*)
|
||||
|
||||
PROCEDURE PerformFoldBecomes (p: WalkAction; quad: CARDINAL) ;
|
||||
|
|
@ -2770,9 +2868,12 @@ BEGIN
|
|||
des, op2, expr, overflowChecking,
|
||||
despos, op2pos, exprpos) ;
|
||||
Assert (op2pos = UnknownTokenNo) ;
|
||||
IF IsConstString (expr)
|
||||
IF IsConst (des) AND IsConstString (expr)
|
||||
THEN
|
||||
PutConstString (exprpos, des, GetString (expr))
|
||||
IF IsConstStringKnown (expr) AND (NOT IsConstStringKnown (des))
|
||||
THEN
|
||||
CopyConstString (exprpos, des, expr)
|
||||
END
|
||||
ELSIF GetType (des) = NulSym
|
||||
THEN
|
||||
Assert (GetType (expr) # NulSym) ;
|
||||
|
|
@ -3033,32 +3134,47 @@ BEGIN
|
|||
THEN
|
||||
(*
|
||||
* Create string from char and add nul to the end, nul is
|
||||
* added by BuildStringConstant
|
||||
* added by BuildStringConstant. In modula-2 an array must
|
||||
* have at least one element.
|
||||
*)
|
||||
srcTree := BuildStringConstant (KeyToCharStar (GetString (src)), 1)
|
||||
ELSE
|
||||
srcTree := Mod2Gcc (src)
|
||||
END ;
|
||||
srcTree := ConvertString (Mod2Gcc (destStrType), srcTree) ;
|
||||
PushIntegerTree (FindSize (tokenno, src)) ;
|
||||
PushIntegerTree (FindSize (tokenno, destStrType)) ;
|
||||
IF Less (tokenno)
|
||||
THEN
|
||||
(* There is room for the extra <nul> character. *)
|
||||
length := BuildAdd (location, FindSize (tokenno, src),
|
||||
GetIntegerOne (location), FALSE)
|
||||
ELSE
|
||||
length := FindSize (tokenno, destStrType) ;
|
||||
length := GetIntegerOne (location) ;
|
||||
PushIntegerTree (FindSize (tokenno, src)) ;
|
||||
PushIntegerTree (length) ;
|
||||
(* Greater or Equal so return max characters in the array. *)
|
||||
IF Gre (tokenno)
|
||||
PushIntegerTree (FindSize (tokenno, destStrType)) ;
|
||||
IF Less (tokenno)
|
||||
THEN
|
||||
intLength := GetCstInteger (length) ;
|
||||
srcTree := BuildStringConstant (KeyToCharStar (GetString (src)), intLength) ;
|
||||
RETURN FALSE
|
||||
(* There is room for the extra <nul> character. *)
|
||||
length := BuildAdd (location, length,
|
||||
GetIntegerOne (location), FALSE)
|
||||
END
|
||||
ELSE
|
||||
PushIntegerTree (FindSize (tokenno, src)) ;
|
||||
PushIntegerTree (FindSize (tokenno, destStrType)) ;
|
||||
IF Less (tokenno)
|
||||
THEN
|
||||
(* There is room for the extra <nul> character. *)
|
||||
length := BuildAdd (location, FindSize (tokenno, src),
|
||||
GetIntegerOne (location), FALSE) ;
|
||||
srcTree := Mod2Gcc (src)
|
||||
ELSE
|
||||
(* We need to truncate the <nul> at least. *)
|
||||
length := FindSize (tokenno, destStrType) ;
|
||||
PushIntegerTree (FindSize (tokenno, src)) ;
|
||||
PushIntegerTree (length) ;
|
||||
(* Greater or Equal so return max characters in the array. *)
|
||||
IF Gre (tokenno)
|
||||
THEN
|
||||
(* Create a new string without non nul characters to be gimple safe.
|
||||
But return FALSE indicating an overflow. *)
|
||||
intLength := GetCstInteger (length) ;
|
||||
srcTree := BuildStringConstant (KeyToCharStar (GetString (src)), intLength) ;
|
||||
srcTree := ConvertString (Mod2Gcc (destStrType), srcTree) ;
|
||||
RETURN FALSE
|
||||
END
|
||||
END
|
||||
END ;
|
||||
intLength := GetCstInteger (length) ;
|
||||
srcTree := BuildStringConstant (KeyToCharStar (GetString (src)), intLength) ;
|
||||
srcTree := ConvertString (Mod2Gcc (destStrType), srcTree) ;
|
||||
RETURN TRUE
|
||||
END PrepareCopyString ;
|
||||
|
||||
|
|
@ -3255,6 +3371,11 @@ BEGIN
|
|||
'assignment check caught mismatch between {%1Ead} and {%2ad}',
|
||||
des, expr)
|
||||
END ;
|
||||
IF IsConstString (expr) AND (NOT IsConstStringKnown (expr))
|
||||
THEN
|
||||
MetaErrorT2 (virtpos,
|
||||
'internal error: CodeBecomes {%1Aad} in quad {%2n}', des, quad)
|
||||
END ;
|
||||
IF IsConst (des) AND (NOT GccKnowsAbout (des))
|
||||
THEN
|
||||
ConstantKnownAndUsed (des, CheckConstant (virtpos, des, expr))
|
||||
|
|
@ -3912,6 +4033,18 @@ BEGIN
|
|||
END IsConstStr ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStrKnown - returns TRUE if sym is a constant string or a char constant
|
||||
which is known.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStrKnown (sym: CARDINAL) : BOOLEAN ;
|
||||
BEGIN
|
||||
RETURN (IsConstString (sym) AND IsConstStringKnown (sym)) OR
|
||||
(IsConst (sym) AND (GetSType (sym) = Char))
|
||||
END IsConstStrKnown ;
|
||||
|
||||
|
||||
(*
|
||||
GetStr - return a string containing a constant string value associated with sym.
|
||||
A nul char constant will return an empty string.
|
||||
|
|
@ -3946,15 +4079,18 @@ VAR
|
|||
BEGIN
|
||||
IF IsConstStr (op2) AND IsConstStr (op3)
|
||||
THEN
|
||||
(* Handle special addition for constant strings. *)
|
||||
s := Dup (GetStr (tokenno, op2)) ;
|
||||
s := ConCat (s, GetStr (tokenno, op3)) ;
|
||||
PutConstString (tokenno, op1, makekey (string (s))) ;
|
||||
TryDeclareConstant (tokenno, op1) ;
|
||||
p (op1) ;
|
||||
NoChange := FALSE ;
|
||||
SubQuad (quad) ;
|
||||
s := KillString (s)
|
||||
IF IsConstStrKnown (op2) AND IsConstStrKnown (op3)
|
||||
THEN
|
||||
(* Handle special addition for constant strings. *)
|
||||
s := Dup (GetStr (tokenno, op2)) ;
|
||||
s := ConCat (s, GetStr (tokenno, op3)) ;
|
||||
PutConstStringKnown (tokenno, op1, makekey (string (s)), FALSE, TRUE) ;
|
||||
TryDeclareConstant (tokenno, op1) ;
|
||||
p (op1) ;
|
||||
NoChange := FALSE ;
|
||||
SubQuad (quad) ;
|
||||
s := KillString (s)
|
||||
END
|
||||
ELSE
|
||||
FoldArithAdd (tokenno, p, quad, op1, op2, op3)
|
||||
END
|
||||
|
|
@ -4539,7 +4675,7 @@ BEGIN
|
|||
END
|
||||
ELSE
|
||||
(* rewrite the quad to use becomes. *)
|
||||
d := GetStringLength (op3) ;
|
||||
d := GetStringLength (tokenno, op3) ;
|
||||
s := Sprintf1 (Mark (InitString ("%d")), d) ;
|
||||
result := MakeConstLit (tokenno, makekey (string (s)), Cardinal) ;
|
||||
s := KillString (s) ;
|
||||
|
|
@ -4555,7 +4691,7 @@ BEGIN
|
|||
(* fine, we can take advantage of this and fold constants *)
|
||||
IF IsConst(op1)
|
||||
THEN
|
||||
IF (IsConstString(op3) AND (GetStringLength(op3)=1)) OR
|
||||
IF (IsConstString(op3) AND (GetStringLength (tokenno, op3) = 1)) OR
|
||||
(GetType(op3)=Char)
|
||||
THEN
|
||||
AddModGcc(op1, BuildCap(location, Mod2Gcc(op3))) ;
|
||||
|
|
@ -7514,13 +7650,9 @@ END CodeIndrX ;
|
|||
|
||||
|
||||
(*
|
||||
------------------------------------------------------------------------------
|
||||
XIndr Operator *a = b
|
||||
------------------------------------------------------------------------------
|
||||
Sym1<I> XIndr Sym2<X> Meaning Mem[constant] := Mem[Sym3<I>]
|
||||
Sym1<X> XIndr Sym2<X> Meaning Mem[Mem[Sym1<I>]] := Mem[Sym3<I>]
|
||||
|
||||
(op2 is the type of the data being indirectly copied)
|
||||
CodeXIndr - operands for XIndrOp are: left type right.
|
||||
*left = right. The second operand is the type of the data being
|
||||
indirectly copied.
|
||||
*)
|
||||
|
||||
PROCEDURE CodeXIndr (quad: CARDINAL) ;
|
||||
|
|
@ -7528,34 +7660,29 @@ VAR
|
|||
overflowChecking: BOOLEAN ;
|
||||
op : QuadOperator ;
|
||||
tokenno,
|
||||
op1,
|
||||
left,
|
||||
type,
|
||||
op3,
|
||||
op1pos,
|
||||
op3pos,
|
||||
right,
|
||||
leftpos,
|
||||
rightpos,
|
||||
typepos,
|
||||
xindrpos : CARDINAL ;
|
||||
length,
|
||||
newstr : Tree ;
|
||||
location : location_t ;
|
||||
BEGIN
|
||||
GetQuadOtok (quad, xindrpos, op, op1, type, op3, overflowChecking,
|
||||
op1pos, typepos, op3pos) ;
|
||||
tokenno := MakeVirtualTok (xindrpos, op1pos, op3pos) ;
|
||||
GetQuadOtok (quad, xindrpos, op, left, type, right, overflowChecking,
|
||||
leftpos, typepos, rightpos) ;
|
||||
tokenno := MakeVirtualTok (xindrpos, leftpos, rightpos) ;
|
||||
location := TokenToLocation (tokenno) ;
|
||||
|
||||
type := SkipType (type) ;
|
||||
DeclareConstant (op3pos, op3) ;
|
||||
DeclareConstructor (op3pos, quad, op3) ;
|
||||
(*
|
||||
Follow the Quadruple rule:
|
||||
|
||||
Mem[Mem[Op1]] := Mem[Op3]
|
||||
*)
|
||||
DeclareConstant (rightpos, right) ;
|
||||
DeclareConstructor (rightpos, quad, right) ;
|
||||
IF IsProcType(SkipType(type))
|
||||
THEN
|
||||
BuildAssignmentStatement (location, BuildIndirect (location, Mod2Gcc (op1), GetPointerType ()), Mod2Gcc (op3))
|
||||
ELSIF IsConstString (op3) AND (GetStringLength (op3) = 0) AND (GetMode (op1) = LeftValue)
|
||||
BuildAssignmentStatement (location, BuildIndirect (location, Mod2Gcc (left), GetPointerType ()), Mod2Gcc (right))
|
||||
ELSIF IsConstString (right) AND (GetStringLength (rightpos, right) = 0) AND (GetMode (left) = LeftValue)
|
||||
THEN
|
||||
(*
|
||||
no need to check for type errors,
|
||||
|
|
@ -7564,25 +7691,25 @@ BEGIN
|
|||
contents.
|
||||
*)
|
||||
BuildAssignmentStatement (location,
|
||||
BuildIndirect (location, LValueToGenericPtr (location, op1), Mod2Gcc (Char)),
|
||||
StringToChar (Mod2Gcc (op3), Char, op3))
|
||||
ELSIF IsConstString (op3) AND (SkipTypeAndSubrange (GetType (op1)) # Char)
|
||||
BuildIndirect (location, LValueToGenericPtr (location, left), Mod2Gcc (Char)),
|
||||
StringToChar (Mod2Gcc (right), Char, right))
|
||||
ELSIF IsConstString (right) AND (SkipTypeAndSubrange (GetType (left)) # Char)
|
||||
THEN
|
||||
IF NOT PrepareCopyString (tokenno, length, newstr, op3, type)
|
||||
IF NOT PrepareCopyString (tokenno, length, newstr, right, type)
|
||||
THEN
|
||||
MetaErrorT2 (MakeVirtualTok (xindrpos, op1pos, op3pos),
|
||||
MetaErrorT2 (MakeVirtualTok (xindrpos, leftpos, rightpos),
|
||||
'string constant {%1Ea} is too large to be assigned to the array {%2ad}',
|
||||
op3, op1)
|
||||
right, left)
|
||||
END ;
|
||||
AddStatement (location,
|
||||
MaybeDebugBuiltinMemcpy (location,
|
||||
Mod2Gcc (op1),
|
||||
Mod2Gcc (left),
|
||||
BuildAddr (location, newstr, FALSE),
|
||||
length))
|
||||
ELSE
|
||||
BuildAssignmentStatement (location,
|
||||
BuildIndirect (location, Mod2Gcc (op1), Mod2Gcc (type)),
|
||||
ConvertRHS (Mod2Gcc (op3), type, op3))
|
||||
BuildIndirect (location, Mod2Gcc (left), Mod2Gcc (type)),
|
||||
ConvertRHS (Mod2Gcc (right), type, right))
|
||||
END
|
||||
END CodeXIndr ;
|
||||
|
||||
|
|
|
|||
|
|
@ -233,6 +233,9 @@ TYPE
|
|||
SubOp,
|
||||
SubrangeHighOp,
|
||||
SubrangeLowOp,
|
||||
StringConvertCnulOp,
|
||||
StringConvertM2nulOp,
|
||||
StringLengthOp,
|
||||
ThrowOp,
|
||||
TryOp,
|
||||
UnboundedOp,
|
||||
|
|
|
|||
|
|
@ -50,8 +50,9 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
|
|||
MakeTemporary,
|
||||
MakeTemporaryFromExpression,
|
||||
MakeTemporaryFromExpressions,
|
||||
MakeConstLit, MakeConstLitString,
|
||||
MakeConstString, MakeConstant,
|
||||
MakeConstLit,
|
||||
MakeConstString, MakeConstant, MakeConstVar,
|
||||
MakeConstStringM2nul, MakeConstStringCnul,
|
||||
Make2Tuple,
|
||||
RequestSym, MakePointer, PutPointer,
|
||||
SkipType,
|
||||
|
|
@ -71,8 +72,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
|
|||
GetModuleQuads, GetProcedureQuads,
|
||||
GetModuleCtors,
|
||||
MakeProcedure,
|
||||
MakeConstStringCnul, MakeConstStringM2nul,
|
||||
PutConstString,
|
||||
CopyConstString, PutConstStringKnown,
|
||||
PutModuleStartQuad, PutModuleEndQuad,
|
||||
PutModuleFinallyStartQuad, PutModuleFinallyEndQuad,
|
||||
PutProcedureStartQuad, PutProcedureEndQuad,
|
||||
|
|
@ -110,7 +110,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
|
|||
PutConstructor, PutConstructorFrom,
|
||||
PutDeclared,
|
||||
MakeComponentRecord, MakeComponentRef,
|
||||
IsSubscript, IsComponent,
|
||||
IsSubscript, IsComponent, IsConstStringKnown,
|
||||
IsTemporary,
|
||||
IsAModula2Type,
|
||||
PutLeftValueFrontBackType,
|
||||
|
|
@ -852,6 +852,9 @@ BEGIN
|
|||
GetQuad (QuadNo, op, op1, op2, op3) ;
|
||||
CASE op OF
|
||||
|
||||
StringConvertCnulOp,
|
||||
StringConvertM2nulOp,
|
||||
StringLengthOp,
|
||||
InclOp,
|
||||
ExclOp,
|
||||
UnboundedOp,
|
||||
|
|
@ -2334,12 +2337,12 @@ BEGIN
|
|||
Assert (requestDep # NulSym) ;
|
||||
PushTtok (requestDep, tokno) ;
|
||||
PushTF (Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tokno, GetSymName (moduleSym)), tokno) ;
|
||||
PushTtok (MakeConstString (tokno, GetSymName (moduleSym)), tokno) ;
|
||||
PushT (1) ;
|
||||
BuildAdrFunction ;
|
||||
|
||||
PushTF (Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tokno, GetLibName (moduleSym)), tokno) ;
|
||||
PushTtok (MakeConstString (tokno, GetLibName (moduleSym)), tokno) ;
|
||||
PushT (1) ;
|
||||
BuildAdrFunction ;
|
||||
|
||||
|
|
@ -2349,12 +2352,12 @@ BEGIN
|
|||
PushTF (Nil, Address)
|
||||
ELSE
|
||||
PushTF (Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tokno, GetSymName (depModuleSym)), tokno) ;
|
||||
PushTtok (MakeConstString (tokno, GetSymName (depModuleSym)), tokno) ;
|
||||
PushT (1) ;
|
||||
BuildAdrFunction ;
|
||||
|
||||
PushTF (Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tokno, GetLibName (depModuleSym)), tokno) ;
|
||||
PushTtok (MakeConstString (tokno, GetLibName (depModuleSym)), tokno) ;
|
||||
PushT (1) ;
|
||||
BuildAdrFunction
|
||||
END ;
|
||||
|
|
@ -2581,6 +2584,34 @@ BEGIN
|
|||
END BuildM2MainFunction ;
|
||||
|
||||
|
||||
(*
|
||||
DeferMakeConstStringCnul - return a C const string which will be nul terminated.
|
||||
*)
|
||||
|
||||
PROCEDURE DeferMakeConstStringCnul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
const: CARDINAL ;
|
||||
BEGIN
|
||||
const := MakeConstStringCnul (tok, NulName, FALSE) ;
|
||||
GenQuadO (tok, StringConvertCnulOp, const, 0, sym, FALSE) ;
|
||||
RETURN const
|
||||
END DeferMakeConstStringCnul ;
|
||||
|
||||
|
||||
(*
|
||||
DeferMakeConstStringM2nul - return a const string which will be nul terminated.
|
||||
*)
|
||||
|
||||
PROCEDURE DeferMakeConstStringM2nul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
const: CARDINAL ;
|
||||
BEGIN
|
||||
const := MakeConstStringM2nul (tok, NulName, FALSE) ;
|
||||
GenQuadO (tok, StringConvertM2nulOp, const, 0, sym, FALSE) ;
|
||||
RETURN const
|
||||
END DeferMakeConstStringM2nul ;
|
||||
|
||||
|
||||
(*
|
||||
BuildStringAdrParam - push the address of a nul terminated string onto the quad stack.
|
||||
*)
|
||||
|
|
@ -2590,8 +2621,9 @@ VAR
|
|||
str, m2strnul: CARDINAL ;
|
||||
BEGIN
|
||||
PushTF (Adr, Address) ;
|
||||
str := MakeConstLitString (tok, name) ;
|
||||
m2strnul := MakeConstStringM2nul (tok, str) ;
|
||||
str := MakeConstString (tok, name) ;
|
||||
PutConstStringKnown (tok, str, name, FALSE, TRUE) ;
|
||||
m2strnul := DeferMakeConstStringM2nul (tok, str) ;
|
||||
PushTtok (m2strnul, tok) ;
|
||||
PushT (1) ;
|
||||
BuildAdrFunction
|
||||
|
|
@ -2693,12 +2725,12 @@ BEGIN
|
|||
PushTtok (deconstructModules, tok) ;
|
||||
|
||||
PushTF(Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
|
||||
PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ;
|
||||
PushT(1) ;
|
||||
BuildAdrFunction ;
|
||||
|
||||
PushTF(Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
|
||||
PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ;
|
||||
PushT(1) ;
|
||||
BuildAdrFunction ;
|
||||
|
||||
|
|
@ -2757,12 +2789,12 @@ BEGIN
|
|||
PushTtok (RegisterModule, tok) ;
|
||||
|
||||
PushTF (Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tok, GetSymName (moduleSym)), tok) ;
|
||||
PushTtok (MakeConstString (tok, GetSymName (moduleSym)), tok) ;
|
||||
PushT (1) ;
|
||||
BuildAdrFunction ;
|
||||
|
||||
PushTF (Adr, Address) ;
|
||||
PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
|
||||
PushTtok (MakeConstString (tok, GetLibName (moduleSym)), tok) ;
|
||||
PushT (1) ;
|
||||
BuildAdrFunction ;
|
||||
|
||||
|
|
@ -3262,7 +3294,7 @@ BEGIN
|
|||
THEN
|
||||
GenQuadOtok (tokno, BecomesOp, Des, NulSym, Exp, TRUE,
|
||||
destok, UnknownTokenNo, exptok) ;
|
||||
PutConstString (tokno, Des, GetString (Exp))
|
||||
CopyConstString (tokno, Des, Exp)
|
||||
ELSE
|
||||
IF GetMode(Des)=RightValue
|
||||
THEN
|
||||
|
|
@ -5431,14 +5463,14 @@ BEGIN
|
|||
Actual, FormalI, Proc, i)
|
||||
ELSIF IsConstString (Actual)
|
||||
THEN
|
||||
IF (GetStringLength (Actual) = 0) (* If = 0 then it maybe unknown at this time. *)
|
||||
IF (NOT IsConstStringKnown (Actual))
|
||||
THEN
|
||||
(* We dont check this yet, it is checked in M2GenGCC.mod:CodeParam
|
||||
after the string has been created. *)
|
||||
ELSIF IsArray(GetDType(FormalI)) AND (GetSType(GetDType(FormalI))=Char)
|
||||
THEN
|
||||
(* Allow string literals to be passed to ARRAY [0..n] OF CHAR. *)
|
||||
ELSIF (GetStringLength(Actual) = 1) (* If = 1 then it maybe treated as a char. *)
|
||||
ELSIF (GetStringLength(paramtok, Actual) = 1) (* If = 1 then it maybe treated as a char. *)
|
||||
THEN
|
||||
CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
|
||||
ELSIF NOT IsUnboundedParam(Proc, i)
|
||||
|
|
@ -5650,8 +5682,13 @@ VAR
|
|||
NewList : BOOLEAN ;
|
||||
ActualType, FormalType: CARDINAL ;
|
||||
BEGIN
|
||||
IF IsConstString(Actual) AND (NOT IsConstStringKnown (Actual))
|
||||
THEN
|
||||
(* Cannot check if the string content is not yet known. *)
|
||||
RETURN
|
||||
END ;
|
||||
FormalType := GetDType(Formal) ;
|
||||
IF IsConstString(Actual) AND (GetStringLength(Actual) = 1) (* if = 1 then it maybe treated as a char *)
|
||||
IF IsConstString(Actual) AND (GetStringLength(tokpos, Actual) = 1) (* if = 1 then it maybe treated as a char *)
|
||||
THEN
|
||||
ActualType := Char
|
||||
ELSIF Actual=Boolean
|
||||
|
|
@ -5784,7 +5821,8 @@ BEGIN
|
|||
s := NIL ;
|
||||
IF IsConstString(Sym)
|
||||
THEN
|
||||
IF (GetStringLength(Sym) = 1) (* if = 1 then it maybe treated as a char *)
|
||||
(* If = 1 then it maybe treated as a char. *)
|
||||
IF IsConstStringKnown (Sym) AND (GetStringLength (GetDeclaredMod (Sym), Sym) = 1)
|
||||
THEN
|
||||
s := InitString('(constant string) or {%kCHAR}')
|
||||
ELSE
|
||||
|
|
@ -6316,7 +6354,7 @@ BEGIN
|
|||
ELSIF IsConstString (OperandT (pi))
|
||||
THEN
|
||||
f^.TrueExit := MakeLeftValue (OperandTok (pi),
|
||||
MakeConstStringCnul (OperandTok (pi), OperandT (pi)), RightValue, Address) ;
|
||||
DeferMakeConstStringCnul (OperandTok (pi), OperandT (pi)), RightValue, Address) ;
|
||||
MarkAsReadWrite(rw)
|
||||
ELSIF (GetSType(OperandT(pi))#NulSym) AND IsUnbounded(GetSType(OperandT(pi)))
|
||||
THEN
|
||||
|
|
@ -6361,7 +6399,7 @@ BEGIN
|
|||
(IsUnboundedParam(Proc, i) OR (GetDType(GetParam(Proc, i))=Address))
|
||||
THEN
|
||||
f^.TrueExit := MakeLeftValue (OperandTok (pi),
|
||||
MakeConstStringCnul (OperandTok (pi), OperandT (pi)),
|
||||
DeferMakeConstStringCnul (OperandTok (pi), OperandT (pi)),
|
||||
RightValue, Address) ;
|
||||
MarkAsReadWrite (rw)
|
||||
ELSIF IsUnboundedParam(Proc, i)
|
||||
|
|
@ -6370,7 +6408,7 @@ BEGIN
|
|||
IF IsConstString (OperandT(pi))
|
||||
THEN
|
||||
(* this is a Modula-2 string which must be nul terminated. *)
|
||||
f^.TrueExit := MakeConstStringM2nul (OperandTok (pi), OperandT (pi))
|
||||
f^.TrueExit := DeferMakeConstStringM2nul (OperandTok (pi), OperandT (pi))
|
||||
END ;
|
||||
t := MakeTemporary (OperandTok (pi), RightValue) ;
|
||||
UnboundedType := GetSType(GetParam(Proc, i)) ;
|
||||
|
|
@ -6627,7 +6665,7 @@ BEGIN
|
|||
THEN
|
||||
IF IsConstString (Sym)
|
||||
THEN
|
||||
PushTtok (MakeLengthConst (tok, Sym), tok)
|
||||
PushTtok (DeferMakeLengthConst (tok, Sym), tok)
|
||||
ELSE
|
||||
ArrayType := GetSType (Sym) ;
|
||||
IF IsUnbounded (ArrayType)
|
||||
|
|
@ -7687,7 +7725,7 @@ END BuildConstFunctionCall ;
|
|||
|
||||
(*
|
||||
BuildTypeCoercion - builds the type coersion.
|
||||
MODULA-2 allows types to be coersed with no runtime
|
||||
Modula-2 allows types to be coersed with no runtime
|
||||
penility.
|
||||
It insists that the TSIZE(t1)=TSIZE(t2) where
|
||||
t2 variable := t2(variable of type t1).
|
||||
|
|
@ -8379,13 +8417,18 @@ END GetQualidentImport ;
|
|||
|
||||
|
||||
(*
|
||||
MakeLengthConst - creates a constant which contains the length of string, sym.
|
||||
DeferMakeLengthConst - creates a constant which contains the length of string, sym.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeLengthConst (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
PROCEDURE DeferMakeLengthConst (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
const: CARDINAL ;
|
||||
BEGIN
|
||||
RETURN MakeConstant (tok, GetStringLength (sym))
|
||||
END MakeLengthConst ;
|
||||
const := MakeTemporary (tok, ImmediateValue) ;
|
||||
PutVar (const, ZType) ;
|
||||
GenQuadO (tok, StringLengthOp, const, 0, sym, FALSE) ;
|
||||
RETURN const
|
||||
END DeferMakeLengthConst ;
|
||||
|
||||
|
||||
(*
|
||||
|
|
@ -8422,9 +8465,9 @@ BEGIN
|
|||
Param := OperandT (1) ;
|
||||
paramtok := OperandTok (1) ;
|
||||
functok := OperandTok (NoOfParam + 1) ;
|
||||
(* Restore stack to origional form *)
|
||||
(* Restore stack to origional form. *)
|
||||
PushT (NoOfParam) ;
|
||||
Type := GetSType (Param) ; (* get the type from the symbol, not the stack *)
|
||||
Type := GetSType (Param) ; (* Get the type from the symbol, not the stack. *)
|
||||
IF NoOfParam # 1
|
||||
THEN
|
||||
MetaErrorT1 (functok, 'base procedure {%1EkLENGTH} expects 1 parameter, seen {%1n} parameters', NoOfParam)
|
||||
|
|
@ -8441,7 +8484,7 @@ BEGIN
|
|||
ELSIF IsConstString (Param)
|
||||
THEN
|
||||
PopT (NoOfParam) ;
|
||||
ReturnVar := MakeLengthConst (combinedtok, OperandT (1)) ;
|
||||
ReturnVar := DeferMakeLengthConst (combinedtok, OperandT (1)) ;
|
||||
PopN (NoOfParam + 1) ;
|
||||
PushTtok (ReturnVar, combinedtok)
|
||||
ELSE
|
||||
|
|
@ -12522,11 +12565,10 @@ BEGIN
|
|||
OperatorPos := MakeVirtualTok (OperatorPos, leftpos, rightpos) ;
|
||||
IF (Operator = PlusTok) AND IsConstString(left) AND IsConstString(right)
|
||||
THEN
|
||||
(* handle special addition for constant strings *)
|
||||
s := InitStringCharStar (KeyToCharStar (GetString (left))) ;
|
||||
s := ConCat (s, Mark (InitStringCharStar (KeyToCharStar (GetString (right))))) ;
|
||||
value := MakeConstLitString (OperatorPos, makekey (string (s))) ;
|
||||
s := KillString (s)
|
||||
value := MakeConstString (OperatorPos, NulName) ;
|
||||
PutConstStringKnown (OperatorPos, value, NulName, FALSE, FALSE) ;
|
||||
GenQuadOtok (OperatorPos, MakeOp (PlusTok), value, left, right, FALSE,
|
||||
OperatorPos, leftpos, rightpos)
|
||||
ELSE
|
||||
IF checkTypes
|
||||
THEN
|
||||
|
|
@ -12840,7 +12882,7 @@ BEGIN
|
|||
MetaErrorsT1 (tokpos,
|
||||
'{%1EU} not expecting an array variable as an operand for either comparison or binary operation',
|
||||
'it was declared as a {%1Dd}', sym)
|
||||
ELSIF IsConstString(sym) AND (GetStringLength(sym)>1)
|
||||
ELSIF IsConstString (sym) AND IsConstStringKnown (sym) AND (GetStringLength (tokpos, sym) > 1)
|
||||
THEN
|
||||
MetaErrorT1 (tokpos,
|
||||
'{%1EU} not expecting a string constant as an operand for either comparison or binary operation',
|
||||
|
|
@ -13403,7 +13445,10 @@ BEGIN
|
|||
ReturnValueOp,
|
||||
FunctValueOp,
|
||||
NegateOp,
|
||||
AddrOp : WriteOperand(Operand1) ;
|
||||
AddrOp,
|
||||
StringConvertCnulOp,
|
||||
StringConvertM2nulOp,
|
||||
StringLengthOp : WriteOperand(Operand1) ;
|
||||
printf0(' ') ;
|
||||
WriteOperand(Operand3) |
|
||||
ElementSizeOp,
|
||||
|
|
@ -13617,7 +13662,12 @@ BEGIN
|
|||
RangeCheckOp : printf0('RangeCheck ') |
|
||||
ErrorOp : printf0('Error ') |
|
||||
SaveExceptionOp : printf0('SaveException ') |
|
||||
RestoreExceptionOp : printf0('RestoreException ')
|
||||
RestoreExceptionOp : printf0('RestoreException ') |
|
||||
StringConvertCnulOp : printf0('StringConvertCnul ') |
|
||||
StringConvertM2nulOp : printf0('StringConvertM2nul') |
|
||||
StringLengthOp : printf0('StringLength ') |
|
||||
SubrangeHighOp : printf0('SubrangeHigh ') |
|
||||
SubrangeLowOp : printf0('SubrangeLow ')
|
||||
|
||||
ELSE
|
||||
InternalError ('operator not expected')
|
||||
|
|
|
|||
|
|
@ -1342,6 +1342,9 @@ BEGIN
|
|||
ElementSizeOp,
|
||||
BuiltinConstOp, (* Nothing to do, it is assigning a constant to op1 (also a const). *)
|
||||
BuiltinTypeInfoOp, (* Likewise assigning op1 (const) with a type. *)
|
||||
StringConvertCnulOp,
|
||||
StringConvertM2nulOp,
|
||||
StringLengthOp,
|
||||
ProcedureScopeOp,
|
||||
InitEndOp,
|
||||
InitStartOp,
|
||||
|
|
|
|||
|
|
@ -251,13 +251,16 @@ VAR
|
|||
i: CARDINAL ;
|
||||
p: PtrToChar ;
|
||||
BEGIN
|
||||
p := KeyToCharStar(Key) ;
|
||||
i := 0 ;
|
||||
WHILE p^#nul DO
|
||||
INC(i) ;
|
||||
INC(p)
|
||||
IF Key # NulName
|
||||
THEN
|
||||
p := KeyToCharStar (Key) ;
|
||||
WHILE p^ # nul DO
|
||||
INC (i) ;
|
||||
INC (p)
|
||||
END
|
||||
END ;
|
||||
RETURN( i )
|
||||
RETURN i
|
||||
END LengthKey ;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ FROM SymbolTable IMPORT NulSym,
|
|||
GetCurrentModule, GetMainModule,
|
||||
MakeTemporary, CheckAnonymous, IsNameAnonymous,
|
||||
MakeConstLit,
|
||||
MakeConstLitString,
|
||||
MakeConstString,
|
||||
MakeSubrange,
|
||||
MakeVar, MakeType, PutType,
|
||||
MakeModuleCtor,
|
||||
|
|
@ -87,7 +87,7 @@ FROM SymbolTable IMPORT NulSym,
|
|||
MakeVarient, MakeFieldVarient,
|
||||
MakeArray, PutArraySubscript,
|
||||
MakeSubscript, PutSubscript,
|
||||
PutConstString, GetString,
|
||||
PutConstStringKnown, GetString,
|
||||
PutArray, IsArray,
|
||||
GetType, SkipType,
|
||||
IsProcType, MakeProcType,
|
||||
|
|
@ -790,7 +790,7 @@ BEGIN
|
|||
THEN
|
||||
stop
|
||||
END ;
|
||||
Sym := MakeConstLitString (tok, makekey (string (Mark (Slice (Mark (InitStringCharStar (KeyToCharStar (name))), 1, -1))))) ;
|
||||
Sym := MakeConstString (tok, makekey (string (Mark (Slice (Mark (InitStringCharStar (KeyToCharStar (name))), 1, -1))))) ;
|
||||
PushTFtok (Sym, NulSym, tok) ;
|
||||
Annotate ("%1s(%1d)|%3d||constant string")
|
||||
END BuildString ;
|
||||
|
|
@ -3050,7 +3050,7 @@ BEGIN
|
|||
CASE type OF
|
||||
|
||||
set : PutConstSet(Sym) |
|
||||
str : PutConstString(GetTokenNo(), Sym, MakeKey('')) |
|
||||
str : PutConstStringKnown (GetTokenNo(), Sym, MakeKey(''), FALSE, FALSE) |
|
||||
array,
|
||||
constructor: PutConstructor(Sym) |
|
||||
cast : PutConst(Sym, castType) |
|
||||
|
|
|
|||
|
|
@ -37,335 +37,6 @@ FROM DynamicStrings IMPORT String ;
|
|||
FROM M2Error IMPORT ErrorScope ;
|
||||
FROM Lists IMPORT List ;
|
||||
|
||||
EXPORT QUALIFIED NulSym,
|
||||
FinalSymbol,
|
||||
|
||||
ModeOfAddr,
|
||||
GetMode, PutMode,
|
||||
|
||||
AppendModuleOnImportStatement,
|
||||
AppendModuleImportStatement,
|
||||
|
||||
StartScope, EndScope, PseudoScope,
|
||||
GetCurrentScope,
|
||||
IsDeclaredIn,
|
||||
CheckAnonymous, IsNameAnonymous,
|
||||
|
||||
SetCurrentModule,
|
||||
SetMainModule,
|
||||
SetFileModule,
|
||||
MakeModule, MakeDefImp,
|
||||
MakeInnerModule, MakeModuleCtor, PutModuleCtorExtern,
|
||||
MakeProcedure,
|
||||
MakeProcedureCtorExtern,
|
||||
MakeConstant,
|
||||
MakeConstLit,
|
||||
MakeConstVar,
|
||||
MakeConstLitString,
|
||||
MakeConstString,
|
||||
MakeConstStringC, MakeConstStringCnul, MakeConstStringM2nul,
|
||||
MakeType,
|
||||
MakeHiddenType,
|
||||
MakeVar,
|
||||
MakeRecord,
|
||||
MakeVarient,
|
||||
MakeFieldVarient,
|
||||
MakeEnumeration,
|
||||
MakeSubrange,
|
||||
MakeSet,
|
||||
MakeArray,
|
||||
MakeTemporary,
|
||||
MakeComponentRecord,
|
||||
MakeComponentRef,
|
||||
IsComponent,
|
||||
MakePointer,
|
||||
MakeSubscript,
|
||||
MakeUnbounded,
|
||||
MakeOAFamily,
|
||||
MakeProcType,
|
||||
MakeImport, MakeImportStatement,
|
||||
Make2Tuple,
|
||||
MakeGnuAsm,
|
||||
MakeRegInterface,
|
||||
MakeError, MakeErrorS,
|
||||
|
||||
ForeachModuleDo,
|
||||
ForeachInnerModuleDo,
|
||||
ForeachLocalSymDo,
|
||||
ForeachParamSymDo,
|
||||
|
||||
ForeachFieldEnumerationDo,
|
||||
GetModule,
|
||||
GetCurrentModule,
|
||||
GetFileModule,
|
||||
GetMainModule,
|
||||
GetBaseModule,
|
||||
GetCurrentModuleScope,
|
||||
GetLastModuleScope,
|
||||
AddSymToModuleScope,
|
||||
GetType, GetLType, GetSType, GetDType,
|
||||
SkipType, SkipTypeAndSubrange,
|
||||
GetLowestType, GetTypeMode,
|
||||
GetSym, GetLocalSym, GetDeclareSym, GetRecord,
|
||||
FromModuleGetSym,
|
||||
GetOAFamily,
|
||||
GetDimension,
|
||||
GetNth,
|
||||
GetVarScope,
|
||||
GetSubrange,
|
||||
GetParam,
|
||||
GetString,
|
||||
GetStringLength,
|
||||
GetProcedureBuiltin,
|
||||
GetNthParam,
|
||||
GetNthProcedure,
|
||||
GetParameterShadowVar,
|
||||
GetUnbounded,
|
||||
GetUnboundedRecordType,
|
||||
GetUnboundedAddressOffset,
|
||||
GetUnboundedHighOffset,
|
||||
GetModuleQuads,
|
||||
PutModuleFinallyFunction, GetModuleFinallyFunction,
|
||||
PutExceptionBlock, HasExceptionBlock,
|
||||
PutExceptionFinally, HasExceptionFinally,
|
||||
GetProcedureQuads,
|
||||
GetQuads,
|
||||
GetReadQuads, GetWriteQuads,
|
||||
GetReadLimitQuads, GetWriteLimitQuads,
|
||||
GetDeclaredDef, GetDeclaredMod, PutDeclared,
|
||||
GetDeclaredDefinition, GetDeclaredModule,
|
||||
GetFirstUsed,
|
||||
PutProcedureBegin, PutProcedureEnd, GetProcedureBeginEnd,
|
||||
GetGnuAsmInput, GetGnuAsmOutput, GetGnuAsmTrash, GetGnuAsm,
|
||||
GetRegInterface,
|
||||
GetVariableAtAddress,
|
||||
GetAlignment, GetDefaultRecordFieldAlignment,
|
||||
PutDeclaredPacked, IsDeclaredPacked, IsDeclaredPackedResolved,
|
||||
GetPackedEquivalent, GetNonPackedEquivalent,
|
||||
GetConstStringM2, GetConstStringC, GetConstStringM2nul, GetConstStringCnul,
|
||||
GetModuleCtors,
|
||||
GetImportModule, GetImportDeclared,
|
||||
GetImportStatementList, GetModuleDefImportStatementList, GetModuleModImportStatementList,
|
||||
|
||||
PutVar,
|
||||
PutVarConst,
|
||||
PutLeftValueFrontBackType,
|
||||
GetVarBackEndType,
|
||||
PutVarPointerCheck,
|
||||
GetVarPointerCheck,
|
||||
PutVarWritten,
|
||||
GetVarWritten,
|
||||
PutConst,
|
||||
PutConstString,
|
||||
PutDefLink,
|
||||
PutModLink,
|
||||
PutModuleBuiltin,
|
||||
PutVarArrayRef, IsVarArrayRef,
|
||||
|
||||
PutConstSet,
|
||||
PutConstructor,
|
||||
PutConstructorFrom,
|
||||
PutFieldRecord,
|
||||
PutFieldVarient,
|
||||
GetVarient,
|
||||
GetVarientTag,
|
||||
|
||||
PutVarientTag,
|
||||
IsRecordFieldAVarientTag,
|
||||
IsEmptyFieldVarient,
|
||||
PutFieldEnumeration,
|
||||
PutSubrange,
|
||||
PutSet, IsSetPacked,
|
||||
PutArraySubscript, GetArraySubscript,
|
||||
PutArray,
|
||||
PutArrayLarge, IsArrayLarge,
|
||||
PutType,
|
||||
PutFunction, PutOptFunction,
|
||||
PutParam, PutVarParam, PutParamName,
|
||||
PutProcTypeParam, PutProcTypeVarParam,
|
||||
PutPointer,
|
||||
PutSubscript,
|
||||
PutProcedureBuiltin, PutProcedureInline,
|
||||
PutModuleStartQuad,
|
||||
PutModuleEndQuad,
|
||||
PutModuleFinallyStartQuad,
|
||||
PutModuleFinallyEndQuad,
|
||||
PutProcedureStartQuad,
|
||||
PutProcedureEndQuad,
|
||||
PutProcedureScopeQuad,
|
||||
PutProcedureReachable,
|
||||
PutProcedureNoReturn, IsProcedureNoReturn,
|
||||
PutReadQuad, RemoveReadQuad,
|
||||
PutWriteQuad, RemoveWriteQuad,
|
||||
PutGnuAsm, PutGnuAsmOutput, PutGnuAsmInput, PutGnuAsmTrash,
|
||||
PutGnuAsmVolatile, PutGnuAsmSimple,
|
||||
PutRegInterface,
|
||||
PutVariableAtAddress,
|
||||
PutAlignment, PutDefaultRecordFieldAlignment,
|
||||
PutUnused, IsUnused,
|
||||
PutVariableSSA, IsVariableSSA,
|
||||
PutPublic, IsPublic, PutCtor, IsCtor, PutExtern, IsExtern,
|
||||
PutMonoName, IsMonoName,
|
||||
PutVarHeap, IsVarHeap,
|
||||
|
||||
IsDefImp,
|
||||
IsModule,
|
||||
IsInnerModule,
|
||||
IsUnknown,
|
||||
IsPartialUnbounded,
|
||||
IsType,
|
||||
IsProcedure,
|
||||
IsParameter,
|
||||
IsParameterUnbounded,
|
||||
IsParameterVar,
|
||||
IsVarParam,
|
||||
IsUnboundedParam,
|
||||
IsPointer,
|
||||
IsRecord,
|
||||
IsVarient,
|
||||
IsFieldVarient,
|
||||
IsEnumeration,
|
||||
IsFieldEnumeration,
|
||||
IsUnbounded,
|
||||
IsArray,
|
||||
IsRecordField,
|
||||
IsProcType,
|
||||
IsImport,
|
||||
IsImportStatement,
|
||||
IsVar,
|
||||
IsVarConst,
|
||||
IsConst,
|
||||
IsConstString,
|
||||
IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
|
||||
IsConstLit,
|
||||
IsConstSet,
|
||||
IsConstructor,
|
||||
IsDummy,
|
||||
IsTemporary, IsVarAParam,
|
||||
IsSubscript,
|
||||
IsSubrange,
|
||||
IsSet,
|
||||
IsHiddenType,
|
||||
IsAModula2Type,
|
||||
IsGnuAsmVolatile, IsGnuAsmSimple, IsGnuAsm, IsRegInterface,
|
||||
IsError,
|
||||
IsObject,
|
||||
IsTuple,
|
||||
IsComposite,
|
||||
|
||||
IsReallyPointer,
|
||||
IsLegal,
|
||||
|
||||
IsProcedureReachable,
|
||||
IsProcedureVariable,
|
||||
IsProcedureNested,
|
||||
IsProcedureBuiltin, IsProcedureInline,
|
||||
IsModuleWithinProcedure,
|
||||
IsVariableAtAddress,
|
||||
IsReturnOptional,
|
||||
IsDefLink,
|
||||
IsModLink,
|
||||
IsModuleBuiltin,
|
||||
IsProcedureBuiltinAvailable,
|
||||
|
||||
ForeachProcedureDo,
|
||||
ProcedureParametersDefined,
|
||||
AreProcedureParametersDefined,
|
||||
ParametersDefinedInDefinition,
|
||||
AreParametersDefinedInDefinition,
|
||||
ParametersDefinedInImplementation,
|
||||
AreParametersDefinedInImplementation,
|
||||
|
||||
PutUseVarArgs,
|
||||
UsesVarArgs,
|
||||
PutUseOptArg,
|
||||
UsesOptArg,
|
||||
PutOptArgInit,
|
||||
GetOptArgInit,
|
||||
PutPriority,
|
||||
GetPriority,
|
||||
PutNeedSavePriority,
|
||||
GetNeedSavePriority,
|
||||
|
||||
NoOfVariables,
|
||||
NoOfElements,
|
||||
NoOfParam,
|
||||
AddNameToImportList,
|
||||
AddNameToScope, ResolveImports,
|
||||
GetScope, GetModuleScope, GetProcedureScope,
|
||||
GetParent,
|
||||
|
||||
GetSymName,
|
||||
RenameSym,
|
||||
|
||||
RequestSym,
|
||||
|
||||
GetExported,
|
||||
PutImported,
|
||||
PutIncluded,
|
||||
PutExported,
|
||||
PutExportQualified,
|
||||
PutExportUnQualified,
|
||||
PutExportUnImplemented,
|
||||
GetFromOuterModule,
|
||||
IsExportQualified,
|
||||
IsExportUnQualified,
|
||||
IsExported,
|
||||
IsImplicityExported,
|
||||
IsImported,
|
||||
PutIncludedByDefinition, IsIncludedByDefinition,
|
||||
TryMoveUndeclaredSymToInnerModule,
|
||||
ForeachImportedDo,
|
||||
ForeachExportedDo,
|
||||
ForeachOAFamily,
|
||||
|
||||
CheckForExportedImplementation,
|
||||
CheckForUnImplementedExports,
|
||||
CheckForUndeclaredExports,
|
||||
CheckForUnknownInModule, UnknownReported,
|
||||
CheckHiddenTypeAreAddress,
|
||||
|
||||
CheckForEnumerationInCurrentModule,
|
||||
PutHiddenTypeDeclared,
|
||||
IsHiddenTypeDeclared,
|
||||
|
||||
PutDefinitionForC,
|
||||
IsDefinitionForC,
|
||||
|
||||
PutDoesNeedExportList, PutDoesNotNeedExportList,
|
||||
DoesNotNeedExportList,
|
||||
ResolveConstructorTypes,
|
||||
MakeTemporaryFromExpression, MakeTemporaryFromExpressions,
|
||||
SanityCheckConstants,
|
||||
|
||||
PutModuleContainsBuiltin, IsBuiltinInModule,
|
||||
HasVarParameters,
|
||||
GetErrorScope,
|
||||
GetLibName, PutLibName,
|
||||
|
||||
IsSizeSolved,
|
||||
IsOffsetSolved,
|
||||
IsValueSolved,
|
||||
IsConstructorConstant,
|
||||
IsSumOfParamSizeSolved,
|
||||
PushSize,
|
||||
PushOffset,
|
||||
PushValue,
|
||||
PushParamSize,
|
||||
PushVarSize,
|
||||
PushSumOfLocalVarSize,
|
||||
PushSumOfParamSize,
|
||||
PopValue,
|
||||
PopSize,
|
||||
PopOffset,
|
||||
PopSumOfParamSize,
|
||||
DisplayTrees,
|
||||
DebugLineNumbers,
|
||||
VarCheckReadInit, VarInitState, PutVarInitialized,
|
||||
PutVarFieldInitialized, GetVarFieldInitialized,
|
||||
PrintInitialized,
|
||||
GetParameterHeapVar, PutProcedureParameterHeapVars ;
|
||||
|
||||
|
||||
(*
|
||||
Throughout this module any SymKey value of 0 is deemed to be a
|
||||
|
|
@ -787,37 +458,97 @@ PROCEDURE MakeConstLit (tok: CARDINAL; constName: Name; constType: CARDINAL) : C
|
|||
|
||||
|
||||
(*
|
||||
MakeConstVar - makes a ConstVar type with
|
||||
name ConstVarName.
|
||||
MakeConstVar - makes a ConstVar type with name ConstVarName.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstVar (tok: CARDINAL; ConstVarName: Name) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstLitString - put a constant which has the string described by
|
||||
ConstName into the ConstantTree and return a symbol.
|
||||
This symbol is known as a String Constant rather than a
|
||||
ConstLit which indicates a number.
|
||||
If the constant already exits
|
||||
then a duplicate constant is not entered in the tree.
|
||||
All values of constant strings
|
||||
are ignored in Pass 1 and evaluated in Pass 2 via
|
||||
character manipulation.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstLitString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstString - puts a constant into the symboltable which is a string.
|
||||
The string value is unknown at this time and will be
|
||||
filled in later by PutString.
|
||||
MakeConstString - create a string constant in the symboltable.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstStringCnul - creates a constant string nul terminated string suitable for C.
|
||||
If known is TRUE then name is assigned to the contents
|
||||
and the escape sequences will be converted into characters.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringCnul (tok: CARDINAL; name: Name; known: BOOLEAN) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstStringM2nul - creates a constant string nul terminated string suitable for M2.
|
||||
If known is TRUE then name is assigned to the contents
|
||||
however the escape sequences are not converted into characters.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringM2nul (tok: CARDINAL; name: Name; known: BOOLEAN) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
PutConstStringKnown - if sym is a constvar then convert it into a conststring.
|
||||
If known is FALSE then contents is ignored and NulName is
|
||||
stored. If escape is TRUE then the contents will have
|
||||
any escape sequences converted into single characters.
|
||||
*)
|
||||
|
||||
PROCEDURE PutConstStringKnown (tok: CARDINAL; sym: CARDINAL;
|
||||
contents: Name; escape, known: BOOLEAN) ;
|
||||
|
||||
|
||||
(*
|
||||
CopyConstString - copies string contents from expr to des
|
||||
and retain the kind of string.
|
||||
*)
|
||||
|
||||
PROCEDURE CopyConstString (tok: CARDINAL; des, expr: CARDINAL) ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringKnown - returns TRUE if sym is a const string
|
||||
and the contents are known.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringKnown (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringM2 - returns whether this conststring is a
|
||||
Modula-2 string.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringM2 (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringC - returns whether this conststring is a C style string
|
||||
which will have any escape translated.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringC (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringM2nul - returns whether this conststring is a Modula-2 string which
|
||||
contains a nul terminator.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringM2nul (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringCnul - returns whether this conststring is a C style string
|
||||
which will have any escape translated and also contains
|
||||
a nul terminator.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringCnul (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
MakeSubrange - makes a new symbol into a subrange type with
|
||||
name SubrangeName.
|
||||
|
|
@ -1292,10 +1023,10 @@ PROCEDURE GetString (Sym: CARDINAL) : Name ;
|
|||
|
||||
(*
|
||||
GetStringLength - returns the actual string length for ConstString
|
||||
symbol Sym.
|
||||
symbol sym.
|
||||
*)
|
||||
|
||||
PROCEDURE GetStringLength (Sym: CARDINAL) : CARDINAL ;
|
||||
PROCEDURE GetStringLength (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
|
|
@ -1431,47 +1162,6 @@ PROCEDURE GetVarWritten (sym: CARDINAL) : BOOLEAN ;
|
|||
PROCEDURE PutConst (Sym: CARDINAL; ConstType: CARDINAL) ;
|
||||
|
||||
|
||||
(*
|
||||
PutConstString - places contents into a constant symbol, sym.
|
||||
sym maybe a ConstString or a ConstVar. If the later is
|
||||
true then the ConstVar is converted to a ConstString.
|
||||
*)
|
||||
|
||||
PROCEDURE PutConstString (tok: CARDINAL; sym: CARDINAL; contents: Name) ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringM2 - returns the Modula-2 variant of a string
|
||||
(with no added nul terminator).
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringM2 (sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringC - returns the C variant of a string
|
||||
(with no added nul terminator).
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringC (sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringM2nul - returns the Modula-2 variant of a string
|
||||
(with added nul terminator).
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringM2nul (sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringCnul - returns the C variant of a string
|
||||
(with no added nul terminator).
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringCnul (sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
PutConstSet - informs the constant symbol, sym, that it is or will contain
|
||||
a set value.
|
||||
|
|
@ -2910,38 +2600,6 @@ PROCEDURE IsConst (Sym: CARDINAL) : BOOLEAN ;
|
|||
PROCEDURE IsConstString (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringM2 - returns whether this conststring is an unaltered Modula-2 string.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringM2 (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringC - returns whether this conststring is a C style string
|
||||
which will have any escape translated.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringC (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringM2nul - returns whether this conststring is a Modula-2 string which
|
||||
contains a nul terminator.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringM2nul (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringCnul - returns whether this conststring is a C style string
|
||||
which will have any escape translated and also contains
|
||||
a nul terminator.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringCnul (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringNulTerminated - returns TRUE if the constant string, sym,
|
||||
should be created with a nul terminator.
|
||||
|
|
@ -2950,33 +2608,6 @@ PROCEDURE IsConstStringCnul (sym: CARDINAL) : BOOLEAN ;
|
|||
PROCEDURE IsConstStringNulTerminated (sym: CARDINAL) : BOOLEAN ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstStringCnul - creates a constant string nul terminated string suitable for C.
|
||||
sym is a ConstString and a new symbol is returned
|
||||
with the escape sequences converted into characters.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringCnul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstStringM2nul - creates a constant string nul terminated string.
|
||||
sym is a ConstString and a new symbol is returned.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringM2nul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstStringC - creates a constant string suitable for C.
|
||||
sym is a Modula-2 ConstString and a new symbol is returned
|
||||
with the escape sequences converted into characters.
|
||||
It is not nul terminated.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringC (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstLit - returns true if Sym is a literal constant.
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@ CONST
|
|||
UnboundedAddressName = "_m2_contents" ;
|
||||
UnboundedHighName = "_m2_high_%d" ;
|
||||
|
||||
BreakSym = 5293 ;
|
||||
BreakSym = 8496 ;
|
||||
|
||||
TYPE
|
||||
ConstLitPoolEntry = POINTER TO RECORD
|
||||
|
|
@ -475,11 +475,8 @@ TYPE
|
|||
(* of const. *)
|
||||
Contents : Name ; (* Contents of the string. *)
|
||||
Length : CARDINAL ; (* StrLen (Contents) *)
|
||||
M2Variant,
|
||||
NulM2Variant,
|
||||
CVariant,
|
||||
NulCVariant : CARDINAL ; (* variants of the same string *)
|
||||
StringVariant : ConstStringVariant ;
|
||||
Known : BOOLEAN ; (* Is Contents known? *)
|
||||
Scope : CARDINAL ; (* Scope of declaration. *)
|
||||
At : Where ; (* Where was sym declared/used *)
|
||||
END ;
|
||||
|
|
@ -875,9 +872,6 @@ VAR
|
|||
FreeSymbol : CARDINAL ; (* The next free symbol indice. *)
|
||||
DefModuleTree : SymbolTree ;
|
||||
ModuleTree : SymbolTree ; (* Tree of all modules ever used. *)
|
||||
ConstLitStringTree
|
||||
: SymbolTree ; (* String Literal Constants only need *)
|
||||
(* to be declared once. *)
|
||||
CurrentModule : CARDINAL ; (* Index into symbols determining the *)
|
||||
(* current module being compiled. *)
|
||||
(* This maybe an inner module. *)
|
||||
|
|
@ -924,12 +918,12 @@ VAR
|
|||
|
||||
PROCEDURE CheckAnonymous (name: Name) : Name ;
|
||||
BEGIN
|
||||
IF name=NulName
|
||||
IF name = NulName
|
||||
THEN
|
||||
INC(AnonymousName) ;
|
||||
name := makekey(string(Mark(Sprintf1(Mark(InitString('$$%d')), AnonymousName))))
|
||||
INC (AnonymousName) ;
|
||||
name := makekey (string (Mark (Sprintf1 (Mark (InitString ('__anon%d')), AnonymousName))))
|
||||
END ;
|
||||
RETURN( name )
|
||||
RETURN name
|
||||
END CheckAnonymous ;
|
||||
|
||||
|
||||
|
|
@ -940,7 +934,7 @@ END CheckAnonymous ;
|
|||
|
||||
PROCEDURE IsNameAnonymous (sym: CARDINAL) : BOOLEAN ;
|
||||
VAR
|
||||
a: ARRAY [0..1] OF CHAR ;
|
||||
a: ARRAY [0..5] OF CHAR ;
|
||||
n: Name ;
|
||||
BEGIN
|
||||
n := GetSymName(sym) ;
|
||||
|
|
@ -949,7 +943,7 @@ BEGIN
|
|||
RETURN( TRUE )
|
||||
ELSE
|
||||
GetKey(n, a) ;
|
||||
RETURN( StrEqual(a, '$$') )
|
||||
RETURN( StrEqual(a, '__anon') )
|
||||
END
|
||||
END IsNameAnonymous ;
|
||||
|
||||
|
|
@ -1647,7 +1641,6 @@ BEGIN
|
|||
AnonymousName := 0 ;
|
||||
CurrentError := NIL ;
|
||||
InitTree (ConstLitPoolTree) ;
|
||||
InitTree (ConstLitStringTree) ;
|
||||
InitTree (DefModuleTree) ;
|
||||
InitTree (ModuleTree) ;
|
||||
Symbols := InitIndex (1) ;
|
||||
|
|
@ -4990,7 +4983,10 @@ PROCEDURE MakeConstVar (tok: CARDINAL; ConstVarName: Name) : CARDINAL ;
|
|||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
Sym : CARDINAL ;
|
||||
temp: BOOLEAN ;
|
||||
BEGIN
|
||||
temp := (ConstVarName = NulName) ;
|
||||
ConstVarName := CheckAnonymous (ConstVarName) ;
|
||||
Sym := DeclareSym (tok, ConstVarName) ;
|
||||
IF NOT IsError(Sym)
|
||||
THEN
|
||||
|
|
@ -5005,7 +5001,7 @@ BEGIN
|
|||
IsConstructor := FALSE ;
|
||||
FromType := NulSym ; (* type is determined FromType *)
|
||||
UnresFromType := FALSE ; (* is Type resolved? *)
|
||||
IsTemp := FALSE ;
|
||||
IsTemp := temp ;
|
||||
Scope := GetCurrentScope () ;
|
||||
InitWhereDeclaredTok (tok, At)
|
||||
END
|
||||
|
|
@ -5018,82 +5014,11 @@ END MakeConstVar ;
|
|||
|
||||
|
||||
(*
|
||||
MakeConstLitString - put a constant which has the string described by
|
||||
ConstName into the ConstantTree.
|
||||
The symbol number is returned.
|
||||
This symbol is known as a String Constant rather than a
|
||||
ConstLit which indicates a number.
|
||||
If the constant already exits
|
||||
then a duplicate constant is not entered in the tree.
|
||||
All values of constant strings
|
||||
are ignored in Pass 1 and evaluated in Pass 2 via
|
||||
character manipulation.
|
||||
In this procedure ConstName is the string.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstLitString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
sym : CARDINAL ;
|
||||
BEGIN
|
||||
sym := GetSymKey (ConstLitStringTree, ConstName) ;
|
||||
IF sym=NulSym
|
||||
THEN
|
||||
NewSym (sym) ;
|
||||
PutSymKey (ConstLitStringTree, ConstName, sym) ;
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
SymbolType := ConstStringSym ;
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: InitConstString (tok, sym, ConstName, ConstName,
|
||||
m2str,
|
||||
sym, NulSym, NulSym, NulSym)
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
END
|
||||
END
|
||||
END ;
|
||||
RETURN sym
|
||||
END MakeConstLitString ;
|
||||
|
||||
|
||||
(*
|
||||
BackFillString -
|
||||
*)
|
||||
|
||||
PROCEDURE BackFillString (sym, m2sym, m2nulsym, csym, cnulsym: CARDINAL) ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
IF sym # NulSym
|
||||
THEN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: ConstString.M2Variant := m2sym ;
|
||||
ConstString.NulM2Variant := m2nulsym ;
|
||||
ConstString.CVariant := csym ;
|
||||
ConstString.NulCVariant := cnulsym
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
END
|
||||
END BackFillString ;
|
||||
|
||||
|
||||
(*
|
||||
InitConstString - initialize the constant string and back fill any
|
||||
previous string variants.
|
||||
InitConstString - initialize the constant string.
|
||||
*)
|
||||
|
||||
PROCEDURE InitConstString (tok: CARDINAL; sym: CARDINAL; name, contents: Name;
|
||||
kind: ConstStringVariant;
|
||||
m2sym, m2nulsym, csym, cnulsym: CARDINAL) ;
|
||||
kind: ConstStringVariant; escape, known: BOOLEAN) ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
|
|
@ -5104,19 +5029,9 @@ BEGIN
|
|||
|
||||
ConstStringSym: ConstString.name := name ;
|
||||
ConstString.StringVariant := kind ;
|
||||
PutConstString (tok, sym, contents) ;
|
||||
BackFillString (sym,
|
||||
m2sym, m2nulsym, csym, cnulsym) ;
|
||||
BackFillString (m2sym,
|
||||
m2sym, m2nulsym, csym, cnulsym) ;
|
||||
BackFillString (m2nulsym,
|
||||
m2sym, m2nulsym, csym, cnulsym) ;
|
||||
BackFillString (csym,
|
||||
m2sym, m2nulsym, csym, cnulsym) ;
|
||||
BackFillString (cnulsym,
|
||||
m2sym, m2nulsym, csym, cnulsym) ;
|
||||
ConstString.Scope := GetCurrentScope() ;
|
||||
InitWhereDeclaredTok (tok, ConstString.At)
|
||||
InitWhereDeclaredTok (tok, ConstString.At) ;
|
||||
PutConstStringKnown (tok, sym, contents, escape, known)
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
|
|
@ -5126,11 +5041,10 @@ END InitConstString ;
|
|||
|
||||
|
||||
(*
|
||||
GetConstStringM2 - returns the Modula-2 variant of a string
|
||||
(with no added nul terminator).
|
||||
GetConstString - returns the contents of a string constant.
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringM2 (sym: CARDINAL) : CARDINAL ;
|
||||
PROCEDURE GetConstStringContent (sym: CARDINAL) : Name ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
|
|
@ -5138,79 +5052,13 @@ BEGIN
|
|||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.M2Variant
|
||||
ConstStringSym: RETURN ConstString.Contents
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
END GetConstStringM2 ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringC - returns the C variant of a string
|
||||
(with no added nul terminator).
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringC (sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.CVariant
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
END GetConstStringC ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringM2nul - returns the Modula-2 variant of a string
|
||||
(with added nul terminator).
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringM2nul (sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.NulM2Variant
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
END GetConstStringM2nul ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringCnul - returns the C variant of a string
|
||||
(with no added nul terminator).
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringCnul (sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.NulCVariant
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
END GetConstStringCnul ;
|
||||
END GetConstStringContent ;
|
||||
|
||||
|
||||
(*
|
||||
|
|
@ -5238,189 +5086,157 @@ END IsConstStringNulTerminated ;
|
|||
|
||||
(*
|
||||
MakeConstStringCnul - creates a constant string nul terminated string suitable for C.
|
||||
sym is a ConstString and a new symbol is returned
|
||||
with the escape sequences converted into characters.
|
||||
If known is TRUE then name is assigned to the contents
|
||||
and the escape sequences will be converted into characters.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringCnul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
PROCEDURE MakeConstStringCnul (tok: CARDINAL; name: Name; known: BOOLEAN) : CARDINAL ;
|
||||
VAR
|
||||
pSym : PtrToSymbol ;
|
||||
newstr: CARDINAL ;
|
||||
BEGIN
|
||||
pSym := GetPsym (GetConstStringM2 (sym)) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: Assert (ConstString.StringVariant = m2str) ;
|
||||
ConstString.CVariant := MakeConstStringC (tok, sym) ;
|
||||
IF ConstString.NulCVariant = NulSym
|
||||
THEN
|
||||
NewSym (newstr) ;
|
||||
ConstString.NulCVariant := newstr ;
|
||||
InitConstString (tok, newstr, ConstString.name, GetString (ConstString.CVariant),
|
||||
cnulstr,
|
||||
ConstString.M2Variant, ConstString.NulM2Variant, ConstString.CVariant, ConstString.NulCVariant)
|
||||
END ;
|
||||
RETURN ConstString.NulCVariant
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
NewSym (newstr) ;
|
||||
InitConstString (tok, newstr, name, name, cnulstr, TRUE, known) ;
|
||||
RETURN newstr
|
||||
END MakeConstStringCnul ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstStringM2nul - creates a constant string nul terminated string.
|
||||
sym is a ConstString and a new symbol is returned.
|
||||
MakeConstStringM2nul - creates a constant string nul terminated string suitable for M2.
|
||||
If known is TRUE then name is assigned to the contents
|
||||
however the escape sequences are not converted into characters.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringM2nul (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
PROCEDURE MakeConstStringM2nul (tok: CARDINAL; name: Name; known: BOOLEAN) : CARDINAL ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
newstr: CARDINAL ;
|
||||
BEGIN
|
||||
pSym := GetPsym (GetConstStringM2 (sym)) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: Assert (ConstString.StringVariant = m2str) ;
|
||||
IF ConstString.NulM2Variant = NulSym
|
||||
THEN
|
||||
NewSym (ConstString.NulM2Variant) ;
|
||||
InitConstString (tok, ConstString.NulM2Variant,
|
||||
ConstString.name, ConstString.Contents,
|
||||
m2nulstr,
|
||||
ConstString.M2Variant, ConstString.NulM2Variant,
|
||||
ConstString.CVariant, ConstString.NulCVariant)
|
||||
END ;
|
||||
RETURN ConstString.NulM2Variant
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
NewSym (newstr) ;
|
||||
InitConstString (tok, newstr, name, name, m2nulstr, FALSE, known) ;
|
||||
RETURN newstr
|
||||
END MakeConstStringM2nul ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstStringC - creates a constant string suitable for C.
|
||||
sym is a Modula-2 ConstString and a new symbol is returned
|
||||
with the escape sequences converted into characters.
|
||||
It is not nul terminated.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstStringC (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
pSym : PtrToSymbol ;
|
||||
s : String ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: IF ConstString.StringVariant = cstr
|
||||
THEN
|
||||
RETURN sym (* this is already the C variant. *)
|
||||
ELSIF ConstString.CVariant = NulSym
|
||||
THEN
|
||||
Assert (ConstString.StringVariant = m2str) ; (* we can only derive string variants from Modula-2 strings. *)
|
||||
Assert (sym = ConstString.M2Variant) ;
|
||||
(* we need to create a new one and return the new symbol. *)
|
||||
s := HandleEscape (InitStringCharStar (KeyToCharStar (GetString (ConstString.M2Variant)))) ;
|
||||
NewSym (ConstString.CVariant) ;
|
||||
InitConstString (tok, ConstString.CVariant, ConstString.name, makekey (string (s)),
|
||||
cstr,
|
||||
ConstString.M2Variant, ConstString.NulM2Variant, ConstString.CVariant, ConstString.NulCVariant) ;
|
||||
s := KillString (s)
|
||||
END ;
|
||||
RETURN ConstString.CVariant
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstStringSym')
|
||||
END
|
||||
END
|
||||
END MakeConstStringC ;
|
||||
|
||||
|
||||
(*
|
||||
MakeConstString - puts a constant into the symboltable which is a string.
|
||||
The string value is unknown at this time and will be
|
||||
filled in later by PutString.
|
||||
MakeConstString - create a string constant in the symboltable.
|
||||
*)
|
||||
|
||||
PROCEDURE MakeConstString (tok: CARDINAL; ConstName: Name) : CARDINAL ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
sym : CARDINAL ;
|
||||
newstr: CARDINAL ;
|
||||
BEGIN
|
||||
NewSym (sym) ;
|
||||
PutSymKey (ConstLitStringTree, ConstName, sym) ;
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
SymbolType := ConstStringSym ;
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym : InitConstString (tok, sym, ConstName, NulName,
|
||||
m2str, sym, NulSym, NulSym, NulSym)
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
END
|
||||
END ;
|
||||
RETURN sym
|
||||
NewSym (newstr) ;
|
||||
InitConstString (tok, newstr, ConstName, ConstName, m2nulstr, FALSE, TRUE) ;
|
||||
RETURN newstr
|
||||
END MakeConstString ;
|
||||
|
||||
|
||||
(*
|
||||
PutConstString - places a string, String, into a constant symbol, Sym.
|
||||
Sym maybe a ConstString or a ConstVar. If the later is
|
||||
true then the ConstVar is converted to a ConstString.
|
||||
PutConstStringKnown - if sym is a constvar then convert it into a conststring.
|
||||
If known is FALSE then contents is ignored and NulName is
|
||||
stored. If escape is TRUE then the contents will have
|
||||
any escape sequences converted into single characters.
|
||||
*)
|
||||
|
||||
PROCEDURE PutConstString (tok: CARDINAL; sym: CARDINAL; contents: Name) ;
|
||||
PROCEDURE PutConstStringKnown (tok: CARDINAL; sym: CARDINAL;
|
||||
contents: Name; escape, known: BOOLEAN) ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
s : String ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: ConstString.Length := LengthKey (contents) ;
|
||||
ConstString.Contents := contents ;
|
||||
ConstStringSym: IF known
|
||||
THEN
|
||||
IF escape
|
||||
THEN
|
||||
s := HandleEscape (InitStringCharStar (KeyToCharStar (contents))) ;
|
||||
contents := makekey (string (s)) ;
|
||||
s := KillString (s)
|
||||
END ;
|
||||
ConstString.Length := LengthKey (contents) ;
|
||||
ConstString.Contents := contents
|
||||
ELSE
|
||||
ConstString.Length := 0 ;
|
||||
ConstString.Contents := NulName
|
||||
END ;
|
||||
ConstString.Known := known ;
|
||||
InitWhereDeclaredTok (tok, ConstString.At) ;
|
||||
InitWhereFirstUsedTok (tok, ConstString.At) |
|
||||
|
||||
ConstVarSym : (* ok altering this to ConstString *)
|
||||
(* copy name and alter symbol. *)
|
||||
ConstVarSym : (* Change a ConstVar to a ConstString copy name
|
||||
and alter symboltype. *)
|
||||
InitConstString (tok, sym, ConstVar.name, contents,
|
||||
m2str,
|
||||
sym, NulSym, NulSym, NulSym)
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString or ConstVar symbol')
|
||||
END
|
||||
END
|
||||
END PutConstString ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringM2 - returns whether this conststring is an unaltered Modula-2 string.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringM2 (sym: CARDINAL) : BOOLEAN ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.StringVariant = m2str
|
||||
m2str, escape, known)
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
END
|
||||
END
|
||||
END PutConstStringKnown ;
|
||||
|
||||
|
||||
(*
|
||||
CopyConstString - copies string contents from expr to des
|
||||
and retain the kind of string.
|
||||
*)
|
||||
|
||||
PROCEDURE CopyConstString (tok: CARDINAL; des, expr: CARDINAL) ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
Assert (IsConstStringKnown (expr)) ;
|
||||
pSym := GetPsym (des) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: InitConstString (tok, des, ConstString.name,
|
||||
GetString (expr),
|
||||
GetConstStringKind (expr), FALSE, TRUE) |
|
||||
ConstVarSym : (* Change a ConstVar to a ConstString copy name
|
||||
and alter symboltype. *)
|
||||
InitConstString (tok, des, ConstVar.name,
|
||||
GetString (expr),
|
||||
GetConstStringKind (expr), FALSE, TRUE)
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
END
|
||||
END
|
||||
END CopyConstString ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringKnown - returns TRUE if sym is a const string
|
||||
and the contents are known.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringKnown (sym: CARDINAL) : BOOLEAN ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.Known
|
||||
|
||||
ELSE
|
||||
RETURN FALSE
|
||||
END
|
||||
END
|
||||
END IsConstStringKnown ;
|
||||
|
||||
|
||||
(*
|
||||
IsConstStringM2 - returns whether this conststring is a
|
||||
Modula-2 string.
|
||||
*)
|
||||
|
||||
PROCEDURE IsConstStringM2 (sym: CARDINAL) : BOOLEAN ;
|
||||
BEGIN
|
||||
RETURN GetConstStringKind (sym) = m2str
|
||||
END IsConstStringM2 ;
|
||||
|
||||
|
||||
|
|
@ -5430,19 +5246,8 @@ END IsConstStringM2 ;
|
|||
*)
|
||||
|
||||
PROCEDURE IsConstStringC (sym: CARDINAL) : BOOLEAN ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.StringVariant = cstr
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
END
|
||||
END
|
||||
RETURN GetConstStringKind (sym) = cstr
|
||||
END IsConstStringC ;
|
||||
|
||||
|
||||
|
|
@ -5452,19 +5257,8 @@ END IsConstStringC ;
|
|||
*)
|
||||
|
||||
PROCEDURE IsConstStringM2nul (sym: CARDINAL) : BOOLEAN ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.StringVariant = m2nulstr
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
END
|
||||
END
|
||||
RETURN GetConstStringKind (sym) = m2nulstr
|
||||
END IsConstStringM2nul ;
|
||||
|
||||
|
||||
|
|
@ -5475,6 +5269,16 @@ END IsConstStringM2nul ;
|
|||
*)
|
||||
|
||||
PROCEDURE IsConstStringCnul (sym: CARDINAL) : BOOLEAN ;
|
||||
BEGIN
|
||||
RETURN GetConstStringKind (sym) = cnulstr
|
||||
END IsConstStringCnul ;
|
||||
|
||||
|
||||
(*
|
||||
GetConstStringKind - return the StringVariant field associated with sym.
|
||||
*)
|
||||
|
||||
PROCEDURE GetConstStringKind (sym: CARDINAL) : ConstStringVariant ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
|
|
@ -5482,13 +5286,14 @@ BEGIN
|
|||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.StringVariant = cnulstr
|
||||
ConstStringSym: RETURN ConstString.StringVariant
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
END
|
||||
END
|
||||
END IsConstStringCnul ;
|
||||
END GetConstStringKind ;
|
||||
|
||||
|
||||
|
||||
(*
|
||||
|
|
@ -5504,7 +5309,12 @@ BEGIN
|
|||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.Contents
|
||||
ConstStringSym: IF ConstString.Known
|
||||
THEN
|
||||
RETURN ConstString.Contents
|
||||
ELSE
|
||||
InternalError ('const string contents are unknown')
|
||||
END
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
|
|
@ -5517,15 +5327,21 @@ END GetString ;
|
|||
GetStringLength - returns the length of the string symbol Sym.
|
||||
*)
|
||||
|
||||
PROCEDURE GetStringLength (Sym: CARDINAL) : CARDINAL ;
|
||||
PROCEDURE GetStringLength (tok: CARDINAL; sym: CARDINAL) : CARDINAL ;
|
||||
VAR
|
||||
pSym: PtrToSymbol ;
|
||||
BEGIN
|
||||
pSym := GetPsym (Sym) ;
|
||||
pSym := GetPsym (sym) ;
|
||||
WITH pSym^ DO
|
||||
CASE SymbolType OF
|
||||
|
||||
ConstStringSym: RETURN ConstString.Length
|
||||
ConstStringSym: IF ConstString.Known
|
||||
THEN
|
||||
RETURN ConstString.Length
|
||||
ELSE
|
||||
MetaErrorT0 (tok, 'const string contents are unknown') ;
|
||||
RETURN 0
|
||||
END
|
||||
|
||||
ELSE
|
||||
InternalError ('expecting ConstString symbol')
|
||||
|
|
|
|||
7
gcc/testsuite/gm2/extensions/run/pass/callingc2.mod
Normal file
7
gcc/testsuite/gm2/extensions/run/pass/callingc2.mod
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
MODULE callingc2 ;
|
||||
|
||||
FROM libc IMPORT printf ;
|
||||
|
||||
BEGIN
|
||||
printf ("\n") ;
|
||||
END callingc2.
|
||||
13
gcc/testsuite/gm2/extensions/run/pass/callingc3.mod
Normal file
13
gcc/testsuite/gm2/extensions/run/pass/callingc3.mod
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
MODULE callingc3 ;
|
||||
|
||||
FROM libc IMPORT exit ;
|
||||
FROM StrLib IMPORT StrLen ;
|
||||
|
||||
VAR
|
||||
a: ARRAY [0..1] OF CHAR ;
|
||||
BEGIN
|
||||
IF StrLen ("\n") # 2
|
||||
THEN
|
||||
exit (1)
|
||||
END
|
||||
END callingc3.
|
||||
10
gcc/testsuite/gm2/extensions/run/pass/callingc4.mod
Normal file
10
gcc/testsuite/gm2/extensions/run/pass/callingc4.mod
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
MODULE callingc4 ;
|
||||
|
||||
FROM libc IMPORT printf, exit ;
|
||||
FROM StrLib IMPORT StrLen ;
|
||||
|
||||
VAR
|
||||
a: ARRAY [0..1] OF CHAR ;
|
||||
BEGIN
|
||||
a := "\n"
|
||||
END callingc4.
|
||||
10
gcc/testsuite/gm2/extensions/run/pass/callingc5.mod
Normal file
10
gcc/testsuite/gm2/extensions/run/pass/callingc5.mod
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
MODULE callingc5 ;
|
||||
|
||||
FROM libc IMPORT printf, exit ;
|
||||
FROM StrLib IMPORT StrLen ;
|
||||
|
||||
VAR
|
||||
a: ARRAY [0..1] OF CHAR ;
|
||||
BEGIN
|
||||
a := "a"
|
||||
END callingc5.
|
||||
10
gcc/testsuite/gm2/extensions/run/pass/callingc6.mod
Normal file
10
gcc/testsuite/gm2/extensions/run/pass/callingc6.mod
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
MODULE callingc6 ;
|
||||
|
||||
FROM libc IMPORT printf, exit ;
|
||||
FROM StrLib IMPORT StrLen ;
|
||||
|
||||
VAR
|
||||
tinyarray: ARRAY [0..1] OF CHAR ;
|
||||
BEGIN
|
||||
tinyarray := "ab"
|
||||
END callingc6.
|
||||
10
gcc/testsuite/gm2/extensions/run/pass/callingc7.mod
Normal file
10
gcc/testsuite/gm2/extensions/run/pass/callingc7.mod
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
MODULE callingc7 ;
|
||||
|
||||
FROM libc IMPORT printf, exit ;
|
||||
FROM StrLib IMPORT StrLen ;
|
||||
|
||||
VAR
|
||||
tinyarray: ARRAY [0..1] OF CHAR ;
|
||||
BEGIN
|
||||
tinyarray := "b"
|
||||
END callingc7.
|
||||
10
gcc/testsuite/gm2/extensions/run/pass/callingc8.mod
Normal file
10
gcc/testsuite/gm2/extensions/run/pass/callingc8.mod
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
MODULE callingc8 ;
|
||||
|
||||
FROM libc IMPORT printf, exit ;
|
||||
FROM StrLib IMPORT StrLen ;
|
||||
|
||||
VAR
|
||||
tinyarray: ARRAY [0..1] OF CHAR ;
|
||||
BEGIN
|
||||
tinyarray := "ab"
|
||||
END callingc8.
|
||||
7
gcc/testsuite/gm2/extensions/run/pass/fixedarray.mod
Normal file
7
gcc/testsuite/gm2/extensions/run/pass/fixedarray.mod
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
MODULE fixedarray ;
|
||||
|
||||
VAR
|
||||
array: ARRAY [0..9] OF CHAR ;
|
||||
BEGIN
|
||||
array := "0123456789"
|
||||
END fixedarray.
|
||||
7
gcc/testsuite/gm2/extensions/run/pass/fixedarray2.mod
Normal file
7
gcc/testsuite/gm2/extensions/run/pass/fixedarray2.mod
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
MODULE fixedarray2 ;
|
||||
|
||||
VAR
|
||||
array: ARRAY [0..9] OF CHAR ;
|
||||
BEGIN
|
||||
array := "012345678"
|
||||
END fixedarray2.
|
||||
6
gcc/testsuite/gm2/pim/run/pass/constdef.def
Normal file
6
gcc/testsuite/gm2/pim/run/pass/constdef.def
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
DEFINITION MODULE constdef ; (*!m2iso+gm2*)
|
||||
|
||||
CONST
|
||||
StrConst = 'hello' ;
|
||||
|
||||
END constdef.
|
||||
3
gcc/testsuite/gm2/pim/run/pass/constdef.mod
Normal file
3
gcc/testsuite/gm2/pim/run/pass/constdef.mod
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
IMPLEMENTATION MODULE constdef ; (*!m2iso+gm2*)
|
||||
|
||||
END constdef.
|
||||
|
|
@ -27,18 +27,20 @@ load_lib gm2-torture.exp
|
|||
set gm2src ${srcdir}/../m2
|
||||
|
||||
gm2_init_pim "${srcdir}/gm2/pim/run/pass"
|
||||
gm2_link_obj "sys.o"
|
||||
gm2_link_obj "sys.o constdef.o"
|
||||
|
||||
|
||||
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
|
||||
set output [gm2_target_compile $srcdir/$subdir/sys.mod sys.o object "-g -I$srcdir/../m2/gm2-libs -I$srcdir/$subdir -I$srcdir/../m2/gm2-compiler -I../m2/gm2-libs -I../m2/gm2-compiler -fpim"]
|
||||
set output [gm2_target_compile $srcdir/$subdir/constdef.mod constdef.o object "-g -I$srcdir/../m2/gm2-libs -I$srcdir/$subdir -I$srcdir/../m2/gm2-compiler -I../m2/gm2-libs -I../m2/gm2-compiler -fpim"]
|
||||
|
||||
# If we're only testing specific files and this isn't one of them, skip it.
|
||||
if ![runtest_file_p $runtests $testcase] then {
|
||||
continue
|
||||
}
|
||||
|
||||
if { $testcase != "$srcdir/$subdir/sys.mod" } {
|
||||
if { $testcase != "$srcdir/$subdir/sys.mod"
|
||||
&& $testcase != "$srcdir/$subdir/constdef.mod" } {
|
||||
gm2-torture-execute $testcase "" "pass"
|
||||
}
|
||||
}
|
||||
|
|
|
|||
26
gcc/testsuite/gm2/pim/run/pass/testimportconst.mod
Normal file
26
gcc/testsuite/gm2/pim/run/pass/testimportconst.mod
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
MODULE testimportconst ; (*!m2iso+gm2*)
|
||||
|
||||
FROM StrLib IMPORT StrEqual ;
|
||||
FROM libc IMPORT printf ;
|
||||
FROM constdef IMPORT StrConst ;
|
||||
IMPORT constdef ;
|
||||
|
||||
|
||||
PROCEDURE init ;
|
||||
BEGIN
|
||||
IF NOT StrEqual (StrConst, 'hello')
|
||||
THEN
|
||||
printf ("failed to import 'hello' from constdef\n");
|
||||
HALT (1)
|
||||
END ;
|
||||
IF NOT StrEqual (constdef.StrConst, 'hello')
|
||||
THEN
|
||||
printf ("failed constdef.StrConst does not equal 'hello'\n");
|
||||
HALT (2)
|
||||
END
|
||||
END init ;
|
||||
|
||||
|
||||
BEGIN
|
||||
init
|
||||
END testimportconst.
|
||||
Loading…
Add table
Reference in a new issue