nsf

Clone
Gustaf Neumann <neumann@wu-wien.ac.at>
committed
f0f87b4
on 03 Jan 21
added enumeration values
define-incrementals + 6 more
generic/nsf.c (+21 -38)
26998 26998 /*
26999 26999  *----------------------------------------------------------------------
27000 27000  *
27001 27001  * ListDefinedMethods --
27002 27002  *
27003 27003  *      List the methods defined by the specified object/class
27004 27004  *      according to the filtering options (types, pattern,
27005 27005  *      protection, etc.). The result is placed into the interp
27006 27006  *      result.
27007 27007  *
27008 27008  * Results:
27009 27009  *      A standard Tcl result.
27010 27010  *
27011 27011  * Side effects:
27012 27012  *      Sets the interpreter's result object.
27013 27013  *
27014 27014  *----------------------------------------------------------------------
27015 27015  */
27016 27016 static int
27017 27017 ListDefinedMethods(Tcl_Interp *interp, NsfObject *object, const char *pattern,
27018                      bool withPer_object, MethodtypeIdx_t methodType, CallprotectionIdx_t withCallprotection,
  27018                    bool withPer_object,
  27019                    MethodtypeIdx_t methodType,
  27020                    CallprotectionIdx_t withCallprotection,
27019 27021                    bool withPath) {
27020 27022   Tcl_HashTable *cmdTablePtr;
27021 27023   Tcl_DString ds, *dsPtr = NULL;
27022 27024
27023 27025   nonnull_assert(interp != NULL);
27024 27026   nonnull_assert(object != NULL);
27025 27027
27026 27028   if (pattern != NULL && *pattern == ':' && *(pattern + 1) == ':') {
27027 27029     Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
27028 27030     const char *remainder;
27029 27031
27030 27032     /*fprintf(stderr, "we have a colon pattern '%s' methodtype %.6x\n", pattern, methodType);*/
27031 27033
27032 27034     TclGetNamespaceForQualName(interp, pattern, NULL, 0,
27033 27035                                &nsPtr, &dummy1Ptr, &dummy2Ptr, &remainder);
27034 27036     /*fprintf(stderr,
27035 27037             "TclGetNamespaceForQualName with %s => (%p %s) (%p %s) (%p %s) (%p %s)\n",
27036 27038             pattern,
27037 27039             nsPtr, (nsPtr != NULL) ? nsPtr->fullName : "",
27038 27040             dummy1Ptr, (dummy1Ptr != NULL) ? dummy1Ptr->fullName : "",
 
28027 28029 } {-nxdoc 1}
28028 28030 */
28029 28031 static int
28030 28032 NsfCmdInfoCmd(Tcl_Interp *interp, InfomethodsubcmdIdx_t subcmd, NsfObject *contextObject,
28031 28033               Tcl_Obj *methodNameObj, const char *pattern) {
28032 28034
28033 28035   nonnull_assert(interp != NULL);
28034 28036   nonnull_assert(methodNameObj != NULL);
28035 28037
28036 28038   return ListMethodResolve(interp, subcmd, contextObject, pattern, NULL, NULL, methodNameObj, NSF_FALSE);
28037 28039 }
28038 28040
28039 28041 /*
28040 28042 cmd configure NsfConfigureCmd {
28041 28043   {-argName "option" -required 1 -type "debug|dtrace|filter|profile|softrecreate|objectsystems|keepcmds|checkresults|checkarguments"}
28042 28044   {-argName "value" -required 0 -type tclobj}
28043 28045 }
28044 28046 */
28045 28047 static int
28046 28048 NsfConfigureCmd(Tcl_Interp *interp, ConfigureoptionIdx_t option, Tcl_Obj *valueObj) {
28047     int boolVal;
  28049   int boolVal = 0;
28048 28050
28049 28051   nonnull_assert(interp != NULL);
28050 28052 #if defined(NSF_DTRACE)
28051 28053   if (NSF_DTRACE_CONFIGURE_PROBE_ENABLED()) {
28052       NSF_DTRACE_CONFIGURE_PROBE((char *)Nsf_Configureoption[option-1],
  28054     NSF_DTRACE_CONFIGURE_PROBE(Nsf_Configureoption[option-1].key,
28053 28055                                (valueObj != NULL) ? ObjStr(valueObj) : NULL);
28054 28056   }
28055 28057 #endif
28056 28058
28057 28059   if (option == ConfigureoptionObjectsystemsIdx) {
28058 28060     NsfObjectSystem *osPtr;
28059 28061     Tcl_Obj         *list = Tcl_NewListObj(0, NULL);
28060 28062
28061 28063     for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr != NULL; osPtr = osPtr->nextPtr) {
28062 28064       Tcl_Obj *osObj = Tcl_NewListObj(0, NULL);
28063 28065       Tcl_Obj *systemMethods = Tcl_NewListObj(0, NULL);
28064 28066       int      idx;
28065 28067
28066 28068       Tcl_ListObjAppendElement(interp, osObj, osPtr->rootClass->object.cmdName);
28067 28069       Tcl_ListObjAppendElement(interp, osObj, osPtr->rootMetaClass->object.cmdName);
28068 28070
28069 28071       for (idx = 0; Nsf_SystemMethodOpts[idx]; idx++) {
28070 28072         /*fprintf(stderr, "opt %s %s\n", Nsf_SystemMethodOpts[idx],
28071 28073           osPtr->methods[idx] ? ObjStr(osPtr->methods[idx]) : "NULL");*/
28072 28074         if (osPtr->methods[idx] == NULL) {
 
29335 29337       return TCL_OK;
29336 29338     } else {
29337 29339       return NsfPrintError(interp, "cannot lookup %smethod '%s' for %s",
29338 29340                            class == NULL ? "object " : "",
29339 29341                            ObjStr(methodNameObj), ObjectName_(object));
29340 29342     }
29341 29343   }
29342 29344
29343 29345   switch (methodProperty) {
29344 29346   case MethodpropertyExistsIdx:
29345 29347     Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
29346 29348     break;
29347 29349   case MethodpropertyClass_onlyIdx:          NSF_FALL_THROUGH; /* fall through */
29348 29350   case MethodpropertyCall_privateIdx:        NSF_FALL_THROUGH; /* fall through */
29349 29351   case MethodpropertyCall_protectedIdx:      NSF_FALL_THROUGH; /* fall through */
29350 29352   case MethodpropertyDebugIdx:               NSF_FALL_THROUGH; /* fall through */
29351 29353   case MethodpropertyDeprecatedIdx:          NSF_FALL_THROUGH; /* fall through */
29352 29354   case MethodpropertyRedefine_protectedIdx:
29353 29355     {
29354 29356       int          impliedSetFlag = 0, impliedClearFlag = 0;
29355         unsigned int flag;
  29357       unsigned int flag = 0u;
29356 29358
29357 29359       switch (methodProperty) {
29358 29360       case MethodpropertyClass_onlyIdx:
29359 29361         flag = NSF_CMD_CLASS_ONLY_METHOD;
29360 29362         break;
29361 29363       case MethodpropertyCall_privateIdx:
29362 29364         flag = NSF_CMD_CALL_PRIVATE_METHOD;
29363 29365         impliedSetFlag = NSF_CMD_CALL_PROTECTED_METHOD;
29364 29366         break;
29365 29367       case MethodpropertyCall_protectedIdx:
29366 29368         impliedClearFlag = NSF_CMD_CALL_PRIVATE_METHOD;
29367 29369         flag = NSF_CMD_CALL_PROTECTED_METHOD;
29368 29370         break;
29369 29371       case MethodpropertyDebugIdx:
29370 29372         flag = NSF_CMD_DEBUG_METHOD;
29371 29373         break;
29372 29374       case MethodpropertyDeprecatedIdx:
29373 29375         flag = NSF_CMD_DEPRECATED_METHOD;
29374 29376         break;
29375 29377       case MethodpropertyRedefine_protectedIdx:
 
32615 32617 objectMethod requirenamespace NsfORequireNamespaceMethod {
32616 32618 }
32617 32619 */
32618 32620 static int
32619 32621 NsfORequireNamespaceMethod(Tcl_Interp *interp, NsfObject *object) {
32620 32622
32621 32623   nonnull_assert(interp != NULL);
32622 32624   nonnull_assert(object != NULL);
32623 32625
32624 32626   RequireObjNamespace(interp, object);
32625 32627   return TCL_OK;
32626 32628 }
32627 32629
32628 32630 /*
32629 32631 objectMethod residualargs NsfOResidualargsMethod {
32630 32632   {-argName "args" -type allargs}
32631 32633 }
32632 32634 */
32633 32635 static int
32634 32636 NsfOResidualargsMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[]) {
32635     int          i, start = 1, argc, nextArgc, normalArgs, result = TCL_OK;
  32637   int          i, start = 1, argc = 0, nextArgc = 0, normalArgs, result = TCL_OK;
32636 32638   dashArgType  isdasharg = NO_DASH;
32637     const char  *methodName, *nextMethodName, *initString = NULL;
32638     Tcl_Obj    **argv = NULL, **nextArgv;
  32639   const char  *methodName, *nextMethodName = NULL, *initString = NULL;
  32640   Tcl_Obj    **argv = NULL, **nextArgv = NULL;
32639 32641
32640 32642   nonnull_assert(interp != NULL);
32641 32643   nonnull_assert(object != NULL);
32642 32644
32643 32645 #if 0
32644 32646   fprintf(stderr, "NsfOResidualargsMethod %s %2d ", ObjectName_(object), objc);
32645 32647   for(i = 0; i < objc; i++) {fprintf(stderr, " [%d]=%p %s,", i, &objv[i], ObjStr(objv[i]));}
32646 32648   fprintf(stderr, "\n");
32647 32649 #endif
32648 32650
32649 32651   /*
32650 32652    * Skip arguments without leading dash.
32651 32653    */
32652 32654   for (i = start; i < objc; i++) {
32653 32655     if ((isdasharg = IsDashArg(interp, objv[i], 1, &methodName, &argc, &argv))) {
32654 32656       break;
32655 32657     }
32656 32658   }
32657 32659   normalArgs = i-1;
32658 32660
 
33662 33664 /*
33663 33665 classMethod superclass NsfCSuperclassMethod {
33664 33666   {-argName "superclasses" -required 0 -type tclobj}
33665 33667 }
33666 33668 */
33667 33669 static int
33668 33670 NsfCSuperclassMethod(Tcl_Interp *interp, NsfClass *class, Tcl_Obj *superclassesObj) {
33669 33671
33670 33672   nonnull_assert(interp != NULL);
33671 33673   nonnull_assert(class != NULL);
33672 33674
33673 33675   return NsfRelationSetCmd(interp, &class->object, RelationtypeSuperclassIdx, superclassesObj);
33674 33676 }
33675 33677
33676 33678 /***********************************************************************
33677 33679  * End Class Methods
33678 33680  ***********************************************************************/
33679 33681
33680 33682 static MethodtypeIdx_t
33681 33683 AggregatedMethodType(MethodtypeIdx_t methodType) {
33682     switch (methodType) {
33683     case MethodtypeNULL: NSF_FALL_THROUGH; /* fall through */
33684     case MethodtypeAllIdx:
33685       methodType = NSF_METHODTYPE_ALL;
33686       break;
33687     case MethodtypeScriptedIdx:
33688       /*methodType = NSF_METHODTYPE_SCRIPTED|NSF_METHODTYPE_ALIAS;*/
33689       methodType = NSF_METHODTYPE_SCRIPTED;
33690       break;
33691     case MethodtypeBuiltinIdx:
33692       methodType = NSF_METHODTYPE_BUILTIN|NSF_METHODTYPE_OBJECT;
33693       break;
33694     case MethodtypeForwarderIdx:
33695       methodType = NSF_METHODTYPE_FORWARDER;
33696       break;
33697     case MethodtypeAliasIdx:
33698       methodType = NSF_METHODTYPE_ALIAS;
33699       break;
33700     case MethodtypeSetterIdx:
33701       methodType = NSF_METHODTYPE_SETTER;
33702       break;
33703     case MethodtypeObjectIdx:
33704       methodType = NSF_METHODTYPE_OBJECT;
33705       break;
33706     case MethodtypeNsfprocIdx:
33707       methodType = NSF_METHODTYPE_NSFPROC;
33708       break;
33709     }
  33684   MethodtypeIdx_t result;
33710 33685
33711     return methodType;
  33686   if (methodType == MethodtypeNULL) {
  33687     result = MethodtypeAllIdx;
  33688   } else if (methodType == MethodtypeBuiltinIdx) {
  33689     result = NSF_METHODTYPE_BUILTIN|NSF_METHODTYPE_OBJECT;
  33690   } else {
  33691     result = methodType;
33712 33692   }
  33693   //fprintf(stderr, "AggregatedMethodType input %.4x output %.4x\n", methodType, result);
  33694   return result;
  33695 }
33713 33696
33714 33697 /***********************************************************************
33715 33698  * Begin Object Info Methods
33716 33699  ***********************************************************************/
33717 33700 /*
33718 33701 objectInfoMethod baseclass NsfObjInfoBaseclassMethod {
33719 33702 }
33720 33703 */
33721 33704
33722 33705 static int
33723 33706 NsfObjInfoBaseclassMethod(Tcl_Interp *interp, NsfObject *object) {
33724 33707   NsfObjectSystem *osPtr;
33725 33708
33726 33709   nonnull_assert(interp != NULL);
33727 33710   nonnull_assert(object != NULL);
33728 33711
33729 33712   osPtr = GetObjectSystem(object);
33730 33713   assert(osPtr != NULL);
33731 33714
33732 33715   Tcl_SetObjResult(interp, osPtr->rootClass->object.cmdName);