FreeBASIC  0.91.0
rtl-array.bas
Go to the documentation of this file.
1 '' intrinsic runtime lib array functions (REDIM, ERASE, LBOUND, ...)
2 ''
3 '' chng: oct/2004 written [v1ctor]
4 
5 #include once "fb.bi"
6 #include once "fbint.bi"
7 #include once "ast.bi"
8 #include once "lex.bi"
9 #include once "rtl.bi"
10 
11  dim shared as FB_RTL_PROCDEF funcdata( 0 to ... ) = _
12  { _
13 /' function fb_ArrayRedimEx cdecl _
14  ( _
15  array() as any, _
16  byval elementlen as uinteger, _
17  byval doclear as long, _
18  byval isvarlen as long, _
19  byval dimensions as uinteger, _
20  ... _
21  ) as long '/ _
22  ( _
23  @FB_RTL_ARRAYREDIM, NULL, _
24  FB_DATATYPE_LONG, FB_FUNCMODE_CDECL, _
25  NULL, FB_RTL_OPT_NONE, _
26  6, _
27  { _
28  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
29  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
30  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ), _
31  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ), _
32  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
33  ( FB_DATATYPE_INVALID, FB_PARAMMODE_VARARG, FALSE ) _
34  } _
35  ), _
36 /' function fb_ArrayRedimPresvEx cdecl _
37  ( _
38  array() as any, _
39  byval elementlen as uinteger, _
40  byval doclear as long, _
41  byval isvarlen as long, _
42  byval dimensions as uinteger, _
43  ... _
44  ) as integer '/ _
45  ( _
46  @FB_RTL_ARRAYREDIMPRESV, NULL, _
47  FB_DATATYPE_LONG, FB_FUNCMODE_CDECL, _
48  NULL, FB_RTL_OPT_NONE, _
49  6, _
50  { _
51  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
52  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
53  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ), _
54  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ), _
55  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
56  ( FB_DATATYPE_INVALID, FB_PARAMMODE_VARARG, FALSE ) _
57  } _
58  ), _
59 /' function fb_ArrayRedimObj cdecl _
60  ( _
61  array() as any, _
62  byval elementlen as uinteger, _
63  byval ctor as sub cdecl( byval this_ as any ptr), _
64  byval dtor as sub cdecl( byval this_ as any ptr), _
65  byval dimensions as uinteger, _
66  ... _
67  ) as long '/ _
68  ( _
69  @FB_RTL_ARRAYREDIM_OBJ, NULL, _
70  FB_DATATYPE_LONG, FB_FUNCMODE_CDECL, _
71  NULL, FB_RTL_OPT_NONE, _
72  6, _
73  { _
74  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
75  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
76  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ), _
77  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ), _
78  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
79  ( FB_DATATYPE_INVALID, FB_PARAMMODE_VARARG, FALSE ) _
80  } _
81  ), _
82 /' function fb_ArrayRedimPresvObj cdecl _
83  ( _
84  array() as any, _
85  byval elementlen as uinteger, _
86  byval ctor as sub cdecl( ), _
87  byval dtor as sub cdecl( ), _
88  byval dimensions as uinteger, _
89  ... _
90  ) as long '/ _
91  ( _
92  @FB_RTL_ARRAYREDIMPRESV_OBJ, NULL, _
93  FB_DATATYPE_LONG, FB_FUNCMODE_CDECL, _
94  NULL, FB_RTL_OPT_NONE, _
95  6, _
96  { _
97  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
98  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
99  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ), _
100  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ), _
101  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
102  ( FB_DATATYPE_INVALID, FB_PARAMMODE_VARARG, FALSE ) _
103  } _
104  ), _
105 /' sub fb_ArrayDestructObj( array() as any, byval dtor as sub cdecl( ) ) '/ _
106  ( _
107  @FB_RTL_ARRAYDESTRUCTOBJ, NULL, _
108  FB_DATATYPE_VOID, FB_FUNCMODE_FBCALL, _
109  NULL, FB_RTL_OPT_NONE, _
110  2, _
111  { _
112  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
113  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ) _
114  } _
115  ), _
116 /' sub fb_ArrayDestructStr( array() as any ) '/ _
117  ( _
118  @FB_RTL_ARRAYDESTRUCTSTR, NULL, _
119  FB_DATATYPE_VOID, FB_FUNCMODE_FBCALL, _
120  NULL, FB_RTL_OPT_NONE, _
121  1, _
122  { _
123  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ) _
124  } _
125  ), _
126 /' function fb_ArrayClear( array() as any, byval isvarlen as long ) as long '/ _
127  ( _
128  @FB_RTL_ARRAYCLEAR, NULL, _
129  FB_DATATYPE_LONG, FB_FUNCMODE_FBCALL, _
130  NULL, FB_RTL_OPT_NONE, _
131  2, _
132  { _
133  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
134  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ) _
135  } _
136  ), _
137 /' function fb_ArrayClearObj _
138  ( _
139  array() as any, _
140  byval ctor as sub cdecl( ), _
141  byval dtor as sub cdecl( ), _
142  byval dofill as long _
143  ) as long '/ _
144  ( _
145  @FB_RTL_ARRAYCLEAROBJ, NULL, _
146  FB_DATATYPE_LONG, FB_FUNCMODE_FBCALL, _
147  NULL, FB_RTL_OPT_NONE, _
148  4, _
149  { _
150  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
151  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ), _
152  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ), _
153  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ) _
154  } _
155  ), _
156 /' function fb_ArrayErase( array() as any, byval isvarlen as long ) as long '/ _
157  ( _
158  @FB_RTL_ARRAYERASE, NULL, _
159  FB_DATATYPE_LONG, FB_FUNCMODE_FBCALL, _
160  NULL, FB_RTL_OPT_NONE, _
161  2, _
162  { _
163  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
164  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ) _
165  } _
166  ), _
167 /' function fb_ArrayEraseObj( array() as any, byval dtor as sub cdecl( ) ) as long '/ _
168  ( _
169  @FB_RTL_ARRAYERASEOBJ, NULL, _
170  FB_DATATYPE_LONG, FB_FUNCMODE_FBCALL, _
171  NULL, FB_RTL_OPT_NONE, _
172  2, _
173  { _
174  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
175  ( typeAddrOf( FB_DATATYPE_VOID ), FB_PARAMMODE_BYVAL, FALSE ) _
176  } _
177  ), _
178 /' sub fb_ArrayStrErase( array() as any ) '/ _
179  ( _
180  @FB_RTL_ARRAYERASESTR, NULL, _
181  FB_DATATYPE_VOID, FB_FUNCMODE_FBCALL, _
182  NULL, FB_RTL_OPT_NONE, _
183  1, _
184  { _
185  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ) _
186  } _
187  ), _
188 /' function fb_ArrayLBound( array() as any, byval dimension as integer ) as integer '/ _
189  ( _
190  @FB_RTL_ARRAYLBOUND, NULL, _
191  FB_DATATYPE_INTEGER, FB_FUNCMODE_FBCALL, _
192  NULL, FB_RTL_OPT_NONE, _
193  2, _
194  { _
195  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
196  ( FB_DATATYPE_INTEGER, FB_PARAMMODE_BYVAL, FALSE ) _
197  } _
198  ), _
199 /' function fb_ArrayUBound( array() as any, byval dimension as integer ) as integer '/ _
200  ( _
201  @FB_RTL_ARRAYUBOUND, NULL, _
202  FB_DATATYPE_INTEGER, FB_FUNCMODE_FBCALL, _
203  NULL, FB_RTL_OPT_NONE, _
204  2, _
205  { _
206  ( FB_DATATYPE_VOID, FB_PARAMMODE_BYDESC, FALSE ), _
207  ( FB_DATATYPE_INTEGER, FB_PARAMMODE_BYVAL, FALSE ) _
208  } _
209  ), _
210 /' function fb_ArraySngBoundChk _
211  ( _
212  byval idx as uinteger, _
213  byval ubound as uinteger, _
214  byval linenum as long, _
215  byval fname as const zstring ptr _
216  ) as any ptr '/ _
217  ( _
218  @FB_RTL_ARRAYSNGBOUNDCHK, NULL, _
219  typeAddrOf( FB_DATATYPE_VOID ), FB_FUNCMODE_FBCALL, _
220  NULL, FB_RTL_OPT_NONE, _
221  4, _
222  { _
223  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
224  ( FB_DATATYPE_UINT, FB_PARAMMODE_BYVAL, FALSE ), _
225  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ), _
226  ( typeAddrOf( FB_DATATYPE_CHAR ), FB_PARAMMODE_BYVAL, FALSE ) _
227  } _
228  ), _
229 /' function fb_ArrayBoundChk _
230  ( _
231  byval idx as integer, _
232  byval lbound as integer, _
233  byval ubound as integer, _
234  byval linenum as long, _
235  byval fname as const zstring ptr _
236  ) as any ptr '/ _
237  ( _
238  @FB_RTL_ARRAYBOUNDCHK, NULL, _
239  typeAddrOf( FB_DATATYPE_VOID ), FB_FUNCMODE_FBCALL, _
240  NULL, FB_RTL_OPT_NONE, _
241  5, _
242  { _
243  ( FB_DATATYPE_INTEGER, FB_PARAMMODE_BYVAL, FALSE ), _
244  ( FB_DATATYPE_INTEGER, FB_PARAMMODE_BYVAL, FALSE ), _
245  ( FB_DATATYPE_INTEGER, FB_PARAMMODE_BYVAL, FALSE ), _
246  ( FB_DATATYPE_LONG, FB_PARAMMODE_BYVAL, FALSE ), _
247  ( typeAddrOf( FB_DATATYPE_CHAR ), FB_PARAMMODE_BYVAL, FALSE ) _
248  } _
249  ), _
250 /' EOL '/ _
251  ( _
252  NULL _
253  ) _
254  }
255 
258 end sub
259 
261  '' procs will be deleted when symbEnd is called
262 end sub
263 
264 function hBuildProcPtr(byval proc as FBSYMBOL ptr) as ASTNODE ptr
265  if( proc = NULL ) then
266  return astNewCONSTi( 0 )
267  end if
268  function = astBuildProcAddrof( proc )
269 end function
270 
271 sub hCheckDefCtor _
272  ( _
273  byval ctor as FBSYMBOL ptr, _
274  byval check_access as integer, _
275  byval is_erase as integer _
276  )
277 
278  if( ctor = NULL ) then exit sub
279 
280  assert( symbIsConstructor( ctor ) )
281 
282  if( check_access ) then
283  if( symbCheckAccess( ctor ) = FALSE ) then
284  errReport( FB_ERRMSG_NOACCESSTODEFAULTCTOR )
285  end if
286  end if
287 
288  '' Check whether the given default ctor matches the rtlib's FB_DEFCTOR
289  if( symbGetProcMode( ctor ) <> FB_FUNCMODE_CDECL ) then
290  errReport( iif( is_erase, FB_ERRMSG_ERASECTORMUSTBECDEL, _
291  FB_ERRMSG_REDIMCTORMUSTBECDEL ) )
292  end if
293 
294  '' Must have only the THIS ptr parameter
295  if( symbGetProcParams( ctor ) <> 1 ) then
296  errReport( iif( is_erase, FB_ERRMSG_ERASECTORMUSTHAVEONEPARAM, _
297  FB_ERRMSG_REDIMCTORMUSTHAVEONEPARAM ) )
298  end if
299 
300 end sub
301 
302 sub hCheckDtor _
303  ( _
304  byval dtor as FBSYMBOL ptr, _
305  byval check_access as integer, _
306  byval is_erase as integer _
307  )
308 
309  if( dtor = NULL ) then exit sub
310 
311  assert( symbIsDestructor( dtor ) )
312 
313  if( check_access ) then
314  if( symbCheckAccess( dtor ) = FALSE ) then
315  errReport( FB_ERRMSG_NOACCESSTODTOR )
316  end if
317  end if
318 
319  '' Check whether the given dtor matches the rtlib's FB_DEFCTOR
320  if( symbGetProcMode( dtor ) <> FB_FUNCMODE_CDECL ) then
321  errReport( iif( is_erase, FB_ERRMSG_ERASEDTORMUSTBECDEL, _
322  FB_ERRMSG_REDIMDTORMUSTBECDEL ) )
323  end if
324 
325  assert( symbGetProcParams( dtor ) = 1 )
326 
327 end sub
328 
329 '' fb_ArrayClear* - destruct elements if needed and then re-initialize
330 function rtlArrayClear( byval arrayexpr as ASTNODE ptr ) as ASTNODE ptr
331  dim as ASTNODE ptr proc = any
332  dim as integer dtype = any
333  dim as FBSYMBOL ptr ctor = any, dtor = any, subtype = any
334 
335  function = NULL
336 
337  dtype = astGetDataType( arrayexpr )
338 
339  if( dtype = FB_DATATYPE_STRUCT ) then
340  subtype = astGetSubtype( arrayexpr )
341  ctor = symbGetCompDefCtor( subtype )
342  dtor = symbGetCompDtor( subtype )
343 
344  '' No default ctor, but others? Then the rtlib cannot just clear
345  '' that array of objects.
346  if( (ctor = NULL) and (symbGetCompCtorHead( subtype ) <> NULL) ) then
347  errReport( FB_ERRMSG_NODEFAULTCTORDEFINED )
348  end if
349  else
350  ctor = NULL
351  dtor = NULL
352  end if
353 
354  if( (ctor <> NULL) or (dtor <> NULL) ) then
355  hCheckDefCtor( ctor, TRUE, TRUE )
356  hCheckDtor( dtor, TRUE, TRUE )
357 
358  '' fb_ArrayClearObj()
359  proc = astNewCALL( PROCLOOKUP( ARRAYCLEAROBJ ) )
360 
361  '' array() as any
362  if( astNewARG( proc, arrayexpr, dtype ) = NULL ) then
363  exit function
364  end if
365 
366  '' byval ctor as sub cdecl( )
367  if( astNewARG( proc, hBuildProcPtr( ctor ) ) = NULL ) then
368  exit function
369  end if
370 
371  '' byval dtor as sub cdecl( )
372  if( astNewARG( proc, hBuildProcPtr( dtor ) ) = NULL ) then
373  exit function
374  end if
375 
376  '' byval dofill as integer
377  if( astNewARG( proc, astNewCONSTi( -1 ) ) = NULL ) then
378  exit function
379  end if
380  elseif( dtype = FB_DATATYPE_STRING ) then
381  '' fb_ArrayDestructStr() works as fb_ArrayClearStr() just fine
382  proc = astNewCALL( PROCLOOKUP( ARRAYDESTRUCTSTR ) )
383 
384  '' array() as any
385  if( astNewARG( proc, arrayexpr, dtype ) = NULL ) then
386  exit function
387  end if
388  else
389  '' fb_ArrayClear()
390  proc = astNewCALL( PROCLOOKUP( ARRAYCLEAR ) )
391 
392  '' array() as any
393  if( astNewARG( proc, arrayexpr, dtype ) = NULL ) then
394  exit function
395  end if
396 
397  '' byval isvarlen as integer
398  if( astNewARG( proc, astNewCONSTi( 0 ) ) = NULL ) then
399  exit function
400  end if
401  end if
402 
403  function = proc
404 end function
405 
406 '' fb_ArrayErase* or fb_ArrayDestruct*
407 '' - destruct elements, and free array if it's dynamic
408 function rtlArrayErase _
409  ( _
410  byval arrayexpr as ASTNODE ptr, _
411  byval is_dynamic as integer, _
412  byval check_access as integer _
413  ) as ASTNODE ptr
414 
415  dim as ASTNODE ptr proc = any
416  dim as integer dtype = any
417  dim as FBSYMBOL ptr dtor = any
418 
419  function = NULL
420 
421  dtype = astGetDataType( arrayexpr )
422 
423  if( dtype = FB_DATATYPE_STRUCT ) then
424  dtor = symbGetCompDtor( astGetSubtype( arrayexpr ) )
425  else
426  dtor = NULL
427  end if
428 
429  if( dtor ) then
430  hCheckDtor( dtor, check_access, TRUE )
431 
432  if( is_dynamic ) then
433  '' fb_ArrayEraseObj()
434  proc = astNewCALL( PROCLOOKUP( ARRAYERASEOBJ ) )
435  else
436  '' fb_ArrayDestructObj()
437  proc = astNewCALL( PROCLOOKUP( ARRAYDESTRUCTOBJ ) )
438  end if
439 
440  '' array() as any
441  if( astNewARG( proc, arrayexpr, dtype ) = NULL ) then
442  exit function
443  end if
444 
445  '' byval dtor as sub cdecl( )
446  if( astNewARG( proc, hBuildProcPtr( dtor ) ) = NULL ) then
447  exit function
448  end if
449  elseif( dtype = FB_DATATYPE_STRING ) then
450  if( is_dynamic ) then
451  '' fb_ArrayStrErase()
452  proc = astNewCALL( PROCLOOKUP( ARRAYERASESTR ) )
453  else
454  '' fb_ArrayDestructStr()
455  proc = astNewCALL( PROCLOOKUP( ARRAYDESTRUCTSTR ) )
456  end if
457 
458  '' array() as any
459  if( astNewARG( proc, arrayexpr, dtype ) = NULL ) then
460  exit function
461  end if
462  else
463  if( is_dynamic = FALSE ) then
464  '' No dtor, not dynamic = nothing to do
465  exit function
466  end if
467 
468  '' fb_ArrayErase()
469  proc = astNewCALL( PROCLOOKUP( ARRAYERASE ) )
470 
471  '' array() as any
472  if( astNewARG( proc, arrayexpr, dtype ) = NULL ) then
473  exit function
474  end if
475 
476  '' byval isvarlen as integer
477  if( astNewARG( proc, astNewCONSTi( 0 ) ) = NULL ) then
478  exit function
479  end if
480  end if
481 
482  function = proc
483 end function
484 
485 function rtlArrayRedim _
486  ( _
487  byval s as FBSYMBOL ptr, _
488  byval elementlen as longint, _
489  byval dimensions as integer, _
490  exprTB() as ASTNODE ptr, _
491  byval dopreserve as integer, _
492  byval doclear as integer _
493  ) as ASTNODE ptr
494 
495  '' no const filtering needed... dynamic arrays can't be const
496 
497  dim as ASTNODE ptr proc = any, expr = any
498  dim as FBSYMBOL ptr f = any, ctor = any, dtor = any, subtype = any
499  dim as integer dtype = any
500 
501  dtype = symbGetFullType( s )
502 
503  '' only objects get instantiated
504  select case typeGet( dtype )
505  case FB_DATATYPE_STRUCT ', FB_DATATYPE_CLASS
506  subtype = symbGetSubtype( s )
507  ctor = symbGetCompDefCtor( subtype )
508  dtor = symbGetCompDtor( subtype )
509 
510  '' Assuming there aren't any other ctors if there is no default one,
511  '' because if it were possible to declare such a dynamic array,
512  '' the rtlib couldn't REDIM it.
513  assert( iif( ctor = NULL, (symbGetCompCtorHead( subtype ) = NULL) or (errGetCount( ) > 0), TRUE ) )
514  case else
515  ctor = NULL
516  dtor = NULL
517  end select
518 
519  if( (ctor = NULL) and (dtor = NULL) ) then
520  if( dopreserve = FALSE ) then
521  f = PROCLOOKUP( ARRAYREDIM )
522  else
523  f = PROCLOOKUP( ARRAYREDIMPRESV )
524  end if
525  else
526  if( dopreserve = FALSE ) then
527  f = PROCLOOKUP( ARRAYREDIM_OBJ )
528  else
529  f = PROCLOOKUP( ARRAYREDIMPRESV_OBJ )
530  end if
531  end if
532 
533  proc = astNewCALL( f )
534 
535  '' array() as ANY
536  if( astNewARG( proc, astNewVAR( s ) ) = NULL ) then
537  exit function
538  end if
539 
540  '' byval element_len as integer
541  if( astNewARG( proc, astNewCONSTi( elementlen ) ) = NULL ) then
542  exit function
543  end if
544 
545  if( (ctor = NULL) and (dtor = NULL) ) then
546  '' byval doclear as integer
547  if( astNewARG( proc, astNewCONSTi( doclear ) ) = NULL ) then
548  exit function
549  end if
550 
551  '' byval isvarlen as integer
552  if( astNewARG( proc, astNewCONSTi( (dtype = FB_DATATYPE_STRING) ) ) = NULL ) then
553  exit function
554  end if
555  else
556  hCheckDefCtor( ctor, FALSE, FALSE )
557  hCheckDtor( dtor, FALSE, FALSE )
558 
559  '' byval ctor as sub cdecl( )
560  if( astNewARG( proc, hBuildProcPtr( ctor ) ) = NULL ) then
561  exit function
562  end if
563 
564  '' byval dtor as sub cdecl( )
565  if( astNewARG( proc, hBuildProcPtr( dtor ) ) = NULL ) then
566  exit function
567  end if
568  end if
569 
570  '' byval dimensions as integer
571  if( astNewARG( proc, astNewCONSTi( dimensions ) ) = NULL ) then
572  exit function
573  end if
574 
575  '' ...
576  for i as integer = 0 to dimensions-1
577  '' lbound
578  expr = exprTB(i, 0)
579 
580  '' convert to int
581  if( astGetDataType( expr ) <> FB_DATATYPE_INTEGER ) then
582  expr = astNewCONV( FB_DATATYPE_INTEGER, NULL, expr )
583  end if
584 
585  if( astNewARG( proc, expr ) = NULL ) then
586  exit function
587  end if
588 
589  '' ubound
590  expr = exprTB(i, 1)
591 
592  '' convert to int
593  if( astGetDataType( expr ) <> FB_DATATYPE_INTEGER ) then
594  expr = astNewCONV( FB_DATATYPE_INTEGER, NULL, expr )
595  end if
596 
597  if( astNewARG( proc, expr ) = NULL ) then
598  exit function
599  end if
600  next
601 
602  function = rtlErrorCheck( proc )
603 end function
604 
605 function rtlArrayBound _
606  ( _
607  byval arrayexpr as ASTNODE ptr, _
608  byval dimexpr as ASTNODE ptr, _
609  byval islbound as integer _
610  ) as ASTNODE ptr
611 
612  dim as ASTNODE ptr proc = any
613 
614  function = NULL
615 
616  proc = astNewCALL( iif( islbound, _
617  PROCLOOKUP( ARRAYLBOUND ), _
618  PROCLOOKUP( ARRAYUBOUND ) ) )
619 
620  '' array() as ANY
621  if( astNewARG( proc, arrayexpr ) = NULL ) then
622  exit function
623  end if
624 
625  '' byval dimension as integer
626  if( astNewARG( proc, dimexpr ) = NULL ) then
627  exit function
628  end if
629 
630  function = proc
631 end function
632 
633 '':::::
634 function rtlArrayBoundsCheck _
635  ( _
636  byval idx as ASTNODE ptr, _
637  byval lb as ASTNODE ptr, _
638  byval rb as ASTNODE ptr, _
639  byval linenum as integer, _
640  byval module as zstring ptr _
641  ) as ASTNODE ptr
642 
643  dim as ASTNODE ptr proc = any
644  dim as FBSYMBOL ptr f = any
645 
646  function = NULL
647 
648  '' lbound 0? do a single check
649  if( lb = NULL ) then
650  f = PROCLOOKUP( ARRAYSNGBOUNDCHK )
651  else
652  f = PROCLOOKUP( ARRAYBOUNDCHK )
653  end if
654 
655  proc = astNewCALL( f )
656 
657  '' idx
658  if( astNewARG( proc, astNewCONV( FB_DATATYPE_INTEGER, NULL, idx ) ) = NULL ) then
659  exit function
660  end if
661 
662  '' lbound
663  if( lb <> NULL ) then
664  if( astNewARG( proc, lb, FB_DATATYPE_INTEGER ) = NULL ) then
665  exit function
666  end if
667  end if
668 
669  '' rbound
670  if( astNewARG( proc, rb, FB_DATATYPE_INTEGER ) = NULL ) then
671  exit function
672  end if
673 
674  '' linenum
675  if( astNewARG( proc, astNewCONSTi( linenum ) ) = NULL ) then
676  exit function
677  end if
678 
679  '' module
680  if( astNewARG( proc, astNewCONSTstr( module ) ) = NULL ) then
681  exit function
682  end if
683 
684  function = proc
685 
686 end function
687