PROCEDURE GetFullScopeAsmName (sym: CARDINAL) : Name ;
VAR
- leader,
- module: String ;
+ leader: String ;
scope : CARDINAL ;
BEGIN
scope := GetScope (sym) ;
Top,
PopTF, PushTF, PopT, PushT, PopNothing, PopN, PushTFA,
PushTtok, PushTFtok, PopTFtok, PopTtok, PushTFAtok,
- PushTFn, PopTFn,
+ PushTFn, PushTFntok, PopTFn,
OperandT, OperandF, OperandA, OperandAnno, OperandTok,
DisplayStack, WriteOperand, Annotate,
BuildConstructorStart,
BuildConstructorEnd,
NextConstructorField, BuildTypeForConstructor,
+ PopConstructor,
BuildComponentValue,
SilentBuildConstructor, SilentBuildConstructorStart,
|------------+
*)
-PROCEDURE BuildConstructor ;
+PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ;
(*
|------------+ |------------|
*)
-PROCEDURE BuildConstructorStart ;
+PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
(*
|------------+ |------------|
*)
-PROCEDURE BuildConstructorEnd ;
+PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
(*
PROCEDURE BuildComponentValue ;
+(*
+ PopConstructor - removes the top constructor from the top of stack.
+*)
+
+PROCEDURE PopConstructor ;
+
+
(*
BuildNot - Builds a NOT operation from the quad stack.
The Stack is expected to contain:
PROCEDURE PushTFn (True, False, n: WORD) ;
+(*
+ PushTFntok - Push a True and False numbers onto the True/False stack.
+ True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ;
+
+
(*
PopTFn - Pop a True and False number from the True/False stack.
True and False are assumed to contain Symbols or Ident etc.
PutWriteQuad, RemoveWriteQuad,
PutPriority, GetPriority,
PutProcedureBegin, PutProcedureEnd,
+ PutVarConst, IsVarConst,
IsVarParam, IsProcedure, IsPointer, IsParameter,
IsUnboundedParam, IsEnumeration, IsDefinitionForC,
IsVarAParam, IsVarient, IsLegal,
IsPartialUnbounded, IsProcedureBuiltin,
IsSet, IsConstSet, IsConstructor, PutConst,
PutConstructor, PutConstructorFrom,
+ PutDeclared,
MakeComponentRecord, MakeComponentRef,
IsSubscript,
IsTemporary,
combinedtok: CARDINAL ;
BEGIN
des := OperandT (2) ;
- IF IsConst (des)
+ IF IsConst (des) OR IsVarConst (des)
THEN
destok := OperandTok (2) ;
exptok := OperandTok (1) ;
+ exp := OperandT (1) ;
IF DebugTokPos
THEN
MetaErrorT1 (destok, 'destok {%1Ead}', des) ;
MetaErrorT1 (exptok, 'exptok {%1Ead}', exp)
END ;
combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
+ IF DebugTokPos
+ THEN
+ MetaErrorT1 (combinedtok, 'combined {%1Ead}', des)
+ END ;
IF IsBoolean (1)
THEN
MetaErrorT1 (combinedtok,
combinedtok := MakeVirtualTok (becomesTokNo, destok, exptok) ;
IF (GetSType (Des) # NulSym) AND (NOT IsSet (GetDType (Des)))
THEN
- (* tell code generator to test runtime values of assignment so ensure we
- catch overflow and underflow *)
+ (* Tell code generator to test runtime values of assignment so ensure we
+ catch overflow and underflow. *)
BuildRange (InitAssignmentRangeCheck (combinedtok, Des, Exp))
END ;
IF checkTypes
THEN
CheckBecomesMeta (Des, Exp)
END ;
- (* Traditional Assignment *)
+ (* Traditional Assignment. *)
MoveWithMode (becomesTokNo, Des, Exp, Array, destok, exptok, checkOverflow) ;
IF checkTypes
THEN
(*
IF (CannotCheckTypeInPass3 (Des) OR CannotCheckTypeInPass3 (Exp))
THEN
- (* we must do this after the assignment to allow the Designator to be
- resolved (if it is a constant) before the type checking is done *)
- (* prompt post pass 3 to check the assignment once all types are resolved *)
+ (* We must do this after the assignment to allow the Designator to be
+ resolved (if it is a constant) before the type checking is done. *)
+ (* Prompt post pass 3 to check the assignment once all types are resolved. *)
BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp))
END ;
*)
PushTFtok (t, GetSType(t), exprTok) ;
PushTtok (Sym, arrayTok) ;
combinedTok := MakeVirtualTok (arrayTok, arrayTok, exprTok) ;
+ PutVarConst (t, TRUE) ;
BuildAssignConstant (combinedTok) ;
PushTFDtok (t, GetDType(t), d, arrayTok) ;
PushTtok (e, exprTok)
(* now make Adr point to the address of the indexed element *)
combinedTok := MakeVirtualTok (arrayTok, arrayTok, indexTok) ;
Adr := MakeTemporary (combinedTok, LeftValue) ;
+ IF IsVar (Array)
+ THEN
+ (* BuildDesignatorArray may have detected des is a constant. *)
+ PutVarConst (Adr, IsVarConst (Array))
+ END ;
(*
From now on it must reference the array element by its lvalue
- so we create the type of the referenced entity
IF Dim = 1
THEN
(*
- Base has type address because
+ Base has type address since
BuildDesignatorRecord references by address.
Build a record for retrieving the address of dynamic array.
BuildDesignatorRecord will generate the required quadruples,
therefore build sets up the stack for BuildDesignatorRecord
which will generate the quads to access the record.
-
- Build above current current info needed for array.
- Note that, n, has gone by now.
*)
ArraySym := Sym ;
UnboundedType := GetUnboundedRecordType(GetSType(Sym)) ;
VAR
c: ConstructorFrame ;
BEGIN
- c := PopAddress(ConstructorStack) ;
+ c := PopAddress (ConstructorStack) ;
DISPOSE(c)
END PopConstructor ;
PROCEDURE SilentBuildConstructor ;
BEGIN
- PutConstructorIntoFifoQueue(NulSym)
+ PutConstructorIntoFifoQueue (NulSym)
END SilentBuildConstructor ;
|------------+
*)
-PROCEDURE BuildConstructor ;
+PROCEDURE BuildConstructor (tokcbrpos: CARDINAL) ;
VAR
tok : CARDINAL ;
constValue,
type : CARDINAL ;
BEGIN
- PopT(type) ;
- tok := GetTokenNo () ;
- constValue := MakeTemporary(tok, ImmediateValue) ;
- PutVar(constValue, type) ;
- PutConstructor(constValue) ;
- PushValue(constValue) ;
- IF type=NulSym
+ PopTtok (type, tok) ;
+ constValue := MakeTemporary (tok, ImmediateValue) ;
+ PutVar (constValue, type) ;
+ PutConstructor (constValue) ;
+ PushValue (constValue) ;
+ IF type = NulSym
THEN
- WriteFormat0('constructor requires a type before the opening {')
+ MetaErrorT0 (tokcbrpos,
+ '{%E}constructor requires a type before the opening {')
ELSE
- ChangeToConstructor(GetTokenNo(), type) ;
- PutConstructorFrom(constValue, type) ;
- PopValue(constValue) ;
- PutConstructorIntoFifoQueue(constValue)
+ ChangeToConstructor (tok, type) ;
+ PutConstructorFrom (constValue, type) ;
+ PopValue (constValue) ;
+ PutConstructorIntoFifoQueue (constValue)
END ;
- PushConstructor(type)
+ PushConstructor (type)
END BuildConstructor ;
VAR
constValue: CARDINAL ;
BEGIN
- GetConstructorFromFifoQueue(constValue)
+ GetConstructorFromFifoQueue (constValue)
END SilentBuildConstructorStart ;
|------------+ |----------------|
*)
-PROCEDURE BuildConstructorStart ;
+PROCEDURE BuildConstructorStart (cbratokpos: CARDINAL) ;
VAR
constValue,
type : CARDINAL ;
BEGIN
- PopT(type) ; (* we ignore the type as we already have the constructor symbol from pass C *)
- GetConstructorFromFifoQueue(constValue) ;
- Assert(type=GetSType(constValue)) ;
- PushT(constValue) ;
- PushConstructor(type)
+ PopT (type) ; (* we ignore the type as we already have the constructor symbol from pass C *)
+ GetConstructorFromFifoQueue (constValue) ;
+ Assert (type = GetSType (constValue)) ;
+ PushTtok (constValue, cbratokpos) ;
+ PushConstructor (type)
END BuildConstructorStart ;
|------------| |------------|
*)
-PROCEDURE BuildConstructorEnd ;
+PROCEDURE BuildConstructorEnd (cbratokpos: CARDINAL) ;
+VAR
+ type, typetok,
+ value, valtok: CARDINAL ;
BEGIN
+ PopTtok (value, valtok) ;
+ IF IsBoolean (1)
+ THEN
+ typetok := valtok
+ ELSE
+ typetok := OperandTtok (1)
+ END ;
+ valtok := MakeVirtualTok (typetok, typetok, cbratokpos) ;
+ PutDeclared (valtok, value) ;
+ PushTtok (value, valtok) ; (* Use valtok as we now know it was a constructor. *)
PopConstructor
+ (* ; ErrorStringAt (Mark (InitString ('aggregate constant')), valtok) *)
END BuildConstructorEnd ;
END PushTFn ;
+(*
+ PushTFntok - Push a True and False numbers onto the True/False stack.
+ True and False are assumed to contain Symbols or Ident etc.
+*)
+
+PROCEDURE PushTFntok (True, False, n: WORD; tokno: CARDINAL) ;
+VAR
+ f: BoolFrame ;
+BEGIN
+ f := newBoolFrame () ;
+ WITH f^ DO
+ TrueExit := True ;
+ FalseExit := False ;
+ name := n ;
+ tokenno := tokno
+ END ;
+ PushAddress (BoolStack, f)
+END PushTFntok ;
+
+
(*
PopTFn - Pop a True and False number from the True/False stack.
True and False are assumed to contain Symbols or Ident etc.
}
=:
-Constructor := '{' % BuildConstructorStart %
- [ ArraySetRecordValue ] % BuildConstructorEnd %
+Constructor := % DisplayStack %
+ '{' % BuildConstructorStart (GetTokenNo() -1) %
+ [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
'}' =:
ConstSetOrQualidentOrFunction := Qualident
AndTok, AmbersandTok, PeriodPeriodTok, ByTok ;
FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF, PopNothing, OperandT, PushTFA,
- PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok,
+ PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok, PushTFntok,
PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto,
BuildTypeForConstructor, BuildConstructor, BuildConstructorEnd,
+ PopConstructor,
NextConstructorField, SilentBuildConstructor ;
FROM P3SymBuild IMPORT CheckCanBeImported ;
PROCEDURE ErrorString (s: String) ;
BEGIN
- ErrorStringAt(s, GetTokenNo()) ;
+ ErrorStringAt (s, GetTokenNo ()) ;
WasNoError := FALSE
END ErrorString ;
PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
BEGIN
- ErrorString(InitString(a))
+ ErrorString (InitString (a))
END ErrorArray ;
+PROCEDURE ErrorArrayAt (a: ARRAY OF CHAR; tok: CARDINAL) ;
+BEGIN
+ ErrorStringAt (InitString(a), tok)
+END ErrorArrayAt ;
+
+
% declaration PCBuild begin
BEGIN
IF IsAutoPushOn()
THEN
- PushTF(makekey(currentstring), identtok)
+ PushTFtok (makekey (currentstring), identtok, GetTokenNo ())
END ;
Expect(identtok, stopset0, stopset1, stopset2)
END Ident ;
Constructor := '{' % PushConstructorCastType %
% PushInConstructor %
- % BuildConstructor %
- [ ArraySetRecordValue ] % BuildConstructorEnd %
+ % BuildConstructor (GetTokenNo ()-1) %
+ [ ArraySetRecordValue ] % PopConstructor %
'}' % PopInConstructor %
=:
Factor := Number | string | SetOrDesignatorOrFunction |
"(" Expression ")" | "NOT" ( Factor | ConstAttribute ) =:
-PushQualident := % VAR name : Name ;
- init, ip1: CARDINAL ; %
+PushQualident := % VAR name : Name ;
+ init, ip1 : CARDINAL ;
+ tok, tokstart: CARDINAL ; %
% PushAutoOn %
Ident % IF IsAutoPushOn()
THEN
- PopT(name) ;
- init := GetSym(name) ;
+ PopTtok (name, tokstart) ;
+ tok := tokstart ;
+ init := GetSym (name) ;
IF init=NulSym
THEN
- PushTFn(NulSym, NulSym, name)
+ PushTFntok (NulSym, NulSym, name, tok)
ELSE
- WHILE IsDefImp(init) OR IsModule(init) DO
- IF currenttoken#periodtok
+ WHILE IsDefImp (init) OR IsModule (init) DO
+ IF currenttoken # periodtok
THEN
- ErrorArray("expecting '.' after module in the construction of a qualident") ;
- PushT(init) ;
+ ErrorArrayAt ("expecting '.' after module in the construction of a qualident", tok) ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTtok (init, tok) ;
PopAuto ;
RETURN
ELSE
- Expect(periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
- StartScope(init) ;
- Ident(stopset0, stopset1, stopset2) ;
- PopT(name) ;
- ip1 := GetSym(name) ;
- IF ip1=NulSym
+ Expect (periodtok, stopset0, stopset1, stopset2 + SetOfStop2{identtok}) ;
+ StartScope (init) ;
+ Ident (stopset0, stopset1, stopset2) ;
+ PopTtok (name, tok) ;
+ ip1 := GetSym (name) ;
+ IF ip1 = NulSym
THEN
- ErrorArray("unknown ident in the construction of a qualident") ;
+ ErrorArrayAt ("unknown ident in the construction of a qualident", tok) ;
EndScope ;
- PushTFn(NulSym, NulSym, name) ;
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ PushTFntok (NulSym, NulSym, name, tok) ;
PopAuto ;
RETURN
ELSE
- PutIncluded(ip1)
+ PutIncluded (ip1)
END ;
EndScope ;
- CheckCanBeImported(init, ip1) ;
+ CheckCanBeImported (init, ip1) ;
init := ip1
END
END ;
- IF IsProcedure(init) OR IsProcType(init)
+ IF tok#tokstart
+ THEN
+ tok := MakeVirtualTok (tokstart, tokstart, tok)
+ END ;
+ IF IsProcedure (init) OR IsProcType (init)
THEN
- PushT(init)
+ PushTtok (init, tok)
ELSE
- PushTF(init, GetType(init))
+ PushTFtok (init, GetType(init), tok)
END
END
ELSE %
*)
PROCEDURE PushConstructorCastType ;
-VAR
- c: CARDINAL ;
BEGIN
- PopT(c) ;
- PushT(c) ;
IF inDesignator
THEN
- InitConvert(cast, c, NIL, NIL)
+ InitConvert (cast, OperandT (1), NIL, NIL)
END
END PushConstructorCastType ;
}
=:
-Constructor := '{' % BuildConstructorStart %
- [ ArraySetRecordValue ] % BuildConstructorEnd %
+Constructor := '{' % BuildConstructorStart (GetTokenNo() -1) %
+ [ ArraySetRecordValue ] % BuildConstructorEnd (GetTokenNo()) %
'}' =:
ConstSetOrQualidentOrFunction := Qualident
GetImportStatementList, GetModuleDefImportStatementList, GetModuleModImportStatementList,
PutVar,
+ PutVarConst,
PutLeftValueFrontBackType,
GetVarBackEndType,
PutVarPointerCheck,
IsImport,
IsImportStatement,
IsVar,
+ IsVarConst,
IsConst,
IsConstString,
IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
PROCEDURE IsVariableSSA (sym: CARDINAL) : BOOLEAN ;
+(*
+ PutVarConst - sets the IsConst field to value indicating the variable is read only.
+*)
+
+PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ;
+
+
(*
MakeGnuAsm - create a GnuAsm symbol.
*)
PROCEDURE IsVar (Sym: CARDINAL) : BOOLEAN ;
+(*
+ IsVarConst - returns the IsConst field indicating the variable is read only.
+*)
+
+PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ;
+
+
(*
IsConst - returns true is Sym is a Const Symbol.
*)
CVariant,
NulCVariant : CARDINAL ; (* variants of the same string *)
StringVariant : ConstStringVariant ;
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
IsConstructor: BOOLEAN ; (* is the constant a set? *)
FromType : CARDINAL ; (* type is determined FromType *)
UnresFromType: BOOLEAN ; (* is Type unresolved? *)
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
FromType : CARDINAL ; (* type is determined FromType *)
UnresFromType: BOOLEAN ; (* is Type resolved? *)
IsTemp : BOOLEAN ; (* is it a temporary? *)
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
(* dereference a pointer? *)
IsWritten : BOOLEAN ; (* Is variable written to? *)
IsSSA : BOOLEAN ; (* Is variable a SSA? *)
+ IsConst : BOOLEAN ; (* Is variable read/only? *)
At : Where ; (* Where was sym declared/used *)
ReadUsageList, (* list of var read quads *)
WriteUsageList: LRLists ; (* list of var write quads *)
IsPointerCheck := FALSE ;
IsWritten := FALSE ;
IsSSA := FALSE ;
+ IsConst := FALSE ;
InitWhereDeclaredTok(tok, At) ;
InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
InitList(ReadUsageList[RightValue]) ;
ConstLit.IsConstructor := FALSE ;
ConstLit.FromType := NulSym ; (* type is determined FromType *)
ConstLit.UnresFromType := FALSE ; (* is Type resolved? *)
+ ConstLit.Scope := GetCurrentScope() ;
InitWhereDeclaredTok (tok, ConstLit.At) ;
InitWhereFirstUsedTok (tok, ConstLit.At)
FromType := NulSym ; (* type is determined FromType *)
UnresFromType := FALSE ; (* is Type resolved? *)
IsTemp := FALSE ;
+ Scope := GetCurrentScope() ;
InitWhereDeclaredTok (tok, At)
END
END ;
m2sym, m2nulsym, csym, cnulsym) ;
BackFillString (cnulsym,
m2sym, m2nulsym, csym, cnulsym) ;
+ ConstString.Scope := GetCurrentScope() ;
InitWhereDeclaredTok (tok, ConstString.At)
ELSE
END GetVarWritten ;
+(*
+ PutVarConst - sets the IsConst field to value indicating the variable is read only.
+*)
+
+PROCEDURE PutVarConst (sym: CARDINAL; value: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsVar (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ pSym^.Var.IsConst := value
+ END
+END PutVarConst ;
+
+
+(*
+ IsVarConst - returns the IsConst field indicating the variable is read only.
+*)
+
+PROCEDURE IsVarConst (sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym: RETURN( Var.IsConst )
+
+ ELSE
+ InternalError ('expecting VarSym')
+ END
+ END
+END IsVarConst ;
+
+
(*
PutConst - gives the constant symbol Sym a type ConstType.
*)
RecordSym : RETURN( Record.Scope ) |
SetSym : RETURN( Set.Scope ) |
UnboundedSym : RETURN( Unbounded.Scope ) |
+ ConstLitSym : RETURN( ConstLit.Scope ) |
+ ConstStringSym : RETURN( ConstString.Scope ) |
+ ConstVarSym : RETURN( ConstVar.Scope ) |
PartialUnboundedSym: InternalError ('should not be requesting the scope of a PartialUnbounded symbol')
ELSE
projects / thirdparty / gcc.git / commitdiff
