Overview
| Comment: | Added Tcl_WideInt support |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
60d4d528a0fe217ab06af90a88c0be07 |
| User & Date: | rkeene on 2014-06-23 00:54:42 |
| Other Links: | manifest | tags |
Context
|
2014-06-23
| ||
| 01:39 | Corrected issue where path to headers and libraries was reset when adding libraries and header paths check-in: 79472adb57 user: rkeene tags: trunk | |
| 00:54 | Added Tcl_WideInt support check-in: 60d4d528a0 user: rkeene tags: trunk | |
|
2014-06-22
| ||
| 23:40 | Added a test using "curl" as a baseline for linking in external functions and libraries check-in: 2bc3e54e9e user: rkeene tags: trunk | |
Changes
Modified tcc4tcl.tcl from [64ae92f63e] to [1b632735c7].
334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 ... 368 369 370 371 372 373 374 375 376 377 378 379 380 381 ... 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 |
## int
## long
## float
## double
## char*
## Tcl_Obj*
## void*
foreach x $varnames {
set t $types($x)
switch -- $t {
int - long - float - double - char* - Tcl_Obj* {
append cbody " $types($x) _$x;" "\n"
}
default {
append cbody " void *_$x;" "\n"
}
}
}
................................................................................
append cbody " if (Tcl_GetIntFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
append cbody " return TCL_ERROR;" "\n"
}
long {
append cbody " if (Tcl_GetLongFromObj(ip, objv\[$n], &_$x) != TCL_OK)"
append cbody " return TCL_ERROR;" "\n"
}
float {
append cbody " {" "\n"
append cbody " double t;" "\n"
append cbody " if (Tcl_GetDoubleFromObj(ip, objv\[$n], &t) != TCL_OK)"
append cbody " return TCL_ERROR;" "\n"
append cbody " _$x = (float) t;" "\n"
append cbody " }" "\n"
................................................................................
# float
# double
# char* (TCL_STATIC char*)
# string (TCL_DYNAMIC char*)
# dstring (TCL_DYNAMIC char*)
# vstring (TCL_VOLATILE char*)
# default (Tcl_Obj*)
# wide
switch -- $rtype {
void - ok - int - long - float - double - wide {}
default {
append cbody " if (rv == NULL) {\n"
append cbody " return(TCL_ERROR);\n"
append cbody " }\n"
}
}
switch -- $rtype {
void { }
ok { append cbody " return rv;" "\n" }
int { append cbody " Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" }
long { append cbody " Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" }
float -
double { append cbody " Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" }
char* { append cbody " Tcl_SetResult(ip, rv, TCL_STATIC);" "\n" }
string -
dstring { append cbody " Tcl_SetResult(ip, rv, TCL_DYNAMIC);" "\n" }
vstring { append cbody " Tcl_SetResult(ip, rv, TCL_VOLATILE);" "\n" }
default { append cbody " Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv);" "\n" }
|
> | > > > > | | > |
334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 ... 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 ... 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 |
## int ## long ## float ## double ## char* ## Tcl_Obj* ## void* ## Tcl_WideInt foreach x $varnames { set t $types($x) switch -- $t { int - long - float - double - char* - Tcl_WideInt - Tcl_Obj* { append cbody " $types($x) _$x;" "\n" } default { append cbody " void *_$x;" "\n" } } } ................................................................................ append cbody " if (Tcl_GetIntFromObj(ip, objv\[$n], &_$x) != TCL_OK)" append cbody " return TCL_ERROR;" "\n" } long { append cbody " if (Tcl_GetLongFromObj(ip, objv\[$n], &_$x) != TCL_OK)" append cbody " return TCL_ERROR;" "\n" } Tcl_WideInt { append cbody " if (Tcl_GetWideIntFromObj(ip, objv\[$n], &_$x) != TCL_OK)" append cbody " return TCL_ERROR;" "\n" } float { append cbody " {" "\n" append cbody " double t;" "\n" append cbody " if (Tcl_GetDoubleFromObj(ip, objv\[$n], &t) != TCL_OK)" append cbody " return TCL_ERROR;" "\n" append cbody " _$x = (float) t;" "\n" append cbody " }" "\n" ................................................................................ # float # double # char* (TCL_STATIC char*) # string (TCL_DYNAMIC char*) # dstring (TCL_DYNAMIC char*) # vstring (TCL_VOLATILE char*) # default (Tcl_Obj*) # Tcl_WideInt switch -- $rtype { void - ok - int - long - float - double - Tcl_WideInt {} default { append cbody " if (rv == NULL) {\n" append cbody " return(TCL_ERROR);\n" append cbody " }\n" } } switch -- $rtype { void { } ok { append cbody " return rv;" "\n" } int { append cbody " Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" } long { append cbody " Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" } Tcl_WideInt { append cbody " Tcl_SetWideIntObj(Tcl_GetObjResult(ip), rv);" "\n" } float - double { append cbody " Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" } char* { append cbody " Tcl_SetResult(ip, rv, TCL_STATIC);" "\n" } string - dstring { append cbody " Tcl_SetResult(ip, rv, TCL_DYNAMIC);" "\n" } vstring { append cbody " Tcl_SetResult(ip, rv, TCL_VOLATILE);" "\n" } default { append cbody " Tcl_SetObjResult(ip, rv); Tcl_DecrRefCount(rv);" "\n" } |