diff options
Diffstat (limited to 'gcc/m2/gm2-compiler/M2Quads.mod')
| -rw-r--r-- | gcc/m2/gm2-compiler/M2Quads.mod | 211 |
1 files changed, 138 insertions, 73 deletions
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index 9bb8c4d..748ce24 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -69,6 +69,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, GetArraySubscript, GetDimension, GetParam, GetNth, GetNthParamAny, + GetNthParamAnyClosest, GetFirstUsed, GetDeclaredMod, GetQuads, GetReadQuads, GetWriteQuads, GetWriteLimitQuads, GetReadLimitQuads, @@ -225,6 +226,7 @@ FROM M2Options IMPORT NilChecking, GenerateLineDebug, Exceptions, Profiling, Coding, Optimizing, UninitVariableChecking, + StrictTypeAssignment, ScaffoldDynamic, ScaffoldStatic, cflag, ScaffoldMain, SharedFlag, WholeProgram, GetDumpDir, GetM2DumpFilter, @@ -257,8 +259,10 @@ FROM M2Range IMPORT InitAssignmentRangeCheck, InitRotateCheck, InitShiftCheck, InitTypesAssignmentCheck, + InitTypesIndrXCheck, InitTypesExpressionCheck, InitTypesParameterCheck, + InitTypesReturnTypeCheck, InitForLoopBeginRangeCheck, InitForLoopToRangeCheck, InitForLoopEndRangeCheck, @@ -283,7 +287,6 @@ IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ; CONST DebugStackOn = TRUE ; DebugVarients = FALSE ; - BreakAtQuad = 758 ; DebugTokPos = FALSE ; TYPE @@ -396,6 +399,7 @@ VAR (* in order. *) NoOfQuads : CARDINAL ; (* Number of used quadruples. *) Head : CARDINAL ; (* Head of the list of quadruples. *) + BreakQuad : CARDINAL ; (* Stop when BreakQuad is created. *) (* @@ -1486,22 +1490,6 @@ BEGIN END AddQuadInformation ; -PROCEDURE stop ; BEGIN END stop ; - - -(* - CheckBreak - check whether QuadNo = BreakAtQuad and if so call stop. -*) - -PROCEDURE CheckBreak (QuadNo: CARDINAL) ; -BEGIN - IF QuadNo = BreakAtQuad - THEN - stop - END -END CheckBreak ; - - (* PutQuadO - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and sets a boolean to determinine whether overflow should be checked. @@ -3887,6 +3875,10 @@ BEGIN THEN MetaErrorT1 (combinedtok, 'combined {%1Oad}', Des) END ; + IF StrictTypeAssignment + THEN + BuildRange (InitTypesAssignmentCheck (combinedtok, Des, Exp)) + END ; IF (GetSType (Des) # NulSym) AND (NOT IsSet (GetDType (Des))) THEN (* Tell code generator to test runtime values of assignment so ensure we @@ -4654,6 +4646,8 @@ BEGIN BySym) ; MetaErrorDecl (BySym, TRUE) ELSE + e1 := DereferenceLValue (e1tok, e1) ; + e2 := DereferenceLValue (e2tok, e2) ; GenQuadOTypetok (bytok, LastForIteratorOp, LastIterator, Make2Tuple (e1, e2), BySym, FALSE, FALSE, bytok, MakeVirtual2Tok (e1tok, e2tok), bytok) @@ -5627,7 +5621,7 @@ VAR proctok, paramtok : CARDINAL ; n1, n2 : Name ; - ParamCheckId, + ParamCheckId, Dim, Actual, FormalI, @@ -5676,7 +5670,8 @@ BEGIN WHILE i<=ParamTotal DO IF i <= NoOfParamAny (Proc) THEN - FormalI := GetParam(Proc, i) ; + (* FormalI := GetParam(Proc, i) ; *) + FormalI := GetNthParamAnyClosest (Proc, i, GetCurrentModule ()) ; IF CompilerDebugging THEN n1 := GetSymName(FormalI) ; @@ -5768,42 +5763,46 @@ VAR CheckedProcedure: CARDINAL ; e : Error ; BEGIN - n := NoOfParamAny (ProcType) ; IF IsVar(call) OR IsTemporary(call) OR IsParameter(call) THEN CheckedProcedure := GetDType(call) ELSE CheckedProcedure := call END ; - IF n # NoOfParamAny (CheckedProcedure) + IF ProcType # CheckedProcedure THEN - e := NewError(GetDeclaredMod(ProcType)) ; - n1 := GetSymName(call) ; - n2 := GetSymName(ProcType) ; - ErrorFormat2(e, 'procedure (%a) is a parameter being passed as variable (%a) but they are declared with different number of parameters', - n1, n2) ; - e := ChainError(GetDeclaredMod(call), e) ; - t := NoOfParamAny (CheckedProcedure) ; - IF n<2 + n := NoOfParamAny (ProcType) ; + (* We need to check the formal parameters between the procedure and proc type. *) + IF n # NoOfParamAny (CheckedProcedure) THEN - ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameter, declared with (%d)', - n1, n, t) - ELSE - ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameters, declared with (%d)', - n1, n, t) - END - ELSE - i := 1 ; - WHILE i<=n DO - IF IsVarParamAny (ProcType, i) # IsVarParamAny (CheckedProcedure, i) + e := NewError(GetDeclaredMod(ProcType)) ; + n1 := GetSymName(call) ; + n2 := GetSymName(ProcType) ; + ErrorFormat2(e, 'procedure (%a) is a parameter being passed as variable (%a) but they are declared with different number of parameters', + n1, n2) ; + e := ChainError(GetDeclaredMod(call), e) ; + t := NoOfParamAny (CheckedProcedure) ; + IF n<2 THEN - MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', ProcType, GetNth (ProcType, i), i) ; - MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', call, GetNth (call, i), i) - END ; - BuildRange (InitTypesParameterCheck (tokno, CheckedProcedure, i, - GetParam (CheckedProcedure, i), - GetParam (ProcType, i), ParamCheckId)) ; - INC(i) + ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameter, declared with (%d)', + n1, n, t) + ELSE + ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameters, declared with (%d)', + n1, n, t) + END + ELSE + i := 1 ; + WHILE i<=n DO + IF IsVarParamAny (ProcType, i) # IsVarParamAny (CheckedProcedure, i) + THEN + MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', ProcType, GetNth (ProcType, i), i) ; + MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', call, GetNth (call, i), i) + END ; + BuildRange (InitTypesParameterCheck (tokno, CheckedProcedure, i, + GetNthParamAnyClosest (CheckedProcedure, i, GetCurrentModule ()), + GetParam (ProcType, i), ParamCheckId)) ; + INC(i) + END END END END CheckProcTypeAndProcedure ; @@ -6150,7 +6149,7 @@ BEGIN MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo) ; IF NoOfParamAny (ProcedureSym) >= ParameterNo THEN - FormalParam := GetNthParamAny (ProcedureSym, ParameterNo) ; + FormalParam := GetNthParamAnyClosest (ProcedureSym, ParameterNo, GetCurrentModule ()) ; IF IsUnboundedParamAny (ProcedureSym, ParameterNo) THEN MetaErrorT2 (GetVarDeclFullTok (FormalParam), 'formal parameter {%1ad} has an open array type {%2tad}', @@ -6205,7 +6204,7 @@ BEGIN MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo) ; IF NoOfParamAny (ProcedureSym) >= ParameterNo THEN - FormalParam := GetNthParamAny (ProcedureSym, ParameterNo) ; + FormalParam := GetNthParamAnyClosest (ProcedureSym, ParameterNo, GetCurrentModule ()) ; IF IsUnboundedParamAny (ProcedureSym, ParameterNo) THEN MetaErrorT2 (GetVarDeclFullTok (FormalParam), '{%W}formal parameter {%1ad} has an open array type {%2tad}', @@ -6270,21 +6269,24 @@ END ExpectVariable ; doIndrX - perform des = *exp with a conversion if necessary. *) -PROCEDURE doIndrX (tok: CARDINAL; - des, exp: CARDINAL) ; +PROCEDURE doIndrX (tok: CARDINAL; des, exp: CARDINAL) ; VAR t: CARDINAL ; BEGIN - IF GetDType(des)=GetDType(exp) + IF GetDType (des) = GetDType (exp) THEN GenQuadOtok (tok, IndrXOp, des, GetSType (des), exp, TRUE, tok, tok, tok) ELSE + IF StrictTypeAssignment + THEN + BuildRange (InitTypesIndrXCheck (tok, des, exp)) + END ; t := MakeTemporary (tok, RightValue) ; PutVar (t, GetSType (exp)) ; GenQuadOtok (tok, IndrXOp, t, GetSType (exp), exp, TRUE, tok, tok, tok) ; - GenQuadOtok (tok, BecomesOp, des, NulSym, doVal (GetSType(des), t), TRUE, + GenQuadOtok (tok, BecomesOp, des, NulSym, doVal (GetSType (des), t), TRUE, tok, UnknownTokenNo, tok) END END doIndrX ; @@ -11293,12 +11295,41 @@ BEGIN n1, n2) ELSE (* this checks the types are compatible, not the data contents. *) - BuildRange (InitTypesAssignmentCheck (tokno, currentProc, actualVal)) + BuildRange (InitTypesReturnTypeCheck (tokno, currentProc, actualVal)) END END CheckReturnType ; (* + BuildReturnLower - check the return type and value to ensure type + compatibility and no range overflow will occur. +*) + +PROCEDURE BuildReturnLower (tokcombined, tokexpr: CARDINAL; e1, t1: CARDINAL) ; +VAR + e2, t2: CARDINAL ; +BEGIN + (* This will check that the type returned is compatible with + the formal return type of the procedure. *) + CheckReturnType (tokcombined, CurrentProc, e1, t1) ; + (* Dereference LeftValue if necessary. *) + IF GetMode (e1) = LeftValue + THEN + t2 := GetSType (CurrentProc) ; + e2 := MakeTemporary (tokexpr, RightValue) ; + PutVar(e2, t2) ; + CheckPointerThroughNil (tokexpr, e1) ; + doIndrX (tokexpr, e2, e1) ; + e1 := e2 + END ; + (* Here we check the data contents to ensure no overflow. *) + BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e1)) ; + GenQuadOtok (tokcombined, ReturnValueOp, e1, NulSym, CurrentProc, FALSE, + tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc)) +END BuildReturnLower ; + + +(* BuildReturn - Builds the Return part of the procedure. tokreturn is the location of the RETURN keyword. The Stack is expected to contain: @@ -11317,7 +11348,6 @@ PROCEDURE BuildReturn (tokreturn: CARDINAL) ; VAR tokcombined, tokexpr : CARDINAL ; - e2, t2, e1, t1, t, f, Des : CARDINAL ; @@ -11337,26 +11367,18 @@ BEGIN tokcombined := MakeVirtualTok (tokreturn, tokreturn, tokexpr) ; IF e1 # NulSym THEN - (* this will check that the type returned is compatible with - the formal return type of the procedure. *) - CheckReturnType (tokcombined, CurrentProc, e1, t1) ; - (* dereference LeftValue if necessary *) - IF GetMode (e1) = LeftValue - THEN - t2 := GetSType (CurrentProc) ; - e2 := MakeTemporary (tokexpr, RightValue) ; - PutVar(e2, t2) ; - CheckPointerThroughNil (tokexpr, e1) ; - doIndrX (tokexpr, e2, e1) ; - (* here we check the data contents to ensure no overflow. *) - BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e2)) ; - GenQuadOtok (tokcombined, ReturnValueOp, e2, NulSym, CurrentProc, FALSE, - tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc)) + (* Check we are in a procedure scope and that the procedure has a return type. *) + IF CurrentProc = NulSym + THEN + MetaErrorT0 (tokcombined, + '{%1E} attempting to return a value when not in a procedure scope') + ELSIF GetSType (CurrentProc) = NulSym + THEN + MetaErrorT1 (tokcombined, + 'attempting to return a value from procedure {%1Ea} which does not have a return type', + CurrentProc) ELSE - (* here we check the data contents to ensure no overflow. *) - BuildRange (InitReturnRangeCheck (tokcombined, CurrentProc, e1)) ; - GenQuadOtok (tokcombined, ReturnValueOp, e1, NulSym, CurrentProc, FALSE, - tokcombined, UnknownTokenNo, GetDeclaredMod (CurrentProc)) + BuildReturnLower (tokcombined, tokexpr, e1, t1) END END ; GenQuadO (tokcombined, GotoOp, NulSym, NulSym, PopWord (ReturnStack), FALSE) ; @@ -16059,12 +16081,55 @@ END StressStack ; (* + gdbhook - a debugger convenience hook. +*) + +PROCEDURE gdbhook ; +END gdbhook ; + + +(* + BreakWhenQuadCreated - to be called interactively by gdb. +*) + +PROCEDURE BreakWhenQuadCreated (quad: CARDINAL) ; +BEGIN + BreakQuad := quad +END BreakWhenQuadCreated ; + + +(* + CheckBreak - if quad = BreakQuad then call gdbhook. +*) + +PROCEDURE CheckBreak (quad: CARDINAL) ; +BEGIN + IF quad = BreakQuad + THEN + gdbhook + END +END CheckBreak ; + + +(* Init - initialize the M2Quads module, all the stacks, all the lists and the quads list. *) PROCEDURE Init ; BEGIN + BreakWhenQuadCreated (0) ; (* Disable the intereactive quad watch. *) + (* To examine the quad table when a quad is created run cc1gm2 from gdb + and set a break point on gdbhook. + (gdb) break gdbhook + (gdb) run + Now below interactively call BreakWhenQuadCreated with the quad + under investigation. *) + gdbhook ; + (* Now is the time to interactively call gdb, for example: + (gdb) print BreakWhenQuadCreated (1234) + (gdb) cont + and you will arrive at gdbhook when this quad is created. *) LogicalOrTok := MakeKey('_LOR') ; LogicalAndTok := MakeKey('_LAND') ; LogicalXorTok := MakeKey('_LXOR') ; |