diff --git a/sicstemplates.tcl b/sicstemplates.tcl new file mode 100644 index 00000000..a5159572 --- /dev/null +++ b/sicstemplates.tcl @@ -0,0 +1,107 @@ +#---------------------------------------------------------------------------- +# This file contaisn template generation code for SICS programming +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, December 2006 +#---------------------------------------------------------------------------- +proc stdIncludes {} { + append txt "#include \n" + append txt "#include \n" + append txt "#include \n" + append txt "#include \n" +} +#--------------------------------------------------------------------------- +proc makeSicsFunc {name} { + append txt "int ${name}(SConnection *pCon,SicsInterp *pSics, void *pData,\n" + append txt " int argc, char *argv\[\])" + return $txt +} +#---------------------------------------------------------------------------- +proc newStruc {name indent} { + set pre [string repeat " " $indent] + append txt "pNew = malloc(sizeof($name));\n" + append txt $pre "if(pNew == NULL){\n" + append txt $pre " return NULL;\n" + append txt $pre "}\n" + append txt $pre "memset(pNew,0,sizeof($name));\n" + return $txt +} +#---------------------------------------------------------------------------- +proc newStrucRet {name indent retval} { + set pre [string repeat " " $indent] + append txt "pNew = malloc(sizeof($name));\n" + append txt $pre "if(pNew == NULL){\n" + append txt $pre " return $retval;\n" + append txt $pre "}\n" + append txt $pre "memset(pNew,0,sizeof($name));\n" + return $txt +} +#----------------------------------------------------------------------------- +proc testNoPar {noPar indent} { + set pre [string repeat " " $indent] + append txt "if(argc < $noPar){\n" + append txt $pre " SCWrite(pCon,\"ERROR: Not enough arguments\",eError);\n" + append txt $pre " return 0;\n" + append txt $pre "}\n" + return $txt +} +#------------------------------------------------------------------------------- +proc testPriv {priv indent} { + set pre [string repeat " " $indent] + append txt "if(!SCMatchRights(pCon,$priv)){\n" + append txt $pre " return 0;\n" + append txt $pre "}\n" + return $txt +} +#-------------------------------------------------------------------------------- +proc sicsPar {parName parCName noPar priv type indent} { + set pre [string repeat " " $indent] + append txt "if(argc < $noPar) {\n" + switch $type { + int { + append txt $pre + append txt " snprintf(buffer,512,\"%s.%s = %d\", argv\[0\], \"$parName\", $parCName);\n" + } + float { + append txt $pre + append txt " snprintf(buffer,512,\"%s.%s = %f\", argv\[0\], \"$parName\", $parCName);\n" + } + text { + append txt $pre + append txt " snprintf(buffer,512,\"%s.%s = %s\", argv\[0\], \"$parName\", $parCName);\n" + } + default { + error "$type is unknown" + } + } + append txt $pre "} else {\n" + append txt $pre " " [testPriv $priv [expr $indent + 4]] + set n [expr $noPar -1] + switch $type { + int { + append txt $pre " status = sscanf(argv\[$n\],\"%d\",&$parCName);\n" + } + float { + append txt $pre " status = sscanf(argv\[$n\],\"%f\",&$parCName);\n" + } + text { + append txt $pre " if($parCName != NULL){\n" + append txt $pre " free($parCName);\n" + append txt $pre " }\n" + append txt $pre " $parCName = strdup(argv\[$n\]);\n" + append txt $pre " status = 1;\n" + } + } + append txt $pre " if(status != 1) {\n" + append txt $pre " snprintf(buffer,512," + append txt "\"ERROR: failed to convert %s to $type\",argv\[$n\]);\n" + append txt $pre " SCWrite(pCon,buffer,eError);\n" + append txt $pre " return 0;\n" + append txt $pre " } else {\n" + append txt $pre " SCSendOK(pCon);\n" + append txt $pre " return 1;\n" + append txt $pre " }\n" + append txt $pre "}" + return $txt +}