1 /***************************************************************************
2 envt.cpp - description
3 -------------------
4 begin : July 22 2002
5 copyright : (C) 2002 by Marc Schellens
6 email : m_schellens@users.sf.net
7 ***************************************************************************/
8
9 /***************************************************************************
10 * *
11 * This program is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 ***************************************************************************/
17
18 #include "includefirst.hpp"
19
20 #include <iomanip>
21
22 #include "envt.hpp"
23 #include "objects.hpp"
24 #include "dinterpreter.hpp"
25 #include "basic_pro.hpp"
26 #include "nullgdl.hpp"
27
28 #include <cassert> // always as last
29
30 using namespace std;
31
32 // instance of static data
33 DInterpreter* EnvBaseT::interpreter;
34
35 // EnvBaseT::ContainerT EnvBaseT::toDestroy;
36
37 // EnvT::new & delete
38 vector< void*> EnvT::freeList;
39 const int multiAllocEnvT = 4;
operator new(size_t bytes)40 void* EnvT::operator new( size_t bytes)
41 {
42 assert( bytes == sizeof( EnvT));
43 if( freeList.size() > 0)
44 {
45 void* res = freeList.back();
46 freeList.pop_back();
47 return res;
48 }
49 // cout << "*** Resize EnvT " << endl;
50 const size_t newSize = multiAllocEnvT - 1;
51 freeList.resize( newSize);
52 char* res = static_cast< char*>( malloc( sizeof( EnvT) * multiAllocEnvT)); // one more than newSize
53 for( size_t i=0; i<newSize; ++i)
54 {
55 freeList[ i] = res;
56 res += sizeof( EnvT);
57 }
58 // the one more
59 return res;
60 }
operator delete(void * ptr)61 void EnvT::operator delete( void *ptr)
62 {
63 freeList.push_back( ptr);
64 }
65
66 // EnvUDT::new & delete
67 // deque< void*> EnvUDT::freeList;
68 FreeListT EnvUDT::freeList;
69 const int multiAllocEnvUDT = 16;
operator new(size_t bytes)70 void* EnvUDT::operator new( size_t bytes)
71 {
72 assert( bytes == sizeof( EnvUDT));
73 if( freeList.size() > 0)
74 {
75 return freeList.pop_back();
76 // void* res = freeList.back();
77 // freeList.pop_back();
78 // return res;
79 }
80 // cout << "*** Resize EnvUDT " << endl;
81 const size_t newSize = multiAllocEnvUDT - 1;
82
83 static long callCount = 0;
84 ++callCount;
85
86 freeList.reserve( multiAllocEnvUDT * callCount);
87 // char* res = static_cast< char*>( malloc( sizeof( EnvUDT) * multiAllocEnvUDT)); // one more than newSize
88 // for( size_t i=0; i<newSize; ++i)
89 // {
90 // freeList[ i] = res;
91 // res += sizeof( EnvUDT);
92 // }
93 const size_t sizeOfType = sizeof( EnvUDT);
94 char* res = static_cast< char*>( malloc( sizeOfType * multiAllocEnvUDT)); // one more than newSize
95
96 res = freeList.Init( newSize, res, sizeOfType);
97 // the one more
98 return res;
99 }
operator delete(void * ptr)100 void EnvUDT::operator delete( void *ptr)
101 {
102 freeList.push_back( ptr);
103 }
104
105
106
107
108
EnvBaseT(ProgNodeP cN,DSub * pro_)109 EnvBaseT::EnvBaseT( ProgNodeP cN, DSub* pro_):
110 toDestroy()
111 ,env()
112 ,pro(pro_)
113 ,callingNode( cN)
114 ,lineNumber( 0)
115 ,obj(false)
116 ,extra(NULL)
117 ,newEnvOff(NULL)
118 ,ptrToReturnValue(NULL)
119 //, toDestroyInitialIndex( toDestroy.size())
120 {}
121
EnvUDT(ProgNodeP cN,DSubUD * pro_,CallContext lF)122 EnvUDT::EnvUDT( ProgNodeP cN, DSubUD* pro_, CallContext lF):
123 EnvBaseT( cN, pro_),
124 ioError(NULL),
125 onError( -1),
126 catchVar(NULL),
127 catchNode(NULL),
128 callContext( lF),
129 // callContext( RFUNCTION),
130 nJump( 0),
131 lastJump( -1)
132 {
133 DSubUD* proUD=static_cast<DSubUD*>(pro);
134
135 forLoopInfo.InitSize( proUD->NForLoops());
136
137 SizeT envSize;
138 SizeT keySize;
139
140 envSize=proUD->var.size();
141 keySize=proUD->key.size();
142
143 env.resize(envSize);
144 parIx=keySize; // set to first parameter
145 }
146
EnvT(ProgNodeP cN,DSub * pro_)147 EnvT::EnvT ( ProgNodeP cN, DSub* pro_):
148 EnvBaseT ( cN, pro_)
149 {
150 // SizeT envSize;
151 // SizeT keySize;
152 parIx=pro->key.size();
153 if ( pro->nPar > 0 )
154 {
155 env.resize ( pro->nPar + parIx);
156 // envSize=pro->nPar+parIx;
157 }
158 else
159 {
160 env.resize ( parIx);
161 // envSize=parIx;
162 // performance optimization
163 //env.reserve(envSize+5);
164 }
165 // env.resize ( envSize);
166 // parIx=keySize; // set to first parameter
167 }
168
169 // member pro
EnvUDT(ProgNodeP cN,BaseGDL * self,const string & parent)170 EnvUDT::EnvUDT( ProgNodeP cN, BaseGDL* self,
171 const string& parent):
172 EnvBaseT( cN, NULL),
173 ioError(NULL),
174 onError( -1),
175 catchVar(NULL),
176 catchNode(NULL),
177 callContext( RFUNCTION),
178 nJump( 0),
179 lastJump( -1)
180 {
181 obj = true;
182
183 DType selfType = self->Type();
184 if( selfType != GDL_OBJ)
185 throw GDLException( cN, "Object reference type"
186 " required in this context: "+interpreter->Name(self));
187
188 DStructGDL* oStructGDL = interpreter->ObjectStruct( static_cast<DObjGDL*>(self), cN);
189
190 const string& mp = cN->getText();
191
192 DStructDesc* desc=oStructGDL->Desc();
193
194 if( parent != "")
195 {
196 pro=desc->GetPro( mp, parent);
197
198 if( pro == NULL)
199 throw GDLException(cN,"Attempt to call undefined method: "+
200 parent+"::"+mp,true,false);
201 }
202 else
203 {
204 pro=desc->GetPro( mp);
205
206 if( pro == NULL)
207 throw GDLException(cN,"Attempt to call undefined method: "+
208 desc->Name()+"::"+mp,true,false);
209 }
210
211 DSubUD* proUD=static_cast<DSubUD*>(pro);
212
213 forLoopInfo.InitSize( proUD->NForLoops());
214
215 SizeT envSize;
216 // SizeT keySize;
217 envSize=proUD->var.size();
218 parIx=proUD->key.size();
219
220 env.resize(envSize);
221 // parIx=keySize; // set to first parameter
222 // pass by value (self must not be changed)
223 env.Set( parIx++, self); //static_cast<BaseGDL*>(oStructGDL));
224 }
225
226 // member fun
EnvUDT(BaseGDL * self,ProgNodeP cN,const string & parent,CallContext lF)227 EnvUDT::EnvUDT( BaseGDL* self, ProgNodeP cN, const string& parent, CallContext lF):
228 EnvBaseT( cN, NULL),
229 ioError(NULL),
230 onError( -1),
231 catchVar(NULL),
232 catchNode(NULL),
233 callContext( lF),
234 nJump( 0),
235 lastJump( -1)
236 {
237 obj = true;
238
239 DType selfType = self->Type();
240 if( selfType != GDL_OBJ)
241 throw GDLException( cN, "Object reference type"
242 " required in this context: "+interpreter->Name(self));
243
244 DStructGDL* oStructGDL = interpreter->ObjectStruct( static_cast<DObjGDL*>(self), cN);
245
246 const string& mp = cN->getText();
247
248 DStructDesc* desc=oStructGDL->Desc();
249
250 if( parent != "")
251 {
252 pro=desc->GetFun( mp, parent);
253
254 if( pro == NULL)
255 throw GDLException(cN,"Attempt to call undefined method: "+
256 parent+"::"+mp,true,false);
257 }
258 else
259 {
260 pro=desc->GetFun( mp);
261
262 if( pro == NULL)
263 throw GDLException(cN,"Attempt to call undefined method: "+
264 desc->Name()+"::"+mp,true,false);
265 }
266
267 DSubUD* proUD=static_cast<DSubUD*>(pro);
268
269 forLoopInfo.InitSize( proUD->NForLoops());
270
271 SizeT envSize=proUD->var.size();
272 parIx=proUD->key.size();
273
274 env.resize(envSize);
275 // parIx=keySize; // set to first parameter
276 // pass by value (self must not be changed)
277 env.Set( parIx++, self); //static_cast<BaseGDL*>(oStructGDL));
278 }
279
280
281
282 // for obj_new, obj_destroy, call_procedure and call_function
EnvT(EnvT * pEnv,DSub * newPro,DObjGDL ** self)283 EnvT::EnvT( EnvT* pEnv, DSub* newPro, DObjGDL** self):
284 EnvBaseT( pEnv->callingNode, newPro)
285 {
286 obj = (self != NULL);
287
288 SizeT envSize;
289 parIx=pro->key.size();
290 if( pro->nPar > 0)
291 {
292 envSize=pro->nPar+parIx;
293 }
294 else
295 {
296 envSize=parIx;
297 }
298 env.resize(envSize);
299 // parIx=keySize; // set to first parameter
300 // pass by reference (self must not be deleted)
301 if( self != NULL)
302 env.Set( parIx++, (BaseGDL**)self); //static_cast<BaseGDL*>(oStructGDL));
303 }
304
305
306
307 //EnvUDT::EnvUDT( EnvBaseT* pEnv, DSub* newPro, BaseGDL** self):
EnvUDT(ProgNodeP callingNode_,DSubUD * newPro,DObjGDL ** self)308 EnvUDT::EnvUDT( ProgNodeP callingNode_, DSubUD* newPro, DObjGDL** self):
309 // EnvBaseT( pEnv->CallingNode(), newPro),
310 EnvBaseT( callingNode_, newPro),
311 ioError(NULL),
312 onError( -1),
313 catchVar(NULL),
314 catchNode(NULL),
315 callContext( RFUNCTION),
316 nJump( 0),
317 lastJump( -1)
318 {
319 obj = (self != NULL);
320
321 DSubUD* proUD= newPro; //static_cast<DSubUD*>(pro);
322
323 forLoopInfo.InitSize( proUD->NForLoops());
324
325 SizeT envSize;
326 // SizeT keySize;
327 envSize=proUD->var.size();
328 parIx=proUD->key.size();
329 env.resize(envSize);
330 // parIx=keySize; // set to first parameter
331 // pass by reference (self must not be deleted)
332 if( self != NULL)
333 env.Set( parIx++, (BaseGDL**)self); //static_cast<BaseGDL*>(oStructGDL));
334 }
335
336
337
338
AddStruct(DPtrListT & ptrAccessible,DPtrListT & objAccessible,DStructGDL * stru)339 void EnvBaseT::AddStruct( DPtrListT& ptrAccessible,
340 DPtrListT& objAccessible, DStructGDL* stru)
341 {
342 if( stru == NULL) return;
343
344 SizeT nEl = stru->N_Elements();
345
346 const DStructDesc* desc = stru->Desc();
347
348 // avoid recursion on LIST (for > 100000 list elements a segfault is generated otherwise)
349 if( desc->IsParent("LIST"))
350 {
351 AddLIST(ptrAccessible, objAccessible, stru);
352 return;
353 }
354
355 SizeT nTags = desc->NTags();
356 for( SizeT t=0; t<nTags; ++t)
357 {
358 if( (*desc)[ t]->Type() == GDL_PTR)
359 {
360 for( SizeT e = 0; e<nEl; ++e)
361 {
362 DPtrGDL* ptr = static_cast< DPtrGDL*>( stru->GetTag( t, e));
363 AddPtr( ptrAccessible, objAccessible, ptr);
364 }
365 }
366 else if( (*desc)[ t]->Type() == GDL_STRUCT)
367 {
368 for( SizeT e = 0; e<nEl; ++e)
369 {
370 DStructGDL* ptr = static_cast< DStructGDL*>( stru->GetTag( t, e));
371 AddStruct( ptrAccessible, objAccessible, ptr);
372 }
373 }
374 else if( (*desc)[ t]->Type() == GDL_OBJ)
375 {
376 for( SizeT e = 0; e<nEl; ++e)
377 {
378 DObjGDL* obj = static_cast< DObjGDL*>( stru->GetTag( t, e));
379 AddObj( ptrAccessible, objAccessible, obj);
380 }
381 }
382
383 }
384 }
AddPtr(DPtrListT & ptrAccessible,DPtrListT & objAccessible,DPtrGDL * ptr)385 void EnvBaseT::AddPtr( DPtrListT& ptrAccessible, DPtrListT& objAccessible,
386 DPtrGDL* ptr)
387 {
388 if( ptr == NULL) return;
389
390 SizeT nEl = ptr->N_Elements();
391 for( SizeT e = 0; e<nEl; ++e)
392 {
393 DPtr p = (*ptr)[ e];
394 if( p != 0 && interpreter->PtrValid( p))
395 {
396 if( ptrAccessible.find( p) == ptrAccessible.end())
397 {
398 ptrAccessible.insert( p);
399 Add( ptrAccessible, objAccessible, interpreter->GetHeap( p));
400 }
401 }
402 }
403 }
AddObj(DPtrListT & ptrAccessible,DPtrListT & objAccessible,DObjGDL * ptr)404 void EnvBaseT::AddObj( DPtrListT& ptrAccessible, DPtrListT& objAccessible,
405 DObjGDL* ptr)
406 {
407 if( ptr == NULL) return;
408
409 SizeT nEl = ptr->Size();// N_Elements();
410 for( SizeT e = 0; e<nEl; ++e)
411 {
412 DObj p = (*ptr)[ e];
413 if( p != 0 && interpreter->ObjValid( p))
414 {
415 if( objAccessible.find( p) == objAccessible.end())
416 {
417 objAccessible.insert( p);
418 AddStruct( ptrAccessible, objAccessible,
419 interpreter->GetObjHeap( p));
420 }
421 }
422 }
423 }
Add(DPtrListT & ptrAccessible,DPtrListT & objAccessible,BaseGDL * p)424 void EnvBaseT::Add( DPtrListT& ptrAccessible, DPtrListT& objAccessible,
425 BaseGDL* p)
426 {
427 if( p == NULL)
428 return;
429 DType pType = p->Type();
430 if( pType == GDL_PTR)
431 AddPtr( ptrAccessible, objAccessible, static_cast< DPtrGDL*>( p));
432 else if( pType == GDL_STRUCT)
433 AddStruct( ptrAccessible, objAccessible, static_cast< DStructGDL*>( p));
434 else if( pType == GDL_OBJ)
435 AddObj( ptrAccessible, objAccessible, static_cast< DObjGDL*>( p));
436 }
AddEnv(DPtrListT & ptrAccessible,DPtrListT & objAccessible)437 void EnvBaseT::AddEnv( DPtrListT& ptrAccessible, DPtrListT& objAccessible)
438 {
439 for( SizeT e=0; e<env.size(); ++e)
440 {
441 Add( ptrAccessible, objAccessible, env[ e]);
442 }
443 }
AddToDestroy(DPtrListT & ptrAccessible,DPtrListT & objAccessible)444 void EnvBaseT::AddToDestroy( DPtrListT& ptrAccessible, DPtrListT& objAccessible)
445 {
446 for( SizeT i=0; i<toDestroy.size(); ++i)
447 {
448 Add( ptrAccessible, objAccessible, toDestroy[i]);
449 }
450 }
451
452 typedef std::vector<DObj> VectorDObj;
HeapGC(bool doPtr,bool doObj,bool verbose)453 void EnvT::HeapGC( bool doPtr, bool doObj, bool verbose)
454 {
455 // within CLEANUP method HEAP_GC could be called again
456 // within CLEANUP common block or global variables may be freed
457 // thus HEAP_GC has to be called again if called (but only once)
458 static SizeT inProgress = 0;
459 if( inProgress > 0)
460 {
461 inProgress = 2;
462 return;
463 }
464
465 startGC:
466 inProgress = 1;
467
468 try {
469 DPtrListT ptrAccessible;
470 DPtrListT objAccessible;
471
472 // search common blocks
473 for( CommonListT::iterator c = commonList.begin();
474 c != commonList.end(); ++c)
475 {
476 DCommon* common = *c;
477 SizeT nVar = common->NVar();
478 for( SizeT v = 0; v < nVar; ++v)
479 {
480 DVar* var = common->Var( v);
481 if( var != NULL)
482 {
483 Add( ptrAccessible, objAccessible, var->Data());
484 }
485 }
486 }
487
488 SizeT nVar = sysVarList.size();
489 for( SizeT v=0; v<nVar; ++v)
490 {
491 DVar* var = sysVarList[ v];
492 if( var != NULL)
493 {
494 Add( ptrAccessible, objAccessible, var->Data());
495 }
496 }
497
498 EnvStackT& cS=interpreter->CallStack();
499 // for( EnvStackT::reverse_iterator r = cS.rbegin(); r != cS.rend(); ++r)
500 for( long ix = cS.size()-1; ix >= 0; --ix)
501 {
502 cS[ix]->AddEnv( ptrAccessible, objAccessible);
503 }
504
505 // add all data already set for destruction (not to be deleted now)
506 AddToDestroy( ptrAccessible, objAccessible);
507
508 // do OBJ first as the cleanup might need the GDL_PTR be valid
509 if( doObj)
510 {
511 std::vector<DObj>* heap = interpreter->GetAllObjHeapSTL();
512 Guard< std::vector<DObj> > heap_guard( heap);
513 SizeT nH = heap->size();//N_Elements();
514 if( nH > 0 && (*heap)[0] != 0)
515 {
516 for( SizeT h=0; h<nH; ++h)
517 {
518 DObj p = (*heap)[ h];
519 if( interpreter->ObjValid( p))
520 if( objAccessible.find( p) == objAccessible.end())
521 {
522 if( verbose)
523 {
524 BaseGDL* hV = GetObjHeap( p);
525 lib::help_item( cout,
526 hV, DString( "<ObjHeapVar")+
527 i2s(p)+">",
528 false);
529 }
530 ObjCleanup( p);
531 }
532 // else
533 // objAccessible.erase( p);
534 }
535 }
536 }
537 if( doPtr)
538 {
539 std::vector<DPtr>* heap = interpreter->GetAllHeapSTL();
540 Guard< std::vector<DPtr> > heap_guard( heap);
541 SizeT nH = heap->size();
542 if( nH > 0 && (*heap)[0] != 0)
543 {
544 for( SizeT h=0; h<nH; ++h)
545 {
546 DPtr p = (*heap)[ h];
547 if( interpreter->PtrValid( p))
548 if( ptrAccessible.find( p) == ptrAccessible.end())
549 {
550 if( verbose)
551 {
552 BaseGDL* hV = GetHeap( p);
553 lib::help_item( cout,
554 hV, DString( "<PtrHeapVar")+
555 i2s(p)+">",
556 false);
557 }
558 interpreter->FreeHeap( p);
559 }
560 // else
561 // ptrAccessible.erase( p);
562 }
563 }
564 }
565 }
566 catch( ...)
567 {
568 // make sure HEAP_GC stays not disabled in case of unhandled error
569 inProgress = 0;
570 throw;
571 }
572
573 if( inProgress == 2)
574 {
575 inProgress = 1;
576 goto startGC;
577 }
578 inProgress = 0;
579 }
580
581
582 set< DObj> EnvBaseT::inProgress;
583
584 class InProgressGuard
585 {
586 private:
587 DObj actID;
588 public:
InProgressGuard(DObj id)589 InProgressGuard( DObj id): actID( id)
590 {
591 EnvBaseT::inProgress.insert( actID);
592 }
~InProgressGuard()593 ~InProgressGuard()
594 {
595 EnvBaseT::inProgress.erase( actID);
596 }
597 };
598
599 // for CLEANUP calls due to reference counting
600 // note: refcount is already zero for actID
ObjCleanup(DObj actID)601 void EnvBaseT::ObjCleanup( DObj actID)
602 {
603 if( actID == 0 || (inProgress.find( actID) != inProgress.end()))
604 return;
605
606 DStructGDL* actObj;
607 try{
608 actObj=GetObjHeap( actID);
609 }
610 catch( GDLInterpreter::HeapException&){
611 // not found
612 return;
613 }
614
615 // found actID
616 if( actObj != NULL)
617 {
618 InProgressGuard inProgressGuard( actID); // exception save
619
620 Guard<BaseGDL> actObjGDL_guard;
621 try{
622 // call CLEANUP function
623 DPro* objCLEANUP= actObj->Desc()->GetPro( "CLEANUP");
624
625 if( objCLEANUP != NULL)
626 {
627 DObjGDL* actObjGDL = new DObjGDL( actID);
628 actObjGDL_guard.Init( actObjGDL);
629 GDLInterpreter::IncRefObj( actID); // set refcount to 1
630
631 PushNewEmptyEnvUD( objCLEANUP, &actObjGDL);
632
633 interpreter->call_pro( objCLEANUP->GetTree());
634
635 EnvBaseT* callStackBack = interpreter->CallStack().back();
636 interpreter->CallStack().pop_back();
637 delete callStackBack;
638 }
639 }
640 catch( ...)
641 {
642 FreeObjHeap( actID); // make sure actObj is freed
643 throw; // rethrow
644 }
645 // actObjGDL_guard goes out of scope -> refcount is (would be) decreased
646 FreeObjHeap( actID);
647 }
648 else // actObj == NULL
649 {
650 Warning("Cleaning up invalid (NULL) OBJECT ID <"+i2s(actID)+">.");
651 FreeObjHeap( actID); // make sure actObj is freed
652 }
653 }
654
655
656
ObjCleanup(DObj actID)657 void EnvT::ObjCleanup( DObj actID)
658 {
659 if( actID != 0 && (inProgress.find( actID) == inProgress.end()))
660 {
661 DStructGDL* actObj;
662 try {
663 actObj=GetObjHeap( actID);
664 // GDLInterpreter::ObjHeapT::iterator it;
665 // actObj=GDLInterpreter::GetObjHeap( actID, it);
666 }
667 catch( GDLInterpreter::HeapException) {
668 actObj=NULL;
669 }
670
671 if( actObj != NULL)
672 {
673 // call CLEANUP function
674 DPro* objCLEANUP= actObj->Desc()->GetPro( "CLEANUP");
675
676 if( objCLEANUP != NULL)
677 {
678 DObjGDL* actObjGDL = new DObjGDL( actID);
679 Guard<BaseGDL> actObjGDL_guard( actObjGDL);
680 GDLInterpreter::IncRefObj( actID);
681
682 StackGuard<EnvStackT> guard( interpreter->CallStack());
683 EnvUDT* newEnv = PushNewEnvUD( objCLEANUP, 1, &actObjGDL);
684
685 inProgress.insert( actID);
686
687 interpreter->call_pro( objCLEANUP->GetTree());
688
689 inProgress.erase( actID);
690 // delete newEnv;
691 // interpreter->CallStack().pop_back();
692 }
693
694 FreeObjHeap( actID); // the actual freeing
695 }
696 }
697 }
698
699
700
701 // these two functions should be inlined
NewObjHeap(SizeT n,DStructGDL * v)702 SizeT EnvBaseT::NewObjHeap( SizeT n, DStructGDL* v)
703 {
704 return interpreter->NewObjHeap(n,v);
705 }
NewHeap(SizeT n,BaseGDL * v)706 SizeT EnvBaseT::NewHeap( SizeT n, BaseGDL* v)
707 {
708 return interpreter->NewHeap(n,v);
709 }
FreeObjHeap(DObj id)710 void EnvBaseT::FreeObjHeap( DObj id)
711 {
712 interpreter->FreeObjHeap( id);
713 }
FreeHeap(DPtrGDL * p)714 void EnvBaseT::FreeHeap( DPtrGDL* p)
715 {
716 interpreter->FreeHeap(p);
717 }
718 // // DStructGDL* EnvT::GetObjHeap( DObj ID, ObjHeapT::iterator& it)
719 // // {
720 // // return interpreter->GetObjHeap( ID, it);
721 // // }
GetObjHeap(DObj ID)722 DStructGDL* EnvBaseT::GetObjHeap( DObj ID)
723 {
724 return interpreter->GetObjHeap( ID);
725 }
GetHeap(DPtr ID)726 BaseGDL* EnvBaseT::GetHeap( DPtr ID)
727 {
728 return interpreter->GetHeap( ID);
729 }
730
731 // returns name of BaseGDL*&
GetString(BaseGDL * & p,bool calledFromHELP)732 const string EnvBaseT::GetString( BaseGDL*& p, bool calledFromHELP)
733 {
734 DSubUD* subUD=dynamic_cast<DSubUD*>(pro);
735
736 SizeT nVar=env.size();
737 const string Default = "<Expression>";
738 string name = Default;
739 for( SizeT ix=0; ix<nVar; ix++)
740 {
741 if( (env.Env(ix) != NULL && p != NULL && *env.Env(ix) == p) ||
742 (&env[ ix] == &p) ||
743 (p != NULL && env.Loc( ix) == p)
744 )
745 {
746 if (p == NullGDL::GetSingleInstance()) std::cerr<<"NULL pointer: uncertain name"<<std::endl;
747 if( subUD != NULL) {return subUD->GetVarName(ix);}
748
749 string callerName = Default;
750 if( this->Caller() != NULL)
751 callerName = this->Caller()->GetString( p, calledFromHELP);
752
753 if( callerName.length() < Default.length() || callerName.substr(0,Default.length()) != Default)
754 return callerName;
755
756 if( ix < pro->key.size()) {name="<KEY_"+i2s(ix)+">";break;}
757 name="<PAR_"+i2s(ix - pro->key.size())+">";
758 break;
759 }
760 }
761
762 // search system variables
763 // note: system variables are never passed by reference
764 // ie. always a copy is passed.
765 // therefore the help function never returns the sys var's name here
766 // DVar* sysVar=FindInVarList( sysVarList, p);
767 // if( sysVar != NULL) return sysVar->Name();
768
769 // search common blocks
770 if (name == Default && subUD != NULL)
771 {
772 string varName;
773 if (calledFromHELP)
774 {
775 if (subUD->GetCommonVarName4Help (p, varName))
776 return varName;
777 }
778 else
779 {
780 if (subUD->GetCommonVarName (p, varName))
781 return varName;
782 }
783 }
784
785 if( !p)
786 {
787 return "<Undefined>";
788 }
789
790 if( !calledFromHELP)
791 {
792 ostringstream os;
793 os << '<' << left;
794 os.width(10);
795 os << p->TypeStr() << right;
796
797 // Data display
798 if( p->Type() == GDL_STRUCT)
799 {
800 /* DStructGDL* s = static_cast<DStructGDL*>( p);
801 os << "-> ";
802 os << (s->Desc()->IsUnnamed()? "<Anonymous>" : s->Desc()->Name());
803 os << " ";*/
804 }
805 else if( p->Dim( 0) == 0)
806 {
807 os << "(";
808 if (p->Type() == GDL_STRING)
809 {
810 // trim string larger than 45 characters
811 DString dataString = (*static_cast<DStringGDL*>(p))[0];
812 os << "'" << StrMid( dataString,0,45,0) << "'";
813 if( dataString.length() > 45) os << "...";
814 }
815 else
816 {
817 p->ToStream( os);
818 }
819 os << ")";
820 }
821
822 // Dimension display
823 if( p->Dim( 0) != 0) os << p->Dim();
824
825 os << ">";
826
827 name += " " + os.str();
828 // return os.str();
829 }
830
831 return name; //string("<Expression>");
832 }
833
834 // // returns name of BaseGDL*
835 // const string EnvBaseT::GetString( BaseGDL* p)
836 // {
837 // DSubUD* subUD=dynamic_cast<DSubUD*>(pro);
838 //
839 // SizeT nVar=env.size();
840 // for( SizeT ix=0; ix<nVar; ix++)
841 // {
842 // if( (env.Env(ix) != NULL && p != NULL && *env.Env(ix) == p) ||
843 // // (&env[ ix] == &p) ||
844 // (p != NULL && env.Loc( ix) == p)
845 // )
846 // {
847 // if( subUD != NULL) return subUD->GetVarName(ix);
848 // if( ix < pro->key.size()) return "KEYWORD_"+i2s(ix);
849 // return "PAR_VAR_"+i2s(ix - pro->key.size());
850 // }
851 // }
852 //
853 // // search system variables
854 // // note: system variables are never passed by reference
855 // // ie. always a copy is passed.
856 // // therefore the help function never returns the sys var's name here
857 // // DVar* sysVar=FindInVarList( sysVarList, p);
858 // // if( sysVar != NULL) return sysVar->Name();
859 //
860 // // search common blocks
861 // if( subUD != NULL)
862 // {
863 // string varName;
864 // if( subUD->GetCommonVarName( p, varName)) return varName;
865 // }
866 //
867 // if( !p)
868 // {
869 // return "<Undefined>";
870 // }
871 //
872 // // if( !calledFromHELP)
873 // {
874 // ostringstream os;
875 // os << '<' << left;
876 // os.width(10);
877 // os << p->TypeStr() << right;
878 //
879 // // Data display
880 // if( p->Type() == GDL_STRUCT)
881 // {
882 // DStructGDL* s = static_cast<DStructGDL*>( p);
883 // os << "-> ";
884 // os << (s->Desc()->IsUnnamed()? "<Anonymous>" : s->Desc()->Name());
885 // os << " ";
886 // }
887 // else if( p->Dim( 0) == 0)
888 // {
889 // os << "(";
890 // if (p->Type() == GDL_STRING)
891 // {
892 // // trim string larger than 45 characters
893 // DString dataString = (*static_cast<DStringGDL*>(p))[0];
894 // os << "'" << StrMid( dataString,0,45,0) << "'";
895 // if( dataString.length() > 45) os << "...";
896 // }
897 // else
898 // {
899 // p->ToStream( os);
900 // }
901 // os << ")";
902 // }
903 //
904 // // Dimension display
905 // if( p->Dim( 0) != 0) os << p->Dim();
906 //
907 // os << ">";
908 //
909 // return os.str();
910 // }
911 //
912 // return string("<Expression>");
913 // }
914
915
Help(const std::string s_help[],int size_of_s)916 void EnvT::Help(const std::string s_help[], int size_of_s)
917 {
918 if (size_of_s == 0)
919 throw GDLException( CallingNode(), pro->ObjectName()+": no inline doc ready");
920 else {
921 int i;
922 for (i = 0; i < size_of_s; i++)
923 Message(pro->ObjectName()+": "+s_help[i]);
924 throw GDLException( CallingNode(), pro->ObjectName()+": call to inline help");
925 }
926 }
927 //TODO: variant enabling static ints in lieu of const string& (speedup!)
SetKeyword(const string & k,BaseGDL * const val)928 void EnvBaseT::SetKeyword( const string& k, BaseGDL* const val) // value
929 {
930 int varIx=GetKeywordIx( k);
931
932 // -4 means ignore (warn keyword)
933 if( varIx == -4) return;
934
935 // -2 means _EXTRA keyword
936 // -3 means _STRICT_EXTRA keyword
937 if( varIx <= -2)
938 {
939 if( extra == NULL) extra = new ExtraT( this);
940 extra->Set(val);
941 extra->SetStrict( varIx == -3);
942 return;
943 }
944
945 // -1 means an extra (additional) keyword
946 if( varIx == -1)
947 {
948 if( extra == NULL) extra = new ExtraT( this);
949 extra->Add(k,val);
950 return;
951 }
952
953 env.Set( varIx,val);
954 }
955 //TODO: variant enabling static ints in lieu of const string& (speedup!)
956
SetKeyword(const string & k,BaseGDL ** const val)957 void EnvBaseT::SetKeyword( const string& k, BaseGDL** const val) // reference
958 {
959 int varIx=GetKeywordIx( k);
960
961 // -4 means ignore (warn keyword)
962 if( varIx == -4) return;
963
964 // -2 means _EXTRA keyword
965 // -3 means _STRICT_EXTRA keyword
966 if( varIx <= -2)
967 {
968 if( extra == NULL) extra = new ExtraT( this);
969 extra->Set(val);
970 extra->SetStrict( varIx == -3);
971 return;
972 }
973
974 // -1 means an extra (additional) keyword
975 if( varIx == -1)
976 {
977 if( extra == NULL) extra = new ExtraT( this);
978 extra->Add(k,val);
979 return;
980 }
981
982 env.Set( varIx,val);
983 }
984
985 // called after parameter definition
ResolveExtra()986 void EnvBaseT::ResolveExtra()
987 {
988 if( extra != NULL) extra->ResolveExtra( NULL);
989 }
990
991 // // for internal non-library routines (e.g. operator overloads) ('this' is on the stack)
992 // EnvUDT* EnvUDT::CallingEnv()
993 // {
994 // EnvStackT& callStack=interpreter->CallStack();
995 // assert( callStack.size() >= 2); // must be: "$MAIN$" and the EnvUDT of the internal routine
996 // return callStack[callStack.size()-2];
997 // }
998
999 // for library subroutines, get the EnvUDT from which they are called
Caller()1000 EnvBaseT* EnvBaseT::Caller()
1001 {
1002 EnvStackT& callStack=interpreter->CallStack();
1003
1004 //if( callStack.size() <= 1) return NULL;
1005 // library environments are no longer on the call stack
1006 // but since we have WRAPPED_FUNNode it is convenient
1007 // assert( callStack.back() != this);
1008 if( callStack.back() == this)
1009 {
1010 assert( callStack.size() >= 2);
1011 return callStack[ callStack.size() - 2];
1012 }
1013
1014 return callStack.back();
1015
1016 // if( callStack.back() != this)
1017 // return callStack.back();
1018 // // return static_cast< EnvUDT*>( callStack.back());
1019 //
1020 // return callStack[ callStack.size()-2];
1021 // // return static_cast< EnvUDT*>( callStack[ callStack.size()-2]);
1022 }
1023
1024 // used by obj_new (basic_fun.cpp)
1025 // and obj_destroy (basic_pro.cpp)
PushNewEmptyEnvUD(DSubUD * newPro,DObjGDL ** newObj)1026 void EnvBaseT::PushNewEmptyEnvUD( DSubUD* newPro, DObjGDL** newObj)
1027 {
1028 EnvUDT* newEnv= new EnvUDT( this->CallingNode(), newPro, newObj);
1029
1030 // pass the parameters, skip the first 'skipP'
1031 // SizeT nParam = NParam();
1032 // for( SizeT p=skipP; p<nParam; p++)
1033 // {
1034 // newEnv->SetNextPar( &GetPar( p)); // pass as global
1035 // }
1036
1037 interpreter->CallStack().push_back( newEnv);
1038
1039 // _REF_EXTRA is set to the keyword string array
1040 // newEnv->extra = new ExtraT( newEnv);
1041 // newEnv->extra->Set( &env[0]);
1042 // newEnv->extra->Resolve();
1043 }
1044
1045 // used by obj_new (basic_fun.cpp)
1046 // and obj_destroy (basic_pro.cpp)
1047 // and call_function (basic_fun.cpp)
1048 // and call_procedure (basic_pro.cpp)
PushNewEnvUD(DSubUD * newPro,SizeT skipP,DObjGDL ** newObj)1049 EnvUDT* EnvT::PushNewEnvUD( DSubUD* newPro, SizeT skipP, DObjGDL** newObj)
1050 {
1051 EnvUDT* newEnv= new EnvUDT( this->CallingNode(), newPro, newObj);
1052
1053 // pass the parameters, skip the first 'skipP'
1054 SizeT nParam = NParam();
1055 for( SizeT p=skipP; p<nParam; p++)
1056 {
1057 newEnv->SetNextPar( &GetPar( p)); // pass as global
1058 }
1059
1060 // interpreter->CallStack().push_back( newEnv); // problem with call_function if done here s. b.
1061
1062 // _REF_EXTRA is set to the keyword string array
1063 newEnv->extra = new ExtraT( newEnv);
1064 newEnv->extra->Set( &env[0]);
1065 newEnv->extra->ResolveExtra( this); // s. a. problem caused here due to a call to EnvBaseT::Caller() in Resolve()
1066
1067 interpreter->CallStack().push_back( newEnv);
1068 return newEnv;
1069 }
1070 // used by obj_new (basic_fun.cpp)
1071 // and obj_destroy (basic_pro.cpp)
1072 // and call_function (basic_fun.cpp)
1073 // and call_procedure (basic_pro.cpp)
NewEnv(DSub * newPro,SizeT skipP,DObjGDL ** newObj)1074 EnvT* EnvT::NewEnv( DSub* newPro, SizeT skipP, DObjGDL** newObj)
1075 {
1076 EnvT* newEnv= new EnvT( this, newPro, newObj);
1077
1078 // pass the parameters, skip the first 'skipP'
1079 SizeT nParam = NParam();
1080 for( SizeT p=skipP; p<nParam; p++)
1081 {
1082 newEnv->SetNextPar( &GetPar( p)); // pass as global
1083 }
1084
1085 // interpreter->CallStack().push_back( newEnv);
1086
1087 // _REF_EXTRA is set to the keyword string array
1088 newEnv->extra = new ExtraT( newEnv);
1089 newEnv->extra->Set( &env[0]);
1090 newEnv->extra->ResolveExtra( this);
1091
1092 return newEnv;
1093 }
1094
AssureGlobalPar(SizeT pIx)1095 void EnvT::AssureGlobalPar( SizeT pIx)
1096 {
1097 SizeT ix= pIx + pro->key.size();
1098 AssureGlobalKW( ix);
1099 }
1100
AssureGlobalKW(SizeT ix)1101 void EnvBaseT::AssureGlobalKW( SizeT ix)
1102 {
1103 if( env.Env( ix) == NULL) {
1104 if( env.Loc( ix) != NULL)
1105 Throw( "Attempt to store into an expression.");
1106 else
1107 Throw( "Parameter must be a named variable.");
1108 }
1109 }
1110
GetObjectPar(SizeT pIx)1111 DStructGDL* EnvT::GetObjectPar( SizeT pIx)
1112 {
1113 BaseGDL* p1 = GetParDefined(pIx);
1114
1115 if( p1->Type() != GDL_OBJ)
1116 {
1117 Throw( "Parameter must be an object reference"
1118 " in this context: "+
1119 GetParString(pIx));
1120 }
1121 else
1122 {
1123 DObjGDL* oRef = static_cast<DObjGDL*> (p1);
1124 DObj objIx;
1125 if (!oRef->Scalar(objIx))
1126 Throw("Parameter must be a scalar or 1 element array in this context: " +
1127 GetParString(pIx));
1128 if (objIx == 0)
1129 Throw("Unable to invoke method"
1130 " on NULL object reference: " + GetParString(pIx));
1131
1132 try {
1133 return GetObjHeap(objIx);
1134 }
1135 catch ( GDLInterpreter::HeapException)
1136 {
1137 Throw("Object not valid: " + GetParString(pIx));
1138 }
1139 }
1140 return NULL; //keep clang happy.
1141 }
1142
1143 // for exclusive use by lib::catch_pro
Catch()1144 void EnvT::Catch()
1145 {
1146 EnvUDT* caller = static_cast<EnvUDT*>(Caller());
1147 if( caller == NULL) return;
1148 SizeT nParam = NParam();
1149 if( nParam == 0)
1150 {
1151 if( KeywordSet( 0)) // CANCEL
1152 {
1153 caller->catchVar = NULL;
1154 caller->catchNode = NULL;
1155 }
1156 return;
1157 }
1158 if( !GlobalPar( 0))
1159 Throw( "Expression must be named variable "
1160 "in this context: " + GetParString(0));
1161 caller->catchNode = callingNode->getNextSibling();
1162 caller->catchVar = &GetPar( 0);
1163 GDLDelete(*caller->catchVar);
1164 *caller->catchVar = new DLongGDL( 0);
1165 }
1166
1167 // for exclusive use by lib::on_error
OnError()1168 void EnvT::OnError()
1169 {
1170 SizeT nParam = NParam();
1171 DLong onE = 0;
1172 if( nParam > 0)
1173 AssureLongScalarPar( 0, onE);
1174 if( onE < 0 || onE > 3)
1175 Throw( "Value out of allowed range: " + GetParString(0));
1176 EnvUDT* caller = static_cast<EnvUDT*>(Caller());
1177 if( caller == NULL) return;
1178 caller->onError = onE;
1179 }
1180
KeywordIx(const std::string & k)1181 int EnvT::KeywordIx( const std::string& k)
1182 {
1183 // cout << pro->ObjectName() << " Key: " << k << endl;
1184 assert( pro != NULL);
1185 int val=pro->FindKey( k);
1186 if( val == -1) { // assert( val != -1);
1187
1188 cout << "Invalid Keyword lookup (EnvT::KeywordIx) ! "
1189 " from "+pro->ObjectName() + " Key: " + k << endl;
1190 // cout << pro->ObjectName() << " Key: " << k << endl;
1191 // << " Returning the wrong (but a valid) key index of zero" << endl;
1192 // val = 0; // too lax - may allow most tests to pass
1193 assert( val != -1);
1194 }
1195 return val;
1196 }
1197
KeywordPresent(const std::string & kw)1198 bool EnvT::KeywordPresent( const std::string& kw)
1199 {
1200 int ix = KeywordIx( kw);
1201 return EnvBaseT::KeywordPresent( ix);
1202 }
1203
GetString(SizeT ix)1204 const string EnvBaseT::GetString( SizeT ix)
1205 {
1206 const string unnamed("<INTERNAL_VAR>");
1207 DSubUD* subUD=dynamic_cast<DSubUD*>(pro);
1208 if( subUD == NULL)
1209 { // internal subroutine
1210 DLib* subLib=dynamic_cast<DLib*>(pro);
1211 if( subLib != NULL)
1212 {
1213 EnvBaseT* caller = Caller();
1214 if( caller != NULL) return caller->GetString( env[ ix]);
1215 }
1216 return unnamed;
1217 }
1218 // UD subroutine
1219 return subUD->GetVarName( ix);
1220 }
1221
1222 // SA: used by GDL_STRING() for VMS-compat hack
ShiftParNumbering(int n)1223 void EnvT::ShiftParNumbering(int n)
1224 {
1225 assert(abs(n) == 1); // currently the code below works for n = +/- 1 only
1226
1227 SizeT nParam = NParam();
1228 SizeT oParam = pro->key.size();
1229
1230 if (n == 1)
1231 {
1232 BaseGDL* tmp = env[oParam + nParam - 1];
1233 for (int i = nParam - 1; i > 0; --i)
1234 {
1235 env[oParam + i] = env[oParam + i - 1];
1236 }
1237 env[oParam] = tmp;
1238 }
1239 else if (n == -1)
1240 {
1241 BaseGDL* tmp = env[oParam];
1242 for (int i = 0; i < nParam - 1; ++i)
1243 {
1244 env[oParam + i] = env[oParam + i + 1];
1245 }
1246 env[oParam + nParam - 1] = tmp;
1247 }
1248 }
1249
GetParDefined(SizeT i)1250 BaseGDL*& EnvBaseT::GetParDefined(SizeT i)
1251 {
1252 SizeT ix = i + pro->key.size();
1253
1254 // cout << i << " -> " << ix << " " << env.size() << " env[ix] " << env[ix] << endl;
1255 if( ix >= env.size())
1256 Throw("Incorrect number of arguments.");
1257 if( env[ ix] == NULL || env[ ix] == NullGDL::GetSingleInstance())
1258 Throw("Variable is undefined: "+GetString( ix));
1259 return env[ ix];
1260 }
GetParDefined(SizeT i)1261 BaseGDL*& EnvT::GetParDefined(SizeT i)
1262 {
1263 return EnvBaseT::GetParDefined( i);
1264 }
1265
GetParGlobal(SizeT pIx)1266 BaseGDL*& EnvT::GetParGlobal(SizeT pIx)
1267 {
1268 AssureGlobalPar( pIx);
1269 return GetPar( pIx);
1270 }
1271
1272 // get i'th parameter, subName is used for error reporting
1273 // throws if not present (ie. not global)
1274 // paramter might be NULL (but ¶mter is a valid BaseGDL** to store into)
1275 // BaseGDL*& EnvT::GetParPresent(SizeT i, const std::string& subName = "")
1276 // {
1277 // SizeT ix = i + pro->key.size();
1278 // if( ix >= env.size() || env.Env( ix) == NULL)
1279 // if( subName != "")
1280 // throw GDLException( callingNode, subName+": Paramter must be a "
1281 // "named variable in this context: "+
1282 // GetString( ix));
1283 // else
1284 // throw GDLException( callingNode, "Paramter must be a "
1285 // "named variable in this context: "+
1286 // GetString( ix));
1287 // return env[ ix];
1288 // }
1289
NParam(SizeT minPar)1290 SizeT EnvBaseT::NParam( SizeT minPar)
1291 {
1292 assert( pro != NULL);
1293
1294 SizeT nPar = parIx - pro->key.size();
1295
1296 if( nPar < minPar)
1297 Throw( "Incorrect number of arguments.");
1298 return nPar;
1299 }
NParam(SizeT minPar)1300 SizeT EnvT::NParam( SizeT minPar)
1301 {
1302 return EnvBaseT::NParam( minPar);
1303 }
1304
Removeall()1305 bool EnvBaseT::Removeall()
1306 {
1307 DSubUD* proD=dynamic_cast<DSubUD*>(pro);
1308 int osz = env.size();
1309 for( ssize_t ix=osz-1; ix >= 0; ix--) {
1310 if( env[ix] != NULL) GDLDelete( env[ix]);
1311 env.pop_back();
1312 }
1313 proD->Resize(0);
1314 return true;
1315 }
1316
Remove(int * rindx)1317 bool EnvBaseT::Remove(int* rindx)
1318 {
1319 DSubUD* proD=dynamic_cast<DSubUD*>(pro);
1320
1321 static volatile bool debug( false); // switch off/on
1322 static int ix, osz, inrem;
1323
1324 osz = env.size();
1325 inrem = 0;
1326 int itrg = rindx[0];
1327 ix=itrg;
1328 if(debug) printf(" env.size() = %d", osz);
1329 while( ix >= 0)
1330 {
1331 inrem++;
1332 if(debug) printf(" env.now.size() = %d env[%d] = %p ",
1333 osz - inrem,
1334 ix,static_cast <const void *>(env[ix]) );
1335 if ( env[ix] != NULL) GDLDelete( env[ix]);
1336 int esrc = rindx[inrem];
1337 if(esrc < 0) esrc = osz;
1338 if(debug) cout << " limit:"<< esrc ;
1339 while( ++ix < esrc) {
1340 if(debug) cout << ", @:"<<itrg<<"<"<<ix;
1341 env.Set( itrg, env.Loc(ix));
1342 proD->ReName(itrg++, proD->GetVarName(ix));
1343 }
1344 ix=rindx[inrem];
1345 if(debug) cout << " inrem:"<<inrem <<" ix:" << ix << endl;
1346 } // zero all with GDLDelete
1347 if(inrem <= 0) return false;
1348
1349 osz = osz - inrem;
1350 while(inrem-- > 0) env.pop_back();
1351
1352 env.resize(osz);
1353 proD->Resize(osz);
1354 return true;
1355 }
1356
findvar(const std::string & s)1357 int EnvBaseT::findvar(const std::string& s)
1358 {
1359 DSubUD* proD=dynamic_cast<DSubUD*>(pro);
1360 int kIx = proD->FindVar(s);
1361 return kIx;
1362 }
1363
findvar(BaseGDL * delP)1364 int EnvBaseT::findvar(BaseGDL* delP)
1365 {
1366 // static BaseGDL* null=NULL;
1367 for(int Ix=0; Ix < env.size(); Ix++) {
1368 if(delP != env[ Ix] ) continue;
1369 return Ix;
1370 }
1371 return -1;
1372 }
1373
KeywordPresent(SizeT ix)1374 bool EnvBaseT::KeywordPresent( SizeT ix)
1375 { return (env.Loc(ix)!=NULL)||(env.Env(ix)!=NULL);}
1376
1377
1378 // AC 2021/09/19 : keyword might be present but undefined :
1379 // !null or an un-affected variable. In both cases KW shall not be used.
KeywordPresentAndDefined(SizeT ix)1380 bool EnvBaseT::KeywordPresentAndDefined( SizeT ix)
1381 {
1382 // if KW is not present
1383 if (!( (env.Loc(ix)!=NULL)||(env.Env(ix)!=NULL)))
1384 return false;
1385 else {
1386 BaseGDL* p = GetKW(ix);
1387 if( p == NULL) return false;
1388 if ( p->Type() == GDL_UNDEF) return false; else return true;
1389 }
1390 }
1391
SetNextParUnchecked(BaseGDL * const nextP)1392 void EnvBaseT::SetNextParUnchecked( BaseGDL* const nextP) // by value (reset loc)
1393 {
1394 if(!( static_cast<int>(parIx - pro->key.size()) < pro->nPar)){
1395 throw GDLException(callingNode,
1396 pro->Name()+": Incorrect number of arguments.",false,false);
1397 }
1398 env.Set(parIx++,nextP); // check done in parameter_def
1399 }
SetNextParUncheckedVarNum(BaseGDL * const nextP)1400 void EnvBaseT::SetNextParUncheckedVarNum( BaseGDL* const nextP) // by reference (reset env)
1401 {
1402 AddEnv();
1403 env.Set(parIx++,nextP);
1404 }
1405
SetNextParUnchecked(BaseGDL ** const nextP)1406 void EnvBaseT::SetNextParUnchecked( BaseGDL** const nextP) // by reference (reset env)
1407 {
1408 if(!( static_cast<int>(parIx - pro->key.size()) < pro->nPar)){
1409 throw GDLException(callingNode,
1410 pro->Name()+": Incorrect number of arguments.",false,false);
1411 }
1412 env.Set(parIx++,nextP);
1413 }
SetNextParUncheckedVarNum(BaseGDL ** const nextP)1414 void EnvBaseT::SetNextParUncheckedVarNum( BaseGDL** const nextP) // by reference (reset env)
1415 {
1416 AddEnv();
1417 env.Set(parIx++,nextP);
1418 }
1419
SetNextPar(BaseGDL * const nextP)1420 void EnvBaseT::SetNextPar( BaseGDL* const nextP) // by value (reset loc)
1421 {
1422 if( pro->nPar >= 0)
1423 {
1424 if( static_cast<int>(parIx - pro->key.size()) >= pro->nPar)
1425 {
1426 throw GDLException(callingNode,
1427 pro->Name()+": Incorrect number of arguments.",false,false);
1428 }
1429 }
1430 else
1431 { // variable number of parameters (only lib functions)
1432 AddEnv();
1433 }
1434 env.Set(parIx++,nextP);
1435 }
SetNextPar(BaseGDL ** const nextP)1436 void EnvBaseT::SetNextPar( BaseGDL** const nextP) // by reference (reset env)
1437 {
1438 if( pro->nPar >= 0)
1439 {
1440 if( static_cast<int>(parIx - pro->key.size()) >= pro->nPar)
1441 {
1442 throw GDLException(callingNode,
1443 pro->Name()+": Incorrect number of arguments.",false,false);
1444 }
1445 }
1446 else
1447 { // variable number of parameters (only lib functions)
1448 AddEnv();
1449 }
1450 env.Set(parIx++,nextP);
1451 }
1452
1453
1454
1455 // returns the keyword index, used for UD functions
GetKeywordIx(const std::string & k)1456 int EnvBaseT::GetKeywordIx( const std::string& k)
1457 {
1458 String_abbref_eq strAbbrefEq_k(k);
1459
1460 // if there are no keywords, even _EXTRA isn't allowed
1461 if( pro->key.size() == 0)
1462 {
1463 if( pro->warnKey.size() == 0)
1464 Throw( "Keyword parameters not allowed in call.");
1465
1466 // look if warnKeyword
1467 IDList::iterator wf=std::find_if(pro->warnKey.begin(),
1468 pro->warnKey.end(),
1469 strAbbrefEq_k);
1470 if( wf == pro->warnKey.end())
1471 Throw( "Keyword parameter -"+k+"- not allowed in call "
1472 "to: "+pro->Name());
1473 // throw GDLException(callingNode,
1474 // "Keyword parameter "+k+" not allowed in call "
1475 // "to: "+pro->Name());
1476
1477 Warning("Warning: Keyword parameter "+k+" not supported in call "
1478 "to: "+pro->Name() + ". Ignored.");
1479
1480 return -4;
1481 }
1482
1483 // search keyword
1484 KeyVarListT::iterator f=std::find_if(pro->key.begin(),
1485 pro->key.end(),
1486 strAbbrefEq_k);
1487 if( f == pro->key.end())
1488 {
1489 // every routine (which accepts keywords), also accepts (_STRICT)_EXTRA
1490 if( strAbbrefEq_k("_EXTRA")) return -2;
1491 if( strAbbrefEq_k("_STRICT_EXTRA")) return -3;
1492
1493 if( pro->Extra() == DSub::NONE)
1494 {
1495 // look if warnKeyword
1496 IDList::iterator wf=std::find_if(pro->warnKey.begin(),
1497 pro->warnKey.end(),
1498 strAbbrefEq_k);
1499 if( wf == pro->warnKey.end())
1500 Throw( "Keyword parameter <"+k+"> not allowed in call "
1501 "to: "+pro->Name());
1502 /* throw GDLException(callingNode,
1503 "Keyword parameter "+k+" not allowed in call "
1504 "to: "+pro->Name());*/
1505
1506 Warning("Warning: Keyword parameter "+k+" not supported in call "
1507 "to: "+pro->Name() + ". Ignored.");
1508
1509 return -4;
1510 }
1511
1512 // extra keyword
1513 return -1;
1514 }
1515 // continue search (for ambiguity)
1516 KeyVarListT::iterator ff=std::find_if(f+1,
1517 pro->key.end(),
1518 strAbbrefEq_k);
1519 if( ff != pro->key.end())
1520 {
1521 Throw("Ambiguous keyword abbreviation: "+k);
1522 }
1523
1524 // every routine (which accepts keywords), also accepts (_STRICT)_EXTRA
1525 if( strAbbrefEq_k("_EXTRA")) return -2;
1526 if( strAbbrefEq_k("_STRICT_EXTRA")) return -3;
1527
1528 SizeT varIx=std::distance(pro->key.begin(),f);
1529
1530 // already set? -> Warning
1531 // (move to Throw by AC on June 25, 2014, bug found by Levan.)
1532 // Removed G. Jung 2016:
1533 // mungs things up. Could not determine 2014 bug.
1534 // if( KeywordPresent(varIx)) // just a message in the original
1535 // {
1536 // Throw( "Duplicate keyword "+k+" in call to: "+pro->Name());
1537 // }
1538
1539 return varIx;
1540 }
1541
1542 // for use within library functions
KeywordSet(const std::string & kw)1543 bool EnvT::KeywordSet( const std::string& kw)
1544 {
1545 assert( pro != NULL);
1546
1547 int ix=pro->FindKey( kw);
1548 if( ix == -1) return false;
1549 return KeywordSet( static_cast<SizeT>(ix));
1550 }
1551
KeywordSet(SizeT ix)1552 bool EnvT::KeywordSet( SizeT ix)
1553 {
1554 return EnvBaseT::KeywordSet( ix);
1555 }
KeywordSet(SizeT ix)1556 bool EnvBaseT::KeywordSet( SizeT ix)
1557 {
1558 BaseGDL* keyword=env[ix];
1559 if( keyword == NULL) return false;
1560 if( !keyword->Scalar()) return true; //IDL would Throw("Expression must be a scalar or 1 element array in this context.");
1561 if( keyword->Type() == GDL_STRUCT) return true; //IDL would Throw("Unable to convert variable from type struct.");
1562 return keyword->LogTrue();
1563 }
1564 //this version is for testing boolean KWs when the default is 'set' = true when they are not defined/present etc (see code)
BooleanKeywordAbsentOrSet(SizeT ix)1565 bool EnvBaseT::BooleanKeywordAbsentOrSet( SizeT ix)
1566 {
1567 BaseGDL* keyword=env[ix];
1568 if( keyword == NULL) return true;
1569 if( !keyword->Scalar()) return true; // Throw("Expression must be a scalar or 1 element array in this context.");
1570 if( keyword->Type() == GDL_STRUCT) return true; // Throw("Unable to convert variable from type struct.");
1571 return keyword->LogTrue();
1572 }
1573 // returns the ix'th parameter (for library function API only)
GetPar(SizeT i)1574 BaseGDL*& EnvT::GetPar(SizeT i)
1575 {
1576 static BaseGDL* null=NULL;
1577 SizeT ix= i + pro->key.size();
1578 if( ix >= env.size())
1579 {
1580 // Warning( "EnvT::GetPar(): Index out of env size ("+i2s(env.size())+"): " + i2s(i) +" (+ "+i2s(pro->key.size())+" KW)");
1581 return null;
1582 }
1583 return env[ ix];
1584 }
1585 // BaseGDL*& EnvT::GetParUnchecked(SizeT i)
1586 // {
1587 // SizeT ix= i + pro->key.size();
1588 // return env[ ix];
1589 // }
1590
AssureLongScalarPar(SizeT pIx,DLong64 & scalar)1591 void EnvBaseT::AssureLongScalarPar( SizeT pIx, DLong64& scalar)
1592 {
1593 BaseGDL* p = GetParDefined( pIx);
1594 DLong64GDL* lp = static_cast<DLong64GDL*>(p->Convert2( GDL_LONG64, BaseGDL::COPY));
1595 Guard<DLong64GDL> guard_lp( lp);
1596 if( !lp->Scalar( scalar))
1597 Throw("Parameter must be a scalar or 1 element array in this context: "+
1598 GetParString(pIx));
1599 }
AssureLongScalarPar(SizeT pIx,DLong & scalar)1600 void EnvBaseT::AssureLongScalarPar( SizeT pIx, DLong& scalar)
1601 {
1602 BaseGDL* p = GetParDefined( pIx);
1603 DLongGDL* lp = static_cast<DLongGDL*>(p->Convert2( GDL_LONG, BaseGDL::COPY));
1604 Guard<DLongGDL> guard_lp( lp);
1605 if( !lp->Scalar( scalar))
1606 Throw("Parameter must be a scalar or 1 element array in this context: "+
1607 GetParString(pIx));
1608 }
AssureLongScalarPar(SizeT pIx,DLong64 & scalar)1609 void EnvT::AssureLongScalarPar( SizeT pIx, DLong64& scalar)
1610 {
1611 EnvBaseT::AssureLongScalarPar( pIx, scalar);
1612 }
AssureLongScalarPar(SizeT pIx,DLong & scalar)1613 void EnvT::AssureLongScalarPar( SizeT pIx, DLong& scalar)
1614 {
1615 EnvBaseT::AssureLongScalarPar( pIx, scalar);
1616 }
1617 // if keyword 'kw' is not set, 'scalar' is left unchanged
AssureLongScalarKWIfPresent(const std::string & kw,DLong & scalar)1618 void EnvT::AssureLongScalarKWIfPresent( const std::string& kw, DLong& scalar)
1619 {
1620 int ix = KeywordIx( kw);
1621 if( env[ix] == NULL) return;
1622 // if( !KeywordPresent( ix)) return;
1623 AssureLongScalarKW( ix, scalar);
1624 }
AssureLongScalarKWIfPresent(SizeT ix,DLong & scalar)1625 void EnvT::AssureLongScalarKWIfPresent( SizeT ix, DLong& scalar)
1626 {
1627 if( env[ix] == NULL) return;
1628 // if( !KeywordPresent( ix)) return;
1629 AssureLongScalarKW( ix, scalar);
1630 }
1631 // converts keyword 'kw' if necessary and sets 'scalar'
AssureLongScalarKW(const std::string & kw,DLong & scalar)1632 void EnvT::AssureLongScalarKW( const std::string& kw, DLong& scalar)
1633 {
1634 AssureLongScalarKW( KeywordIx( kw), scalar);
1635 }
AssureLongScalarKW(const std::string & kw,DLong64 & scalar)1636 void EnvT::AssureLongScalarKW( const std::string& kw, DLong64& scalar)
1637 {
1638 AssureLongScalarKW( KeywordIx( kw), scalar);
1639 }
1640
AssureLongScalarKW(SizeT eIx,DLong64 & scalar)1641 void EnvT::AssureLongScalarKW( SizeT eIx, DLong64& scalar)
1642 {
1643 BaseGDL* p = GetKW( eIx);
1644
1645 if( p == NULL)
1646 Throw("Expression undefined: "+GetString(eIx));
1647
1648 DLong64GDL* lp= static_cast<DLong64GDL*>(p->Convert2( GDL_LONG64, BaseGDL::COPY));
1649
1650 Guard<DLong64GDL> guard_lp( lp);
1651
1652 if( !lp->Scalar( scalar))
1653 Throw("Expression must be a scalar or 1 element array in this context: "+
1654 GetString(eIx));
1655 }
AssureLongScalarKW(SizeT eIx,DLong & scalar)1656 void EnvT::AssureLongScalarKW( SizeT eIx, DLong& scalar)
1657 {
1658 BaseGDL* p = GetKW( eIx);
1659
1660 if( p == NULL)
1661 Throw("Expression undefined: "+GetString(eIx));
1662
1663 DLongGDL* lp= static_cast<DLongGDL*>(p->Convert2( GDL_LONG, BaseGDL::COPY));
1664
1665 Guard<DLongGDL> guard_lp( lp);
1666
1667 if( !lp->Scalar( scalar))
1668 Throw("Expression must be a scalar or 1 element array in this context: "+
1669 GetString(eIx));
1670 }
1671
AssureDoubleScalarPar(SizeT pIx,DDouble & scalar)1672 void EnvT::AssureDoubleScalarPar( SizeT pIx, DDouble& scalar)
1673 {
1674 BaseGDL* p = GetParDefined( pIx);
1675 DDoubleGDL* lp = static_cast<DDoubleGDL*>(p->Convert2( GDL_DOUBLE, BaseGDL::COPY));
1676 Guard<DDoubleGDL> guard_lp( lp);
1677 if( !lp->Scalar( scalar))
1678 Throw("Parameter must be a scalar or 1 element array in this context: "+
1679 GetParString(pIx));
1680 }
AssureDoubleScalarKWIfPresent(const std::string & kw,DDouble & scalar)1681 void EnvT::AssureDoubleScalarKWIfPresent( const std::string& kw, DDouble& scalar)
1682 {
1683 int ix = KeywordIx( kw);
1684 if( env[ix] == NULL) return;
1685 // if( !KeywordPresent( ix)) return;
1686 AssureDoubleScalarKW( ix, scalar);
1687 }
AssureDoubleScalarKWIfPresent(SizeT ix,DDouble & scalar)1688 void EnvT::AssureDoubleScalarKWIfPresent( SizeT ix, DDouble& scalar)
1689 {
1690 if( env[ix] == NULL) return;
1691 // if( !KeywordPresent( ix)) return;
1692 AssureDoubleScalarKW( ix, scalar);
1693 }
AssureDoubleScalarKW(const std::string & kw,DDouble & scalar)1694 void EnvT::AssureDoubleScalarKW( const std::string& kw, DDouble& scalar)
1695 {
1696 AssureDoubleScalarKW( KeywordIx( kw), scalar);
1697 }
AssureDoubleScalarKW(SizeT eIx,DDouble & scalar)1698 void EnvT::AssureDoubleScalarKW( SizeT eIx, DDouble& scalar)
1699 {
1700 BaseGDL* p = GetKW( eIx);
1701
1702 if( p == NULL)
1703 Throw("Expression undefined: "+GetString(eIx));
1704
1705 DDoubleGDL* lp= static_cast<DDoubleGDL*>(p->Convert2( GDL_DOUBLE, BaseGDL::COPY));
1706
1707 Guard<DDoubleGDL> guard_lp( lp);
1708
1709 if( !lp->Scalar( scalar))
1710 Throw("Expression must be a scalar or 1 element array in this context: "+
1711 GetString(eIx));
1712 }
1713
1714
AssureFloatScalarPar(SizeT pIx,DFloat & scalar)1715 void EnvT::AssureFloatScalarPar( SizeT pIx, DFloat& scalar)
1716 {
1717 BaseGDL* p = GetParDefined( pIx);
1718 DFloatGDL* lp = static_cast<DFloatGDL*>(p->Convert2( GDL_FLOAT, BaseGDL::COPY));
1719 Guard<DFloatGDL> guard_lp( lp);
1720 if( !lp->Scalar( scalar))
1721 Throw("Parameter must be a scalar or 1 element array in this context: "+
1722 GetParString(pIx));
1723 }
AssureFloatScalarKWIfPresent(const std::string & kw,DFloat & scalar)1724 void EnvT::AssureFloatScalarKWIfPresent( const std::string& kw, DFloat& scalar)
1725 {
1726 int ix = KeywordIx( kw);
1727 if( env[ix] == NULL) return;
1728 // if( !KeywordPresent( ix)) return;
1729 AssureFloatScalarKW( ix, scalar);
1730 }
AssureFloatScalarKWIfPresent(SizeT ix,DFloat & scalar)1731 void EnvT::AssureFloatScalarKWIfPresent( SizeT ix, DFloat& scalar)
1732 {
1733 if( env[ix] == NULL) return;
1734 // if( !KeywordPresent( ix)) return;
1735 AssureFloatScalarKW( ix, scalar);
1736 }
AssureFloatScalarKW(const std::string & kw,DFloat & scalar)1737 void EnvT::AssureFloatScalarKW( const std::string& kw, DFloat& scalar)
1738 {
1739 AssureFloatScalarKW( KeywordIx( kw), scalar);
1740 }
AssureFloatScalarKW(SizeT eIx,DFloat & scalar)1741 void EnvT::AssureFloatScalarKW( SizeT eIx, DFloat& scalar)
1742 {
1743 BaseGDL* p = GetKW( eIx);
1744
1745 if( p == NULL)
1746 Throw("Expression undefined: "+GetString(eIx));
1747
1748 DFloatGDL* lp= static_cast<DFloatGDL*>(p->Convert2( GDL_FLOAT, BaseGDL::COPY));
1749
1750 Guard<DFloatGDL> guard_lp( lp);
1751
1752 if( !lp->Scalar( scalar))
1753 Throw("Expression must be a scalar or 1 element array in this context: "+
1754 GetString(eIx));
1755 }
1756
1757
AssureStringScalarPar(SizeT pIx,DString & scalar)1758 void EnvT::AssureStringScalarPar( SizeT pIx, DString& scalar)
1759 {
1760 BaseGDL* p = GetParDefined( pIx);
1761 DStringGDL* lp = static_cast<DStringGDL*>(p->Convert2( GDL_STRING, BaseGDL::COPY));
1762 Guard<DStringGDL> guard_lp( lp);
1763 if( !lp->Scalar( scalar))
1764 Throw("Parameter must be a scalar or 1 element array in this context: "+
1765 GetParString(pIx));
1766 }
AssureStringScalarKWIfPresent(const std::string & kw,DString & scalar)1767 void EnvT::AssureStringScalarKWIfPresent( const std::string& kw, DString& scalar)
1768 {
1769 int ix = KeywordIx( kw);
1770 if( env[ix] == NULL) return;
1771 // if( !KeywordPresent( ix)) return;
1772 AssureStringScalarKW( ix, scalar);
1773 }
AssureStringScalarKWIfPresent(SizeT ix,DString & scalar)1774 void EnvT::AssureStringScalarKWIfPresent( SizeT ix, DString& scalar)
1775 {
1776 if( env[ix] == NULL) return;
1777 // if( !KeywordPresent( ix)) return;
1778 AssureStringScalarKW( ix, scalar);
1779 }
AssureStringScalarKW(const std::string & kw,DString & scalar)1780 void EnvT::AssureStringScalarKW( const std::string& kw, DString& scalar)
1781 {
1782 AssureStringScalarKW( KeywordIx( kw), scalar);
1783 }
AssureStringScalarKW(SizeT eIx,DString & scalar)1784 void EnvT::AssureStringScalarKW( SizeT eIx, DString& scalar)
1785 {
1786 BaseGDL* p = GetKW( eIx);
1787 if( p == NULL)
1788 Throw("Expression undefined: "+GetString(eIx));
1789
1790 DStringGDL* lp= static_cast<DStringGDL*>(p->Convert2( GDL_STRING, BaseGDL::COPY));
1791 Guard<DStringGDL> guard_lp( lp);
1792
1793 if( !lp->Scalar( scalar))
1794 Throw("Expression must be a scalar or 1 element array in this context: "+
1795 GetString(eIx));
1796 }
1797
SetKW(SizeT ix,BaseGDL * newVal)1798 void EnvBaseT::SetKW( SizeT ix, BaseGDL* newVal)
1799 {
1800 // can't use Guard here as data has to be released
1801 Guard<BaseGDL> guard( newVal);
1802 AssureGlobalKW( ix);
1803 GDLDelete(GetKW( ix));
1804 GetKW( ix) = guard.release();
1805 }
SetPar(SizeT ix,BaseGDL * newVal)1806 void EnvT::SetPar( SizeT ix, BaseGDL* newVal)
1807 {
1808 // can't use Guard here as data has to be released
1809 Guard<BaseGDL> guard( newVal);
1810 AssureGlobalPar( ix);
1811 GDLDelete(GetPar( ix));
1812 GetPar( ix) = guard.release();
1813 }
1814
1815 // bool EnvBaseT::Contains( BaseGDL* p) const
1816 // {
1817 // if( env.Contains( p)) return true;
1818 // if (static_cast<DSubUD*>(pro)->GetCommonVarPtr( p) != NULL) return true;
1819 // // horrible slow... but correct
1820 // return Interpreter()->GetPtrToHeap( p) != NULL;
1821 // }
1822
1823 // BaseGDL** EnvBaseT::GetPtrTo( BaseGDL* p)
1824 // {
1825 // BaseGDL** pp = env.GetPtrTo( p);
1826 // if( pp != NULL) return pp;
1827 // pp = static_cast<DSubUD*>(pro)->GetCommonVarPtr( p);
1828 // if( pp != NULL) return pp;
1829 // return GDLInterpreter::GetPtrToHeap( p);
1830 // }
1831