Common subdirectories: kqml/src/tkqml/RCS and /home/src/kqml/C/ver.2/src/tkqml/RCS diff -c kqml/src/tkqml/TKqml.h /home/src/kqml/C/ver.2/src/tkqml/TKqml.h *** kqml/src/tkqml/TKqml.h Wed Jun 4 12:39:44 1997 --- /home/src/kqml/C/ver.2/src/tkqml/TKqml.h Wed Jul 2 15:03:21 1997 *************** *** 1,4 **** ! // $Id: TKqml.h,v 1.5 1997/06/04 16:37:06 ian Exp $ #define TALLOC(TYPE) (TYPE *)malloc(sizeof(TYPE)) #define KQML_PERF_EXTENSIONS --- 1,4 ---- ! // $Id: TKqml.h,v 1.6 1997/07/02 19:01:28 ian Exp $ #define TALLOC(TYPE) (TYPE *)malloc(sizeof(TYPE)) #define KQML_PERF_EXTENSIONS *************** *** 60,65 **** --- 60,66 ---- #define TKQML_DERIV_PINT_ERROR "ERR: Cannot derive PINT." #define TKQML_DERIV_CHAR_ERROR "ERR: Cannot derive CHAR." #define TKQML_DERIV_PCHAR_ERROR "ERR: Cannot derive PCHAR." + #define TKQML_DERIV_QCHAR_ERROR "Err: Cannot derive QCHAR." #define TKQML_DERIV_POBJ_ERROR "ERR: Cannot derive POBJ." #define TKQML_DERIV_PPOBJ_ERROR "ERR: Cannot derive PPOBJ." #define TKQML_DERIV_UNKNOWN_ERROR "ERR: Unknown type; cannot derive." *************** *** 84,89 **** --- 85,91 ---- #define KPTR 0x00000008 /* pointer */ #define KPPTR 0x00000020 /* pointer to pointer */ #define KSTR 0x0000000F /* string */ + #define KPSTR 0x00000040 /* pointer to string */ #define KKET 0x00000010 /* enum. type: kqml_expression_type */ #define KKRT 0x00000010 /* kqml_reply_type */ #define COPY 0x00000100 /* copy value back to variable */ diff -c kqml/src/tkqml/TKqmlApp.C /home/src/kqml/C/ver.2/src/tkqml/TKqmlApp.C *** kqml/src/tkqml/TKqmlApp.C Wed Jun 4 12:39:45 1997 --- /home/src/kqml/C/ver.2/src/tkqml/TKqmlApp.C Wed Jul 2 14:59:07 1997 *************** *** 10,16 **** // 2. Makefile must know app. kqml directores, libs, etc. // 3. AppInit must contain an entry for kqml_command // ! // $Id: TKqmlApp.C,v 1.6 1997/06/04 16:37:31 ian Exp $ // //----------------------------------------------------------------------------- --- 10,16 ---- // 2. Makefile must know app. kqml directores, libs, etc. // 3. AppInit must contain an entry for kqml_command // ! // $Id: TKqmlApp.C,v 1.7 1997/07/02 18:59:06 ian Exp $ // //----------------------------------------------------------------------------- *************** *** 241,247 **** case 14 : // *(int*)a[0]=kqml_get_field_count((kqml_message*)a[2]); break; ! case 15 : // break; case 16 : // *(int*)a[0]=kqml_put_performative((kqml_message*)a[2],(char*)a[3]); --- 241,250 ---- case 14 : // *(int*)a[0]=kqml_get_field_count((kqml_message*)a[2]); break; ! case 15 : // get_ith_field ! a[0]=(void*)kqml_get_ith_field(*(int*)a[2],(kqml_message*)a[3], ! (char**)a[4],(char**)a[5], ! (int*)a[6],(kqml_expression_type*)a[7]); break; case 16 : // *(int*)a[0]=kqml_put_performative((kqml_message*)a[2],(char*)a[3]); *************** *** 386,391 **** --- 389,397 ---- break; case KSTR : Tcl_SetVar(interp,argv[i],(char*)argt[i],TCL_GLOBAL_ONLY); + break; + case KPSTR: + Tcl_SetVar(interp,argv[i],*(char**)(argt[i]),TCL_GLOBAL_ONLY); break; case KPTR : Tcl_SetVar(interp,argv[i],ptoa(argt[i],TKQML_POBJ_TYPE), diff -c kqml/src/tkqml/TKqmlDeriv.C /home/src/kqml/C/ver.2/src/tkqml/TKqmlDeriv.C *** kqml/src/tkqml/TKqmlDeriv.C Wed Jun 4 12:39:44 1997 --- /home/src/kqml/C/ver.2/src/tkqml/TKqmlDeriv.C Wed Jul 2 14:58:11 1997 *************** *** 1,5 **** // ******************** type derivation code **************************** ! // $Id: TKqmlDeriv.C,v 1.7 1997/06/04 16:35:34 ian Exp $ #include #include --- 1,5 ---- // ******************** type derivation code **************************** ! // $Id: TKqmlDeriv.C,v 1.8 1997/07/02 18:58:10 ian Exp $ #include #include *************** *** 91,96 **** --- 91,133 ---- *nv = (void*)strdup(s); *r=DESTROY; } + return(TCL_OK); /* this call can't fail - everything is at least a string */ + } + + // Derive reference to a string (char**) + int derive_qchar(Tcl_Interp *interp, char *s, TTYPE *r, void **nv) { + char *v; + char **str; + + *r=NO_ACTION; /* default */ + if ((v=Tcl_GetVar(interp,s,TCL_GLOBAL_ONLY)) != NULL) { /* variable? */ + if (ptr_string(v,nv)) { // variable holds pointer + if (strcmp(v, "NULL") == 0) { // variable holds null pointer + *nv = (void*)malloc(sizeof(char*)); + *r |= COPY | KPSTR; + } + else if (v[0] != TKQML_QCHAR_TYPE) // variable holds QCHAR ptr + return(tkqml_err(TKQML_DERIV_QCHAR_ERROR)); + } else { // variable holds a literal string + // pass a reference to string literal + str = (char**)malloc(sizeof(char*)); + *str = strdup(v); + *nv = (void*)str; + // set *r to COPY | KPSTR + *r |= COPY | KPSTR; + } + } else { // s is literal string + if (ptr_string(s,nv)) { // string is pointer + if (strcmp(s, "NULL") == 0) + *nv = (void*)NULL; + else if (s[0] != TKQML_QCHAR_TYPE) // variable holds QCHAR ptr + return(tkqml_err(TKQML_DERIV_QCHAR_ERROR)); + } else + return(tkqml_err(TKQML_DERIV_QCHAR_ERROR)); + } + #ifdef DEBUG + printf("QCHAR returning value %p\n", *nv); + #endif return(TCL_OK); /* this call can't fail - everything is at least a string */ } diff -c kqml/src/tkqml/TKqmlHandler.C /home/src/kqml/C/ver.2/src/tkqml/TKqmlHandler.C *** kqml/src/tkqml/TKqmlHandler.C Wed Jun 4 12:39:45 1997 --- /home/src/kqml/C/ver.2/src/tkqml/TKqmlHandler.C Mon Jul 28 15:56:12 1997 *************** *** 10,16 **** // master_handler acts as dispatch for the handler scripts. // //----------------------------------------------------------------------------- ! // $Id: TKqmlHandler.C,v 1.3 1997/05/30 17:51:37 ian Exp $ #include #include --- 10,16 ---- // master_handler acts as dispatch for the handler scripts. // //----------------------------------------------------------------------------- ! // $Id: TKqmlHandler.C,v 1.5 1997/07/28 19:56:11 pmf Exp $ #include #include *************** *** 37,43 **** else { if (handler_table[hook].handler!=NULL) // this is a replace free(handler_table[hook].handler); // so release old script, ! if (argc==2) handler_table[hook].handler=NULL; else { handler_table[hook].handler=(char*)malloc(strlen(argv[3]));// & store new strcpy(handler_table[hook].handler,argv[3]); --- 37,43 ---- else { if (handler_table[hook].handler!=NULL) // this is a replace free(handler_table[hook].handler); // so release old script, ! if (argc==3) handler_table[hook].handler=NULL; else { handler_table[hook].handler=(char*)malloc(strlen(argv[3]));// & store new strcpy(handler_table[hook].handler,argv[3]); *************** *** 57,63 **** else { if (handler_table[hook].handler!=NULL) // this is a replace free(handler_table[hook].handler); // so release old script, ! if (argc==2) handler_table[hook].handler=NULL; else { handler_table[hook].handler=(char*)malloc(strlen(argv[3]));// & store new strcpy(handler_table[hook].handler,argv[3]); --- 57,63 ---- else { if (handler_table[hook].handler!=NULL) // this is a replace free(handler_table[hook].handler); // so release old script, ! if (argc==3) handler_table[hook].handler=NULL; else { handler_table[hook].handler=(char*)malloc(strlen(argv[3]));// & store new strcpy(handler_table[hook].handler,argv[3]); *************** *** 93,108 **** rval=Tcl_SetVar(TInterp,"kqml_reply", TCL_NULL,TCL_GLOBAL_ONLY); // prepare vbl in adv. reply_with = kqml_get_field(":reply-with",message,NULL,NULL); - if ((code=HT_LookUp(kqml_get_performative(message)))!=KQML_ERR) - script=handler_table[code].handler; // look up performative handler - else if ((code=HT_LookUp("default"))!=KQML_ERR) - script=handler_table[code].handler; // if no handler, use default script - else script=system_default_handler; // last resort, use system default if (script == NULL) script = system_default_handler; ! if (handler_table[code].handler_is_file) // run handler rcode=Tcl_EvalFile(TInterp, script); else rcode=Tcl_Eval(TInterp, script); --- 93,116 ---- rval=Tcl_SetVar(TInterp,"kqml_reply", TCL_NULL,TCL_GLOBAL_ONLY); // prepare vbl in adv. reply_with = kqml_get_field(":reply-with",message,NULL,NULL); + if ((code=HT_LookUp(kqml_get_performative(message)))==KQML_ERR) + { + dprint ("Error in handler lookup: invalid performative '%s'\n", + kqml_get_performative(message)); + *reply_type = KQML_REPLY_NONE; + return NULL; + } + if (handler_table[code].handler != NULL) // Execute handler if registered + script = handler_table[code].handler; + else if ((script = handler_table[HT_LookUp("default")].handler) == NULL) + script = system_default_handler; // fall back to defaults + if (script == NULL) script = system_default_handler; ! if (script == system_default_handler || ! handler_table[code].handler_is_file) // run handler rcode=Tcl_EvalFile(TInterp, script); else rcode=Tcl_Eval(TInterp, script); *************** *** 116,128 **** } reply_type_str=Tcl_GetVar(TInterp,"kqml_reply_type",TCL_GLOBAL_ONLY); ! krt_enum_lookup(reply_type_str,reply_type); ! if (*reply_type==KQML_REPLY_STRING) { ! return(Tcl_GetVar(TInterp,"kqml_reply",TCL_GLOBAL_ONLY)); ! } ! else if (*reply_type==KQML_REPLY_KMSG) ! return((kqml_message*)atop(Tcl_GetVar(TInterp,"kqml_reply", ! TCL_GLOBAL_ONLY))); } --- 124,142 ---- } reply_type_str=Tcl_GetVar(TInterp,"kqml_reply_type",TCL_GLOBAL_ONLY); ! if ((reply_type_str != NULL) && (strlen(reply_type_str) > 0)) { ! krt_enum_lookup(reply_type_str,reply_type); ! if (*reply_type==KQML_REPLY_STRING) { ! return(Tcl_GetVar(TInterp,"kqml_reply",TCL_GLOBAL_ONLY)); ! } ! else if (*reply_type==KQML_REPLY_KMSG) ! return((kqml_message*)atop(Tcl_GetVar(TInterp,"kqml_reply", ! TCL_GLOBAL_ONLY))); ! } ! else { ! *reply_type = KQML_REPLY_NONE; ! return NULL; ! } } diff -c kqml/src/tkqml/TKqmlTab.C /home/src/kqml/C/ver.2/src/tkqml/TKqmlTab.C *** kqml/src/tkqml/TKqmlTab.C Wed Jun 4 12:39:44 1997 --- /home/src/kqml/C/ver.2/src/tkqml/TKqmlTab.C Wed Jul 2 15:06:45 1997 *************** *** 7,13 **** // legal kqml performative, and one for a default handler. // //----------------------------------------------------------------------------- ! // $Id: TKqmlTab.C,v 1.5 1997/06/04 16:36:34 ian Exp $ #include #include --- 7,13 ---- // legal kqml performative, and one for a default handler. // //----------------------------------------------------------------------------- ! // $Id: TKqmlTab.C,v 1.6 1997/07/02 19:05:36 ian Exp $ #include #include *************** *** 28,33 **** --- 28,34 ---- {"broadcast", NULL, 0}, {"broker-all", NULL, 0}, {"broker-one", NULL, 0}, + {"default", NULL, 0}, /* Default handler script, not a performative */ {"deny", NULL, 0}, {"delete", NULL, 0}, {"delete-all", NULL, 0}, *************** *** 148,153 **** --- 149,155 ---- {PINT, derive_pint}, {CHAR, derive_char}, {PCHAR, derive_pchar}, + {QCHAR, derive_qchar}, {POBJ, derive_pobj}, {KET, derive_ket}, {PKET, derive_pket}, diff -c kqml/src/tkqml/TKqmlTab.h /home/src/kqml/C/ver.2/src/tkqml/TKqmlTab.h *** kqml/src/tkqml/TKqmlTab.h Wed Jun 4 12:39:45 1997 --- /home/src/kqml/C/ver.2/src/tkqml/TKqmlTab.h Wed Jul 2 15:07:23 1997 *************** *** 1,4 **** ! // $Id: TKqmlTab.h,v 1.3 1997/05/23 19:52:23 ian Exp $ extern int derive_nul(Tcl_Interp*, char*, TTYPE *rc, void**); extern int derive_int(Tcl_Interp*, char*, TTYPE *rc, void**); --- 1,4 ---- ! // $Id: TKqmlTab.h,v 1.4 1997/07/02 19:06:45 ian Exp $ extern int derive_nul(Tcl_Interp*, char*, TTYPE *rc, void**); extern int derive_int(Tcl_Interp*, char*, TTYPE *rc, void**); *************** *** 5,10 **** --- 5,11 ---- extern int derive_pint(Tcl_Interp*, char*, TTYPE *rc, void**); extern int derive_char(Tcl_Interp*, char*, TTYPE *rc, void**); extern int derive_pchar(Tcl_Interp*, char*, TTYPE *rc, void**); + extern int derive_qchar(Tcl_Interp*, char*, TTYPE *rc, void**); extern int derive_pobj(Tcl_Interp*, char*, TTYPE *rc, void**); extern int derive_ket(Tcl_Interp*, char*, TTYPE *rc, void**); extern int derive_pket(Tcl_Interp*, char*, TTYPE *rc, void**);