BuiltinFunctions.cpp
Go to the documentation of this file.
1 /*----------------------------------------------------------------------------*/
2 /* */
3 /* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */
4 /* Copyright (c) 2005-2009 Rexx Language Association. All rights reserved. */
5 /* */
6 /* This program and the accompanying materials are made available under */
7 /* the terms of the Common Public License v1.0 which accompanies this */
8 /* distribution. A copy is also available at the following address: */
9 /* http://www.oorexx.org/license.html */
10 /* */
11 /* Redistribution and use in source and binary forms, with or */
12 /* without modification, are permitted provided that the following */
13 /* conditions are met: */
14 /* */
15 /* Redistributions of source code must retain the above copyright */
16 /* notice, this list of conditions and the following disclaimer. */
17 /* Redistributions in binary form must reproduce the above copyright */
18 /* notice, this list of conditions and the following disclaimer in */
19 /* the documentation and/or other materials provided with the distribution. */
20 /* */
21 /* Neither the name of Rexx Language Association nor the names */
22 /* of its contributors may be used to endorse or promote products */
23 /* derived from this software without specific prior written permission. */
24 /* */
25 /* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
26 /* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */
27 /* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */
28 /* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */
29 /* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */
30 /* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */
31 /* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */
32 /* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */
33 /* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */
34 /* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */
35 /* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
36 /* */
37 /*----------------------------------------------------------------------------*/
38 /******************************************************************************/
39 /* REXX Translator */
40 /* */
41 /* Builtin Function Execution Stubs */
42 /* */
43 /******************************************************************************/
44 
45 #include <stdlib.h>
46 #include <ctype.h>
47 #include "RexxCore.h"
48 #include "StringClass.hpp"
49 #include "DirectoryClass.hpp"
50 #include "ArrayClass.hpp"
52 #include "RexxActivation.hpp"
53 #include "RexxActivity.hpp"
55 #include "SourceFile.hpp"
56 #include "BuiltinFunctions.hpp"
57 #include "RexxDateTime.hpp"
58 #include "Numerics.hpp"
59 #include "ProtectedObject.hpp"
60 #include "PackageManager.hpp"
61 #include "SystemInterpreter.hpp"
62 #include "SysFileSystem.hpp"
63 
64 
65 /**
66  * Verify that a function has received all of its required arguments, and did not receive extras.
67  *
68  * @param argcount The number of arguments passed to the function.
69  * @param min The minimum required arguments
70  * @param max The maximum required arguments
71  * @param function The function name
72  *
73  * @return Nothing.
74  */
75 void expandArgs(RexxObject **arguments, size_t argcount, size_t min, size_t max, const char *function)
76 {
77  /*
78  JLF
79  The parser was modified to keep the trailing omitted arguments:
80  .array~of(10,20,30,,)~dimensions= -- [5] instead of [3]
81  The change above has an unexpected effect on the regression tests:
82  base/bif: [SYNTAX 40.5] raised unexpectedly
83  because
84  40.5 "Missing argument in invocation of XXX; argument 2 is required"
85  is raised instead of
86  40.3 "Not enough arguments in invocation of XXX; minimum expected is 2."
87  */
88 
89  // Adjust argcount to be more compliant with the regression tests when reporting errors
90  size_t argcountAdjusted = argcount;
91  if (argcount >=2)
92  {
93  while (argcountAdjusted >= 1 && arguments[argcountAdjusted - 1] == OREF_NULL)
94  {
95  argcountAdjusted--;
96  }
97  }
98 
99  if (argcountAdjusted < min) /* too few arguments? */
100  {
101  /* report an error */
102  reportException(Error_Incorrect_call_minarg, OREF_positional, function, min);
103  }
104  else if (argcountAdjusted > max) /* too many arguments? */
105  {
106  /* report an error */
107  reportException(Error_Incorrect_call_maxarg, OREF_positional, function, max);
108  }
109  else /* need to expand number of args */
110  {
111  for (size_t i = min; i >= 1; i--)
112  {
113  if (arguments[i - 1] == OREF_NULL) reportException(Error_Incorrect_call_noarg, function, OREF_positional, i);
114  }
115  }
116 }
117 
118 
119 /**
120  * Process a required argument and potentially convert it into a string argument
121  *
122  * @param position The argument position for any error messages (1 to argcount).
123  * @param argcount The number of arguments passed to the function.
124  * @param function The function name
125  *
126  * @return The string representation of the argument.
127  */
128 RexxString *requiredStringArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
129 {
130  RexxObject *argument = OREF_NULL;
131  if (argcount >= position) argument = arguments[position - 1]; /* get the argument in question */
132  if (argument == OREF_NULL) reportException(Error_Incorrect_call_noarg, function, OREF_positional, position);
133 
134  if (isOfClass(String, argument)) /* string object already? */
135  {
136  return(RexxString *)argument; /* finished */
137  }
138  /* get the string form, raising a */
139  /* NOSTRING condition if necessary */
140  RexxString *newStr = argument->requestString();
141  arguments[position - 1] = newStr; /* replace the argument */
142  return newStr; /* return the replacement value */
143 }
144 
145 
146 /**
147  * Process an optional argument and potentially convert it into a string argument
148  *
149  * @param position The argument position for any error messages (1 to argcount).
150  * @param argcount The number of arguments passed to the function.
151  * @param function The function name
152  *
153  * @return The string representation of the argument.
154  */
155 RexxString *optionalStringArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
156 {
157  RexxObject *argument = OREF_NULL;
158  if (argcount >= position) argument = arguments[position - 1]; /* get the argument in question */
159  if (argument == OREF_NULL) /* missing a required argument? */
160  {
161  return OREF_NULL; /* finished already */
162  }
163  if (isOfClass(String, argument)) /* string object already? */
164  {
165  return(RexxString *)argument; /* finished */
166  }
167  /* get the string form, raising a */
168  /* NOSTRING condition if necessary */
169  RexxString *newStr = argument->requestString();
170  arguments[position - 1] = newStr; /* replace the argument */
171  return newStr; /* return the replacement value */
172 }
173 
174 
175 /**
176  * Process a required argument and ensure it is a valid integer
177  *
178  * @param position The argument position for any error messages (1 to argcount).
179  * @param argcount The number of arguments passed to the function.
180  * @param function The function name
181  *
182  * @return An object that can be converted to an integer argument.
183  */
184 RexxInteger *requiredIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
185 {
186  RexxObject *argument = OREF_NULL;
187  if (argcount >= position) argument = arguments[position - 1]; /* get the argument in question */
188  if (argument == OREF_NULL) reportException(Error_Incorrect_call_noarg, function, OREF_positional, position);
189 
190  if (isOfClass(Integer, argument)) /* integer object already? */
191  {
192  return(RexxInteger *)argument; /* finished */
193  }
194  /* return the string form of argument*/
195  wholenumber_t numberValue; /* converted long value */
196  if (!argument->requestNumber(numberValue, Numerics::ARGUMENT_DIGITS))
197  {
198  /* report an exception */
199  reportException(Error_Incorrect_call_whole, function, OREF_positional, argcount - position, argument);
200  }
201  RexxInteger *newInt = new_integer(numberValue); /* create an integer object */
202  arguments[position - 1] = newInt; /* replace the argument */
203  return newInt; /* return the replacement value */
204 }
205 
206 
207 /**
208  * Process an optional argument and ensure it is a valid integer
209  *
210  * @param position The argument position for any error messages (1 to argcount).
211  * @param argcount The number of arguments passed to the function.
212  * @param function The function name
213  *
214  * @return An object that can be converted to an integer argument.
215  */
216 RexxInteger *optionalIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
217 {
218  RexxObject *argument = OREF_NULL;
219  if (argcount >= position) argument = arguments[position - 1]; /* get the argument in question */
220  if (argument == OREF_NULL) /* missing an optional argument? */
221  {
222  return OREF_NULL; /* nothing there */
223  }
224  if (isOfClass(Integer, argument)) /* integer object already? */
225  {
226  return(RexxInteger *)argument; /* finished */
227  }
228  /* return the string form of argument*/
229  wholenumber_t numberValue; /* converted long value */
230  if (!argument->requestNumber(numberValue, Numerics::ARGUMENT_DIGITS))
231  {
232  /* report an exception */
233  reportException(Error_Incorrect_call_whole, function, OREF_positional, position, argument);
234  }
235  RexxInteger *newInt = new_integer(numberValue); /* create an integer object */
236  arguments[position - 1] = newInt; /* replace the argument */
237  return newInt; /* return the replacement value */
238 }
239 
240 
241 /**
242  * Process a required argument and ensure it is a valid integer
243  * that can be expressed as a 64-bit value.
244  *
245  * @param position The argument position for any error messages (1 to argcount).
246  * @param argcount The number of arguments passed to the function.
247  * @param function The function name
248  *
249  * @return An object that can be converted to a 64-bit value for
250  * pass-on to a native function.
251  */
252 RexxObject *requiredBigIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
253 {
254  RexxObject *argument = OREF_NULL;
255  if (argcount >= position) argument = arguments[position - 1]; /* get the argument in question */
256  if (argument == OREF_NULL) reportException(Error_Incorrect_call_noarg, function, OREF_positional, position);
257 
258  // get this in the form of an object that is valid as a 64-bit integer, ready to
259  // be passed along as an argument to native code.
260  RexxObject *newArgument = Numerics::int64Object(argument);
261  // returns a null value if it doesn't convert properly
262  if (newArgument == OREF_NULL)
263  {
264  /* report an exception */
265  reportException(Error_Incorrect_call_whole, function, OREF_positional, argcount - position, argument);
266  }
267  arguments[position - 1] = newArgument; /* replace the argument */
268  return newArgument;
269 }
270 
271 
272 /**
273  * Process an optional argument and ensure it is a valid integer
274  * that can be expressed as a 64-bit value.
275  *
276  * @param position The argument position for any error messages (1 to argcount).
277  * @param argcount The number of arguments passed to the function.
278  * @param function The function name
279  *
280  * @return An object that can be converted to a 64-bit value for
281  * pass-on to a native function.
282  */
283 RexxObject *optionalBigIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
284 {
285  RexxObject *argument = OREF_NULL;
286  if (argcount >= position) argument = arguments[position - 1]; /* get the argument in question */
287  if (argument == OREF_NULL) /* missing an optional argument? */
288  {
289  return OREF_NULL; /* nothing there */
290  }
291  // get this in the form of an object that is valid as a 64-bit integer, ready to
292  // be passed along as an argument to native code.
293  RexxObject *newArgument = Numerics::int64Object(argument);
294  // returns a null value if it doesn't convert properly
295  if (newArgument == OREF_NULL)
296  {
297  /* report an exception */
298  reportException(Error_Incorrect_call_whole, function, OREF_positional, position, argument);
299  }
300  arguments[position - 1] = newArgument; /* replace the argument */
301  return newArgument;
302 }
303 
304 
305 /* checks if pad is a single character string */
306 void checkPadArgument(const char *pFuncName, RexxObject *position, RexxString *pad)
307 {
308  if (pad == OREF_NULL)
309  {
310  return;
311  }
312  if (pad->getBLength() != 1)
313  {
314  reportException(Error_Incorrect_call_pad, pFuncName, OREF_positional, position, pad);
315  }
316 }
317 
318 #define CENTER_MIN 2
319 #define CENTER_MAX 3
320 #define CENTER_string 1
321 #define CENTER_length 2
322 #define CENTER_pad 3
323 
324 BUILTIN(CENTER)
325 {
326  fix_args(CENTER); /* check on required number of args */
327  /* force first argument to a string */
328  RexxString *string = required_string(CENTER, string);
329  /* this is a required length */
330  RexxInteger *length = required_integer(CENTER, length);
331  RexxString *pad = optional_string(CENTER, pad); /* the pad character must be one too */
332  checkPadArgument(CHAR_CENTER, IntegerThree, pad);
333  return string->center(length, pad); /* do the center function */
334 }
335 
336 #define CENTRE_MIN 2
337 #define CENTRE_MAX 3
338 #define CENTRE_string 1
339 #define CENTRE_length 2
340 #define CENTRE_pad 3
341 
342 BUILTIN(CENTRE)
343 {
344  fix_args(CENTRE); /* check on required number of args */
345  /* force first argument to a string */
346  RexxString *string = required_string(CENTRE, string);
347  /* this is a required length */
348  RexxInteger *length = required_integer(CENTRE, length);
349  RexxString *pad = optional_string(CENTRE, pad); /* the pad character must be one too */
350  checkPadArgument(CHAR_CENTRE, IntegerThree, pad);
351  return string->center(length, pad); /* do the center function */
352 }
353 
354 #define DELSTR_MIN 2
355 #define DELSTR_MAX 3
356 #define DELSTR_string 1
357 #define DELSTR_n 2
358 #define DELSTR_length 3
359 
360 BUILTIN(DELSTR)
361 {
362  fix_args(DELSTR); /* check on required number of args */
363  /* must have the first argument */
364  RexxString *string = required_string(DELSTR, string);
365  RexxInteger *n = required_integer(DELSTR, n); /* need a delete position */
366  /* length is optional */
367  RexxInteger *length = optional_integer(DELSTR, length);
368  return string->delstr(n, length); /* do the delstr function */
369 }
370 
371 #define DELWORD_MIN 2
372 #define DELWORD_MAX 3
373 #define DELWORD_string 1
374 #define DELWORD_n 2
375 #define DELWORD_length 3
376 
377 BUILTIN(DELWORD)
378 {
379  fix_args(DELWORD); /* check on required number of args */
380  /* must have the first argument */
381  RexxString *string = required_string(DELWORD, string);
382  RexxInteger *n = required_integer(DELWORD, n); /* need a delete position */
383  /* length is optional */
384  RexxInteger *length = optional_integer(DELWORD, length);
385  return string->delWord(n, length); /* do the delword function */
386 }
387 
388 #define INSERT_MIN 2
389 #define INSERT_MAX 5
390 #define INSERT_new 1
391 #define INSERT_target 2
392 #define INSERT_n 3
393 #define INSERT_length 4
394 #define INSERT_pad 5
395 
396 BUILTIN(INSERT)
397 {
398  fix_args(INSERT); /* check on require number of args */
399  /* get string for new */
400  RexxString *newString = required_string(INSERT, new);
401  /* get string for target */
402  RexxString *target = required_string(INSERT, target);
403  RexxInteger *n = optional_integer(INSERT, n); /* insert position is optional */
404  /* length is optional */
405  RexxInteger *length = optional_integer(INSERT, length);
406  RexxString *pad = optional_string(INSERT, pad); /* get string for pad */
407  /* go perform the insert function */
408  checkPadArgument(CHAR_INSERT, IntegerFour, pad);
409  return target->insert(newString, n, length, pad);
410 }
411 
412 #define LEFT_MIN 2
413 #define LEFT_MAX 3
414 #define LEFT_string 1
415 #define LEFT_length 2
416 #define LEFT_pad 3
417 
418 BUILTIN(LEFT)
419 {
420  fix_args(LEFT); /* check on required number of args */
421  /* must have the first argument */
422  RexxString *string = required_string(LEFT, string);
423  /* length is optional */
424  RexxInteger *length = optional_integer(LEFT, length);
425  RexxString *pad = optional_string(LEFT, pad); /* pad must be a string also */
426  checkPadArgument(CHAR_LEFT, IntegerThree, pad);
427  return string->left(length, pad); /* do the substr function */
428 }
429 
430 #define OVERLAY_MIN 2
431 #define OVERLAY_MAX 5
432 #define OVERLAY_new 1
433 #define OVERLAY_target 2
434 #define OVERLAY_n 3
435 #define OVERLAY_length 4
436 #define OVERLAY_pad 5
437 
438 BUILTIN(OVERLAY)
439 {
440  fix_args(OVERLAY); /* check on require number of args */
441  /* get string for new */
442  RexxString *newString = required_string(OVERLAY, new);
443  /* get string for target */
444  RexxString *target = required_string(OVERLAY, target);
445  RexxInteger *n = optional_integer(OVERLAY, n); /* overlay position is optional */
446  /* length is optional */
447  RexxInteger *length = optional_integer(OVERLAY, length);
448  RexxString *pad = optional_string(OVERLAY, pad); /* get string for pad */
449  /* go perform the overlay function */
450  checkPadArgument(CHAR_OVERLAY, IntegerFive, pad);
451  return target->overlay(newString, n, length, pad);
452 }
453 
454 #define POS_MIN 2
455 #define POS_MAX 4
456 #define POS_needle 1
457 #define POS_haystack 2
458 #define POS_start 3
459 #define POS_range 4
460 
462 {
463  fix_args(POS); /* check on require number of args */
464  /* get string for new */
465  RexxString *needle = required_string(POS, needle);
466  /* get string for target */
467  RexxString *haystack = required_string(POS, haystack);
468  RexxInteger *start = optional_integer(POS, start);/* start position is optional */
469  RexxInteger *range = optional_integer(POS, range);
470  /* go perform the pos function */
471  return haystack->posRexx(needle, start, range);
472 }
473 
474 #define LASTPOS_MIN 2
475 #define LASTPOS_MAX 4
476 #define LASTPOS_needle 1
477 #define LASTPOS_haystack 2
478 #define LASTPOS_start 3
479 #define LASTPOS_range 4
480 
481 BUILTIN(LASTPOS)
482 {
483  fix_args(LASTPOS); /* check on require number of args */
484  /* get string for new */
485  RexxString *needle = required_string(LASTPOS, needle);
486  /* get string for target */
487  RexxString *haystack = required_string(LASTPOS, haystack);
488  /* start position is optional */
489  RexxInteger *start = optional_integer(LASTPOS, start);
490  RexxInteger *range = optional_integer(LASTPOS, range);
491  /* go perform the lastpos function */
492  return haystack->lastPosRexx(needle, start, range);
493 }
494 
495 #define REVERSE_MIN 1
496 #define REVERSE_MAX 1
497 #define REVERSE_string 1
498 
499 BUILTIN(REVERSE)
500 {
501  fix_args(REVERSE); /* check on require number of args */
502  /* get string for string */
503  RexxString *string = required_string(REVERSE, string);
504  return string->reverse(); /* go perform the reverse function */
505 }
506 
507 #define RIGHT_MIN 2
508 #define RIGHT_MAX 3
509 #define RIGHT_string 1
510 #define RIGHT_length 2
511 #define RIGHT_pad 3
512 
513 BUILTIN(RIGHT)
514 {
515  fix_args(RIGHT); /* check on required number of args */
516  /* must have the first argument */
517  RexxString *string = required_string(RIGHT, string);
518  /* length is optional */
519  RexxInteger *length = optional_integer(RIGHT, length);
520  RexxString *pad = optional_string(RIGHT, pad); /* pad must be a string also */
521  checkPadArgument(CHAR_RIGHT, IntegerThree, pad);
522  return string->right(length, pad); /* do the substr function */
523 }
524 
525 #define STRIP_MIN 1
526 #define STRIP_MAX 3
527 #define STRIP_string 1
528 #define STRIP_option 2
529 #define STRIP_char 3
530 
531 BUILTIN(STRIP)
532 {
533  fix_args(STRIP); /* check on required number of args */
534  /* must have the first argument */
535  RexxString *string = required_string(STRIP, string);
536  /* option must be a string too */
537  RexxString *option = optional_string(STRIP, option);
538  /* as is char as well */
539  RexxString *character = optional_string(STRIP, char);
540  /* do the strip function */
541  return string->strip(option, character);
542 }
543 
544 #define SPACE_MIN 1
545 #define SPACE_MAX 3
546 #define SPACE_string 1
547 #define SPACE_n 2
548 #define SPACE_pad 3
549 
550 
551 BUILTIN(SPACE)
552 {
553  fix_args(SPACE); /* check on required number of args */
554  /* must have the first argument */
555  RexxString *string = required_string(SPACE, string);
556  RexxInteger *n = optional_integer(SPACE, n); /* spacing is an optional integer */
557  RexxString *pad = optional_string(SPACE, pad); /* pad must be a string also */
558  checkPadArgument(CHAR_SPACE, IntegerThree, pad);
559  return string->space(n, pad); /* do the space function */
560 }
561 
562 #define SUBSTR_MIN 2
563 #define SUBSTR_MAX 4
564 #define SUBSTR_string 1
565 #define SUBSTR_n 2
566 #define SUBSTR_length 3
567 #define SUBSTR_pad 4
568 
569 
570 BUILTIN(SUBSTR)
571 {
572  fix_args(SUBSTR); /* check on required number of args */
573  /* must have the first argument */
574  RexxString *string = required_string(SUBSTR, string);
575  RexxInteger *n = required_integer(SUBSTR, n); /* position is required */
576  /* length is optional */
577  RexxInteger *length = optional_integer(SUBSTR, length);
578  RexxString *pad = optional_string(SUBSTR, pad); /* pad must be a string also */
579  /* do the substr function */
580  checkPadArgument(CHAR_SUBSTR, IntegerFour, pad);
581  return string->substr(n, length, pad);
582 }
583 
584 
585 #define LOWER_MIN 1
586 #define LOWER_MAX 3
587 #define LOWER_string 1
588 #define LOWER_n 2
589 #define LOWER_length 3
590 
591 
592 BUILTIN(LOWER)
593 {
594  fix_args(LOWER); /* check on required number of args */
595  /* must have the first argument */
596  RexxString *string = required_string(LOWER, string);
597  RexxInteger *n = optional_integer(LOWER, n); /* position is optional */
598  /* length is optional */
599  RexxInteger *length = optional_integer(LOWER, length);
600  /* do the LOWER function */
601  return string->lowerRexx(n, length);
602 }
603 
604 
605 #define UPPER_MIN 1
606 #define UPPER_MAX 3
607 #define UPPER_string 1
608 #define UPPER_n 2
609 #define UPPER_length 3
610 
611 
612 BUILTIN(UPPER)
613 {
614  fix_args(UPPER); /* check on required number of args */
615  /* must have the first argument */
616  RexxString *string = required_string(UPPER, string);
617  RexxInteger *n = optional_integer(UPPER, n); /* position is optional */
618  /* length is optional */
619  RexxInteger *length = optional_integer(UPPER, length);
620  /* do the UPPER function */
621  return string->upperRexx(n, length);
622 }
623 
624 
625 #define SUBWORD_MIN 2
626 #define SUBWORD_MAX 3
627 #define SUBWORD_string 1
628 #define SUBWORD_n 2
629 #define SUBWORD_length 3
630 
631 BUILTIN(SUBWORD)
632 {
633  fix_args(SUBWORD); /* check on required number of args */
634  /* must have the first argument */
635  RexxString *string = required_string(SUBWORD, string);
636  RexxInteger *n = required_integer(SUBWORD, n); /* position is required */
637  /* length is optional */
638  RexxInteger *length = optional_integer(SUBWORD, length);
639  return string->subWord(n, length); /* do the subword function */
640 }
641 
642 #define WORD_MIN 2
643 #define WORD_MAX 2
644 #define WORD_string 1
645 #define WORD_n 2
646 
647 BUILTIN(WORD)
648 {
649  fix_args(WORD); /* check on required number of args */
650  /* must have the first argument */
651  RexxString *string = required_string(WORD, string);
652  RexxInteger *n = required_integer(WORD, n); /* position is required */
653  return string->word(n); /* do the word function */
654 }
655 
656 #define WORDINDEX_MIN 2
657 #define WORDINDEX_MAX 2
658 #define WORDINDEX_string 1
659 #define WORDINDEX_n 2
660 
661 BUILTIN(WORDINDEX)
662 {
663  fix_args(WORDINDEX); /* check on required number of args */
664  /* must have the first argument */
665  RexxString *string = required_string(WORDINDEX, string);
666  RexxInteger *n = required_integer(WORDINDEX, n); /* position is required */
667  return string->wordIndex(n); /* do the wordindex function */
668 }
669 
670 #define WORDLENGTH_MIN 2
671 #define WORDLENGTH_MAX 2
672 #define WORDLENGTH_string 1
673 #define WORDLENGTH_n 2
674 
675 BUILTIN(WORDLENGTH)
676 {
677  fix_args(WORDLENGTH); /* check on required number of args */
678  /* must have the first argument */
679  RexxString *string = required_string(WORDLENGTH, string);
680  RexxInteger *n = required_integer(WORDLENGTH, n); /* position is required */
681  return string->wordLength(n); /* do the wordlength function */
682 }
683 
684 #define COPIES_MIN 2
685 #define COPIES_MAX 2
686 #define COPIES_string 1
687 #define COPIES_n 2
688 
689 BUILTIN(COPIES)
690 {
691  fix_args(COPIES); /* check on required number of args */
692  /* must have the first argument */
693  RexxString *string = required_string(COPIES, string);
694  RexxInteger *n = required_integer(COPIES, n); /* position is required */
695  return string->copies(n); /* do the copies function */
696 }
697 
698 #define WORDPOS_MIN 2
699 #define WORDPOS_MAX 3
700 #define WORDPOS_phrase 1
701 #define WORDPOS_string 2
702 #define WORDPOS_start 3
703 
704 BUILTIN(WORDPOS)
705 {
706  fix_args(WORDPOS); /* check on required number of args */
707  /* must have a phrase string */
708  RexxString *phrase = required_string(WORDPOS, phrase);
709  /* must have the string argument */
710  RexxString *string = required_string(WORDPOS, string);
711  /* start position is optional */
712  RexxInteger *start = optional_integer(WORDPOS, start);
713  /* do the wordpos function */
714  return string->wordPos(phrase, start);
715 }
716 
717 #define WORDS_MIN 1
718 #define WORDS_MAX 1
719 #define WORDS_string 1
720 
721 BUILTIN(WORDS)
722 {
723  fix_args(WORDS); /* check on required number of args */
724  /* must have the string argument */
725  RexxString *string = required_string(WORDS, string);
726  return string->words(); /* do the words function */
727 }
728 
729 #define ABBREV_MIN 2
730 #define ABBREV_MAX 3
731 #define ABBREV_information 1
732 #define ABBREV_info 2
733 #define ABBREV_length 3
734 
735 BUILTIN(ABBREV)
736 {
737  fix_args(ABBREV); /* check on required number of args */
738  /* information must be a string arg */
739  RexxString *information = required_string(ABBREV, information);
740  RexxString *info = required_string(ABBREV, info);/* info must also be a string */
741  /* length is optional */
742  RexxInteger *length = optional_integer(ABBREV, length);
743  /* check on the abbreviation */
744  return information->abbrev(info, length);
745 }
746 
747 #define BITAND_MIN 1
748 #define BITAND_MAX 3
749 #define BITAND_string1 1
750 #define BITAND_string2 2
751 #define BITAND_pad 3
752 
753 BUILTIN(BITAND)
754 {
755  fix_args(BITAND); /* check on required number of args */
756  /* must have the first string */
757  RexxString *string1 = required_string(BITAND, string1);
758  /* second string is optional */
759  RexxString *string2 = optional_string(BITAND, string2);
760  RexxString *pad = optional_string(BITAND, pad); /* pad is optional also */
761  checkPadArgument(CHAR_BITAND, IntegerThree, pad);
762  return string1->bitAnd(string2, pad);/* do the bitand function */
763 }
764 
765 #define BITOR_MIN 1
766 #define BITOR_MAX 3
767 #define BITOR_string1 1
768 #define BITOR_string2 2
769 #define BITOR_pad 3
770 
771 BUILTIN(BITOR)
772 {
773  fix_args(BITOR); /* check on required number of args */
774  /* must have the first string */
775  RexxString *string1 = required_string(BITOR, string1);
776  /* second string is optional */
777  RexxString *string2 = optional_string(BITOR, string2);
778  RexxString *pad = optional_string(BITOR, pad); /* pad is optional also */
779  checkPadArgument(CHAR_BITOR, IntegerThree, pad);
780  return string1->bitOr(string2, pad); /* do the bitor function */
781 }
782 
783 #define BITXOR_MIN 1
784 #define BITXOR_MAX 3
785 #define BITXOR_string1 1
786 #define BITXOR_string2 2
787 #define BITXOR_pad 3
788 
789 BUILTIN(BITXOR)
790 {
791  fix_args(BITXOR); /* check on required number of args */
792  /* must have the first string */
793  RexxString *string1 = required_string(BITXOR, string1);
794  /* second string is optional */
795  RexxString *string2 = optional_string(BITXOR, string2);
796  RexxString *pad = optional_string(BITXOR, pad); /* pad is optional also */
797  checkPadArgument(CHAR_BITXOR, IntegerThree, pad);
798  return string1->bitXor(string2, pad);/* do the bitxor function */
799 }
800 
801 #define B2X_MIN 1
802 #define B2X_MAX 1
803 #define B2X_string 1
804 
806 {
807  fix_args(B2X); /* check on required number of args */
808  /* must have the first string */
809  RexxString *string = required_string(B2X, string);
810  return string->b2x(); /* do the b2x function */
811 }
812 
813 #define X2B_MIN 1
814 #define X2B_MAX 1
815 #define X2B_string 1
816 
818 {
819  fix_args(X2B); /* check on required number of args */
820  /* must have the first string */
821  RexxString *string = required_string(X2B, string);
822  return string->x2b(); /* do the x2b function */
823 }
824 
825 #define C2X_MIN 1
826 #define C2X_MAX 1
827 #define C2X_string 1
828 
830 {
831  fix_args(C2X); /* check on required number of args */
832  /* must have the first string */
833  RexxString *string = required_string(C2X, string);
834  return string->c2x(); /* do the c2x function */
835 }
836 
837 #define X2C_MIN 1
838 #define X2C_MAX 1
839 #define X2C_string 1
840 
842 {
843  fix_args(X2C); /* check on required number of args */
844  /* must have the first string */
845  RexxString *string = required_string(X2C, string);
846  return string->x2c(); /* do the x2c function */
847 }
848 
849 #define C2D_MIN 1
850 #define C2D_MAX 2
851 #define C2D_string 1
852 #define C2D_n 2
853 
855 {
856  fix_args(C2D); /* check on required number of args */
857  /* must have the first string */
858  RexxString *string = required_string(C2D, string);
859  RexxInteger *n = optional_integer(C2D, n); /* length is optional */
860  return string->c2d(n); /* do the c2d function */
861 }
862 
863 #define TRUNC_MIN 1
864 #define TRUNC_MAX 2
865 #define TRUNC_number 1
866 #define TRUNC_n 2
867 
868 BUILTIN(TRUNC)
869 {
870  fix_args(TRUNC); /* check on required number of args */
871  /* must have the first string */
872  RexxString *number = required_string(TRUNC, number);
873  RexxInteger *n = optional_integer(TRUNC, n); /* length is optional */
874  return number->trunc(n); /* do the trunc function */
875 }
876 
877 #define X2D_MIN 1
878 #define X2D_MAX 2
879 #define X2D_string 1
880 #define X2D_n 2
881 
883 {
884  fix_args(X2D); /* check on required number of args */
885  /* must have the first string */
886  RexxString *string = required_string(X2D, string);
887  RexxInteger *n = optional_integer(X2D, n); /* length is optional */
888  return string->x2d(n); /* do the x2d function */
889 }
890 
891 #define D2X_MIN 1
892 #define D2X_MAX 2
893 #define D2X_string 1
894 #define D2X_n 2
895 
897 {
898  fix_args(D2X); /* check on required number of args */
899  /* must have the first string */
900  RexxString *string = required_string(D2X, string);
901  RexxInteger *n = optional_integer(D2X, n); /* length is optional */
902  return string->d2x(n); /* do the x2d function */
903 }
904 
905 #define D2C_MIN 1
906 #define D2C_MAX 2
907 #define D2C_string 1
908 #define D2C_n 2
909 
911 {
912  fix_args(D2C); /* check on required number of args */
913  /* must have the first string */
914  RexxString *string = required_string(D2C, string);
915  RexxInteger *n = optional_integer(D2C, n); /* length is optional */
916  return string->d2c(n); /* do the x2d function */
917 }
918 
919 #define COMPARE_MIN 2
920 #define COMPARE_MAX 3
921 #define COMPARE_string1 1
922 #define COMPARE_string2 2
923 #define COMPARE_pad 3
924 
925 BUILTIN(COMPARE)
926 {
927  fix_args(COMPARE); /* check on required number of args */
928  /* must have the first string */
929  RexxString *string1 = required_string(COMPARE, string1);
930  /* and the second string also */
931  RexxString *string2 = required_string(COMPARE, string2);
932  RexxString *pad = optional_string(COMPARE, pad); /* padding is optional */
933  /* do the comparison */
934  checkPadArgument(CHAR_COMPARE, IntegerThree, pad);
935  return string1->compare(string2, pad);
936 }
937 
938 #define LENGTH_MIN 1
939 #define LENGTH_MAX 1
940 #define LENGTH_string 1
941 
942 BUILTIN(LENGTH)
943 {
944  fix_args(LENGTH); /* check on required number of args */
945  /* must have a string */
946  RexxString *target = required_string(LENGTH, string);
947  return target->lengthRexx(); /* get the length */
948 }
949 
950 #define TRANSLATE_MIN 1
951 #define TRANSLATE_MAX 6
952 #define TRANSLATE_string 1
953 #define TRANSLATE_tableo 2
954 #define TRANSLATE_tablei 3
955 #define TRANSLATE_pad 4
956 #define TRANSLATE_start 5
957 #define TRANSLATE_range 6
958 
959 BUILTIN(TRANSLATE)
960 {
961  fix_args(TRANSLATE); /* check on required number of args */
962  /* must have a string */
963  RexxString *string = required_string(TRANSLATE, string);
964  /* output table is optional */
965  RexxString *tableo = optional_string(TRANSLATE, tableo);
966  /* input table is optional */
967  RexxString *tablei = optional_string(TRANSLATE, tablei);
968  /* pad is also optional */
969  RexxString *pad = optional_string(TRANSLATE, pad);
970  /* perform the translate */
971  checkPadArgument(CHAR_TRANSLATE, IntegerFour, pad);
972  RexxInteger *start = optional_integer(TRANSLATE, start);
973  RexxInteger *range = optional_integer(TRANSLATE, range);
974  return string->translate(tableo, tablei, pad, start, range);
975 }
976 
977 #define VERIFY_MIN 2
978 #define VERIFY_MAX 5
979 #define VERIFY_string 1
980 #define VERIFY_reference 2
981 #define VERIFY_option 3
982 #define VERIFY_start 4
983 #define VERIFY_range 5
984 
985 BUILTIN(VERIFY)
986 {
987  fix_args(VERIFY); /* check on required number of args */
988  /* must have a string */
989  RexxString *string = required_string(VERIFY, string);
990  /* reference is also required */
991  RexxString *reference = required_string(VERIFY, reference);
992  /* the options are optional */
993  RexxString *option = optional_string(VERIFY, option);
994  /* start is optional */
995  RexxInteger *start = optional_integer(VERIFY, start);
996  /* start is optional */
997  RexxInteger *range = optional_integer(VERIFY, range);
998  /* do the verify function */
999  return string->verify(reference, option, start, range);
1000 }
1001 
1002 #define DATATYPE_MIN 1
1003 #define DATATYPE_MAX 2
1004 #define DATATYPE_string 1
1005 #define DATATYPE_type 2
1006 
1007 BUILTIN(DATATYPE)
1008 {
1009  fix_args(DATATYPE); /* check on required number of args */
1010  /* must have a string */
1011  RexxString *string = required_string(DATATYPE, string);
1012  /* type must also be a string */
1013  RexxString *type = optional_string(DATATYPE, type);
1014  return string->dataType(type); /* call the datatype method */
1015 }
1016 
1017 #define ADDRESS_MIN 0
1018 #define ADDRESS_MAX 0
1019 
1020 BUILTIN(ADDRESS)
1021 {
1022  check_args(ADDRESS); /* check on required number of args */
1023  return context->getAddress(); /* return the current address setting*/
1024 }
1025 
1026 #define DIGITS_MIN 0
1027 #define DIGITS_MAX 0
1028 
1029 BUILTIN(DIGITS)
1030 {
1031  check_args(DIGITS); /* check on required number of args */
1032  return new_integer(context->digits()); /* return as an option */
1033 }
1034 
1035 #define FUZZ_MIN 0
1036 #define FUZZ_MAX 0
1037 
1038 BUILTIN(FUZZ)
1039 {
1040  check_args(FUZZ); /* check on required number of args */
1041  return new_integer(context->fuzz()); /* return as an integer object */
1042 }
1043 
1044 #define FORM_MIN 0
1045 #define FORM_MAX 0
1046 
1047 BUILTIN(FORM)
1048 {
1049  check_args(FORM); /* check on required number of args */
1050  /* return the current form setting */
1051  return context->form() == Numerics::FORM_SCIENTIFIC ? OREF_SCIENTIFIC : OREF_ENGINEERING;
1052 }
1053 
1054 #define USERID_MIN 0
1055 #define USERID_MAX 0
1056 
1057 BUILTIN(USERID)
1058 {
1059  check_args(USERID);
1061 }
1062 
1063 #define ERRORTEXT_MIN 1
1064 #define ERRORTEXT_MAX 1
1065 #define ERRORTEXT_n 1
1066 
1067 BUILTIN(ERRORTEXT)
1068 {
1069  check_args(ERRORTEXT); /* check on required number of args */
1070  /* get the error number */
1071  wholenumber_t error_number = (required_integer(ERRORTEXT, n))->getValue();
1072  /* outside allowed range? */
1073  if (error_number < 0 || error_number > 99)
1074  {
1075  /* this is an error */
1076  reportException(Error_Incorrect_call_range, CHAR_ERRORTEXT, OREF_positional, IntegerOne, error_number);
1077  }
1078  /* retrieve the major error message */
1079  RexxString *result = SystemInterpreter::getMessageText(error_number * 1000);
1080  if (result == OREF_NULL) /* not found? */
1081  {
1082  result = OREF_NULLSTRING; /* this is a null string result */
1083  }
1084  return result; /* finished */
1085 }
1086 
1087 #define ARG_MIN 0
1088 #undef ARG_MAX /* In AIX already defined */
1089 #define ARG_MAX 2
1090 #define ARG_n 1
1091 #define ARG_option 2
1092 
1094 {
1095  fix_args(ARG); /* expand arguments to full value */
1096  RexxInteger *n = optional_integer(ARG, n); /* get the position info */
1097  /* get the option string */
1098  RexxString *option = optional_string(ARG, option);
1099  /* get the argument array */
1100  RexxObject **arglist = context->getMethodArgumentList();
1101  size_t size = context->getMethodArgumentCount();
1102  /* have an option but no position? */
1103  if (n == OREF_NULL)
1104  { /* no position specified? */
1105  if (option != OREF_NULL) /* have an option with no position */
1106  {
1107  /* raise an error */
1108  reportException(Error_Incorrect_call_noarg, CHAR_ARG, OREF_positional, IntegerOne);
1109  }
1110  /* return the count as an object */
1111  return new_integer(size);
1112  }
1113  else if (option == OREF_NULL)
1114  { /* just looking for a specific arg? */
1115  size_t position = n->getValue(); /* get the integer value */
1116  /* must be a positive integer */
1117  positive_integer(position, ARG, IntegerOne);
1118  /* bigger than argument list size? */
1119  if (size < position)
1120  {
1121  return OREF_NULLSTRING; /* just return a null string */
1122  }
1123  else
1124  {
1125  RexxObject *result = arglist[position - 1]; /* get actual value from arglist */
1126  if (result == OREF_NULL) /* argument wasn't there? */
1127  {
1128  return OREF_NULLSTRING; /* this too is a null string */
1129  }
1130  return result; // return the argument stuff
1131  }
1132  }
1133  else
1134  { /* need to process an option */
1135  size_t position = n->getValue(); /* get the integer value */
1136  /* must be a positive integer */
1137  positive_integer(position, ARG, IntegerOne);
1138 
1139  switch (option->getCharC(0))
1140  { /* process the option character */
1141 
1142  case 'A': /* return argument array */
1143  case 'a': /* return argument array */
1144  if (position == 1)
1145  { /* want it all? */
1146  /* create an array result for the return */
1147  return new (size, arglist) RexxArray;
1148  }
1149  else if (position > size) /* beyond bounds of argument list? */
1150  {
1151  /* this is a zero size array */
1152  return TheNullArray->copy();
1153  }
1154  else
1155  { /* need to extract a sub array */
1156  return new (size - position + 1, &arglist[position - 1]) RexxArray;
1157  }
1158  break;
1159 
1160  case 'E': /* argument 'E'xist? */
1161  case 'e': /* argument 'E'xist? */
1162  if (position > size) /* too big for argument list? */
1163  {
1164  return TheFalseObject; /* can't be true */
1165  }
1166  /* have a real argument? */
1167  else if (arglist[position - 1] == OREF_NULL)
1168  {
1169  return TheFalseObject; /* nope, this is false also */
1170  }
1171  else
1172  {
1173  return TheTrueObject; /* have a real argument */
1174  }
1175  break;
1176 
1177  case 'O': /* argument 'O'mitted? */
1178  case 'o': /* argument 'O'mitted? */
1179  if (position > size) /* too big for argument list? */
1180  {
1181  return TheTrueObject; /* must be omitted */
1182  }
1183  /* have a real argument? */
1184  else if (arglist[position - 1] == OREF_NULL)
1185  {
1186  return TheTrueObject; /* this is omitted also */
1187  }
1188  else
1189  {
1190  return TheFalseObject; /* have a real argument */
1191  }
1192  break;
1193 
1194  case 'N': /* 'N'ormal processing? */
1195  case 'n': /* 'N'ormal processing? */
1196  if (position > size) /* bigger than argument list size? */
1197  {
1198  return OREF_NULLSTRING; /* just return a null string */
1199  }
1200  else
1201  { /* get actual value from arglist */
1202  RexxObject *result = arglist[position - 1];
1203  if (result == OREF_NULL) /* argument wasn't there? */
1204  {
1205  return OREF_NULLSTRING; /* this too is a null string */
1206  }
1207  return result;
1208  }
1209  break;
1210 
1211  default: /* unknown option */
1212  /* this is an error */
1213  reportException(Error_Incorrect_call_list, CHAR_ARG, OREF_positional, IntegerTwo, "AENO", option);
1214  break;
1215  }
1216  }
1217  return OREF_NULLSTRING; // should never happen
1218 }
1219 
1220 
1221 #define DATE_MIN 0
1222 #define DATE_MAX 5
1223 #define DATE_option 1
1224 #define DATE_indate 2
1225 #define DATE_option2 3
1226 #define DATE_osep 4
1227 #define DATE_isep 5
1228 
1229 BUILTIN(DATE)
1230 {
1231  char work[30]; /* temporary work */
1232 
1233  fix_args(DATE); /* expand arguments to full value */
1234 
1235  // get the arguments
1236  RexxString *option = optional_string(DATE, option);
1237  RexxString *indate = optional_string(DATE, indate);
1238  RexxString *option2 = optional_string(DATE, option2);
1239  RexxString *osep = optional_string(DATE, osep);
1240  RexxString *isep = optional_string(DATE, isep);
1241 
1242  // get a copy of the current activation time. This will ensure
1243  // a consistent timestamp across calls
1244  RexxDateTime current = context->getTime();
1245  // by default, we operator off of the current time. We may end up
1246  // overwriting this
1247  RexxDateTime timestamp = current;
1248 
1249  // default for both input and output styles is 'N'ormal
1250  int style = 'N';
1251  int style2 = 'N';
1252 
1253  // now process the various option specifiers
1254  if (option != OREF_NULL) /* just using default format? */
1255  {
1256  if (option->getBLength() == 0) /* have a null string? */
1257  {
1258  /* this is an error */
1259  reportException(Error_Incorrect_call_list, CHAR_DATE, OREF_positional, IntegerOne, "BDEFLMNOSTUW", option);
1260  }
1261  else /* need to process an option */
1262  {
1263  /* option is first character */
1264  style = toupper(option->getCharC(0));
1265  }
1266  }
1267 
1268  /* opt2 or isep w/o date? */
1269  if (indate == OREF_NULL && (option2 != OREF_NULL || isep != OREF_NULL))
1270  {
1271  /* this is an error */
1272  reportException(Error_Incorrect_call_noarg, CHAR_DATE, OREF_positional, IntegerTwo);
1273  }
1274 
1275  if (option2 != OREF_NULL) /* just using default format? */
1276  {
1277  if (option2->getBLength() == 0) /* have a null string? */
1278  {
1279  /* this is an error */
1280  reportException(Error_Incorrect_call_list, CHAR_DATE, OREF_positional, IntegerThree, "BDEFNOSTU", option2);
1281  }
1282  else /* need to process an option */
1283  {
1284  /* option is first character */
1285  style2 = toupper(option2->getCharC(0));
1286  }
1287  }
1288 
1289  const char *outputSeparator = NULL; // each format has it's own default
1290 
1291  // validate the output separator is only used with supported styles
1292  if (osep != OREF_NULL)
1293  {
1294  // only certain styles support this option
1295  if (strchr("BDMWL", style) != NULL)
1296  {
1297  reportException(Error_Incorrect_call_format_incomp_sep, CHAR_DATE, OREF_positional, IntegerOne, new_string((char)style), IntegerFour);
1298  }
1299  if (osep->getBLength() > 1 || (osep->getBLength() == 1 && strchr(ALPHANUM, osep->getCharC(0)) != NULL))
1300  {
1301  reportException(Error_Incorrect_call_parm_wrong_sep, CHAR_DATE, OREF_positional, IntegerFour, osep);
1302  }
1303  // string objects are null terminated, so we can point directly at what will
1304  // be either 1 or 0 characters of data.
1305  outputSeparator = osep->getStringData();
1306  }
1307 
1308  if (indate != OREF_NULL) /* given a time stamp? */
1309  {
1310  bool valid = true; /* assume have a good stamp */
1311 
1312  const char *separator = NULL; // different formats will override this
1313  /* begin addition */
1314  // if we have a separator, perform validation here
1315  if (isep != OREF_NULL)
1316  {
1317  if (strchr("BDMWL", style2) != NULL)
1318  {
1319  reportException(Error_Incorrect_call_format_incomp_sep, CHAR_DATE, OREF_positional, IntegerThree, new_string((char *)&style2, 1), IntegerFive);
1320  }
1321  // explicitly specified delimiter, we need to validate this first
1322  if (isep->getBLength() > 1 || (isep->getBLength() == 1 && strchr(ALPHANUM, isep->getCharC(0)) != NULL))
1323  {
1324  // the field delimiter must be a single character and NOT
1325  // alphanumeric, or a null character
1326  reportException(Error_Incorrect_call_parm_wrong_sep, new_string(CHAR_DATE), OREF_positional, IntegerFive, isep);
1327  }
1328  // string objects are null terminated, so we can point directly at what will
1329  // be either 1 or 0 characters of data.
1330  separator = isep->getStringData();
1331  }
1332 
1333  /* clear the time stamp */
1334  timestamp.clear();
1335  // everything is done using the current timezone offset
1336  timestamp.setTimeZoneOffset(current.getTimeZoneOffset());
1337  switch (style2)
1338  { /* convert to usable form per option2*/
1339 
1340  case 'N': /* 'N'ormal: default style */
1341  valid = timestamp.parseNormalDate(indate->getStringData(), separator);
1342  break;
1343 
1344  case 'B': /* 'B'asedate */
1345  {
1346  /*convert the value */
1347  wholenumber_t basedays;
1348  if (!indate->numberValue(basedays) || !timestamp.setBaseDate(basedays))
1349  {
1350  reportException(Error_Incorrect_call_format_invalid, CHAR_DATE, OREF_positional, indate, new_string((char *)&style2, 1));
1351  }
1352  break;
1353  }
1354 
1355  case 'F': /* 'F'ull datetime stamp */
1356  {
1357  /*convert the value */
1358  int64_t basetime;
1359  if (!Numerics::objectToInt64(indate, basetime) || !timestamp.setBaseTime(basetime))
1360  {
1361  reportException(Error_Incorrect_call_format_invalid, CHAR_DATE, OREF_positional, indate, new_string((char *)&style2, 1));
1362  }
1363  break;
1364  }
1365 
1366  case 'T': /* 'T'icks datetime stamp */
1367  {
1368  /*convert the value */
1369  int64_t basetime;
1370  if (!Numerics::objectToInt64(indate, basetime) || !timestamp.setUnixTime(basetime))
1371  {
1372  reportException(Error_Incorrect_call_format_invalid, CHAR_DATE, OREF_positional, indate, new_string((char *)&style2, 1));
1373  }
1374  break;
1375  }
1376 
1377  case 'D': /* 'D'ay of year */
1378  {
1379  /*convert the value */
1380  wholenumber_t yearday;
1381  if (!indate->numberValue(yearday) || yearday < 0 || yearday > YEAR_DAYS + 1 ||
1382  (yearday > YEAR_DAYS && !LeapYear(current.year)))
1383  {
1384  reportException(Error_Incorrect_call_format_invalid, CHAR_DATE, OREF_positional, indate, new_string((char *)&style2, 1));
1385  }
1386  // set the date directly
1387  timestamp.setDate(current.year, yearday);
1388  break;
1389  }
1390 
1391  case 'E': /* 'E'uropean format: days-month-year*/
1392  valid = timestamp.parseEuropeanDate(indate->getStringData(), separator, current.year);
1393  break;
1394 
1395  case 'O': /* 'O'rdered format: year-month-day */
1396  valid = timestamp.parseOrderedDate(indate->getStringData(), separator, current.year);
1397  break;
1398 
1399  case 'S': /* 'S'tandard format (ISO date) */
1400  valid = timestamp.parseStandardDate(indate->getStringData(), separator);
1401  break;
1402 
1403  case 'U': /* 'U'SA format: month-day-year */
1404  valid = timestamp.parseUsaDate(indate->getStringData(), separator, current.year);
1405  break;
1406 
1407  default:
1408  reportException(Error_Incorrect_call_list, CHAR_DATE, OREF_positional, IntegerThree, "BDEFNOTSU", new_string((char *)&style2, 1));
1409  break;
1410  }
1411  // if there's a formatting error
1412  if (!valid)
1413  {
1414  // different error message depending on whether a separator was specified, or not.
1415  if (isep != OREF_NULL)
1416  {
1417  reportException(Error_Incorrect_call_format_incomp_sep, CHAR_DATE, OREF_positional, IntegerTwo, indate, IntegerFive);
1418  }
1419  else
1420  {
1421  reportException(Error_Incorrect_call_format_invalid, CHAR_DATE, OREF_positional, indate, new_string((char *)&style2, 1));
1422  }
1423  }
1424  }
1425  else
1426  {
1427  // just copy the current time stamp
1428  timestamp = current;
1429  }
1430 
1431  wholenumber_t day = timestamp.day; /* get various date parts */
1432  wholenumber_t month = timestamp.month;
1433  wholenumber_t year = timestamp.year;
1434 
1435  switch (style)
1436  { /* process the various styles */
1437 
1438  case 'B': /* 'B'asedate */
1439  timestamp.formatBaseDate(work);
1440  break;
1441 
1442  case 'F': /* 'F'asedate */
1443  timestamp.formatBaseTime(work);
1444  break;
1445 
1446  case 'T': /* 'F'asedate */
1447  timestamp.formatUnixTime(work);
1448  break;
1449 
1450  case 'D': /* 'D'ays */
1451  timestamp.formatDays(work);
1452  break;
1453 
1454  case 'E': /* 'E'uropean */
1455  timestamp.formatEuropeanDate(work, outputSeparator);
1456  break;
1457 
1458  case 'L': /* 'L'ocal */
1459  {
1460  /* get the month name */
1462  /* format as a date */
1463  sprintf(work, "%ld %s %4.4ld", day, month_name->getStringData(), year);
1464  break;
1465 
1466  }
1467 
1468  case 'M': /* 'M'onth */
1469  timestamp.formatMonthName(work);
1470  break;
1471 
1472  case 'N': /* 'N'ormal -- default format */
1473  timestamp.formatNormalDate(work, outputSeparator);
1474  break;
1475 
1476  case 'O': /* 'O'rdered */
1477  timestamp.formatOrderedDate(work, outputSeparator);
1478  break;
1479 
1480  case 'S': /* 'S'tandard format (ISO dates) */
1481  timestamp.formatStandardDate(work, outputSeparator);
1482  break;
1483 
1484  case 'U': /* 'U'SA */
1485  timestamp.formatUsaDate(work, outputSeparator);
1486  break;
1487 
1488  case 'W': /* 'W'eekday */
1489  timestamp.formatWeekDay(work);
1490  break;
1491 
1492  default: /* unrecognized */
1493  work[0] = style; /* copy over the character */
1494  reportException(Error_Incorrect_call_list, CHAR_DATE, OREF_positional, IntegerOne, "BDEFLMNOSTUW", new_string(work, 1));
1495  break;
1496  }
1497  /* now create a string object */
1498  return new_string(work);
1499 }
1500 
1501 
1502 #define TIME_MIN 0
1503 #define TIME_MAX 3
1504 #define TIME_option 1
1505 #define TIME_intime 2
1506 #define TIME_option2 3
1507 
1508 BUILTIN(TIME)
1509 {
1510  char work[30]; /* temporary work */
1511 
1512  fix_args(TIME); /* expand arguments to full value */
1513  /* get the option string */
1514  RexxString *option = optional_string(TIME, option);
1515  /* the input date */
1516  RexxString *intime = optional_string(TIME, intime);
1517  /* input date format */
1518  RexxString *option2 = optional_string(TIME, option2);
1519  RexxDateTime current = context->getTime(); /* get the current activation time */
1520  RexxDateTime timestamp = current; // and by default we work off of that time
1521  int style = 'N'; // get the default style
1522 
1523  // do we have a style option specified? Validate, and retrieve
1524  if (option != OREF_NULL)
1525  {
1526  // null strings not allowed as an option character
1527  if (option->getBLength() == 0)
1528  {
1529  reportException(Error_Incorrect_call_list, CHAR_TIME, OREF_positional, IntegerOne, "CEFHLMNORST", option);
1530  }
1531  // we only use the first character
1532  style = toupper(option->getCharC(0));
1533  }
1534 
1535  // now repeat with the second style
1536  int style2 = 'N';
1537 
1538  // has the input style been specified?
1539  if (option2 != OREF_NULL)
1540  {
1541  // the second option requires an input date
1542  if (intime == OREF_NULL)
1543  {
1544  reportException(Error_Incorrect_call_noarg, CHAR_TIME, OREF_positional, IntegerTwo);
1545  }
1546  // again, must be at least one character, of which we only use the first
1547  if (option2->getBLength() == 0)
1548  {
1549  reportException(Error_Incorrect_call_list, CHAR_TIME, OREF_positional, IntegerThree, "CFHLMNOST", option2);
1550  }
1551  style2 = toupper(option2->getCharC(0));
1552  }
1553 
1554 
1555  if (intime != OREF_NULL)
1556  {
1557  // the input timestamp is not valid with the elapsed time options, and
1558  // using an offset as an input isn't really meaningful
1559  if (style == 'R' || style == 'E')
1560  {
1561  reportException(Error_Incorrect_call_invalid_conversion, CHAR_TIME, new_string((char *)&style, 1));
1562  }
1563  bool valid = true; // assume this is a good timestamp
1564  timestamp.clear(); // clear everything out
1565  // everything is done using the current timezone offset
1566  timestamp.setTimeZoneOffset(current.getTimeZoneOffset());
1567 
1568  switch (style2)
1569  {
1570  // default style, 01:23:45 format (24 hour)
1571  case 'N':
1572  valid = timestamp.parseNormalTime(intime->getStringData());
1573  break;
1574 
1575  // 'C'ivil time, 1:23pm format (12-hour, no zero)
1576  case 'C':
1577  valid = timestamp.parseCivilTime(intime->getStringData());
1578  break;
1579 
1580  // 'L'ong time, full 24-hour, plus fractional
1581  case 'L':
1582  valid = timestamp.parseLongTime(intime->getStringData());
1583  break;
1584 
1585  case 'H': /* 'H'ours format */
1586  {
1587  wholenumber_t i;
1588  valid = intime->numberValue(i) && timestamp.setHours(i);
1589  break;
1590  }
1591 
1592  case 'S': /* 'S'econds format */
1593  {
1594  wholenumber_t i;
1595  valid = intime->numberValue(i) && timestamp.setSeconds(i);
1596  break;
1597  }
1598 
1599  case 'M': /* 'M'inutes format */
1600  {
1601  wholenumber_t i;
1602  valid = intime->numberValue(i) && timestamp.setMinutes(i);
1603  break;
1604  }
1605 
1606  case 'F': /* 'F'ull datetime stamp */
1607  {
1608  /*convert the value */
1609  int64_t basetime;
1610  if (!Numerics::objectToInt64(intime, basetime) || !timestamp.setBaseTime(basetime))
1611  {
1612  reportException(Error_Incorrect_call_format_invalid, CHAR_TIME, OREF_positional, intime, new_string((char *)&style2, 1));
1613  }
1614  break;
1615  }
1616 
1617  case 'T': /* 'T'icks datetime stamp */
1618  {
1619  /*convert the value */
1620  int64_t basetime;
1621  if (!Numerics::objectToInt64(intime, basetime) || !timestamp.setUnixTime(basetime))
1622  {
1623  reportException(Error_Incorrect_call_format_invalid, CHAR_TIME, OREF_positional, intime, new_string((char *)&style2, 1));
1624  }
1625  break;
1626  }
1627 
1628  case 'O': // 'O'ffset. microseconds offset from UTC
1629  {
1630  // everything comes from the current time stamp, but we will adjust to the new offset
1631  timestamp = current; // and by default we work off of that time
1632  wholenumber_t i;
1633  valid = intime->numberValue(i) && timestamp.adjustTimeZone(i);
1634  break;
1635 
1636  }
1637 
1638  default:
1639  work[0] = style2; /* copy over the character */
1640  reportException(Error_Incorrect_call_list, CHAR_TIME, OREF_positional, IntegerThree, "CFHLMNOST", new_string(work, 1));
1641  break;
1642  }
1643  if (!valid) /* not convert cleanly? */
1644  {
1645  reportException(Error_Incorrect_call_format_invalid, CHAR_TIME, OREF_positional, intime, new_string((char *)&style2, 1) );
1646  }
1647  }
1648 
1649  switch (style)
1650  { /* process the styles */
1651 
1652  case 'E': /* 'E'lapsed time */
1653  case 'R': /* 'R'eset elapsed time */
1654  {
1655  /* get the current elapsed time */
1656  int64_t startTime = context->getElapsed();
1657  // substract the time values
1658  int64_t threshold = current.getUTCBaseTime() - startTime;
1659  if (threshold < 0)
1660  {
1661  strcpy(work, "0"); /* just return zero */
1662  context->resetElapsed(); /* reset the clock for next time */
1663  } /* times equal? */
1664  else if (threshold == 0)
1665  {
1666  strcpy(work, "0"); /* just return zero */
1667  }
1668  else
1669  {
1670  // format as a long time
1671  sprintf(work, "%d.%06d", (int)(threshold / (int64_t)MICROSECONDS), (int)(threshold % (int64_t)MICROSECONDS));
1672  }
1673  /* format the result */
1674  if (style == 'R') /* is this a reset call? */
1675  {
1676  context->resetElapsed(); /* reset the clock for next time */
1677  }
1678  break;
1679  }
1680 
1681  case 'C': /* 'C'ivil time */
1682  timestamp.formatCivilTime(work);
1683  break;
1684 
1685  case 'H': /* 'Hours' */
1686  timestamp.formatHours(work);
1687  break;
1688 
1689  case 'L': /* 'L'ong format */
1690  timestamp.formatLongTime(work);
1691  break;
1692 
1693  case 'M': /* 'M'inutes format */
1694  timestamp.formatMinutes(work);
1695  break;
1696 
1697  case 'N': /* 'N'ormal format...the default */
1698  timestamp.formatNormalTime(work);
1699  break;
1700 
1701  case 'S': /* 'S'econds format...total seconds */
1702  timestamp.formatSeconds(work);
1703  break;
1704 
1705  case 'F': /* 'F'ull */
1706  timestamp.formatBaseTime(work);
1707  break;
1708 
1709  case 'T': /* 'T'icks */
1710  timestamp.formatUnixTime(work);
1711  break;
1712 
1713  case 'O': // 'O'ffset. microseconds offset from UTC
1714  timestamp.formatTimeZone(work);
1715  break;
1716 
1717  default: /* unknown format */
1718  work[0] = style; /* copy over the character */
1719  reportException(Error_Incorrect_call_list, CHAR_TIME, OREF_positional, IntegerOne, "CEFHLMNORST", new_string(work, 1));
1720  break;
1721  }
1722  /* now create a string object */
1723  return new_string(work);
1724 }
1725 
1726 #define RANDOM_MIN 0
1727 #define RANDOM_MAX 3
1728 #define RANDOM_minimum 1
1729 #define RANDOM_maximum 2
1730 #define RANDOM_seed 3
1731 
1732 BUILTIN(RANDOM)
1733 {
1734  RexxInteger *minimum; /* RANDOM minimum value */
1735  RexxInteger *maximum; /* RANDOM maximum value */
1736 
1737  fix_args(RANDOM); /* expand arguments to full value */
1738  // we need a special case here. the interpretation of Random is such that
1739  // random() is NOT the same as Random(,).
1740  if (argcount == 2 && arg_omitted(RANDOM, minimum) && arg_omitted(RANDOM, maximum))
1741  {
1742  minimum = IntegerZero;
1743  maximum = new_integer(999);
1744  }
1745  else
1746  {
1747  /* get the minimum value */
1748  minimum = optional_integer(RANDOM, minimum);
1749  /* get the maximum value */
1750  maximum = optional_integer(RANDOM, maximum);
1751  }
1752  /* get the seed value */
1753  RexxInteger *seed = optional_integer(RANDOM, seed);
1754  /* have the activation generate */
1755  return context->random(minimum, maximum, seed);
1756 }
1757 
1758 #define XRANGE_MIN 0
1759 #define XRANGE_MAX 2
1760 #define XRANGE_start 1
1761 #define XRANGE_end 2
1762 
1763 BUILTIN(XRANGE)
1764 {
1765  fix_args(XRANGE); /* expand arguments to full value */
1766  codepoint_t startchar = 0; /* set default start position */
1767  codepoint_t endchar = (char)0xff; /* set default end position */
1768 
1769  /* get the starting string */
1770  RexxString *start = optional_string(XRANGE, start);
1771  RexxString *end = optional_string(XRANGE, end); /* get the ending string */
1772 
1773  if (start != OREF_NULL)
1774  { /* have a start position */
1775  if (start->getBLength() != 1) /* not a single character? */
1776  {
1777  /* have an error */
1778  reportException(Error_Incorrect_call_pad, CHAR_XRANGE, OREF_positional, IntegerOne, start);
1779  }
1780  startchar = start->getCharC(0); /* get the new start position */
1781  }
1782  if (end != OREF_NULL)
1783  { /* have an end position */
1784  if (end->getBLength() != 1) /* not a single character? */
1785  {
1786  /* have an error */
1787  reportException(Error_Incorrect_call_pad, CHAR_XRANGE, OREF_positional, IntegerTwo, end);
1788  }
1789  endchar = end->getCharC(0); /* get the new end position */
1790  }
1791  /* calculate result size */
1792  size_t length = ((endchar < startchar) ? (256 - startchar) + endchar : (endchar - startchar)) + 1;
1793  RexxString *result = raw_string(length); /* get a result string */
1794  for (size_t i = 0; i < length; i++) /* loop through result length */
1795  {
1796  result->putCharB(i, startchar++); /* inserting each character */ // todo m17n : no putCharC yet... probably not needed here, unless the end range is > 255
1797  }
1798  return result; /* finished */
1799 }
1800 
1801 #define SYMBOL_MIN 1
1802 #define SYMBOL_MAX 1
1803 #define SYMBOL_name 1
1804 
1805 BUILTIN(SYMBOL)
1806 {
1807  fix_args(SYMBOL); /* expand arguments to full value */
1808  /* get the variable name */
1809  RexxString *name = required_string(SYMBOL, name);
1810  /* get a variable retriever */
1812  if (variable == OREF_NULL) /* invalid variable name? */
1813  {
1814  /* return the 'BAD' result */
1815  return new_string(CHAR_BAD);
1816  }
1817  else if (isOfClass(String, variable)) /* directly returned a string? */
1818  {
1819  /* this is a literal value */
1820  return new_string(CHAR_LIT);
1821  }
1822  else
1823  { /* need to perform lookup */
1824  /* see if variable has a value */
1825  if (!variable->exists(context))
1826  {
1827  /* this is a literal value */
1828  return new_string(CHAR_LIT);
1829  }
1830  else
1831  {
1832  /* this is a variable value */
1833  return new_string(CHAR_VAR);
1834  }
1835  }
1836 }
1837 
1838 #define VAR_MIN 1
1839 #define VAR_MAX 1
1840 #define VAR_name 1
1841 
1843 {
1844  fix_args(VAR); /* expand arguments to full value */
1845  /* get the variable name */
1846  RexxString *variable = required_string(VAR, name);
1847  /* get a variable retriever */
1849  if (retriever == OREF_NULL) /* invalid variable name? */
1850  {
1851  return TheFalseObject; /* return the 'BAD' result */
1852  }
1853  else if (isOfClass(String, retriever)) /* directly returned a string? */
1854  {
1855  return TheFalseObject; /* this doesn't exist either */
1856  }
1857  else
1858  { /* need to perform lookup */
1859  /* get the variable value */
1860  return retriever->exists(context) ? TheTrueObject : TheFalseObject;
1861  }
1862 }
1863 
1864 #define VALUE_MIN 1
1865 #define VALUE_MAX 3
1866 #define VALUE_name 1
1867 #define VALUE_newValue 2
1868 #define VALUE_selector 3
1869 
1870 BUILTIN(VALUE)
1871 {
1872  fix_args(VALUE); /* expand arguments to full value */
1873  /* get the variable name */
1874  RexxString *variable = required_string(VALUE, name);
1875  /* get the new value */
1876  RexxObject *newvalue = optional_argument(VALUE, newValue);
1877  /* and the selector */
1878  RexxString *selector = optional_string(VALUE, selector);
1879  // get the variable type
1880  int variableType = variable->isSymbol();
1881  bool assignable = variableType == STRING_NAME || variableType == STRING_STEM || variableType == STRING_COMPOUND_NAME;
1882 
1883  if (selector == OREF_NULL) /* have a selector? */
1884  {
1885  /* get a variable retriever */
1887  // this could an invalid name, or we might be trying to assign a value to a non-variable
1888  // symbol.
1889  if (retriever == OREF_NULL || (newvalue != OREF_NULL && !assignable))
1890  {
1891  reportException(Error_Incorrect_call_symbol, CHAR_VALUE, OREF_positional, IntegerOne, variable);
1892  }
1893  /* get the variable value */
1894  RexxObject *result = retriever->getValue(context);
1895  if (newvalue != OREF_NULL) /* have a new value to assign? */
1896  {
1897  /* do the assignment */
1898  retriever->assign(context, stack, newvalue);
1899  }
1900  return result; /* return the indicator */
1901  }
1902  else if (selector->getBLength() == 0) /* null string selector? */
1903  {
1904  /* get the existing value */
1905  RexxObject *result = TheEnvironment->entry(variable);
1906  if (result == OREF_NULL) /* not in the environment? */
1907  {
1908  /* turn into ".VARIABLE" as value */
1909  variable = variable->upper();
1910  ProtectedObject p(variable);
1911  result = ((RexxString *)OREF_PERIOD)->concat(variable);
1912  }
1913  if (newvalue != OREF_NULL) /* have a new value? */
1914  {
1915  /* do the set also */
1916  TheEnvironment->setEntry(variable, newvalue);
1917  }
1918  return result; /* return the indicator */
1919  }
1920  else /* external value function */
1921  {
1922  RexxObject *result;
1923  // try the platform defined selectors.
1924  if (SystemInterpreter::valueFunction(variable, newvalue, selector, result))
1925  {
1926  return result;
1927  }
1928  // if the exit passes on this, try the platform-defined selectors
1929  if (!context->getActivity()->callValueExit(context, selector, variable, newvalue, result))
1930  {
1931  return result;
1932  }
1933  // this is an exception
1935  }
1936  return OREF_NULL; // should never reach here
1937 }
1938 
1939 #define ABS_MIN 1
1940 #define ABS_MAX 1
1941 #define ABS_n 1
1942 
1944 {
1945  fix_args(ABS); /* check on required number of args */
1946  /* get the argument in question */
1947  RexxObject *argument = get_arg(ABS, n);
1948  if (isOfClass(Integer, argument))
1949  { /* integer object already? */
1950  /* we can process this without conversion */
1951  return((RexxInteger *)argument)->abs();
1952  }
1953  else if (isOfClass(NumberString, argument))
1954  { /* how about already numeric? */
1955  /* we can process this without conversion */
1956  return((RexxNumberString *)argument)->abs();
1957  }
1958  /* force to a string object */
1959  RexxString *n = required_string(ABS, n);
1960  return n->abs(); /* invoke the string ABS function */
1961 }
1962 
1963 #define SIGN_MIN 1
1964 #define SIGN_MAX 1
1965 #define SIGN_n 1
1966 
1967 BUILTIN(SIGN)
1968 {
1969  fix_args(SIGN); /* check on required number of args */
1970  /* get the argument in question */
1971  RexxObject *argument = get_arg(SIGN, n);
1972  if (isOfClass(Integer, argument))
1973  { /* integer object already? */
1974  /* we can process this without conversion */
1975  return((RexxInteger *)argument)->sign();
1976  }
1977  else if (isOfClass(NumberString, argument))
1978  { /* how about already numeric? */
1979  /* we can process this without conversion */
1980  return((RexxNumberString *)argument)->Sign();
1981  }
1982  /* force to a string object */
1983  RexxString *n = required_string(SIGN, n);
1984  return n->sign(); /* invoke the string SIGN function */
1985 }
1986 
1987 #define FORMAT_MIN 1
1988 #define FORMAT_MAX 5
1989 #define FORMAT_number 1
1990 #define FORMAT_before 2
1991 #define FORMAT_after 3
1992 #define FORMAT_expp 4
1993 #define FORMAT_expt 5
1994 
1995 BUILTIN(FORMAT)
1996 {
1997  fix_args(FORMAT); /* check on required number of args */
1998  /* force to a string object */
1999  RexxString *number = required_string(FORMAT, number);
2000  /* before value is optional */
2001  RexxInteger *before = optional_integer(FORMAT, before);
2002  /* after value is optional */
2003  RexxInteger *after = optional_integer(FORMAT, after);
2004  /* expp value is optional */
2005  RexxInteger *expp = optional_integer(FORMAT, expp);
2006  /* expt value is optional */
2007  RexxInteger *expt = optional_integer(FORMAT, expt);
2008  /* invoke the string FORMAT function */
2009  return number->format(before, after, expp, expt);
2010 }
2011 
2012 // Must use a prefix different from MAX because CHAR_MAX seems to be an integer instead of a char* (compilation error)
2013 #define ORXMAX_MIN 1
2014 #define ORXMAX_MAX argcount
2015 #define ORXMAX_target 1
2016 
2017 BUILTIN(ORXMAX)
2018 {
2019  check_args(ORXMAX); /* check on required args */
2020  /* get the argument in question */
2021  RexxObject *argument = get_arg(ORXMAX, target);
2022  if (isOfClass(NumberString, argument))
2023  { /* how about already numeric? */
2024  /* we can process this without conversion */
2025  // return((RexxNumberString *)argument)->Max(stack->arguments(argcount - 1), argcount - 1);
2026  return((RexxNumberString *)argument)->Max(arguments + 1, argcount - 1, named_argcount);
2027  }
2028  /* get the target string */
2029  RexxString *target = required_string(ORXMAX, target);
2030  /* go perform the MIN function */
2031  // return target->Max(stack->arguments(argcount - 1), argcount - 1);
2032  return target->Max(arguments + 1, argcount - 1, named_argcount);
2033 }
2034 
2035 // Must use a prefix different from MAX because CHAR_MAX seems to be an integer instead of a char* (compilation error)
2036 #define ORXMIN_MIN 1
2037 #define ORXMIN_MAX argcount
2038 #define ORXMIN_target 1
2039 
2040 BUILTIN(ORXMIN)
2041 {
2042  check_args(ORXMIN); /* check on required args */
2043  /* get the argument in question */
2044  RexxObject *argument = get_arg(ORXMIN, target);
2045  if (isOfClass(NumberString, argument))
2046  { /* how about already numeric? */
2047  /* we can process this without conversion */
2048  // return((RexxNumberString *)argument)->Min(stack->arguments(argcount - 1), argcount - 1);
2049  return((RexxNumberString *)argument)->Min(arguments + 1, argcount - 1, named_argcount);
2050  }
2051  /* get the target string */
2052  RexxString *target = required_string(ORXMIN, target);
2053  /* go perform the MIN function */
2054  // return target->Min(stack->arguments(argcount - 1), argcount - 1);
2055  return target->Min(arguments + 1, argcount - 1, named_argcount);
2056 }
2057 
2058 #define SOURCELINE_MIN 0
2059 #define SOURCELINE_MAX 1
2060 #define SOURCELINE_n 1
2061 
2062 BUILTIN(SOURCELINE)
2063 {
2064  fix_args(SOURCELINE); /* check on required number of args */
2065  // get the effective source object. If we're in an interpret context, this will
2066  // be the one of our caller.
2067  RexxSource *source = context->getEffectiveSourceObject();
2068  size_t size = source->sourceSize(); /* get the program size */
2069  if (argcount == 1) /* asking for a specific line? */
2070  {
2071  /* get the line number */
2072  size_t line_number = required_integer(SOURCELINE, n)->getValue();
2073  /* must be a positive integer */
2074  positive_integer((ssize_t)line_number, SOURCELINE, IntegerOne);
2075  if (line_number > size) /* larger than program source? */
2076  {
2077  /* this is an error too? */
2079  }
2080  /* get the specific line */
2081  return(RexxObject *)source->get(line_number);
2082  }
2083  else
2084  {
2085  /* just return the source size */
2086  return(RexxObject *)new_integer(size);
2087  }
2088 }
2089 
2090 #define TRACE_MIN 0
2091 #define TRACE_MAX 1
2092 #define TRACE_setting 1
2093 
2094 BUILTIN(TRACE)
2095 {
2096  RexxString *result; /* returned result */
2097  RexxString *setting; /* new trace setting */
2098 
2099  fix_args(TRACE); /* check required arguments */
2100  /* get the trace setting */
2101  setting = optional_string(TRACE, setting);
2102  result = context->traceSetting(); /* get the existing trace setting */
2103  if (setting != OREF_NULL)
2104  { /* have a new setting? */
2105  context->setTrace(setting);
2106  }
2107  return result; /* return old trace setting */
2108 }
2109 
2110 /* check to see if stream is to queue*/
2112 /******************************************************************************/
2113 /* Function: Check to see if a stream name is a queue */
2114 /******************************************************************************/
2115 {
2116  if (name != OREF_NULL) /* non-default name? */
2117  {
2118  return name->strCaselessCompare("QUEUE:");/* compare against the queue */
2119  }
2120  else
2121  {
2122  return false; /* not the queue */
2123  }
2124 }
2125 
2126 #define LINEIN_MIN 0
2127 #define LINEIN_MAX 3
2128 #define LINEIN_name 1
2129 #define LINEIN_line 2
2130 #define LINEIN_count 3
2131 
2132 BUILTIN(LINEIN)
2133 {
2134  fix_args(LINEIN); /* check required arguments */
2135 
2136  RexxString *name = optional_string(LINEIN, name);/* get the string name */
2137  /* get the line position */
2139  /* and the optional count of lines */
2140  RexxObject *count = optional_big_integer(LINEIN, count);
2141  if (check_queue(name))
2142  { /* is this "QUEUE:" */
2143  RexxString *result;
2144  /* if exit declines call */
2145  if (context->getActivity()->callPullExit(context, result))
2146  {
2147  /* get the default output stream */
2148  RexxObject *stream = context->getLocalEnvironment(OREF_REXXQUEUE);
2149  /* pull from the queue */
2150  return stream->sendMessage(OREF_LINEIN);
2151  }
2152  return result;
2153  }
2154  else
2155  {
2156  bool added = false;
2157  /* get a stream for this name */
2158  RexxObject *stream = context->resolveStream(name, true, NULL, &added);
2159  switch (argcount)
2160  { /* process according to argcount */
2161  case 0: /* no name */
2162  case 1: /* name only */
2163  return stream->sendMessage(OREF_LINEIN);
2164  break;
2165  case 2: /* name and start */
2166  return stream->sendMessage(OREF_LINEIN, line);
2167  break;
2168  case 3: /* name, start and count */
2169  return stream->sendMessage(OREF_LINEIN, line, count);
2170  break;
2171  }
2172  }
2173  return OREF_NULLSTRING; // should never happen
2174 }
2175 
2176 #define CHARIN_MIN 0
2177 #define CHARIN_MAX 3
2178 #define CHARIN_name 1
2179 #define CHARIN_start 2
2180 #define CHARIN_count 3
2181 
2182 BUILTIN(CHARIN)
2183 {
2184  fix_args(CHARIN); /* check required arguments */
2185  /* get the string name */
2186  RexxString *name = optional_string(CHARIN, name);
2187  /* get the line position */
2188  RexxObject *position = optional_big_integer(CHARIN, start);
2189  /* and the optional count of chars */
2190  RexxObject *count = optional_big_integer(CHARIN, count);
2191  if (check_queue(name)) /* is this "QUEUE:" */
2192  {
2193  /* this isn't allowed */
2195  }
2196 
2197  /* get a stream for this name */
2198  bool added = false;
2199  RexxObject *stream = context->resolveStream(name, true, NULL, &added);
2200  switch (argcount)
2201  { /* process according to argcount */
2202  case 0: /* no name */
2203  case 1: /* name only */
2204  return stream->sendMessage(OREF_CHARIN);
2205  break;
2206  case 2: /* name and string */
2207  return stream->sendMessage(OREF_CHARIN, position);
2208  break;
2209  case 3: /* name, string and line */
2210  return stream->sendMessage(OREF_CHARIN, position, count);
2211  break;
2212  }
2213  return OREF_NULLSTRING; /* should never get here */
2214 }
2215 
2216 #define LINEOUT_MIN 0
2217 #define LINEOUT_MAX 3
2218 #define LINEOUT_name 1
2219 #define LINEOUT_string 2
2220 #define LINEOUT_line 3
2221 
2222 BUILTIN(LINEOUT)
2223 {
2224  fix_args(LINEOUT); /* check required arguments */
2225  /* get the string name */
2226  RexxString *name = optional_string(LINEOUT, name);
2227  /* get the output string */
2228  RexxString *string = optional_string(LINEOUT, string);
2229  /* get the line position */
2231  if (check_queue(name))
2232  { /* is this "QUEUE:" */
2233  /* if exit declines call */
2234  if (context->getActivity()->callPushExit(context, string, QUEUE_FIFO))
2235  {
2236  if (string != OREF_NULL)
2237  { /* have an actual string to write? */
2238  /* get the default output stream */
2239  RexxObject *stream = context->getLocalEnvironment(OREF_REXXQUEUE);
2240  /* push onto the queue */
2241  return stream->sendMessage(OREF_QUEUENAME, string);
2242  }
2243  else
2244  {
2245  /* always a zero residual */
2246  return IntegerZero;
2247  }
2248  }
2249  }
2250  else
2251  {
2252  bool added;
2253  RexxString *fullName;
2254  /* get a stream for this name */
2255  RexxObject *stream = context->resolveStream(name, false, &fullName, &added);
2256  switch (argcount)
2257  { /* process according to argcount */
2258  case 0: /* no name */
2259  case 1: /* name only */
2260  return stream->sendMessage(OREF_LINEOUT);
2261  break;
2262  case 2: /* name and string */
2263  return stream->sendMessage(OREF_LINEOUT, string);
2264  break;
2265  case 3: /* name, string and line */
2266  return stream->sendMessage(OREF_LINEOUT, string, line);
2267  break;
2268  }
2269  }
2270  return OREF_NULLSTRING; /* should never happen */
2271 }
2272 
2273 #define CHAROUT_MIN 0
2274 #define CHAROUT_MAX 3
2275 #define CHAROUT_name 1
2276 #define CHAROUT_string 2
2277 #define CHAROUT_start 3
2278 
2279 BUILTIN(CHAROUT)
2280 {
2281  fix_args(CHAROUT); /* check required arguments */
2282  /* get the string name */
2283  RexxString *name = optional_string(CHAROUT, name);
2284  /* get the output string */
2285  RexxString *string = optional_string(CHAROUT, string);
2286  /* get the line position */
2287  RexxObject *position = optional_big_integer(CHAROUT, start);
2288  if (check_queue(name)) /* is this "QUEUE:" */
2289  {
2290  /* this isn't allowed */
2292  }
2293 
2294  bool added;
2295  /* get a stream for this name */
2296  RexxObject *stream = context->resolveStream(name, false, NULL, &added);
2297  switch (argcount)
2298  { /* process according to argcount */
2299  case 0: /* no name */
2300  case 1: /* name only */
2301  return stream->sendMessage(OREF_CHAROUT);
2302  break;
2303  case 2: /* name and string */
2304  return stream->sendMessage(OREF_CHAROUT, string);
2305  break;
2306  case 3: /* name, string and line */
2307  return stream->sendMessage(OREF_CHAROUT, string, position);
2308  break;
2309  }
2310  return OREF_NULLSTRING; /* should never happen */
2311 }
2312 
2313 #define LINES_MIN 0
2314 #define LINES_MAX 2
2315 #define LINES_name 1
2316 #define LINES_option 2
2317 
2318 BUILTIN(LINES)
2319 {
2320  fix_args(LINES); /* check required arguments */
2321 
2322  RexxString *name = optional_string(LINES, name); /* get the string name */
2323  RexxString *option = optional_string(LINES, option);
2324  RexxObject *result;
2325 
2326  if (option != OREF_NULL)
2327  {
2328  switch (option->getCharC(0))
2329  { /* process the option character */
2330  case 'C':
2331  case 'c':
2332  break;
2333  case 'N':
2334  case 'n':
2335  break;
2336  default: /* unknown option */
2337  /* this is an error */
2338  reportException(Error_Incorrect_call_list, CHAR_ARG, OREF_positional, IntegerTwo, "NC", option);
2339  break;
2340  }
2341  }
2342  else
2343  {
2344  option = OREF_NORMAL;
2345  }
2346 
2347  if (check_queue(name))
2348  { /* is this "QUEUE:" */
2349  /* get the default output stream */
2350  RexxObject *stream = context->getLocalEnvironment(OREF_REXXQUEUE);
2351  /* return count on the queue */
2352  result = stream->sendMessage(OREF_QUEUED);
2353  }
2354  else
2355  {
2356  bool added;
2357  /* get a stream for this name */
2358  RexxObject *stream = context->resolveStream(name, true, NULL, &added);
2359 
2360  /* use modified LINES method with quick flag */
2361  result = stream->sendMessage(OREF_LINES, option);
2362  }
2363  /* for compatibility this needs */
2364  /* to only return 0 or 1 */
2365  if (toupper(option->getCharC(0)) == 'N')
2366  {
2367  wholenumber_t count = 0;
2368  if (result->numberValue(count))
2369  {
2370  return (count != 0) ? IntegerOne : IntegerZero;
2371  }
2372  return result; // not sure what this, just return directly
2373  }
2374  else
2375  {
2376  return result;
2377  }
2378 }
2379 
2380 #define CHARS_MIN 0
2381 #define CHARS_MAX 1
2382 #define CHARS_name 1
2383 
2384 BUILTIN(CHARS)
2385 {
2386  fix_args(CHARS); /* check required arguments */
2387 
2388  RexxString *name = optional_string(CHARS, name); /* get the string name */
2389  if (check_queue(name)) /* is this "QUEUE:" */
2390  {
2391  /* this isn't allowed */
2393  }
2394  /* get a stream for this name */
2395  bool added;
2396  RexxObject *stream = context->resolveStream(name, true, NULL, &added);
2397  return stream->sendMessage(OREF_CHARS);
2398 }
2399 
2400 #define STREAM_MIN 1
2401 #undef STREAM_MAX /* already defined in AIX */
2402 #define STREAM_MAX 3
2403 #define STREAM_name 1
2404 #define STREAM_operation 2
2405 #define STREAM_command 3
2406 
2407 #define STREAM_STATUS 'S'
2408 #define STREAM_DESCRIPTION 'D'
2409 #define STREAM_COMMAND 'C'
2410 
2411 BUILTIN(STREAM)
2412 {
2413  fix_args(STREAM); /* check required arguments */
2414  /* get the string name */
2415  RexxString *name = required_string(STREAM, name);
2416  if (name->getBLength() == 0) /* check name validity */
2417  {
2418  /* raise an error */
2420  }
2421  /* get any operation */
2422  RexxString *action = optional_string(STREAM, operation);
2423  /* get any command */
2424  RexxString *command = optional_string(STREAM, command);
2425 
2426  char action_char = STREAM_STATUS; /* this is a status attempt */
2427  if (action != OREF_NULL)
2428  { /* no action given? */
2429  if (action->getBLength() == 0)
2430  { /* get a null string? */
2431  /* this is an error */
2432  reportException(Error_Incorrect_call_list, CHAR_STREAM, OREF_positional, IntegerTwo, "SDC", action);
2433  }
2434  /* get the option character */
2435  action_char = toupper(action->getCharC(0));
2436  }
2437 
2438  switch (action_char)
2439  { /* process the options */
2440  case STREAM_STATUS: /* stream(name, s) */
2441  {
2442  if (argcount > 2)
2443  { /* given a third argument? */
2444  /* raise an error */
2445  reportException(Error_Incorrect_call_maxarg, OREF_positional, OREF_STREAM, IntegerTwo);
2446  }
2447  RexxObject *stream = context->resolveStream(name, true, NULL, NULL);
2448  /* get the stream state */
2449  return stream->sendMessage(OREF_STATE);
2450  break;
2451  }
2452 
2453  case STREAM_DESCRIPTION: /* stream(name, d) */
2454  {
2455  if (argcount > 2)
2456  { /* given a third argument? */
2457  /* raise an error */
2458  reportException(Error_Incorrect_call_maxarg, OREF_positional, OREF_STREAM, IntegerTwo);
2459  }
2460  RexxObject *stream = context->resolveStream(name, true, NULL, NULL);
2461  /* get the stream description */
2462  return stream->sendMessage(OREF_DESCRIPTION);
2463  break;
2464  }
2465 
2466  case STREAM_COMMAND: /* stream(name, c, command) */
2467  {
2468  if (argcount < 3)
2469  { /* given a third argument? */
2470  /* raise an error */
2471  reportException(Error_Incorrect_call_minarg, OREF_positional, OREF_STREAM, IntegerThree);
2472  }
2473  /* get the stream description */
2474  ProtectedObject p(command);
2475 
2476  /* I have to check the command twice because in the RexxMethods (i.g. query_exists)
2477  I don't have access to the activation and thus not to the streamtable.
2478  It's also not possible to pass context as the second argument because
2479  stream is a RexxMethod and USE ARG RexxActivation is not possible */
2480  RexxString *command_upper = command->upper();
2481  ProtectedObject p1(command_upper);
2482 
2483  if (command_upper->wordPos(new_string("OPEN"), OREF_NULL)->getValue() > 0)
2484  {
2485  RexxString *fullName;
2486  bool added;
2487  RexxObject *stream = context->resolveStream(name, true, &fullName, &added);
2488  RexxString *result = (RexxString *)stream->sendMessage(OREF_COMMAND, command);
2489  /* if open failed, remove the stream object from stream table again */
2490  if (!result->strCompare("READY:"))
2491  {
2492  context->getStreams()->remove(fullName);
2493  }
2494  return result;
2495  }
2496  else if (command_upper->wordPos(new_string("CLOSE"), OREF_NULL)->getValue() > 0)
2497  {
2498  RexxString *fullName;
2499  bool added;
2500  RexxObject *stream = context->resolveStream(name, true, &fullName, &added);
2501  RexxString *result = (RexxString *)stream->sendMessage(OREF_COMMAND, command);
2502  context->getStreams()->remove(fullName);
2503  return result;
2504  }
2505  // these are real operations that might cause an implicit open
2506  else if (command_upper->wordPos(new_string("SEEK"), OREF_NULL)->getValue() > 0 ||
2507  command_upper->wordPos(new_string("POSITON"), OREF_NULL)->getValue() > 0)
2508  {
2509  RexxString *fullName;
2510  bool added;
2511  RexxObject *stream = context->resolveStream(name, true, &fullName, &added);
2512  // this is a real operation, so just leave alone
2513  RexxString *result = (RexxString *)stream->sendMessage(OREF_COMMAND, command);
2514  return result;
2515  }
2516  else
2517  {
2518  RexxObject *stream = context->resolveStream(name, true, NULL, NULL);
2519  return stream->sendMessage(OREF_COMMAND, command);
2520  }
2521  break;
2522  }
2523 
2524  default:
2525  /* this is an error */
2526  reportException(Error_Incorrect_call_list, CHAR_STREAM, OREF_positional, IntegerTwo, "SDC", action);
2527  break;
2528  }
2529  return OREF_NULL; /* should never happen */
2530 }
2531 
2532 #define QUEUED_MIN 0
2533 #define QUEUED_MAX 0
2534 
2535 BUILTIN(QUEUED)
2536 {
2537 
2538  check_args(QUEUED); /* check on required number of args */
2539  RexxInteger *queuesize; /* returned queue size from sys exit */
2540  /* get the default output stream */
2541  if (context->getActivity()->callQueueSizeExit(context, queuesize))
2542  {
2543  RexxObject *queue = context->getLocalEnvironment(OREF_REXXQUEUE);
2544  /* return count on the queue */
2545  return queue->sendMessage(OREF_QUEUED);
2546  }
2547  else
2548  {
2549  return queuesize; /* return count from system exit */
2550  }
2551 }
2552 
2553 #define CONDITION_MIN 0
2554 #define CONDITION_MAX 1
2555 #define CONDITION_option 1
2556 
2557 BUILTIN(CONDITION)
2558 {
2559  int style = 'I'; /* style of condition output */
2560  fix_args(CONDITION); /* expand arguments to full value */
2561  /* get the option string */
2562  RexxString *option = optional_string(CONDITION, option);
2563  if (option != OREF_NULL) /* just using default format? */
2564  {
2565  if (option->getBLength() == 0) /* have a null string? */
2566  {
2567  /* this is an error */
2568  reportException(Error_Incorrect_call_list, CHAR_CONDITION, OREF_positional, IntegerOne, "ACDIOS", option);
2569  }
2570 
2571  /* option is first character */
2572  style = toupper(option->getCharC(0));
2573  }
2574  /* get current trapped condition */
2575  RexxDirectory *conditionobj = context->getConditionObj();
2576 
2577  switch (style)
2578  { /* process various CONDITION objects */
2579 
2580  case 'A': /* 'A'dditional */
2581  if (conditionobj != OREF_NULL)
2582  { /* have a condition object? */
2583  /* retrieve the additional info */
2584  RexxObject *result = conditionobj->at(OREF_ADDITIONAL);
2585  if (result == OREF_NULL) /* not there? */
2586  {
2587  return TheNilObject; /* return .nil */
2588  }
2589  else
2590  {
2591  return result->copy(); /* copy the result info */
2592  }
2593  }
2594  else
2595  {
2596  return TheNilObject; /* return .nil if not there */
2597  }
2598  break;
2599 
2600  case 'I': /* 'I'nstruction */
2601  if (conditionobj != OREF_NULL) /* have a condition object? */
2602  {
2603  /* retrieve the instruction info */
2604  return conditionobj->at(OREF_INSTRUCTION);
2605  }
2606  break;
2607 
2608  case 'D': /* 'D'escription */
2609  if (conditionobj != OREF_NULL)
2610  { /* have a condition object? */
2611  /* retrieve the description info */
2612  RexxObject *result = conditionobj->at(OREF_DESCRIPTION);
2613  if (result == OREF_NULL) /* not found? */
2614  {
2615  result = OREF_NULLSTRING; /* return a null string if nothing */
2616  }
2617  return result;
2618  }
2619  break;
2620 
2621  case 'C': /* 'C'ondition name */
2622  if (conditionobj != OREF_NULL) /* have a condition object? */
2623  {
2624  /* retrieve the condition name */
2625  return conditionobj->at(OREF_CONDITION);
2626  }
2627  break;
2628 
2629  case 'O': /* 'C'ondition name */
2630  if (conditionobj != OREF_NULL) /* have a condition object? */
2631  {
2632  return conditionobj->copy(); /* just return a copy of this */
2633  }
2634  return TheNilObject; /* return the NIL object */
2635 
2636  case 'S': /* 'S'tate */
2637  if (conditionobj != OREF_NULL) /* have a condition object? */
2638  {
2639  /* get the current trap state */
2640  return context->trapState((RexxString *)conditionobj->at(OREF_CONDITION));
2641  }
2642  break;
2643 
2644  default: /* unknown option */
2645  /* report an error */
2646  reportException(Error_Incorrect_call_list, CHAR_CONDITION, OREF_positional, IntegerOne, "ACDIOS", option);
2647  break;
2648  }
2649  return OREF_NULLSTRING;
2650 }
2651 
2652 #define CHANGESTR_MIN 3
2653 #define CHANGESTR_MAX 4
2654 #define CHANGESTR_needle 1
2655 #define CHANGESTR_haystack 2
2656 #define CHANGESTR_newneedle 3
2657 #define CHANGESTR_count 4
2658 
2659 BUILTIN(CHANGESTR)
2660 {
2661  fix_args(CHANGESTR); /* check on require number of args */
2662  /* get string for new */
2663  RexxString *needle = required_string(CHANGESTR, needle);
2664  /* get string for target */
2665  RexxString *haystack = required_string(CHANGESTR, haystack);
2666  /* get string to change to */
2667  RexxString *newneedle = required_string(CHANGESTR, newneedle);
2668  /* length is optional */
2669  RexxInteger *count = optional_integer(CHANGESTR, count);
2670  /* go perform the pos function */
2671  return haystack->changeStr(needle, newneedle, count);
2672 }
2673 
2674 #define COUNTSTR_MIN 2
2675 #define COUNTSTR_MAX 2
2676 #define COUNTSTR_needle 1
2677 #define COUNTSTR_haystack 2
2678 
2679 BUILTIN(COUNTSTR)
2680 {
2681  fix_args(COUNTSTR); /* check on require number of args */
2682  /* get string for new */
2683  RexxString *needle = required_string(COUNTSTR, needle);
2684  /* get string for target */
2685  RexxString *haystack = required_string(COUNTSTR, haystack);
2686  return haystack->countStrRexx(needle); /* go perform the countstr function */
2687 }
2688 
2689 
2690 #define RXFUNCADD_MIN 2
2691 #define RXFUNCADD_MAX 3
2692 #define RXFUNCADD_name 1
2693 #define RXFUNCADD_module 2
2694 #define RXFUNCADD_proc 3
2695 
2696 BUILTIN(RXFUNCADD)
2697 {
2698  fix_args(RXFUNCADD); /* check on required number of args */
2699 
2700  // we require a name and module, but the
2701  // procedure is optional. If not specified, we
2702  // use the function name directly.
2703  RexxString *name = required_string(RXFUNCADD, name);
2704  RexxString *module = required_string(RXFUNCADD, module);
2705  RexxString *proc = optional_string(RXFUNCADD, proc);
2706 
2707  if (proc == OREF_NULL)
2708  {
2709  proc = name;
2710  }
2711 
2712  // hand this off to the package manager.
2713  return PackageManager::addRegisteredRoutine(name, module, proc);
2714 }
2715 
2716 #define RXFUNCDROP_MIN 1
2717 #define RXFUNCDROP_MAX 1
2718 #define RXFUNCDROP_name 1
2719 
2720 BUILTIN(RXFUNCDROP)
2721 {
2722  fix_args(RXFUNCDROP); /* check on required number of args */
2723 
2724  // only a name is required.
2725  RexxString *name = required_string(RXFUNCDROP, name);
2726 
2727  // hand this off to the package manager.
2729 }
2730 
2731 #define RXFUNCQUERY_MIN 1
2732 #define RXFUNCQUERY_MAX 1
2733 #define RXFUNCQUERY_name 1
2734 
2735 BUILTIN(RXFUNCQUERY)
2736 {
2737  fix_args(RXFUNCQUERY); /* check on required number of args */
2738 
2739  // only a name is required.
2740  RexxString *name = required_string(RXFUNCQUERY, name);
2741 
2742  // hand this off to the package manager.
2744 }
2745 
2746 
2747 #define QUEUEEXIT_MIN 1
2748 #define QUEUEEXIT_MAX 1
2749 #define QUEUEEXIT_name 1
2750 
2751 
2752 // This somewhat funny function is implemented as a builtin because it
2753 // requires quite a bit of internal access.
2754 BUILTIN(QUEUEEXIT)
2755 {
2756  fix_args(QUEUEEXIT); /* check on required number of args */
2757 
2758  // only a name is required.
2759  RexxString *name = required_string(QUEUEEXIT, name);
2760  /* call the exit */
2761  context->getActivity()->callQueueNameExit(context, name);
2762  // make sure we have real object to return
2763  if (name == OREF_NULL)
2764  {
2765  name = OREF_NULLSTRING;
2766  }
2767  return name;
2768 }
2769 
2770 #define SETLOCAL_MIN 0
2771 #define SETLOCAL_MAX 0
2772 
2773 BUILTIN(SETLOCAL)
2774 {
2775  check_args(SETLOCAL); /* check on required number of args */
2776  // the external environment implements this
2777  return SystemInterpreter::pushEnvironment(context);
2778 }
2779 
2780 #define ENDLOCAL_MIN 0
2781 #define ENDLOCAL_MAX 0
2782 
2783 BUILTIN(ENDLOCAL)
2784 {
2785  check_args(ENDLOCAL); /* check on required number of args */
2786  // the external environment implements this
2787  return SystemInterpreter::popEnvironment(context);
2788 }
2789 
2790 #define QUALIFY_MIN 0
2791 #define QUALIFY_MAX 1
2792 #define QUALIFY_name 1
2793 
2794 /**
2795  * Qualify a stream name.
2796  */
2797 BUILTIN(QUALIFY)
2798 {
2799  check_args(QUALIFY); /* check on required number of args */
2800  RexxString *name = optional_string(QUALIFY, name);
2801 
2802  char qualified_name[SysFileSystem::MaximumFileNameLength];
2803  // qualifyStreamName will not expand if not a null string on entry.
2804  qualified_name[0] = '\0';
2805  SysFileSystem::qualifyStreamName(name->getStringData(), qualified_name, sizeof(qualified_name));
2806  return new_string(qualified_name);
2807 }
2808 
2809 /* the following builtin function */
2810 /* table must maintain the same order*/
2811 /* as the builtin function codes used*/
2812 /* in the token class builtin */
2813 /* builtin function lookup */
2815  NULL, /* NULL first entry as dummy */
2816  &builtin_function_ABBREV ,
2817  &builtin_function_ABS ,
2818  &builtin_function_ADDRESS ,
2819  &builtin_function_ARG ,
2820  &builtin_function_B2X ,
2821  &builtin_function_BITAND ,
2822  &builtin_function_BITOR ,
2823  &builtin_function_BITXOR ,
2824  &builtin_function_C2D ,
2825  &builtin_function_C2X ,
2826  &builtin_function_CENTER ,
2827  &builtin_function_CENTRE ,
2828  &builtin_function_CHANGESTR ,
2829  &builtin_function_CHARIN ,
2830  &builtin_function_CHAROUT ,
2831  &builtin_function_CHARS ,
2832  &builtin_function_COMPARE ,
2833  &builtin_function_CONDITION ,
2834  &builtin_function_COPIES ,
2835  &builtin_function_COUNTSTR ,
2836  &builtin_function_D2C ,
2837  &builtin_function_D2X ,
2838  &builtin_function_DATATYPE ,
2839  &builtin_function_DATE ,
2840  &builtin_function_DELSTR ,
2841  &builtin_function_DELWORD ,
2842  &builtin_function_DIGITS ,
2843  &builtin_function_ERRORTEXT ,
2844  &builtin_function_FORM ,
2845  &builtin_function_FORMAT ,
2846  &builtin_function_FUZZ ,
2847  &builtin_function_INSERT ,
2848  &builtin_function_LASTPOS ,
2849  &builtin_function_LEFT ,
2850  &builtin_function_LENGTH ,
2851  &builtin_function_LINEIN ,
2852  &builtin_function_LINEOUT ,
2853  &builtin_function_LINES ,
2854  &builtin_function_ORXMAX ,
2855  &builtin_function_ORXMIN ,
2856  &builtin_function_OVERLAY ,
2857  &builtin_function_POS ,
2858  &builtin_function_QUEUED ,
2859  &builtin_function_RANDOM ,
2860  &builtin_function_REVERSE ,
2861  &builtin_function_RIGHT ,
2862  &builtin_function_SIGN ,
2863  &builtin_function_SOURCELINE ,
2864  &builtin_function_SPACE ,
2865  &builtin_function_STREAM ,
2866  &builtin_function_STRIP ,
2867  &builtin_function_SUBSTR ,
2868  &builtin_function_SUBWORD ,
2869  &builtin_function_SYMBOL ,
2870  &builtin_function_TIME ,
2871  &builtin_function_TRACE ,
2872  &builtin_function_TRANSLATE ,
2873  &builtin_function_TRUNC ,
2874  &builtin_function_VALUE ,
2875  &builtin_function_VAR ,
2876  &builtin_function_VERIFY ,
2877  &builtin_function_WORD ,
2878  &builtin_function_WORDINDEX ,
2879  &builtin_function_WORDLENGTH ,
2880  &builtin_function_WORDPOS ,
2881  &builtin_function_WORDS ,
2882  &builtin_function_X2B ,
2883  &builtin_function_X2C ,
2884  &builtin_function_X2D ,
2885  &builtin_function_XRANGE ,
2886  &builtin_function_USERID ,
2887  &builtin_function_LOWER ,
2888  &builtin_function_UPPER ,
2889  &builtin_function_RXFUNCADD ,
2890  &builtin_function_RXFUNCDROP ,
2891  &builtin_function_RXFUNCQUERY ,
2892  &builtin_function_ENDLOCAL ,
2893  &builtin_function_SETLOCAL ,
2894  &builtin_function_QUEUEEXIT ,
2895  &builtin_function_QUALIFY ,
2896 };
2897 
void reportException(wholenumber_t error)
#define min(a, b)
Definition: ArrayClass.cpp:82
#define STREAM_DESCRIPTION
RexxString * requiredStringArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
void expandArgs(RexxObject **arguments, size_t argcount, size_t min, size_t max, const char *function)
RexxInteger * requiredIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
#define STREAM_STATUS
bool check_queue(RexxString *name)
BUILTIN(CENTER)
void checkPadArgument(const char *pFuncName, RexxObject *position, RexxString *pad)
RexxString * optionalStringArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
RexxObject * optionalBigIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
RexxInteger * optionalIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
RexxObject * requiredBigIntegerArg(size_t position, RexxObject **arguments, size_t argcount, const char *function)
#define STREAM_COMMAND
#define get_arg(x, n)
#define optional_string(x, n)
#define optional_integer(x, n)
#define fix_args(x)
#define required_integer(x, n)
#define optional_big_integer(x, n)
#define required_string(x, n)
#define positive_integer(n, f, p)
#define optional_argument(x, n)
#define check_args(x)
#define arg_omitted(x, n)
RexxInteger * new_integer(wholenumber_t v)
#define OREF_NULL
Definition: RexxCore.h:60
#define IntegerThree
Definition: RexxCore.h:192
#define IntegerFour
Definition: RexxCore.h:193
#define IntegerFive
Definition: RexxCore.h:194
#define TheNullArray
Definition: RexxCore.h:183
#define IntegerOne
Definition: RexxCore.h:190
#define TheEnvironment
Definition: RexxCore.h:174
#define TheTrueObject
Definition: RexxCore.h:186
#define IntegerTwo
Definition: RexxCore.h:191
#define isOfClass(t, r)
Definition: RexxCore.h:212
#define TheNilObject
Definition: RexxCore.h:181
#define TheFalseObject
Definition: RexxCore.h:185
#define IntegerZero
Definition: RexxCore.h:189
#define LeapYear(year)
#define YEAR_DAYS
#define MICROSECONDS
#define Error_Incorrect_call_stream_name
#define Error_Incorrect_call_selector
#define Error_Incorrect_call_list
#define Error_Incorrect_call_pad
#define Error_Incorrect_call_symbol
#define Error_Incorrect_call_noarg
#define Error_Incorrect_call_minarg
#define Error_Incorrect_call_whole
#define Error_Incorrect_call_queue_no_char
#define Error_Incorrect_call_maxarg
#define Error_Incorrect_call_format_invalid
#define Error_Incorrect_call_parm_wrong_sep
#define Message_Translations_January
#define Error_Incorrect_call_sourceline
#define Error_Incorrect_call_range
#define Error_Incorrect_call_format_incomp_sep
#define Error_Incorrect_call_invalid_conversion
@ QUEUE_FIFO
builtin_func * pbuiltin
Definition: SourceFile.hpp:113
#define STRING_NAME
Definition: StringClass.hpp:60
RexxString * new_string(const char *s, stringsizeB_t bl, sizeC_t cl=-1)
#define ALPHANUM
Definition: StringClass.hpp:96
#define STRING_COMPOUND_NAME
Definition: StringClass.hpp:56
RexxString * raw_string(stringsizeB_t bl, stringsizeC_t cl=-1)
#define STRING_STEM
Definition: StringClass.hpp:55
static RexxObject * int64Object(RexxObject *source)
Definition: Numerics.cpp:447
static const bool FORM_SCIENTIFIC
Definition: Numerics.hpp:76
static const size_t ARGUMENT_DIGITS
Definition: Numerics.hpp:68
static bool objectToInt64(RexxObject *o, int64_t &result)
Definition: Numerics.cpp:409
static RexxObject * dropRegisteredRoutine(RexxString *name)
static RexxObject * queryRegisteredRoutine(RexxString *name)
static RexxObject * addRegisteredRoutine(RexxString *name, RexxString *module, RexxString *proc)
void formatCivilTime(char *buffer)
void formatNormalDate(char *buffer, const char *sep)
void formatHours(char *buffer)
void formatBaseTime(char *buffer)
void formatWeekDay(char *buffer)
void setDate(wholenumber_t newYear, wholenumber_t newDay)
void formatMonthName(char *buffer)
void formatOrderedDate(char *buffer, const char *sep)
bool setMinutes(wholenumber_t m)
void formatMinutes(char *buffer)
bool setBaseDate(wholenumber_t basedays)
void formatDays(char *buffer)
bool parseUsaDate(const char *date, const char *sep, wholenumber_t currentYear)
bool parseOrderedDate(const char *date, const char *sep, wholenumber_t currentYear)
void formatStandardDate(char *buffer, const char *sep)
bool parseNormalTime(const char *date)
void formatTimeZone(char *buffer)
bool parseLongTime(const char *date)
void formatNormalTime(char *buffer)
bool parseEuropeanDate(const char *date, const char *sep, wholenumber_t currentYear)
bool parseCivilTime(const char *date)
int64_t getUTCBaseTime()
void formatLongTime(char *buffer)
bool setBaseTime(int64_t basetime)
bool setHours(wholenumber_t h)
void formatSeconds(char *buffer)
bool parseStandardDate(const char *date, const char *sep)
bool parseNormalDate(const char *date, const char *sep)
bool adjustTimeZone(int64_t o)
bool setUnixTime(int64_t basetime)
void formatUnixTime(char *buffer)
void formatEuropeanDate(char *buffer, const char *sep)
void formatUsaDate(char *buffer, const char *sep)
void setTimeZoneOffset(int64_t o)
void formatBaseDate(char *buffer)
int64_t getTimeZoneOffset()
bool setSeconds(wholenumber_t s)
RexxObject * copy()
RexxObject * at(RexxString *)
RexxObject * getValue(RexxActivation *)
virtual RexxObject * getValue(RexxActivation *)
RexxObject * copy()
void sendMessage(RexxString *, RexxArray *, RexxDirectory *, ProtectedObject &)
bool requestNumber(wholenumber_t &, size_t)
RexxString * requestString()
virtual bool numberValue(wholenumber_t &result, size_t precision)
static pbuiltin builtinTable[]
Definition: SourceFile.hpp:420
size_t sourceSize()
Definition: SourceFile.cpp:783
RexxString * get(size_t)
Definition: SourceFile.cpp:815
bool numberValue(wholenumber_t &result, size_t precision)
RexxObject * trunc(RexxInteger *decimals)
RexxString * changeStr(RexxString *, RexxString *, RexxInteger *)
RexxObject * Min(RexxObject **args, size_t argCount, size_t named_argCount)
RexxString * bitOr(RexxString *, RexxString *)
bool strCaselessCompare(const char *s)
RexxString * bitAnd(RexxString *, RexxString *)
RexxString * overlay(RexxString *, RexxInteger *, RexxInteger *, RexxString *)
RexxObject * lengthRexx()
RexxInteger * abbrev(RexxString *, RexxInteger *)
RexxObject * format(RexxObject *Integers, RexxObject *Decimals, RexxObject *MathExp, RexxObject *ExpTrigger)
const char * getStringData()
RexxObject * Max(RexxObject **args, size_t argCount, size_t named_argCount)
RexxInteger * lastPosRexx(RexxString *, RexxInteger *, RexxInteger *)
RexxInteger * compare(RexxString *, RexxString *)
char putCharB(sizeB_t p, char c)
RexxString * bitXor(RexxString *, RexxString *)
RexxInteger * posRexx(RexxString *, RexxInteger *, RexxInteger *)
bool strCompare(const char *s)
codepoint_t getCharC(sizeC_t p)
RexxInteger * countStrRexx(RexxString *)
RexxString * upper()
RexxInteger * wordPos(RexxString *, RexxInteger *)
RexxString * insert(RexxString *, RexxInteger *, RexxInteger *, RexxString *)
sizeB_t getBLength()
RexxObject * abs()
RexxObject * sign()
virtual bool exists(RexxActivation *)
virtual void assign(RexxActivation *, RexxExpressionStack *, RexxObject *)
static RexxVariableBase * getVariableRetriever(RexxString *variable)
static void qualifyStreamName(const char *unqualifiedName, char *qualifiedName, size_t bufferSize)
static bool valueFunction(RexxString *name, RexxObject *newValue, RexxString *selector, RexxObject *&result)
static RexxString * getMessageText(wholenumber_t code)
static RexxObject * popEnvironment(RexxActivation *context)
static RexxString * getUserid()
static RexxObject * pushEnvironment(RexxActivation *context)
int type
Definition: cmdparse.cpp:383
ssize_t codepoint_t
Definition: rexx.h:232
ssize_t wholenumber_t
Definition: rexx.h:230
char work[256]
char line[LINEBUFSIZE]
signed __int64 int64_t
SSIZE_T ssize_t