diff options
Diffstat (limited to 'nim')
39 files changed, 5547 insertions, 574 deletions
diff --git a/nim/ast.pas b/nim/ast.pas index c84262db4..899554c4e 100644 --- a/nim/ast.pas +++ b/nim/ast.pas @@ -65,148 +65,148 @@ for key, val in enums.items(): cog.out(a) cog.out(b) ]]]*) -type - TTypeFlag = ( - tfVarargs, tfFinal, tfAcyclic, tfEnumHasWholes); - TTypeFlags = set of TTypeFlag; -const - TypeFlagToStr: array [TTypeFlag] of string = ( - 'tfVarargs', 'tfFinal', 'tfAcyclic', 'tfEnumHasWholes'); -type - TTypeKind = ( - tyNone, tyBool, tyChar, tyEmpty, - tyArrayConstr, tyNil, tyGeneric, tyGenericInst, - tyGenericParam, tyEnum, tyAnyEnum, tyArray, - tyObject, tyTuple, tySet, tyRange, - tyPtr, tyRef, tyVar, tySequence, - tyProc, tyPointer, tyOpenArray, tyString, - tyCString, tyForward, tyInt, tyInt8, - tyInt16, tyInt32, tyInt64, tyFloat, - tyFloat32, tyFloat64, tyFloat128); - TTypeKinds = set of TTypeKind; -const - TypeKindToStr: array [TTypeKind] of string = ( - 'tyNone', 'tyBool', 'tyChar', 'tyEmpty', - 'tyArrayConstr', 'tyNil', 'tyGeneric', 'tyGenericInst', - 'tyGenericParam', 'tyEnum', 'tyAnyEnum', 'tyArray', - 'tyObject', 'tyTuple', 'tySet', 'tyRange', - 'tyPtr', 'tyRef', 'tyVar', 'tySequence', - 'tyProc', 'tyPointer', 'tyOpenArray', 'tyString', - 'tyCString', 'tyForward', 'tyInt', 'tyInt8', - 'tyInt16', 'tyInt32', 'tyInt64', 'tyFloat', - 'tyFloat32', 'tyFloat64', 'tyFloat128'); -type - TSymFlag = ( - sfUsed, sfStar, sfMinus, sfInInterface, - sfFromGeneric, sfGlobal, sfForward, sfImportc, - sfExportc, sfVolatile, sfRegister, sfPure, - sfResult, sfNoSideEffect, sfMainModule, sfSystemModule, - sfNoReturn, sfAddrTaken, sfCompilerProc, sfCppMethod, - sfDiscriminant, sfDeprecated, sfInClosure, sfTypeCheck, - sfCompileTime, sfThreadVar, sfMerge); - TSymFlags = set of TSymFlag; -const - SymFlagToStr: array [TSymFlag] of string = ( - 'sfUsed', 'sfStar', 'sfMinus', 'sfInInterface', - 'sfFromGeneric', 'sfGlobal', 'sfForward', 'sfImportc', - 'sfExportc', 'sfVolatile', 'sfRegister', 'sfPure', - 'sfResult', 'sfNoSideEffect', 'sfMainModule', 'sfSystemModule', - 'sfNoReturn', 'sfAddrTaken', 'sfCompilerProc', 'sfCppMethod', - 'sfDiscriminant', 'sfDeprecated', 'sfInClosure', 'sfTypeCheck', - 'sfCompileTime', 'sfThreadVar', 'sfMerge'); -type - TNodeFlag = ( - nfNone, nfBase2, nfBase8, nfBase16, - nfAllConst, nfTransf, nfSem); - TNodeFlags = set of TNodeFlag; -const - NodeFlagToStr: array [TNodeFlag] of string = ( - 'nfNone', 'nfBase2', 'nfBase8', 'nfBase16', - 'nfAllConst', 'nfTransf', 'nfSem'); -type - TSymKind = ( - skUnknownSym, skConditional, skDynLib, skParam, - skTypeParam, skTemp, skType, skConst, - skVar, skProc, skIterator, skConverter, - skMacro, skTemplate, skField, skEnumField, - skForVar, skModule, skLabel, skStub); - TSymKinds = set of TSymKind; -const - SymKindToStr: array [TSymKind] of string = ( - 'skUnknownSym', 'skConditional', 'skDynLib', 'skParam', - 'skTypeParam', 'skTemp', 'skType', 'skConst', - 'skVar', 'skProc', 'skIterator', 'skConverter', - 'skMacro', 'skTemplate', 'skField', 'skEnumField', - 'skForVar', 'skModule', 'skLabel', 'skStub'); -type - TNodeKind = ( - nkNone, nkEmpty, nkIdent, nkSym, - nkType, nkCharLit, nkIntLit, nkInt8Lit, - nkInt16Lit, nkInt32Lit, nkInt64Lit, nkFloatLit, - nkFloat32Lit, nkFloat64Lit, nkStrLit, nkRStrLit, - nkTripleStrLit, nkMetaNode, nkNilLit, nkDotCall, - nkCommand, nkCall, nkGenericCall, nkExplicitTypeListCall, - nkExprEqExpr, nkExprColonExpr, nkIdentDefs, nkInfix, - nkPrefix, nkPostfix, nkPar, nkCurly, - nkBracket, nkBracketExpr, nkPragmaExpr, nkRange, - nkDotExpr, nkCheckedFieldExpr, nkDerefExpr, nkIfExpr, - nkElifExpr, nkElseExpr, nkLambda, nkAccQuoted, - nkHeaderQuoted, nkTableConstr, nkQualified, nkHiddenStdConv, - nkHiddenSubConv, nkHiddenCallConv, nkConv, nkCast, - nkAddr, nkHiddenAddr, nkHiddenDeref, nkObjDownConv, - nkObjUpConv, nkChckRangeF, nkChckRange64, nkChckRange, - nkStringToCString, nkCStringToString, nkPassAsOpenArray, nkAsgn, - nkDefaultTypeParam, nkGenericParams, nkFormalParams, nkOfInherit, - nkModule, nkProcDef, nkConverterDef, nkMacroDef, - nkTemplateDef, nkIteratorDef, nkOfBranch, nkElifBranch, - nkExceptBranch, nkElse, nkMacroStmt, nkAsmStmt, - nkPragma, nkIfStmt, nkWhenStmt, nkForStmt, - nkWhileStmt, nkCaseStmt, nkVarSection, nkConstSection, - nkConstDef, nkTypeSection, nkTypeDef, nkYieldStmt, - nkTryStmt, nkFinally, nkRaiseStmt, nkReturnStmt, - nkBreakStmt, nkContinueStmt, nkBlockStmt, nkDiscardStmt, - nkStmtList, nkImportStmt, nkFromStmt, nkImportAs, - nkIncludeStmt, nkAccessStmt, nkCommentStmt, nkStmtListExpr, - nkBlockExpr, nkStmtListType, nkBlockType, nkVm, - nkTypeOfExpr, nkObjectTy, nkTupleTy, nkRecList, - nkRecCase, nkRecWhen, nkRefTy, nkPtrTy, - nkVarTy, nkProcTy, nkEnumTy, nkEnumFieldDef, - nkReturnToken); - TNodeKinds = set of TNodeKind; -const - NodeKindToStr: array [TNodeKind] of string = ( - 'nkNone', 'nkEmpty', 'nkIdent', 'nkSym', - 'nkType', 'nkCharLit', 'nkIntLit', 'nkInt8Lit', - 'nkInt16Lit', 'nkInt32Lit', 'nkInt64Lit', 'nkFloatLit', - 'nkFloat32Lit', 'nkFloat64Lit', 'nkStrLit', 'nkRStrLit', - 'nkTripleStrLit', 'nkMetaNode', 'nkNilLit', 'nkDotCall', - 'nkCommand', 'nkCall', 'nkGenericCall', 'nkExplicitTypeListCall', - 'nkExprEqExpr', 'nkExprColonExpr', 'nkIdentDefs', 'nkInfix', - 'nkPrefix', 'nkPostfix', 'nkPar', 'nkCurly', - 'nkBracket', 'nkBracketExpr', 'nkPragmaExpr', 'nkRange', - 'nkDotExpr', 'nkCheckedFieldExpr', 'nkDerefExpr', 'nkIfExpr', - 'nkElifExpr', 'nkElseExpr', 'nkLambda', 'nkAccQuoted', - 'nkHeaderQuoted', 'nkTableConstr', 'nkQualified', 'nkHiddenStdConv', - 'nkHiddenSubConv', 'nkHiddenCallConv', 'nkConv', 'nkCast', - 'nkAddr', 'nkHiddenAddr', 'nkHiddenDeref', 'nkObjDownConv', - 'nkObjUpConv', 'nkChckRangeF', 'nkChckRange64', 'nkChckRange', - 'nkStringToCString', 'nkCStringToString', 'nkPassAsOpenArray', 'nkAsgn', - 'nkDefaultTypeParam', 'nkGenericParams', 'nkFormalParams', 'nkOfInherit', - 'nkModule', 'nkProcDef', 'nkConverterDef', 'nkMacroDef', - 'nkTemplateDef', 'nkIteratorDef', 'nkOfBranch', 'nkElifBranch', - 'nkExceptBranch', 'nkElse', 'nkMacroStmt', 'nkAsmStmt', - 'nkPragma', 'nkIfStmt', 'nkWhenStmt', 'nkForStmt', - 'nkWhileStmt', 'nkCaseStmt', 'nkVarSection', 'nkConstSection', - 'nkConstDef', 'nkTypeSection', 'nkTypeDef', 'nkYieldStmt', - 'nkTryStmt', 'nkFinally', 'nkRaiseStmt', 'nkReturnStmt', - 'nkBreakStmt', 'nkContinueStmt', 'nkBlockStmt', 'nkDiscardStmt', - 'nkStmtList', 'nkImportStmt', 'nkFromStmt', 'nkImportAs', - 'nkIncludeStmt', 'nkAccessStmt', 'nkCommentStmt', 'nkStmtListExpr', - 'nkBlockExpr', 'nkStmtListType', 'nkBlockType', 'nkVm', - 'nkTypeOfExpr', 'nkObjectTy', 'nkTupleTy', 'nkRecList', - 'nkRecCase', 'nkRecWhen', 'nkRefTy', 'nkPtrTy', - 'nkVarTy', 'nkProcTy', 'nkEnumTy', 'nkEnumFieldDef', - 'nkReturnToken'); +type + TNodeKind = ( + nkNone, nkEmpty, nkIdent, nkSym, + nkType, nkCharLit, nkIntLit, nkInt8Lit, + nkInt16Lit, nkInt32Lit, nkInt64Lit, nkFloatLit, + nkFloat32Lit, nkFloat64Lit, nkStrLit, nkRStrLit, + nkTripleStrLit, nkMetaNode, nkNilLit, nkDotCall, + nkCommand, nkCall, nkGenericCall, nkExplicitTypeListCall, + nkExprEqExpr, nkExprColonExpr, nkIdentDefs, nkInfix, + nkPrefix, nkPostfix, nkPar, nkCurly, + nkBracket, nkBracketExpr, nkPragmaExpr, nkRange, + nkDotExpr, nkCheckedFieldExpr, nkDerefExpr, nkIfExpr, + nkElifExpr, nkElseExpr, nkLambda, nkAccQuoted, + nkHeaderQuoted, nkTableConstr, nkQualified, nkHiddenStdConv, + nkHiddenSubConv, nkHiddenCallConv, nkConv, nkCast, + nkAddr, nkHiddenAddr, nkHiddenDeref, nkObjDownConv, + nkObjUpConv, nkChckRangeF, nkChckRange64, nkChckRange, + nkStringToCString, nkCStringToString, nkPassAsOpenArray, nkAsgn, + nkDefaultTypeParam, nkGenericParams, nkFormalParams, nkOfInherit, + nkModule, nkProcDef, nkConverterDef, nkMacroDef, + nkTemplateDef, nkIteratorDef, nkOfBranch, nkElifBranch, + nkExceptBranch, nkElse, nkMacroStmt, nkAsmStmt, + nkPragma, nkIfStmt, nkWhenStmt, nkForStmt, + nkWhileStmt, nkCaseStmt, nkVarSection, nkConstSection, + nkConstDef, nkTypeSection, nkTypeDef, nkYieldStmt, + nkTryStmt, nkFinally, nkRaiseStmt, nkReturnStmt, + nkBreakStmt, nkContinueStmt, nkBlockStmt, nkDiscardStmt, + nkStmtList, nkImportStmt, nkFromStmt, nkImportAs, + nkIncludeStmt, nkAccessStmt, nkCommentStmt, nkStmtListExpr, + nkBlockExpr, nkStmtListType, nkBlockType, nkVm, + nkTypeOfExpr, nkObjectTy, nkTupleTy, nkRecList, + nkRecCase, nkRecWhen, nkRefTy, nkPtrTy, + nkVarTy, nkProcTy, nkEnumTy, nkEnumFieldDef, + nkReturnToken); + TNodeKinds = set of TNodeKind; +const + NodeKindToStr: array [TNodeKind] of string = ( + 'nkNone', 'nkEmpty', 'nkIdent', 'nkSym', + 'nkType', 'nkCharLit', 'nkIntLit', 'nkInt8Lit', + 'nkInt16Lit', 'nkInt32Lit', 'nkInt64Lit', 'nkFloatLit', + 'nkFloat32Lit', 'nkFloat64Lit', 'nkStrLit', 'nkRStrLit', + 'nkTripleStrLit', 'nkMetaNode', 'nkNilLit', 'nkDotCall', + 'nkCommand', 'nkCall', 'nkGenericCall', 'nkExplicitTypeListCall', + 'nkExprEqExpr', 'nkExprColonExpr', 'nkIdentDefs', 'nkInfix', + 'nkPrefix', 'nkPostfix', 'nkPar', 'nkCurly', + 'nkBracket', 'nkBracketExpr', 'nkPragmaExpr', 'nkRange', + 'nkDotExpr', 'nkCheckedFieldExpr', 'nkDerefExpr', 'nkIfExpr', + 'nkElifExpr', 'nkElseExpr', 'nkLambda', 'nkAccQuoted', + 'nkHeaderQuoted', 'nkTableConstr', 'nkQualified', 'nkHiddenStdConv', + 'nkHiddenSubConv', 'nkHiddenCallConv', 'nkConv', 'nkCast', + 'nkAddr', 'nkHiddenAddr', 'nkHiddenDeref', 'nkObjDownConv', + 'nkObjUpConv', 'nkChckRangeF', 'nkChckRange64', 'nkChckRange', + 'nkStringToCString', 'nkCStringToString', 'nkPassAsOpenArray', 'nkAsgn', + 'nkDefaultTypeParam', 'nkGenericParams', 'nkFormalParams', 'nkOfInherit', + 'nkModule', 'nkProcDef', 'nkConverterDef', 'nkMacroDef', + 'nkTemplateDef', 'nkIteratorDef', 'nkOfBranch', 'nkElifBranch', + 'nkExceptBranch', 'nkElse', 'nkMacroStmt', 'nkAsmStmt', + 'nkPragma', 'nkIfStmt', 'nkWhenStmt', 'nkForStmt', + 'nkWhileStmt', 'nkCaseStmt', 'nkVarSection', 'nkConstSection', + 'nkConstDef', 'nkTypeSection', 'nkTypeDef', 'nkYieldStmt', + 'nkTryStmt', 'nkFinally', 'nkRaiseStmt', 'nkReturnStmt', + 'nkBreakStmt', 'nkContinueStmt', 'nkBlockStmt', 'nkDiscardStmt', + 'nkStmtList', 'nkImportStmt', 'nkFromStmt', 'nkImportAs', + 'nkIncludeStmt', 'nkAccessStmt', 'nkCommentStmt', 'nkStmtListExpr', + 'nkBlockExpr', 'nkStmtListType', 'nkBlockType', 'nkVm', + 'nkTypeOfExpr', 'nkObjectTy', 'nkTupleTy', 'nkRecList', + 'nkRecCase', 'nkRecWhen', 'nkRefTy', 'nkPtrTy', + 'nkVarTy', 'nkProcTy', 'nkEnumTy', 'nkEnumFieldDef', + 'nkReturnToken'); +type + TSymFlag = ( + sfUsed, sfStar, sfMinus, sfInInterface, + sfFromGeneric, sfGlobal, sfForward, sfImportc, + sfExportc, sfVolatile, sfRegister, sfPure, + sfResult, sfNoSideEffect, sfMainModule, sfSystemModule, + sfNoReturn, sfAddrTaken, sfCompilerProc, sfCppMethod, + sfDiscriminant, sfDeprecated, sfInClosure, sfTypeCheck, + sfCompileTime, sfThreadVar, sfMerge); + TSymFlags = set of TSymFlag; +const + SymFlagToStr: array [TSymFlag] of string = ( + 'sfUsed', 'sfStar', 'sfMinus', 'sfInInterface', + 'sfFromGeneric', 'sfGlobal', 'sfForward', 'sfImportc', + 'sfExportc', 'sfVolatile', 'sfRegister', 'sfPure', + 'sfResult', 'sfNoSideEffect', 'sfMainModule', 'sfSystemModule', + 'sfNoReturn', 'sfAddrTaken', 'sfCompilerProc', 'sfCppMethod', + 'sfDiscriminant', 'sfDeprecated', 'sfInClosure', 'sfTypeCheck', + 'sfCompileTime', 'sfThreadVar', 'sfMerge'); +type + TTypeKind = ( + tyNone, tyBool, tyChar, tyEmpty, + tyArrayConstr, tyNil, tyGeneric, tyGenericInst, + tyGenericParam, tyEnum, tyAnyEnum, tyArray, + tyObject, tyTuple, tySet, tyRange, + tyPtr, tyRef, tyVar, tySequence, + tyProc, tyPointer, tyOpenArray, tyString, + tyCString, tyForward, tyInt, tyInt8, + tyInt16, tyInt32, tyInt64, tyFloat, + tyFloat32, tyFloat64, tyFloat128); + TTypeKinds = set of TTypeKind; +const + TypeKindToStr: array [TTypeKind] of string = ( + 'tyNone', 'tyBool', 'tyChar', 'tyEmpty', + 'tyArrayConstr', 'tyNil', 'tyGeneric', 'tyGenericInst', + 'tyGenericParam', 'tyEnum', 'tyAnyEnum', 'tyArray', + 'tyObject', 'tyTuple', 'tySet', 'tyRange', + 'tyPtr', 'tyRef', 'tyVar', 'tySequence', + 'tyProc', 'tyPointer', 'tyOpenArray', 'tyString', + 'tyCString', 'tyForward', 'tyInt', 'tyInt8', + 'tyInt16', 'tyInt32', 'tyInt64', 'tyFloat', + 'tyFloat32', 'tyFloat64', 'tyFloat128'); +type + TNodeFlag = ( + nfNone, nfBase2, nfBase8, nfBase16, + nfAllConst, nfTransf, nfSem); + TNodeFlags = set of TNodeFlag; +const + NodeFlagToStr: array [TNodeFlag] of string = ( + 'nfNone', 'nfBase2', 'nfBase8', 'nfBase16', + 'nfAllConst', 'nfTransf', 'nfSem'); +type + TTypeFlag = ( + tfVarargs, tfFinal, tfAcyclic, tfEnumHasWholes); + TTypeFlags = set of TTypeFlag; +const + TypeFlagToStr: array [TTypeFlag] of string = ( + 'tfVarargs', 'tfFinal', 'tfAcyclic', 'tfEnumHasWholes'); +type + TSymKind = ( + skUnknownSym, skConditional, skDynLib, skParam, + skTypeParam, skTemp, skType, skConst, + skVar, skProc, skIterator, skConverter, + skMacro, skTemplate, skField, skEnumField, + skForVar, skModule, skLabel, skStub); + TSymKinds = set of TSymKind; +const + SymKindToStr: array [TSymKind] of string = ( + 'skUnknownSym', 'skConditional', 'skDynLib', 'skParam', + 'skTypeParam', 'skTemp', 'skType', 'skConst', + 'skVar', 'skProc', 'skIterator', 'skConverter', + 'skMacro', 'skTemplate', 'skField', 'skEnumField', + 'skForVar', 'skModule', 'skLabel', 'skStub'); {[[[end]]]} type @@ -219,43 +219,43 @@ type // if (i+1) % 6 == 0: cog.outl("") //cog.outl("m" + magics[-1]) //]]] - mNone, mDefined, mLow, mHigh, mSizeOf, mIs, - mSucc, mPred, mInc, mDec, mOrd, mNew, - mNewFinalize, mNewSeq, mRegisterFinalizer, mLengthOpenArray, mLengthStr, mLengthArray, - mLengthSeq, mIncl, mExcl, mCard, mChr, mGCref, - mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, - mAddI64, mSubI64, mMulI64, mDivI64, mModI64, mShrI, - mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, - mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, - mMaxI64, mAddF64, mSubF64, mMulF64, mDivF64, mMinF64, - mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, - mAddU64, mSubU64, mMulU64, mDivU64, mModU64, mEqI, - mLeI, mLtI, mEqI64, mLeI64, mLtI64, mEqF64, - mLeF64, mLtF64, mLeU, mLtU, mLeU64, mLtU64, - mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, - mEqB, mLeB, mLtB, mEqRef, mEqProc, mEqUntracedRef, - mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, - mAbsI, mAbsI64, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusI64, - mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, - mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, - mToU32, mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, - mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, - mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, - mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mSymDiffSet, - mConStrStr, mConArrArr, mConArrT, mConTArr, mConTT, mSlice, - mAppendStrCh, mAppendStrStr, mAppendSeqElem, mAppendSeqSeq, mInRange, mInSet, - mAsgn, mRepr, mExit, mSetLengthStr, mSetLengthSeq, mAssert, - mSwap, mIsNil, mArrToSeq, mArray, mOpenArray, mRange, - mSet, mSeq, mInt, mInt8, mInt16, mInt32, - mInt64, mFloat, mFloat32, mFloat64, mBool, mChar, - mString, mCstring, mPointer, mAnyEnum, mEmptySet, mIntSetBaseType, - mNil, mIsMainModule, mCompileDate, mCompileTime, mNimrodVersion, mNimrodMajor, - mNimrodMinor, mNimrodPatch, mCpuEndian, mNaN, mInf, mNegInf, - mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, - mNKind, mNIntVal, mNFloatVal, mNSymbol, mNIdent, mNGetType, - mNStrVal, mNSetIntVal, mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetType, - mNSetStrVal, mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mIdentToStr, - mEqIdent, mNHint, mNWarning, mNError + mNone, mDefined, mLow, mHigh, mSizeOf, mIs, + mSucc, mPred, mInc, mDec, mOrd, mNew, + mNewFinalize, mNewSeq, mRegisterFinalizer, mLengthOpenArray, mLengthStr, mLengthArray, + mLengthSeq, mIncl, mExcl, mCard, mChr, mGCref, + mGCunref, mAddI, mSubI, mMulI, mDivI, mModI, + mAddI64, mSubI64, mMulI64, mDivI64, mModI64, mShrI, + mShlI, mBitandI, mBitorI, mBitxorI, mMinI, mMaxI, + mShrI64, mShlI64, mBitandI64, mBitorI64, mBitxorI64, mMinI64, + mMaxI64, mAddF64, mSubF64, mMulF64, mDivF64, mMinF64, + mMaxF64, mAddU, mSubU, mMulU, mDivU, mModU, + mAddU64, mSubU64, mMulU64, mDivU64, mModU64, mEqI, + mLeI, mLtI, mEqI64, mLeI64, mLtI64, mEqF64, + mLeF64, mLtF64, mLeU, mLtU, mLeU64, mLtU64, + mEqEnum, mLeEnum, mLtEnum, mEqCh, mLeCh, mLtCh, + mEqB, mLeB, mLtB, mEqRef, mEqProc, mEqUntracedRef, + mLePtr, mLtPtr, mEqCString, mXor, mUnaryMinusI, mUnaryMinusI64, + mAbsI, mAbsI64, mNot, mUnaryPlusI, mBitnotI, mUnaryPlusI64, + mBitnotI64, mUnaryPlusF64, mUnaryMinusF64, mAbsF64, mZe8ToI, mZe8ToI64, + mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64, mToU8, mToU16, + mToU32, mToFloat, mToBiggestFloat, mToInt, mToBiggestInt, mCharToStr, + mBoolToStr, mIntToStr, mInt64ToStr, mFloatToStr, mCStrToStr, mStrToStr, + mAnd, mOr, mEqStr, mLeStr, mLtStr, mEqSet, + mLeSet, mLtSet, mMulSet, mPlusSet, mMinusSet, mSymDiffSet, + mConStrStr, mConArrArr, mConArrT, mConTArr, mConTT, mSlice, + mAppendStrCh, mAppendStrStr, mAppendSeqElem, mAppendSeqSeq, mInRange, mInSet, + mAsgn, mRepr, mExit, mSetLengthStr, mSetLengthSeq, mAssert, + mSwap, mIsNil, mArrToSeq, mArray, mOpenArray, mRange, + mSet, mSeq, mInt, mInt8, mInt16, mInt32, + mInt64, mFloat, mFloat32, mFloat64, mBool, mChar, + mString, mCstring, mPointer, mAnyEnum, mEmptySet, mIntSetBaseType, + mNil, mIsMainModule, mCompileDate, mCompileTime, mNimrodVersion, mNimrodMajor, + mNimrodMinor, mNimrodPatch, mCpuEndian, mNaN, mInf, mNegInf, + mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, + mNKind, mNIntVal, mNFloatVal, mNSymbol, mNIdent, mNGetType, + mNStrVal, mNSetIntVal, mNSetFloatVal, mNSetSymbol, mNSetIdent, mNSetType, + mNSetStrVal, mNNewNimNode, mNCopyNimNode, mNCopyNimTree, mStrToIdent, mIdentToStr, + mEqIdent, mNHint, mNWarning, mNError //[[[end]]] ); @@ -319,10 +319,10 @@ type locField, // location is a record field locArrayElem, // location is an array element locExpr, // "location" is really an expression - locImmediate, // location is an immediate value locProc, // location is a proc (an address of a procedure) locData, // location is a constant - locCall, // location is a call expression + locCall, // location is a call expression + locImmediate, // location is an immediate value locOther // location is something other ); @@ -351,9 +351,10 @@ type end; // ---------------- end of backend information ------------------------------ - TLibKind = (libHeader, libDynamic, libDynamicGenerated); + TLibKind = (libHeader, libDynamic); TLib = object(lists.TListEntry) // also misused for headers! kind: TLibKind; + generated: bool; // needed for the backends: name: PRope; path: string; @@ -476,43 +477,43 @@ const // "MagicToStr" array: // if (i+1) % 6 == 0: cog.outl("") //cog.outl("'%s'" % magics[-1]) //]]] - 'None', 'Defined', 'Low', 'High', 'SizeOf', 'Is', - 'Succ', 'Pred', 'Inc', 'Dec', 'Ord', 'New', - 'NewFinalize', 'NewSeq', 'RegisterFinalizer', 'LengthOpenArray', 'LengthStr', 'LengthArray', - 'LengthSeq', 'Incl', 'Excl', 'Card', 'Chr', 'GCref', - 'GCunref', 'AddI', 'SubI', 'MulI', 'DivI', 'ModI', - 'AddI64', 'SubI64', 'MulI64', 'DivI64', 'ModI64', 'ShrI', - 'ShlI', 'BitandI', 'BitorI', 'BitxorI', 'MinI', 'MaxI', - 'ShrI64', 'ShlI64', 'BitandI64', 'BitorI64', 'BitxorI64', 'MinI64', - 'MaxI64', 'AddF64', 'SubF64', 'MulF64', 'DivF64', 'MinF64', - 'MaxF64', 'AddU', 'SubU', 'MulU', 'DivU', 'ModU', - 'AddU64', 'SubU64', 'MulU64', 'DivU64', 'ModU64', 'EqI', - 'LeI', 'LtI', 'EqI64', 'LeI64', 'LtI64', 'EqF64', - 'LeF64', 'LtF64', 'LeU', 'LtU', 'LeU64', 'LtU64', - 'EqEnum', 'LeEnum', 'LtEnum', 'EqCh', 'LeCh', 'LtCh', - 'EqB', 'LeB', 'LtB', 'EqRef', 'EqProc', 'EqUntracedRef', - 'LePtr', 'LtPtr', 'EqCString', 'Xor', 'UnaryMinusI', 'UnaryMinusI64', - 'AbsI', 'AbsI64', 'Not', 'UnaryPlusI', 'BitnotI', 'UnaryPlusI64', - 'BitnotI64', 'UnaryPlusF64', 'UnaryMinusF64', 'AbsF64', 'Ze8ToI', 'Ze8ToI64', - 'Ze16ToI', 'Ze16ToI64', 'Ze32ToI64', 'ZeIToI64', 'ToU8', 'ToU16', - 'ToU32', 'ToFloat', 'ToBiggestFloat', 'ToInt', 'ToBiggestInt', 'CharToStr', - 'BoolToStr', 'IntToStr', 'Int64ToStr', 'FloatToStr', 'CStrToStr', 'StrToStr', - 'And', 'Or', 'EqStr', 'LeStr', 'LtStr', 'EqSet', - 'LeSet', 'LtSet', 'MulSet', 'PlusSet', 'MinusSet', 'SymDiffSet', - 'ConStrStr', 'ConArrArr', 'ConArrT', 'ConTArr', 'ConTT', 'Slice', - 'AppendStrCh', 'AppendStrStr', 'AppendSeqElem', 'AppendSeqSeq', 'InRange', 'InSet', - 'Asgn', 'Repr', 'Exit', 'SetLengthStr', 'SetLengthSeq', 'Assert', - 'Swap', 'IsNil', 'ArrToSeq', 'Array', 'OpenArray', 'Range', - 'Set', 'Seq', 'Int', 'Int8', 'Int16', 'Int32', - 'Int64', 'Float', 'Float32', 'Float64', 'Bool', 'Char', - 'String', 'Cstring', 'Pointer', 'AnyEnum', 'EmptySet', 'IntSetBaseType', - 'Nil', 'IsMainModule', 'CompileDate', 'CompileTime', 'NimrodVersion', 'NimrodMajor', - 'NimrodMinor', 'NimrodPatch', 'CpuEndian', 'NaN', 'Inf', 'NegInf', - 'NLen', 'NChild', 'NSetChild', 'NAdd', 'NAddMultiple', 'NDel', - 'NKind', 'NIntVal', 'NFloatVal', 'NSymbol', 'NIdent', 'NGetType', - 'NStrVal', 'NSetIntVal', 'NSetFloatVal', 'NSetSymbol', 'NSetIdent', 'NSetType', - 'NSetStrVal', 'NNewNimNode', 'NCopyNimNode', 'NCopyNimTree', 'StrToIdent', 'IdentToStr', - 'EqIdent', 'NHint', 'NWarning', 'NError' + 'None', 'Defined', 'Low', 'High', 'SizeOf', 'Is', + 'Succ', 'Pred', 'Inc', 'Dec', 'Ord', 'New', + 'NewFinalize', 'NewSeq', 'RegisterFinalizer', 'LengthOpenArray', 'LengthStr', 'LengthArray', + 'LengthSeq', 'Incl', 'Excl', 'Card', 'Chr', 'GCref', + 'GCunref', 'AddI', 'SubI', 'MulI', 'DivI', 'ModI', + 'AddI64', 'SubI64', 'MulI64', 'DivI64', 'ModI64', 'ShrI', + 'ShlI', 'BitandI', 'BitorI', 'BitxorI', 'MinI', 'MaxI', + 'ShrI64', 'ShlI64', 'BitandI64', 'BitorI64', 'BitxorI64', 'MinI64', + 'MaxI64', 'AddF64', 'SubF64', 'MulF64', 'DivF64', 'MinF64', + 'MaxF64', 'AddU', 'SubU', 'MulU', 'DivU', 'ModU', + 'AddU64', 'SubU64', 'MulU64', 'DivU64', 'ModU64', 'EqI', + 'LeI', 'LtI', 'EqI64', 'LeI64', 'LtI64', 'EqF64', + 'LeF64', 'LtF64', 'LeU', 'LtU', 'LeU64', 'LtU64', + 'EqEnum', 'LeEnum', 'LtEnum', 'EqCh', 'LeCh', 'LtCh', + 'EqB', 'LeB', 'LtB', 'EqRef', 'EqProc', 'EqUntracedRef', + 'LePtr', 'LtPtr', 'EqCString', 'Xor', 'UnaryMinusI', 'UnaryMinusI64', + 'AbsI', 'AbsI64', 'Not', 'UnaryPlusI', 'BitnotI', 'UnaryPlusI64', + 'BitnotI64', 'UnaryPlusF64', 'UnaryMinusF64', 'AbsF64', 'Ze8ToI', 'Ze8ToI64', + 'Ze16ToI', 'Ze16ToI64', 'Ze32ToI64', 'ZeIToI64', 'ToU8', 'ToU16', + 'ToU32', 'ToFloat', 'ToBiggestFloat', 'ToInt', 'ToBiggestInt', 'CharToStr', + 'BoolToStr', 'IntToStr', 'Int64ToStr', 'FloatToStr', 'CStrToStr', 'StrToStr', + 'And', 'Or', 'EqStr', 'LeStr', 'LtStr', 'EqSet', + 'LeSet', 'LtSet', 'MulSet', 'PlusSet', 'MinusSet', 'SymDiffSet', + 'ConStrStr', 'ConArrArr', 'ConArrT', 'ConTArr', 'ConTT', 'Slice', + 'AppendStrCh', 'AppendStrStr', 'AppendSeqElem', 'AppendSeqSeq', 'InRange', 'InSet', + 'Asgn', 'Repr', 'Exit', 'SetLengthStr', 'SetLengthSeq', 'Assert', + 'Swap', 'IsNil', 'ArrToSeq', 'Array', 'OpenArray', 'Range', + 'Set', 'Seq', 'Int', 'Int8', 'Int16', 'Int32', + 'Int64', 'Float', 'Float32', 'Float64', 'Bool', 'Char', + 'String', 'Cstring', 'Pointer', 'AnyEnum', 'EmptySet', 'IntSetBaseType', + 'Nil', 'IsMainModule', 'CompileDate', 'CompileTime', 'NimrodVersion', 'NimrodMajor', + 'NimrodMinor', 'NimrodPatch', 'CpuEndian', 'NaN', 'Inf', 'NegInf', + 'NLen', 'NChild', 'NSetChild', 'NAdd', 'NAddMultiple', 'NDel', + 'NKind', 'NIntVal', 'NFloatVal', 'NSymbol', 'NIdent', 'NGetType', + 'NStrVal', 'NSetIntVal', 'NSetFloatVal', 'NSetSymbol', 'NSetIdent', 'NSetType', + 'NSetStrVal', 'NNewNimNode', 'NCopyNimNode', 'NCopyNimTree', 'StrToIdent', 'IdentToStr', + 'EqIdent', 'NHint', 'NWarning', 'NError' //[[[end]]] ); @@ -629,18 +630,29 @@ function leValue(a, b: PNode): Boolean; // a <= b? a, b are literals function ValueToString(a: PNode): string; // ------------- efficient integer sets ------------------------------------- +{@ignore} +type + TBitScalar = int32; // FPC produces wrong code for ``int`` +{@emit +type + TBitScalar = int; } + const - IntsPerTrunk = 8; InitIntSetSize = 8; // must be a power of two! - BitsPerTrunk = IntsPerTrunk * sizeof(int) * 8; - BitsPerInt = sizeof(int) * 8; + TrunkShift = 9; + BitsPerTrunk = 1 shl TrunkShift; + // needs to be a power of 2 and divisible by 64 + TrunkMask = BitsPerTrunk-1; + IntsPerTrunk = BitsPerTrunk div (sizeof(TBitScalar)*8); + IntShift = 5+ord(sizeof(TBitScalar)=8); // 5 or 6, depending on int width + IntMask = 1 shl IntShift -1; type PTrunk = ^TTrunk; TTrunk = record next: PTrunk; // all nodes are connected with this pointer key: int; // start address at bit 0 - bits: array [0..IntsPerTrunk-1] of int; // a bit vector + bits: array [0..IntsPerTrunk-1] of TBitScalar; // a bit vector end; TTrunkSeq = array of PTrunk; TIntSet = record @@ -661,45 +673,9 @@ const procedure registerID(id: PIdObj); -// owner handling: -function getCurrOwner(): PSym; -procedure PushOwner(owner: PSym); -procedure PopOwner; - implementation var - gOwners: array of PSym; // owner stack (used for initializing the - // owner field of syms) - // the documentation comment always gets - // assigned to the current owner - // BUGFIX: global array is needed! -{@emit gOwners := @[]; } - -function getCurrOwner(): PSym; -begin - result := gOwners[high(gOwners)]; -end; - -procedure PushOwner(owner: PSym); -var - len: int; -begin - len := length(gOwners); - setLength(gOwners, len+1); - gOwners[len] := owner; -end; - -procedure PopOwner; -var - len: int; -begin - len := length(gOwners); - if (len <= 0) then InternalError('popOwner'); - setLength(gOwners, len - 1); -end; - -var usedIds: TIntSet; procedure registerID(id: PIdObj); @@ -1301,8 +1277,7 @@ begin result := nil end; -procedure IntSetRawInsert(const t: TIntSet; var data: TTrunkSeq; - desc: PTrunk); +procedure IntSetRawInsert(const t: TIntSet; var data: TTrunkSeq; desc: PTrunk); var h: int; begin @@ -1365,23 +1340,15 @@ end; // ---------- slightly higher level procs ---------------------------------- -function transform(key: int): int; -begin - if key < 0 then result := 1000000000 + key // avoid negative numbers! - else result := key -end; - function IntSetContains(const s: TIntSet; key: int): bool; var u: int; t: PTrunk; begin - u := transform(key); - t := IntSetGet(s, u div BitsPerTrunk); + t := IntSetGet(s, key shr TrunkShift); if t <> nil then begin - u := u mod BitsPerTrunk; - result := (t.bits[u div BitsPerInt] - and (1 shl (u mod BitsPerInt))) <> 0 + u := key and TrunkMask; + result := (t.bits[u shr IntShift] and (1 shl (u and IntMask))) <> 0 end else result := false @@ -1392,11 +1359,10 @@ var u: int; t: PTrunk; begin - u := transform(key); - t := IntSetPut(s, u div BitsPerTrunk); - u := u mod BitsPerTrunk; - t.bits[u div BitsPerInt] := t.bits[u div BitsPerInt] - or (1 shl (u mod BitsPerInt)); + t := IntSetPut(s, key shr TrunkShift); + u := key and TrunkMask; + t.bits[u shr IntShift] := t.bits[u shr IntShift] + or (1 shl (u and IntMask)); end; function IntSetContainsOrIncl(var s: TIntSet; key: int): bool; @@ -1404,22 +1370,35 @@ var u: int; t: PTrunk; begin - u := transform(key); - t := IntSetGet(s, u div BitsPerTrunk); + t := IntSetGet(s, key shr TrunkShift); if t <> nil then begin - u := u mod BitsPerTrunk; - result := (t.bits[u div BitsPerInt] - and (1 shl (u mod BitsPerInt))) <> 0; + u := key and TrunkMask; + result := (t.bits[u shr IntShift] and (1 shl (u and IntMask))) <> 0; if not result then - t.bits[u div BitsPerInt] := t.bits[u div BitsPerInt] - or (1 shl (u mod BitsPerInt)); + t.bits[u shr IntShift] := t.bits[u shr IntShift] + or (1 shl (u and IntMask)); end else begin IntSetIncl(s, key); result := false end end; - +(* +procedure IntSetDebug(const s: TIntSet); +var + it: PTrunk; + i, j: int; +begin + it := s.head; + while it <> nil do begin + for i := 0 to high(it.bits) do + for j := 0 to BitsPerInt-1 do begin + if (it.bits[j] and (1 shl j)) <> 0 then + MessageOut('Contains key: ' + toString(it.key + i * BitsPerInt + j)); + end; + it := it.next + end +end;*) initialization if debugIDs then IntSetInit(usedIds); diff --git a/nim/astalgo.pas b/nim/astalgo.pas index ddd646efb..0e31f4ac7 100644 --- a/nim/astalgo.pas +++ b/nim/astalgo.pas @@ -274,11 +274,12 @@ begin res := '"' + ''; for i := strStart to length(s)+strStart-1 do begin if (i-strStart+1) mod MaxLineLength = 0 then begin - res := res +{&} '"' +{&} nl; + addChar(res, '"'); + add(res, nl); app(result, toRope(res)); res := '"'+''; // reset end; - res := res +{&} toYamlChar(s[i]); + add(res, toYamlChar(s[i])); end; addChar(res, '"'); app(result, toRope(res)); diff --git a/nim/ccgexprs.pas b/nim/ccgexprs.pas index 97828680b..f94cff3a4 100644 --- a/nim/ccgexprs.pas +++ b/nim/ccgexprs.pas @@ -32,7 +32,7 @@ begin end; function genHexLiteral(v: PNode): PRope; -// hex literals are unsigned in C (at least I think so) +// hex literals are unsigned in C // so we don't generate hex literals any longer. begin if not (v.kind in [nkIntLit..nkInt64Lit]) then @@ -58,7 +58,13 @@ begin nkCharLit..nkInt64Lit: begin case skipVarGenericRange(ty).kind of tyChar, tyInt64, tyNil: result := intLiteral(v.intVal); - tyInt..tyInt32: begin + tyInt8: + result := ropef('((NI8) $1)', [intLiteral(biggestInt(int8(v.intVal)))]); + tyInt16: + result := ropef('((NI16) $1)', [intLiteral(biggestInt(int16(v.intVal)))]); + tyInt32: + result := ropef('((NI32) $1)', [intLiteral(biggestInt(int32(v.intVal)))]); + tyInt: begin if (v.intVal >= low(int32)) and (v.intVal <= high(int32)) then result := int32Literal(int32(v.intVal)) else @@ -436,8 +442,6 @@ begin InitLocExpr(p, e.sons[1], a); InitLocExpr(p, e.sons[2], b); appf(p.s[cpsStmts], frmt, [rdLoc(a), rdLoc(b)]); - freeTemp(p, a); - freeTemp(p, b) end; procedure unaryStmt(p: BProc; e: PNode; var d: TLoc; @@ -449,7 +453,6 @@ begin if magic <> '' then useMagic(p.module, magic); InitLocExpr(p, e.sons[1], a); appf(p.s[cpsStmts], frmt, [rdLoc(a)]); - freeTemp(p, a); end; procedure binaryStmtChar(p: BProc; e: PNode; var d: TLoc; @@ -462,8 +465,6 @@ begin InitLocExpr(p, e.sons[1], a); InitLocExpr(p, e.sons[2], b); appf(p.s[cpsStmts], frmt, [rdCharLoc(a), rdCharLoc(b)]); - freeTemp(p, a); - freeTemp(p, b) end; procedure binaryExpr(p: BProc; e: PNode; var d: TLoc; @@ -476,12 +477,7 @@ begin assert(e.sons[2].typ <> nil); InitLocExpr(p, e.sons[1], a); InitLocExpr(p, e.sons[2], b); - putIntoDest(p, d, e.typ, - ropef(frmt, [rdLoc(a), rdLoc(b), getTypeDesc(p.module, e.typ)])); - if d.k <> locExpr then begin // BACKPORT - freeTemp(p, a); - freeTemp(p, b) - end + putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdLoc(b)])); end; procedure binaryExprChar(p: BProc; e: PNode; var d: TLoc; @@ -495,10 +491,6 @@ begin InitLocExpr(p, e.sons[1], a); InitLocExpr(p, e.sons[2], b); putIntoDest(p, d, e.typ, ropef(frmt, [rdCharLoc(a), rdCharLoc(b)])); - if d.k <> locExpr then begin // BACKPORT - freeTemp(p, a); - freeTemp(p, b) - end end; procedure unaryExpr(p: BProc; e: PNode; var d: TLoc; @@ -508,10 +500,7 @@ var begin if magic <> '' then useMagic(p.module, magic); InitLocExpr(p, e.sons[1], a); - putIntoDest(p, d, e.typ, ropef(frmt, - [rdLoc(a), getTypeDesc(p.module, e.typ)])); - if d.k <> locExpr then // BACKPORT - freeTemp(p, a) + putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a)])); end; procedure unaryExprChar(p: BProc; e: PNode; var d: TLoc; @@ -522,26 +511,90 @@ begin if magic <> '' then useMagic(p.module, magic); InitLocExpr(p, e.sons[1], a); putIntoDest(p, d, e.typ, ropef(frmt, [rdCharLoc(a)])); - if d.k <> locExpr then // BACKPORT - freeTemp(p, a) end; +procedure binaryArithOverflow(p: BProc; e: PNode; var d: TLoc; m: TMagic); const - binOverflowTab: array [mAddi..mModi64] of string = ( + prc: array [mAddi..mModi64] of string = ( 'addInt', 'subInt', 'mulInt', 'divInt', 'modInt', 'addInt64', 'subInt64', 'mulInt64', 'divInt64', 'modInt64' ); - binWoOverflowTab: array [mAddi..mModi64] of string = ( - '($3)($1 + $2)', '($3)($1 - $2)', '($3)($1 * $2)', '($3)($1 / $2)', - '($3)($1 % $2)', - '($1 + $2)', '($1 - $2)', '($1 * $2)', '($1 / $2)', '($1 % $2)' + opr: array [mAddi..mModi64] of string = ( + '+'+'', '-'+'', '*'+'', '/'+'', '%'+'', + '+'+'', '-'+'', '*'+'', '/'+'', '%'+'' + ); +var + a, b: TLoc; + t: PType; +begin + assert(e.sons[1].typ <> nil); + assert(e.sons[2].typ <> nil); + InitLocExpr(p, e.sons[1], a); + InitLocExpr(p, e.sons[2], b); + t := skipGenericRange(e.typ); + if getSize(t) >= platform.IntSize then begin + if optOverflowCheck in p.options then begin + useMagic(p.module, prc[m]); + putIntoDest(p, d, e.typ, ropef('$1($2, $3)', + [toRope(prc[m]), rdLoc(a), rdLoc(b)])); + end + else + putIntoDest(p, d, e.typ, ropef('(NI$4)($2 $1 $3)', + [toRope(opr[m]), rdLoc(a), rdLoc(b), toRope(getSize(t)*8)])); + end + else begin + if optOverflowCheck in p.options then begin + useMagic(p.module, 'raiseOverflow'); + if (m = mModI) or (m = mDivI) then begin + useMagic(p.module, 'raiseDivByZero'); + appf(p.s[cpsStmts], 'if (!$1) raiseDivByZero();$n', [rdLoc(b)]); + end; + a.r := ropef('((NI)($2) $1 (NI)($3))', + [toRope(opr[m]), rdLoc(a), rdLoc(b)]); + if d.k = locNone then getTemp(p, getSysType(tyInt), d); + genAssignment(p, d, a, {@set}[]); + appf(p.s[cpsStmts], 'if ($1 < $2 || $1 > $3) raiseOverflow();$n', + [rdLoc(d), intLiteral(firstOrd(t)), intLiteral(lastOrd(t))]); + d.t := e.typ; + d.r := ropef('(NI$1)($2)', [toRope(getSize(t)*8), rdLoc(d)]); + end + else + putIntoDest(p, d, e.typ, ropef('(NI$4)($2 $1 $3)', + [toRope(opr[m]), rdLoc(a), rdLoc(b), toRope(getSize(t)*8)])); + end +end; + +procedure unaryArithOverflow(p: BProc; e: PNode; var d: TLoc; m: TMagic); +const + opr: array [mUnaryMinusI..mAbsI64] of string = ( + '((NI$2)-($1))', // UnaryMinusI + '-($1)', // UnaryMinusI64 + '(NI$2)abs($1)', // AbsI + '($1 > 0? ($1) : -($1))' // AbsI64 ); +var + a: TLoc; + t: PType; +begin + assert(e.sons[1].typ <> nil); + InitLocExpr(p, e.sons[1], a); + t := skipGenericRange(e.typ); + if optOverflowCheck in p.options then begin + useMagic(p.module, 'raiseOverflow'); + appf(p.s[cpsStmts], 'if ($1 == $2) raiseOverflow();$n', + [rdLoc(a), intLiteral(firstOrd(t))]); + end; + putIntoDest(p, d, e.typ, ropef(opr[m], [rdLoc(a), toRope(getSize(t)*8)])); +end; + +procedure binaryArith(p: BProc; e: PNode; var d: TLoc; op: TMagic); +const binArithTab: array [mShrI..mXor] of string = ( - '($3)((NU)($1) >> (NU)($2))', // ShrI - '($3)((NU)($1) << (NU)($2))', // ShlI - '($3)($1 & $2)', // BitandI - '($3)($1 | $2)', // BitorI - '($3)($1 ^ $2)', // BitxorI + '(NI$3)((NU$3)($1) >> (NU$3)($2))', // ShrI + '(NI$3)((NU$3)($1) << (NU$3)($2))', // ShlI + '(NI$3)($1 & $2)', // BitandI + '(NI$3)($1 | $2)', // BitorI + '(NI$3)($1 ^ $2)', // BitxorI '(($1 <= $2) ? $1 : $2)', // MinI '(($1 >= $2) ? $1 : $2)', // MaxI '(NI64)((NU64)($1) >> (NU64)($2))', // ShrI64 @@ -559,11 +612,11 @@ const '(($1 <= $2) ? $1 : $2)', // MinF64 '(($1 >= $2) ? $1 : $2)', // MaxF64 - '($3)((NU)($1) + (NU)($2))', // AddU - '($3)((NU)($1) - (NU)($2))', // SubU - '($3)((NU)($1) * (NU)($2))', // MulU - '($3)((NU)($1) / (NU)($2))', // DivU - '($3)((NU)($1) % (NU)($2))', // ModU + '(NI$3)((NU$3)($1) + (NU$3)($2))', // AddU + '(NI$3)((NU$3)($1) - (NU$3)($2))', // SubU + '(NI$3)((NU$3)($1) * (NU$3)($2))', // MulU + '(NI$3)((NU$3)($1) / (NU$3)($2))', // DivU + '(NI$3)((NU$3)($1) % (NU$3)($2))', // ModU '(NI64)((NU64)($1) + (NU64)($2))', // AddU64 '(NI64)((NU64)($1) - (NU64)($2))', // SubU64 '(NI64)((NU64)($1) * (NU64)($2))', // MulU64 @@ -580,8 +633,8 @@ const '($1 <= $2)', // LeF64 '($1 < $2)', // LtF64 - '((NU)($1) <= (NU)($2))', // LeU - '((NU)($1) < (NU)($2))', // LtU + '((NU$3)($1) <= (NU$3)($2))', // LeU + '((NU$3)($1) < (NU$3)($2))', // LtU '((NU64)($1) <= (NU64)($2))', // LeU64 '((NU64)($1) < (NU64)($2))', // LtU64 @@ -604,16 +657,32 @@ const '($1 != $2)' // Xor ); +var + a, b: TLoc; + s: biggestInt; +begin + assert(e.sons[1].typ <> nil); + assert(e.sons[2].typ <> nil); + InitLocExpr(p, e.sons[1], a); + InitLocExpr(p, e.sons[2], b); + // BUGFIX: cannot use result-type here, as it may be a boolean + s := max(getSize(a.t), getSize(b.t))*8; + putIntoDest(p, d, e.typ, ropef(binArithTab[op], + [rdLoc(a), rdLoc(b), toRope(s)])); +end; + +procedure unaryArith(p: BProc; e: PNode; var d: TLoc; op: TMagic); +const unArithTab: array [mNot..mToBiggestInt] of string = ( '!($1)', // Not '$1', // UnaryPlusI - '(($2) ~($1))', // BitnotI - '+($1)', // UnaryPlusI64 + '(NI$2)((NU$2) ~($1))', // BitnotI + '$1', // UnaryPlusI64 '~($1)', // BitnotI64 - '+($1)', // UnaryPlusF64 + '$1', // UnaryPlusF64 '-($1)', // UnaryMinusF64 - '($1 > 0? ($1) : -($1))', // AbsF64; BUGFIX: fabs() makes problems for Tiny C, so we don't use it - + '($1 > 0? ($1) : -($1))', // AbsF64; BUGFIX: fabs() makes problems + // for Tiny C, so we don't use it '((NI)(NU)(NU8)($1))', // mZe8ToI '((NI64)(NU64)(NU8)($1))', // mZe8ToI64 '((NI)(NU)(NU16)($1))', // mZe16ToI @@ -630,70 +699,15 @@ const 'float64ToInt32($1)', // ToInt XXX: this is not correct! 'float64ToInt64($1)' // ToBiggestInt ); - unOverflowTab: array [mUnaryMinusI..mAbsI64] of string = ( - 'negInt', // UnaryMinusI - 'negInt64', // UnaryMinusI64 - 'absInt', // AbsI - 'absInt64' // AbsI64 - ); - unWoOverflowTab: array [mUnaryMinusI..mAbsI64] of string = ( - '(($2)-($1))', // UnaryMinusI - '-($1)', // UnaryMinusI64 - '($2)abs($1)', // AbsI - '($1 > 0? ($1) : -($1))' // AbsI64 - ); - -procedure binaryArith(p: BProc; e: PNode; var d: TLoc; op: TMagic); -begin - binaryExpr(p, e, d, '', binArithTab[op]) -end; - -procedure binaryArithOverflow(p: BProc; e: PNode; var d: TLoc; op: TMagic); var - a, b: TLoc; -begin - if not (optOverflowCheck in p.options) then - binaryExpr(p, e, d, '', binWoOverflowTab[op]) - else begin - case op of - mAddi..mModi: begin - if (skipGeneric(e.typ).kind = tyInt) then - binaryExpr(p, e, d, binOverflowTab[op], - binOverflowTab[op] + '($1, $2)') - else begin - InitLocExpr(p, e.sons[1], a); - InitLocExpr(p, e.sons[2], b); - UseMagic(p.module, binOverflowTab[op]); - UseMagic(p.module, 'raiseOverflow'); - a.r := ropef(binOverflowTab[op] + '($1, $2)', - [rdLoc(a), rdLoc(b)]); - if d.k = locNone then getTemp(p, getSysType(tyInt), d); - genAssignment(p, d, a, {@set}[]); - appf(p.s[cpsStmts], 'if ($1 < $2 || $1 > $3) raiseOverflow();$n', - [rdLoc(d), intLiteral(firstOrd(e.typ)), - intLiteral(lastOrd(e.typ))]); - d.t := e.typ; - d.r := ropef('($1)($2)', [getTypeDesc(p.module, e.typ), rdLoc(d)]); - end - end; - mAddi64..mModi64: - binaryExpr(p, e, d, binOverflowTab[op], binOverflowTab[op] + '($1, $2)'); - else InternalError(e.info, 'binaryArithOverflow'); - end - end -end; - -procedure unaryArith(p: BProc; e: PNode; var d: TLoc; op: TMagic); -begin - unaryExpr(p, e, d, '', unArithTab[op]) -end; - -procedure unaryArithOverflow(p: BProc; e: PNode; var d: TLoc; op: TMagic); + a: TLoc; + t: PType; begin - if optOverflowCheck in p.options then - unaryExpr(p, e, d, unOverflowTab[op], '($2)' + unOverflowTab[op] + '($1)') - else - unaryExpr(p, e, d, '', unWoOverflowTab[op]) + assert(e.sons[1].typ <> nil); + InitLocExpr(p, e.sons[1], a); + t := skipGenericRange(e.typ); + putIntoDest(p, d, e.typ, ropef(unArithTab[op], + [rdLoc(a), toRope(getSize(t)*8)])); end; procedure genDeref(p: BProc; e: PNode; var d: TLoc); @@ -707,7 +721,7 @@ begin case skipGeneric(a.t).kind of tyRef: d.s := OnHeap; tyVar: d.s := OnUnknown; - tyPtr: d.s := OnStack; + tyPtr: d.s := OnUnknown; // BUGFIX! else InternalError(e.info, 'genDeref ' + typekindToStr[a.t.kind]); end; putIntoDest(p, d, a.t.sons[0], ropef('(*$1)', [rdLoc(a)])); @@ -723,7 +737,6 @@ begin else begin InitLocExpr(p, e.sons[0], a); putIntoDest(p, d, e.typ, addrLoc(a)); - if d.k <> locExpr then freeTemp(p, a) end end; @@ -834,7 +847,7 @@ begin ty := skipPtrsGeneric(skipVarGenericRange(a.t)); first := intLiteral(firstOrd(ty)); // emit range check: - if (optBoundsCheck in p.options) then + if (optBoundsCheck in p.options) then begin if b.k <> locImmediate then begin // semantic pass has already checked: useMagic(p.module, 'raiseIndexError'); if firstOrd(ty) = 0 then begin @@ -848,11 +861,10 @@ begin 'if ($1 < $2 || $1 > $3) raiseIndexError();$n', [rdCharLoc(b), first, intLiteral(lastOrd(ty))]) end; + end; if d.k = locNone then d.s := a.s; putIntoDest(p, d, elemType(skipVarGeneric(ty)), ropef('$1[($2)-$3]', [rdLoc(a), rdCharLoc(b), first])); - // freeTemp(p, a); // backport - // freeTemp(p, b) end; procedure genCStringElem(p: BProc; e: PNode; var d: TLoc); @@ -866,8 +878,6 @@ begin if d.k = locNone then d.s := a.s; putIntoDest(p, d, elemType(skipVarGeneric(ty)), ropef('$1[$2]', [rdLoc(a), rdCharLoc(b)])); - // freeTemp(p, a); // backport - // freeTemp(p, b) end; procedure genOpenArrayElem(p: BProc; e: PNode; var d: TLoc); @@ -880,13 +890,12 @@ begin if (optBoundsCheck in p.options) then begin useMagic(p.module, 'raiseIndexError'); appf(p.s[cpsStmts], - 'if ((NU)($1) > (NU)($2Len0)) raiseIndexError();$n', [rdLoc(b), rdLoc(a)]) + 'if ((NU)($1) >= (NU)($2Len0)) raiseIndexError();$n', [rdLoc(b), rdLoc(a)]) + // BUGFIX: ``>=`` and not ``>``! end; if d.k = locNone then d.s := a.s; putIntoDest(p, d, elemType(skipVarGeneric(a.t)), ropef('$1[$2]', [rdLoc(a), rdCharLoc(b)])); - // freeTemp(p, a); // backport - // freeTemp(p, b) end; procedure genSeqElem(p: BPRoc; e: PNode; var d: TLoc); @@ -915,8 +924,6 @@ begin a.r := ropef('(*$1)', [a.r]); putIntoDest(p, d, elemType(skipVarGeneric(a.t)), ropef('$1->data[$2]', [rdLoc(a), rdCharLoc(b)])); - // freeTemp(p, a); // backport - // freeTemp(p, b) end; procedure genAndOr(p: BProc; e: PNode; var d: TLoc; m: TMagic); @@ -955,10 +962,8 @@ begin fixLabel(p, L); if d.k = locNone then d := tmp - else begin + else genAssignment(p, d, tmp, {@set}[]); // no need for deep copying - freeTemp(p, tmp); - end end; procedure genIfExpr(p: BProc; n: PNode; var d: TLoc); @@ -989,7 +994,6 @@ begin initLocExpr(p, it.sons[0], a); Lelse := getLabel(p); appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Lelse]); - freeTemp(p, a); expr(p, it.sons[1], tmp); appf(p.s[cpsStmts], 'goto $1;$n', [Lend]); fixLabel(p, Lelse); @@ -1003,10 +1007,8 @@ begin fixLabel(p, Lend); if d.k = locNone then d := tmp - else begin + else genAssignment(p, d, tmp, {@set}[]); // no need for deep copying - freeTemp(p, tmp); - end end; procedure genCall(p: BProc; t: PNode; var d: TLoc); @@ -1111,14 +1113,10 @@ begin appf(p.s[cpsStmts], '$1 = rawNewString($2$3);$n', [tmp.r, lens, toRope(L)]); app(p.s[cpsStmts], appends); - for i := 0 to high(a) do - freeTemp(p, a[i]); if d.k = locNone then d := tmp - else begin + else genAssignment(p, d, tmp, {@set}[]); // no need for deep copying - freeTemp(p, tmp); // BACKPORT - end end; procedure genStrAppend(p: BProc; e: PNode; var d: TLoc); @@ -1170,8 +1168,6 @@ begin appf(p.s[cpsStmts], '$1 = resizeString($1, $2$3);$n', [rdLoc(a[0]), lens, toRope(L)]); app(p.s[cpsStmts], appends); - for i := 0 to high(a) do - freeTemp(p, a[i]) end; procedure genSeqElemAppend(p: BProc; e: PNode; var d: TLoc); @@ -1376,8 +1372,6 @@ begin [addrLoc(a), genTypeInfo(p.module, t)])) end end; - if d.k <> locExpr then - freeTemp(p, a); end; procedure genDollar(p: BProc; n: PNode; var d: TLoc; const magic, frmt: string); @@ -1441,8 +1435,6 @@ begin '$1 = ($3) setLengthSeq(&($1)->Sup, sizeof($4), $2);$n', [rdLoc(a), rdLoc(b), getTypeDesc(p.module, t), getTypeDesc(p.module, t.sons[0])]); - freeTemp(p, a); - freeTemp(p, b) end; procedure genSetLengthStr(p: BProc; e: PNode; var d: TLoc); @@ -1464,7 +1456,6 @@ begin genAssignment(p, tmp, a, {@set}[]); genAssignment(p, a, b, {@set}[]); genAssignment(p, b, tmp, {@set}[]); - freeTemp(p, tmp); // BACKPORT end; // -------------------- set operations ------------------------------------ @@ -1496,10 +1487,6 @@ procedure binaryExprIn(p: BProc; e: PNode; var a, b, d: TLoc; const frmt: string); begin putIntoDest(p, d, e.typ, ropef(frmt, [rdLoc(a), rdSetElemLoc(b, a.t)])); - if d.k <> locExpr then begin - freeTemp(p, a); - freeTemp(p, b) - end end; procedure genInExprAux(p: BProc; e: PNode; var a, b, d: TLoc); @@ -1521,8 +1508,6 @@ begin InitLocExpr(p, e.sons[1], a); InitLocExpr(p, e.sons[2], b); appf(p.s[cpsStmts], frmt, [rdLoc(a), rdSetElemLoc(b, a.t)]); - freeTemp(p, a); - freeTemp(p, b) end; procedure genInOp(p: BProc; e: PNode; var d: TLoc); @@ -1557,10 +1542,6 @@ begin end; app(b.r, ')'+''); putIntoDest(p, d, e.typ, b.r); - if d.k <> locExpr then begin - for i := 0 to high(c) do freeTemp(p, c[i]); - freeTemp(p, a) - end end else begin assert(e.sons[1].typ <> nil); @@ -1635,9 +1616,6 @@ begin if d.k = locNone then getTemp(p, a.t, d); appf(p.s[cpsStmts], lookupOpr[op], [rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b)]); - freeTemp(p, a); - freeTemp(p, b); - freeTemp(p, i) end; mEqSet: binaryExprChar(p, e, d, '', @@ -1652,9 +1630,6 @@ begin 'for ($1 = 0; $1 < $2; $1++) $n' + ' $3[$1] = $4[$1] $6 $5[$1];$n', [rdLoc(i), toRope(size), rdLoc(d), rdLoc(a), rdLoc(b), toRope(lookupOpr[op])]); - freeTemp(p, a); - freeTemp(p, b); - freeTemp(p, i) end; mInSet: genInOp(p, e, d); else internalError(e.info, 'genSetOp') @@ -1686,7 +1661,6 @@ begin else putIntoDest(p, d, e.typ, ropef('(($1) ($2))', [getTypeDesc(p.module, e.typ), rdCharLoc(a)])); - if d.k <> locExpr then freeTemp(p, a) end; procedure genRangeChck(p: BProc; n: PNode; var d: TLoc; const magic: string); @@ -1704,11 +1678,11 @@ begin InitLocExpr(p, n.sons[0], a); useMagic(p.module, magic); putIntoDest(p, d, dest, - ropef('(($1)' +{&} magic +{&} '($2, $3, $4))', + ropef('(($1)$5($2, $3, $4))', [getTypeDesc(p.module, dest), rdCharLoc(a), genLiteral(p, n.sons[1], dest), - genLiteral(p, n.sons[2], dest)])); - if d.k <> locExpr then freeTemp(p, a) + genLiteral(p, n.sons[2], dest), + toRope(magic)])); end end; @@ -1722,19 +1696,25 @@ var a: TLoc; dest: PType; begin + while n.sons[0].kind = nkPassAsOpenArray do + n.sons[0] := n.sons[0].sons[0]; // BUGFIX dest := skipVarGeneric(n.typ); - initLocExpr(p, n.sons[0], a); - case skipVarGeneric(a.t).kind of - tyOpenArray: + case skipVarGeneric(n.sons[0].typ).kind of + tyOpenArray: begin + initLocExpr(p, n.sons[0], a); putIntoDest(p, d, dest, ropef('$1, $1Len0', [rdLoc(a)])); - tyString, tySequence: + end; + tyString, tySequence: begin + initLocExpr(p, n.sons[0], a); putIntoDest(p, d, dest, ropef('$1->data, $1->Sup.len', [rdLoc(a)])); - tyArray, tyArrayConstr: + end; + tyArray, tyArrayConstr: begin + initLocExpr(p, n.sons[0], a); putIntoDest(p, d, dest, ropef('$1, $2', [rdLoc(a), toRope(lengthOrd(a.t))])); + end else InternalError(n.sons[0].info, 'passToOpenArray: ' + typeToString(a.t)) - end; - if d.k <> locExpr then freeTemp(p, a) + end end; procedure convStrToCStr(p: BProc; n: PNode; var d: TLoc); @@ -1743,7 +1723,6 @@ var begin initLocExpr(p, n.sons[0], a); putIntoDest(p, d, skipVarGeneric(n.typ), ropef('$1->data', [rdLoc(a)])); - if d.k <> locExpr then freeTemp(p, a) end; procedure convCStrToStr(p: BProc; n: PNode; var d: TLoc); @@ -1754,7 +1733,6 @@ begin initLocExpr(p, n.sons[0], a); putIntoDest(p, d, skipVarGeneric(n.typ), ropef('cstrToNimstr($1)', [rdLoc(a)])); - if d.k <> locExpr then freeTemp(p, a) end; procedure genStrEquals(p: BProc; e: PNode; var d: TLoc); @@ -1846,7 +1824,6 @@ begin InitLocExpr(p, e.sons[1], a); assert(a.t <> nil); expr(p, e.sons[2], a); - freeTemp(p, a) end; mSwap: genSwap(p, e, d); mPred: begin // XXX: range checking? @@ -1978,15 +1955,11 @@ begin '$2[$1/8] |=(1<<($1%8));$n', [rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), rdSetElemLoc(b, e.typ)]); - freeTemp(p, a); - freeTemp(p, b); - freeTemp(p, idx) end else begin initLocExpr(p, e.sons[i], a); appf(p.s[cpsStmts], '$1[$2/8] |=(1<<($2%8));$n', [rdLoc(d), rdSetElemLoc(a, e.typ)]); - freeTemp(p, a) end end end @@ -2003,9 +1976,6 @@ begin '$2 |=(1<<((' +{&} ts +{&} ')($1)%(sizeof(' +{&}ts+{&}')*8)));$n', [rdLoc(idx), rdLoc(d), rdSetElemLoc(a, e.typ), rdSetElemLoc(b, e.typ)]); - freeTemp(p, a); - freeTemp(p, b); - freeTemp(p, idx) end else begin initLocExpr(p, e.sons[i], a); @@ -2013,7 +1983,6 @@ begin '$1 |=(1<<((' +{&} ts +{&} ')($2)%(sizeof(' +{&}ts+{&} ')*8)));$n', [rdLoc(d), rdSetElemLoc(a, e.typ)]); - freeTemp(p, a) end end end @@ -2191,7 +2160,8 @@ begin nkStrLit..nkTripleStrLit, nkIntLit..nkInt64Lit, nkFloatLit..nkFloat64Lit, nkNilLit, nkCharLit: begin putIntoDest(p, d, e.typ, genLiteral(p, e)); - d.k := locImmediate // for removal of index checks + if d.k in [locNone, locExpr] then + d.k := locImmediate // for removal of index checks end; nkCall, nkHiddenCallConv, nkInfix, nkPrefix, nkPostfix, nkCommand: begin if (e.sons[0].kind = nkSym) and diff --git a/nim/ccgstmts.pas b/nim/ccgstmts.pas index b00751edd..0e93d6b0f 100644 --- a/nim/ccgstmts.pas +++ b/nim/ccgstmts.pas @@ -141,7 +141,6 @@ begin initLocExpr(p, it.sons[0], a); Lelse := getLabel(p); appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Lelse]); - freeTemp(p, a); genStmts(p, it.sons[1]); if sonsLen(n) > 1 then appf(p.s[cpsStmts], 'goto $1;$n', [Lend]); @@ -179,7 +178,6 @@ begin p.blocks[len].id := abs(p.blocks[len].id); appf(p.s[cpsStmts], 'if (!$1) goto $2;$n', [rdLoc(a), Labl]); end; - freeTemp(p, a); genStmts(p, t.sons[1]); if p.blocks[len].id > 0 then appf(p.s[cpsStmts], '} $1: ;$n', [Labl]) @@ -286,7 +284,6 @@ begin if gCmd <> cmdCompileToCpp then useMagic(p.module, 'raiseException'); InitLocExpr(p, t.sons[0], a); e := rdLoc(a); - freeTemp(p, a); typ := t.sons[0].typ; while typ.kind in [tyVar, tyRef, tyPtr] do typ := typ.sons[0]; appf(p.s[cpsStmts], getRaiseFrmt(p), @@ -306,10 +303,11 @@ end; // ---------------- case statement generation ----------------------------- const - stringCaseThreshold = 1000; //4; // above X strings a hash-switch for strings - // is generated - // this version sets it too high to avoid hashing, because the hashing - // algorithm won't be the same; I don't know why + stringCaseThreshold = 100000; + // above X strings a hash-switch for strings is generated + // this version sets it too high to avoid hashing, because this has not + // been tested for a long time + // XXX test and enable this optimization! procedure genCaseGenericBranch(p: BProc; b: PNode; const e: TLoc; const rangeFormat, eqFormat: TFormatStr; @@ -323,14 +321,11 @@ begin if b.sons[i].kind = nkRange then begin initLocExpr(p, b.sons[i].sons[0], x); initLocExpr(p, b.sons[i].sons[1], y); - freeTemp(p, x); - freeTemp(p, y); appf(p.s[cpsStmts], rangeFormat, [rdCharLoc(e), rdCharLoc(x), rdCharLoc(y), labl]) end else begin initLocExpr(p, b.sons[i], x); - freeTemp(p, x); appf(p.s[cpsStmts], eqFormat, [rdCharLoc(e), rdCharLoc(x), labl]) end @@ -377,7 +372,6 @@ begin end; // second pass: generate statements genCaseSecondPass(p, t, labId); - freeTemp(p, a) end; {@ignore} @@ -402,24 +396,24 @@ begin b := 0; for i := 0 to Length(s)-1 do begin b := b +{%} Ord(s[i]); - b := b +{%} b shl 10; - b := b xor (b shr 6) + b := b +{%} shlu(b, 10); + b := b xor shru(b, 6) end; - b := b +{%} b shl 3; - b := b xor (b shr 11); - b := b +{%} b shl 15; + b := b +{%} shlu(b, 3); + b := b xor shru(b, 11); + b := b +{%} shlu(b, 15); result := b end else begin a := 0; for i := 0 to Length(s)-1 do begin a := a +{%} int32(Ord(s[i])); - a := a +{%} a shl int32(10); - a := a xor (a shr int32(6)); + a := a +{%} shlu(a, int32(10)); + a := a xor shru(a, int32(6)); end; - a := a +{%} a shl int32(3); - a := a xor (a shr int32(11)); - a := a +{%} a shl int32(15); + a := a +{%} shlu(a, int32(3)); + a := a xor shru(a, int32(11)); + a := a +{%} shlu(a, int32(15)); result := a end end; @@ -448,7 +442,6 @@ begin for i := 0 to len - 2 do begin assert(b.sons[i].kind <> nkRange); initLocExpr(p, b.sons[i], x); - freeTemp(p, x); assert(b.sons[i].kind in [nkStrLit..nkTripleStrLit]); j := int(hashString(b.sons[i].strVal) and high(branches)); appf(branches[j], 'if (eqStrings($1, $2)) goto $3;$n', @@ -499,7 +492,6 @@ begin appf(p.s[cpsStmts], 'goto LA$1;$n', [toRope(p.labels)]); // third pass: generate statements genCaseSecondPass(p, t, labId); - freeTemp(p, a); end else genCaseGeneric(p, t, '', 'if (eqStrings($1, $2)) goto $3;$n') @@ -541,7 +533,6 @@ begin if canGenerateSwitch then begin initLocExpr(p, t.sons[0], a); appf(p.s[cpsStmts], 'switch ($1) {$n', [rdCharLoc(a)]); - freeTemp(p, a); for i := 1 to sonsLen(t)-1 do begin if t.sons[i].kind = nkOfBranch then begin len := sonsLen(t.sons[i]); @@ -823,7 +814,6 @@ begin InitLocExpr(p, e.sons[0], a); assert(a.t <> nil); expr(p, e.sons[1], a); - freeTemp(p, a) end; procedure genStmts(p: BProc; t: PNode); @@ -852,13 +842,11 @@ begin nkCall: begin genLineDir(p, t); initLocExpr(p, t, a); - freeTemp(p, a); end; nkAsgn: genAsgn(p, t); nkDiscardStmt: begin genLineDir(p, t); initLocExpr(p, t.sons[0], a); - freeTemp(p, a) end; nkAsmStmt: genAsmStmt(p, t); nkTryStmt: begin @@ -880,8 +868,11 @@ begin if (t.sons[codePos] <> nil) or (lfDynamicLib in prc.loc.flags) then begin // BUGFIX if IntSetContainsOrIncl(p.module.debugDeclared, prc.id) then begin - internalError(t.info, 'genProc()'); // XXX: remove this check! + internalError(t.info, 'genStmts(): ' + toString(prc.id)); + // XXX: remove this check! end; + //if IntSetContains(p.module.debugDeclared, 2642) then + // InternalError(t.info, 'this sucks ' + toString(prc.id)); genProc(p.module, prc) end //else if sfCompilerProc in prc.flags then genProcPrototype(prc); diff --git a/nim/ccgtypes.pas b/nim/ccgtypes.pas index 2c238ce84..5f4def667 100644 --- a/nim/ccgtypes.pas +++ b/nim/ccgtypes.pas @@ -33,7 +33,10 @@ begin 'A'..'Z': addChar(result, chr(ord(name[i]) - ord('A') + ord('a'))); '_': begin end; 'a'..'z', '0'..'9': addChar(result, name[i]); - else result := result + 'HEX' +{&} toHex(ord(name[i]), 2); + else begin + add(result, 'HEX'); + add(result, toHex(ord(name[i]), 2)) + end end end end; @@ -92,6 +95,7 @@ begin 1: result := ctUInt8; 2: result := ctUInt16; 4: result := ctInt32; + 8: result := ctInt64; else internalError('mapType'); end end @@ -284,8 +288,10 @@ begin 1: result := typeNameOrLiteral(typ, 'NU8'); 2: result := typeNameOrLiteral(typ, 'NU16'); 4: result := typeNameOrLiteral(typ, 'NI32'); + 8: result := typeNameOrLiteral(typ, 'NI64'); else begin - internalError('getSimpleTypeDesc()'); + internalError(typ.sym.info, + 'getSimpleTypeDesc: ' + toString(getSize(typ))); result := nil end end @@ -885,7 +891,7 @@ begin dataGen := true end; tyObject: begin - if sfPure in t.sym.flags then + if isPureObject(t) then id := getID() else begin id := t.id; @@ -943,7 +949,7 @@ begin genEnumInfo(m, t, ropef('NTI$1', [toRope(t.id)])); end; tyObject: begin - if not (sfPure in t.sym.flags) then begin + if not isPureObject(t) then begin useMagic(m, 'TNimType'); useMagic(m, 'TNimNode'); genObjectInfo(m, t, ropef('NTI$1', [toRope(t.id)])); diff --git a/nim/ccgutils.pas b/nim/ccgutils.pas index 8e3775d22..05f2ea828 100644 --- a/nim/ccgutils.pas +++ b/nim/ccgutils.pas @@ -39,7 +39,7 @@ begin if key = nil then exit; case key.Kind of tyEmpty, tyChar, tyBool, tyNil, tyPointer, tyString, tyCString, - tyInt..tyFloat128, tyProc, tyEnum, tyObject, tyAnyEnum: begin end; + tyInt..tyFloat128, tyProc, tyAnyEnum: begin end; tyNone, tyForward: InternalError('GetUniqueType: ' + typeToString(key)); tyGenericParam, tyGeneric, tySequence, @@ -54,6 +54,13 @@ begin end; IdTablePut(gTypeTable, key, key); end; + tyObject, tyEnum: begin + result := PType(IdTableGet(gTypeTable, key)); + if result = nil then begin + IdTablePut(gTypeTable, key, key); + result := key; + end + end; tyGenericInst: result := GetUniqueType(lastSon(key)); end; end; @@ -102,11 +109,14 @@ begin res := '"'+''; for i := strStart to length(s)+strStart-1 do begin if (i-strStart+1) mod MaxLineLength = 0 then begin - res := res +{&} '"' +{&} nl; - app(result, toRope(res)); - res := '"'+''; // reset + add(res, '"'); + add(res, nl); + app(result, toRope(res)); + // reset: + setLength(res, 1); + res[strStart] := '"'; end; - res := res +{&} toCChar(s[i]); + add(res, toCChar(s[i])); end; addChar(res, '"'); app(result, toRope(res)); diff --git a/nim/cgen.pas b/nim/cgen.pas index 2f89c4208..736d4b796 100644 --- a/nim/cgen.pas +++ b/nim/cgen.pas @@ -207,10 +207,6 @@ begin result.flags := {@set}[]; end; -procedure freeTemp(p: BProc; const temp: TLoc); -begin -end; - // -------------------------- Variable manager ---------------------------- procedure declareGlobalVar(m: BModule; s: PSym); @@ -318,8 +314,8 @@ var tmp: PRope; begin assert(lib <> nil); - if lib.kind = libDynamic then begin - lib.kind := libDynamicGenerated; + if not lib.generated then begin + lib.generated := true; useMagic(m, 'nimLoadLibrary'); useMagic(m, 'nimUnloadLibrary'); useMagic(m, 'NimStringDesc'); diff --git a/nim/condsyms.pas b/nim/condsyms.pas index c018a37ea..9c5d64d4b 100644 --- a/nim/condsyms.pas +++ b/nim/condsyms.pas @@ -102,6 +102,7 @@ begin case targetCPU of cpuI386: DefineSymbol('x86'); cpuIa64: DefineSymbol('itanium'); + cpuAmd64: DefineSymbol('x8664'); else begin end end; case targetOS of diff --git a/nim/crc.pas b/nim/crc.pas index 429f0ec30..e14716605 100644 --- a/nim/crc.pas +++ b/nim/crc.pas @@ -126,7 +126,8 @@ const function updateCrc32(val: Byte; crc: TCrc32): TCrc32; overload; begin - result := crc32Table[(int(crc) xor (int(val) and $ff)) and $ff] xor (int(crc) shr 8); + result := TCrc32(crc32Table[(int(crc) xor (int(val) and $ff)) and $ff]) xor + (crc shr TCrc32(8)); end; function updateCrc32(val: Char; crc: TCrc32): TCrc32; overload; diff --git a/nim/debugids.pas b/nim/debugids.pas new file mode 100644 index 000000000..fff9ed10b --- /dev/null +++ b/nim/debugids.pas @@ -0,0 +1,129 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit debugids; + +interface + +{$include 'config.inc'} + +uses + nsystem, nos, strutils, ast; + +const + idfile = 'debugids.txt'; + +// This module implements debugging facilities for the ID mechanism. +procedure registerID(s: PSym); + +procedure writeIDTable(); +procedure loadIDTable(); + +implementation + +type + TIdSymTuple = record{@tuple} // keep id from sym to better detect bugs + id: int; + s: PSym; + end; + TIdSymTupleSeq = array of TIdSymTuple; + TIdSymTable = record + counter: int; + data: TIdSymTupleSeq; + end; + +function TableRawGet(const t: TTable; key: PObject): int; +var + h: THash; +begin + h := hashNode(key) and high(t.data); // start with real hash value + while t.data[h].key <> nil do begin + if (t.data[h].key = key) then begin + result := h; exit + end; + h := nextTry(h, high(t.data)) + end; + result := -1 +end; + +function TableSearch(const t: TTable; key, closure: PObject; + comparator: TCmpProc): PObject; +var + h: THash; +begin + h := hashNode(key) and high(t.data); // start with real hash value + while t.data[h].key <> nil do begin + if (t.data[h].key = key) then + if comparator(t.data[h].val, closure) then begin // BUGFIX 1 + result := t.data[h].val; exit + end; + h := nextTry(h, high(t.data)) + end; + result := nil +end; + +function TableGet(const t: TTable; key: PObject): PObject; +var + index: int; +begin + index := TableRawGet(t, key); + if index >= 0 then result := t.data[index].val + else result := nil +end; + +procedure TableRawInsert(var data: TPairSeq; key, val: PObject); +var + h: THash; +begin + h := HashNode(key) and high(data); + while data[h].key <> nil do begin + assert(data[h].key <> key); + h := nextTry(h, high(data)) + end; + assert(data[h].key = nil); + data[h].key := key; + data[h].val := val; +end; + +procedure TableEnlarge(var t: TTable); +var + n: TPairSeq; + i: int; +begin +{@ignore} + n := emptySeq; + setLength(n, length(t.data) * growthFactor); + fillChar(n[0], length(n)*sizeof(n[0]), 0); +{@emit + newSeq(n, length(t.data) * growthFactor); } + for i := 0 to high(t.data) do + if t.data[i].key <> nil then + TableRawInsert(n, t.data[i].key, t.data[i].val); +{@ignore} + t.data := n; +{@emit + swap(t.data, n); +} +end; + +procedure TablePut(var t: TTable; key, val: PObject); +var + index: int; +begin + index := TableRawGet(t, key); + if index >= 0 then + t.data[index].val := val + else begin + if mustRehash(length(t.data), t.counter) then TableEnlarge(t); + TableRawInsert(t.data, key, val); + inc(t.counter) + end; +end; + + +end. diff --git a/nim/depends.pas b/nim/depends.pas new file mode 100644 index 000000000..d8b978142 --- /dev/null +++ b/nim/depends.pas @@ -0,0 +1,97 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit depends; + +// This module implements a dependency file generator. + +interface + +{$include 'config.inc'} + +uses + nsystem, nos, options, ast, astalgo, msgs, ropes, idents, passes, importer; + +function genDependPass(): TPass; +procedure generateDot(const project: string); + +implementation + +type + TGen = object(TPassContext) + module: PSym; + filename: string; + end; + PGen = ^TGen; + +var + gDotGraph: PRope; // the generated DOT file; we need a global variable + +procedure addDependencyAux(const importing, imported: string); +begin + appf(gDotGraph, '$1 -> $2;$n', [toRope(importing), + toRope(imported)]); + // s1 -> s2_4 [label="[0-9]"]; +end; + +function addDotDependency(c: PPassContext; n: PNode): PNode; +var + i: int; + g: PGen; + imported: string; +begin + result := n; + if n = nil then exit; + g := PGen(c); + case n.kind of + nkImportStmt: begin + for i := 0 to sonsLen(n)-1 do begin + imported := getFileTrunk(getModuleFile(n.sons[i])); + addDependencyAux(g.module.name.s, imported); + end + end; + nkFromStmt: begin + imported := getFileTrunk(getModuleFile(n.sons[0])); + addDependencyAux(g.module.name.s, imported); + end; + nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: begin + for i := 0 to sonsLen(n)-1 do {@discard} addDotDependency(c, n.sons[i]); + end + else begin end + end +end; + +procedure generateDot(const project: string); +begin + writeRope( + ropef('digraph $1 {$n$2}$n', [ + toRope(changeFileExt(extractFileName(project), '')), gDotGraph]), + changeFileExt(project, 'dot') ); +end; + +function myOpen(module: PSym; const filename: string): PPassContext; +var + g: PGen; +begin + new(g); +{@ignore} + fillChar(g^, sizeof(g^), 0); +{@emit} + g.module := module; + g.filename := filename; + result := g; +end; + +function gendependPass(): TPass; +begin + initPass(result); + result.open := myOpen; + result.process := addDotDependency; +end; + +end. diff --git a/nim/docgen.pas b/nim/docgen.pas index fd835db57..19dc93a91 100644 --- a/nim/docgen.pas +++ b/nim/docgen.pas @@ -209,10 +209,10 @@ end; procedure addXmlChar(var dest: string; c: Char); begin case c of - '&': dest := dest + '&'; - '<': dest := dest + '<'; - '>': dest := dest + '>'; - '"': dest := dest + '"'; + '&': add(dest, '&'); + '<': add(dest, '<'); + '>': add(dest, '>'); + '"': add(dest, '"'); else addChar(dest, c) end end; @@ -292,8 +292,7 @@ var a, h: PRstNode; begin inc(d.id); - result := ropef('<em id="$1">$2</em>', - [toRope(d.id), renderAux(d, n)]); + result := ropef('<em id="$1">$2</em>', [toRope(d.id), renderAux(d, n)]); h := newRstNode(rnHyperlink); a := newRstNode(rnLeaf, d.indexValFilename +{&} '#' +{&} toString(d.id)); addSon(h, a); @@ -709,8 +708,8 @@ begin g.len+g.start-1+strStart)); else appf(result, '<span class="$2">$1</span>', - [toRope(ncopy(m.text, g.start+strStart, - g.len+g.start-1+strStart)), + [toRope(toXml(ncopy(m.text, g.start+strStart, + g.len+g.start-1+strStart))), toRope(tokenClassToStr[g.kind])]); end; end; diff --git a/nim/evals.pas b/nim/evals.pas new file mode 100644 index 000000000..bb14f8be9 --- /dev/null +++ b/nim/evals.pas @@ -0,0 +1,1308 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit evals; + +// This file implements the evaluator for Nimrod code. +// The evaluator is very slow, but simple. Since this +// is used mainly for evaluating macros and some other +// stuff at compile time, performance is not that +// important. + +interface + +{$include 'config.inc'} + +uses + sysutils, nsystem, charsets, strutils, magicsys, + lists, options, ast, astalgo, trees, treetab, nimsets, + msgs, nos, condsyms, idents, rnimsyn, types, passes, semfold; + +type + PStackFrame = ^TStackFrame; + TStackFrame = record + mapping: TIdNodeTable; // mapping from symbols to nodes + prc: PSym; // current prc; proc that is evaluated + call: PNode; // current for stmt + next: PStackFrame; // for stacking + params: TNodeSeq; // parameters passed to the proc + end; + + TEvalContext = object(passes.TPassContext) + module: PSym; + tos: PStackFrame; // top of a tos tos + lastException: PNode; + end; + PEvalContext = ^TEvalContext; + +function newStackFrame(): PStackFrame; +procedure pushStackFrame(c: PEvalContext; t: PStackFrame); +procedure popStackFrame(c: PEvalContext); + +function newEvalContext(module: PSym; const filename: string): PEvalContext; + +function eval(c: PEvalContext; n: PNode): PNode; +// eval never returns nil! This simplifies the code a lot and +// makes it faster too. + +function evalPass(): TPass; + +implementation + +const + evalMaxIterations = 10000000; // max iterations of all loops + evalMaxRecDepth = 100000; // max recursion depth for evaluation + +var + emptyNode: PNode; + +function newStackFrame(): PStackFrame; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + initIdNodeTable(result.mapping); +{@emit result.params := @[];} +end; + +function newEvalContext(module: PSym; const filename: string): PEvalContext; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + result.module := module; +end; + +procedure pushStackFrame(c: PEvalContext; t: PStackFrame); +begin + t.next := c.tos; + c.tos := t; +end; + +procedure popStackFrame(c: PEvalContext); +begin + if (c.tos = nil) then InternalError('popStackFrame'); + c.tos := c.tos.next; +end; + +function evalAux(c: PEvalContext; n: PNode): PNode; forward; + +procedure stackTraceAux(x: PStackFrame); +begin + if x <> nil then begin + stackTraceAux(x.next); + messageOut(format('file: $1, line: $2', [toFilename(x.call.info), + toString(toLineNumber(x.call.info))])); + end +end; + +procedure stackTrace(c: PEvalContext; n: PNode; msg: TMsgKind; + const arg: string = ''); +begin + messageOut('stack trace: (most recent call last)'); + stackTraceAux(c.tos); + liMessage(n.info, msg, arg); +end; + +function evalIf(c: PEvalContext; n: PNode): PNode; +var + i, len: int; +begin + i := 0; + len := sonsLen(n); + while (i < len) and (sonsLen(n.sons[i]) >= 2) do begin + result := evalAux(c, n.sons[i].sons[0]); + if result.kind = nkExceptBranch then exit; + if (result.kind = nkIntLit) and (result.intVal <> 0) then begin + result := evalAux(c, n.sons[i].sons[1]); + exit + end; + inc(i) + end; + if (i < len) and (sonsLen(n.sons[i]) < 2) then // eval else-part + result := evalAux(c, n.sons[0]) + else + result := emptyNode +end; + +function evalCase(c: PEvalContext; n: PNode): PNode; +var + i, j: int; + res: PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + res := result; + result := emptyNode; + for i := 1 to sonsLen(n)-1 do begin + if n.sons[i].kind = nkOfBranch then begin + for j := 0 to sonsLen(n.sons[i])-2 do begin + if overlap(res, n.sons[i].sons[j]) then begin + result := evalAux(c, lastSon(n.sons[i])); + exit + end + end + end + else begin + result := evalAux(c, lastSon(n.sons[i])); + end + end; +end; + +var + gWhileCounter: int; // Use a counter to prevend endless loops! + // We make this counter global, because otherwise + // nested loops could make the compiler extremely slow. + gNestedEvals: int; // count the recursive calls to ``evalAux`` to prevent + // endless recursion + +function evalWhile(c: PEvalContext; n: PNode): PNode; +begin + while true do begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + if getOrdValue(result) = 0 then break; + result := evalAux(c, n.sons[1]); + case result.kind of + nkBreakStmt: begin + if result.sons[0] = nil then begin + result := emptyNode; // consume ``break`` token + break + end + end; + nkExceptBranch, nkReturnToken: break; + else begin end + end; + dec(gWhileCounter); + if gWhileCounter <= 0 then begin + stackTrace(c, n, errTooManyIterations); + break; + end + end +end; + +function evalBlock(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkBreakStmt then begin + if result.sons[0] <> nil then begin + assert(result.sons[0].kind = nkSym); + if n.sons[0] <> nil then begin + assert(n.sons[0].kind = nkSym); + if result.sons[0].sym.id = n.sons[0].sym.id then + result := emptyNode + end + end + else + result := emptyNode // consume ``break`` token + end +end; + +function evalFinally(c: PEvalContext; n, exc: PNode): PNode; +var + finallyNode: PNode; +begin + finallyNode := lastSon(n); + if finallyNode.kind = nkFinally then begin + result := evalAux(c, finallyNode); + if result.kind <> nkExceptBranch then + result := exc + end + else + result := exc +end; + +function evalTry(c: PEvalContext; n: PNode): PNode; +var + exc: PNode; + i, j, len, blen: int; +begin + result := evalAux(c, n.sons[0]); + case result.kind of + nkBreakStmt, nkReturnToken: begin end; + nkExceptBranch: begin + // exception token! + exc := result; + i := 1; + len := sonsLen(n); + while (i < len) and (n.sons[i].kind = nkExceptBranch) do begin + blen := sonsLen(n.sons[i]); + if blen = 1 then begin + // general except section: + result := evalAux(c, n.sons[i].sons[0]); + exc := result; + break + end + else begin + for j := 0 to blen-2 do begin + assert(n.sons[i].sons[j].kind = nkType); + if exc.typ.id = n.sons[i].sons[j].typ.id then begin + result := evalAux(c, n.sons[i].sons[blen-1]); + exc := result; + break + end + end + end; + inc(i); + end; + result := evalFinally(c, n, exc); + end; + else + result := evalFinally(c, n, emptyNode); + end +end; + +function getNullValue(typ: PType; const info: TLineInfo): PNode; +var + i: int; + t: PType; +begin + t := skipGenericRange(typ); + result := emptyNode; + case t.kind of + tyBool, tyChar, tyInt..tyInt64: result := newNodeIT(nkIntLit, info, t); + tyFloat..tyFloat128: result := newNodeIt(nkFloatLit, info, t); + tyVar, tyPointer, tyPtr, tyRef, tyCString, tySequence, tyString: + result := newNodeIT(nkNilLit, info, t); + tyObject: begin + result := newNodeIT(nkPar, info, t); + internalError(info, 'init to implement'); + end; + tyArray, tyArrayConstr: begin + result := newNodeIT(nkBracket, info, t); + for i := 0 to int(lengthOrd(t))-1 do + addSon(result, getNullValue(elemType(t), info)); + end; + tyTuple: begin + result := newNodeIT(nkPar, info, t); + for i := 0 to sonsLen(t)-1 do + addSon(result, getNullValue(t.sons[i], info)); + end; + else InternalError('getNullValue') + end +end; + +function evalVar(c: PEvalContext; n: PNode): PNode; +var + i: int; + v: PSym; + a: PNode; +begin + for i := 0 to sonsLen(n)-1 do begin + a := n.sons[i]; + if a.kind = nkCommentStmt then continue; + assert(a.kind = nkIdentDefs); + assert(a.sons[0].kind = nkSym); + v := a.sons[0].sym; + if a.sons[2] <> nil then begin + result := evalAux(c, a.sons[2]); + if result.kind = nkExceptBranch then exit; + end + else + result := getNullValue(a.sons[0].typ, a.sons[0].info); + IdNodeTablePut(c.tos.mapping, v, result); + end; + result := emptyNode; +end; + +function evalCall(c: PEvalContext; n: PNode): PNode; +var + d: PStackFrame; + prc: PNode; + i: int; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + prc := result; + // bind the actual params to the local parameter + // of a new binding + d := newStackFrame(); + d.call := n; + if prc.kind = nkSym then begin + d.prc := prc.sym; + if not (prc.sym.kind in [skProc, skConverter]) then + InternalError(n.info, 'evalCall'); + end; + setLength(d.params, sonsLen(n)); + for i := 1 to sonsLen(n)-1 do begin + result := evalAux(c, n.sons[i]); + if result.kind = nkExceptBranch then exit; + d.params[i] := result; + end; + if n.typ <> nil then d.params[0] := getNullValue(n.typ, n.info); + pushStackFrame(c, d); + result := evalAux(c, prc); + if n.typ <> nil then result := d.params[0]; + popStackFrame(c); +end; + +function evalVariable(c: PStackFrame; sym: PSym): PNode; +// We need to return a node to the actual value, +// which can be modified. +var + x: PStackFrame; +begin + x := c; + while x <> nil do begin + if sfResult in sym.flags then begin + result := x.params[0]; + exit + end; + result := IdNodeTableGet(x.mapping, sym); + if result <> nil then exit; + x := x.next + end; + result := emptyNode; +end; + +function evalArrayAccess(c: PEvalContext; n: PNode): PNode; +var + x: PNode; + idx: biggestInt; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + idx := getOrdValue(result); + result := emptyNode; + case x.kind of + nkBracket, nkPar, nkMetaNode: begin + if (idx >= 0) and (idx < sonsLen(x)) then + result := x.sons[int(idx)] + else + stackTrace(c, n, errIndexOutOfBounds); + end; + nkStrLit..nkTripleStrLit: begin + result := newNodeIT(nkCharLit, x.info, getSysType(tyChar)); + if (idx >= 0) and (idx < length(x.strVal)) then + result.intVal := ord(x.strVal[int(idx)+strStart]) + else if idx = length(x.strVal) then begin end + else + stackTrace(c, n, errIndexOutOfBounds); + end; + else + stackTrace(c, n, errIndexNoIntType); + end +end; + +function evalFieldAccess(c: PEvalContext; n: PNode): PNode; +// a real field access; proc calls have already been +// transformed +// XXX: field checks! +var + x: PNode; + field: PSym; + i: int; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + if x.kind <> nkPar then InternalError(n.info, 'evalFieldAccess'); + field := n.sons[1].sym; + for i := 0 to sonsLen(n)-1 do begin + if x.sons[i].kind <> nkExprColonExpr then + InternalError(n.info, 'evalFieldAccess'); + if x.sons[i].sons[0].sym.name.id = field.id then begin + result := x.sons[i].sons[1]; exit + end + end; + stackTrace(c, n, errFieldXNotFound, field.name.s); + result := emptyNode; +end; + +function evalAsgn(c: PEvalContext; n: PNode): PNode; +var + x: PNode; + i: int; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + x.kind := result.kind; + x.typ := result.typ; + case x.kind of + nkCharLit..nkInt64Lit: x.intVal := result.intVal; + nkFloatLit..nkFloat64Lit: x.floatVal := result.floatVal; + nkStrLit..nkTripleStrLit: begin + x.strVal := result.strVal; + end + else begin + if not (x.kind in [nkEmpty..nkNilLit]) then begin + discardSons(x); + for i := 0 to sonsLen(result)-1 do addSon(x, result.sons[i]); + end + end + end; + result := emptyNode +end; + +function evalSwap(c: PEvalContext; n: PNode): PNode; +var + x: PNode; + i: int; + tmpi: biggestInt; + tmpf: biggestFloat; + tmps: string; + tmpn: PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if (x.kind <> result.kind) then + stackTrace(c, n, errCannotInterpretNodeX, nodeKindToStr[n.kind]) + else begin + case x.kind of + nkCharLit..nkInt64Lit: begin + tmpi := x.intVal; + x.intVal := result.intVal; + result.intVal := tmpi + end; + nkFloatLit..nkFloat64Lit: begin + tmpf := x.floatVal; + x.floatVal := result.floatVal; + result.floatVal := tmpf; + end; + nkStrLit..nkTripleStrLit: begin + tmps := x.strVal; + x.strVal := result.strVal; + result.strVal := tmps; + end + else begin + tmpn := copyTree(x); + discardSons(x); + for i := 0 to sonsLen(result)-1 do + addSon(x, result.sons[i]); + discardSons(result); + for i := 0 to sonsLen(tmpn)-1 do + addSon(result, tmpn.sons[i]); + end + end + end; + result := emptyNode +end; + +function evalSym(c: PEvalContext; n: PNode): PNode; +begin + case n.sym.kind of + skProc, skConverter, skMacro: result := n.sym.ast.sons[codePos]; + skVar, skForVar, skTemp: result := evalVariable(c.tos, n.sym); + skParam: result := c.tos.params[n.sym.position+1]; + skConst: result := n.sym.ast; + else begin + stackTrace(c, n, errCannotInterpretNodeX, symKindToStr[n.sym.kind]); + result := emptyNode + end + end; + if result = nil then InternalError(n.info, 'evalSym: ' + n.sym.name.s); +end; + +function evalIncDec(c: PEvalContext; n: PNode; sign: biggestInt): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkCharLit..nkInt64Lit: a.intval := a.intVal + sign * getOrdValue(b); + else internalError(n.info, 'evalIncDec'); + end; + result := emptyNode +end; + +function evalExit(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, hintQuitCalled); + halt(int(getOrdValue(result))); +end; + +function evalOr(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIntLit then InternalError(n.info, 'evalOr'); + if result.intVal = 0 then result := evalAux(c, n.sons[2]) +end; + +function evalAnd(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIntLit then InternalError(n.info, 'evalAnd'); + if result.intVal <> 0 then result := evalAux(c, n.sons[2]) +end; + +function evalNew(c: PEvalContext; n: PNode): PNode; +var + t: PType; +begin + t := skipVarGeneric(n.sons[1].typ); + result := newNodeIT(nkRefTy, n.info, t); + addSon(result, getNullValue(t.sons[0], n.info)); +end; + +function evalDeref(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkRefTy then InternalError(n.info, 'evalDeref'); + result := result.sons[0]; +end; + +function evalAddr(c: PEvalContext; n: PNode): PNode; +var + a: PNode; + t: PType; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkRefTy then InternalError(n.info, 'evalDeref'); + a := result; + t := newType(tyPtr, c.module); + addSon(t, a.typ); + result := newNodeIT(nkRefTy, n.info, t); + addSon(result, a); +end; + +function evalConv(c: PEvalContext; n: PNode): PNode; +begin + // hm, I cannot think of any conversions that need to be handled here... + result := evalAux(c, n.sons[1]); + result.typ := n.typ; +end; + +function evalCheckedFieldAccess(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); +end; + +function evalUpConv(c: PEvalContext; n: PNode): PNode; +var + dest, src: PType; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + dest := skipPtrsGeneric(n.typ); + src := skipPtrsGeneric(result.typ); + if inheritanceDiff(src, dest) > 0 then + stackTrace(c, n, errInvalidConversionFromTypeX, typeToString(src)); +end; + +function evalRangeChck(c: PEvalContext; n: PNode): PNode; +var + x, a, b: PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + x := result; + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + + if leValueConv(a, x) and leValueConv(x, b) then begin + result := x; // a <= x and x <= b + result.typ := n.typ + end + else + stackTrace(c, n, errGenerated, + format(msgKindToString(errIllegalConvFromXtoY), + [typeToString(n.sons[0].typ), typeToString(n.typ)])); +end; + +function evalConvStrToCStr(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + result.typ := n.typ; +end; + +function evalConvCStrToStr(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + result.typ := n.typ; +end; + +function evalRaise(c: PEvalContext; n: PNode): PNode; +var + a: PNode; +begin + if n.sons[0] <> nil then begin + result := evalAux(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkExceptBranch, n.info, a.typ); + addSon(result, a); + c.lastException := result; + end + else if c.lastException <> nil then + result := c.lastException + else begin + stackTrace(c, n, errExceptionAlreadyHandled); + result := newNodeIT(nkExceptBranch, n.info, nil); + addSon(result, nil); + end +end; + +function evalReturn(c: PEvalContext; n: PNode): PNode; +begin + if n.sons[0] <> nil then begin + result := evalAsgn(c, n.sons[0]); + if result.kind = nkExceptBranch then exit; + end; + result := newNodeIT(nkReturnToken, n.info, nil); +end; + +function evalProc(c: PEvalContext; n: PNode): PNode; +var + v: PSym; +begin + if n.sons[genericParamsPos] = nil then begin + if (resultPos < sonsLen(n)) and (n.sons[resultPos] <> nil) then begin + v := n.sons[resultPos].sym; + result := getNullValue(v.typ, n.info); + IdNodeTablePut(c.tos.mapping, v, result); + end; + result := evalAux(c, n.sons[codePos]); + if result.kind = nkReturnToken then + result := IdNodeTableGet(c.tos.mapping, v); + end + else + result := emptyNode +end; + +function evalHigh(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + case skipVarGeneric(n.sons[1].typ).kind of + tyOpenArray, tySequence: + result := newIntNodeT(sonsLen(result), n); + tyString: + result := newIntNodeT(length(result.strVal)-1, n); + else InternalError(n.info, 'evalHigh') + end +end; + +function evalIs(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + result := newIntNodeT(ord(inheritanceDiff(result.typ, n.sons[2].typ) >= 0), n) +end; + +function evalSetLengthStr(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkStrLit..nkTripleStrLit: setLength(a.strVal, int(getOrdValue(b))); + else InternalError(n.info, 'evalSetLengthStr') + end; + result := emptyNode +end; + +function evalSetLengthSeq(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if a.kind = nkBracket then setLength(a.sons, int(getOrdValue(b))) + else InternalError(n.info, 'evalSetLengthSeq'); + result := emptyNode +end; + +function evalNewSeq(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; + t: PType; + i: int; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + + t := skipVarGeneric(n.sons[1].typ); + result := newNodeIT(nkBracket, n.info, t); + for i := 0 to int(getOrdValue(b))-1 do + addSon(result, getNullValue(t.sons[0], n.info)); + // XXX: assign to `a`? result := emptyNode +end; + +function evalAssert(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if getOrdValue(result) <> 0 then + result := emptyNode + else + stackTrace(c, n, errAssertionFailed) +end; + +function evalIncl(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if not inSet(a, b) then addSon(a, copyTree(b)); + result := emptyNode; +end; + +function evalExcl(c: PEvalContext; n: PNode): PNode; +var + a, b, r: PNode; + i: int; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := newNodeIT(nkCurly, n.info, n.sons[1].typ); + addSon(b, result); + r := diffSets(a, b); + discardSons(a); + for i := 0 to sonsLen(r)-1 do addSon(a, r.sons[i]); + result := emptyNode; +end; + +function evalAppendStrCh(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkStrLit..nkTripleStrLit: addChar(a.strVal, chr(int(getOrdValue(b)))); + else InternalError(n.info, 'evalAppendStrCh'); + end; + result := emptyNode; +end; + +function getStrValue(n: PNode): string; +begin + case n.kind of + nkStrLit..nkTripleStrLit: result := n.strVal; + else begin InternalError(n.info, 'getStrValue'); result := '' end; + end +end; + +function evalConStrStr(c: PEvalContext; n: PNode): PNode; +// we cannot use ``evalOp`` for this as we can here have more than 2 arguments +var + a: PNode; + i: int; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + for i := 2 to sonsLen(n)-1 do begin + result := evalAux(c, n.sons[i]); + if result.kind = nkExceptBranch then exit; + a.strVal := getStrValue(a) +{&} getStrValue(result); + end; + result := a; +end; + +function evalAppendStrStr(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + case a.kind of + nkStrLit..nkTripleStrLit: a.strVal := a.strVal +{&} getStrValue(b); + else InternalError(n.info, 'evalAppendStrStr'); + end; + result := emptyNode; +end; + +function evalAppendSeqElem(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if a.kind = nkBracket then addSon(a, copyTree(b)) + else InternalError(n.info, 'evalAppendSeqElem'); + result := emptyNode; +end; + +function evalAppendSeqSeq(c: PEvalContext; n: PNode): PNode; +var + a, b: PNode; + i: int; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + if a.kind = nkBracket then + for i := 0 to sonsLen(b)-1 do addSon(a, copyTree(b.sons[i])) + else InternalError(n.info, 'evalAppendSeqSeq'); + result := emptyNode; +end; + +function evalRepr(c: PEvalContext; n: PNode): PNode; +begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + result := newStrNodeT(renderTree(result, {@set}[renderNoComments]), n); +end; + +function evalMagicOrCall(c: PEvalContext; n: PNode): PNode; +var + m: TMagic; + a, b: PNode; + k: biggestInt; + i: int; +begin + m := getMagic(n); + case m of + mNone: result := evalCall(c, n); + mIs: result := evalIs(c, n); + mSizeOf: internalError(n.info, 'sizeof() should have been evaluated'); + mHigh: result := evalHigh(c, n); + mAssert: result := evalAssert(c, n); + mExit: result := evalExit(c, n); + mNew, mNewFinalize: result := evalNew(c, n); + mNewSeq: result := evalNewSeq(c, n); + mSwap: result := evalSwap(c, n); + mInc: result := evalIncDec(c, n, 1); + ast.mDec: result := evalIncDec(c, n, -1); + mSetLengthStr: result := evalSetLengthStr(c, n); + mSetLengthSeq: result := evalSetLengthSeq(c, n); + mIncl: result := evalIncl(c, n); + mExcl: result := evalExcl(c, n); + mAnd: result := evalAnd(c, n); + mOr: result := evalOr(c, n); + + mAppendStrCh: result := evalAppendStrCh(c, n); + mAppendStrStr: result := evalAppendStrStr(c, n); + mAppendSeqElem: result := evalAppendSeqElem(c, n); + mAppendSeqSeq: result := evalAppendSeqSeq(c, n); + + mNLen: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + case a.kind of + nkEmpty..nkNilLit: begin end; + else result.intVal := sonsLen(a); + end + end; + mNChild: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + k := getOrdValue(result); + if (k >= 0) and (k < sonsLen(a)) + and not (a.kind in [nkEmpty..nkNilLit]) then + result := a.sons[int(k)] + else begin + stackTrace(c, n, errIndexOutOfBounds); + result := emptyNode + end; + end; + mNSetChild: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + result := evalAux(c, n.sons[3]); + if result.kind = nkExceptBranch then exit; + k := getOrdValue(b); + if (k >= 0) and (k < sonsLen(a)) + and not (a.kind in [nkEmpty..nkNilLit]) then + a.sons[int(k)] := result + else + stackTrace(c, n, errIndexOutOfBounds); + result := emptyNode; + end; + mNAdd: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + addSon(a, result); + result := emptyNode + end; + mNAddMultiple: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + for i := 0 to sonsLen(result)-1 do addSon(a, result.sons[i]); + result := emptyNode + end; + mNDel: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + result := evalAux(c, n.sons[3]); + if result.kind = nkExceptBranch then exit; + for i := 0 to int(getOrdValue(result))-1 do + delSon(a, int(getOrdValue(b))); + result := emptyNode; + end; + mNKind: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + result.intVal := ord(a.kind); + end; + mNIntVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + case a.kind of + nkCharLit..nkInt64Lit: result.intVal := a.intVal; + else InternalError(n.info, 'no int value') + end + end; + mNFloatVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkFloatLit, n.info, n.typ); + case a.kind of + nkFloatLit..nkFloat64Lit: result.floatVal := a.floatVal; + else InternalError(n.info, 'no float value') + end + end; + mNSymbol: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkSym then InternalError(n.info, 'no symbol') + end; + mNIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIdent then InternalError(n.info, 'no symbol') + end; + mNGetType: result := evalAux(c, n.sons[1]); + mNStrVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := newNodeIT(nkStrLit, n.info, n.typ); + case a.kind of + nkStrLit..nkTripleStrLit: result.strVal := a.strVal; + else InternalError(n.info, 'no string value') + end + end; + mNSetIntVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.intVal := result.intVal; // XXX: exception handling? + result := emptyNode + end; + mNSetFloatVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.floatVal := result.floatVal; // XXX: exception handling? + result := emptyNode + end; + mNSetSymbol: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.sym := result.sym; // XXX: exception handling? + result := emptyNode + end; + mNSetIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.ident := result.ident; // XXX: exception handling? + result := emptyNode + end; + mNSetType: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.typ := result.typ; // XXX: exception handling? + result := emptyNode + end; + mNSetStrVal: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a.strVal := result.strVal; // XXX: exception handling? + result := emptyNode + end; + mNNewNimNode: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + k := getOrdValue(result); + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + a := result; + if (k < 0) or (k > ord(high(TNodeKind))) then + internalError(n.info, 'request to create a NimNode with invalid kind'); + if a.kind = nkNilLit then + result := newNodeI(TNodeKind(int(k)), n.info) + else + result := newNodeI(TNodeKind(int(k)), a.info) + end; + mNCopyNimNode: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + result := copyNode(result); + end; + mNCopyNimTree: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + result := copyTree(result); + end; + mStrToIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if not (result.kind in [nkStrLit..nkTripleStrLit]) then + InternalError(n.info, 'no string node'); + a := result; + result := newNodeIT(nkIdent, n.info, n.typ); + result.ident := getIdent(a.strVal); + end; + mIdentToStr: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + if result.kind <> nkIdent then + InternalError(n.info, 'no ident node'); + a := result; + result := newNodeIT(nkStrLit, n.info, n.typ); + result.strVal := a.ident.s; + end; + mEqIdent: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + b := result; + result := newNodeIT(nkIntLit, n.info, n.typ); + if (a.kind = nkIdent) and (b.kind = nkIdent) then + if a.ident.id = b.ident.id then result.intVal := 1 + end; + mNHint: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, hintUser, getStrValue(result)); + result := emptyNode + end; + mNWarning: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, warnUser, getStrValue(result)); + result := emptyNode + end; + mNError: begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + liMessage(n.info, errUser, getStrValue(result)); + result := emptyNode + end; + mConStrStr: result := evalConStrStr(c, n); + mRepr: result := evalRepr(c, n); + else begin + result := evalAux(c, n.sons[1]); + if result.kind = nkExceptBranch then exit; + a := result; + if sonsLen(n) > 2 then begin + result := evalAux(c, n.sons[2]); + if result.kind = nkExceptBranch then exit; + end + else + result := nil; + result := evalOp(m, n, a, result); + end + end +end; + +function evalAux(c: PEvalContext; n: PNode): PNode; +var + i: int; +begin + result := emptyNode; + dec(gNestedEvals); + if gNestedEvals <= 0 then stackTrace(c, n, errTooManyIterations); + case n.kind of // atoms: + nkEmpty: result := n; + nkSym: result := evalSym(c, n); + nkType..pred(nkNilLit): result := copyNode(n); + nkNilLit: result := n; // end of atoms + + nkCall, nkHiddenCallConv, nkMacroStmt: result := evalMagicOrCall(c, n); + nkCurly, nkBracket: begin + result := copyNode(n); + for i := 0 to sonsLen(n)-1 do addSon(result, evalAux(c, n.sons[i])); + end; + nkPar: begin + result := copyTree(n); + for i := 0 to sonsLen(n)-1 do + result.sons[i].sons[1] := evalAux(c, n.sons[i].sons[1]); + end; + nkBracketExpr: result := evalArrayAccess(c, n); + nkDotExpr: result := evalFieldAccess(c, n); + nkDerefExpr, nkHiddenDeref: result := evalDeref(c, n); + nkAddr, nkHiddenAddr: result := evalAddr(c, n); + nkHiddenStdConv, nkHiddenSubConv, nkConv: result := evalConv(c, n); + nkAsgn: result := evalAsgn(c, n); + nkWhenStmt, nkIfStmt, nkIfExpr: result := evalIf(c, n); + nkWhileStmt: result := evalWhile(c, n); + nkCaseStmt: result := evalCase(c, n); + nkVarSection: result := evalVar(c, n); + nkTryStmt: result := evalTry(c, n); + nkRaiseStmt: result := evalRaise(c, n); + nkReturnStmt: result := evalReturn(c, n); + nkBreakStmt, nkReturnToken: result := n; + nkBlockExpr, nkBlockStmt: result := evalBlock(c, n); + nkDiscardStmt: result := evalAux(c, n.sons[0]); + nkCheckedFieldExpr: result := evalCheckedFieldAccess(c, n); + nkObjDownConv: result := evalAux(c, n.sons[0]); + nkObjUpConv: result := evalUpConv(c, n); + nkChckRangeF, nkChckRange64, nkChckRange: result := evalRangeChck(c, n); + nkStringToCString: result := evalConvStrToCStr(c, n); + nkCStringToString: result := evalConvCStrToStr(c, n); + nkPassAsOpenArray: result := evalAux(c, n.sons[0]); + + nkStmtListExpr, nkStmtList, nkModule: begin + for i := 0 to sonsLen(n)-1 do begin + result := evalAux(c, n.sons[i]); + case result.kind of + nkExceptBranch, nkReturnToken, nkBreakStmt: break; + else begin end + end + end + end; + nkProcDef, nkMacroDef, nkCommentStmt, nkPragma, nkTypeSection, + nkTemplateDef, nkConstSection, nkIteratorDef, nkConverterDef, + nkIncludeStmt, nkImportStmt, nkFromStmt: begin end; + nkIdentDefs, nkCast, nkYieldStmt, nkAsmStmt, nkForStmt, nkPragmaExpr, + nkQualified, nkLambda, nkContinueStmt: + stackTrace(c, n, errCannotInterpretNodeX, nodeKindToStr[n.kind]); + else InternalError(n.info, 'evalAux: ' + nodekindToStr[n.kind]); + end; + if result = nil then + InternalError(n.info, 'evalAux: returned nil ' + nodekindToStr[n.kind]); + inc(gNestedEvals); +end; + +function eval(c: PEvalContext; n: PNode): PNode; +begin + gWhileCounter := evalMaxIterations; + gNestedEvals := evalMaxRecDepth; + result := evalAux(c, n); + if result.kind = nkExceptBranch then + stackTrace(c, n, errUnhandledExceptionX, typeToString(result.typ)); +end; + +function myOpen(module: PSym; const filename: string): PPassContext; +var + c: PEvalContext; +begin + c := newEvalContext(module, filename); + pushStackFrame(c, newStackFrame()); + result := c; +end; + +function myProcess(c: PPassContext; n: PNode): PNode; +begin + result := eval(PEvalContext(c), n); +end; + +function evalPass(): TPass; +begin + initPass(result); + result.open := myOpen; + result.close := myProcess; + result.process := myProcess; +end; + +initialization + new(emptyNode); +{@ignore} + fillChar(emptyNode^, sizeof(emptyNode^), 0); +{@emit} + emptyNode.kind := nkEmpty; +end. diff --git a/nim/hashes.pas b/nim/hashes.pas index cf5ab03bc..1bd3c7d2a 100644 --- a/nim/hashes.pas +++ b/nim/hashes.pas @@ -44,9 +44,6 @@ function finishHash(h: THash): THash; implementation -type - TUnsignedHash = cardinal; - {@ignore} {$ifopt Q+} { we need Q- here! } {$define Q_on} @@ -89,7 +86,7 @@ end; function GetDataHash(Data: Pointer; Size: int): THash; var - h: TUnsignedHash; + h: THash; p: PChar; i, s: int; begin @@ -116,7 +113,7 @@ end; function GetHash(str: PChar): THash; var - h: TUnsignedHash; + h: THash; i: int; begin h := 0; @@ -135,7 +132,7 @@ end; function GetHashStr(const s: string): THash; var - h: TUnsignedHash; + h: THash; i: int; begin h := 0; @@ -152,7 +149,7 @@ end; function getNormalizedHash(const s: string): THash; var - h: TUnsignedHash; + h: THash; c: Char; i: int; begin @@ -173,7 +170,7 @@ end; function GetHashStrCI(const s: string): THash; var - h: TUnsignedHash; + h: THash; c: Char; i: int; begin @@ -193,7 +190,7 @@ end; function GetHashCI(str: PChar): THash; var - h: TUnsignedHash; + h: THash; c: Char; i: int; begin diff --git a/nim/hashtest.pas b/nim/hashtest.pas new file mode 100644 index 000000000..ba7a62372 --- /dev/null +++ b/nim/hashtest.pas @@ -0,0 +1,10 @@ +program hashtest; + +{$include 'config.inc'} + +uses + hashes; + +begin + writeln(output, getNormalizedHash(ParamStr(1))); +end. diff --git a/nim/interact.pas b/nim/interact.pas new file mode 100644 index 000000000..ac238107f --- /dev/null +++ b/nim/interact.pas @@ -0,0 +1,22 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit interact; + +// This file implements interactive sessions. + +interface + +{$include 'config.inc'} + +uses + nsystem, llstream, strutils, charsets, ropes, strtabs, msgs; + +implementation + +end. diff --git a/nim/lists.pas b/nim/lists.pas index 74b1479d9..e3442eb29 100644 --- a/nim/lists.pas +++ b/nim/lists.pas @@ -8,7 +8,7 @@ // unit lists; -// This unit implements a generic doubled linked list. +// This module implements a generic doubled linked list. interface diff --git a/nim/llstream.pas b/nim/llstream.pas new file mode 100644 index 000000000..2d4336664 --- /dev/null +++ b/nim/llstream.pas @@ -0,0 +1,250 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit llstream; + +// Low-level streams for high performance. + +interface + +uses + nsystem, charsets, strutils; + +type + TLLStreamKind = ( + llsNone, // null stream: reading and writing has no effect + llsString, // stream encapsulates a string + llsFile, // stream encapsulates a file + llsStdIn); // stream encapsulates stdin + TLLStream = object(NObject) + kind: TLLStreamKind; // exposed for low-level access (lexbase uses this) + f: TBinaryFile; + s: string; + pos: int; // for string streams + end; + PLLStream = ^TLLStream; + + +function LLStreamOpen(const data: string): PLLStream; overload; +function LLStreamOpen(var f: TBinaryFile): PLLStream; overload; +function LLStreamOpen(const filename: string; mode: TFileMode): PLLStream; overload; +function LLStreamOpen(): PLLStream; overload; +function LLStreamOpenStdIn(): PLLStream; + +procedure LLStreamClose(s: PLLStream); + +function LLStreamRead(s: PLLStream; buf: pointer; bufLen: int): int; +function LLStreamReadLine(s: PLLStream): string; +function LLStreamReadAll(s: PLLStream): string; + +procedure LLStreamWrite(s: PLLStream; const data: string); overload; +procedure LLStreamWrite(s: PLLStream; data: Char); overload; +procedure LLStreamWrite(s: PLLStream; buf: pointer; buflen: int); overload; + +function LLStreamAtEnd(s: PLLStream): bool; + +implementation + +function LLStreamOpen(const data: string): PLLStream; overload; +begin + new(result); + {@ignore} + fillChar(result^, sizeof(result^), 0); + {@emit} + result.s := data; + result.kind := llsString; +end; + +function LLStreamOpen(var f: TBinaryFile): PLLStream; overload; +begin + new(result); + {@ignore} + fillChar(result^, sizeof(result^), 0); + {@emit} + result.f := f; + result.kind := llsFile; +end; + +function LLStreamOpen(const filename: string; mode: TFileMode): PLLStream; overload; +begin + new(result); + {@ignore} + fillChar(result^, sizeof(result^), 0); + {@emit} + result.kind := llsFile; + if not OpenFile(result.f, filename, mode) then result := nil; +end; + +function LLStreamOpen(): PLLStream; overload; +begin + new(result); + {@ignore} + fillChar(result^, sizeof(result^), 0); + {@emit} + result.kind := llsNone; +end; + +function LLStreamOpenStdIn(): PLLStream; +begin + new(result); + {@ignore} + fillChar(result^, sizeof(result^), 0); + {@emit} + result.kind := llsStdIn; + result.s := ''; + result.pos := -1; +end; + +procedure LLStreamClose(s: PLLStream); +begin + case s.kind of + llsNone, llsString, llsStdIn: begin end; + llsFile: nimCloseFile(s.f); + end +end; + +function LLreadFromStdin(s: PLLStream; buf: pointer; bufLen: int): int; +var + line: string; + L: int; +begin + s.s := ''; + s.pos := 0; + while true do begin + write(output, 'Nimrod> '); + line := readLine(input); + L := length(line); + add(s.s, line); + add(s.s, nl); + if (L > 0) and (line[L-1+strStart] = '#') then break; + end; + result := min(bufLen, length(s.s)-s.pos); + if result > 0 then begin + copyMem(buf, addr(s.s[strStart+s.pos]), result); + inc(s.pos, result) + end +end; + +function LLStreamRead(s: PLLStream; buf: pointer; bufLen: int): int; +begin + case s.kind of + llsNone: result := 0; + llsString: begin + result := min(bufLen, length(s.s)-s.pos); + if result > 0 then begin + copyMem(buf, addr(s.s[strStart+s.pos]), result); + inc(s.pos, result) + end + end; + llsFile: result := readBuffer(s.f, buf, bufLen); + llsStdIn: result := LLreadFromStdin(s, buf, bufLen); + end +end; + +function LLStreamReadLine(s: PLLStream): string; +begin + case s.kind of + llsNone: result := ''; + llsString: begin + result := ''; + while s.pos < length(s.s) do begin + case s.s[s.pos+strStart] of + #13: begin + inc(s.pos); + if s.s[s.pos+strStart] = #10 then inc(s.pos); + break + end; + #10: begin inc(s.pos); break end; + else begin + addChar(result, s.s[s.pos+strStart]); + inc(s.pos); + end + end + end + end; + llsFile: result := readLine(s.f); + llsStdIn: result := readLine(input); + end +end; + +function LLStreamAtEnd(s: PLLStream): bool; +begin + case s.kind of + llsNone: result := true; + llsString: result := s.pos < length(s.s); + llsFile: result := endOfFile(s.f); + llsStdIn: result := false; + end +end; + +procedure LLStreamWrite(s: PLLStream; const data: string); overload; +begin + case s.kind of + llsNone, llsStdIn: begin end; + llsString: add(s.s, data); + llsFile: nimWrite(s.f, data); + end +end; + +procedure LLStreamWrite(s: PLLStream; data: Char); overload; +var + c: char; +begin + case s.kind of + llsNone, llsStdIn: begin end; + llsString: addChar(s.s, data); + llsFile: begin + c := data; + {@discard} writeBuffer(s.f, addr(c), sizeof(c)); + end + end +end; + +procedure LLStreamWrite(s: PLLStream; buf: pointer; buflen: int); overload; +begin + case s.kind of + llsNone, llsStdIn: begin end; + llsString: begin + if bufLen > 0 then begin + setLength(s.s, length(s.s) + bufLen); + copyMem(addr(s.s[strStart+s.pos]), buf, bufLen); + inc(s.pos, bufLen); + end + end; + llsFile: {@discard} writeBuffer(s.f, buf, bufLen); + end +end; + +function LLStreamReadAll(s: PLLStream): string; +const + bufSize = 2048; +var + bytes, i: int; +begin + case s.kind of + llsNone, llsStdIn: result := ''; + llsString: begin + if s.pos = 0 then result := s.s + else result := ncopy(s.s, s.pos+strStart); + s.pos := length(s.s); + end; + llsFile: begin + result := newString(bufSize); + bytes := readBuffer(s.f, addr(result[strStart]), bufSize); + i := bytes; + while bytes = bufSize do begin + setLength(result, i+bufSize); + bytes := readBuffer(s.f, addr(result[i+strStart]), bufSize); + inc(i, bytes); + end; + setLength(result, i); + end + end +end; + +end. diff --git a/nim/lookups.pas b/nim/lookups.pas new file mode 100644 index 000000000..a9a4a783b --- /dev/null +++ b/nim/lookups.pas @@ -0,0 +1,289 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit lookups; + +// This module implements lookup helpers. + +interface + +uses + nsystem, ast, astalgo, idents, semdata, types, msgs, options, rodread, + rnimsyn; + +{$include 'config.inc'} + +type + TOverloadIterMode = (oimNoQualifier, oimSelfModule, oimOtherModule); + TOverloadIter = record + stackPtr: int; + it: TIdentIter; + m: PSym; + mode: TOverloadIterMode; + end; + +function getSymRepr(s: PSym): string; + +procedure CloseScope(var tab: TSymTab); + +procedure AddSym(var t: TStrTable; n: PSym); + +procedure addDecl(c: PContext; sym: PSym); +procedure addDeclAt(c: PContext; sym: PSym; at: Natural); +procedure addOverloadableSymAt(c: PContext; fn: PSym; at: Natural); + +procedure addInterfaceDecl(c: PContext; sym: PSym); +procedure addInterfaceOverloadableSymAt(c: PContext; sym: PSym; at: int); + +function lookUp(c: PContext; n: PNode): PSym; +// Looks up a symbol. Generates an error in case of nil. + +function QualifiedLookUp(c: PContext; n: PNode; ambigiousCheck: bool): PSym; + +function InitOverloadIter(out o: TOverloadIter; c: PContext; n: PNode): PSym; +function nextOverloadIter(var o: TOverloadIter; c: PContext; n: PNode): PSym; + +implementation + +function getSymRepr(s: PSym): string; +begin + case s.kind of + skProc, skConverter, skIterator: result := getProcHeader(s); + else result := s.name.s + end +end; + +procedure CloseScope(var tab: TSymTab); +var + it: TTabIter; + s: PSym; +begin + // check if all symbols have been used and defined: + if (tab.tos > length(tab.stack)) then InternalError('CloseScope'); + s := InitTabIter(it, tab.stack[tab.tos-1]); + while s <> nil do begin + if sfForward in s.flags then + liMessage(s.info, errImplOfXexpected, getSymRepr(s)) + else if ([sfUsed, sfInInterface] * s.flags = []) and + (optHints in s.options) then // BUGFIX: check options in s! + if not (s.kind in [skForVar, skParam]) then + liMessage(s.info, hintXDeclaredButNotUsed, getSymRepr(s)); + s := NextIter(it, tab.stack[tab.tos-1]); + end; + astalgo.rawCloseScope(tab); +end; + +procedure AddSym(var t: TStrTable; n: PSym); +begin + if StrTableIncl(t, n) then liMessage(n.info, errAttemptToRedefine, n.name.s); +end; + +procedure addDecl(c: PContext; sym: PSym); +begin + if SymTabAddUnique(c.tab, sym) = Failure then + liMessage(sym.info, errAttemptToRedefine, sym.Name.s); +end; + +procedure addDeclAt(c: PContext; sym: PSym; at: Natural); +begin + if SymTabAddUniqueAt(c.tab, sym, at) = Failure then + liMessage(sym.info, errAttemptToRedefine, sym.Name.s); +end; + +procedure addOverloadableSymAt(c: PContext; fn: PSym; at: Natural); +var + check: PSym; +begin + if not (fn.kind in OverloadableSyms) then + InternalError(fn.info, 'addOverloadableSymAt'); + check := StrTableGet(c.tab.stack[at], fn.name); + if (check <> nil) and (check.Kind <> fn.kind) then + liMessage(fn.info, errAttemptToRedefine, fn.Name.s); + SymTabAddAt(c.tab, fn, at); +end; + +procedure AddInterfaceDeclAux(c: PContext; sym: PSym); +begin + if (sfInInterface in sym.flags) then begin + // add to interface: + if c.module = nil then InternalError(sym.info, 'AddInterfaceDeclAux'); + StrTableAdd(c.module.tab, sym); + end; + if getCurrOwner().kind = skModule then + include(sym.flags, sfGlobal) +end; + +procedure addInterfaceDecl(c: PContext; sym: PSym); +begin // it adds the symbol to the interface if appropriate + addDecl(c, sym); + AddInterfaceDeclAux(c, sym); +end; + +procedure addInterfaceOverloadableSymAt(c: PContext; sym: PSym; at: int); +begin // it adds the symbol to the interface if appropriate + addOverloadableSymAt(c, sym, at); + AddInterfaceDeclAux(c, sym); +end; + +function lookUp(c: PContext; n: PNode): PSym; +// Looks up a symbol. Generates an error in case of nil. +begin + case n.kind of + nkAccQuoted: result := lookup(c, n.sons[0]); + nkSym: begin + result := SymtabGet(c.Tab, n.sym.name); + if result = nil then + liMessage(n.info, errUndeclaredIdentifier, n.sym.name.s); + include(result.flags, sfUsed); + end; + nkIdent: begin + result := SymtabGet(c.Tab, n.ident); + if result = nil then + liMessage(n.info, errUndeclaredIdentifier, n.ident.s); + include(result.flags, sfUsed); + end + else InternalError(n.info, 'lookUp'); + end; + if IntSetContains(c.AmbigiousSymbols, result.id) then + liMessage(n.info, errUseQualifier, result.name.s); + if result.kind = skStub then loadStub(result); +end; + +function QualifiedLookUp(c: PContext; n: PNode; ambigiousCheck: bool): PSym; +var + m: PSym; + ident: PIdent; +begin + case n.kind of + nkIdent: begin + result := SymtabGet(c.Tab, n.ident); + if result = nil then + liMessage(n.info, errUndeclaredIdentifier, n.ident.s) + else if ambigiousCheck + and IntSetContains(c.AmbigiousSymbols, result.id) then + liMessage(n.info, errUseQualifier, n.ident.s) + end; + nkSym: begin + result := SymtabGet(c.Tab, n.sym.name); + if result = nil then + liMessage(n.info, errUndeclaredIdentifier, n.sym.name.s) + else if ambigiousCheck + and IntSetContains(c.AmbigiousSymbols, result.id) then + liMessage(n.info, errUseQualifier, n.sym.name.s) + end; + nkDotExpr, nkQualified: begin + result := nil; + m := qualifiedLookUp(c, n.sons[0], false); + if (m <> nil) and (m.kind = skModule) then begin + ident := nil; + if (n.sons[1].kind = nkIdent) then + ident := n.sons[1].ident + else if (n.sons[1].kind = nkAccQuoted) + and (n.sons[1].sons[0].kind = nkIdent) then + ident := n.sons[1].sons[0].ident; + if ident <> nil then begin + if m = c.module then + // a module may access its private members: + result := StrTableGet(c.tab.stack[ModuleTablePos], ident) + else + result := StrTableGet(m.tab, ident); + if result = nil then + liMessage(n.sons[1].info, errUndeclaredIdentifier, ident.s) + end + else + liMessage(n.sons[1].info, errIdentifierExpected, + renderTree(n.sons[1])); + end + end; + nkAccQuoted: result := QualifiedLookup(c, n.sons[0], ambigiousCheck); + else begin + result := nil; + //liMessage(n.info, errIdentifierExpected, '') + end; + end; + if (result <> nil) and (result.kind = skStub) then loadStub(result); +end; + +function InitOverloadIter(out o: TOverloadIter; c: PContext; n: PNode): PSym; +var + ident: PIdent; +begin + result := nil; + case n.kind of + nkIdent: begin + o.stackPtr := c.tab.tos; + o.mode := oimNoQualifier; + while (result = nil) do begin + dec(o.stackPtr); + if o.stackPtr < 0 then break; + result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.ident); + end; + end; + nkSym: begin + o.stackPtr := c.tab.tos; + o.mode := oimNoQualifier; + while (result = nil) do begin + dec(o.stackPtr); + if o.stackPtr < 0 then break; + result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], n.sym.name); + end; + end; + nkDotExpr, nkQualified: begin + o.mode := oimOtherModule; + o.m := qualifiedLookUp(c, n.sons[0], false); + if (o.m <> nil) and (o.m.kind = skModule) then begin + ident := nil; + if (n.sons[1].kind = nkIdent) then + ident := n.sons[1].ident + else if (n.sons[1].kind = nkAccQuoted) + and (n.sons[1].sons[0].kind = nkIdent) then + ident := n.sons[1].sons[0].ident; + if ident <> nil then begin + if o.m = c.module then begin + // a module may access its private members: + result := InitIdentIter(o.it, c.tab.stack[ModuleTablePos], ident); + o.mode := oimSelfModule; + end + else + result := InitIdentIter(o.it, o.m.tab, ident); + end + else + liMessage(n.sons[1].info, errIdentifierExpected, + renderTree(n.sons[1])); + end + end; + nkAccQuoted: result := InitOverloadIter(o, c, n.sons[0]); + else begin end + end; + if (result <> nil) and (result.kind = skStub) then loadStub(result); +end; + +function nextOverloadIter(var o: TOverloadIter; c: PContext; n: PNode): PSym; +begin + case o.mode of + oimNoQualifier: begin + if n.kind = nkAccQuoted then + result := nextOverloadIter(o, c, n.sons[0]) // BUGFIX + else if o.stackPtr >= 0 then begin + result := nextIdentIter(o.it, c.tab.stack[o.stackPtr]); + while (result = nil) do begin + dec(o.stackPtr); + if o.stackPtr < 0 then break; + result := InitIdentIter(o.it, c.tab.stack[o.stackPtr], o.it.name); + // BUGFIX: o.it.name <-> n.ident + end + end + else result := nil; + end; + oimSelfModule: result := nextIdentIter(o.it, c.tab.stack[ModuleTablePos]); + oimOtherModule: result := nextIdentIter(o.it, o.m.tab); + end; + if (result <> nil) and (result.kind = skStub) then loadStub(result); +end; + +end. diff --git a/nim/main.pas b/nim/main.pas index 7cf3fbd0a..565373685 100644 --- a/nim/main.pas +++ b/nim/main.pas @@ -127,7 +127,6 @@ begin registerPass(verbosePass()); registerPass(sem.semPass()); registerPass(transf.transfPass()); - registerPass(rodwrite.rodwritePass()); end; procedure CommandGenDepend(const filename: string); @@ -152,6 +151,7 @@ procedure CommandCompileToC(const filename: string); begin semanticPasses(); registerPass(cgen.cgenPass()); + registerPass(rodwrite.rodwritePass()); registerPass(cleanupPass()); compileProject(filename); //for i := low(TTypeKind) to high(TTypeKind) do diff --git a/nim/nsystem.pas b/nim/nsystem.pas index 340477461..c33236189 100644 --- a/nim/nsystem.pas +++ b/nim/nsystem.pas @@ -41,6 +41,8 @@ type EOverflow = class(Exception) end; {$endif} + EOutOfRange = class(Exception) + end; float32 = single; float64 = double; @@ -153,6 +155,7 @@ function ltU(a, b: biggestInt): bool; function leU(a, b: biggestInt): bool; function toU8(a: biggestInt): byte; +function toU16(a: biggestInt): int16; function toU32(a: biggestInt): int32; function ze64(a: byte): biggestInt; function ze(a: byte): int; @@ -206,9 +209,25 @@ function readFile(const filename: string): string; procedure nimWrite(var f: tBinaryFile; const str: string); overload; +procedure add(var x: string; const y: string); +// Pascal version of string appending. Terminating zero is ignored. implementation +{@ignore} +procedure add(var x: string; const y: string); +// Pascal version of string appending. Terminating zero is ignored. +var + L: int; +begin + L := length(y); + if L > 0 then begin + if y[L] = #0 then x := x + copy(y, 1, L-1) + else x := x + y; + end +end; +{@emit} + function alloc(size: int): Pointer; begin getMem(result, size); // use standard allocator @@ -284,6 +303,11 @@ begin result := int32(a and $ffffffff); end; +function toU16(a: biggestInt): int16; +begin + result := int16(a and $ffff); +end; + function ze64(a: byte): biggestInt; begin result := a @@ -565,16 +589,30 @@ end; var zero: float; Saved8087CW: Word; + savedExcMask: TFPUExceptionMask; initialization +{$ifdef cpu64} + savedExcMask := SetExceptionMask([exInvalidOp, + exDenormalized, + exPrecision, + exZeroDivide, + exOverflow, + exUnderflow + ]); +{$else} Saved8087CW := Default8087CW; Set8087CW($133f); // Disable all fpu exceptions - +{$endif} zero := 0.0; NaN := 0.0 / zero; inf := 1.0 / zero; NegInf := -inf; finalization +{$ifdef cpu64} + SetExceptionMask(savedExcMask); // set back exception mask +{$else} Set8087CW(Saved8087CW); +{$endif} {$ifdef R_on} {$R+,Q+} {$endif} diff --git a/nim/nversion.pas b/nim/nversion.pas index 51390a073..9629079b2 100644 --- a/nim/nversion.pas +++ b/nim/nversion.pas @@ -31,10 +31,10 @@ const //cog.outl('VersionMinor = %s;' % ver[1]) //cog.outl('VersionPatch = %s;' % ver[2]) //]]] - VersionAsString = '0.7.0'; + VersionAsString = '0.7.2'; VersionMajor = 0; VersionMinor = 7; - VersionPatch = 0; + VersionPatch = 2; //[[[[end]]]] implementation diff --git a/nim/paslex.pas b/nim/paslex.pas index 678f3af1a..c0136e4d8 100644 --- a/nim/paslex.pas +++ b/nim/paslex.pas @@ -298,7 +298,7 @@ begin end; '_': inc(pos); '0', '1': begin - xi := (xi shl 1) or (ord(L.buf[pos]) - ord('0')); + xi := shlu(xi, 1) or (ord(L.buf[pos]) - ord('0')); inc(pos); inc(bits); end; @@ -330,17 +330,17 @@ begin end; '_': inc(pos); '0'..'9': begin - xi := (xi shl 4) or (ord(L.buf[pos]) - ord('0')); + xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('0')); inc(pos); inc(bits, 4); end; 'a'..'f': begin - xi := (xi shl 4) or (ord(L.buf[pos]) - ord('a') + 10); + xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10); inc(pos); inc(bits, 4); end; 'A'..'F': begin - xi := (xi shl 4) or (ord(L.buf[pos]) - ord('A') + 10); + xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10); inc(pos); inc(bits, 4); end; diff --git a/nim/passaux.pas b/nim/passaux.pas new file mode 100644 index 000000000..6344efb0b --- /dev/null +++ b/nim/passaux.pas @@ -0,0 +1,74 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit passaux; + +// implements some little helper passes +{$include 'config.inc'} + +interface + +uses + nsystem, strutils, ast, passes, msgs, options; + +function verbosePass: TPass; +function cleanupPass: TPass; + +implementation + +function verboseOpen(s: PSym; const filename: string): PPassContext; +begin + //MessageOut('compiling ' + s.name.s); + result := nil; // we don't need a context + if gVerbosity > 0 then + rawMessage(hintProcessing, s.name.s); +end; + +function verboseProcess(context: PPassContext; n: PNode): PNode; +begin + result := n; + if context <> nil then InternalError('logpass: context is not nil'); + if gVerbosity = 3 then + liMessage(n.info, hintProcessing, toString(ast.gid)); +end; + +function verbosePass: TPass; +begin + initPass(result); + result.open := verboseOpen; + result.process := verboseProcess; +end; + +function cleanUp(c: PPassContext; n: PNode): PNode; +var + i: int; + s: PSym; +begin + result := n; + case n.kind of + nkStmtList: begin + for i := 0 to sonsLen(n)-1 do {@discard} cleanup(c, n.sons[i]); + end; + nkProcDef: begin + if (n.sons[namePos].kind = nkSym) then begin + s := n.sons[namePos].sym; + if not astNeeded(s) then s.ast.sons[codePos] := nil; // free the memory + end + end + else begin end; + end +end; + +function cleanupPass: TPass; +begin + initPass(result); + result.process := cleanUp; + result.close := cleanUp; +end; + +end. diff --git a/nim/passes.pas b/nim/passes.pas new file mode 100644 index 000000000..028cfc2a2 --- /dev/null +++ b/nim/passes.pas @@ -0,0 +1,216 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit passes; + +// This module implements the passes functionality. A pass must implement the +// `TPass` interface. + +interface + +{$include 'config.inc'} + +uses + nsystem, charsets, strutils, + lists, options, ast, astalgo, llstream, + msgs, platform, nos, condsyms, idents, rnimsyn, types, + extccomp, nmath, magicsys, nversion, nimsets, pnimsyn, ntime, rodread; + +type + TPassContext = object(NObject) // the pass's context + end; + PPassContext = ^TPassContext; + + TPass = record {@tuple} // a pass is a tuple of procedure vars + open: function (module: PSym; const filename: string): PPassContext; + openCached: function (module: PSym; const filename: string; + rd: PRodReader): PPassContext; + close: function (p: PPassContext; n: PNode): PNode; + process: function (p: PPassContext; topLevelStmt: PNode): PNode; + end; + +// ``TPass.close`` may produce additional nodes. These are passed to the other +// close procedures. This mechanism is needed for the instantiation of +// generics. + +procedure registerPass(const p: TPass); + +procedure initPass(var p: TPass); + +// This implements a memory preserving scheme: Top level statements are +// processed in a pipeline. The compiler never looks at a whole module +// any longer. However, this is simple to change, as new passes may perform +// whole program optimizations. For now, we avoid it to save a lot of memory. + +procedure processModule(module: PSym; const filename: string; + stream: PLLStream; rd: PRodReader); + + +function astNeeded(s: PSym): bool; + // The ``rodwrite`` module uses this to determine if the body of a proc + // needs to be stored. The passes manager frees s.sons[codePos] when + // appropriate to free the procedure body's memory. This is important + // to keep memory usage down. + +// some passes (the semantic checker) need these: +var + gImportModule: function (const filename: string): PSym; + gIncludeFile: function (const filename: string): PNode; + gIncludeTmplFile: function (const filename: string): PNode; + +implementation + +function astNeeded(s: PSym): bool; +begin + if (s.kind = skProc) + and ([sfCompilerProc, sfCompileTime] * s.flags = []) + and (s.typ.callConv <> ccInline) + and (s.ast.sons[genericParamsPos] = nil) then + result := false + else + result := true +end; + +const + maxPasses = 10; + +type + TPassContextArray = array [0..maxPasses-1] of PPassContext; +var + gPasses: array [0..maxPasses-1] of TPass; + gPassesLen: int; + +procedure registerPass(const p: TPass); +begin + gPasses[gPassesLen] := p; + inc(gPassesLen); +end; + +procedure openPasses(var a: TPassContextArray; module: PSym; + const filename: string); +var + i: int; +begin + for i := 0 to gPassesLen-1 do + if assigned(gPasses[i].open) then + a[i] := gPasses[i].open(module, filename) + else + a[i] := nil +end; + +procedure openPassesCached(var a: TPassContextArray; module: PSym; + const filename: string; rd: PRodReader); +var + i: int; +begin + for i := 0 to gPassesLen-1 do + if assigned(gPasses[i].openCached) then + a[i] := gPasses[i].openCached(module, filename, rd) + else + a[i] := nil +end; + +procedure closePasses(var a: TPassContextArray); +var + i: int; + m: PNode; +begin + m := nil; + for i := 0 to gPassesLen-1 do begin + if assigned(gPasses[i].close) then m := gPasses[i].close(a[i], m); + a[i] := nil; // free the memory here + end +end; + +procedure processTopLevelStmt(n: PNode; var a: TPassContextArray); +var + i: int; + m: PNode; +begin + // this implements the code transformation pipeline + m := n; + for i := 0 to gPassesLen-1 do + if assigned(gPasses[i].process) then m := gPasses[i].process(a[i], m); +end; + +procedure processTopLevelStmtCached(n: PNode; var a: TPassContextArray); +var + i: int; + m: PNode; +begin + // this implements the code transformation pipeline + m := n; + for i := 0 to gPassesLen-1 do + if assigned(gPasses[i].openCached) then m := gPasses[i].process(a[i], m); +end; + +procedure closePassesCached(var a: TPassContextArray); +var + i: int; + m: PNode; +begin + m := nil; + for i := 0 to gPassesLen-1 do begin + if assigned(gPasses[i].openCached) and assigned(gPasses[i].close) then + m := gPasses[i].close(a[i], m); + a[i] := nil; // free the memory here + end +end; + +procedure processModule(module: PSym; const filename: string; + stream: PLLStream; rd: PRodReader); +var + p: TParser; + n: PNode; + a: TPassContextArray; + s: PLLStream; + i: int; +begin + if rd = nil then begin + openPasses(a, module, filename); + if stream = nil then begin + s := LLStreamOpen(filename, fmRead); + if s = nil then begin + rawMessage(errCannotOpenFile, filename); + exit + end; + end + else + s := stream; + while true do begin + openParser(p, filename, s); + while true do begin + n := parseTopLevelStmt(p); + if n = nil then break; + processTopLevelStmt(n, a) + end; + closeParser(p); + if s.kind <> llsStdIn then break; + end; + closePasses(a); + // id synchronization point for more consistent code generation: + IDsynchronizationPoint(1000); + end + else begin + openPassesCached(a, module, filename, rd); + n := loadInitSection(rd); + //MessageOut('init section' + renderTree(n)); + for i := 0 to sonsLen(n)-1 do processTopLevelStmtCached(n.sons[i], a); + closePassesCached(a); + end; +end; + +procedure initPass(var p: TPass); +begin + p.open := nil; + p.openCached := nil; + p.close := nil; + p.process := nil; +end; + +end. diff --git a/nim/pragmas.pas b/nim/pragmas.pas index 372d8d4a4..68bc366f1 100644 --- a/nim/pragmas.pas +++ b/nim/pragmas.pas @@ -197,10 +197,10 @@ begin while it <> nil do begin if it.kind = kind then begin if ospCaseInsensitive in platform.OS[targetOS].props then begin - if it.path = path then begin result := it; exit end; + if cmpIgnoreCase(it.path, path) = 0 then begin result := it; exit end; end else begin - if cmpIgnoreCase(it.path, path) = 0 then begin result := it; exit end; + if it.path = path then begin result := it; exit end; end end; it := PLib(it.next) diff --git a/nim/ptmplsyn.pas b/nim/ptmplsyn.pas new file mode 100644 index 000000000..2368b22c7 --- /dev/null +++ b/nim/ptmplsyn.pas @@ -0,0 +1,270 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit ptmplsyn; + +// This module implements the parser of the Nimrod Template files. + +{$include config.inc} + +interface + +uses + nsystem, llstream, nos, charsets, wordrecg, strutils, + ast, astalgo, msgs, options, pnimsyn; + +function ParseTmplFile(const filename: string): PNode; + + +type + TParseState = (psDirective, psMultiDir, psTempl); + TTmplParser = record + inp: PLLStream; + state: TParseState; + info: TLineInfo; + indent, par: int; + x: string; // the current input line + outp: PLLStream; // the ouput will be parsed by pnimsyn + subsChar: Char; + end; + +function ParseTmpl(var p: TTmplParser): PNode; + +procedure openTmplParser(var p: TTmplParser; const filename: string; + inputStream: PLLStream); +procedure closeTmplParser(var p: TTmplParser); + +implementation + +const + NimDirective = '#'; + PatternChars = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255, '.', '_']; + +procedure newLine(var p: TTmplParser); +begin + LLStreamWrite(p.outp, repeatChar(p.par, ')')); + p.par := 0; + if p.info.line > int16(1) then LLStreamWrite(p.outp, nl); +end; + +procedure parseLine(var p: TTmplParser); +var + d, j, curly: int; + keyw: string; +begin + j := strStart; + while p.x[j] = ' ' do inc(j); + if p.state = psMultiDir then begin + newLine(p); + if p.x[j] = '*' then begin + inc(j); + if p.x[j] = NimDirective then p.state := psTempl; + // ignore the rest of the line + end + else + LLStreamWrite(p.outp, p.x); // simply add the whole line + end + else if p.x[j] = NimDirective then begin + newLine(p); + inc(j); + while p.x[j] = ' ' do inc(j); + d := j; + if p.x[j] = '*' then begin + inc(j); + p.state := psMultiDir; + LLStreamWrite(p.outp, repeatChar(p.indent)); + LLStreamWrite(p.outp, '#*'); + LLStreamWrite(p.outp, ncopy(p.x, j)); // simply add the whole line + end + else begin + keyw := ''; + while p.x[j] in PatternChars do begin + addChar(keyw, p.x[j]); + inc(j); + end; + case whichKeyword(keyw) of + wEnd: begin + if p.indent >= 2 then + dec(p.indent, 2) + else begin + p.info.col := int16(j); + liMessage(p.info, errXNotAllowedHere, 'end'); + end; + LLStreamWrite(p.outp, repeatChar(p.indent)); + LLStreamWrite(p.outp, '#end'); + end; + wSubsChar: begin + LLStreamWrite(p.outp, repeatChar(p.indent)); + LLStreamWrite(p.outp, '#subschar'); + while p.x[j] = ' ' do inc(j); + if p.x[j] in ['+', '-', '*', '/', '<', '>', '!', '?', '^', '.', + '|', '=', '%', '&', '$', '@', '~'] then p.subsChar := p.x[j] + else begin + p.info.col := int16(j); + liMessage(p.info, errXNotAllowedHere, p.x[j]+''); + end + end; + wIf, wWhen, wTry, wWhile, wFor, wBlock, wCase, wProc, wIterator, + wConverter, wMacro, wTemplate: begin + LLStreamWrite(p.outp, repeatChar(p.indent)); + LLStreamWrite(p.outp, ncopy(p.x, d)); + inc(p.indent, 2); + end; + wElif, wOf, wElse, wExcept, wFinally: begin + LLStreamWrite(p.outp, repeatChar(p.indent-2)); + LLStreamWrite(p.outp, ncopy(p.x, d)); + end + else begin + LLStreamWrite(p.outp, repeatChar(p.indent)); + LLStreamWrite(p.outp, ncopy(p.x, d)); + end + end; + p.state := psDirective; + end + end + else begin + // data line + j := strStart; + case p.state of + psTempl: begin + // next line of string literal: + LLStreamWrite(p.outp, ' &'+nl); + LLStreamWrite(p.outp, repeatChar(p.indent + 2)); + LLStreamWrite(p.outp, '"'+''); + end; + psDirective: begin + newLine(p); + LLStreamWrite(p.outp, repeatChar(p.indent)); + LLStreamWrite(p.outp, 'add(result, "'); + inc(p.par); + end; + else InternalError(p.info, 'parser in invalid state'); + end; + p.state := psTempl; + while true do begin + case p.x[j] of + #0: break; + #1..#31, #128..#255: begin + LLStreamWrite(p.outp, '\x'); + LLStreamWrite(p.outp, toHex(ord(p.x[j]), 2)); + inc(j); + end; + '\': begin LLStreamWrite(p.outp, '\\'); inc(j); end; + '''': begin LLStreamWrite(p.outp, '\'''); inc(j); end; + '"': begin LLStreamWrite(p.outp, '\"'); inc(j); end; + else if p.x[j] = p.subsChar then begin // parse Nimrod expression: + inc(j); + case p.x[j] of + '{': begin + p.info.col := int16(j); + LLStreamWrite(p.outp, '" & $('); + inc(j); + curly := 0; + while true do begin + case p.x[j] of + #0: liMessage(p.info, errXExpected, '}'+''); + '{': begin + inc(j); + inc(curly); + LLStreamWrite(p.outp, '{'+''); + end; + '}': begin + inc(j); + if curly = 0 then break; + if curly > 0 then dec(curly); + LLStreamWrite(p.outp, '}'+''); + end; + else begin + LLStreamWrite(p.outp, p.x[j]); + inc(j) + end + end + end; + LLStreamWrite(p.outp, ') & "') + end; + 'A'..'Z', 'a'..'z', '_': begin + LLStreamWrite(p.outp, '" & $'); + while p.x[j] in PatternChars do begin + LLStreamWrite(p.outp, p.x[j]); + inc(j) + end; + LLStreamWrite(p.outp, ' & "') + end; + else if p.x[j] = p.subsChar then begin + LLStreamWrite(p.outp, p.subsChar); + inc(j); + end + else begin + p.info.col := int16(j); + liMessage(p.info, errInvalidExpression, '$'+''); + end + end; + end + else begin + LLStreamWrite(p.outp, p.x[j]); + inc(j); + end + end + end; + LLStreamWrite(p.outp, '\n"'); + end +end; + +function ParseTmpl(var p: TTmplParser): PNode; +var + q: TParser; +begin + while not LLStreamAtEnd(p.inp) do begin + p.x := LLStreamReadLine(p.inp) {@ignore} + #0 {@emit}; + p.info.line := p.info.line + int16(1); + parseLine(p); + end; + newLine(p); + if gVerbosity >= 2 then begin + rawMessage(hintCodeBegin); + messageOut(p.outp.s); + rawMessage(hintCodeEnd); + end; + openParser(q, toFilename(p.info), p.outp); + result := ParseModule(q); + closeParser(q); +end; + +procedure openTmplParser(var p: TTmplParser; const filename: string; + inputStream: PLLStream); +begin +{@ignore} + FillChar(p, sizeof(p), 0); +{@emit} + p.info := newLineInfo(filename, 0, 0); + p.outp := LLStreamOpen(''); + p.inp := inputStream; + p.subsChar := '$'; +end; + +procedure CloseTmplParser(var p: TTmplParser); +begin + LLStreamClose(p.inp); +end; + +function ParseTmplFile(const filename: string): PNode; +var + p: TTmplParser; + f: TBinaryFile; +begin + if not OpenFile(f, filename) then begin + rawMessage(errCannotOpenFile, filename); + result := nil; + exit + end; + OpenTmplParser(p, filename, LLStreamOpen(f)); + result := ParseTmpl(p); + CloseTmplParser(p); +end; + +end. diff --git a/nim/rodread.pas b/nim/rodread.pas new file mode 100644 index 000000000..549cfec58 --- /dev/null +++ b/nim/rodread.pas @@ -0,0 +1,1134 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit rodread; + +// This module is responsible for loading of rod files. +(* + Reading and writing binary files are really hard to debug. Therefore we use + a special text format. ROD-files only describe the interface of a module. + Thus they are smaller than the source files most of the time. Even if they + are bigger, they are more efficient to process because symbols are only + loaded on demand. + It consists of: + + - a header: + NIM:$fileversion\n + - the module's id (even if the module changed, its ID will not!): + ID:Ax3\n + - CRC value of this module: + CRC:CRC-val\n + - a section containing the compiler options and defines this + module has been compiled with: + OPTIONS:options\n + DEFINES:defines\n + - FILES( + myfile.inc + lib/mymodA + ) + - a include file dependency section: + INCLUDES( + <fileidx> <CRC of myfile.inc>\n # fileidx is the LINE in the file section! + ) + - a module dependency section: + DEPS: <fileidx> <fileidx>\n + - an interface section: + INTERF( + identifier1 id\n # id is the symbol's id + identifier2 id\n + ) + - a compiler proc section: + COMPILERPROCS( + identifier1 id\n # id is the symbol's id + ) + - an index consisting of (ID, linenumber)-pairs: + INDEX( + id-diff idx-diff\n + id-diff idx-diff\n + ) + - an import index consisting of (ID, moduleID)-pairs: + IMPORTS( + id-diff moduleID-diff\n + id-diff moduleID-diff\n + ) + - a list of all exported type converters because they are needed for correct + semantic checking: + CONVERTERS:id id\n # position of the symbol in the DATA section + - an AST section that contains the module's AST: + INIT( + idx\n # position of the node in the DATA section + idx\n + ) + - a data section, where each type, symbol or AST is stored. + DATA( + type + (node) + sym + ) + + We now also do index compression, because an index always needs to be read. +*) + +interface + +{$include 'config.inc'} + +uses + sysutils, nsystem, nos, options, strutils, nversion, ast, astalgo, msgs, + platform, condsyms, ropes, idents, crc; + +type + TReasonForRecompile = ( + rrEmpty, // used by moddeps module + rrNone, // no need to recompile + rrRodDoesNotExist, // rod file does not exist + rrRodInvalid, // rod file is invalid + rrCrcChange, // file has been edited since last recompilation + rrDefines, // defines have changed + rrOptions, // options have changed + rrInclDeps, // an include has changed + rrModDeps // a module this module depends on has been changed + ); +const + reasonToFrmt: array [TReasonForRecompile] of string = ( + '', + 'no need to recompile: $1', + 'symbol file for $1 does not exist', + 'symbol file for $1 has the wrong version', + 'file edited since last compilation: $1', + 'list of conditional symbols changed for: $1', + 'list of options changed for: $1', + 'an include file edited: $1', + 'a module $1 depends on has changed' + ); + +type + TIndex = record // an index with compression + lastIdxKey, lastIdxVal: int; + tab: TIITable; + r: PRope; // writers use this + offset: int; // readers use this + end; + TRodReader = object(NObject) + pos: int; // position; used for parsing + s: string; // the whole file in memory + options: TOptions; + reason: TReasonForRecompile; + modDeps: TStringSeq; + files: TStringSeq; + dataIdx: int; // offset of start of data section + convertersIdx: int; // offset of start of converters section + initIdx, interfIdx, compilerProcsIdx: int; + filename: string; + index, imports: TIndex; + readerIndex: int; + line: int; // only used for debugging, but is always in the code + moduleID: int; + syms: TIdTable; // already processed symbols + end; + PRodReader = ^TRodReader; + +const + FileVersion = '1012'; // modify this if the rod-format changes! + +var + rodCompilerprocs: TStrTable; // global because this is needed by magicsys + + +function handleSymbolFile(module: PSym; const filename: string): PRodReader; +function GetCRC(const filename: string): TCrc32; + +function loadInitSection(r: PRodReader): PNode; + +procedure loadStub(s: PSym); + +function encodeInt(x: BiggestInt): PRope; +function encode(const s: string): PRope; + +implementation + +var + gTypeTable: TIdTable; + +function rrGetSym(r: PRodReader; id: int; const info: TLineInfo): PSym; forward; + // `info` is only used for debugging purposes + +function rrGetType(r: PRodReader; id: int; const info: TLineInfo): PType; forward; + +function decode(r: PRodReader): string; forward; +function decodeInt(r: PRodReader): int; forward; +function decodeBInt(r: PRodReader): biggestInt; forward; + +function encode(const s: string): PRope; +var + i: int; + res: string; +begin + res := ''; + for i := strStart to length(s)+strStart-1 do begin + case s[i] of + '0'..'9', 'a'..'z', 'A'..'Z', '_': + addChar(res, s[i]); + else + res := res +{&} '\' +{&} toHex(ord(s[i]), 2) + end + end; + result := toRope(res); +end; + +procedure encodeIntAux(var str: string; x: BiggestInt); +const + chars: string = + '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'; +var + v, rem: biggestInt; + d: char; + idx: int; +begin + v := x; + rem := v mod 190; + if (rem < 0) then begin + str := str + '-'; + v := -(v div 190); + rem := -rem; + end + else + v := v div 190; + idx := int(rem); + if idx < 62 then d := chars[idx+strStart] + else d := chr(idx - 62 + 128); + if (v <> 0) then encodeIntAux(str, v); + addChar(str, d); +end; + +function encodeInt(x: BiggestInt): PRope; +var + res: string; +begin + res := ''; + encodeIntAux(res, x); + result := toRope(res); +end; + + +procedure decodeLineInfo(r: PRodReader; var info: TLineInfo); +begin + if r.s[r.pos] = '?' then begin + inc(r.pos); + if r.s[r.pos] = ',' then + info.col := int16(-1) + else + info.col := int16(decodeInt(r)); + if r.s[r.pos] = ',' then begin + inc(r.pos); + if r.s[r.pos] = ',' then info.line := int16(-1) + else info.line := int16(decodeInt(r)); + if r.s[r.pos] = ',' then begin + inc(r.pos); + info := newLineInfo(r.files[decodeInt(r)], info.line, info.col); + end + end + end +end; + +function decodeNode(r: PRodReader; const fInfo: TLineInfo): PNode; +var + id: int; + fl: string; +begin + result := nil; + if r.s[r.pos] = '(' then begin + inc(r.pos); + if r.s[r.pos] = ')' then begin + inc(r.pos); exit; // nil node + end; + result := newNodeI(TNodeKind(decodeInt(r)), fInfo); + decodeLineInfo(r, result.info); + if r.s[r.pos] = '$' then begin + inc(r.pos); + result.flags := {@cast}TNodeFlags(int32(decodeInt(r))); + end; + if r.s[r.pos] = '^' then begin + inc(r.pos); + id := decodeInt(r); + result.typ := rrGetType(r, id, result.info); + end; + case result.kind of + nkCharLit..nkInt64Lit: begin + if r.s[r.pos] = '!' then begin + inc(r.pos); + result.intVal := decodeBInt(r); + end + end; + nkFloatLit..nkFloat64Lit: begin + if r.s[r.pos] = '!' then begin + inc(r.pos); + fl := decode(r); + result.floatVal := parseFloat(fl); + end + end; + nkStrLit..nkTripleStrLit: begin + if r.s[r.pos] = '!' then begin + inc(r.pos); + result.strVal := decode(r); + end + else + result.strVal := ''; // BUGFIX + end; + nkIdent: begin + if r.s[r.pos] = '!' then begin + inc(r.pos); + fl := decode(r); + result.ident := getIdent(fl); + end + else + internalError(result.info, 'decodeNode: nkIdent'); + end; + nkSym: begin + if r.s[r.pos] = '!' then begin + inc(r.pos); + id := decodeInt(r); + result.sym := rrGetSym(r, id, result.info); + end + else + internalError(result.info, 'decodeNode: nkSym'); + end; + else begin + while r.s[r.pos] <> ')' do + addSon(result, decodeNode(r, result.info)); + end + end; + if r.s[r.pos] = ')' then inc(r.pos) + else internalError(result.info, 'decodeNode'); + end + else InternalError(result.info, 'decodeNode ' + r.s[r.pos]) +end; + +procedure decodeLoc(r: PRodReader; var loc: TLoc; const info: TLineInfo); +begin + if r.s[r.pos] = '<' then begin + inc(r.pos); + if r.s[r.pos] in ['0'..'9', 'a'..'z', 'A'..'Z'] then + loc.k := TLocKind(decodeInt(r)) + else + loc.k := low(loc.k); + if r.s[r.pos] = '*' then begin + inc(r.pos); + loc.s := TStorageLoc(decodeInt(r)); + end + else + loc.s := low(loc.s); + if r.s[r.pos] = '$' then begin + inc(r.pos); + loc.flags := {@cast}TLocFlags(int32(decodeInt(r))); + end + else + loc.flags := {@set}[]; + if r.s[r.pos] = '^' then begin + inc(r.pos); + loc.t := rrGetType(r, decodeInt(r), info); + end + else + loc.t := nil; + if r.s[r.pos] = '!' then begin + inc(r.pos); + loc.r := toRope(decode(r)); + end + else + loc.r := nil; + if r.s[r.pos] = '?' then begin + inc(r.pos); + loc.a := decodeInt(r); + end + else + loc.a := 0; + if r.s[r.pos] = '>' then inc(r.pos) + else InternalError(info, 'decodeLoc ' + r.s[r.pos]); + end +end; + +function decodeType(r: PRodReader; const info: TLineInfo): PType; +var + d: int; +begin + result := nil; + if r.s[r.pos] = '[' then begin + inc(r.pos); + if r.s[r.pos] = ']' then begin + inc(r.pos); exit; // nil type + end; + end; + new(result); +{@ignore} + FillChar(result^, sizeof(result^), 0); +{@emit} + result.kind := TTypeKind(decodeInt(r)); + if r.s[r.pos] = '+' then begin + inc(r.pos); + result.id := decodeInt(r); + setId(result.id); + if debugIds then registerID(result); + end + else + InternalError(info, 'decodeType: no id'); + IdTablePut(gTypeTable, result, result); // here this also + // avoids endless recursion for recursive type + if r.s[r.pos] = '(' then + result.n := decodeNode(r, UnknownLineInfo()); + if r.s[r.pos] = '$' then begin + inc(r.pos); + result.flags := {@cast}TTypeFlags(int32(decodeInt(r))); + end; + if r.s[r.pos] = '?' then begin + inc(r.pos); + result.callConv := TCallingConvention(decodeInt(r)); + end; + if r.s[r.pos] = '*' then begin + inc(r.pos); + result.owner := rrGetSym(r, decodeInt(r), info); + end; + if r.s[r.pos] = '&' then begin + inc(r.pos); + result.sym := rrGetSym(r, decodeInt(r), info); + end; + if r.s[r.pos] = '/' then begin + inc(r.pos); + result.size := decodeInt(r); + end + else result.size := -1; + if r.s[r.pos] = '=' then begin + inc(r.pos); + result.align := decodeInt(r); + end + else result.align := 2; + if r.s[r.pos] = '@' then begin + inc(r.pos); + result.containerID := decodeInt(r); + end; + decodeLoc(r, result.loc, info); + while r.s[r.pos] = '^' do begin + inc(r.pos); + if r.s[r.pos] = '(' then begin + inc(r.pos); + if r.s[r.pos] = ')' then inc(r.pos) + else InternalError(info, 'decodeType ^(' + r.s[r.pos]); + addSon(result, nil); + end + else begin + d := decodeInt(r); + addSon(result, rrGetType(r, d, info)); + end; + end +end; + +function decodeLib(r: PRodReader): PLib; +begin + result := nil; + if r.s[r.pos] = '|' then begin + new(result); + {@ignore} + fillChar(result^, sizeof(result^), 0); + {@emit} + inc(r.pos); + result.kind := TLibKind(decodeInt(r)); + if r.s[r.pos] <> '|' then InternalError('decodeLib: 1'); + inc(r.pos); + result.name := toRope(decode(r)); + if r.s[r.pos] <> '|' then InternalError('decodeLib: 2'); + inc(r.pos); + result.path := decode(r); + end +end; + +function decodeSym(r: PRodReader; const info: TLineInfo): PSym; +var + k: TSymKind; + id: int; + ident: PIdent; +begin + result := nil; + if r.s[r.pos] = '{' then begin + inc(r.pos); + if r.s[r.pos] = '}' then begin + inc(r.pos); exit; // nil sym + end + end; + k := TSymKind(decodeInt(r)); + if r.s[r.pos] = '+' then begin + inc(r.pos); + id := decodeInt(r); + setId(id); + end + else + InternalError(info, 'decodeSym: no id'); + if r.s[r.pos] = '&' then begin + inc(r.pos); + ident := getIdent(decode(r)); + end + else + InternalError(info, 'decodeSym: no ident'); + result := PSym(IdTableGet(r.syms, id)); + if result = nil then begin + new(result); + {@ignore} + FillChar(result^, sizeof(result^), 0); + {@emit} + result.id := id; + IdTablePut(r.syms, result, result); + if debugIds then registerID(result); + end + else if (result.id <> id) then + InternalError(info, 'decodeSym: wrong id'); + result.kind := k; + result.name := ident; + // read the rest of the symbol description: + if r.s[r.pos] = '^' then begin + inc(r.pos); + result.typ := rrGetType(r, decodeInt(r), info); + end; + decodeLineInfo(r, result.info); + if r.s[r.pos] = '*' then begin + inc(r.pos); + result.owner := rrGetSym(r, decodeInt(r), result.info); + end; + if r.s[r.pos] = '$' then begin + inc(r.pos); + result.flags := {@cast}TSymFlags(int32(decodeInt(r))); + end; + if r.s[r.pos] = '@' then begin + inc(r.pos); + result.magic := TMagic(decodeInt(r)); + end; + if r.s[r.pos] = '(' then + result.ast := decodeNode(r, result.info); + if r.s[r.pos] = '!' then begin + inc(r.pos); + result.options := {@cast}TOptions(int32(decodeInt(r))); + end + else + result.options := r.options; + if r.s[r.pos] = '%' then begin + inc(r.pos); + result.position := decodeInt(r); + end + else + result.position := 0; // BUGFIX: this may have been misused as reader index! + if r.s[r.pos] = '`' then begin + inc(r.pos); + result.offset := decodeInt(r); + end + else + result.offset := -1; + decodeLoc(r, result.loc, result.info); + result.annex := decodeLib(r); +end; + +function decodeInt(r: PRodReader): int; // base 190 numbers +var + i: int; + sign: int; +begin + i := r.pos; + sign := -1; + assert(r.s[i] in ['0'..'9', 'a'..'z', 'A'..'Z', '-', #128..#255]); + if r.s[i] = '-' then begin + inc(i); + sign := 1 + end; + result := 0; + while true do begin + case r.s[i] of + '0'..'9': result := result * 190 - (ord(r.s[i]) - ord('0')); + 'a'..'z': result := result * 190 - (ord(r.s[i]) - ord('a') + 10); + 'A'..'Z': result := result * 190 - (ord(r.s[i]) - ord('A') + 36); + #128..#255: result := result * 190 - (ord(r.s[i]) - 128 + 62); + else break; + end; + inc(i) + end; + result := result * sign; + r.pos := i +end; + +function decodeBInt(r: PRodReader): biggestInt; +var + i: int; + sign: biggestInt; +begin + i := r.pos; + sign := -1; + assert(r.s[i] in ['0'..'9', 'a'..'z', 'A'..'Z', '-', #128..#255]); + if r.s[i] = '-' then begin + inc(i); + sign := 1 + end; + result := 0; + while true do begin + case r.s[i] of + '0'..'9': result := result * 190 - (ord(r.s[i]) - ord('0')); + 'a'..'z': result := result * 190 - (ord(r.s[i]) - ord('a') + 10); + 'A'..'Z': result := result * 190 - (ord(r.s[i]) - ord('A') + 36); + #128..#255: result := result * 190 - (ord(r.s[i]) - 128 + 62); + else break; + end; + inc(i) + end; + result := result * sign; + r.pos := i +end; + +procedure hexChar(c: char; var xi: int); +begin + case c of + '0'..'9': xi := (xi shl 4) or (ord(c) - ord('0')); + 'a'..'f': xi := (xi shl 4) or (ord(c) - ord('a') + 10); + 'A'..'F': xi := (xi shl 4) or (ord(c) - ord('A') + 10); + else begin end + end +end; + +function decode(r: PRodReader): string; +var + i, xi: int; +begin + i := r.pos; + result := ''; + while true do begin + case r.s[i] of + '\': begin + inc(i, 3); xi := 0; + hexChar(r.s[i-2], xi); + hexChar(r.s[i-1], xi); + addChar(result, chr(xi)); + end; + 'a'..'z', '0'..'9', 'A'..'Z', '_': begin + addChar(result, r.s[i]); + inc(i); + end + else break + end + end; + r.pos := i; +end; + +procedure skipSection(r: PRodReader); +var + c: int; +begin + if r.s[r.pos] = ':' then begin + while r.s[r.pos] > #10 do inc(r.pos); + end + else if r.s[r.pos] = '(' then begin + c := 0; // count () pairs + inc(r.pos); + while true do begin + case r.s[r.pos] of + #10: inc(r.line); + '(': inc(c); + ')': begin + if c = 0 then begin inc(r.pos); break end + else if c > 0 then dec(c); + end; + #0: break; // end of file + else begin end; + end; + inc(r.pos); + end + end + else + InternalError('skipSection ' + toString(r.line)); +end; + +function rdWord(r: PRodReader): string; +begin + result := ''; + while r.s[r.pos] in ['A'..'Z', '_', 'a'..'z', '0'..'9'] do begin + addChar(result, r.s[r.pos]); + inc(r.pos); + end; +end; + +function newStub(r: PRodReader; const name: string; id: int): PSym; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + result.kind := skStub; + result.id := id; + result.name := getIdent(name); + result.position := r.readerIndex; + setID(id); + //MessageOut(result.name.s); + if debugIds then registerID(result); +end; + +procedure processInterf(r: PRodReader; module: PSym); +var + s: PSym; + w: string; + key: int; +begin + if r.interfIdx = 0 then InternalError('processInterf'); + r.pos := r.interfIdx; + while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin + w := decode(r); + inc(r.pos); + key := decodeInt(r); + inc(r.pos); // #10 + s := newStub(r, w, key); + s.owner := module; + StrTableAdd(module.tab, s); + IdTablePut(r.syms, s, s); + end; +end; + +procedure processCompilerProcs(r: PRodReader; module: PSym); +var + s: PSym; + w: string; + key: int; +begin + if r.compilerProcsIdx = 0 then InternalError('processCompilerProcs'); + r.pos := r.compilerProcsIdx; + while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin + w := decode(r); + inc(r.pos); + key := decodeInt(r); + inc(r.pos); // #10 + s := PSym(IdTableGet(r.syms, key)); + if s = nil then begin + s := newStub(r, w, key); + s.owner := module; + IdTablePut(r.syms, s, s); + end; + StrTableAdd(rodCompilerProcs, s); + end; +end; + +procedure processIndex(r: PRodReader; var idx: TIndex); +var + key, val, tmp: int; +begin + inc(r.pos, 2); // skip "(\10" + inc(r.line); + while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin + tmp := decodeInt(r); + if r.s[r.pos] = ' ' then begin + inc(r.pos); + key := idx.lastIdxKey + tmp; + val := decodeInt(r) + idx.lastIdxVal; + end + else begin + key := idx.lastIdxKey + 1; + val := tmp + idx.lastIdxVal; + end; + IITablePut(idx.tab, key, val); + idx.lastIdxKey := key; + idx.lastIdxVal := val; + setID(key); // ensure that this id will not be used + if r.s[r.pos] = #10 then begin inc(r.pos); inc(r.line) end; + end; + if r.s[r.pos] = ')' then inc(r.pos); +end; + +procedure processRodFile(r: PRodReader; crc: TCrc32); +var + section, w: string; + d, L, inclCrc: int; +begin + while r.s[r.pos] <> #0 do begin + section := rdWord(r); + if r.reason <> rrNone then break; // no need to process this file further + if section = 'CRC' then begin + inc(r.pos); // skip ':' + if int(crc) <> decodeInt(r) then + r.reason := rrCrcChange + end + else if section = 'ID' then begin + inc(r.pos); // skip ':' + r.moduleID := decodeInt(r); + setID(r.moduleID); + end + else if section = 'OPTIONS' then begin + inc(r.pos); // skip ':' + r.options := {@cast}TOptions(int32(decodeInt(r))); + if options.gOptions <> r.options then r.reason := rrOptions + end + else if section = 'DEFINES' then begin + inc(r.pos); // skip ':' + d := 0; + while r.s[r.pos] > #10 do begin + w := decode(r); + inc(d); + if not condsyms.isDefined(getIdent(w)) then begin + r.reason := rrDefines; + //MessageOut('not defined, but should: ' + w); + end; + if r.s[r.pos] = ' ' then inc(r.pos); + end; + if (d <> countDefinedSymbols()) then + r.reason := rrDefines + end + else if section = 'FILES' then begin + inc(r.pos, 2); // skip "(\10" + inc(r.line); + L := 0; + while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin + setLength(r.files, L+1); + r.files[L] := decode(r); + inc(r.pos); // skip #10 + inc(r.line); + inc(L); + end; + if r.s[r.pos] = ')' then inc(r.pos); + end + else if section = 'INCLUDES' then begin + inc(r.pos, 2); // skip "(\10" + inc(r.line); + while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin + w := r.files[decodeInt(r)]; + inc(r.pos); // skip ' ' + inclCrc := decodeInt(r); + if r.reason = rrNone then begin + if not ExistsFile(w) or (inclCrc <> int(crcFromFile(w))) then + r.reason := rrInclDeps + end; + if r.s[r.pos] = #10 then begin inc(r.pos); inc(r.line) end; + end; + if r.s[r.pos] = ')' then inc(r.pos); + end + else if section = 'DEPS' then begin + inc(r.pos); // skip ':' + L := 0; + while (r.s[r.pos] > #10) do begin + setLength(r.modDeps, L+1); + r.modDeps[L] := r.files[decodeInt(r)]; + inc(L); + if r.s[r.pos] = ' ' then inc(r.pos); + end; + end + else if section = 'INTERF' then begin + r.interfIdx := r.pos+2; + skipSection(r); + end + else if section = 'COMPILERPROCS' then begin + r.compilerProcsIdx := r.pos+2; + skipSection(r); + end + else if section = 'INDEX' then begin + processIndex(r, r.index); + end + else if section = 'IMPORTS' then begin + processIndex(r, r.imports); + end + else if section = 'CONVERTERS' then begin + r.convertersIdx := r.pos+1; + skipSection(r); + end + else if section = 'DATA' then begin + r.dataIdx := r.pos+2; // "(\10" + // We do not read the DATA section here! We read the needed objects on + // demand. + skipSection(r); + end + else if section = 'INIT' then begin + r.initIdx := r.pos+2; // "(\10" + skipSection(r); + end + else begin + MessageOut('skipping section: ' + toString(r.pos)); + skipSection(r); + end; + if r.s[r.pos] = #10 then begin inc(r.pos); inc(r.line) end; + end +end; + +function newRodReader(const modfilename: string; crc: TCrc32; + readerIndex: int): PRodReader; +var + version: string; + r: PRodReader; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit result.files := @[];} +{@emit result.modDeps := @[];} + r := result; + r.reason := rrNone; + r.pos := strStart; + r.line := 1; + r.readerIndex := readerIndex; + r.filename := modfilename; + InitIdTable(r.syms); + r.s := readFile(modfilename) {@ignore} + #0 {@emit}; + if startsWith(r.s, 'NIM:') then begin + initIITable(r.index.tab); + initIITable(r.imports.tab); + // looks like a ROD file + inc(r.pos, 4); + version := ''; + while not (r.s[r.pos] in [#0,#10]) do begin + addChar(version, r.s[r.pos]); + inc(r.pos); + end; + if r.s[r.pos] = #10 then inc(r.pos); + if version = FileVersion then begin + // since ROD files are only for caching, no backwarts compability is + // needed + processRodFile(r, crc); + end + else + result := nil + end + else + result := nil; +end; + +function rrGetType(r: PRodReader; id: int; const info: TLineInfo): PType; +var + oldPos, d: int; +begin + result := PType(IdTableGet(gTypeTable, id)); + if result = nil then begin + // load the type: + oldPos := r.pos; + d := IITableGet(r.index.tab, id); + if d = invalidKey then InternalError(info, 'rrGetType'); + r.pos := d + r.dataIdx; + result := decodeType(r, info); + r.pos := oldPos; + end; +end; + +type + TFileModuleRec = record + filename: string; + reason: TReasonForRecompile; + rd: PRodReader; + crc: TCrc32; + end; + TFileModuleMap = array of TFileModuleRec; +var + gMods: TFileModuleMap = {@ignore} nil {@emit @[]}; // all compiled modules + +function decodeSymSafePos(rd: PRodReader; offset: int; + const info: TLineInfo): PSym; +var + oldPos: int; +begin + if rd.dataIdx = 0 then InternalError(info, 'dataIdx == 0'); + oldPos := rd.pos; + rd.pos := offset + rd.dataIdx; + result := decodeSym(rd, info); + rd.pos := oldPos; +end; + +function rrGetSym(r: PRodReader; id: int; const info: TLineInfo): PSym; +var + d, i, moduleID: int; + rd: PRodReader; +begin + result := PSym(IdTableGet(r.syms, id)); + if result = nil then begin + // load the symbol: + d := IITableGet(r.index.tab, id); + if d = invalidKey then begin + moduleID := IiTableGet(r.imports.tab, id); + if moduleID < 0 then + InternalError(info, + 'missing from both indexes: +' + ropeToStr(encodeInt(id))); + // find the reader with the correct moduleID: + for i := 0 to high(gMods) do begin + rd := gMods[i].rd; + if (rd <> nil) then begin + if (rd.moduleID = moduleID) then begin + d := IITableGet(rd.index.tab, id); + if d <> invalidKey then begin + result := decodeSymSafePos(rd, d, info); + break + end + else + InternalError(info, + 'rrGetSym: no reader found: +' + ropeToStr(encodeInt(id))); + end + else begin + //if IiTableGet(rd.index.tab, id) <> invalidKey then + // XXX expensive check! + //InternalError(info, + //'id found in other module: +' + ropeToStr(encodeInt(id))) + end + end + end; + end + else begin + // own symbol: + result := decodeSymSafePos(r, d, info); + end; + end; + if (result <> nil) and (result.kind = skStub) then loadStub(result); +end; + +function loadInitSection(r: PRodReader): PNode; +var + d, oldPos, p: int; +begin + if (r.initIdx = 0) or (r.dataIdx = 0) then InternalError('loadInitSection'); + oldPos := r.pos; + r.pos := r.initIdx; + result := newNode(nkStmtList); + while (r.s[r.pos] > #10) and (r.s[r.pos] <> ')') do begin + d := decodeInt(r); + inc(r.pos); // #10 + p := r.pos; + r.pos := d + r.dataIdx; + addSon(result, decodeNode(r, UnknownLineInfo())); + r.pos := p; + end; + r.pos := oldPos; +end; + +procedure loadConverters(r: PRodReader); +var + d: int; +begin + // We have to ensure that no exported converter is a stub anymore. + if (r.convertersIdx = 0) or (r.dataIdx = 0) then + InternalError('importConverters'); + r.pos := r.convertersIdx; + while (r.s[r.pos] > #10) do begin + d := decodeInt(r); + {@discard} rrGetSym(r, d, UnknownLineInfo()); + if r.s[r.pos] = ' ' then inc(r.pos) + end; +end; + +function getModuleIdx(const filename: string): int; +var + i: int; +begin + for i := 0 to high(gMods) do + if sameFile(gMods[i].filename, filename) then begin + result := i; exit + end; + // not found, reserve space: + result := length(gMods); + setLength(gMods, result+1); +end; + +function checkDep(const filename: string): TReasonForRecompile; +var + crc: TCrc32; + r: PRodReader; + rodfile: string; + idx, i: int; + res: TReasonForRecompile; +begin + idx := getModuleIdx(filename); + if gMods[idx].reason <> rrEmpty then begin + // reason has already been computed for this module: + result := gMods[idx].reason; exit + end; + crc := crcFromFile(filename); + gMods[idx].reason := rrNone; // we need to set it here to avoid cycles + gMods[idx].filename := filename; + gMods[idx].crc := crc; + result := rrNone; + r := nil; + rodfile := toGeneratedFile(filename, RodExt); + if ExistsFile(rodfile) then begin + r := newRodReader(rodfile, crc, idx); + if r = nil then + result := rrRodInvalid + else begin + result := r.reason; + if result = rrNone then begin + // check modules it depends on + // NOTE: we need to process the entire module graph so that no ID will + // be used twice! However, compilation speed does not suffer much from + // this, since results are cached. + res := checkDep(JoinPath(options.libpath, + appendFileExt('system', nimExt))); + if res <> rrNone then result := rrModDeps; + for i := 0 to high(r.modDeps) do begin + res := checkDep(r.modDeps[i]); + if res <> rrNone then begin + result := rrModDeps; + //break // BUGFIX: cannot break here! + end + end + end + end + end + else + result := rrRodDoesNotExist; + if (result <> rrNone) and (gVerbosity > 0) then + MessageOut(format(reasonToFrmt[result], [filename])); + if (result <> rrNone) or (optForceFullMake in gGlobalOptions) then begin + // recompilation is necessary: + r := nil; + end; + gMods[idx].rd := r; + gMods[idx].reason := result; // now we know better +end; + +function handleSymbolFile(module: PSym; const filename: string): PRodReader; +var + idx: int; +begin + if not (optSymbolFiles in gGlobalOptions) then begin + module.id := getID(); + result := nil; + exit + end; + {@discard} checkDep(filename); + idx := getModuleIdx(filename); + if gMods[idx].reason = rrEmpty then InternalError('handleSymbolFile'); + result := gMods[idx].rd; + if result <> nil then begin + module.id := result.moduleID; + IdTablePut(result.syms, module, module); + processInterf(result, module); + processCompilerProcs(result, module); + loadConverters(result); + end + else + module.id := getID(); +end; + +function GetCRC(const filename: string): TCrc32; +var + idx: int; +begin + idx := getModuleIdx(filename); + result := gMods[idx].crc; +end; + +procedure loadStub(s: PSym); +var + rd: PRodReader; + d, theId: int; + rs: PSym; +begin + if s.kind <> skStub then InternalError('loadStub'); + //MessageOut('loading stub: ' + s.name.s); + rd := gMods[s.position].rd; + theId := s.id; // used for later check + d := IITableGet(rd.index.tab, s.id); + if d = invalidKey then InternalError('loadStub: invalid key'); + rs := decodeSymSafePos(rd, d, UnknownLineInfo()); + if rs <> s then InternalError(rs.info, 'loadStub: wrong symbol') + else if rs.id <> theId then InternalError(rs.info, 'loadStub: wrong ID'); + //MessageOut('loaded stub: ' + s.name.s); +end; + +initialization + InitIdTable(gTypeTable); + InitStrTable(rodCompilerProcs); +end. diff --git a/nim/rodwrite.pas b/nim/rodwrite.pas new file mode 100644 index 000000000..64f3d6733 --- /dev/null +++ b/nim/rodwrite.pas @@ -0,0 +1,609 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit rodwrite; + +// This module is responsible for writing of rod files. Note that writing of +// rod files is a pass, reading of rod files is not! This is why reading and +// writing of rod files is split into two different modules. + +interface + +{$include 'config.inc'} + +uses + sysutils, nsystem, nos, options, strutils, nversion, ast, astalgo, msgs, + platform, condsyms, ropes, idents, crc, rodread, passes, importer; + +function rodwritePass(): TPass; + +implementation + +type + TRodWriter = object(TPassContext) + module: PSym; + crc: TCrc32; + options: TOptions; + defines: PRope; + inclDeps: PRope; + modDeps: PRope; + interf: PRope; + compilerProcs: PRope; + index, imports: TIndex; + converters: PRope; + init: PRope; + data: PRope; + filename: string; + sstack: TSymSeq; // a stack of symbols to process + tstack: TTypeSeq; // a stack of types to process + files: TStringSeq; + end; + PRodWriter = ^TRodWriter; + +function newRodWriter(const modfilename: string; crc: TCrc32; + module: PSym): PRodWriter; forward; +procedure addModDep(w: PRodWriter; const dep: string); forward; +procedure addInclDep(w: PRodWriter; const dep: string); forward; +procedure addInterfaceSym(w: PRodWriter; s: PSym); forward; +procedure addStmt(w: PRodWriter; n: PNode); forward; +procedure writeRod(w: PRodWriter); forward; + +function encodeStr(w: PRodWriter; const s: string): PRope; +begin + result := encode(s) +end; + +procedure processStacks(w: PRodWriter); forward; + +function getDefines: PRope; +var + it: TTabIter; + s: PSym; +begin + s := InitTabIter(it, gSymbols); + result := nil; + while s <> nil do begin + if s.position = 1 then begin + if result <> nil then app(result, ' '+''); + app(result, s.name.s); + end; + s := nextIter(it, gSymbols); + end +end; + +function fileIdx(w: PRodWriter; const filename: string): int; +var + i: int; +begin + for i := 0 to high(w.files) do begin + if w.files[i] = filename then begin result := i; exit end; + end; + result := length(w.files); + setLength(w.files, result+1); + w.files[result] := filename; +end; + +function newRodWriter(const modfilename: string; crc: TCrc32; + module: PSym): PRodWriter; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit + result.sstack := @[];} +{@emit + result.tstack := @[];} + InitIITable(result.index.tab); + InitIITable(result.imports.tab); + result.filename := modfilename; + result.crc := crc; + result.module := module; + result.defines := getDefines(); + result.options := options.gOptions; + {@emit result.files := @[];} +end; + +procedure addModDep(w: PRodWriter; const dep: string); +begin + if w.modDeps <> nil then app(w.modDeps, ' '+''); + app(w.modDeps, encodeInt(fileIdx(w, dep))); +end; + +const + rodNL = #10+''; + +procedure addInclDep(w: PRodWriter; const dep: string); +begin + app(w.inclDeps, encodeInt(fileIdx(w, dep))); + app(w.inclDeps, ' '+''); + app(w.inclDeps, encodeInt(crcFromFile(dep))); + app(w.inclDeps, rodNL); +end; + +procedure pushType(w: PRodWriter; t: PType); +var + L: int; +begin + // check so that the stack does not grow too large: + if IiTableGet(w.index.tab, t.id) = invalidKey then begin + L := length(w.tstack); + setLength(w.tstack, L+1); + w.tstack[L] := t; + end +end; + +procedure pushSym(w: PRodWriter; s: PSym); +var + L: int; +begin + // check so that the stack does not grow too large: + if IiTableGet(w.index.tab, s.id) = invalidKey then begin + L := length(w.sstack); + setLength(w.sstack, L+1); + w.sstack[L] := s; + end +end; + +function encodeNode(w: PRodWriter; const fInfo: TLineInfo; n: PNode): PRope; +var + i: int; + f: TNodeFlags; +begin + if n = nil then begin + // nil nodes have to be stored too: + result := toRope('()'); exit + end; + result := toRope('('+''); + app(result, encodeInt(ord(n.kind))); + // we do not write comments for now + // Line information takes easily 20% or more of the filesize! Therefore we + // omit line information if it is the same as the father's line information: + if (finfo.fileIndex <> n.info.fileIndex) then + appf(result, '?$1,$2,$3', [encodeInt(n.info.col), encodeInt(n.info.line), + encodeInt(fileIdx(w, toFilename(n.info)))]) + else if (finfo.line <> n.info.line) then + appf(result, '?$1,$2', [encodeInt(n.info.col), encodeInt(n.info.line)]) + else if (finfo.col <> n.info.col) then + appf(result, '?$1', [encodeInt(n.info.col)]); + // No need to output the file index, as this is the serialization of one + // file. + f := n.flags * PersistentNodeFlags; + if f <> {@set}[] then + appf(result, '$$$1', [encodeInt({@cast}int32(f))]); + if n.typ <> nil then begin + appf(result, '^$1', [encodeInt(n.typ.id)]); + pushType(w, n.typ); + end; + case n.kind of + nkCharLit..nkInt64Lit: begin + if n.intVal <> 0 then + appf(result, '!$1', [encodeInt(n.intVal)]); + end; + nkFloatLit..nkFloat64Lit: begin + if n.floatVal <> 0.0 then + appf(result, '!$1', [encodeStr(w, toStringF(n.floatVal))]); + end; + nkStrLit..nkTripleStrLit: begin + if n.strVal <> '' then + appf(result, '!$1', [encodeStr(w, n.strVal)]); + end; + nkIdent: + appf(result, '!$1', [encodeStr(w, n.ident.s)]); + nkSym: begin + appf(result, '!$1', [encodeInt(n.sym.id)]); + pushSym(w, n.sym); + end; + else begin + for i := 0 to sonsLen(n)-1 do + app(result, encodeNode(w, n.info, n.sons[i])); + end + end; + app(result, ')'+''); +end; + +function encodeLoc(w: PRodWriter; const loc: TLoc): PRope; +begin + result := nil; + if loc.k <> low(loc.k) then + app(result, encodeInt(ord(loc.k))); + if loc.s <> low(loc.s) then + appf(result, '*$1', [encodeInt(ord(loc.s))]); + if loc.flags <> {@set}[] then + appf(result, '$$$1', [encodeInt({@cast}int32(loc.flags))]); + if loc.t <> nil then begin + appf(result, '^$1', [encodeInt(loc.t.id)]); + pushType(w, loc.t); + end; + if loc.r <> nil then + appf(result, '!$1', [encodeStr(w, ropeToStr(loc.r))]); + if loc.a <> 0 then + appf(result, '?$1', [encodeInt(loc.a)]); + if result <> nil then + result := ropef('<$1>', [result]); +end; + +function encodeType(w: PRodWriter; t: PType): PRope; +var + i: int; +begin + if t = nil then begin + // nil nodes have to be stored too: + result := toRope('[]'); exit + end; + result := nil; + if t.kind = tyForward then InternalError('encodeType: tyForward'); + app(result, encodeInt(ord(t.kind))); + appf(result, '+$1', [encodeInt(t.id)]); + if t.n <> nil then + app(result, encodeNode(w, UnknownLineInfo(), t.n)); + if t.flags <> {@set}[] then + appf(result, '$$$1', [encodeInt({@cast}int32(t.flags))]); + if t.callConv <> low(t.callConv) then + appf(result, '?$1', [encodeInt(ord(t.callConv))]); + if t.owner <> nil then begin + appf(result, '*$1', [encodeInt(t.owner.id)]); + pushSym(w, t.owner); + end; + if t.sym <> nil then begin + appf(result, '&$1', [encodeInt(t.sym.id)]); + pushSym(w, t.sym); + end; + if t.size <> -1 then appf(result, '/$1', [encodeInt(t.size)]); + if t.align <> 2 then appf(result, '=$1', [encodeInt(t.align)]); + if t.containerID <> 0 then + appf(result, '@$1', [encodeInt(t.containerID)]); + app(result, encodeLoc(w, t.loc)); + for i := 0 to sonsLen(t)-1 do begin + if t.sons[i] = nil then + app(result, '^()') + else begin + appf(result, '^$1', [encodeInt(t.sons[i].id)]); + pushType(w, t.sons[i]); + end + end; +end; + +function encodeLib(w: PRodWriter; lib: PLib): PRope; +begin + result := nil; + appf(result, '|$1', [encodeInt(ord(lib.kind))]); + appf(result, '|$1', [encodeStr(w, ropeToStr(lib.name))]); + appf(result, '|$1', [encodeStr(w, lib.path)]); +end; + +function encodeSym(w: PRodWriter; s: PSym): PRope; +var + codeAst: PNode; + col, line: PRope; +begin + codeAst := nil; + if s = nil then begin + // nil nodes have to be stored too: + result := toRope('{}'); exit + end; + result := nil; + app(result, encodeInt(ord(s.kind))); + appf(result, '+$1', [encodeInt(s.id)]); + appf(result, '&$1', [encodeStr(w, s.name.s)]); + if s.typ <> nil then begin + appf(result, '^$1', [encodeInt(s.typ.id)]); + pushType(w, s.typ); + end; + if s.info.col = int16(-1) then col := nil + else col := encodeInt(s.info.col); + if s.info.line = int16(-1) then line := nil + else line := encodeInt(s.info.line); + appf(result, '?$1,$2,$3', [col, line, + encodeInt(fileIdx(w, toFilename(s.info)))]); + if s.owner <> nil then begin + appf(result, '*$1', [encodeInt(s.owner.id)]); + pushSym(w, s.owner); + end; + if s.flags <> {@set}[] then + appf(result, '$$$1', [encodeInt({@cast}int32(s.flags))]); + if s.magic <> mNone then + appf(result, '@$1', [encodeInt(ord(s.magic))]); + if (s.ast <> nil) then begin + if not astNeeded(s) then begin + codeAst := s.ast.sons[codePos]; + s.ast.sons[codePos] := nil; + end; + app(result, encodeNode(w, s.info, s.ast)); + if codeAst <> nil then // restore code ast + s.ast.sons[codePos] := codeAst; + end; + if s.options <> w.options then + appf(result, '!$1', [encodeInt({@cast}int32(s.options))]); + if s.position <> 0 then + appf(result, '%$1', [encodeInt(s.position)]); + if s.offset <> -1 then + appf(result, '`$1', [encodeInt(s.offset)]); + app(result, encodeLoc(w, s.loc)); + if s.annex <> nil then + app(result, encodeLib(w, s.annex)); +end; + +procedure addToIndex(var w: TIndex; key, val: int); +begin + if key - w.lastIdxKey = 1 then begin + // we do not store a key-diff of 1 to safe space + app(w.r, encodeInt(val - w.lastIdxVal)); + app(w.r, rodNL); + end + else + appf(w.r, '$1 $2'+rodNL, [encodeInt(key - w.lastIdxKey), + encodeInt(val - w.lastIdxVal)]); + w.lastIdxKey := key; + w.lastIdxVal := val; + IiTablePut(w.tab, key, val); +end; + +var + debugWritten: TIntSet; + +procedure symStack(w: PRodWriter); +var + i, L: int; + s, m: PSym; +begin + i := 0; + while i < length(w.sstack) do begin + s := w.sstack[i]; + if IiTableGet(w.index.tab, s.id) = invalidKey then begin + m := getModule(s); + if m = nil then InternalError('symStack: module nil: ' + s.name.s); + if (m.id = w.module.id) or (sfFromGeneric in s.flags) then begin + // put definition in here + L := ropeLen(w.data); + addToIndex(w.index, s.id, L); + //intSetIncl(debugWritten, s.id); + app(w.data, encodeSym(w, s)); + app(w.data, rodNL); + if sfInInterface in s.flags then + appf(w.interf, '$1 $2'+rodNL, [encode(s.name.s), encodeInt(s.id)]); + if sfCompilerProc in s.flags then + appf(w.compilerProcs, '$1 $2'+rodNL, [encode(s.name.s), encodeInt(s.id)]); + if s.kind = skConverter then begin + if w.converters <> nil then app(w.converters, ' '+''); + app(w.converters, encodeInt(s.id)) + end + end + else if IiTableGet(w.imports.tab, s.id) = invalidKey then begin + addToIndex(w.imports, s.id, m.id); + //if not IntSetContains(debugWritten, s.id) then begin + // MessageOut(w.filename); + // debug(s.owner); + // debug(s); + // InternalError('BUG!!!!'); + //end + end + end; + inc(i); + end; + setLength(w.sstack, 0); +end; + +procedure typeStack(w: PRodWriter); +var + i, L: int; +begin + i := 0; + while i < length(w.tstack) do begin + if IiTableGet(w.index.tab, w.tstack[i].id) = invalidKey then begin + L := ropeLen(w.data); + addToIndex(w.index, w.tstack[i].id, L); + app(w.data, encodeType(w, w.tstack[i])); + app(w.data, rodNL); + end; + inc(i); + end; + setLength(w.tstack, 0); +end; + +procedure processStacks(w: PRodWriter); +begin + while (length(w.tstack) > 0) or (length(w.sstack) > 0) do begin + symStack(w); + typeStack(w); + end +end; + +procedure rawAddInterfaceSym(w: PRodWriter; s: PSym); +begin + pushSym(w, s); + processStacks(w); +end; + +procedure addInterfaceSym(w: PRodWriter; s: PSym); +begin + if w = nil then exit; + if [sfInInterface, sfCompilerProc] * s.flags <> [] then begin + rawAddInterfaceSym(w, s); + end +end; + +procedure addStmt(w: PRodWriter; n: PNode); +begin + app(w.init, encodeInt(ropeLen(w.data))); + app(w.init, rodNL); + app(w.data, encodeNode(w, UnknownLineInfo(), n)); + app(w.data, rodNL); + processStacks(w); +end; + +procedure writeRod(w: PRodWriter); +var + content: PRope; + i: int; +begin + processStacks(w); + // write header: + content := toRope('NIM:'); + app(content, toRope(FileVersion)); + app(content, rodNL); + app(content, toRope('ID:')); + app(content, encodeInt(w.module.id)); + app(content, rodNL); + app(content, toRope('CRC:')); + app(content, encodeInt(w.crc)); + app(content, rodNL); + app(content, toRope('OPTIONS:')); + app(content, encodeInt({@cast}int32(w.options))); + app(content, rodNL); + app(content, toRope('DEFINES:')); + app(content, w.defines); + app(content, rodNL); + app(content, toRope('FILES('+rodNL)); + for i := 0 to high(w.files) do begin + app(content, encode(w.files[i])); + app(content, rodNL); + end; + app(content, toRope(')'+rodNL)); + app(content, toRope('INCLUDES('+rodNL)); + app(content, w.inclDeps); + app(content, toRope(')'+rodNL)); + app(content, toRope('DEPS:')); + app(content, w.modDeps); + app(content, rodNL); + app(content, toRope('INTERF('+rodNL)); + app(content, w.interf); + app(content, toRope(')'+rodNL)); + app(content, toRope('COMPILERPROCS('+rodNL)); + app(content, w.compilerProcs); + app(content, toRope(')'+rodNL)); + app(content, toRope('INDEX('+rodNL)); + app(content, w.index.r); + app(content, toRope(')'+rodNL)); + app(content, toRope('IMPORTS('+rodNL)); + app(content, w.imports.r); + app(content, toRope(')'+rodNL)); + app(content, toRope('CONVERTERS:')); + app(content, w.converters); + app(content, toRope(rodNL)); + app(content, toRope('INIT('+rodNL)); + app(content, w.init); + app(content, toRope(')'+rodNL)); + app(content, toRope('DATA('+rodNL)); + app(content, w.data); + app(content, toRope(')'+rodNL)); + + //MessageOut('interf ' + ToString(ropeLen(w.interf))); + //MessageOut('index ' + ToString(ropeLen(w.indexRope))); + //MessageOut('init ' + ToString(ropeLen(w.init))); + //MessageOut('data ' + ToString(ropeLen(w.data))); + + writeRope(content, + completeGeneratedFilePath(changeFileExt(w.filename, 'rod'))); +end; + +function process(c: PPassContext; n: PNode): PNode; +var + i, j: int; + w: PRodWriter; + a: PNode; + s: PSym; +begin + result := n; + if c = nil then exit; + w := PRodWriter(c); + case n.kind of + nkStmtList: begin + for i := 0 to sonsLen(n)-1 do {@discard} process(c, n.sons[i]); + end; + nkTemplateDef, nkMacroDef: begin + s := n.sons[namePos].sym; + addInterfaceSym(w, s); + end; + nkProcDef, nkIteratorDef, nkConverterDef: begin + s := n.sons[namePos].sym; + if s = nil then InternalError(n.info, 'rodwrite.process'); + if (n.sons[codePos] <> nil) or (s.magic <> mNone) + or not (sfForward in s.flags) then begin + addInterfaceSym(w, s); + end + end; + nkVarSection: begin + for i := 0 to sonsLen(n)-1 do begin + a := n.sons[i]; + if a.kind <> nkIdentDefs then InternalError(a.info, 'rodwrite.process'); + addInterfaceSym(w, a.sons[0].sym); + end + end; + nkConstSection: begin + for i := 0 to sonsLen(n)-1 do begin + a := n.sons[i]; + if a.kind <> nkConstDef then InternalError(a.info, 'rodwrite.process'); + addInterfaceSym(w, a.sons[0].sym); + end + end; + nkTypeSection: begin + for i := 0 to sonsLen(n)-1 do begin + a := n.sons[i]; + if a.sons[0].kind <> nkSym then + InternalError(a.info, 'rodwrite.process'); + s := a.sons[0].sym; + addInterfaceSym(w, s); // this takes care of enum fields too + // Note: The check for ``s.typ.kind = tyEnum`` is wrong for enum + // type aliasing! Otherwise the same enum symbol would be included + // several times! + (* + if (a.sons[2] <> nil) and (a.sons[2].kind = nkEnumTy) then begin + a := s.typ.n; + for j := 0 to sonsLen(a)-1 do + addInterfaceSym(w, a.sons[j].sym); + end *) + end + end; + nkImportStmt: begin + for i := 0 to sonsLen(n)-1 do addModDep(w, getModuleFile(n.sons[i])); + addStmt(w, n); + end; + nkFromStmt: begin + addModDep(w, getModuleFile(n.sons[0])); + addStmt(w, n); + end; + nkIncludeStmt: begin + for i := 0 to sonsLen(n)-1 do addInclDep(w, getModuleFile(n.sons[i])); + end; + nkPragma: addStmt(w, n); + else begin end + end; +end; + +function myOpen(module: PSym; const filename: string): PPassContext; +var + w: PRodWriter; +begin + if module.id < 0 then InternalError('rodwrite: module ID not set'); + w := newRodWriter(filename, rodread.GetCRC(filename), module); + rawAddInterfaceSym(w, module); + result := w; +end; + +function myClose(c: PPassContext; n: PNode): PNode; +var + w: PRodWriter; +begin + w := PRodWriter(c); + writeRod(w); + result := n; +end; + +function rodwritePass(): TPass; +begin + initPass(result); + if optSymbolFiles in gGlobalOptions then begin + result.open := myOpen; + result.close := myClose; + result.process := process; + end +end; + +initialization + IntSetInit(debugWritten); +end. diff --git a/nim/rst.pas b/nim/rst.pas index b5e5846b1..cc92e41eb 100644 --- a/nim/rst.pas +++ b/nim/rst.pas @@ -469,19 +469,24 @@ end; // --------------------------------------------------------------- -function addNodes(n: PRstNode): string; +procedure addNodesAux(n: PRstNode; var result: string); var i: int; begin if n.kind = rnLeaf then - result := n.text + add(result, n.text) else begin - result := ''; for i := 0 to rsonsLen(n)-1 do - result := result +{&} addNodes(n.sons[i]) + addNodesAux(n.sons[i], result) end end; +function addNodes(n: PRstNode): string; +begin + result := ''; + addNodesAux(n, result); +end; + procedure rstnodeToRefnameAux(n: PRstNode; var r: string; var b: bool); var i: int; @@ -1118,7 +1123,7 @@ begin inc(p.idx); while p.tok[p.idx].kind in [tkWord, tkPunct, tkAdornment, tkOther] do begin if p.tok[p.idx].symbol = '::' then break; - result := result +{&} p.tok[p.idx].symbol; + add(result, p.tok[p.idx].symbol); inc(p.idx); end; if (p.tok[p.idx].kind = tkWhite) then inc(p.idx); @@ -1287,12 +1292,13 @@ begin break; end else begin - n.text := n.text +{&} nl +{&} repeatChar(p.tok[p.idx].ival - indent); + add(n.text, nl); + add(n.text, repeatChar(p.tok[p.idx].ival - indent)); inc(p.idx) end end else begin - n.text := n.text +{&} p.tok[p.idx].symbol; + add(n.text, p.tok[p.idx].symbol); inc(p.idx) end end @@ -1300,7 +1306,7 @@ begin end else begin while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin - n.text := n.text +{&} p.tok[p.idx].symbol; + add(n.text, p.tok[p.idx].symbol); inc(p.idx) end end; @@ -1560,7 +1566,7 @@ begin i := 0; while not (p.tok[p.idx].kind in [tkIndent, tkEof]) do begin if (tokEnd(p) <= cols[i]) then begin - row[i] := row[i] +{&} p.tok[p.idx].symbol; + add(row[i], p.tok[p.idx].symbol); inc(p.idx); end else begin diff --git a/nim/scanner.pas b/nim/scanner.pas index 98bb54c07..83f5c12b0 100644 --- a/nim/scanner.pas +++ b/nim/scanner.pas @@ -10,12 +10,11 @@ unit scanner; // This scanner is handwritten for efficiency. I used an elegant buffering // scheme which I have not seen anywhere else: -// We guarantee that a hole line is in the buffer (too long lines are reported -// as an error). Thus only when scanning the \n or \r character we have -// to check wether we need to read in the next chunk. (\n or \r already need -// special handling for incrementing the line counter; choosing both \n and \r -// allows the scanner to properly read Unix, DOS or Macintosh text files, even -// when it is not the native format. +// We guarantee that a whole line is in the buffer. Thus only when scanning +// the \n or \r character we have to check wether we need to read in the next +// chunk. (\n or \r already need special handling for incrementing the line +// counter; choosing both \n and \r allows the scanner to properly read Unix, +// DOS or Macintosh text files, even when it is not the native format. interface @@ -29,7 +28,7 @@ uses const MaxLineLength = 80; // lines longer than this lead to a warning - numChars: TCharSet = ['0'..'9','a'..'z','A'..'Z']; // we support up to base 36 + numChars: TCharSet = ['0'..'9','a'..'z','A'..'Z']; SymChars: TCharSet = ['a'..'z', 'A'..'Z', '0'..'9', #128..#255]; SymStartChars: TCharSet = ['a'..'z', 'A'..'Z', #128..#255]; OpChars: TCharSet = ['+', '-', '*', '/', '<', '>', '!', '?', '^', '.', @@ -436,7 +435,7 @@ begin end; '_': inc(pos); '0', '1': begin - xi := (xi shl 1) or (ord(L.buf[pos]) - ord('0')); + xi := shlu(xi, 1) or (ord(L.buf[pos]) - ord('0')); inc(pos); end; else break; @@ -453,7 +452,7 @@ begin end; '_': inc(pos); '0'..'7': begin - xi := (xi shl 3) or (ord(L.buf[pos]) - ord('0')); + xi := shlu(xi, 3) or (ord(L.buf[pos]) - ord('0')); inc(pos); end; else break; @@ -471,15 +470,15 @@ begin end; '_': inc(pos); '0'..'9': begin - xi := (xi shl 4) or (ord(L.buf[pos]) - ord('0')); + xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('0')); inc(pos); end; 'a'..'f': begin - xi := (xi shl 4) or (ord(L.buf[pos]) - ord('a') + 10); + xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('a') + 10); inc(pos); end; 'A'..'F': begin - xi := (xi shl 4) or (ord(L.buf[pos]) - ord('A') + 10); + xi := shlu(xi, 4) or (ord(L.buf[pos]) - ord('A') + 10); inc(pos); end; else break; @@ -490,8 +489,14 @@ begin end; // now look at the optional type suffix: case result.tokType of - tkIntLit..tkInt64Lit: + tkIntLit, tkInt64Lit: result.iNumber := xi; + tkInt8Lit: + result.iNumber := biggestInt(int8(toU8(int(xi)))); + tkInt16Lit: + result.iNumber := biggestInt(toU16(int(xi))); + tkInt32Lit: + result.iNumber := biggestInt(toU32(xi)); tkFloat32Lit: result.fNumber := ({@cast}PFloat32(addr(xi)))^; // note: this code is endian neutral! @@ -525,6 +530,8 @@ begin {@emit} on EOverflow do lexMessage(L, errNumberOutOfRange, result.literal); + on EOutOfRange do + lexMessage(L, errNumberOutOfRange, result.literal); end; L.bufpos := endpos; end; diff --git a/nim/semdata.pas b/nim/semdata.pas new file mode 100644 index 000000000..f920fae2a --- /dev/null +++ b/nim/semdata.pas @@ -0,0 +1,254 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// +unit semdata; + +// This module contains the data structures for the semantic checking phase. + +interface + +{$include 'config.inc'} + +uses + sysutils, nsystem, charsets, strutils, + lists, options, scanner, ast, astalgo, trees, treetab, wordrecg, + ropes, msgs, platform, nos, condsyms, idents, rnimsyn, types, + extccomp, nmath, magicsys, nversion, nimsets, pnimsyn, ntime, passes, + rodread; + +type + TOptionEntry = object(lists.TListEntry) + // entries to put on a stack for pragma parsing + options: TOptions; + defaultCC: TCallingConvention; + dynlib: PLib; + Notes: TNoteKinds; + end; + POptionEntry = ^TOptionEntry; + + TProcCon = record // procedure context; also used for top-level + // statements + owner: PSym; // the symbol this context belongs to + resultSym: PSym; // the result symbol (if we are in a proc) + nestedLoopCounter: int; // whether we are in a loop or not + nestedBlockCounter: int; // whether we are in a block or not + end; + PProcCon = ^TProcCon; + + PContext = ^TContext; + TContext = object(TPassContext) // a context represents a module + module: PSym; // the module sym belonging to the context + tab: TSymTab; // each module has its own symbol table + AmbigiousSymbols: TIntSet; // contains ids of all ambigious symbols (cannot + // store this info in the syms themselves!) + generics: PNode; // a list of the things to compile; list of + // nkExprEqExpr nodes which contain the generic + // symbol and the instantiated symbol + converters: TSymSeq; // sequence of converters + optionStack: TLinkedList; + libs: TLinkedList; // all libs used by this module + p: PProcCon; // procedure context + fromCache: bool; // is the module read from a cache? + semConstExpr: function (c: PContext; n: PNode): PNode; + // for the pragmas module + end; + +function newContext(module: PSym; const nimfile: string): PContext; +function newProcCon(owner: PSym): PProcCon; + +function lastOptionEntry(c: PContext): POptionEntry; +function newOptionEntry(): POptionEntry; + +procedure addConverter(c: PContext; conv: PSym); + +function newLib(kind: TLibKind): PLib; +procedure addToLib(lib: PLib; sym: PSym); + +function makePtrType(c: PContext; baseType: PType): PType; +function makeVarType(c: PContext; baseType: PType): PType; + +function newTypeS(const kind: TTypeKind; c: PContext): PType; +procedure fillTypeS(dest: PType; const kind: TTypeKind; c: PContext); +function makeRangeType(c: PContext; first, last: biggestInt; + const info: TLineInfo): PType; + +procedure illFormedAst(n: PNode); +function getSon(n: PNode; indx: int): PNode; +procedure checkSonsLen(n: PNode; len: int); +procedure checkMinSonsLen(n: PNode; len: int); + +// owner handling: +function getCurrOwner(): PSym; +procedure PushOwner(owner: PSym); +procedure PopOwner; + +implementation + +var + gOwners: array of PSym; // owner stack (used for initializing the + // owner field of syms) + // the documentation comment always gets + // assigned to the current owner + // BUGFIX: global array is needed! +{@emit gOwners := @[]; } + +function getCurrOwner(): PSym; +begin + result := gOwners[high(gOwners)]; +end; + +procedure PushOwner(owner: PSym); +var + len: int; +begin + len := length(gOwners); + setLength(gOwners, len+1); + gOwners[len] := owner; +end; + +procedure PopOwner; +var + len: int; +begin + len := length(gOwners); + if (len <= 0) then InternalError('popOwner'); + setLength(gOwners, len - 1); +end; + +function lastOptionEntry(c: PContext): POptionEntry; +begin + result := POptionEntry(c.optionStack.tail); +end; + +function newProcCon(owner: PSym): PProcCon; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + result.owner := owner; +end; + +function newOptionEntry(): POptionEntry; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + result.options := gOptions; + result.defaultCC := ccDefault; + result.dynlib := nil; + result.notes := gNotes; +end; + +function newContext(module: PSym; const nimfile: string): PContext; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + InitSymTab(result.tab); + IntSetInit(result.AmbigiousSymbols); + initLinkedList(result.optionStack); + initLinkedList(result.libs); + append(result.optionStack, newOptionEntry()); + result.module := module; + result.generics := newNode(nkStmtList); +{@emit result.converters := @[];} +end; + +procedure addConverter(c: PContext; conv: PSym); +var + i, L: int; +begin + L := length(c.converters); + for i := 0 to L-1 do + if c.converters[i].id = conv.id then exit; + setLength(c.converters, L+1); + c.converters[L] := conv; +end; + + +function newLib(kind: TLibKind): PLib; +begin + new(result); +{@ignore} + fillChar(result^, sizeof(result^), 0); +{@emit} + result.kind := kind; + //initObjectSet(result.syms) +end; + +procedure addToLib(lib: PLib; sym: PSym); +begin + //ObjectSetIncl(lib.syms, sym); + if sym.annex <> nil then liMessage(sym.info, errInvalidPragma); + sym.annex := lib +end; + +function makePtrType(c: PContext; baseType: PType): PType; +begin + if (baseType = nil) then InternalError('makePtrType'); + result := newTypeS(tyPtr, c); + addSon(result, baseType); +end; + +function makeVarType(c: PContext; baseType: PType): PType; +begin + if (baseType = nil) then InternalError('makeVarType'); + result := newTypeS(tyVar, c); + addSon(result, baseType); +end; + +function newTypeS(const kind: TTypeKind; c: PContext): PType; +begin + result := newType(kind, getCurrOwner()) +end; + +procedure fillTypeS(dest: PType; const kind: TTypeKind; c: PContext); +begin + dest.kind := kind; + dest.owner := getCurrOwner(); + dest.size := -1; +end; + +function makeRangeType(c: PContext; first, last: biggestInt; + const info: TLineInfo): PType; +var + n: PNode; +begin + n := newNodeI(nkRange, info); + addSon(n, newIntNode(nkIntLit, first)); + addSon(n, newIntNode(nkIntLit, last)); + result := newTypeS(tyRange, c); + result.n := n; + addSon(result, getSysType(tyInt)); // basetype of range +end; + +procedure illFormedAst(n: PNode); +begin + liMessage(n.info, errIllFormedAstX, renderTree(n, {@set}[renderNoComments])); +end; + +function getSon(n: PNode; indx: int): PNode; +begin + if (n <> nil) and (indx < sonsLen(n)) then result := n.sons[indx] + else begin illFormedAst(n); result := nil end; +end; + +procedure checkSonsLen(n: PNode; len: int); +begin + if (n = nil) or (sonsLen(n) <> len) then illFormedAst(n); +end; + +procedure checkMinSonsLen(n: PNode; len: int); +begin + if (n = nil) or (sonsLen(n) < len) then illFormedAst(n); +end; + +end. diff --git a/nim/semexprs.pas b/nim/semexprs.pas index 26e63c845..2c5672f7f 100644 --- a/nim/semexprs.pas +++ b/nim/semexprs.pas @@ -637,7 +637,7 @@ begin Consider:: const x = [] proc p(a: openarray[int], i: int) - proc q(a: sequence[char], c: char) + proc q(a: openarray[char], c: char) p(x, 0) q(x, '\0') diff --git a/nim/semfold.pas b/nim/semfold.pas index 9c27c3a16..fa2e97635 100644 --- a/nim/semfold.pas +++ b/nim/semfold.pas @@ -122,7 +122,7 @@ begin end; mZe8ToI, mZe8ToI64, mZe16ToI, mZe16ToI64, mZe32ToI64, mZeIToI64: begin // byte(-128) = 1...1..1000_0000'64 --> 0...0..1000_0000'64 - result := newIntNodeT(getInt(a) and (1 shl a.typ.size*8 - 1), n); + result := newIntNodeT(getInt(a) and (shlu(1, getSize(a.typ)*8) - 1), n); end; mToU8: result := newIntNodeT(getInt(a) and $ff, n); mToU16: result := newIntNodeT(getInt(a) and $ffff, n); @@ -142,8 +142,26 @@ begin if getInt(a) > getInt(b) then result := newIntNodeT(getInt(a), n) else result := newIntNodeT(getInt(b), n); end; - mShlI, mShlI64: result := newIntNodeT(getInt(a) shl getInt(b), n); - mShrI, mShrI64: result := newIntNodeT(getInt(a) shr getInt(b), n); + mShlI, mShlI64: begin + case skipGenericRange(n.typ).kind of + tyInt8: result := newIntNodeT(int8(getInt(a)) shl int8(getInt(b)), n); + tyInt16: result := newIntNodeT(int16(getInt(a)) shl int16(getInt(b)), n); + tyInt32: result := newIntNodeT(int32(getInt(a)) shl int32(getInt(b)), n); + tyInt64, tyInt: + result := newIntNodeT(shlu(getInt(a), getInt(b)), n); + else InternalError(n.info, 'constant folding for shl'); + end + end; + mShrI, mShrI64: begin + case skipGenericRange(n.typ).kind of + tyInt8: result := newIntNodeT(int8(getInt(a)) shr int8(getInt(b)), n); + tyInt16: result := newIntNodeT(int16(getInt(a)) shr int16(getInt(b)), n); + tyInt32: result := newIntNodeT(int32(getInt(a)) shr int32(getInt(b)), n); + tyInt64, tyInt: + result := newIntNodeT(shru(getInt(a), getInt(b)), n); + else InternalError(n.info, 'constant folding for shl'); + end + end; mDivI, mDivI64: result := newIntNodeT(getInt(a) div getInt(b), n); mModI, mModI64: result := newIntNodeT(getInt(a) mod getInt(b), n); @@ -380,7 +398,7 @@ begin result := nil // XXX: size computation for complex types // is still wrong else - result := newIntNodeT(a.typ.size, n); + result := newIntNodeT(getSize(a.typ), n); end; mLow: result := newIntNodeT(firstOrd(n.sons[1].typ), n); mHigh: begin diff --git a/nim/seminst.pas b/nim/seminst.pas new file mode 100644 index 000000000..4c3d416d4 --- /dev/null +++ b/nim/seminst.pas @@ -0,0 +1,278 @@ +// +// +// The Nimrod Compiler +// (c) Copyright 2008 Andreas Rumpf +// +// See the file "copying.txt", included in this +// distribution, for details about the copyright. +// + +// This module does the instantiation of generic procs and types. + +function generateInstance(c: PContext; fn: PSym; const pt: TIdTable; + const instantiator: TLineInfo): PSym; forward; +// generates an instantiated proc + +type + TInstantiateClosure = object(NObject) + typeMap: TIdTable; // map PType to PType + symMap: TIdTable; // map PSym to PSym + fn: PSym; + module: PSym; + //newOwner: PSym; + instantiator: TLineInfo; + end; + PInstantiateClosure = ^TInstantiateClosure; + PInstClosure = PInstantiateClosure; + +function instantiateTree(c: PInstantiateClosure; t: PNode): PNode; forward; +function instantiateSym(c: PInstantiateClosure; sym: PSym): PSym; forward; +function instantiateType(c: PInstantiateClosure; typ: PType): PType; forward; + +function containsGenericTypeIter(t: PType; closure: PObject): bool; +begin + result := t.kind in GenericTypes; +end; + +function containsGenericType(t: PType): bool; +begin + result := iterOverType(t, containsGenericTypeIter, nil); +end; + +function instTypeNode(c: PInstantiateClosure; n: PNode): PNode; +var + i: int; +begin + result := nil; + if n <> nil then begin + result := copyNode(n); + result.typ := instantiateType(c, n.typ); + case n.kind of + nkNone..nkNilLit: begin // a leaf + end; + else begin + for i := 0 to sonsLen(n)-1 do + addSon(result, instTypeNode(c, n.sons[i])); + end + end + end +end; + +function instantiateType(c: PInstantiateClosure; typ: PType): PType; +var + i: int; +begin + result := PType(idTableGet(c.typeMap, typ)); + if result <> nil then exit; + //if typ.kind = tyOpenArray then + // liMessage(c.instantiator, warnUser, 'instantiating type for: openarray'); + if containsGenericType(typ) then begin + result := copyType(typ, typ.owner, false); + idTablePut(c.typeMap, typ, result); // to avoid cycles + for i := 0 to sonsLen(result)-1 do + result.sons[i] := instantiateType(c, result.sons[i]); + if result.n <> nil then + result.n := instTypeNode(c, result.n); + end + else + result := typ; + if result.Kind in GenericTypes then begin + liMessage(c.instantiator, errCannotInstantiateX, + TypeToString(typ, preferName)); + end + else if result.kind = tyVar then begin + if result.sons[0].kind = tyVar then + liMessage(c.instantiator, errVarVarTypeNotAllowed); + end; +end; + +function instantiateSym(c: PInstantiateClosure; sym: PSym): PSym; +begin + if sym = nil then begin result := nil; exit end; // BUGFIX + result := PSym(idTableGet(c.symMap, sym)); + if (result = nil) then begin + if (sym.owner.id = c.fn.id) then begin // XXX: nested generics? + result := copySym(sym, false); + include(result.flags, sfFromGeneric); + idTablePut(c.symMap, sym, result); // BUGFIX + result.typ := instantiateType(c, sym.typ); + if (result.owner <> nil) and (result.owner.kind = skModule) then + result.owner := c.module // BUGFIX + else + result.owner := instantiateSym(c, result.owner); + if sym.ast <> nil then begin + result.ast := instantiateTree(c, sym.ast); + end + end + else + result := sym // do not copy t! + end +end; + +function instantiateTree(c: PInstantiateClosure; t: PNode): PNode; +var + len, i: int; +begin + if t = nil then begin result := nil; exit end; + result := copyNode(t); + if result.typ <> nil then result.typ := instantiateType(c, result.typ); + case t.kind of + nkNone..pred(nkSym), succ(nkSym)..nkNilLit: begin end; + nkSym: begin + if result.sym <> nil then result.sym := instantiateSym(c, result.sym); + end + else begin + len := sonsLen(t); + if len > 0 then begin + newSons(result, len); + for i := 0 to len-1 do + result.sons[i] := instantiateTree(c, t.sons[i]); + end + end + end +end; + +procedure instantiateGenericParamList(c: PContext; n: PNode; + const pt: TIdTable); +var + i: int; + s, q: PSym; + t: PType; +begin + if (n.kind <> nkGenericParams) then + InternalError(n.info, 'instantiateGenericParamList'); + for i := 0 to sonsLen(n)-1 do begin + if n.sons[i].kind = nkDefaultTypeParam then begin + internalError(n.sons[i].info, + 'instantiateGenericParamList() to implement'); + // XXX + end; + if (n.sons[i].kind <> nkSym) then + InternalError(n.info, 'instantiateGenericParamList'); + q := n.sons[i].sym; + s := newSym(skType, q.name, getCurrOwner()); + t := PType(IdTableGet(pt, q.typ)); + if t = nil then + liMessage(n.sons[i].info, errCannotInstantiateX, s.name.s); + if (t.kind = tyGenericParam) then + InternalError(n.info, 'instantiateGenericParamList'); + s.typ := t; + addDecl(c, s); + end +end; + +function GenericCacheGet(c: PContext; genericSym, instSym: PSym): PSym; +var + i: int; + a, b: PSym; +begin + result := nil; + for i := 0 to sonsLen(c.generics)-1 do begin + if c.generics.sons[i].kind <> nkExprEqExpr then + InternalError(genericSym.info, 'GenericCacheGet'); + a := c.generics.sons[i].sons[0].sym; + if genericSym.id = a.id then begin + b := c.generics.sons[i].sons[1].sym; + if equalParams(b.typ.n, instSym.typ.n) = paramsEqual then begin + //if gVerbosity > 0 then + // MessageOut('found in cache: ' + getProcHeader(instSym)); + result := b; exit + end + end + end +end; + +procedure GenericCacheAdd(c: PContext; genericSym, instSym: PSym); +var + n: PNode; +begin + n := newNode(nkExprEqExpr); + addSon(n, newSymNode(genericSym)); + addSon(n, newSymNode(instSym)); + addSon(c.generics, n); +end; + +procedure semParamList(c: PContext; n: PNode; s: PSym); forward; +procedure addParams(c: PContext; n: PNode); forward; +procedure addResult(c: PContext; t: PType; const info: TLineInfo); forward; +procedure addResultNode(c: PContext; n: PNode); forward; + +function generateInstance(c: PContext; fn: PSym; const pt: TIdTable; + const instantiator: TLineInfo): PSym; +// generates an instantiated proc +var + oldPrc: PSym; + oldP: PProcCon; + n: PNode; +begin + oldP := c.p; // restore later + result := copySym(fn, false); + include(result.flags, sfFromGeneric); + //include(fn.flags, sfFromGeneric); + result.owner := getCurrOwner().owner; + //idTablePut(c.mapping, fn, result); + n := copyTree(fn.ast); + result.ast := n; + pushOwner(result); + openScope(c.tab); + if (n.sons[genericParamsPos] = nil) then + InternalError(n.info, 'generateInstance'); + n.sons[namePos] := newSymNode(result); + pushInfoContext(instantiator); + + instantiateGenericParamList(c, n.sons[genericParamsPos], pt); + n.sons[genericParamsPos] := nil; + // semantic checking for the parameters: + if n.sons[paramsPos] <> nil then begin + semParamList(c, n.sons[ParamsPos], result); + addParams(c, result.typ.n); + end + else begin + result.typ := newTypeS(tyProc, c); + addSon(result.typ, nil); + end; + + // now check if we have already such a proc generated + oldPrc := GenericCacheGet(c, fn, result); + if oldPrc = nil then begin + // add it here, so that recursive generic procs are possible: + addDecl(c, result); + if n.sons[codePos] <> nil then begin + c.p := newProcCon(result); + if result.kind in [skProc, skConverter] then begin + addResult(c, result.typ.sons[0], n.info); + addResultNode(c, n); + end; + n.sons[codePos] := semStmtScope(c, n.sons[codePos]); + end; + GenericCacheAdd(c, fn, result); + end + else + result := oldPrc; + popInfoContext(); + closeScope(c.tab); // close scope for parameters + popOwner(); + c.p := oldP; // restore +end; + +function generateTypeInstance(p: PContext; const pt: TIdTable; + const instantiator: TLineInfo; t: PType): PType; +var + c: PInstantiateClosure; +begin + new(c); +{@ignore} + fillChar(c^, sizeof(c^), 0); +{@emit} + copyIdTable(c.typeMap, pt); + InitIdTable(c.symMap); + c.fn := nil; + c.instantiator := instantiator; + c.module := p.module; + result := instantiateType(c, t); +end; + +function partialSpecialization(c: PContext; n: PNode; s: PSym): PNode; +begin + result := n; +end; diff --git a/nim/semtypes.pas b/nim/semtypes.pas index 00cb019f8..5d9bd626a 100644 --- a/nim/semtypes.pas +++ b/nim/semtypes.pas @@ -157,7 +157,7 @@ begin liMessage(n.info, errOrdinalTypeExpected); if enumHasWholes(a.typ) then liMessage(n.info, errEnumXHasWholes, a.typ.sym.name.s); - if not leValue(a, b) then + if not leValue(a, b) then liMessage(n.Info, errRangeIsEmpty); addSon(result.n, a); addSon(result.n, b); diff --git a/nim/sigmatch.pas b/nim/sigmatch.pas index 96001ed90..741052f05 100644 --- a/nim/sigmatch.pas +++ b/nim/sigmatch.pas @@ -570,9 +570,10 @@ begin result := copyTree(arg); result.typ := getInstantiatedType(c, arg, m, f); // BUG: f may not be the right key! - if (skipVarGeneric(f).kind in [tyTuple, tyOpenArray]) then + if (skipVarGeneric(result.typ).kind in [tyTuple, tyOpenArray]) then // BUGFIX: must pass length implicitely result := implicitConv(nkHiddenStdConv, f, copyTree(arg), m, c); + // BUGFIX: use ``result.typ`` and not `f` here end; isEqual: begin inc(m.exactMatches); diff --git a/nim/transf.pas b/nim/transf.pas index fb59eeef2..d74f2aa83 100644 --- a/nim/transf.pas +++ b/nim/transf.pas @@ -69,9 +69,15 @@ end; // ------------ helpers ----------------------------------------------------- +function getCurrOwner(c: PTransf): PSym; +begin + if c.transCon <> nil then result := c.transCon.owner + else result := c.module; +end; + function newTemp(c: PTransf; typ: PType; const info: TLineInfo): PSym; begin - result := newSym(skTemp, getIdent(genPrefix), getCurrOwner()); + result := newSym(skTemp, getIdent(genPrefix), getCurrOwner(c)); result.info := info; result.typ := skipGeneric(typ); include(result.flags, sfFromGeneric); @@ -195,7 +201,7 @@ begin for i := 0 to sonsLen(n)-1 do result.sons[i] := transform(c, n.sons[i]); counter := 0; - labl := newSym(skLabel, nil, getCurrOwner()); + labl := newSym(skLabel, nil, getCurrOwner(c)); labl.name := getIdent(genPrefix +{&} ToString(labl.id)); labl.info := result.info; transformContinueAux(c, result, labl, counter); @@ -270,7 +276,7 @@ begin include(newVar.flags, sfFromGeneric); // fixes a strange bug for rodgen: //include(it.sons[0].sym.flags, sfFromGeneric); - newVar.owner := getCurrOwner(); + newVar.owner := getCurrOwner(c); IdNodeTablePut(c.transCon.mapping, it.sons[0].sym, newSymNode(newVar)); it.sons[0] := newSymNode(newVar); it.sons[2] := transform(c, it.sons[2]); @@ -460,7 +466,9 @@ begin // generate a temporary and produce an assignment statement: temp := newTemp(c, formal.typ, formal.info); addVar(v, newSymNode(temp)); - addSon(result, newAsgnStmt(c, newSymNode(temp), copyTree(call.sons[i]))); + // BUGFIX: do not copy call.sons[i], but transform it! + addSon(result, newAsgnStmt(c, newSymNode(temp), + transform(c, call.sons[i]))); IdNodeTablePut(newC.mapping, formal, newSymNode(temp)); // BUGFIX end end; diff --git a/nim/types.pas b/nim/types.pas index bc42f2169..0686a368f 100644 --- a/nim/types.pas +++ b/nim/types.pas @@ -930,7 +930,7 @@ end; function align(address, alignment: biggestInt): biggestInt; begin - result := address + (alignment-1) and not (alignment-1); + result := (address + (alignment-1)) and not (alignment-1); end; // we compute the size of types lazily: @@ -951,6 +951,7 @@ begin case n.sons[i].kind of nkOfBranch, nkElse: begin res := computeRecSizeAux(lastSon(n.sons[i]), b, currOffset); + if res < 0 then begin result := res; exit end; maxSize := max(maxSize, res); maxAlign := max(maxAlign, b); end; @@ -966,6 +967,7 @@ begin maxAlign := 1; for i := 0 to sonsLen(n)-1 do begin res := computeRecSizeAux(n.sons[i], b, currOffset); + if res < 0 then begin result := res; exit end; currOffset := align(currOffset, b) + res; result := align(result, b) + res; if b > maxAlign then maxAlign := b; @@ -1024,9 +1026,9 @@ begin result := 4 // use signed int32 else begin len := lastOrd(typ); // BUGFIX: use lastOrd! - if len+1 < 1 shl 8 then result := 1 - else if len+1 < 1 shl 16 then result := 2 - else if len+1 < 1 shl 32 then result := 4 + if len+1 < shlu(1, 8) then result := 1 + else if len+1 < shlu(1, 16) then result := 2 + else if len+1 < shlu(biggestInt(1), 32) then result := 4 else result := 8; end; a := result; @@ -1047,6 +1049,7 @@ begin maxAlign := 1; for i := 0 to sonsLen(typ)-1 do begin res := computeSizeAux(typ.sons[i], a); + if res < 0 then begin result := res; exit end; maxAlign := max(maxAlign, a); result := align(result, a) + res; end; @@ -1056,6 +1059,7 @@ begin tyObject: begin if typ.sons[0] <> nil then begin result := computeSizeAux(typ.sons[0], a); + if result < 0 then exit; maxAlign := a end else if typ.kind = tyObject then begin @@ -1066,6 +1070,7 @@ begin end; currOffset := result; result := computeRecSizeAux(typ.n, a, currOffset); + if result < 0 then exit; if a < maxAlign then a := maxAlign; result := align(result, a); end; @@ -1097,4 +1102,3 @@ begin end; end. - |