1

/* -*- Mode: c++ -*-

2

* $Id: xotclInt.h,v 1.27 2007/10/12 19:53:32 neumann Exp $

2

* $Id: xotclInt.h,v 1.20 2006/10/04 20:40:23 neumann Exp $

3

* Extended Object Tcl (XOTcl)

4

*

5

76

#define DSTRING_FREE(D) Tcl_DStringFree(D); MEM_COUNT_FREE("DString",D)

77

78

#if USE_ASSOC_DATA

79

# define RUNTIME_STATE(in) ((XOTclRuntimeState*)Tcl_GetAssocData((in), "XOTclRuntimeState", NULL))

79

# define RUNTIME_STATE(in) ((XOTclRuntimeState*) Tcl_GetAssocData(in, "XOTclRuntimeState", NULL))

80

#else

81

# define RUNTIME_STATE(in) ((XOTclRuntimeState*)((Interp*) in)->globalNsPtr->clientData)

81

# define RUNTIME_STATE(in) \

82

((XOTclRuntimeState*)((Interp*) in)->globalNsPtr->clientData)

82

83

#endif

83

84

85

129

130

#define isAllocString(m) (\

130

131

*m == 'a' && m[1] == 'l' && m[2] == 'l' && m[3] == 'o' && \

131

132

m[4] == 'c' && m[5] == '\0')

133

#define isDeallocString(m) (\

134

*m == 'd' && m[1] == 'e' && m[2] == 'a' && m[3] == 'l' && \

135

m[4] == 'l' && m[5] == 'o' && m[6] == 'c' && m[7] == '\0')

132

136

#define isDestroyString(m) (\

133

137

*m == 'd' && m[1] == 'e' && m[2] == 's' && m[3] == 't' && \

134

138

m[4] == 'r' && m[5] == 'o' && m[6] == 'y' && m[7] == '\0')

272

276

273

277

#if 0

274

278

#define XOTcl_FrameDecls CallFrame *oldFramePtr = 0, frame, *newFramePtr = &frame

275

#define XOTcl_PushFrame(in,obj) \

279

#define XOTcl_PushFrame(interp,obj) \

276

280

memset(newFramePtr, 0, sizeof(CallFrame)); \

277

oldFramePtr = ((Interp *)in)->varFramePtr; \

281

oldFramePtr = ((Interp *)interp)->varFramePtr; \

278

282

if ((obj)->nsPtr) { \

279

283

newFramePtr->nsPtr = (Namespace*) (obj)->nsPtr; \

280

284

} else { \

281

newFramePtr->nsPtr = (Namespace*) RUNTIME_STATE(in)->fakeNS; \

285

newFramePtr->nsPtr = (Namespace*) RUNTIME_STATE(interp)->fakeNS; \

282

286

newFramePtr->isProcCallFrame = 1; \

283

newFramePtr->procPtr = &RUNTIME_STATE(in)->fakeProc; \

287

newFramePtr->procPtr = &RUNTIME_STATE(interp)->fakeProc; \

284

288

newFramePtr->varTablePtr = (obj)->varTable; \

285

289

} \

286

((Interp *)in)->varFramePtr = newFramePtr; \

290

((Interp *)interp)->varFramePtr = newFramePtr; \

287

291

MEM_COUNT_OPEN_FRAME()

288

#define XOTcl_PopFrame(in,obj) \

292

#define XOTcl_PopFrame(interp,obj) \

289

293

if (!(obj)->nsPtr && (obj)->varTable == 0) \

290

294

(obj)->varTable = newFramePtr->varTablePtr; \

291

((Interp *)in)->varFramePtr = oldFramePtr; \

295

((Interp *)interp)->varFramePtr = oldFramePtr; \

292

296

MEM_COUNT_CLOSE_FRAME()

293

297

294

298

#else

300

304

#define XOTcl_PushFrame(interp,obj) \

301

305

if ((obj)->nsPtr) { \

302

306

frame_constructed = 0; \

303

Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr, (obj)->nsPtr, 0); \

307

Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr, (obj)->nsPtr, 0); \

304

308

} else { \

305

CallFrame *myframe = (CallFrame *)framePtr; \

309

CallFrame *myframePtr = (CallFrame *)framePtr; \

306

310

Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr, RUNTIME_STATE(interp)->fakeNS, 1); \

307

Tcl_CallFrame_procPtr(myframe) = &RUNTIME_STATE(interp)->fakeProc; \

308

Tcl_CallFrame_varTablePtr(myframe) = (obj)->varTable; \

311

Tcl_CallFrame_procPtr(myframePtr) = &RUNTIME_STATE(interp)->fakeProc; \

312

Tcl_CallFrame_varTablePtr(myframePtr) = (obj)->varTable; \

309

313

}

310

314

#define XOTcl_PopFrame(interp,obj) \

311

315

if (!(obj)->nsPtr) { \

314

318

(obj)->varTable = Tcl_CallFrame_varTablePtr(myframe); \

315

319

} \

316

320

if (frame_constructed) { \

317

Interp *iPtr = (Interp *) interp; \

321

register Interp *iPtr = (Interp *) interp; \

318

322

register CallFrame *myframe = iPtr->framePtr; \

319

323

Tcl_CallFrame_varTablePtr(myframe) = 0; \

320

324

Tcl_CallFrame_procPtr(myframe) = 0; \

359

363

typedef struct XOTclFilterStack {

360

364

Tcl_Command currentCmdPtr;

361

365

Tcl_Obj* calledProc;

362

struct XOTclFilterStack* next;

366

struct XOTclFilterStack* nextPtr;

363

367

} XOTclFilterStack;

364

368

365

369

typedef struct XOTclTclObjList {

366

370

Tcl_Obj* content;

367

struct XOTclTclObjList* next;

371

struct XOTclTclObjList* nextPtr;

368

372

} XOTclTclObjList;

369

373

370

374

/*

396

400

*/

397

401

typedef struct XOTclMixinStack {

398

402

Tcl_Command currentCmdPtr;

399

struct XOTclMixinStack* next;

403

struct XOTclMixinStack* nextPtr;

400

404

} XOTclMixinStack;

401

405

402

406

/*

406

410

Tcl_Command cmdPtr;

407

411

ClientData clientData;

408

412

struct XOTclClass *clorobj;

409

struct XOTclCmdList* next;

413

struct XOTclCmdList* nextPtr;

410

414

} XOTclCmdList;

411

415

412

416

typedef void (XOTclFreeCmdListClientData) _ANSI_ARGS_((XOTclCmdList*));

458

462

*/

459

463

460

464

typedef struct XOTclNonposArgs {

461

Tcl_Obj* nonposArgs;

462

Tcl_Obj* ordinaryArgs;

465

Tcl_Obj* nonposArgs;

466

Tcl_Obj* ordinaryArgs;

467

Tcl_Obj* slotObj;

463

468

} XOTclNonposArgs;

464

469

465

470

typedef struct XOTclObjectOpt {

470

475

Tcl_HashTable metaData;

471

476

#endif

472

477

ClientData clientData;

473

char *volatileVarName;

474

478

short checkoptions;

475

479

} XOTclObjectOpt;

476

480

491

495

Tcl_HashTable *nonposArgsTable;

492

496

} XOTclObject;

493

497

498

typedef struct XOTclObjects {

499

struct XOTclObject* obj;

500

struct XOTclObjects* nextPtr;

501

} XOTclObjects;

502

494

503

typedef struct XOTclClassOpt {

495

504

XOTclCmdList* instfilters;

496

505

XOTclCmdList* instmixins;

508

517

struct XOTclClasses* sub;

509

518

short color;

510

519

struct XOTclClasses* order;

511

struct XOTclClass* parent;

520

/*struct XOTclClass* parent;*/

512

521

Tcl_HashTable instances;

513

522

Tcl_Namespace *nsPtr;

514

523

Tcl_Obj* parameters;

519

528

typedef struct XOTclClasses {

520

529

struct XOTclClass* cl;

521

530

ClientData clientData;

522

struct XOTclClasses* next;

531

struct XOTclClasses* nextPtr;

523

532

} XOTclClasses;

524

533

525

534

/* XOTcl global names and strings */

530

539

XOTE_EMPTY, XOTE_UNKNOWN, XOTE_CREATE, XOTE_DESTROY, XOTE_INSTDESTROY,

531

540

XOTE_ALLOC, XOTE_INIT, XOTE_INSTVAR, XOTE_INTERP, XOTE_AUTONAMES,

532

541

XOTE_ZERO, XOTE_ONE, XOTE_MOVE, XOTE_SELF, XOTE_CLASS, XOTE_RECREATE,

533

XOTE_SELF_CLASS, XOTE_SELF_PROC, XOTE_PARAM_CL,

534

XOTE_SEARCH_DEFAULTS, XOTE_EXIT_HANDLER,

535

XOTE_NON_POS_ARGS_CL, XOTE_NON_POS_ARGS_OBJ,

542

XOTE_SELF_CLASS, XOTE_SELF_PROC,

543

XOTE_EXIT_HANDLER, XOTE_DEFAULTSUPERCLASS,

544

XOTE_NON_POS_ARGS_OBJ, XOTE_SETVALUES,

536

545

XOTE_CLEANUP, XOTE_CONFIGURE, XOTE_FILTER, XOTE_INSTFILTER,

537

546

XOTE_INSTPROC, XOTE_PROC, XOTE_INSTFORWARD, XOTE_FORWARD,

538

547

XOTE_INSTCMD, XOTE_CMD, XOTE_INSTPARAMETERCMD, XOTE_PARAMETERCMD,

539

XOTE_MKGETTERSETTER, XOTE_FORMAT,

548

XOTE_FORMAT, XOTE_INITSLOTS,

540

549

XOTE_NEWOBJ, XOTE_GUARD_OPTION, XOTE_DEFAULTMETHOD,

541

550

XOTE___UNKNOWN, XOTE_ARGS, XOTE_SPLIT, XOTE_COMMA,

542

551

/** these are the redefined tcl commands; leave them

550

559

"", "unknown", "create", "destroy", "instdestroy",

551

560

"alloc", "init", "instvar", "interp", "__autonames",

552

561

"0", "1", "move", "self", "class", "recreate",

553

"self class", "self proc", "::xotcl::Class::Parameter",

554

"searchDefaults", "__exitHandler",

555

"::xotcl::NonposArgs", "::xotcl::nonposArgs",

562

"self class", "self proc",

563

"__exitHandler", "__default_superclass",

564

"::xotcl::nonposArgs", "setvalues",

556

565

"cleanup", "configure", "filter", "instfilter",

557

566

"instproc", "proc", "instforward", "forward",

558

567

"instcmd", "cmd", "instparametercmd", "parametercmd",

559

"mkGetterSetter", "format",

560

"__#", "-guard", "defaultmethod",

568

"format", "initslots",

569

"__#", "-guard", "defaultmethod",

561

570

"__unknown", "args", "split", ",",

562

571

"expr", "info", "rename", "subst",

563

572

};

564

573

#endif

565

574

566

#define XOTclGlobalObjects RUNTIME_STATE(in)->methodObjNames

575

#define XOTclGlobalObjects RUNTIME_STATE(interp)->methodObjNames

567

576

568

577

/* XOTcl ShadowTclCommands */

569

578

typedef struct XOTclShadowTclCommandInfo {

570

579

TclObjCmdProcType proc;

571

ClientData cd;

580

ClientData clientData;

572

581

} XOTclShadowTclCommandInfo;

573

582

typedef enum {SHADOW_LOAD=1, SHADOW_UNLOAD=0, SHADOW_REFETCH=2} XOTclShadowOperations;

574

583

717

726

extern void

718

727

XOTclMetaDataInit(XOTclObject* obj);

719

728

extern int

720

XOTclOMetaDataMethod (ClientData cd, Tcl_Interp* in,

729

XOTclOMetaDataMethod (ClientData clientData, Tcl_Interp* in,

721

730

int objc, Tcl_Obj *objv[]);

722

731

#endif /* XOTCL_METADATA */

723

732

742

751

Tcl_ObjCmdProc XOTclInitProcNSCmd, XOTclSelfDispatchCmd,

743

752

XOTclNextObjCmd, XOTclGetSelfObjCmd;

744

753

745

int XOTclDirectSelfDispatch(ClientData cd, Tcl_Interp* in,

754

int XOTclDirectSelfDispatch(ClientData clientData, Tcl_Interp* in,

746

755

int objc, Tcl_Obj *CONST objv[]);

747

756

#endif

748

757

749

758

int

750

XOTclObjDispatch(ClientData cd, Tcl_Interp* in,

759

XOTclObjDispatch(ClientData clientData, Tcl_Interp* in,

751

760

int objc, Tcl_Obj *CONST objv[]);

752

761

753

762

XOTclCallStackContent *