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