/* DC.TH */ /* Y.L. Noyelle, Supelec, France 1994 */ #ifndef DC_TH #define DC_TH #include /* done here, before local macro definitions */ #include "configdc.th" #ifdef LcEqUc # include /* done here, before bulk of local macro definitions */ # ifdef _tolower # define RealChar(x) _tolower(x) # else # define RealChar(x) tolower(x) # endif #else # define RealChar(x) x #endif #define byte signed char #define ubyte unsigned char #ifdef ushort # undef ushort #endif #ifdef uint # undef uint #endif #ifdef ulong # undef ulong #endif #define/*~Masking*/ ushort unsigned short #define/*~Masking*/ uint unsigned int #define/*~Masking*/ ulong unsigned long typedef uint bool; /* Anormal exit codes */ #define ExCod1 "1" #define ExCod2 "2" #define ExCod3 "3" #define ExCod4 "4" #define ExCod5 "5" #define ExCod6 "6" #define ExCod7 "7" #define ExCod8 "8" #define ExCod9 "9" #define AdaptHCode(x) (x & UINT_MAX) /* hardwired h-codes would have to be \ recomputed should 'HCodeCst' (dcrec.c) change; \ they are all parameter of this macro. */ #define AdLastEltP1(x) &x[NbElt(x)] #define AllocXElt(xname, xtype, xctr, xstmtSeq) \ xtype *xname(void) \ { \ /*~ zif (sizeof(TqElt6) < sizeof(xtype)) \ #xname "(): " #xtype " size too big" */\ xtype *resul; \ \ if (headQElt6 != NULL) { /* if there remains free(d) elements, */\ resul = (xtype * /*~OddCast*/) headQElt6; /* use one of them, */ \ headQElt6 = headQElt6->next;} \ else resul = allocChunk(); /* else allocate a new chunk. */ \ xctr++; \ xstmtSeq /* parameter statement sequence */ \ return resul; \ } #define ArrLimErr (-(size_t)1) #define BaseStrunType(x) x->TagId->type #define Base10 10 #define BITNXTSIGN ((SIGN_BIT >> 1) & INT_MAX) #define BitsHexDigit 4 #define CharStr "char" #define ConstStr "const" #define ConvToString(x) ConvToString1(x) /* for parameter to be expanded */ #define ConvToString1(x) #x #define ConvTname(x) (Tname)x #define CreateParArr(n) Tstring ParArr n[n+1 /*~IndexType TmsgParIndex*/] \ = {(Tstring /*~OddCast*/)n} /* creates a message parameter array */ #define DefRepresType \ static TpTypeElt represType(register TpcTypeElt x /*~ResultPtr*/) \ { \ while (NxtIsTypId(x)) {x = x->TypeId->type;} \ return NoConstTyp(x); \ } #define DefSem(xname, xkind, xdefnd) DefSem1(xname, xkind, xdefnd, False, False) #define DefSem1(xname, xkind, xdefnd, xused, xinitlz) \ static const TinfoSeman xname = {{ \ NoAttrib+(0-0) /*~ zif (! __member(_attribb)) \ "misplaced initialization for field '_attribb'" */, \ xkind /*~ zif (! __member(_kind)) \ "misplaced initialization for field '_kind'" */, \ (0-0) /*~ zif (! __member(_dynInitCtr)) \ "misplaced initialization for field '_dynInitCtr'" */, \ xdefnd /*~ zif (! __member(_defnd)) \ "misplaced initialization for field '_defnd'" */, \ xused /*~ zif (! __member(_used)) \ "misplaced initialization for field '_used'" */, \ False /*~ zif (! __member(_undf)) \ "misplaced initialization for field '_undf'" */, \ xinitlz /*~ zif (! __member(_initlz)) \ "misplaced initialization for field '_initlz'" */, \ False /*~ zif (! __member(_passedToFct)) \ "misplaced initialization for field '_passedToFct'" */,\ False /*~ zif (! __member(_modifSJ)) \ "misplaced initialization for field '_modifSJ'" */, \ False /*~ zif (! __member(_variousS1)) \ "misplaced initialization for field '_variousS1'" */, \ False /*~ zif (! __member(_variousS2)) \ "misplaced initialization for field '_variousS2'" */, \ False /*~ zif (! __member(_variousS3)) \ "misplaced initialization for field '_variousS3'" */, \ False /*~ zif (! __member(_variousS4)) \ "misplaced initialization for field '_variousS4'" */, \ False /*~ zif (! __member(_variousS5)) \ "misplaced initialization for field '_variousS5'" */, \ False /*~ zif (! __member(_variousS6)) \ "misplaced initialization for field '_variousS6'" */, \ False /*~ zif (! __member(_variousS7)) \ "misplaced initialization for field '_variousS7'" */, \ True /*~ zif (! __member(_variousS8)) \ "misplaced initialization for field '_variousS8'" */, \ /*~ zif ! __member() "Structure '" ConvToString(xname) \ "' not fully initialized" */}} #define DispLgtId 0 #define DispNSId (DispLgtId + 1) #define Dots "..." #define DoubleStr "double" #define EnumStr "enum" #define FloatStr "float" #define Found(x) ((curTok.tok == x)? (GetNxtTok(), True) : False) #define FoundDP(x) (curTok.tok==DPTOK && foundDP(x)) #define FreeXElt(xname, xtype, xctr, xstmtSeq, xfollow) \ xtype xname(xtype x /*~MayModify*/) \ { \ xtype resul; \ \ resul = x->xfollow; \ xstmtSeq \ ((TqElt6 * /*~OddCast*/)x)->next = headQElt6; \ headQElt6 = (TqElt6 * /*~OddCast*/)x; \ xctr--; \ return resul; \ } #define FullLgt(x) (Lgt(x) + LgtHdrId) #define GapNxtVarie 2 #define GenericEnum QuasiNULLval(TsemanElt *) #define GetNxtTok() (*pCurGNT)() /* calls current 'token supplier' */ #define InsideInterval(p, LLim,HLim) \ /*~ zif (! __sametype(LLim, p)) "InsideInterval: bad parameter type (must " \ "also be <= 'uint')" */ \ /*~ zif (HLim <= LLim) "InsideInterval: bad HLim" */ \ ((uint)((p) - (LLim)) <= (uint)((HLim) - (LLim))) /* limits included */ #define IntStr "int" #ifdef INT_BIT #undef INT_BIT #endif #define INT_BIT (CHAR_BIT * sizeof(int)) #define IsArr(x) ((x)->typeSort == Array) #define IsArrFct(x) IsArrFctSort((x)->typeSort) #define IsArrFctSort(x) InsideInterval((x), Array, VFct) #define IsChar(x) (x->typeSort==Enum && x->TagId==NULL) #define IsCmpsd(x) IsCmpsdSort(x->typeSort) #define IsCmpsdObj(x) IsCmpsd(x->type) #define IsCmpsdSort(x) ((uint)x >= (uint)Array) #define IsDP(x) (curTok.tok==DPTOK && (Tdprag)curTok.Val==x) #define IsFct(x) IsFctSort((x)->typeSort) #define IsFctSort(x) InsideInterval((x), Fct, VFct) #define IsPtr(x) ((x)->typeSort == Ptr) #define IsPtrArr(x) IsPtrArrSort((x)->typeSort) #define IsPtrArrSort(x) InsideInterval((x), Ptr, Array) #define IsScalar(x) InsideInterval((x)->typeSort, Bool, Ptr) #define IsStrun(x) IsStrunSort((x)->typeSort) #define IsStrunSort(x) InsideInterval((x), Struct, Union) #define IsTypeSort(x, msk) (((x)->typeSort & (msk)) != Void) #define Lgt(x) ((size_t)Lgt1(x)) #define Lgt1(x) /*~ zif !__sametype(Tname, x) "Lgt1: parameter not " \ "of 'Tname' type."*/ *(x + DispLgtId) #define LgtHdrId (DispNSId + 1) /* size of header of identifiers name */ #define LitLen(x) (sizeof(x) - 1) #define LongStr "long" #define LSIGN_BIT ~(ulong)LONG_MAX #define MyAllo(w, x) \ if ((w = x) == NULL) sysErr(errTxt[RanOutOfMem]) #define MyAlloc(w, x) MyAllo(w, malloc(x)) #define MyRealloc(w, x) MyAllo(w, realloc(w, x)) #define NoFreeExpType QuasiNULLval(TpTypeElt) #define NbElt(x) NbEltGen(x, 0) #define NbEltGen(x, y) ((int)sizeof(x)/(int)sizeof(x[y])) #define NoConstTyp(x) (TpTypeElt /*~OddCast*/)(x) #define NxtIsTypId(x) ((x)->ParalSysTpdf != 0) #define NxtTok() (GetNxtTok(), curTok.tok) #define NxtTypElt(x) /*~ zif !__sametype(TpcTypeElt, x) "NxtTypElt: " \ "parameter not of 'TtypeElt *' type." */ (represType(x)->NextTE) #define Offset(strunType, fieldName) (size_t)((ubyte *)&((strunType *)0)-> \ fieldName - (ubyte *)0) #define ParArr(n) parArr##n #define Parent(x) x->TypeId->type #define PopHist(x) x >>= SizeHistElt #define PushHist(x) cExp.hist = cExp.hist<>1, NONASSOC = SETJMPUSED>>1, LOWEST_BIT_TOK = NONASSOC } Ttok; /*~ zif NoSwallowTok>=LOWEST_BIT_TOK "Too many token values" */ typedef enum {ZIF, INIT, WARN, SAVED, UNDEF, CASTTO, IGNORE, NOWARN, PUBLIC, SIZEOK, GENERIC, DYNINIT, MASKING, ODDCAST, NOBRK, NOTUSED, POPWARN, PRIVATE, UTILITY, ADDDFCT, EXACTCMP, FULLENUM, LOCALADR, ROOTTYP, UNDEFTAG, INDEXTYPE, MAYMODIFY, NODEFAULT, SAMEVAL, RESULPTR, PRIVATETO, BCKBRCH, DOLLSIGN, #ifdef TstAdjFiles ENDADJ, ENDSYS, #endif LITCST, PORTQM, RESULTYP, PSEUDOVOID, #ifdef TstAdjFiles SIMADJ, SIMSYS, #endif NONCONST, VOIDTOTHER, DCCCOMPL, CMPSGHDR, ENDLJCLLBL, NEVRET, SIDEFFOK, SIZEOFBL, TYPECMBN} Tdprag; /* order important (see 'tabDPragHC' table in dcprag.c). */ typedef enum {Add, Sub, AddSubAsgn} TkAdd; typedef enum {SimplAsgn, IorAsgn, XorAsgn, AndAsgn, LShAsgn, RShAsgn, AddAsgn, SubAsgn=AddAsgn+1, MulAsgn, DivAsgn, ModAsgn} TkAsgn; typedef enum {EQ, NE, GT, GE, LE, LT} TkCmp; /* order important (see array 'cmpCod'). */ typedef enum {Inc, Dec} TkInc; typedef enum {Mul, Div, Mod} TkMul; typedef enum {LSh, RSh} TkShi; /*~ zif ModAsgn-AddAsgn != (int)Mod+(int)Sub+1 "see searchTC function" */ typedef enum { Err = 0, NoErrMsg = 0 /*~SameValue*/, NoConcErr = NoErrMsg + 1, BegErr = 0 /*~SameValue*/, Warning = 0 /*~SameValue*/, Error /*~SameValue*/, Arithm, At0, ComponOf, ComposOf, DblIncldFile, EGConstPtr, Empty, EmptyTxt, EndMsg, ErrWarn, File, IgndMsgs, IncldBy, LastToks, Left, Line, MayM, NoErrWarn, NotCompild, OrJustBef, ProceedMsg, RanOutOfMem, Right, SeparMsg, StopAftMsgBanner, SubPre, Use1, Use2, Use3, WarnErrInFile, WillM, ActParNotArray, AdjectvFrst, AlrdDefId, AlrdDefLabel, AlrdIncldInBlk, AlrdQual, AlrdUndef, AlrdUsedCaseVal, ArgCollGetsOutMacBody, ArrExptd, ArrOfIncplOrFctElt, ArrOrFctCantBeRet, ArrowExptd, ArrShdBeConst, ArrTooSmall, ArrToPtr, AsgnGblWLclAd, AtLeastOnePar, BackwdBranch, BadActParListLgth, BadAttrib, BadAttribForMain, BadDOption, BadDPForFctPar, BadForLftType, BadIndent, BadIndent1, BadIndexType, BadIndexType1, BadIntgrlType, BadLastPar, BadlyIncldHdrFile, BadParForMain, BadRetType, BadRetTypeForMain, BadUUdcc, BigStrun, BlockQM, BndShdBeNamed, BndShdBeOfNamedType, BoolExptd, CantBeGeneUtil, CantChgMnng, CantInitTpdf, CastToVoid, ChkSetjmpDsbld, ChkUcLc, CmpsgHdrWithSelf, CommaOr, CommaOrXExptd, CompHdrFile, ConcOprIlgLast, ConstQalNotHeeded1, ConstQalNotHeeded2, ConstStrun, ConvToUnsig, ConvToUnsig1, CrtdTokTooLong, CstBoolExp, CstExpExptd, CstOnLftSide, CstSwitchExp, DblDefMember, DblDefStrun, DccCantProcDef, DeclExptd, DefaultExptd, DefinedCantBeDef, DiffIncptblPtr, DirNameExptd, DontInclBodyFile, DontSplitIdent, DontWriteIntoConst, DPragNameExptd, DPragNotAlwd, DWhileNotLinedUp, ElseAlrdSeen, EmbdFctNotAlwd, EmptyStmt, EmptyStrun, EndDPExptd, EndOfLineIgnd, ErrorDir, Exptd, ExtDeclBeInHdrFile, ExtObjNotDef, ExtraRBra, ExtraSColAtEndMac, ExtrnExptd, FctCantBeInit, FctDeclDefNotAlwd, FctDefViaTpdf, FileOpenFail, FldNotAlwd, FldSizIncor, FltNotEq, FmtExhstd, FormParSaved, GroupQual, HzrdConv, HzrdConv1, IdExptd, IfKW, IgndCharsOpt, IlgArraySize, IlgAttrib, IlgAttribForFct, IlgBoolDef, IlgCastSource, IlgCastTarget, IlgCastTarget1, IlgCastTo, IlgChar, IlgCharD, IlgCmpsgHdr, IlgCmpsgHdr1, IlgCrtdTok, IlgDccCmpl, IlgDirName, IlgDPrag, IlgEscSeq, IlgFmtSpe, IlgId, IlgInclArg, IlgInIfExp, IlgInit, IlgInit1, IlgInitBU, IlgLftType, IlgOctDig, IlgOpndType, IlgOptForSpe, IlgPrecFld, IlgRhtType, IlgSpeForType, IlgSynt, IlgTCModOpnd, IlgTCOptr, IlgType, IlgTypeForFld, IlgTypes, IllParenMacro, IllPositDecl, IllUndef, IncldAfter, InclNxtIlg, IncohResultType, IncompTypes, IncorNevRet, IncorTCModRes, IncorTCResTyp, IncplArray, IncplPtr, IncplRetType, IncplStrunType, IncplType, IncptblAttrib, IncptblPar, IncptblTypes, IndexTypeTooSmall, IndexValTooBig, IneffOrSideEff, InitDP, InptFileErr, IntBitField, IntgrlTypeExptd, IntgrNbExptd, LegalOnlyInMac, LgtCharCstNotOne, LoCaseObjName, LowerCaseH, LParOutsideMac, MacAlrdDef, MacBefIncl, MacNameExptd, MayModify, MemberCantBeInit, MisplaLbl, MnlsPtrDiff, MoreStrngType, MoreThanOneAttrib, Msng, MsngBrk, MsngConcOpnd, MsngEqual, MsngExp, MsngExtTpdf, MsngFctAttrib, MsngFctName, MsngFctParen, MsngFldWdth, MsngFldWdth1, MsngIF, MsngLBra, MsngMacArg, MsngMembName, MsngNevRet, MsngNotUsed, MsngObjTypName, MsngSavedQ, MsngSpace, MsngStati, MsngStrunEnum, MsngVoid, MsngVolatQual, NameAlrdInUse, NameSymbLoCase, NegIndexVal, NoAttribAlwd, NoCUName, NoDefInHdrFile, NoDirInDPrag, NoIdAlwdInType, NoIndentIndct, NonCoheDPInFct, NonCommutOper, NonNumCantBeCast, NonPortCastQM, NonPortCmbn, NonPortFName, NonPortOpnd, NonPortTC, NonUndfnblMac, NonVisiLabel, NoOrderRel, NoPrecIf, NoQualifAlwd, NoRetAtEnd, NoShrtCircuit, NotAFct, NotArrInit, NotArrToNum, NotASCIIChar, NoTCAllows, NotDefTag, NotEnumTypeOrTag, NotExptdType, NotFctId, NotInit, NotInit1, NotInsideLoop, NotInsideLoopOrSwitch, NotInsideSwitch, NotInsideSwitch1, NotLVal, NotLValP, NotMacParForQuo, NotModfbl, NotNamedStrunCst, NotPureSideEffect, NotPureSideEffect1, NotSameBlk, NotSameNbOfPar, NotSameType, NotStrunInit, NotStrunType, NotTypeId, NotUsdEnumCst, NotUsdObj, NotUsdPar, NotVarId, NotVisiChar, NumCstShdBeNamed, NumCstShdBeNamed1, OnlyExtrn, OnlyRegAttrib, OperIlgInCstExp, Outside01, Overflow, Overflow1, Overflow2, ParAlrdExist, ParMustBeNamed, ParNameExptd, ParNamesNotEq, ParRepreType, ParTypesNotEq, PortCastQM, PossOvfl, PrevCastUsl, PrivNotVisi, PrtblOper, PtrExptd, PtrOnFctExptd, PtrShdBeConst, PtrToNum, QlfdVariant, RegAttribForAmp, RegVolatIncptbl, ResulPtrM, ResulPtrNotHghsTyp, RetPtrOnLclAd, RetRepreType, RParExptd, SameEnumCst, SameParName, SColExptd1, SepDeclStmt, ShdBeBlk, ShdBeInHdrFile, ShdBePrntzBool, ShdContain, ShdntBePtrOnArr, ShdUseSizeof, SideEffInMacPar, SimplAsgnExptd, SizeofDontEval, SlowingInit, StaFctNotDef, StaticInit, StddefNotIncl, StmtExptd, StrCstExptd, StringTooLong, StrunEnumDeclNotAlwd, StrunShdBeConst, SysError, TagNotVisi, TagQM, TagShdBeDefIn, TagShdBeDfnd, TargLabelNotVisi, TCAlrdDef, TCNotAtLvl0, TooManyBraLvl, TooManyFmtSpe, TooManyIniz, TooManyMacArg, TooManyMacPar, TooManyMsg, TooManyParForMain, TrnctdId, TryPermut, TypeExptd, TypeNotParal, UnclosedCmt, UnclosedDP, UncomputAd, UndeclFctId, UndeclId, UndefEnum, UndefLabel, UndefPtdSize, UndefResul, UndefSize, UndefStrun, UndefTag, Underflow, UndfndId, UnFnshArgList, UnFnshCharCst, UnFnshCmt, UnFnshStrCst, UnknDPrag, UnknId, UnknMacro, UnknMember, UnknOption, #ifdef VMS UnknSysHdrFile, #endif UnreachStmt, UnsigDiffNotNeg, UnsigNonNeg, UnsuitFldType, UnusedEnumCst, UnusedFct, UnusedLabel, UnusedMac, UnusedMacPar, UnusedPar, UnusedTag, UnusedTypeId, UnusedVar, UnusedVar1, UpCaseTypName, UseGeneAndSOMBlDP, UseGenericDP, UseIndexTypForPtr, UseIOption, UsePsdVoidDP, UseResTypDP, UseResTypOrGeneDP, UseTypCmbnDP, UslAttrib, UslCast, UslCastTo, UslCmp, UslDPrag, UslFctQual, UslInitBU, UslNoDefault, UslObj, UslStati, UslTypSpe, VariNotVari, VoidNotAlone, VoidNotAlwd, WarnAlrdOff, WarnAlrdOn, WrngCUnit, WrngFullEnum, WrngHdrFile, WrngNb, WrngNb1, WrngSameVal, WrngSizeof, ZifWarn, EndErr, Warn2 = SIGN_BIT, Warn1 = BITNXTSIGN, UWarn = Warn1>>1, NoDispLine = UWarn>>1, PossErr = NoDispLine>>1, Rdbl = PossErr>>1, Effic = Rdbl>>1, EndErrInfoBits} Terr; /*~ zif (EndErr >= EndErrInfoBits) "Too many error messages !" */ #define Warn3 (Warn2 | Warn1) #define WarnMsk (Warn2 | Warn1) /* all bits */ /* Warnings not to be delivered if inside system macro */ #define UWarn1 Warn1 | UWarn #define UWarn2 Warn2 | UWarn #define UWarn3 Warn3 | UWarn /* Definitions for 'universal' storage blocks */ typedef struct _tqElt6 TqElt6; #define SizeUnivBlk 5 typedef union {void *bid1; long bid2;} TallocUnit; struct _tqElt6 { TallocUnit bid[SizeUnivBlk]; /* to get space for 'SizeUnivBlk' universal memory units. */ TqElt6 *next; /* must come last (so as not to destroy content of freed block, which may be used some more just after freeing (cf, for example, 'Shared' flag in freeTypeElt() ). */ }; /*~ zif Offset(TqElt6,next) + sizeof(((TqElt6 *)0)->next) != sizeof(TqElt6) "Field 'next' of TqElt6 not last field" */ #undef SizeUnivBlk /* Offsets in array 'natTyp' of predefined types */ #ifdef LONGLONG # define DeltaTyp (LONG - CHAR + 1 + 1) #else # define DeltaTyp (LONG - CHAR + 1) #endif #define VoidDpl (VOID - BNatTyp) #define SByteDpl (CHAR - BNatTyp) #define UByteDpl (SByteDpl + DeltaTyp) #define ShortDpl (SHORT - BNatTyp) #define IntDpl (INT - BNatTyp) #define UIntDpl (IntDpl + DeltaTyp) #define LongDpl (LONG - BNatTyp) #define ULongDpl (LongDpl + DeltaTyp) #ifdef LONGLONG # define LLongDpl (LongDpl + 1) # define ULLongDpl (ULongDpl + 1) #else # define LLongDpl LongDpl # define ULLongDpl ULongDpl #endif #define CharDpl (ULLongDpl + 1) #define DoubleDpl (DOUBLE - BNatTyp) #define LongDblDpl (CharDpl + 1) #define EndCNatTypDpl (LongDblDpl + 1) /* Flags to manage numeric constants */ #define NegSeen 1U #define SignSeen (NegSeen << 1) #define USeen (SignSeen << 1) #define LSeen (USeen << 1) #define LLSeen (LSeen << 1) #define FltSeen (LLSeen << 1) #define FSeen (FltSeen << 1) #define LDSeen (FSeen << 1) #define OctHex (LDSeen << 1) /* Shorthands */ #define Algn InfoT.s11._algn #define ArtifType u2.s21._artifType #define Attriba InfoD.s11._attriba #define Attribb InfoS.s11._attribb #define BndType u3._bndType #define CstImpsd u2.s21._cstImpsd #define DeclaringFile u2._declaringFile #define DeclFl InfoD.s11._declFl #define Defnd InfoS.s11._defnd #define DpType u2._dpType #define DynInitCtr InfoS.s11._dynInitCtr #define Einfo u2._eInfo #define EnumVal u3._enumVal #define ErrEvl u2.s21._errEvl #define ErrorT u1._errorT #define FctCallNoResTyp u2.s21._fctCallNoResTyp #define FctCallSeen u2.s21._fctCallSeen #define FctCallSeen1 u2.s21._fctCallSeen1 #define FlagsD InfoD1.s11._flags #define FlagsT InfoT1.s11._flags #define FldFl InfoD.s11._fldFl #define FldSize InfoD.s11._fldSize #define FrstEnumCst u2._frstEnumCst #define Generiq InfoT.s11._generic /* not 'Generic', because Generic d-pragma could not be used any more. */ #define Hcod u3._hCod #define IdName u1._idName #define InfoD u1._infoD #define InfoD1 u1._infoD1 #define InfoS u1._infoS #define InfoS1 u1._infoS1 #define InfoT u1._infoT #define InfoT1 u1._infoT1 #define InhibWaNPB u2.s21._inhibWaNPB #define Initlz InfoS.s11._initlz #define Kind InfoS.s11._kind #define LclAdr u2.s21._lclAdr #define Levlbl u2.s21._lEvlbl #define Lim u2._lim #define ListAlwdFiles u2._listAlwdFiles #define LitCst u2.s21._litCst #define LitCstOutsMac u2.s21._litCstOutsMac #define LvalFl u2.s21._lValFl #define MayModifFl MemberFl #define MayNeedSaved InfoS1.s11._mayNeedSaved #define MemberFl InfoD.s11._memberFl #define MemberList u2._memberList #define ModifSJ InfoS.s11._modifSJ #define NamedType u2._namedType #define NbPar u3._nbPar #define NextTE u4._nextTE #define NoFreeDpdt InfoT.s11._noFreeDpdt #define NoNewTypeFl InfoD.s11._noNewTypeFl #define NoOwner InfoT.s11._noOwner #define NotPureBoo LclAd /* Obj (Bool); often managed as LclAd */ #define NotPureBool LclAdr #define NstLvla u3._nstLvla #define NumVal u2._numVal #define NxtEnumCst u2._nxtEnumCst #define OldUsed u2.s21._oldUsed #define ParalSysTpdf InfoT1.s11._paralSysTpdf #define ParalTyp InfoT.s11._paralTyp #define ParamList u2._paramList #define ParQal InfoD.s11._parQal #define PassedToFct InfoS.s11._passedToFct #define PdscId u3._pDscId #define PointedByObj u2.s21._pointedByObj #define PointingOnObj u2.s21._pointingOnObj #define PqlfdTypes u2._pQlfdTypes #define PseudoAttrib u2.s21._pseudoAttrib #define PtrSem u2._ptrSem #define Pval u1._pVal #define QlfdTyp InfoT.s11._qlfdTyp #define Qualif InfoT.s11._qualif #define ResulPtrFl DeclFl #define Revlbl u2.s21._rEvlbl #define RootTyp InfoT.s11._rootTyp #define Saved InfoS1.s11._saved #define SavedFl SignedInt #define Shared InfoT.s11._shared #define SideEff u2.s21._sideEff #define SignedInt InfoD.s11._signedInt #define SizeofBlFl NoNewTypeFl #define SjVal u2.s21._sjVal #define StopFreeing InfoT.s11._stopFreeing #define Sval u1._sVal #define SynthQualif InfoT.s11._synthQualif #define SysTpdf InfoT.s11._sysTpdf #define TagId u3._tagId #define TypeId u4._typeId #define Undf InfoS.s11._undf /* for ~Undef(Tag)/setjmp management */ #define UnsigDiff u2.s21._unsigDiff #define Used InfoS.s11._used #define Uval u1._uVal #define Val u3._val #define ValMltplDef u2.s21._valMltplDef #define VariousD1 InfoD.s11._variousD1 #define InitFl VariousD1 #define NotUsedFl VariousD1 #define VariousD2 InfoD.s11._variousD2 #define ParalTypeFl VariousD2 #define _paralTypeFl _variousD2 #define _prioToCast _variousD2 #define VariousS1 InfoS.s11._variousS1 #define DeclInInHdr VariousS1 /* Extrn Obj */ #define InitBefUsd VariousS1 /* Auto/Reg Obj */ #define VariousS2 InfoS.s11._variousS2 #define Inner VariousS2 /* Label */ #define LclAd VariousS2 /* Obj (Ptr/Strun) */ #define UsedMorThOnce VariousS2 /* ParamMac */ #define VariousS3 InfoS.s11._variousS3 #define ForceUsed VariousS3 /* Param/Obj */ #define NotVisible VariousS3 /* Tags */ #define ReallyUsed VariousS3 /* ParamMac */ #define VariousS4 InfoS.s11._variousS4 #define NoErrTypInd VariousS4 /* Param/Obj (Array/Ptr) : to prevent multiple warnings on IndexType. */ #define PureBoolAskd VariousS4 /* Obj (Bool (may be inside Strun)) */ #define VariousS5 InfoS.s11._variousS5 #define Dmodfd VariousS5 /* Param/Obj (Array/Ptr/Strun) */ #define VariousS6 InfoS.s11._variousS6 #define CheckConst VariousS6 /* Obj (Array/Ptr) */ #define MayModif VariousS6 /* Param */ #define VariousS7 InfoS.s11._variousS7 #define SysElt VariousS7 /* Obj/Tags/EnumCst */ #define ResulPtr VariousS7 /* Param */ #define VariousS8 InfoS.s11._variousS8 #define StrunMdfd VariousS8 /* Obj (Strun) */ #define VariousT InfoT.s11._variousT #define PvNr VariousT /* Fct/VFct: PseudoVoid/NeverReturns */ #define VariousT1 InfoT.s11._variousT1 #define ErrSiz VariousT1 /* Array/Strun (to prevent multiple errors 'size = 0'). */ #define IntPoss VariousT1 /* EnumCst in sysHdrFiles */ #define LitCsta VariousT1 /* Num */ #define ResTypPoss VariousT1 /* Fct */ /* Shared typedefs */ typedef char Tchar; typedef const Tchar *Tstring; typedef Tchar *TstringNC; typedef Tchar TnbBuf1[Log10MaxLongNb +1+1+1]; /* possible sign, leading digit, ending '\0'. */ typedef TnbBuf1 TnbBuf; /* buffer type for bufLongToS() */ typedef Tchar TnameBuf1[MaxLgtId + 1]; typedef TnameBuf1 TnameBuf; /* buffer type for bufNameToS() */ typedef ubyte TnameAtom; /* for local representation of nameString (, , ). */ typedef const TnameAtom *CTname; typedef TnameAtom *TnameNC; typedef CTname Tname, TlitString; typedef int TnstLvl, TcharStream; typedef int TlineNb; /* negative after 'manageInclude()' */ typedef signed int TindentChk; /*~ TypeCombination TnstLvl*TindentChk->TindentChk */ typedef int TenumCst; /* must stay 'int', for enum constants of 'int' type */ typedef uint TdpNst, ThCode /*~LiteralCst*/, TmacLvl, TmacExpNb, TmsgParIndex /*~LiteralCst*/, TtokLvl; #ifdef LONGLONG typedef LONGLONG TcalcS; typedef unsigned LONGLONG TcalcU; #else typedef long TcalcS; typedef ulong TcalcU; #endif typedef enum {ObjectSpace, TagSpace, LabelSpace, StubSpace, DltdMac} TnameSpace; typedef enum {Terse=-1 /* for efficiency */, HalfVerbo, FullVerbo} Tverbo; typedef ulong Thistory /*~RootType*/; #define H_EMPTY (Thistory)0 #define H_ARROW H_EMPTY #define H_DOT (H_ARROW + 1) #define H_PTR (H_DOT + 1) #define H_ARRAY (H_PTR + 1) #define SizeHistElt 2 #define MskHistElt (((Thistory)1 << SizeHistElt) - 1) /*~ zif (H_ARRAY > MskHistElt) "Bad value for SizeHistElt" */ #define MaxHistDescr sizeof(Thistory)*CHAR_BIT/SizeHistElt typedef uint Tattrib /*~RootType*/; #define NoAttrib (Tattrib)0 /* here for efficiency; NoAttrib, Stati chked */ #define Stati (NoAttrib + 1) /* together (cf funcDef(), initOrSizFld()). */ #define Extrn (Stati + 1) /* Stati, Extrn checked together */ #define Typdf (Extrn + 1) /* Typdf, Extrn checked together (cf decl() ) */ #define Auto (Typdf + 1) #define Reg (Auto + 1) /* Extrn, Reg checked together (cf decl() ) */ #define StatiL (Reg + 1) /* 'local' static */ #define MaxAttrib StatiL /*~ zif ((int)MaxAttrib != EAttrib-BAttrib) "Pb with Tattrib" */ /*~ zif (Typdf!=NoAttrib+3 || Reg!=Extrn+3) "Constraints of Tattrib not heeded" */ typedef uint Tqualif /*~RootType*/; #define NoQualif (Tqualif)0 #define ConstQal (Tqualif)1 #define VolatQal (ConstQal << 1) #define MaxQualif (int)VolatQal #define IntDelType (int)DelType typedef enum { Void=0, Bool, Byte=Bool<<1, UByte=Byte<<1, Short=UByte<<1, UShort=Short<<1, Int=UShort<<1, UInt=Int<<1, Long=UInt<<1, ULong=Long<<1, #ifdef LONGLONG LLong=ULong<<1, ULLong=LLong<<1, #else LLong=Long /*~SameValue*/, ULLong=ULong /*~SameValue*/, #endif Float=ULLong<<1, Double=Float<<1, LongDbl=Double<<1, Enum=LongDbl<<1, DelType=Enum<<1, Ptr=DelType, Array=Ptr+IntDelType, /* Ptr/Array checked together (cf primQualif(), authzdType(). */ Fct=Array+IntDelType, VFct= #define X7FFF 0x7FFF #if INT_MAX == X7FFF ~INT_MAX /*~ zif Fct > X7FFF "Problem..." */ #else Fct+IntDelType #endif , /* Fct/VFct checked together (cf IsFct macro); Array/VFct checked together (cf IsArrFct macro, compatType()). */ Struct=VFct+IntDelType, Union=Struct+IntDelType /* Struct/Union checked together (cf IsStrun macro). */ } TtypeSort; /* TtypeSort constraint 1 : Fct, VFct, Struct, Union supposed to be last (see 'cast' check on types in term10(), see also expr(), exprN(). */ /*~ zif Fct != Void + __extent(TtypeSort) - IntDelType*3 "TtypeSort constraint 1 not heeded" */ /* TtypeSort constraint 2 : Array just after Ptr (see primQualif()/LPAR) */ /*~ zif Array != Ptr + IntDelType "TtypeSort constraint 2 not heeded" */ /* (Weak) TtypeSort constraint 3 : Enum just before DelType (see compatType(), typeToS(), NumBoolOther ). */ /*~ zif Enum != DelType >> 1 "TtypeSort constraint 3 not heeded" */ /* (Weak) TtypeSort constraint 4 : Array just before Fct (see IsArrFct macro); VFct just after Fct (see IsFct macro). */ /*~ zif VFct != Array + IntDelType*2 "TtypeSort constraint 4 not heeded" */ /* TtypeSort constraint 5 : 'Uxx' just after 'xx' (see computeCstType(), specialCaseOp(). */ /*~ zif UByte!=Byte<<1 || GapNxtVarie!=2 "TtypeSort constraint 5 not heeded" */ /* TtypeSort constraint 6 : arithmetic types to be adjacent, and in increasing width order (cf management of casts). */ #ifdef LONGLONG /*~ zif LongDbl-Byte != 0x1FFE "TtypeSort constraint 6 not heeded" */ #define PosDelT 15 #else /*~ zif LongDbl-Byte != 0x7FE "TtypeSort constraint 6 not heeded" */ #define PosDelT 13 #endif /*~ zif 1<= (Tattrib)1 << NbBitsAttrib) "Bad field size for storing attribute" */ #define NbBitsParQal 2 /*~ zif (MaxParQal >= (TparQal)1 << NbBitsParQal) "Bad field size for storing formal parameter d-qualifier" */ typedef union { struct { uint _fldSize:SmallestWdthInt; /* also to force efficient alignment */ /* *** Following fields must stay here and grouped (cf. TinfoDecl1) *** */ TparQal _parQal:NbBitsParQal; bool _memberFl:1; bool _declFl:1; bool _signedInt:1; /* *** Previous fields must stay there and grouped (cf. TinfoDecl1) *** */ Tattrib _attriba:NbBitsAttrib; /* *** Following fields must stay here and grouped (cf. TinfoDecl1) *** */ bool _fldFl:1; bool _noNewTypeFl:1; bool _variousD1:1; bool _variousD2:1; /* *** Previous fields must stay there and grouped (cf. TinfoDecl1) *** */ } s11; TallocUnit bid; } TinfoDecl; typedef union { struct { uint _fldSize:SmallestWdthInt; /* also to force efficient alignment */ uint _flags:NbBitsParQal+1+1+1; Tattrib _attriba:NbBitsAttrib; uint _flags1:1+1+1+1; } s11; TallocUnit bid; } TinfoDecl1; #undef NbBitsParQal typedef struct _tDeclElt TdeclElt; typedef TdeclElt *TpDeclElt; typedef TpDeclElt TdeclList; /* 'parallel' type, to differentiate a list from a pointer on elements of the list. */ struct _tDeclElt { Tname idName; ThCode hCode; TpTypeElt type; union { TinfoDecl _infoD; TinfoDecl1 _infoD1; } u1; TdeclList cdr; }; /*~ zif __bitoffset(((TdeclElt *)0)->InfoD.s11, _parQal)!=__bitoffset((( TdeclElt *)0)->InfoD1.s11, _flags) || __bitoffset(((TdeclElt *)0)->InfoD.s11, _attriba)!=__bitoffset((( TdeclElt *)0)->InfoD1.s11, _flags+) || __bitoffset(((TdeclElt *)0)->InfoD.s11, _fldFl)!=__bitoffset((( TdeclElt *)0)->InfoD1.s11, _flags1) || __bitoffset(((TdeclElt *)0)->InfoD.s11)!=__bitoffset(((TdeclElt *)0) ->InfoD1.s11, _flags1+) "Inconsistency between TinfoDecl and TinfoDecl1" */ #define NbBitsKind 3 /*~ zif MaxKind >= (Tkind)1<InfoS.s11, _dynInitCtr)!=__bitoffset((( TsemanElt *)0)->InfoS1.s11, _saved) || __bitoffset(((TsemanElt *)0)->InfoS.s11, _dynInitCtr+)!= __bitoffset(((TsemanElt *)0)->InfoS1.s11, _defnd) "Inconsistency between TinfoSeman and TinfoSeman1" */ #define NbBitsQualif 2 /*~ zif (MaxQualif >= 1<= (Talgn)1< incomplete type). */ /* *doIt* size in bits (for err in '>>', '<<') */ union { size_t _lim; /* Array: index limit (-(1U) if incorrect or non positive size-giving expression, 0 if unspecified). */ TsemanElt *_frstEnumCst; /* Enum */ TdeclList _memberList; /* Struct/Union (root element) */ TdeclList _paramList; /* Fct, VFct */ TqlfdElt *_pQlfdTypes; /* Ptr */ } u2; union { TpTypeElt _bndType; /* Array, Ptr: type of size-giving expression (NULL if invalid type). */ TsemanElt *_tagId; /* Struct/Union/Enum */ } u3; union { TpTypeElt _nextTE; /* points on next element of type chain, or, */ TsemanElt *_typeId; /* for 'parallel' type elements, on parallel type identifier. */ } u4; }; /*~ zif Offset(TtypeElt, NextTE) + sizeof(((TtypeElt*)0)->NextTE) != sizeof(TtypeElt) "Beware, freed typeElt may still be used..." */ /*~ zif __bitoffset(((TtypeElt *)0)->InfoT.s11, _paralTyp)!=__bitoffset((( TtypeElt *)0)->InfoT1.s11, _paralSysTpdf) || __bitoffset(((TtypeElt *)0)->InfoT.s11, _generic)!=__bitoffset((( TtypeElt *)0)->InfoT1.s11, _paralSysTpdf+) || __bitoffset(((TtypeElt *)0)->InfoT.s11, _generic)!=__bitoffset((( TtypeElt *)0)->InfoT1.s11, _flags) || __bitoffset(((TtypeElt *)0)->InfoT.s11, _noOwner)!=__bitoffset((( TtypeElt *)0)->InfoT1.s11, _flags+) "Inconsistency between TinfoType and TinfoType1" */ typedef union { ulong _eInfo; struct { Tattrib _pseudoAttrib: NbBitsAttrib; bool _rEvlbl: 1; /* True if constant expression */ bool _valMltplDef: 1; /* True if constant expression has several possible values. */ bool _errEvl: 1; /* True if error (overflow) occurred during evaluation. */ bool _cstImpsd: 1; /* True if type imposed by constant */ bool _lValFl: 1; /* True if operand has address */ bool _lEvlbl: 1; /* True if address is constant (for 'auto' class, if address stays constant during function evaluation). */ bool _lclAdr: 1; /* True if address inside stack */ bool _oldUsed:1; /* previous value of 'used' bit */ bool _litCst: 1; /* True if there exists an unnamed constant in expr */ bool _litCstOutsMac: 1;/* True if unnamed constant not found in macro */ bool _inhibWaNPB:1; /* True => inhibit warnings on 'notPureBool' */ bool _unsigDiff: 1; /* True if diff. of unsigned met in expression */ bool _pointedByObj: 1; /* True if expr. is pointed by 'ptrId' */ bool _pointingOnObj:1; /* True if expr. points on 'ptrId' */ bool _fctCallSeen:1; /* True if function result */ bool _fctCallSeen1:1; /* True if function call crossed */ bool _fctCallNoResTyp:1;/* True if non ~ResultType function result */ bool _artifType:1; /* True if function result is in fact 'void *' */ bool _sjVal:1; /* True if result of function 'setjmp' */ bool _sideEff:1; /* True if side-effect possible in that expression */ } s21; } TREInfo; typedef struct { TpTypeElt type; /* NULL indicates type error in expression */ TsemanElt *ptrId; /* pointer on (root) identifier */ Thistory hist; /* for objects not constants */ union { /* values of expression (if evaluable: flag 'xEvlbl' set) */ TcalcS _sVal; /* numeric value (if signed) */ TcalcU _uVal; /* numeric value (if unsigned) */ const char *_pVal; /* pointer value ('char *', so that it can be compared). */ } u1; Ttok topOper; /* top operator of the expression tree */ TmacLvl macLvl; TREInfo u2; } TresulExp; /*~ zif sizeof(((TresulExp *)0)->u2) > sizeof(ulong) "Einfo = 0 won't reset all bit fields in structure s21" */ #undef NbBitsAttrib typedef struct { Ttok tok; union { Tname _idName; bool _errorT; } u1; union { TsemanElt *_ptrSem; TcalcS _numVal; TpTypeElt _dpType; } u2; union { uint _val; ThCode _hCod; } u3; } TvalTok; #endif /* ifndef DC_TH */ /* End DC.TH */