nsf

Clone
Gustaf Neumann <neumann@wu-wien.ac.at>
committed
1ed65d1
on 22 Jan 13
more cleanup
2-1-0-rc + 55 more
generic/asm/nsfAssemble.c (+4 -5)
321 321  *    and calls in case of success the asm proc body.
322 322  *
323 323  * Results:
324 324  *    Tcl return code.
325 325  *
326 326  * Side effects:
327 327  *    None.
328 328  *
329 329  *----------------------------------------------------------------------
330 330  */
331 331 extern int
332 332 NsfAsmProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
333 333   AsmProcClientData *cd = clientData;
334 334   int result;
335 335
336 336   assert(cd);
337 337   assert(cd->proc);
338 338   //fprintf(stderr, "NsfAsmProcStub %s is called, tcd %p object %p\n", ObjStr(objv[0]), cd, cd->object);
339 339
340 340   if (likely(cd->paramDefs && cd->paramDefs->paramsPtr)) {
341       ParseContext *pcPtr = (ParseContext *) NsfTclStackAlloc(interp, sizeof(ParseContext), "parse context");
  341     ParseContext *pcPtr;
342 342     ALLOC_ON_STACK(Tcl_Obj*, objc, tov);
343 343
344 344     fprintf(stderr, "not implemented yet\n");
345       pcPtr = (ParseContext *)tov; // dummy operation to keep compiler quiet
346 345 #if 0
  346     pcPtr = (ParseContext *) NsfTclStackAlloc(interp, sizeof(ParseContext), "parse context");
347 347     /*
348 348      * We have to substitute the first element of objv with the name
349 349      * of the function to be called. Since objv is immutable, we have
350 350      * to copy the full argument vector and replace the element on
351 351      * position [0]
352 352      */
353 353     memcpy(tov, objv, sizeof(Tcl_Obj *)*(objc));
354 354     //tov[0] = tcd->procName;
355 355
356 356     /* If the argument parsing is ok, the body will be called */
357 357     result = ProcessMethodArguments(pcPtr, interp, NULL, 0,
358 358                                     cd->paramDefs, objv[0],
359 359                                     objc, tov);
360 360
361 361     if (likely(result == TCL_OK)) {
362 362       result = InvokeShadowedProc(interp, cd->procName, cd->cmd, pcPtr);
363 363     } else {
364 364       /*Tcl_Obj *resultObj = Tcl_GetObjResult(interp);
365 365       fprintf(stderr, "NsfProcStub: incorrect arguments (%s)\n", ObjStr(resultObj));*/
366 366       ParseContextRelease(pcPtr);
 
387 387
388 388
389 389
390 390
391 391 static int
392 392 NsfAsmProcAddParam(Tcl_Interp *interp, NsfParsedParam *parsedParamPtr,
393 393                    Tcl_Obj *nameObj, Tcl_Obj *bodyObj, int with_ad) {
394 394   fprintf(stderr, "NsfAsmProcAddParam not implemented yet\n");
395 395   //CONST char *procName = ObjStr(nameObj);
396 396
397 397   return TCL_OK;
398 398 }
399 399
400 400 static int
401 401 NsfAsmProcAddArgs(Tcl_Interp *interp, Tcl_Obj *argumentsObj,
402 402                   Tcl_Obj *nameObj, Tcl_Obj *bodyObj, int with_ad) {
403 403   int argc, result;
404 404   Tcl_Obj **argv;
405 405   AsmCompiledProc *asmProc;
406 406   AsmProcClientData *cd;
407     Tcl_Command cmd;
408 407   CONST char *procName = ObjStr(nameObj);
409 408
410 409   if (unlikely(Tcl_ListObjGetElements(interp, argumentsObj, &argc, &argv) != TCL_OK)) {
411 410     return NsfPrintError(interp, "argument list invalid '%s'", ObjStr(argumentsObj));
412 411   }
413 412  
414 413   result = AsmAssemble(NULL, interp, nameObj, argc, bodyObj, &asmProc);
415 414   if (unlikely(result != TCL_OK)) {
416 415     return result;
417 416   }
418 417
419 418   cd = NEW(AsmProcClientData);
420 419   cd->object = NULL;
421 420   cd->proc = asmProc;
422 421   cd->paramDefs = NULL;
423 422   cd->with_ad = with_ad;
424 423
425     cmd = Tcl_CreateObjCommand(interp, procName, NsfAsmProc,
  424   Tcl_CreateObjCommand(interp, procName, NsfAsmProc,
426 425                        cd, NsfAsmProcDeleteProc);
427 426   return TCL_OK;
428 427 }
429 428
430 429
431 430 /*
432 431 cmd method::asmcreate NsfAsmMethodCreateCmd {
433 432   {-argName "object" -required 1 -type object}
434 433   {-argName "-inner-namespace" -nrargs 0}
435 434   {-argName "-per-object"  -nrargs 0}
436 435   {-argName "-reg-object" -required 0 -nrargs 1 -type object}
437 436   {-argName "name" -required 1 -type tclobj}
438 437   {-argName "arguments" -required 1 -type tclobj}
439 438   {-argName "body" -required 1 -type tclobj}
440 439 }
441 440 */
442 441
443 442 static int
444 443 NsfAsmMethodCreateCmd(Tcl_Interp *interp, NsfObject *defObject,
445 444                       int withInner_namespace, int withPer_object, NsfObject *regObject,