SourceFile.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 Kernel */
40 /* */
41 /* Primitive Translator Source File Class */
42 /* */
43 /******************************************************************************/
44 #include <ctype.h>
45 #include <string.h>
46 #include "RexxCore.h"
47 #include "StringClass.hpp"
48 #include "ArrayClass.hpp"
49 #include "DirectoryClass.hpp"
50 #include "BufferClass.hpp"
51 #include "RexxActivity.hpp"
52 #include "RexxActivation.hpp"
53 #include "MethodClass.hpp"
54 #include "RexxNativeCode.hpp"
55 #include "RexxCode.hpp"
57 #include "RexxSmartBuffer.hpp"
58 #include "SourceFile.hpp"
59 
60 #include "ExpressionFunction.hpp" /* expression terms */
61 #include "ExpressionMessage.hpp"
62 #include "ExpressionOperator.hpp"
63 #include "ExpressionLogical.hpp"
64 #include "ExpressionList.hpp"
65 
66 #include "ExpressionBaseVariable.hpp" /* base variable management class */
69 #include "ExpressionVariable.hpp"
71 #include "ExpressionStem.hpp"
72 
73 #include "RexxInstruction.hpp" /* base instruction definition */
74 #include "SelectInstruction.hpp"
75 #include "ElseInstruction.hpp"
76 #include "EndIf.hpp"
77 #include "DoInstruction.hpp"
78 #include "CallInstruction.hpp"
79 #include "ProtectedObject.hpp"
80 #include "CPPCode.hpp"
81 #include "SystemInterpreter.hpp"
82 #include "PackageClass.hpp"
83 #include "InterpreterInstance.hpp"
84 #include "ClassDirective.hpp"
85 #include "ExtensionDirective.hpp"
86 #include "LibraryDirective.hpp"
87 #include "RequiresDirective.hpp"
88 #include "PackageManager.hpp"
89 #include "SysFileSystem.hpp"
90 #include "RoutineClass.hpp"
91 #include "ActivationFrame.hpp"
92 #include "StackFrameClass.hpp"
93 #include "BlockClass.hpp"
94 
95 #define HOLDSIZE 60 /* room for 60 temporaries */
96 
97 typedef struct _LINE_DESCRIPTOR {
98  size_t position; /* position within the buffer */
99  sizeB_t length; /* length of the line */
100 } LINE_DESCRIPTOR; /* line within a source buffer */
101 
102 #define line_delimiters "\r\n" /* stream file line end characters */
103 #define ctrl_z 0x1a // the end of file marker
104 
105 /**
106  * Create a source object with source provided from an array.
107  *
108  * @param programname
109  * The name of the program.
110  * @param source_array
111  * The array of the source lines.
112  */
113 RexxSource::RexxSource(RexxString *programname, RexxArray *source_array)
114 {
115  /* fill in the name */
116  setProgramName(programname);
117  /* fill in the source array */
118  OrefSet(this, this->sourceArray, source_array);
119  /* fill in the source size */
120  this->line_count = sourceArray->size();
121  this->position(1, 0); /* set position at the first line */
122 }
123 
124 
125 /**
126  * Create a source object with source provided from a buffer.
127  *
128  * @param programname
129  * The name of the program.
130  * @param source_buffer
131  * The source buffer holding the source data.
132  */
133 RexxSource::RexxSource(RexxString *programname, RexxBuffer *source_buffer)
134 {
135  /* fill in the name */
136  setProgramName(programname);
137  // we require a bit of protection while doing this
138  ProtectedObject p(this);
139  // initialize from the buffer data
140  initBuffered(source_buffer);
141 }
142 
143 
144 /**
145  * Create a source object with source provided from a a data buffer
146  * (not a buffer object).
147  *
148  * @param programname
149  * The name of the program.
150  * @param data The data buffer pointer.
151  * @param length the size of the source buffer.
152  */
153 RexxSource::RexxSource(RexxString *programname, const char *data, size_t length)
154 {
155  /* fill in the name */
156  setProgramName(programname);
157  // we require a bit of protection while doing this
158  ProtectedObject p(this);
159  // initialize from the buffer data
160  initBuffered(new_buffer(data, length));
161 }
162 
163 
164 /**
165  * Create a source object with source provided from a filo.
166  *
167  * @param programname
168  * The name of the program (also the file name)
169  */
171 {
172  /* fill in the name */
173  setProgramName(programname);
174  // we require a bit of protection while doing this
175  ProtectedObject p(this);
176  // read the file data and initialize.
177  initFile();
178 }
179 
180 
182  RexxBuffer *source_buffer) /* containing source buffer */
183 /******************************************************************************/
184 /* Function: Initialize a source object using the entire source as a */
185 /* stream buffer */
186 /******************************************************************************/
187 {
188  LINE_DESCRIPTOR descriptor; /* line description */
189  const char *scan; /* line scanning pointer */
190  const char *_current; /* current scan location */
191  char *start; /* start of the buffer */
192  sizeB_t length; /* length of the buffer */
193 
194  extractNameInformation(); // make sure we have name information to work with
195  /* set the source buffer */
196  OrefSet(this, this->sourceBuffer, source_buffer);
197  RexxSmartBuffer *indices = new RexxSmartBuffer(1024);
198  ProtectedObject p(indices);
199  /* point to the data part */
200  start = this->sourceBuffer->getData();
201  /* get the buffer length */
202  length = this->sourceBuffer->getDataLength();
203 
204  // neutralize shell '#!...'
205  if (start[0] == '#' && start[1] == '!')
206  {
207  memcpy(start, "--", 2);
208  }
209 
210  descriptor.position = 0; /* fill in the "zeroth" position */
211  descriptor.length = 0; /* and the length */
212  /* add to the line list */
213  indices->copyData(&descriptor, sizeof(descriptor));
214  this->line_count = 0; /* start with zero lines */
215  /* look for an EOF mark */
216  scan = (const char *)memchr(start, ctrl_z, length);
217  if (scan != NULL) /* found one? */
218  {
219  length = scan - start; /* reduce the length */
220  }
221  _current = start; /* start at the beginning */
222  while (length != 0)
223  { /* loop until all done */
224  this->line_count++; /* add in another line */
225  /* set the start position */
226  descriptor.position = _current - start;
227  /* scan for a important character */
228  scan = Utilities::locateCharacter(_current, line_delimiters, length);
229  /* need to skip over null chars */
230  while (scan != OREF_NULL && *scan == '\0') // JLF : never enter the loop ? if scan is not null then *scan is necessarily \r or \n, but never \0
231  {
232  /* scan for a linend */
233  scan = Utilities::locateCharacter(scan + 1, line_delimiters, length - (scan - _current - 1));
234  }
235  if (scan == NULL)
236  { /* not found, go to the end */
237  _current = _current + length; /* step to the end */
238  descriptor.length = length; /* use the entire line */
239  length = 0; /* nothing left to process */
240  }
241  else
242  {
243  /* calculate this line length */
244  descriptor.length = scan - _current;
245  /* adjust scan at line end */
246  if (*scan == line_delimiters[0])
247  {/* CR encountered */
248  scan++; /* step the scan position */
249  /* now check for LF */
250  if (length > (size_t)(scan - _current))
251  {
252  if (*scan != '\0' && *scan == line_delimiters[1]) /* */
253  {
254  scan++; /* step again, if required */
255  }
256  }
257  }
258  else /* just a LF */
259  {
260  scan++; /* step the scan position */
261  }
262 
263  length -= scan - _current; /* reduce the length */
264  _current = scan; /* copy the scan pointer */
265  }
266  /* add to the line list */
267  indices->copyData(&descriptor, sizeof(descriptor));
268  }
269  /* throw away the buffer "wrapper" */
270  OrefSet(this, this->sourceIndices, indices->getBuffer());
271  this->position(1, 0); /* set position at the first line */
272 }
273 
274 
276 /******************************************************************************/
277 /* Function: Initialize a source object, reading the source from a file */
278 /******************************************************************************/
279 {
280  /* load the program file */
282  if (program_source == OREF_NULL) /* Program not found or read error? */
283  {
284  /* report this */
286  }
287 
288 #ifdef SCRIPTING
289  if (program_source->getDataLength() > 9)
290  {
291  char begin[10];
292  char end[4];
293  // check, if XML comments have to be removed from the script... (engine situation)
294  memcpy(begin,program_source->getData(), 9);
295  // hashvalue is the length of the buffer
296  memcpy(end, program_source->getData()+ (program_source->getDataLength()-3), 3);
297  begin[9]=end[3]=0x00;
298  if (!Utilities::strCaselessCompare("<![CDATA[",begin) && !Utilities::strCaselessCompare("]]>",end))
299  {
300  memcpy(program_source->getData(), " ", 9);
301  memcpy(program_source->getData() + (program_source->getDataLength() - 3), " ", 3);
302  }
303  }
304 #endif
305 
306  /* save the returned buffer */
307  OrefSet(this, this->sourceBuffer, program_source);
308  /* go process the buffer now */
309  this->initBuffered(this->sourceBuffer);
310 }
311 
312 
313 /**
314  * Extract various bits of the source name to give us directory,
315  * extension and file portions to be used for searches for additional
316  * files.
317  */
319 {
320  if (programName == OREF_NULL)
321  {
322  return;
323  }
324 
328 }
329 
330 
331 /**
332  * Set a program name for this source object. Usually used after
333  * a program restore to update the restored routine object. This
334  * will also update the extension and directory information.
335  *
336  * @param name The new program name.
337  */
339 {
340  OrefSet(this, this->programName, name);
342 }
343 
345 /******************************************************************************/
346 /* Function: Attempt to reconnect to the original source code file */
347 /******************************************************************************/
348 {
349  if (!(this->flags&reclaim_possible)) /* no chance of getting this? */
350  {
351  return false; /* just get out of here */
352  }
353  this->initFile(); /* go reinit this */
354  return true; /* give back the success return */
355 }
356 
358 /******************************************************************************/
359 /* Function: Allow a source reconnect to occur */
360 /******************************************************************************/
361 {
362  this->flags |= reclaim_possible; /* we have a shot at this! */
363 }
364 
365 void RexxSource::adjustLine(size_t start_line_number, size_t end_line_number)
366 /******************************************************************************/
367 /* Arguments: interpret/sourceLiteral line location */
368 /* */
369 /* Function: Adjust the source object so that it thinks it is scanning a */
370 /* set of lines with a line number other than 1 so that errors */
371 /* and trace of an interpreted instruction/ source literal will */
372 /* display the good line numbers. */
373 /******************************************************************************/
374 {
375  /* fill in the source size */
376  this->line_count = end_line_number; /* size is now the end line number */
377  this->line_number = start_line_number;/* we are now on line "nn of mm" */
378  /* remember for positioning */
379  this->line_adjust = start_line_number - 1;
380 }
381 
383  RexxToken *token) /* current token */
384 /******************************************************************************/
385 /* Function: validate that the current token is a variable token */
386 /******************************************************************************/
387 {
388  /* not a variable token? */
389  if (!token->isVariable())
390  {
391  /* begin with a dot? */
392  if (token->value->getCharC(0) == '.')
393  {
395  }
396  else
397  {
399  }
400  }
401 }
402 
404  RexxToken *token) /* current token */
405 /******************************************************************************/
406 /* Function: validate that the current token is a variable token */
407 /******************************************************************************/
408 {
409  /* not a variable token or dot symbol*/
410  if (!token->isVariable() && (token->subclass != SYMBOL_DOTSYMBOL)) {
412  }
413 }
414 
416  int terminators, /* set of possible terminators */
417  RexxToken *token) /* token being processed */
418 /******************************************************************************/
419 /* Function: test for a terminator token in the given context */
420 /******************************************************************************/
421 {
422  bool endtoken; /* found the end flag */
423 
424  endtoken = false; /* not found the end yet */
425 
426  /* process based on terminator class */
427  switch (token->classId)
428  {
429 
430  case TOKEN_EOC: /* found the end-of-clause */
431  endtoken = true; /* this is always an end marker */
432  break;
433 
434  case TOKEN_RIGHT: /* found a right paren */
435  if (terminators&TERM_RIGHT) /* terminate on this? */
436  endtoken = true; /* set the flag */
437  break;
438 
439  case TOKEN_SQRIGHT: /* found a right square bracket */
440  if (terminators&TERM_SQRIGHT) /* terminate on this? */
441  endtoken = true; /* set the flag */
442  break;
443 
444  case TOKEN_COMMA: /* found a comma */
445  if (terminators&TERM_COMMA) /* terminate on this? */
446  endtoken = true; /* set the flag */
447  break;
448 
449  case TOKEN_SYMBOL: /* have a symbol, need to resolve */
450  if (terminators&TERM_KEYWORD)
451  { /* need to do keyword checks? */
452  /* process based on the keyword */
453  // JLF todo ? token->subclass ?
454  switch (this->subKeyword(token))
455  {
456 
457  case SUBKEY_TO: /* TO subkeyword */
458  if (terminators&TERM_TO) /* terminate on this? */
459  endtoken = true; /* set the flag */
460  break;
461 
462  case SUBKEY_BY: /* BY subkeyword */
463  if (terminators&TERM_BY) /* terminate on this? */
464  endtoken = true; /* set the flag */
465  break;
466 
467  case SUBKEY_FOR: /* FOR subkeyword */
468  if (terminators&TERM_FOR) /* terminate on this? */
469  {
470  endtoken = true; /* set the flag */
471  }
472  break;
473 
474  case SUBKEY_WHILE: /* WHILE subkeyword */
475  case SUBKEY_UNTIL: /* UNTIL subkeyword */
476  if (terminators&TERM_WHILE)/* terminate on this? */
477  endtoken = true; /* set the flag */
478  break;
479 
480  case SUBKEY_WITH: /* WITH subkeyword */
481  if (terminators&TERM_WITH) /* terminate on this? */
482  endtoken = true; /* set the flag */
483  break;
484 
485  case SUBKEY_THEN: /* THEN subkeyword */
486  if (terminators&TERM_THEN) /* terminate on this? */
487  endtoken = true; /* set the flag */
488  break;
489 
490  default: /* not a terminator for others */
491  break;
492  }
493  }
494  default: /* not a terminator for others */
495  break;
496  }
497  if (endtoken) /* found the end one? */
498  {
499  previousToken(); /* push it back on the clause */
500  }
501  return endtoken; /* return the true/false flag */
502 }
503 
505 /******************************************************************************/
506 /* Function: Advance the current position to the next source line */
507 /******************************************************************************/
508 {
509  if (this->clause) /* have a clause object? */
510  {
511  /* record current position in clause */
512  this->clause->setEnd(this->line_number, this->line_offset);
513  }
514  /* move to the start of the next line*/
515  this->position(this->line_number + 1, 0);
516 }
517 
519  size_t line, /* target line number */
520  sizeB_t offset) /* target line offset */
521 /******************************************************************************/
522 /* Function: Move the current scan position to a new spot */
523 /******************************************************************************/
524 {
525  LINE_DESCRIPTOR *descriptors; /* line descriptors */
526  const char *buffer_start; /* start of source buffer */
527  RexxString *new_line; /* new line to scan */
528 
529  this->line_number = line; /* set the line number */
530  this->line_offset = offset; /* and the offset */
531  /* past the end? */
532  if (line > this->line_count)
533  {
534  this->current = OREF_NULL; /* null out the current line */
535  this->current_length = 0; /* tag this as a null line */
536  }
537  else
538  {
539  /* working from an array? */
540  if (this->sourceArray != OREF_NULL)
541  {
542  /* get the next line */
543  new_line = (RexxString *)(this->sourceArray->get(line - this->line_adjust));
544  if (new_line == OREF_NULL) /* missing line? */
545  {
546  /* this is an error */
548  }
549  /* not working with a string? */
550  if (!isOfClass(String, new_line))
551  {
552  /* get this as a string */
553  new_line = (RexxString *)new_line->stringValue();
554  if (new_line == TheNilObject) /* got back .nil? */
555  {
556  /* this is an error */
558  }
559  }
560  /* set the program pointer */
561  this->current = new_line->getStringData();
562  /* get the string length */
563  this->current_length = new_line->getBLength();
564  }
565  /* single buffer source */
566  else
567  {
568  /* get the descriptors pointer */
569  descriptors = (LINE_DESCRIPTOR *)(this->sourceIndices->getData());
570  /* source buffered in a string? */
571  if (isOfClass(String, this->sourceBuffer))
572  {
573  /* point to the data part */
574  buffer_start = ((RexxString *)(this->sourceBuffer))->getStringData();
575  }
576  else
577  {
578  /* point to the data part */
579  buffer_start = this->sourceBuffer->getData();
580  }
581  /* calculate the line start */
582  this->current = buffer_start + descriptors[line - this->line_adjust].position;
583  /* and get the length */
584  this->current_length = descriptors[line - this->line_adjust].length;
585  }
586  }
587 }
588 
589 void RexxSource::live(size_t liveMark)
590 /******************************************************************************/
591 /* Perform garbage collection marking of a source object */
592 /******************************************************************************/
593 {
594  memory_mark(this->parentSource);
595  memory_mark(this->sourceArray);
596  memory_mark(this->programName);
599  memory_mark(this->programFile);
600  memory_mark(this->clause);
602  memory_mark(this->sourceBuffer);
603  memory_mark(this->sourceIndices);
604  memory_mark(this->first);
605  memory_mark(this->last);
607  memory_mark(this->savelist);
608  memory_mark(this->holdstack);
609  memory_mark(this->variables);
610  memory_mark(this->literals);
612  memory_mark(this->labels);
613  memory_mark(this->strings);
616  memory_mark(this->control);
617  memory_mark(this->terms);
618  memory_mark(this->subTerms);
619  memory_mark(this->namedSubTerms);
620  memory_mark(this->operators);
621  memory_mark(this->calls);
622  memory_mark(this->routines);
625  memory_mark(this->requires);
626  memory_mark(this->libraries);
628  memory_mark(this->package);
629  memory_mark(this->classes);
630  memory_mark(this->extensions);
635  memory_mark(this->methods);
636  memory_mark(this->active_class);
638  memory_mark(this->initCode);
640 }
641 
642 void RexxSource::liveGeneral(int reason)
643 /******************************************************************************/
644 /* Function: Perform generalized marking of a source object */
645 /******************************************************************************/
646 {
647 #ifndef KEEPSOURCE
648  if (memoryObject.savingImage()) { /* save image time? */
649  /* don't save the source image */
650  OrefSet(this, this->sourceArray, OREF_NULL);
651  OrefSet(this, this->sourceBuffer, OREF_NULL);
652  OrefSet(this, this->sourceIndices, OREF_NULL);
653  OrefSet(this, this->clause, OREF_NULL);
654  /* don't save the install information*/
655  OrefSet(this, this->methods, OREF_NULL);
656  OrefSet(this, this->requires, OREF_NULL);
657  OrefSet(this, this->classes, OREF_NULL);
658  OrefSet(this, this->extensions, OREF_NULL);
659  OrefSet(this, this->routines, OREF_NULL);
660  OrefSet(this, this->libraries, OREF_NULL);
661  OrefSet(this, this->installed_classes, OREF_NULL);
665  this->flags &= ~reclaim_possible; /* can't recover source immediately */
666  }
667 #endif
678  memory_mark_general(this->first);
680  memory_mark_general(this->last);
691  memory_mark_general(this->terms);
695  memory_mark_general(this->calls);
714 }
715 
717 /******************************************************************************/
718 /* Function: Flatten a source object */
719 /******************************************************************************/
720 {
721 
723  /* if we are flattening for EA's, we */
724  /* don't need to to keep source info */
725  /* so ask the envelope if this is a */
726  /* flatten to save the method image */
727  this->sourceArray = OREF_NULL;
728  this->sourceBuffer = OREF_NULL;
729  this->sourceIndices = OREF_NULL;
730  this->securityManager = OREF_NULL;
732  flatten_reference(newThis->sourceArray, envelope);
733  flatten_reference(newThis->parentSource, envelope);
734  flatten_reference(newThis->programName, envelope);
735  flatten_reference(newThis->programDirectory, envelope);
736  flatten_reference(newThis->programExtension, envelope);
737  flatten_reference(newThis->programFile, envelope);
738  flatten_reference(newThis->clause, envelope);
739  flatten_reference(newThis->securityManager, envelope);
740  flatten_reference(newThis->sourceBuffer, envelope);
741  flatten_reference(newThis->sourceIndices, envelope);
742  flatten_reference(newThis->first, envelope);
743  flatten_reference(newThis->last, envelope);
744  flatten_reference(newThis->currentInstruction, envelope);
745  flatten_reference(newThis->savelist, envelope);
746  flatten_reference(newThis->holdstack, envelope);
747  flatten_reference(newThis->variables, envelope);
748  flatten_reference(newThis->literals, envelope);
749  flatten_reference(newThis->sourceLiterals, envelope);
750  flatten_reference(newThis->labels, envelope);
751  flatten_reference(newThis->strings, envelope);
752  flatten_reference(newThis->guard_variables, envelope);
753  flatten_reference(newThis->exposed_variables, envelope);
754  flatten_reference(newThis->control, envelope);
755  flatten_reference(newThis->terms, envelope);
756  flatten_reference(newThis->subTerms, envelope);
757  flatten_reference(newThis->namedSubTerms, envelope);
758  flatten_reference(newThis->operators, envelope);
759  flatten_reference(newThis->calls, envelope);
760  flatten_reference(newThis->routines, envelope);
761  flatten_reference(newThis->public_routines, envelope);
762  flatten_reference(newThis->class_dependencies, envelope);
763  flatten_reference(newThis->requires, envelope);
764  flatten_reference(newThis->libraries, envelope);
765  flatten_reference(newThis->loadedPackages, envelope);
766  flatten_reference(newThis->package, envelope);
767  flatten_reference(newThis->classes, envelope);
768  flatten_reference(newThis->extensions, envelope);
769  flatten_reference(newThis->installed_public_classes, envelope);
770  flatten_reference(newThis->installed_classes, envelope);
771  flatten_reference(newThis->merged_public_classes, envelope);
772  flatten_reference(newThis->merged_public_routines, envelope);
773  flatten_reference(newThis->methods, envelope);
774  flatten_reference(newThis->active_class, envelope);
775  flatten_reference(newThis->active_extension, envelope);
776  flatten_reference(newThis->initCode, envelope);
777  flatten_reference(newThis->interpret_activation, envelope);
778 
780 }
781 
782 
784 /******************************************************************************/
785 /* Function: Return count of lines in the source. If the source is not */
786 /* available, return 0 */
787 /******************************************************************************/
788 {
789  /* currently no source? */
790  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
791  {
792  if (!this->reconnect()) /* unable to recover the source? */
793  {
794  return 0; /* we have no source lines */
795  }
796  }
797  return this->line_count; /* return the line count */
798 }
799 
800 
802 /******************************************************************************/
803 /* Function: Determine if a program is traceable (i.e., the program source */
804 /* is available) */
805 /******************************************************************************/
806 {
807  /* currently no source? */
808  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
809  {
810  return this->reconnect(); /* unable to recover the source? */
811  }
812  return true; /* return the line count */
813 }
814 
816  size_t _position) /* requested source line */
817 /******************************************************************************/
818 /* Function: Extract a give source line from the source program */
819 /******************************************************************************/
820 {
821  LINE_DESCRIPTOR *descriptors; /* line descriptors */
822  const char *buffer_start; /* start of source buffer */
823 
824  if (_position > this->line_count) /* beyond last line? */
825  {
826  return OREF_NULLSTRING; /* just return a null string */
827  }
828  /* working from an array? */
829  if (this->sourceArray != OREF_NULL)
830  {
831  /* return the array line */
832  return(RexxString *)(this->sourceArray->get(_position));
833  }
834  /* buffered version? */
835  else if (this->sourceBuffer != OREF_NULL)
836  {
837  /* get the descriptors pointer */
838  descriptors = (LINE_DESCRIPTOR *)(this->sourceIndices->getData());
839  /* source buffered in a string? */
840  if (isOfClass(String, this->sourceBuffer))
841  {
842  /* point to the data part */
843  buffer_start = ((RexxString *)(this->sourceBuffer))->getStringData();
844  }
845  else
846  {
847  /* point to the data part */
848  buffer_start = this->sourceBuffer->getData();
849  }
850  /* create a new string version */
851  return new_string(buffer_start + descriptors[_position].position, descriptors[_position].length);
852  }
853  else
854  {
855  return OREF_NULLSTRING; /* we have no line */
856  }
857 }
858 
859 #ifdef _DEBUG
860 #define dumpClause(from, source, clause) dumpClauseImpl(from, source, clause)
861 #else
862 #define dumpClause(from, source, clause)
863 #endif
864 
865 void dumpClauseImpl(const char *from, RexxSource *source, RexxClause *clause)
866 {
867  if (!Utilities::traceParsing()) return;
868 
869  RexxString *value = source->extract(clause->clauseLocation, true);
870  ProtectedObject p(value);
871  if (Utilities::traceConcurrency()) dbgprintf(CONCURRENCY_TRACE "...... ... ", Utilities::currentThreadId(), NULL, NULL, 0, ' ');
872  dbgprintf("(Parsing)-------------------------------------------------\n");
873  if (Utilities::traceConcurrency()) dbgprintf(CONCURRENCY_TRACE "...... ... ", Utilities::currentThreadId(), NULL, NULL, 0, ' ');
874  dbgprintf("(Parsing)From %s\n", from);
875  if (Utilities::traceConcurrency()) dbgprintf(CONCURRENCY_TRACE "...... ... ", Utilities::currentThreadId(), NULL, NULL, 0, ' ');
876  dbgprintf("(Parsing)%s\n", value->getStringData());
877  if (Utilities::traceConcurrency()) dbgprintf(CONCURRENCY_TRACE "...... ... ", Utilities::currentThreadId(), NULL, NULL, 0, ' ');
878  dbgprintf("(Parsing)\n");
879 }
880 
881 #ifdef _DEBUG
882 #define dumpTokens(from, source, clause) dumpTokensImpl(from, source, clause)
883 #else
884 #define dumpTokens(from, source, clause)
885 #endif
886 
887 void dumpTokensImpl(const char *from, RexxSource *source, RexxClause *clause)
888 {
889  if (!Utilities::traceParsing()) return;
890 
891  // I think it's better to always start from 1, because this method is called
892  // after the creation of instructions, and the 'first' attribute will be the
893  // first token of the last instruction extracted from the clause.
894  // Here, I want to see ALL the tokens of the clause (after semantic annotation).
895  for (size_t i=1/*clause->first*/; i < clause->free; i++)
896  {
897  RexxToken *token = (RexxToken *)clause->tokens->get(i);
898  if (Utilities::traceConcurrency()) dbgprintf(CONCURRENCY_TRACE "...... ... ", Utilities::currentThreadId(), NULL, NULL, 0, ' ');
899  dbgprintf("(Parsing)startLine=%i startCol=%i endLine=%i endCol=%i ", token->tokenLocation.getLineNumber(), size_v(token->tokenLocation.getOffset()), token->tokenLocation.getEndLine(), size_v(token->tokenLocation.getEndOffset()));
900  dbgprintf("classId=%s subclass=%s numeric=%i ", RexxToken::codeText(token->classId), RexxToken::codeText(token->subclass), token->numeric);
901  if (token->value == NULL)
902  dbgprintf("token=NULL\n");
903  else
904  dbgprintf("token=\"%s\"\n", token->value->getStringData());
905  if (token->classId == TOKEN_EOC) break;
906  }
907 }
908 
910 /*********************************************************************/
911 /* Extract a clause from the source and return as a clause object. */
912 /* The clause object contains a list of all of the tokens contained */
913 /* within the clause and is used by the parser to determine the */
914 /* type of instruction and create the instruction parse tree. */
915 /*********************************************************************/
916 {
917  RexxToken *token; /* current token being processed */
918  SourceLocation location; /* location of the clause */
919  SourceLocation token_location; /* location of each token */
920 
921  /* need to scan off a clause? */
922  if (!(this->flags&reclaimed))
923  {
924  this->clause->newClause(); /* reset the clause object */
925  /* loop until we get an non-null */
926  for (;;)
927  {
928  /* record the start position */
929  this->clause->setStart(this->line_number, this->line_offset);
930  /* get the next source token */
931  /* (blanks are not significant here) */
932  token = this->sourceNextToken(OREF_NULL);
933  /* hit the end of the file? */
934  if (token == OREF_NULL)
935  {
936  this->flags |= no_clause; /* flag this as a no clause */
937  return; /* we're finished */
938  }
939  /* is this the end of the clause? */
940  if (!token->isEndOfClause())
941  {
942  break; /* we've got what we need */
943  }
944  this->clause->newClause(); /* reset the clause object */
945  }
946  /* get the start position */
947  token_location = token->getLocation();
948  location = token_location; /* copy the location info */
949  /* record in clause for errors */
950  this->clause->setLocation(location);
951  /* loop until physical end of clause */
952  for (;;)
953  {
954  /* get the next token of real clause */
955  /* (blanks can be significant) */
956  token = this->sourceNextToken(token);
957  /* get this tokens location */
958  token_location = token->getLocation();
959  if (token->isEndOfClause()) /* end of the clause now? */
960  {
961  break; /* hit the physical end of clause */
962  }
963  }
964  location.setEnd(token_location);
965  /* record the clause position */
966  this->clause->setLocation(location);
967  }
968  this->flags &= ~reclaimed; /* no reclaimed clause */
969  // always set the error information
971 }
972  /* extra space required to format a */
973  /* result line. This overhead is */
974  /* 8 leading spaces for the line */
975  /* number, + 1 space + length of the */
976  /* message prefix (3) + 1 space + */
977  /* 2 for an indent + 2 for the */
978  /* quotes surrounding the value */
979 #define TRACE_OVERHEAD 16
980  /* overhead for a traced instruction */
981  /* (8 digit line number, blank, */
982  /* 3 character prefix, and a blank */
983 #define INSTRUCTION_OVERHEAD 11
984 #define LINENUMBER 6 /* size of a line number */
985 #define PREFIX_OFFSET (LINENUMBER + 1) /* location of the prefix field */
986 #define PREFIX_LENGTH 3 /* length of the prefix flag */
987 #define INDENT_SPACING 2 /* spaces per indentation amount */
988 
989 
990 /**
991  * Create a stack frame for this parsing context.
992  *
993  * @return a stack frame instance for error reporting
994  */
996 {
997  // construct the traceback line before we allocate the stack frame object.
998  // calling this in the constructor argument list can cause the stack frame instance
999  // to be inadvertently reclaimed if a GC is triggered while evaluating the constructor
1000  // arguments.
1001  RexxString *traceback = traceBack(OREF_NULL, clauseLocation, 0, true);
1002  ProtectedObject p_traceback(traceback);
1004 }
1005 
1006 
1007 /**
1008  * Format a source line for tracing
1009  *
1010  * @param activation The activation of the current running code. This can be
1011  * null if this is a translation time error.
1012  * @param location The source line location.
1013  * @param indent The indentation amount to apply to the trace line
1014  * @param trace This is a traced line vs. an error line
1015  *
1016  * @return A formatted trace line, including headers and indentations.
1017  */
1019  size_t indent, bool trace)
1020 {
1021  RexxString *buffer; /* buffer for building result */
1022  RexxString *line; /* actual line data */
1023  size_t outlength; /* output length */
1024  char *linepointer; /* pointer to the line number */
1025  char linenumber[11]; /* formatted line number */
1026 
1027  /* format the value */
1028  sprintf(linenumber,"%lu", location.getLineNumber());
1029 
1030  line = this->extract(location); /* extract the source string */
1031  /* doesn't exist and this isn't a */
1032  /* trace instruction format? */
1033  if (line == OREF_NULLSTRING)
1034  {
1035  // old space code means this is part of the interpreter image. Don't include
1036  // the package name in the message
1037  if (this->isOldSpace())
1038  {
1040  }
1041  // if we have an activation (and we should, since the only time we won't would be for a
1042  // translation time error...and we have source then), ask it to provide a line describing
1043  // the invocation situation
1044  if (activation != OREF_NULL)
1045  {
1046  line = activation->formatSourcelessTraceLine(isInternalCode() ? OREF_REXX : this->programName);
1047  }
1048  // this could be part of the internal code...give a generic message that doesn't identify
1049  // the actual package.
1050  else if (this->isInternalCode())
1051  {
1053  }
1054  else
1055  {
1056  // generic package message.
1057  RexxArray *args = new_array(this->programName);
1058  ProtectedObject p(args);
1060  }
1061  }
1062  /* get an output string */
1063  buffer = raw_string(line->getBLength() + INSTRUCTION_OVERHEAD + indent * INDENT_SPACING);
1064  /* blank out the first part */
1065  buffer->set(0, ' ', INSTRUCTION_OVERHEAD + indent * INDENT_SPACING);
1066  /* copy in the line */
1067  buffer->put(INSTRUCTION_OVERHEAD + indent * INDENT_SPACING, line->getStringData(), line->getBLength());
1068  outlength = strlen(linenumber); /* get the line number length */
1069  linepointer = linenumber; /* point to number start */
1070  /* too long for defined field? */
1071  if (outlength > LINENUMBER)
1072  {
1073  /* step over extra numbers */
1074  linepointer += outlength - LINENUMBER;
1075  *linepointer = '?'; /* overlay a question mark */
1076  outlength = LINENUMBER; /* shorten the length */
1077  }
1078  /* copy in the line number */
1079  buffer->put(LINENUMBER - outlength, linepointer, outlength);
1080  buffer->put(PREFIX_OFFSET, "*-*", PREFIX_LENGTH);
1081  return buffer; /* return formatted buffer */
1082 }
1083 
1085  SourceLocation &location, /* target retrieval structure */
1086  bool newline /* if true then inserts a newline at then end of each line */
1087  )
1088 /******************************************************************************/
1089 /* Extrace a line from the source using the given location information */
1090 /******************************************************************************/
1091 {
1092  /* RexxString * */ ProtectedObject line(OREF_NULLSTRING); /* returned source line */
1093  RexxString *source_line; /* current extracting line */
1094  size_t counter; /* line counter */
1095 
1096  /* currently no source? */
1097  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
1098  {
1099  if (!this->reconnect()) /* unable to recover the source? */
1100  return OREF_NULLSTRING; /* return a null array */
1101  }
1102  /* is the location out of bounds? */
1103  if (location.getLineNumber() == 0 || location.getLineNumber() > this->line_count)
1104  line = OREF_NULLSTRING; /* just give back a null string */
1105  /* all on one line? */
1106  else if (location.getLineNumber() >= location.getEndLine())
1107  /* just extract the string */
1108  line = this->get(location.getLineNumber() - this->line_adjust)->extractB(location.getOffset(),
1109  location.getEndOffset() - location.getOffset());
1110  /* multiple line clause */
1111  else
1112  {
1113  /* get the source line */
1114  source_line = this->get(location.getLineNumber() - this->line_adjust);
1115  /* extract the first part */
1116  line = source_line->extractB(location.getOffset(), source_line->getBLength() - location.getOffset());
1117  if (location.isLimitedTrace()) return line;
1118  /* loop down to end line */
1119  for (counter = location.getLineNumber() + 1 - this->line_adjust; counter < location.getEndLine(); counter++)
1120  {
1121  /* concatenate the next line on */
1122  if (newline) line = ((RexxString*)line)->concatWith(this->get(counter), '\n');
1123  else line = ((RexxString*)line)->concat(this->get(counter));
1124  }
1125  /* now add on the last part */
1126  if (newline) line = ((RexxString*)line)->concatWith(this->get(counter)->extractB(0, location.getEndOffset()), '\n');
1127  else line = ((RexxString*)line)->concat(this->get(counter)->extractB(0, location.getEndOffset()));
1128  }
1129  return line; /* return the extracted line */
1130 }
1131 
1132 
1133 /**
1134  * Extract all of the source from the package.
1135  *
1136  * @return An array of the source lines.
1137  */
1139 {
1140  SourceLocation location;
1141 
1142  location.setLineNumber(1);
1143  location.setEndLine(0);
1144  location.setOffset(0);
1145 
1146  return extractSource(location);
1147 }
1148 
1149 
1150 
1152  SourceLocation &location ) /* target retrieval structure */
1153 /******************************************************************************/
1154 /* Function: Extract a section of source from a method source object, using */
1155 /* the created bounds for the method. */
1156 /******************************************************************************/
1157 {
1158  /* currently no source? */
1159  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
1160  {
1161  if (!this->reconnect()) /* unable to recover the source? */
1162  {
1163  /* return a null array */
1164  return(RexxArray *)TheNullArray->copy();
1165  }
1166  }
1167  /* is the location out of bounds? */
1168  if (location.getLineNumber() == 0 || location.getLineNumber() /*- this->line_adjust*/ > this->line_count)
1169  {
1170  /* just give back a null array */
1171  return (RexxArray *)TheNullArray->copy();
1172  }
1173  else
1174  {
1175  if (location.getEndLine() == 0)
1176  { /* no ending line? */
1177  /* use the last line */
1178  location.setEnd(this->line_count, this->get(line_count)->getBLength());
1179  }
1180  /* end at the line start? */
1181  else if (location.getEndOffset() == 0)
1182  {
1183  // step back a line
1184  location.setEndLine(location.getEndLine() - 1); /* step back a line */
1185  /* end at the line end */
1186  location.setEndOffset(this->get(location.getEndLine())->getBLength());
1187  }
1188  /* get the result array */
1189  RexxArray *source = new_array(location.getEndLine() - location.getLineNumber() + 1);
1190  ProtectedObject p(source);
1191  /* all on one line? */
1192  if (location.getLineNumber() == location.getEndLine())
1193  {
1194  /* get the line */
1195  RexxString *source_line = this->get(location.getLineNumber() - this->line_adjust);
1196  /* extract the line segment */
1197  source_line = source_line->extractB(location.getOffset(), location.getEndOffset() - location.getOffset());
1198  source->put(source_line, 1); /* insert the trailing piece */
1199  return source; /* all done */
1200  }
1201  if (location.getOffset() == 0) /* start on the first location? */
1202  {
1203  /* copy over the entire line */
1204  source->put(this->get(location.getLineNumber()), 1);
1205  }
1206  else
1207  {
1208  /* get the line */
1209  RexxString *source_line = this->get(location.getLineNumber() - this->line_adjust);
1210  /* extract the end portion */
1211  source_line = source_line->extractB(location.getOffset(), source_line->getBLength() - location.getOffset());
1212  source->put(source_line, 1); /* insert the trailing piece */
1213  }
1214 
1215  size_t i = 2;
1216  /* loop until the last line */
1217  for (size_t counter = location.getLineNumber() + 1; counter < location.getEndLine(); counter++, i++)
1218  {
1219  /* copy over the entire line */
1220  source->put(this->get(counter - this->line_adjust), i);
1221  }
1222  /* get the last line */
1223  RexxString *source_line = this->get(location.getEndLine() - this->line_adjust);
1224  /* more than one line? */
1225  if (location.getEndLine() > location.getLineNumber())
1226  {
1227  /* need the entire line? */
1228  if (location.getEndOffset() >= source_line->getBLength())
1229  {
1230  source->put(source_line, i); /* just use it */
1231  }
1232  else
1233  {
1234  /* extract the tail part */
1235  source->put(source_line->extractB(0, location.getEndOffset() - 1), i);
1236  }
1237  }
1238  return source;
1239  }
1240 }
1241 
1243 /******************************************************************************/
1244 /* Function: Perform global parsing initialization */
1245 /******************************************************************************/
1246 {
1247  /* holding pen for temporaries */
1248  OrefSet(this, this->holdstack, new (HOLDSIZE, false) RexxStack(HOLDSIZE));
1249  /* create a save table */
1250  OrefSet(this, this->savelist, new_identity_table());
1251  /* allocate global control tables */
1252  OrefSet(this, this->control, new_queue());
1253  OrefSet(this, this->terms, new_queue());
1254  OrefSet(this, this->subTerms, new_queue());
1255  OrefSet(this, this->namedSubTerms, new_queue());
1256  OrefSet(this, this->operators, new_queue());
1257  OrefSet(this, this->literals, new_directory());
1258  OrefSet(this, this->sourceLiterals, new_list());
1259  // during an image build, we have a global string table. If this is
1260  // available now, use it.
1261  OrefSet(this, this->strings, memoryObject.getGlobalStrings());
1262  if (this->strings == OREF_NULL)
1263  {
1264  // no global string table, use a local copy
1265  OrefSet(this, this->strings, new_directory());
1266  }
1267  /* get the clause object */
1268  OrefSet(this, this->clause, new RexxClause());
1269 }
1270 
1271 
1273 /******************************************************************************/
1274 /* Function: Convert a source object into an executable method */
1275 /******************************************************************************/
1276 {
1277  this->globalSetup(); /* do the global setup part */
1278  /* translate the source program */
1279  RexxCode *newCode = this->translate(OREF_NULL);
1280  ProtectedObject p(newCode);
1281  this->cleanup(); /* release temporary tables */
1282  // if generating a method object, then process the directive installation now
1283  if (isMethod)
1284  {
1285  // force this to install now
1286  install();
1287  }
1288  return newCode; /* return the method */
1289 }
1290 
1292  RexxDirectory *_labels, /* parent label set */
1293  RexxActivation *_activation) /* INTERPRET's activation */
1294 /******************************************************************************/
1295 /* Function: Convert a source object into an executable interpret method */
1296 /******************************************************************************/
1297 {
1298  this->globalSetup(); /* do the global setup part */
1299  this->flags |= _interpret; /* this is an interpret */
1300  OrefSet(this, this->interpret_activation, _activation);
1301  RexxCode *newCode = this->translate(_labels); /* translate the source program */
1302  ProtectedObject p(newCode);
1303  this->cleanup(); /* release temporary tables */
1304  return newCode; /* return the method */
1305 }
1306 
1308  RexxString *string, /* interpret string value */
1309  RexxDirectory *_labels, /* parent labels */
1310  size_t _line_number, /* line number of interpret */
1311  RexxActivation *activation)
1312 /******************************************************************************/
1313 /* Function: Interpret a string in the current activation context */
1314 /******************************************************************************/
1315 {
1316  /* create a source object */
1317  RexxSource *source = new RexxSource (this->programName, new_array(string));
1318  ProtectedObject p(source);
1319  source->adjustLine(_line_number, _line_number);/* fudge the line numbering*/
1320  /* convert to executable form */
1321  return source->interpretMethod(_labels, activation);
1322 }
1323 
1324 void RexxSource::checkDirective(int errorCode)
1325 /******************************************************************************/
1326 /* Function: Verify that no code follows a directive except for more */
1327 /* directive instructions. */
1328 /******************************************************************************/
1329 {
1330  // save the clause location so we can reset for errors
1331  SourceLocation location = clauseLocation;
1332 
1333  this->nextClause(); /* get the next clause */
1334  dumpClause("RexxSource::checkDirective", this, this->clause);
1335  /* have a next clause? */
1336  if (!(this->flags&no_clause))
1337  {
1338  RexxToken *token = nextReal(); /* get the first token */
1339  /* not a directive start? */
1340  if (token->classId != TOKEN_DCOLON)
1341  {
1342  /* this is an error */
1343  syntaxError(errorCode);
1344  }
1345  firstToken(); /* reset to the first token */
1346  this->reclaimClause(); /* give back to the source object */
1347  }
1348  // this resets the current clause location so that any errors on the current
1349  // clause detected after the clause check reports this on the correct line
1350  // number
1351  clauseLocation = location;
1352 }
1353 
1354 
1355 /**
1356  * Test if a directive is followed by a body of Rexx code
1357  * instead of another directive or the end of the source.
1358  *
1359  * @return True if there is a non-directive clause following the current
1360  * clause.
1361  */
1363 {
1364  // assume there's no body here
1365  bool result = false;
1366 
1367  // if we have anything to look at, see if it is a directive or not.
1368  this->nextClause();
1369  dumpClause("RexxSource::hasBody", this, this->clause);
1370  if (!(this->flags&no_clause))
1371  {
1372  // we have a clause, now check if this is a directive or not
1373  RexxToken *token = nextReal();
1374  // not a "::", not a directive, which means we have real code to deal with
1375  result = token->classId != TOKEN_DCOLON;
1376  // reset this clause entirely so we can start parsing for real.
1377  firstToken();
1378  this->reclaimClause();
1379  }
1380  return result;
1381 }
1382 
1383 
1385  RexxObject *object) /* object to "release" */
1386 /******************************************************************************/
1387 /* Function: Remove an object from the save list */
1388 /******************************************************************************/
1389 {
1390  /* have a real object */
1391  if (object != OREF_NULL)
1392  {
1393  this->savelist->remove(object); /* remove from the save table */
1394  this->holdObject(object); /* return this object as held */
1395  }
1396  return object; /* return the object */
1397 }
1398 
1400 /******************************************************************************/
1401 /* Function: Final cleanup after parsing */
1402 /******************************************************************************/
1403 {
1404  /* global area cleanup */
1405  /* release the holding pen */
1406  OrefSet(this, this->holdstack, OREF_NULL);
1407  /* release any saved objects */
1408  OrefSet(this, this->savelist, OREF_NULL);
1409  OrefSet(this, this->literals, OREF_NULL);
1410  OrefSet(this, this->sourceLiterals, OREF_NULL);
1411  OrefSet(this, this->strings, OREF_NULL);
1412  OrefSet(this, this->clause, OREF_NULL);
1413  OrefSet(this, this->control, OREF_NULL);
1414  OrefSet(this, this->terms, OREF_NULL);
1415  OrefSet(this, this->subTerms, OREF_NULL);
1416  OrefSet(this, this->namedSubTerms, OREF_NULL);
1417  OrefSet(this, this->operators, OREF_NULL);
1418  OrefSet(this, this->class_dependencies, OREF_NULL);
1419  OrefSet(this, this->active_class, OREF_NULL);
1420  OrefSet(this, this->active_extension, OREF_NULL);
1421  /* now method parsing areas */
1422  OrefSet(this, this->calls, OREF_NULL);
1423  OrefSet(this, this->variables, OREF_NULL);
1424  OrefSet(this, this->guard_variables, OREF_NULL);
1425  OrefSet(this, this->exposed_variables, OREF_NULL);
1426  OrefSet(this, this->labels, OREF_NULL);
1427  OrefSet(this, this->first, OREF_NULL);
1428  OrefSet(this, this->last, OREF_NULL);
1429  OrefSet(this, this->currentInstruction, OREF_NULL);
1430 }
1431 
1432 
1433 /**
1434  * Merge a parent source context into our context so all of the
1435  * bits that are visible in the parent are also resolvable in our
1436  * context. This is mostly used for dynamically created methods.
1437  *
1438  * @param parent The parent source context.
1439  */
1441 {
1442  // set this as a parent
1443  OrefSet(this, this->parentSource, source);
1444 
1445  // Remember : too early to set up the package global defaults, from the parent.
1446  // At this point, the ::options directives have not been parsed.
1447 }
1448 
1449 
1451 /******************************************************************************/
1452 /* Function: Merge all public class and routine information from a called */
1453 /* program into the full public information of this program. */
1454 /******************************************************************************/
1455 {
1456  // has the source already merged in some public routines? pull those in first,
1457  // so that the direct set will override
1458  if (source->merged_public_routines != OREF_NULL)
1459  {
1460  /* first merged attempt? */
1461  if (this->merged_public_routines == OREF_NULL)
1462  {
1463  /* get the directory */
1465  }
1466  /* loop through the list of routines */
1467  for (HashLink i = source->merged_public_routines->first(); source->merged_public_routines->available(i); i = source->merged_public_routines->next(i))
1468  {
1469  /* copy the routine over */
1471  }
1472 
1473  }
1474 
1475  // now process the direct set
1476  if (source->public_routines != OREF_NULL)
1477  {
1478  /* first merged attempt? */
1479  if (this->merged_public_routines == OREF_NULL)
1480  {
1481  /* get the directory */
1483  }
1484  /* loop through the list of routines */
1485  for (HashLink i = source->public_routines->first(); source->public_routines->available(i); i = source->public_routines->next(i))
1486  {
1487  /* copy the routine over */
1489  }
1490  }
1491 
1492 
1493  // now do the same process for any of the class contexts
1494  if (source->merged_public_classes != OREF_NULL)
1495  {
1496  if (this->merged_public_classes == OREF_NULL)
1497  {
1498  /* get the directory */
1500  }
1501  /* loop through the list of classes, */
1502  for (HashLink i = source->merged_public_classes->first(); source->merged_public_classes->available(i); i = source->merged_public_classes->next(i))
1503  {
1504  /* copy the routine over */
1506  }
1507  }
1508 
1509  // the installed ones are processed second as they will overwrite the imported one, which
1510  // is the behaviour we want
1511  if (source->installed_public_classes != OREF_NULL)
1512  {
1513  if (this->merged_public_classes == OREF_NULL)
1514  {
1515  /* get the directory */
1517  }
1518  /* loop through the list of classes, */
1520  {
1521  /* copy the routine over */
1523  }
1524  }
1525 }
1526 
1527 
1528 /**
1529  * Resolve a directly defined class object in this or a parent
1530  * context.
1531  *
1532  * @param name The name we're searching for (all uppercase).
1533  *
1534  * @return A resolved class object, if found.
1535  */
1537 {
1538  // if we have one locally, then return it.
1539  if (this->routines != OREF_NULL)
1540  {
1541  /* try for a local one first */
1542  RoutineClass *result = (RoutineClass *)(this->routines->fastAt(name));
1543  if (result != OREF_NULL)
1544  {
1545  return result;
1546  }
1547  }
1548 
1549  // we might have a chained context, so check it also
1550  if (parentSource != OREF_NULL)
1551  {
1552  return parentSource->findLocalRoutine(name);
1553  }
1554  // nope, no got one
1555  return OREF_NULL;
1556 }
1557 
1558 
1559 /**
1560  * Resolve a public routine in this source context
1561  *
1562  * @param name The target name.
1563  *
1564  * @return A resolved Routine object, if found.
1565  */
1567 {
1568  // if we have one locally, then return it.
1569  if (this->merged_public_routines != OREF_NULL)
1570  {
1571  /* try for a local one first */
1572  RoutineClass *result = (RoutineClass *)(this->merged_public_routines->fastAt(name));
1573  if (result != OREF_NULL)
1574  {
1575  return result;
1576  }
1577  }
1578 
1579  // we might have a chained context, so check it also
1580  if (parentSource != OREF_NULL)
1581  {
1582  return parentSource->findPublicRoutine(name);
1583  }
1584  // nope, no got one
1585  return OREF_NULL;
1586 }
1587 
1588 
1589 /**
1590  * Resolve a routine from this source files base context.
1591  *
1592  * @param routineName
1593  * The routine name of interest.
1594  *
1595  * @return A RoutineClass instance if located. Returns OREF_NULL if this
1596  * is not known at this level.
1597  */
1599 {
1600  // These lookups are case insensive, so the table are all created using the upper
1601  // case names. Use it once and reuse it.
1602  RexxString *upperName = routineName->upper();
1603  ProtectedObject p1(upperName);
1604  RoutineClass *routineObject = findLocalRoutine(upperName);
1605  if (routineObject != OREF_NULL)
1606  {
1607  return routineObject;
1608  }
1609 
1610  // now try for one pulled in from ::REQUIRES objects
1611  return findPublicRoutine(upperName);
1612 }
1613 
1614 
1615 /**
1616  * Resolve an external call in the context of the program making the
1617  * call. This will use the directory and extension of the context
1618  * program to modify the search order.
1619  *
1620  * @param activity The current activity
1621  * @param name The target name
1622  *
1623  * @return The fully resolved string name of the target program, if one is
1624  * located.
1625  */
1627 {
1629 }
1630 
1631 
1632 /**
1633  * Resolve a directly defined class object in this or a parent
1634  * context.
1635  *
1636  * @param name The name we're searching for (all uppercase).
1637  *
1638  * @return A resolved class object, if found.
1639  */
1641 {
1642  // if we have one locally, then return it.
1643  if (this->installed_classes != OREF_NULL)
1644  {
1645  /* try for a local one first */
1646  RexxClass *result = (RexxClass *)(this->installed_classes->fastAt(name));
1647  if (result != OREF_NULL)
1648  {
1649  return result;
1650  }
1651  }
1652 
1653  // we might have a chained context, so check it also
1654  if (parentSource != OREF_NULL)
1655  {
1656  return parentSource->findInstalledClass(name);
1657  }
1658  // nope, no got one
1659  return OREF_NULL;
1660 }
1661 
1662 
1664 {
1665  // if we have one locally, then return it.
1666  if (this->merged_public_classes != OREF_NULL)
1667  {
1668  /* try for a local one first */
1669  RexxClass *result = (RexxClass *)(this->merged_public_classes->fastAt(name));
1670  if (result != OREF_NULL)
1671  {
1672  return result;
1673  }
1674  }
1675 
1676  // we might have a chained context, so check it also
1677  if (parentSource != OREF_NULL)
1678  {
1679  return parentSource->findPublicClass(name);
1680  }
1681  // nope, no got one
1682  return OREF_NULL;
1683 }
1684 
1685 
1686 /**
1687  * Resolve a class from this source file context (including any
1688  * chained parent contexts).
1689  *
1690  * @param className The target name of the class.
1691  *
1692  * @return The resolved class object, if any.
1693  */
1695 {
1696  RexxString *internalName = className->upper(); /* upper case it */
1697  ProtectedObject p(internalName);
1698  // check for a directly defined one in the source context chain
1699  RexxClass *classObject = findInstalledClass(internalName);
1700  // return if we got one
1701  if (classObject != OREF_NULL)
1702  {
1703  return classObject;
1704  }
1705  // now try for public classes we pulled in from other contexts
1706  classObject = findPublicClass(internalName);
1707  // return if we got one
1708  if (classObject != OREF_NULL)
1709  {
1710  return classObject;
1711  }
1712 
1713  // give the security manager a go
1714  if (this->securityManager != OREF_NULL)
1715  {
1716  classObject = (RexxClass *)securityManager->checkLocalAccess(internalName);
1717  if (classObject != OREF_NULL)
1718  {
1719  return classObject;
1720  }
1721  }
1722 
1723  /* send message to .local */
1724  classObject = (RexxClass *)(ActivityManager::getLocalEnvironment(internalName));
1725  if (classObject != OREF_NULL)
1726  {
1727  return classObject;
1728  }
1729 
1730  /* normal execution? */
1731  if (this->securityManager != OREF_NULL)
1732  {
1733  classObject = (RexxClass *)securityManager->checkEnvironmentAccess(internalName);
1734  if (classObject != OREF_NULL)
1735  {
1736  return classObject;
1737  }
1738  }
1739 
1740  /* last chance, try the environment */
1741  return(RexxClass *)(TheEnvironment->at(internalName));
1742 }
1743 
1744 
1745 /**
1746  * Perform a non-contextual install of a package.
1747  */
1749 {
1750  if (needsInstallation())
1751  {
1752  // In order to install, we need to call something. We manage this by
1753  // creating a dummy stub routine that we can call to force things to install
1754  RexxCode *stub = new RexxCode(this, OREF_NULL, OREF_NULL, 10, FIRST_VARIABLE_INDEX);
1755  ProtectedObject p2(stub);
1756  RoutineClass *code = new RoutineClass(programName, stub);
1757  p2 = code;
1758  ProtectedObject dummy;
1759  code->call(ActivityManager::currentActivity, programName, NULL, 0, 0, dummy);
1760  }
1761 }
1762 
1763 
1765  RexxActivation *activation) /* invoking activation */
1766 /******************************************************************************/
1767 /* Function: Process directive information contained within a method, calling*/
1768 /* all ::requires routines, creating all ::class methods, and */
1769 /* processing all ::routines. */
1770 /******************************************************************************/
1771 {
1772  /* turn the install flag off */
1773  /* immediately, otherwise we may */
1774  /* run into a recursion problem */
1775  /* when class init methods are */
1776  /* processed */
1777  this->flags &= ~_install; /* we are now installed */
1778 
1779  // native packages are processed first. The requires might actually need
1780  // functons loaded by the packages
1781  if (this->libraries != OREF_NULL)
1782  {
1783  /* classes and routines */
1784  // now loop through the requires items
1785  for (size_t i = libraries->firstIndex(); i != LIST_END; i = libraries->nextIndex(i))
1786  {
1787  // and have it do the installs processing
1788  LibraryDirective *library = (LibraryDirective *)this->libraries->getValue(i);
1789  library->install(activation);
1790  }
1791  }
1792 
1793  // native methods and routines are lazy resolved on first use, so we don't
1794  // need to process them here.
1795 
1796  if (this->requires != OREF_NULL) /* need to process ::requires? */
1797  {
1798  /* classes and routines */
1799  // now loop through the requires items
1800  for (size_t i = requires->firstIndex(); i != LIST_END; i = requires->nextIndex(i))
1801  {
1802  // and have it do the installs processing. This is a little roundabout, but
1803  // we end up back in our own context while processing this, and the merge
1804  // of the information happens then.
1805  RequiresDirective *_requires = (RequiresDirective *)this->requires->getValue(i);
1806  _requires->install(activation);
1807  }
1808  }
1809 
1810  // and finally process classes
1811  if (this->classes != OREF_NULL)
1812  {
1813  /* get an installed classes directory*/
1814  OrefSet(this, this->installed_classes, new_directory());
1815  /* and the public classes */
1817  RexxArray *createdClasses = new_array(classes->items());
1818 
1819  ProtectedObject p(createdClasses);
1820  size_t index = 1; // used for keeping track of install order
1821  for (size_t i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1822  {
1823  /* get the class info */
1824  ClassDirective *current_class = (ClassDirective *)this->classes->getValue(i);
1825  // save the newly created class in our array so we can send the activate
1826  // message at the end
1827  RexxClass *newClass = current_class->install(this, activation);
1828  createdClasses->put(newClass, index++);
1829  }
1830  // now send an activate message to each of these classes
1831  for (size_t j = 1; j < index; j++)
1832  {
1833  RexxClass *clz = (RexxClass *)createdClasses->get(j);
1834  clz->sendMessage(OREF_ACTIVATE);
1835  }
1836  }
1837 
1838  // process extensions
1839  if (this->extensions != OREF_NULL)
1840  {
1841  for (size_t i = extensions->firstIndex(); i != LIST_END; i = extensions->nextIndex(i))
1842  {
1843  /* get the extension info */
1844  ExtensionDirective *current_extension = (ExtensionDirective *)this->extensions->getValue(i);
1845  current_extension->install(this, activation);
1846  }
1847  }
1848 }
1849 
1851  RexxDirectory *_labels) /* interpret labels */
1852 /******************************************************************************/
1853 /* Function: Translate a source object into a method object */
1854 /******************************************************************************/
1855 {
1857 
1858  // set up the package global defaults
1866 
1867  /* go translate the lead block */
1868  RexxCode *newMethod = this->translateBlock(_labels);
1869  // we save this in case we need to explicitly run this at install time
1870  OrefSet(this, this->initCode, newMethod);
1871  if (!this->atEnd()) /* have directives to process? */
1872  {
1873  /* create the routines directory */
1874  OrefSet(this, this->routines, new_directory());
1875  /* create the routines directory */
1876  OrefSet(this, this->public_routines, new_directory());
1877  /* and a directory of dependencies */
1878  OrefSet(this, this->class_dependencies, new_directory());
1879  /* create the requires directory */
1880  OrefSet(this, this->requires, new_list());
1881  // and a list of load libraries requiring loading.
1882  OrefSet(this, this->libraries, new_list());
1883  /* create the classes list */
1884  OrefSet(this, this->classes, new_list());
1885  OrefSet(this, this->extensions, new_list());
1886  /* no active class definition */
1887  OrefSet(this, this->active_class, OREF_NULL);
1888  OrefSet(this, this->active_extension, OREF_NULL);
1889  /* translation stopped by a directive*/
1890  if (this->flags&_interpret) /* is this an interpret? */
1891  {
1892  dumpTokens("RexxSource::translate (interpret)", this, this->clause);
1893  this->nextClause(); /* get the directive clause */
1894  dumpClause("RexxSource::translate (interpret)", this, this->clause);
1895  /* raise an error */
1897  }
1898  /* create a directory for ..methods */
1899  OrefSet(this, this->methods, new_directory());
1900 
1901  while (!this->atEnd()) /* loop until end of source */
1902  {
1903  this->directive(); /* process the directive */
1904  }
1905  this->resolveDependencies(); /* go resolve class dependencies */
1906  }
1907  return newMethod; /* return the method */
1908 }
1909 
1910 
1912 /*********************************************************************/
1913 /* Function: Resolve dependencies between ::CLASS directives, */
1914 /* rearranging the order of the directives to preserve */
1915 /* relative ordering wherever possible. Classes with no */
1916 /* dependencies in this source file will be done first, */
1917 /* followed by those with dependencies in the appropriate */
1918 /* order */
1919 /*********************************************************************/
1920 {
1921  // get our class list
1922  if (classes->items() == 0) /* nothing to process? */
1923  {
1924  /* clear out the classes list */
1925  OrefSet(this, this->classes, OREF_NULL);
1926  }
1927  else /* have classes to process */
1928  {
1929  size_t i;
1930  // run through the class list having each directive set up its
1931  // dependencies
1932  for (i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1933  {
1934  /* get the next class */
1935  ClassDirective *current_class = (ClassDirective *)(classes->getValue(i));
1936  // have the class figure out it's in-package dependencies
1937  current_class->addDependencies(class_dependencies);
1938  }
1939 
1940  RexxList *class_order = new_list(); // get a list for doing the order
1941  ProtectedObject p(class_order);
1942 
1943 /* now we repeatedly scan the pending directory looking for a class */
1944 /* with no in-program dependencies - it's an error if there isn't one */
1945 /* as we build the classes we have to remove them (their names) from */
1946 /* pending list and from the remaining dependencies */
1947  while (classes->items() > 0)
1948  {
1949  // this is the next one we process
1950  ClassDirective *next_install = OREF_NULL;
1951  for (i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1952  {
1953  /* get the next class */
1954  ClassDirective *current_class = (ClassDirective *)(classes->getValue(i));
1955  // if this class doesn't have any additional dependencies, pick it next.
1956  if (current_class->dependenciesResolved())
1957  {
1958  next_install = current_class;
1959  // add this to the class ordering
1960  class_order->append((RexxObject *)next_install);
1961  // remove this from the processing list
1962  classes->removeIndex(i);
1963  }
1964  }
1965  if (next_install == OREF_NULL) /* nothing located? */
1966  {
1967  // directive line where we can give as the source of the error
1969  clauseLocation = error_class->getLocation();
1970  /* raise an error */
1972  }
1973  RexxString *class_name = next_install->getName();
1974 
1975  // now go through the pending list telling each of the remaining classes that
1976  // they can remove this dependency from their list
1977  for (i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1978  { /* go remove the dependencies */
1979  /* get a class */
1980  ClassDirective *current_class = (ClassDirective *)classes->getValue(i);
1981  current_class->removeDependency(class_name);
1982  }
1983  }
1984 
1985  /* replace the original class list */
1986  OrefSet(this, this->classes, class_order);
1987  /* don't need the dependencies now */
1988  OrefSet(this, this->class_dependencies, OREF_NULL);
1989  }
1990 
1991  if (this->requires->items() == 0) /* nothing there? */
1992  {
1993  /* just clear it out */
1994  OrefSet(this, this->requires, OREF_NULL);
1995  }
1996  if (this->libraries->items() == 0) /* nothing there? */
1997  {
1998  /* just clear it out */
1999  OrefSet(this, this->libraries, OREF_NULL);
2000  }
2001  if (this->routines->items() == 0) /* no routines to process? */
2002  {
2003  /* just clear it out also */
2004  OrefSet(this, this->routines, OREF_NULL);
2005  }
2006  /* now finally the public routines */
2007  if (this->public_routines->items() == 0)
2008  {
2009  /* just clear it out also */
2010  OrefSet(this, this->public_routines, OREF_NULL);
2011  }
2012  if (this->methods->items() == 0) /* and also the methods directory */
2013  {
2014  /* just clear it out also */
2015  OrefSet(this, this->methods, OREF_NULL);
2016  }
2017 }
2018 
2019 
2020 #define DEFAULT_GUARD 0 /* using defualt guarding */
2021 #define GUARDED_METHOD 1 /* method is a guarded one */
2022 #define UNGUARDED_METHOD 2 /* method is unguarded */
2023 
2024 #define DEFAULT_PROTECTION 0 /* using defualt protection */
2025 #define PROTECTED_METHOD 1 /* security manager permission needed*/
2026 #define UNPROTECTED_METHOD 2 /* no protection. */
2027 
2028 #define DEFAULT_ACCESS_SCOPE 0 /* using defualt scope */
2029 #define PUBLIC_SCOPE 1 /* publicly accessible */
2030 #define PRIVATE_SCOPE 2 /* private scope */
2031 
2032 /**
2033  * Process a ::CLASS directive for a source file.
2034  */
2036 {
2037  RexxToken *token = nextReal(); /* get the next token */
2038  /* not a symbol or a string */
2039  if (!token->isSymbolOrLiteral())
2040  {
2041  /* report an error */
2043  }
2044  RexxString *name = token->value; /* get the routine name */
2045  /* get the exposed name version */
2046  RexxString *public_name = this->commonString(name->upper());
2047  ProtectedObject p(public_name);
2048  /* does this already exist? */
2049  if (this->class_dependencies->entry(public_name) != OREF_NULL)
2050  {
2051  /* have an error here */
2053  }
2054  /* create a dependencies list */
2055  this->flags |= _install; /* have information to install */
2056 
2057  OrefSet(this, this->active_extension, OREF_NULL);
2058  // create a class directive and add this to the dependency list
2059  OrefSet(this, this->active_class, new ClassDirective(name, public_name, this->clause));
2060  this->class_dependencies->put((RexxObject *)active_class, public_name);
2061  // and also add to the classes list
2062  this->classes->append((RexxObject *)this->active_class);
2063 
2064  int Public = DEFAULT_ACCESS_SCOPE; /* haven't seen the keyword yet */
2065  for (;;)
2066  { /* now loop on the option keywords */
2067  token = nextReal(); /* get the next token */
2068  /* reached the end? */
2069  if (token->isEndOfClause())
2070  {
2071  break; /* get out of here */
2072  }
2073  /* not a symbol token? */
2074  else if (!token->isSymbol())
2075  {
2076  /* report an error */
2078  }
2079  else
2080  { /* have some sort of option keyword */
2081  /* get the keyword type */
2082  int type = this->subDirective(token);
2083  if (type != 0) refineSubclass(token, IS_SUBDIRECTIVE);
2084  switch (type)
2085  { /* process each sub keyword */
2086  /* ::CLASS name METACLASS metaclass */
2088  /* already had a METACLASS? */
2090  {
2092  }
2093  token = nextReal(); /* get the next token */
2094  /* not a symbol or a string */
2095  if (!token->isSymbolOrLiteral())
2096  {
2097  /* report an error */
2099  }
2100  /* tag the active class */
2101  this->active_class->setMetaClass(token->value);
2102  break;
2103 
2104 
2105  case SUBDIRECTIVE_PUBLIC: /* ::CLASS name PUBLIC */
2106  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
2107  {
2108  /* duplicates are invalid */
2110  }
2111  Public = PUBLIC_SCOPE; /* turn on the seen flag */
2112  /* just set this as a public object */
2113  this->active_class->setPublic();
2114  break;
2115 
2116  case SUBDIRECTIVE_PRIVATE: /* ::CLASS name PUBLIC */
2117  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
2118  {
2119  /* duplicates are invalid */
2121  }
2122  Public = PRIVATE_SCOPE; /* turn on the seen flag */
2123  break;
2124  /* ::CLASS name SUBCLASS sclass */
2125  case SUBDIRECTIVE_SUBCLASS:
2126  // If we have a subclass set already, this is an error
2128  {
2129  /* duplicates are invalid */
2131  }
2132  token = nextReal(); /* get the next token */
2133  /* not a symbol or a string */
2134  if (!token->isSymbolOrLiteral())
2135  {
2136  /* report an error */
2138  }
2139  /* set the subclass information */
2140  this->active_class->setSubClass(token->value);
2141  break;
2142  /* ::CLASS name MIXINCLASS mclass */
2144  // If we have a subclass set already, this is an error
2146  {
2147  /* duplicates are invalid */
2149  }
2150  token = nextReal(); /* get the next token */
2151  /* not a symbol or a string */
2152  if (!token->isSymbolOrLiteral())
2153  {
2154  /* report an error */
2156  }
2157  /* set the subclass information */
2158  this->active_class->setMixinClass(token->value);
2159  break;
2160  /* ::CLASS name INHERIT iclasses */
2161  case SUBDIRECTIVE_INHERIT:
2162  token = nextReal(); /* get the next token */
2163  /* nothing after the keyword? */
2164  if (token->isEndOfClause())
2165  {
2166  /* report an error */
2168  }
2169  while (!token->isEndOfClause())
2170  {
2171  /* not a symbol or a string */
2172  if (!token->isSymbolOrLiteral())
2173  {
2174  /* report an error */
2176  }
2177  /* add to the inherit list */
2178  this->active_class->addInherits(token->value);
2179  token = nextReal(); /* step to the next token */
2180  }
2181  previousToken(); /* step back a token */
2182  break;
2183 
2184  default: /* invalid keyword */
2185  /* this is an error */
2187  break;
2188  }
2189  }
2190  }
2191 }
2192 
2193 
2194 /**
2195  * Process a ::EXTENSION directive for a source file.
2196  */
2198 {
2199  RexxToken *token = nextReal(); /* get the next token */
2200  /* not a symbol or a string */
2201  if (!token->isSymbolOrLiteral())
2202  {
2203  /* report an error */
2205  }
2206  RexxString *name = token->value; /* get the class name */
2207  /* get the exposed name version */
2208  RexxString *public_name = this->commonString(name->upper());
2209  ProtectedObject p(public_name);
2210  /* create a dependencies list */
2211  this->flags |= _install; /* have information to install */
2212 
2213  OrefSet(this, this->active_class, OREF_NULL);
2214  // create an extension directive
2215  OrefSet(this, this->active_extension, new ExtensionDirective(name, public_name, this->clause));
2216  // add to the extensions list
2217  this->extensions->append((RexxObject *)this->active_extension);
2218 
2219  for (;;)
2220  { /* now loop on the option keywords */
2221  token = nextReal(); /* get the next token */
2222  /* reached the end? */
2223  if (token->isEndOfClause())
2224  {
2225  break; /* get out of here */
2226  }
2227  /* not a symbol token? */
2228  else if (!token->isSymbol())
2229  {
2230  /* report an error */
2232  }
2233  else
2234  { /* have some sort of option keyword */
2235  /* get the keyword type */
2236  int type = this->subDirective(token);
2237  if (type != 0) refineSubclass(token, IS_SUBDIRECTIVE);
2238  switch (type)
2239  { /* process each sub keyword */
2240  case SUBDIRECTIVE_INHERIT:
2241  token = nextReal(); /* get the next token */
2242  /* nothing after the keyword? */
2243  if (token->isEndOfClause())
2244  {
2245  /* report an error */
2247  }
2248  while (!token->isEndOfClause())
2249  {
2250  /* not a symbol or a string */
2251  if (!token->isSymbolOrLiteral())
2252  {
2253  /* report an error */
2255  }
2256  /* add to the inherit list */
2257  this->active_extension->addInherits(token->value);
2258  token = nextReal(); /* step to the next token */
2259  }
2260  previousToken(); /* step back a token */
2261  break;
2262 
2263  default: /* invalid keyword */
2264  /* this is an error */
2266  break;
2267  }
2268  }
2269  }
2270 }
2271 
2272 
2273 /**
2274  * check for a duplicate method.
2275  *
2276  * @param name The name to check.
2277  * @param classMethod
2278  * Indicates whether this is a check for a CLASS or INSTANCE method.
2279  * @param errorMsg
2280  * The error code to use if there is a duplicate.
2281  */
2282 void RexxSource::checkDuplicateMethod(RexxString *name, bool classMethod, int errorMsg)
2283 {
2284  /* no previous ::CLASS or ::EXTENSION directive? */
2285  if (this->active_class == OREF_NULL && this->active_extension == OREF_NULL)
2286  {
2287  if (classMethod) /* supposed to be a class method? */
2288  {
2289  /* this is an error */
2291  }
2292  /* duplicate method name? */
2293  if (this->methods->entry(name) != OREF_NULL)
2294  {
2295  /* this is an error */
2296  syntaxError(errorMsg);
2297  }
2298  }
2299  else if (this->active_extension != OREF_NULL)
2300  {
2301  if (active_extension->checkDuplicateMethod(name, classMethod))
2302  {
2303  /* this is an error */
2304  syntaxError(errorMsg);
2305  }
2306  }
2307  else
2308  { /* add the method to the active class*/
2309  if (active_class->checkDuplicateMethod(name, classMethod))
2310  {
2311  /* this is an error */
2312  syntaxError(errorMsg);
2313  }
2314  }
2315 }
2316 
2317 
2318 /**
2319  * Add a new method to this compilation.
2320  *
2321  * @param name The directory name of the method.
2322  * @param method The method object.
2323  * @param classMethod
2324  * The class/instance method indicator.
2325  */
2326 void RexxSource::addMethod(RexxString *name, RexxMethod *method, bool classMethod)
2327 {
2328  if (this->active_extension != OREF_NULL)
2329  {
2330  active_extension->addMethod(name, method, classMethod);
2331  }
2332  else if (this->active_class == OREF_NULL)
2333  {
2334  this->methods->setEntry(name, method);
2335  }
2336  else
2337  {
2338  active_class->addMethod(name, method, classMethod);
2339  }
2340 }
2341 
2342 
2343 
2344 /**
2345  * Process a ::METHOD directive in a source file.
2346  */
2348 {
2349  int Private = DEFAULT_ACCESS_SCOPE; /* this is a public method */
2350  int Protected = DEFAULT_PROTECTION; /* and is not protected yet */
2351  int guard = DEFAULT_GUARD; /* default is guarding */
2352  bool Class = false; /* default is an instance method */
2353  bool Attribute = false; /* init Attribute flag */
2354  bool abstractMethod = false; // this is an abstract method
2355  RexxToken *token = nextReal(); /* get the next token */
2356  RexxString *externalname = OREF_NULL; /* not an external method yet */
2357 
2358  /* not a symbol or a string */
2359  if (!token->isSymbolOrLiteral())
2360  {
2361  /* report an error */
2363  }
2364  RexxString *name = token->value; /* get the string name */
2365  /* and the name form also */
2366  RexxString *internalname = this->commonString(name->upper());
2367  ProtectedObject p(internalname);
2368  for (;;)
2369  { /* now loop on the option keywords */
2370  token = nextReal(); /* get the next token */
2371  /* reached the end? */
2372  if (token->isEndOfClause())
2373  {
2374  break; /* get out of here */
2375  }
2376  /* not a symbol token? */
2377  else if (!token->isSymbol())
2378  {
2379  /* report an error */
2381  }
2382  else
2383  { /* have some sort of option keyword */
2384  /* process each sub keyword */
2385  switch (this->subDirective(token))
2386  {
2387  /* ::METHOD name CLASS */
2388  case SUBDIRECTIVE_CLASS:
2390  if (Class) /* had one of these already? */
2391  {
2392  /* duplicates are invalid */
2394  }
2395  Class = true; /* flag this for later processing */
2396  break;
2397  /* ::METHOD name EXTERNAL extname */
2398  case SUBDIRECTIVE_EXTERNAL:
2400  /* already had an external? */
2401  if (externalname != OREF_NULL || abstractMethod)
2402  {
2403  /* duplicates are invalid */
2405  }
2406  token = nextReal(); /* get the next token */
2407  /* not a string? */
2408  if (!token->isLiteral())
2409  {
2410  /* report an error */
2412  }
2413  externalname = token->value;
2414  break;
2415  /* ::METHOD name PRIVATE */
2416  case SUBDIRECTIVE_PRIVATE:
2418  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2419  {
2420  /* duplicates are invalid */
2422  }
2423  Private = PRIVATE_SCOPE; /* flag for later processing */
2424  break;
2425  /* ::METHOD name PUBLIC */
2426  case SUBDIRECTIVE_PUBLIC:
2428  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2429  {
2430  /* duplicates are invalid */
2432  }
2433  Private = PUBLIC_SCOPE; /* flag for later processing */
2434  break;
2435  /* ::METHOD name PROTECTED */
2438  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2439  {
2440  /* duplicates are invalid */
2442  }
2443  Protected = PROTECTED_METHOD; /* flag for later processing */
2444  break;
2445  /* ::METHOD name UNPROTECTED */
2448  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2449  {
2450  /* duplicates are invalid */
2452  }
2453  Protected = UNPROTECTED_METHOD; /* flag for later processing */
2454  break;
2455  /* ::METHOD name UNGUARDED */
2458  /* already seen one of these? */
2459  if (guard != DEFAULT_GUARD)
2460  {
2461  /* duplicates are invalid */
2463  }
2464  guard = UNGUARDED_METHOD;/* flag for later processing */
2465  break;
2466  /* ::METHOD name GUARDED */
2467  case SUBDIRECTIVE_GUARDED:
2469  /* already seen one of these? */
2470  if (guard != DEFAULT_GUARD)
2471  {
2472  /* duplicates are invalid */
2474  }
2475  guard = GUARDED_METHOD; /* flag for later processing */
2476  break;
2477  /* ::METHOD name ATTRIBUTE */
2479 
2481  if (Attribute) /* already seen one of these? */
2482  {
2483  /* duplicates are invalid */
2485  }
2486  // cannot have an abstract attribute
2487  if (abstractMethod)
2488  {
2489  /* EXTERNAL and ATTRIBUTE are */
2490  /* mutually exclusive */
2492  }
2493  Attribute = true; /* flag for later processing */
2494  break;
2495 
2496  /* ::METHOD name ABSTRACT */
2497  case SUBDIRECTIVE_ABSTRACT:
2498 
2500  if (abstractMethod || externalname != OREF_NULL)
2501  {
2503  }
2504  // not compatible with ATTRIBUTE or EXTERNAL
2505  if (externalname != OREF_NULL || Attribute)
2506  {
2508  }
2509  abstractMethod = true; /* flag for later processing */
2510  break;
2511 
2512 
2513  default: /* invalid keyword */
2514  /* this is an error */
2516  break;
2517  }
2518  }
2519  }
2520 
2521  // go check for a duplicate and validate the use of the CLASS modifier
2523 
2524 
2525  RexxMethod *_method = OREF_NULL;
2526  // is this an attribute method?
2527  if (Attribute)
2528  {
2529  // now get this as the setter method.
2530  RexxString *setterName = commonString(internalname->concatWithCstring("="));
2531  // need to check for duplicates on that too
2533 
2534  /* Go check the next clause to make */
2535  this->checkDirective(Error_Translation_attribute_method); /* sure that no code follows */
2536  // this might be externally defined setters and getters.
2537  if (externalname != OREF_NULL)
2538  {
2539  RexxString *library = OREF_NULL;
2540  RexxString *procedure = OREF_NULL;
2541  decodeExternalMethod(internalname, externalname, library, procedure);
2542  ProtectedObject p_library(library);
2543  ProtectedObject p_procedure(procedure);
2544  // now create both getter and setting methods from the information.
2545  _method = createNativeMethod(internalname, library, procedure->concatToCstring("GET"));
2546  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2547  // add to the compilation
2548  addMethod(internalname, _method, Class);
2549 
2550  _method = createNativeMethod(setterName, library, procedure->concatToCstring("SET"));
2551  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2552  // add to the compilation
2553  addMethod(setterName, _method, Class);
2554  }
2555  else
2556  {
2557  // now get a variable retriever to get the property
2558  RexxVariableBase *retriever = this->getRetriever(name);
2559 
2560  // create the method pair and quit.
2561  createAttributeGetterMethod(internalname, retriever, Class, Private == PRIVATE_SCOPE,
2562  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2563  createAttributeSetterMethod(setterName, retriever, Class, Private == PRIVATE_SCOPE,
2564  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2565  }
2566  return;
2567  }
2568  // abstract method?
2569  else if (abstractMethod)
2570  {
2571  /* Go check the next clause to make */
2572  this->checkDirective(Error_Translation_abstract_method); /* sure that no code follows */
2573  // this uses a special code block
2574  BaseCode *code = new AbstractCode();
2575  _method = new RexxMethod(name, code);
2576  }
2577  /* not an external method? */
2578  else if (externalname == OREF_NULL)
2579  {
2580  // NOTE: It is necessary to translate the block and protect the code
2581  // before allocating the RexxMethod object. The new operator allocates the
2582  // the object first, then evaluates the constructor arguments after the allocation.
2583  // Since the translateBlock() call will allocate a lot of new objects before returning,
2584  // there's a high probability that the method object can get garbage collected before
2585  // there is any opportunity to protect the object.
2586  RexxCode *code = this->translateBlock(OREF_NULL);
2587  this->saveObject((RexxObject *)code);
2588 
2589  /* go do the next block of code */
2590  _method = new RexxMethod(name, code);
2591  }
2592  else
2593  {
2594  RexxString *library = OREF_NULL;
2595  RexxString *procedure = OREF_NULL;
2596  decodeExternalMethod(internalname, externalname, library, procedure);
2597  ProtectedObject p_library(library);
2598  ProtectedObject p_procedure(procedure);
2599 
2600  /* go check the next clause to make */
2602  // and make this into a method object.
2603  _method = createNativeMethod(name, library, procedure);
2604  }
2605  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2606  // add to the compilation
2607  addMethod(internalname, _method, Class);
2608 }
2609 
2610 
2611 
2612 /**
2613  * Process a ::OPTIONS directive in a source file.
2614  */
2616 {
2617  // all options are of a keyword/value pattern
2618  for (;;)
2619  {
2620  RexxToken *token = nextReal(); /* get the next token */
2621  /* reached the end? */
2622  if (token->isEndOfClause())
2623  {
2624  break; /* get out of here */
2625  }
2626  /* not a symbol token? */
2627  else if (!token->isSymbol())
2628  {
2629  /* report an error */
2631  }
2632  else
2633  { /* have some sort of option keyword */
2634  /* process each sub keyword */
2635  switch (this->subDirective(token))
2636  {
2637  // ::OPTIONS DIGITS nnnn
2638  case SUBDIRECTIVE_DIGITS:
2639  {
2641  token = nextReal(); /* get the next token */
2642  /* not a string? */
2643  if (!token->isSymbolOrLiteral())
2644  {
2645  /* report an error */
2647  }
2648  RexxString *value = token->value; /* get the string value */
2649 
2650  if (!value->requestUnsignedNumber(digits, number_digits()) || digits < 1)
2651  {
2652  /* report an exception */
2654  }
2655  /* problem with the fuzz setting? */
2656  if (digits <= fuzz)
2657  {
2658  /* this is an error */
2660  }
2661  break;
2662  }
2663  // ::OPTIONS FORM ENGINEERING/SCIENTIFIC
2664  case SUBDIRECTIVE_FORM:
2666  token = nextReal(); /* get the next token */
2667  /* not a string? */
2668  if (!token->isSymbol())
2669  {
2670  /* report an error */
2672  }
2673  /* resolve the subkeyword */
2674  /* and process */
2675  switch (this->subKeyword(token))
2676  {
2677 
2678  case SUBKEY_SCIENTIFIC: /* NUMERIC FORM SCIENTIFIC */
2679  refineSubclass(token, IS_SUBKEY);
2681  break;
2682 
2683  case SUBKEY_ENGINEERING: /* NUMERIC FORM ENGINEERING */
2684  refineSubclass(token, IS_SUBKEY);
2686  break;
2687 
2688  default: /* invalid subkeyword */
2689  /* raise an error */
2691  break;
2692 
2693  }
2694  break;
2695  // ::OPTIONS FUZZ nnnn
2696  case SUBDIRECTIVE_FUZZ:
2697  {
2699  token = nextReal(); /* get the next token */
2700  /* not a string? */
2701  if (!token->isSymbolOrLiteral())
2702  {
2703  /* report an error */
2705  }
2706  RexxString *value = token->value; /* get the string value */
2707 
2708  if (!value->requestUnsignedNumber(fuzz, number_digits()))
2709  {
2710  /* report an exception */
2712  }
2713  /* problem with the digits setting? */
2714  if (fuzz >= digits)
2715  {
2716  /* and issue the error */
2718  }
2719  break;
2720  }
2721  // ::OPTIONS TRACE setting
2722  case SUBDIRECTIVE_TRACE:
2723  {
2725  token = nextReal(); /* get the next token */
2726  /* not a string? */
2727  if (!token->isSymbolOrLiteral())
2728  {
2729  /* report an error */
2731  }
2732  RexxString *value = token->value; /* get the string value */
2733  char badOption = 0;
2734  /* process the setting */
2735  if (!parseTraceSetting(value, traceSetting, traceFlags, badOption))
2736  {
2738  }
2739  break;
2740  }
2741  // ::OPTIONS COMMANDS
2742  case SUBDIRECTIVE_COMMANDS:
2743  {
2745  enableCommands = true;
2746  break;
2747  }
2748  // ::OPTIONS NOCOMMANDS
2750  {
2752  enableCommands = false;
2753  break;
2754  }
2755  // ::OPTIONS MACROSPACE
2757  {
2759  enableMacrospace = true;
2760  break;
2761  }
2762  // ::OPTIONS NOMACROSPACE
2764  {
2766  enableMacrospace = false;
2767  break;
2768  }
2769 
2770  default: /* invalid keyword */
2771  /* this is an error */
2773  break;
2774  }
2775  }
2776  }
2777 }
2778 
2779 /**
2780  * Create a native method from a specification.
2781  *
2782  * @param name The method name.
2783  * @param library The library containing the method.
2784  * @param procedure The name of the procedure within the package.
2785  *
2786  * @return A method object representing this method.
2787  */
2789 {
2790  /* create a new native method */
2791  RexxNativeCode *nmethod = PackageManager::resolveMethod(library, procedure);
2792  // raise an exception if this entry point is not found.
2793  if (nmethod == OREF_NULL)
2794  {
2796  }
2797  // this might return a different object if this has been used already
2798  nmethod = (RexxNativeCode *)nmethod->setSourceObject(this);
2799  /* turn into a real method object */
2800  return new RexxMethod(name, nmethod);
2801 }
2802 
2803 /**
2804  * Decode an external library method specification.
2805  *
2806  * @param methodName The internal name of the method (uppercased).
2807  * @param externalSpec
2808  * The external specification string.
2809  * @param library The returned library name.
2810  * @param procedure The returned package name.
2811  */
2812 void RexxSource::decodeExternalMethod(RexxString *methodName, RexxString *externalSpec, RexxString *&library, RexxString *&procedure)
2813 {
2814  // this is the default
2815  procedure = methodName;
2816  library = OREF_NULL;
2817 
2818  /* convert external into words */
2819  RexxArray *_words = this->words(externalSpec);
2820  /* not 'LIBRARY library [entry]' form? */
2821  if (((RexxString *)(_words->get(1)))->strCompare(CHAR_LIBRARY))
2822  {
2823  // full library with entry name version?
2824  if (_words->size() == 3)
2825  {
2826  library = (RexxString *)_words->get(2);
2827  procedure = (RexxString *)_words->get(3);
2828  }
2829  else if (_words->size() == 2)
2830  {
2831  library = (RexxString *)_words->get(2);
2832  }
2833  else // wrong number of tokens
2834  {
2835  /* this is an error */
2837  }
2838  }
2839  else
2840  {
2841  /* unknown external type */
2843  }
2844 }
2845 
2846 #define ATTRIBUTE_BOTH 0
2847 #define ATTRIBUTE_GET 1
2848 #define ATTRIBUTE_SET 2
2849 
2850 
2851 /**
2852  * Process a ::ATTRIBUTE directive in a source file.
2853  */
2855 {
2856  int Private = DEFAULT_ACCESS_SCOPE; /* this is a public method */
2857  int Protected = DEFAULT_PROTECTION; /* and is not protected yet */
2858  int guard = DEFAULT_GUARD; /* default is guarding */
2859  int style = ATTRIBUTE_BOTH; // by default, we create both methods for the attribute.
2860  bool Class = false; /* default is an instance method */
2861  bool abstractMethod = false; // by default, creating a concrete method
2862  RexxToken *token = nextReal(); /* get the next token */
2863 
2864  /* not a symbol or a string */
2865  if (!token->isSymbolOrLiteral())
2866  {
2867  /* report an error */
2869  }
2870  RexxString *name = token->value; /* get the string name */
2871  /* and the name form also */
2872  RexxString *internalname = this->commonString(name->upper());
2873  ProtectedObject p(internalname);
2874  RexxString *externalname = OREF_NULL;
2875 
2876  for (;;)
2877  { /* now loop on the option keywords */
2878  token = nextReal(); /* get the next token */
2879  /* reached the end? */
2880  if (token->isEndOfClause())
2881  {
2882  break; /* get out of here */
2883  }
2884  /* not a symbol token? */
2885  else if (!token->isSymbol())
2886  {
2887  /* report an error */
2889  }
2890  else
2891  { /* have some sort of option keyword */
2892  /* process each sub keyword */
2893  switch (this->subDirective(token))
2894  {
2895  case SUBDIRECTIVE_GET:
2897  // only one of GET/SET allowed
2898  if (style != ATTRIBUTE_BOTH)
2899  {
2901  }
2902  style = ATTRIBUTE_GET;
2903  break;
2904 
2905  case SUBDIRECTIVE_SET:
2907  // only one of GET/SET allowed
2908  if (style != ATTRIBUTE_BOTH)
2909  {
2911  }
2912  style = ATTRIBUTE_SET;
2913  break;
2914 
2915 
2916  /* ::ATTRIBUTE name CLASS */
2917  case SUBDIRECTIVE_CLASS:
2919  if (Class) /* had one of these already? */
2920  {
2921  /* duplicates are invalid */
2923  }
2924  Class = true; /* flag this for later processing */
2925  break;
2926  case SUBDIRECTIVE_PRIVATE:
2928  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2929  {
2930  /* duplicates are invalid */
2932  }
2933  Private = PRIVATE_SCOPE; /* flag for later processing */
2934  break;
2935  /* ::METHOD name PUBLIC */
2936  case SUBDIRECTIVE_PUBLIC:
2938  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2939  {
2940  /* duplicates are invalid */
2942  }
2943  Private = PUBLIC_SCOPE; /* flag for later processing */
2944  break;
2945  /* ::METHOD name PROTECTED */
2948  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2949  {
2950  /* duplicates are invalid */
2952  }
2953  Protected = PROTECTED_METHOD; /* flag for later processing */
2954  break;
2957  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2958  {
2959  /* duplicates are invalid */
2961  }
2962  Protected = UNPROTECTED_METHOD; /* flag for later processing */
2963  break;
2964  /* ::METHOD name UNGUARDED */
2967  /* already seen one of these? */
2968  if (guard != DEFAULT_GUARD)
2969  {
2970  /* duplicates are invalid */
2972  }
2973  guard = UNGUARDED_METHOD;/* flag for later processing */
2974  break;
2975  /* ::METHOD name GUARDED */
2976  case SUBDIRECTIVE_GUARDED:
2978  /* already seen one of these? */
2979  if (guard != DEFAULT_GUARD)
2980  {
2981  /* duplicates are invalid */
2983  }
2984  guard = GUARDED_METHOD; /* flag for later processing */
2985  break;
2986  /* ::METHOD name ATTRIBUTE */
2987  case SUBDIRECTIVE_EXTERNAL:
2989  /* already had an external? */
2990  if (externalname != OREF_NULL || abstractMethod)
2991  {
2992  /* duplicates are invalid */
2994  }
2995  token = nextReal(); /* get the next token */
2996  /* not a string? */
2997  if (!token->isLiteral())
2998  {
2999  /* report an error */
3001  }
3002  externalname = token->value;
3003  break;
3004  /* ::METHOD name ABSTRACT */
3005  case SUBDIRECTIVE_ABSTRACT:
3006 
3007  if (abstractMethod || externalname != OREF_NULL)
3008  {
3010  }
3011  abstractMethod = true; /* flag for later processing */
3012  break;
3013 
3014 
3015  default: /* invalid keyword */
3016  /* this is an error */
3018  break;
3019  }
3020  }
3021  }
3022 
3023  // both attributes same default properties?
3024 
3025  // now get a variable retriever to get the property (do this before checking the body
3026  // so errors get diagnosed on the correct line),
3027  RexxVariableBase *retriever = this->getRetriever(name);
3028 
3029  switch (style)
3030  {
3031  case ATTRIBUTE_BOTH:
3032  {
3034  // now get this as the setter method.
3035  RexxString *setterName = commonString(internalname->concatWithCstring("="));
3037 
3038  // no code can follow the automatically generated methods
3040  if (externalname != OREF_NULL)
3041  {
3042  RexxString *library = OREF_NULL;
3043  RexxString *procedure = OREF_NULL;
3044  decodeExternalMethod(internalname, externalname, library, procedure);
3045  ProtectedObject p_library(library);
3046  ProtectedObject p_procedure(procedure);
3047  // now create both getter and setting methods from the information.
3048  RexxMethod *_method = createNativeMethod(internalname, library, procedure->concatToCstring("GET"));
3049  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3050  // add to the compilation
3051  addMethod(internalname, _method, Class);
3052 
3053  _method = createNativeMethod(setterName, library, procedure->concatToCstring("SET"));
3054  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3055  // add to the compilation
3056  addMethod(setterName, _method, Class);
3057  }
3058  // abstract method?
3059  else if (abstractMethod)
3060  {
3061  // create the method pair and quit.
3062  createAbstractMethod(internalname, Class, Private == PRIVATE_SCOPE,
3063  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3064  createAbstractMethod(setterName, Class, Private == PRIVATE_SCOPE,
3065  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3066  }
3067  else
3068  {
3069  // create the method pair and quit.
3070  createAttributeGetterMethod(internalname, retriever, Class, Private == PRIVATE_SCOPE,
3071  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3072  createAttributeSetterMethod(setterName, retriever, Class, Private == PRIVATE_SCOPE,
3073  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3074  }
3075  break;
3076 
3077  }
3078 
3079  case ATTRIBUTE_GET: // just the getter method
3080  {
3082  // external? resolve the method
3083  if (externalname != OREF_NULL)
3084  {
3085  // no code can follow external methods
3087  RexxString *library = OREF_NULL;
3088  RexxString *procedure = OREF_NULL;
3089  decodeExternalMethod(internalname, externalname, library, procedure);
3090  ProtectedObject p_library(library);
3091  ProtectedObject p_procedure(procedure);
3092  // if there was no procedure explicitly given, create one using the GET/SET convention
3093  if (internalname == procedure)
3094  {
3095  procedure = procedure->concatToCstring("GET");
3096  p_procedure = procedure;
3097  }
3098  // now create both getter and setting methods from the information.
3099  RexxMethod *_method = createNativeMethod(internalname, library, procedure);
3100  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3101  // add to the compilation
3102  addMethod(internalname, _method, Class);
3103  }
3104  // abstract method?
3105  else if (abstractMethod)
3106  {
3107  // no code can follow abstract methods
3109  // create the method pair and quit.
3110  createAbstractMethod(internalname, Class, Private == PRIVATE_SCOPE,
3111  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3112  }
3113  // either written in ooRexx or is automatically generated.
3114  else {
3115  if (hasBody())
3116  {
3117  createMethod(internalname, Class, Private == PRIVATE_SCOPE,
3118  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3119  }
3120  else
3121  {
3122  createAttributeGetterMethod(internalname, retriever, Class, Private == PRIVATE_SCOPE,
3123  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3124  }
3125  }
3126  break;
3127  }
3128 
3129  case ATTRIBUTE_SET:
3130  {
3131  // now get this as the setter method.
3132  RexxString *setterName = commonString(internalname->concatWithCstring("="));
3134  // external? resolve the method
3135  if (externalname != OREF_NULL)
3136  {
3137  // no code can follow external methods
3139  RexxString *library = OREF_NULL;
3140  RexxString *procedure = OREF_NULL;
3141  decodeExternalMethod(internalname, externalname, library, procedure);
3142  ProtectedObject p_library(library);
3143  ProtectedObject p_procedure(procedure);
3144  // if there was no procedure explicitly given, create one using the GET/SET convention
3145  if (internalname == procedure)
3146  {
3147  procedure = procedure->concatToCstring("SET");
3148  p_procedure = procedure;
3149  }
3150  // now create both getter and setting methods from the information.
3151  RexxMethod *_method = createNativeMethod(setterName, library, procedure);
3152  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3153  // add to the compilation
3154  addMethod(setterName, _method, Class);
3155  }
3156  // abstract method?
3157  else if (abstractMethod)
3158  {
3159  // no code can follow abstract methods
3161  // create the method pair and quit.
3162  createAbstractMethod(setterName, Class, Private == PRIVATE_SCOPE,
3163  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3164  }
3165  else
3166  {
3167  if (hasBody()) // just the getter method
3168  {
3169  createMethod(setterName, Class, Private == PRIVATE_SCOPE,
3170  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3171  }
3172  else
3173  {
3174  createAttributeSetterMethod(setterName, retriever, Class, Private == PRIVATE_SCOPE,
3175  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
3176  }
3177  }
3178  break;
3179  }
3180  }
3181 }
3182 
3183 
3184 /**
3185  * Process a ::CONSTANT directive in a source file.
3186  */
3188 {
3189  RexxToken *token = nextReal(); /* get the next token */
3190  /* not a symbol or a string */
3191  if (!token->isSymbolOrLiteral())
3192  {
3193  /* report an error */
3195  }
3196  RexxString *name = token->value; /* get the string name */
3197  /* and the name form also */
3198  RexxString *internalname = this->commonString(name->upper());
3199  ProtectedObject p(internalname);
3200 
3201  // we only expect just a single value token here
3202  token = nextReal(); /* get the next token */
3203  RexxObject *value;
3204  /* not a symbol or a string */
3205  if (!token->isSymbolOrLiteral())
3206  {
3207  // if not a "+" or "-" operator, this is an error
3208  if (!token->isOperator() || (token->subclass != OPERATOR_SUBTRACT && token->subclass != OPERATOR_PLUS))
3209  {
3210  /* report an error */
3212  }
3213  RexxToken *second = nextReal();
3214  // this needs to be a constant symbol...we check for
3215  // numeric below
3216  if (!second->isSymbol() || second->subclass != SYMBOL_CONSTANT)
3217  {
3218  /* report an error */
3220  }
3221  // concat with the sign operator
3222  value = token->value->concat(second->value);
3223  // and validate that this a valid number
3224  if (value->numberString() == OREF_NULL)
3225  {
3226  /* report an error */
3228  }
3229  }
3230  else
3231  {
3232  // this will be some sort of literal value
3233  value = this->commonString(token->value);
3234  }
3235 
3236  token = nextReal(); /* get the next token */
3237  // No other options on this instruction
3238  if (!token->isEndOfClause())
3239  {
3240  /* report an error */
3242  }
3243  // this directive does not allow a body
3245 
3246  // check for duplicates. We only do the class duplicate check if there
3247  // is an active class, otherwise we'll get a syntax error
3249  if (this->active_class != OREF_NULL)
3250  {
3252  }
3253 
3254  // create the method pair and quit.
3255  createConstantGetterMethod(internalname, value);
3256 }
3257 
3258 
3259 /**
3260  * Create a Rexx method body.
3261  *
3262  * @param name The name of the attribute.
3263  * @param classMethod
3264  * Indicates whether we are creating a class or instance method.
3265  * @param privateMethod
3266  * The method's private attribute.
3267  * @param protectedMethod
3268  * The method's protected attribute.
3269  * @param guardedMethod
3270  * The method's guarded attribute.
3271  */
3272 void RexxSource::createMethod(RexxString *name, bool classMethod,
3273  bool privateMethod, bool protectedMethod, bool guardedMethod)
3274 {
3275  // NOTE: It is necessary to translate the block and protect the code
3276  // before allocating the RexxMethod object. The new operator allocates the
3277  // the object first, then evaluates the constructor arguments after the allocation.
3278  // Since the translateBlock() call will allocate a lot of new objects before returning,
3279  // there's a high probability that the method object can get garbage collected before
3280  // there is any opportunity to protect the object.
3281  RexxCode *code = this->translateBlock(OREF_NULL);
3282  this->saveObject((RexxObject *)code);
3283 
3284  /* go do the next block of code */
3285  RexxMethod *_method = new RexxMethod(name, code);
3286  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3287  // go add the method to the accumulator
3288  addMethod(name, _method, classMethod);
3289 }
3290 
3291 
3292 /**
3293  * Create an ATTRIBUTE "get" method.
3294  *
3295  * @param name The name of the attribute.
3296  * @param retriever
3297  * @param classMethod
3298  * Indicates we're adding a class or instance method.
3299  * @param privateMethod
3300  * The method's private attribute.
3301  * @param protectedMethod
3302  * The method's protected attribute.
3303  * @param guardedMethod
3304  * The method's guarded attribute.
3305  */
3307  bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
3308 {
3309  // create the kernel method for the accessor
3310  BaseCode *code = new AttributeGetterCode(retriever);
3311  RexxMethod *_method = new RexxMethod(name, code);
3312  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3313  // add this to the target
3314  addMethod(name, _method, classMethod);
3315 }
3316 
3317 
3318 /**
3319  * Create an ATTRIBUTE "set" method.
3320  *
3321  * @param name The name of the attribute.
3322  * @param classMethod
3323  * Indicates we're adding a class or instance method.
3324  * @param privateMethod
3325  * The method's private attribute.
3326  * @param protectedMethod
3327  * The method's protected attribute.
3328  * @param guardedMethod
3329  * The method's guarded attribute.
3330  */
3332  bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
3333 {
3334  // create the kernel method for the accessor
3335  BaseCode *code = new AttributeSetterCode(retriever);
3336  RexxMethod *_method = new RexxMethod(name, code);
3337  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3338  // add this to the target
3339  addMethod(name, _method, classMethod);
3340 }
3341 
3342 
3343 /**
3344  * Create an abstract method.
3345  *
3346  * @param name The name of the method.
3347  * @param classMethod
3348  * Indicates we're adding a class or instance method.
3349  * @param privateMethod
3350  * The method's private attribute.
3351  * @param protectedMethod
3352  * The method's protected attribute.
3353  * @param guardedMethod
3354  * The method's guarded attribute.
3355  */
3357  bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
3358 {
3359  // create the kernel method for the accessor
3360  // this uses a special code block
3361  BaseCode *code = new AbstractCode();
3362  RexxMethod * _method = new RexxMethod(name, code);
3363  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3364  // add this to the target
3365  addMethod(name, _method, classMethod);
3366 }
3367 
3368 
3369 /**
3370  * Create a CONSTANT "get" method.
3371  *
3372  * @param target The target method directory.
3373  * @param name The name of the attribute.
3374  */
3376 {
3377  ConstantGetterCode *code = new ConstantGetterCode(value);
3378  // add this as an unguarded method
3379  RexxMethod *method = new RexxMethod(name, code);
3380  method->setUnguarded();
3382  {
3383  addMethod(name, method, false);
3384  }
3385  else if (active_extension != OREF_NULL)
3386  {
3387  active_extension->addConstantMethod(name, method);
3388  }
3389  else
3390  {
3391  active_class->addConstantMethod(name, method);
3392  }
3393 }
3394 
3395 
3396 /**
3397  * Process a ::routine directive in a source file.
3398  */
3400 {
3401  RexxToken *token = nextReal(); /* get the next token */
3402  /* not a symbol or a string */
3403  if (!token->isSymbolOrLiteral())
3404  {
3405  /* report an error */
3407  }
3408  RexxString *name = token->value; /* get the routine name */
3409  /* does this already exist? */
3410  if (this->routines->entry(name) != OREF_NULL)
3411  {
3412  /* have an error here */
3414  }
3415  this->flags |= _install; /* have information to install */
3416  RexxString *externalname = OREF_NULL; /* no external name yet */
3417  int Public = DEFAULT_ACCESS_SCOPE; /* not a public routine yet */
3418  for (;;) /* now loop on the option keywords */
3419  {
3420  token = nextReal(); /* get the next token */
3421  /* reached the end? */
3422  if (token->isEndOfClause())
3423  {
3424  break; /* get out of here */
3425  }
3426  /* not a symbol token? */
3427  else if (!token->isSymbol())
3428  {
3429  /* report an error */
3431  }
3432  /* process each sub keyword */
3433  switch (this->subDirective(token))
3434  {
3435  /* ::ROUTINE name EXTERNAL []*/
3436  case SUBDIRECTIVE_EXTERNAL:
3438  /* already had an external? */
3439  if (externalname != OREF_NULL)
3440  {
3441  /* duplicates are invalid */
3443  }
3444  token = nextReal(); /* get the next token */
3445  /* not a string? */
3446  if (!token->isLiteral())
3447  {
3448  /* report an error */
3450  }
3451  /* external name is token value */
3452  externalname = token->value;
3453  break;
3454  /* ::ROUTINE name PUBLIC */
3455  case SUBDIRECTIVE_PUBLIC:
3457  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
3458  {
3459  /* duplicates are invalid */
3461 
3462  }
3463  Public = PUBLIC_SCOPE; /* turn on the seen flag */
3464  break;
3465  /* ::ROUTINE name PUBLIC */
3466  case SUBDIRECTIVE_PRIVATE:
3468  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
3469  {
3470  /* duplicates are invalid */
3472 
3473  }
3474  Public = PRIVATE_SCOPE; /* turn on the seen flag */
3475  break;
3476 
3477  default: /* invalid keyword */
3478  /* this is an error */
3480  break;
3481  }
3482  }
3483  {
3484  this->saveObject(name); /* protect the name */
3485 
3486  if (externalname != OREF_NULL) /* have an external routine? */
3487  {
3488  /* convert external into words */
3489  RexxArray *_words = this->words(externalname);
3490  // ::ROUTINE foo EXTERNAL "LIBRARY libbar [foo]"
3491  if (((RexxString *)(_words->get(1)))->strCompare(CHAR_LIBRARY))
3492  {
3493  RexxString *library = OREF_NULL;
3494  // the default entry point name is the internal name
3495  RexxString *entry = name;
3496 
3497  // full library with entry name version?
3498  if (_words->size() == 3)
3499  {
3500  library = (RexxString *)_words->get(2);
3501  entry = (RexxString *)_words->get(3);
3502  }
3503  else if (_words->size() == 2)
3504  {
3505  library = (RexxString *)_words->get(2);
3506  }
3507  else // wrong number of tokens
3508  {
3509  /* this is an error */
3511  }
3512 
3513  /* go check the next clause to make */
3514  this->checkDirective(Error_Translation_external_routine); /* sure no code follows */
3515  /* create a new native method */
3516  RoutineClass *routine = PackageManager::resolveRoutine(library, entry);
3517  // raise an exception if this entry point is not found.
3518  if (routine == OREF_NULL)
3519  {
3521  }
3522  // make sure this is attached to the source object for context information
3523  routine->setSourceObject(this);
3524  /* add to the routine directory */
3525  this->routines->setEntry(name, routine);
3526  if (Public == PUBLIC_SCOPE) /* a public routine? */
3527  {
3528  /* add to the public directory too */
3529  this->public_routines->setEntry(name, routine);
3530  }
3531  }
3532 
3533  // ::ROUTINE foo EXTERNAL "REGISTERED libbar [foo]"
3534  else if (((RexxString *)(_words->get(1)))->strCompare(CHAR_REGISTERED))
3535  {
3536  RexxString *library = OREF_NULL;
3537  // the default entry point name is the internal name
3538  RexxString *entry = name;
3539 
3540  // full library with entry name version?
3541  if (_words->size() == 3)
3542  {
3543  library = (RexxString *)_words->get(2);
3544  entry = (RexxString *)_words->get(3);
3545  }
3546  else if (_words->size() == 2)
3547  {
3548  library = (RexxString *)_words->get(2);
3549  }
3550  else // wrong number of tokens
3551  {
3552  /* this is an error */
3554  }
3555 
3556  /* go check the next clause to make */
3557  this->checkDirective(Error_Translation_external_routine); /* sure no code follows */
3558  /* create a new native method */
3559  RoutineClass *routine = PackageManager::resolveRoutine(name, library, entry);
3560  // raise an exception if this entry point is not found.
3561  if (routine == OREF_NULL)
3562  {
3564  }
3565  // make sure this is attached to the source object for context information
3566  routine->setSourceObject(this);
3567  /* add to the routine directory */
3568  this->routines->setEntry(name, routine);
3569  if (Public == PUBLIC_SCOPE) /* a public routine? */
3570  {
3571  /* add to the public directory too */
3572  this->public_routines->setEntry(name, routine);
3573  }
3574  }
3575  else
3576  {
3577  /* unknown external type */
3579  }
3580  }
3581  else
3582  {
3583  // NOTE: It is necessary to translate the block and protect the code
3584  // before allocating the RexxMethod object. The new operator allocates the
3585  // the object first, then evaluates the constructor arguments after the allocation.
3586  // Since the translateBlock() call will allocate a lot of new objects before returning,
3587  // there's a high probability that the method object can get garbage collected before
3588  // there is any opportunity to protect the object.
3589  RexxCode *code = this->translateBlock(OREF_NULL);
3590  this->saveObject((RexxObject *)code);
3591  RoutineClass *routine = new RoutineClass(name, code);
3592  /* add to the routine directory */
3593  this->routines->setEntry(name, routine);
3594  if (Public == PUBLIC_SCOPE) /* a public routine? */
3595  {
3596  /* add to the public directory too */
3597  this->public_routines->setEntry(name, routine);
3598 
3599  }
3600  }
3601  this->toss(name); /* release the "Gary Cole" (GC) lock */
3602  }
3603 }
3604 
3605 /**
3606  * Process a ::REQUIRES directive.
3607  */
3609 {
3610  RexxToken *token = nextReal(); /* get the next token */
3611  /* not a symbol or a string */
3612  if (!token->isSymbolOrLiteral())
3613  {
3614  /* report an error */
3616  }
3617  RexxString *name = token->value; /* get the requires name */
3618  token = nextReal(); /* get the next token */
3619  if (!token->isEndOfClause()) /* something appear after this? */
3620  {
3621  // this is potentially a library directive
3622  libraryDirective(name, token);
3623  return;
3624  }
3625  this->flags |= _install; /* have information to install */
3626  /* save the ::requires location */
3627  this->requires->append((RexxObject *)new RequiresDirective(name, this->clause));
3628 }
3629 
3630 
3631 /**
3632  * Process a ::REQUIRES name LIBRARY directive.
3633  */
3635 {
3636  // we have an extra token on a ::REQUIRES directive. The only thing accepted here
3637  // is the token LIBRARY.
3638  if (!token->isSymbol())
3639  {
3641  }
3642  /* process each sub keyword */
3643  if (subDirective(token) != SUBDIRECTIVE_LIBRARY)
3644  {
3646  }
3648  token = nextReal(); /* get the next token */
3649  if (!token->isEndOfClause()) /* something appear after this? */
3650  {
3651  // nothing else allowed after this
3653  }
3654  this->flags |= _install; /* have information to install */
3655  // add this to the library list
3656  this->libraries->append((RexxObject *)new LibraryDirective(name, this->clause));
3657 }
3658 
3659 
3661 /********************************************************************/
3662 /* Function: parse a directive statement */
3663 /********************************************************************/
3664 {
3665  RexxToken *token; /* current token under processing */
3666 
3667  dumpClause("RexxSource::directive", this, this->clause);
3668  this->nextClause(); /* get the directive clause */
3669  dumpClause("RexxSource::directive", this, this->clause);
3670  if (this->flags&no_clause) /* reached the end? */
3671  return; /* all finished */
3672  token = nextReal(); /* skip the leading :: */
3673  if (token->classId != TOKEN_DCOLON) /* reached the end of a block? */
3674  /* have an error here */
3676  token = nextReal(); /* get the keyword token */
3677  if (!token->isSymbol()) /* not a symbol? */
3678  /* have an error here */
3680 
3681  int directiveType = this->keyDirective(token);
3682  if (directiveType != 0 ) refineSubclass(token, IS_DIRECTIVE);
3683  switch (this->keyDirective(token))
3684  { /* match against the directive list */
3685 
3686  case DIRECTIVE_CLASS: /* ::CLASS directive */
3687  classDirective();
3688  break;
3689 
3690  case DIRECTIVE_EXTENSION: /* ::EXTENSION directive */
3692  break;
3693 
3694  case DIRECTIVE_METHOD: /* ::METHOD directive */
3695  methodDirective();
3696  break;
3697 
3698  case DIRECTIVE_ROUTINE: /* ::ROUTINE directive */
3699  routineDirective();
3700  break;
3701 
3702  case DIRECTIVE_REQUIRES: /* ::REQUIRES directive */
3704  break;
3705 
3706  case DIRECTIVE_ATTRIBUTE: /* ::ATTRIBUTE directive */
3708  break;
3709 
3710  case DIRECTIVE_CONSTANT: /* ::CONSTANT directive */
3712  break;
3713 
3714  case DIRECTIVE_OPTIONS: /* ::OPTIONS directive */
3715  optionsDirective();
3716  break;
3717 
3718  default: /* unknown directive */
3720  break;
3721  }
3722 }
3723 
3724 
3726  RexxInstruction *_instruction) /* next instruction */
3727 /******************************************************************************/
3728 /* Function: Flush any pending compound instructions from the control stack */
3729 /* for new added instructions */
3730 /******************************************************************************/
3731 {
3732  size_t type; /* instruction type */
3733  RexxInstruction *second; /* additional created instructions */
3734 
3735  /* loop through the control stack */
3736  for (;;)
3737  {
3738  type = this->topDo()->getType(); /* get the instruction type */
3739  /* pending ELSE close? */
3740  if (type == KEYWORD_ELSE)
3741  {
3742  second = this->popDo(); /* pop the item off of the control */
3743  /* create a new end marker */
3744  second = this->endIfNew((RexxInstructionIf *)second);
3745  /* have an instruction? */
3746  if (_instruction != OREF_NULL)
3747  {
3748  this->addClause(_instruction); /* add this here */
3749  _instruction = OREF_NULL; /* don't process more instructions */
3750  }
3751  this->addClause(second); /* add the clause to the list */
3752  }
3753  /* nested IF-THEN situation? */
3754  else if (type == KEYWORD_IFTHEN || type == KEYWORD_WHENTHEN)
3755  {
3756  second = this->popDo(); /* pop the item off of the control */
3757  /* have an instruction? */
3758  if (_instruction != OREF_NULL)
3759  {
3760  this->addClause(_instruction); /* add this here */
3761  _instruction = OREF_NULL; /* don't process more instructions */
3762  /* create a new end marker */
3763  second = this->endIfNew((RexxInstructionIf *)second);
3764  this->addClause(second); /* add the clause to the list */
3765  this->pushDo(second); /* add to the control stack too */
3766  }
3767  else
3768  {
3769  /* create a new end marker */
3770  second = this->endIfNew((RexxInstructionIf *)second);
3771  this->addClause(second); /* add the clause to the list */
3772  this->pushDo(second); /* add to the control stack too */
3773  }
3774  break; /* finish up here */
3775  }
3776  /* some other type of construct */
3777  else
3778  {
3779  if (_instruction != OREF_NULL) /* have an instruction? */
3780  {
3781  this->addClause(_instruction); /* add this here */
3782  }
3783  break; /* finished flushing */
3784  }
3785  }
3786 }
3787 
3789  RexxDirectory *_labels ) /* labels (for interpret) */
3790 /******************************************************************************/
3791 /* Function: Translate a block of REXX code (delimited by possible */
3792 /* directive instructions */
3793 /******************************************************************************/
3794 {
3795  RexxInstruction *_instruction; /* created instruction item */
3796  RexxInstruction *second; /* secondary clause for IF/WHEN */
3797  RexxToken *token; /* current working token */
3798  size_t type; /* instruction type information */
3799  size_t controltype; /* type on the control stack */
3800 
3801  /* no instructions yet */
3802  OrefSet(this, this->first, OREF_NULL);
3803  OrefSet(this, this->last, OREF_NULL);
3804  /* allocate the call list */
3805  OrefSet(this, this->calls, new_list());
3806  /* create variables and lit tables */
3807  OrefSet(this, this->variables, (RexxDirectory *)TheCommonRetrievers->copy());
3808  /* restart the variable index */
3810  OrefSet(this, this->exposed_variables, new_directory());
3811  if (this->flags&_interpret) /* this an interpret? */
3812  {
3813  /* just use the existing label set */
3814  OrefSet(this, this->labels, _labels);
3815  }
3816  else
3817  {
3818  /* create a new labels directory */
3819  OrefSet(this, this->labels, new_directory());
3820  }
3821  /* not collecting guard variables yet*/
3822  OrefSet(this, this->guard_variables, OREF_NULL);
3823  this->maxstack = 0; /* clear all of the stack accounting */
3824  this->currentstack = 0; /* fields */
3825  this->flags &= ~no_clause; /* not reached the end yet */
3826 
3827  /* add the first dummy instruction */
3828  _instruction = new RexxInstruction(OREF_NULL, KEYWORD_FIRST);
3829  this->pushDo(_instruction); /* set bottom of control stack */
3830  this->addClause(_instruction); /* add to the instruction list */
3831  dumpTokens("RexxSource::translateBlock#1", this, this->clause);
3832  this->nextClause(); /* get the next physical clause */
3833  dumpClause("RexxSource::translateBlock#1", this, this->clause);
3834  for (;;) /* process all clauses */
3835  {
3836  _instruction = OREF_NULL; /* zero the instruction pointer */
3837  while (!(this->flags&no_clause)) /* scan through all labels */
3838  {
3839  /* resolve the instruction type */
3840  _instruction = this->instruction();
3841  if (_instruction == OREF_NULL) /* found a directive clause? */
3842  {
3843  break; /* return to higher level */
3844  }
3845  /* is this a label? */
3846  if (_instruction->getType() != KEYWORD_LABEL)
3847  {
3848  break; /* have a non-label clause */
3849  }
3850  this->addClause(_instruction); /* add this to clause list */
3851  dumpTokens("RexxSource::translateBlock#2", this, this->clause);
3852  this->nextClause(); /* get the next physical clause */
3853  dumpClause("RexxSource::translateBlock#2", this, this->clause);
3854  _instruction = OREF_NULL; /* no instruction any more */
3855  }
3856  /* get an end-of-clause? */
3857  if (this->flags&no_clause || _instruction == OREF_NULL)
3858  {
3859  /* get the control stack type */
3860  controltype = this->topDo()->getType();
3861  /* while end of an IF or WHEN */
3862  while (controltype == KEYWORD_ENDTHEN || controltype == KEYWORD_ENDWHEN)
3863  {
3864  this->popDo(); /* pop pending closing IFs */
3865  this->flushControl(OREF_NULL); /* flush any IFs or ELSEs */
3866  /* get the control stack type */
3867  controltype = this->topDo()->getType();
3868  }
3869  /* any unclosed composite clauses? */
3870  if (this->topDo()->getType() != KEYWORD_FIRST)
3871  {
3872  /* report the block error */
3873  blockSyntaxError(this->topDo());
3874  }
3875  this->popDo(); /* remove the top one */
3876  break; /* done parsing this section */
3877  }
3878  type = _instruction->getType(); /* get the top instruction type */
3879  if (type != KEYWORD_ELSE) /* have a pending THEN to finish */
3880  {
3881  /* get the control stack type */
3882  controltype = this->topDo()->getType();
3883  /* while end of an IF or WHEN */
3884  while (controltype == KEYWORD_ENDTHEN || controltype == KEYWORD_ENDWHEN)
3885  {
3886  this->popDo(); /* pop pending closing IFs */
3887  this->flushControl(OREF_NULL); /* flush any IFs or ELSEs */
3888  /* get the control stack type */
3889  controltype = this->topDo()->getType();
3890  }
3891  }
3892  if (type == KEYWORD_IF || type == KEYWORD_SELECT || type == KEYWORD_DO || type == KEYWORD_LOOP)
3893  {
3894  this->addClause(_instruction); /* add to instruction heap */
3895  }
3896  else if (type != KEYWORD_ELSE) /* not a new control level */
3897  {
3898  this->flushControl(_instruction); /* flush any IFs or ELSEs */
3899  }
3900  /* have a bad instruction within a */
3901  /* SELECT instruction? */
3902  if (this->topDo()->getType() == KEYWORD_SELECT &&
3904  {
3906  }
3907 
3908  switch (type) /* post process the instructions */
3909  {
3910  case KEYWORD_WHEN: /* WHEN clause of SELECT */
3911  second = this->topDo(); /* get the top of the queue */
3912  /* not working on a SELECT? */
3913  if (second->getType() != KEYWORD_SELECT)
3914  {
3916  }
3917  /* add this to the select list */
3918  ((RexxInstructionSelect *)second)->addWhen((RexxInstructionIf *)_instruction);
3919  /* just fall into IF logic */
3920 
3921  case KEYWORD_IF: /* start of an IF instruction */
3922  token = nextReal(); /* get the terminator token */
3923  /* have a terminator before the THEN?*/
3924  if (token->isEndOfClause())
3925  {
3926  dumpTokens("RexxSource::translateBlock#3", this, this->clause);
3927  this->nextClause(); /* get the next physical clause */
3928  dumpClause("RexxSource::translateBlock#3", this, this->clause);
3929  if (this->flags&no_clause) /* get an end-of-file? */
3930  {
3931  /* raise an error */
3932  syntaxError(Error_Then_expected_if, _instruction);
3933  }
3934  token = nextReal(); /* get the first token */
3935  /* not a THEN keyword? */
3936  if (!token->isSymbol() || this->keyword(token) != KEYWORD_THEN)
3937  {
3938  /* have an error */
3939  syntaxError(Error_Then_expected_if, _instruction);
3940  }
3941  /* create a new then clause */
3942  second = this->thenNew(token, (RexxInstructionIf *)_instruction);
3943  token = nextReal(); /* get token after THEN keyword */
3944  /* terminator here? */
3945  if (token->isEndOfClause())
3946  {
3947  dumpTokens("RexxSource::translateBlock#4", this, this->clause);
3948  this->nextClause(); /* get the next physical clause */
3949  dumpClause("RexxSource::translateBlock#4", this, this->clause);
3950  if (this->flags&no_clause) /* get an end-of-file? */
3951  {
3952  /* raise an error */
3953  syntaxError(Error_Incomplete_do_then, _instruction);
3954  }
3955  }
3956  else
3957  {
3958  previousToken(); /* step back a token */
3959  trimClause(); /* make this start of the clause */
3960  }
3961  }
3962  else /* if expr THEN form */
3963  {
3964  /* create a new then clause */
3965  second = this->thenNew(token, (RexxInstructionIf *)_instruction);
3966  token = nextReal(); /* get token after THEN keyword */
3967  /* terminator here? */
3968  if (token->isEndOfClause())
3969  {
3970  dumpTokens("RexxSource::translateBlock#5", this, this->clause);
3971  this->nextClause(); /* get the next physical clause */
3972  dumpClause("RexxSource::translateBlock#5", this, this->clause);
3973  if (this->flags&no_clause) /* get an end-of-file? */
3974  {
3975  /* raise an error */
3976  syntaxError(Error_Incomplete_do_then, _instruction);
3977  }
3978  }
3979  else
3980  {
3981  previousToken(); /* step back a token */
3982  trimClause(); /* make this start of the clause */
3983  }
3984  }
3985  this->addClause(second); /* add this to the instruction list */
3986  this->pushDo(second); /* add to top of control queue */
3987  continue; /* straight around to process clause */
3988  /* remainder */
3989  case KEYWORD_ELSE: /* have an ELSE instruction */
3990  second = this->topDo(); /* get the top block */
3991  if (this->topDo()->getType() != KEYWORD_ENDTHEN)
3992  {
3993  /* have an error */
3995  }
3996  this->addClause(_instruction); /* add to instruction heap */
3997  second = this->popDo(); /* pop the ENDTHEN item */
3998  this->pushDo(_instruction); /* add to the control list */
3999  /* join the THEN and ELSE together */
4000  ((RexxInstructionElse *)_instruction)->setParent((RexxInstructionEndIf *)second);
4001  ((RexxInstructionEndIf *)second)->setEndInstruction((RexxInstructionEndIf *)_instruction);
4002  token = nextReal(); /* get the next token */
4003  /* have an ELSE keyword alone? */
4004  if (token->isEndOfClause())
4005  {
4006  dumpTokens("RexxSource::translateBlock#6", this, this->clause);
4007  this->nextClause(); /* get the next physical clause */
4008  dumpClause("RexxSource::translateBlock#6", this, this->clause);
4009  if (this->flags&no_clause) /* get an end-of-file? */
4010  {
4011  /* raise an error */
4012  syntaxError(Error_Incomplete_do_else, _instruction);
4013  }
4014  }
4015  else /* ELSE instruction form */
4016  {
4017  previousToken(); /* step back a token */
4018  trimClause(); /* make this start of the clause */
4019  }
4020  continue; /* straight around to process clause */
4021  /* remainder */
4022 
4023  case KEYWORD_OTHERWISE: /* start of an OTHERWISE group */
4024  second = this->topDo(); /* get the top of the queue */
4025  /* not working on a SELECT? */
4026  if (second->getType() != KEYWORD_SELECT)
4027  {
4029  }
4030  /* hook up the OTHERWISE instruction */
4031  ((RexxInstructionSelect *)second)->setOtherwise((RexxInstructionOtherwise *)_instruction);
4032  this->pushDo(_instruction); /* add this to the control queue */
4033  token = nextReal(); /* get the next token */
4034  /* OTHERWISE instr form? */
4035  if (!token->isEndOfClause())
4036  {
4037  previousToken(); /* step back a token */
4038  trimClause(); /* make this start of the clause */
4039  continue; /* straight around to process clause */
4040  /* remainder */
4041  }
4042  break; /* normal OTHERWISE processing */
4043 
4044 
4045  case KEYWORD_END: /* END instruction for DO or SELECT */
4046  second = this->popDo(); /* get the top of the queue */
4047  type = second->getType(); /* get the instruction type */
4048  /* not working on a block? */
4050  {
4051  if (type == KEYWORD_ELSE) /* on an else? */
4052  {
4053  /* give the specific error */
4055  }
4056  else if (type == KEYWORD_IFTHEN || type == KEYWORD_WHENTHEN)
4057  {
4058  /* this is a different error */
4060  }
4061  else
4062  {
4063  /* have a misplaced END */
4065  }
4066  }
4067  if (type == KEYWORD_OTHERWISE) /* OTHERWISE part of a SELECT? */
4068  {
4069  second = this->popDo(); /* need to pop one more item off */
4070  }
4071  /* matching a select? */
4072  if (second->getType() == KEYWORD_SELECT)
4073  {
4074  /* match up the instruction */
4075  ((RexxInstructionSelect *)second)->matchEnd((RexxInstructionEnd *)_instruction, this);
4076  }
4077  else /* must be a DO block */
4078  {
4079  /* match up the instruction */
4080  ((RexxInstructionDo *)second)->matchEnd((RexxInstructionEnd *)_instruction, this);
4081  }
4082  this->flushControl(OREF_NULL); /* finish pending IFs or ELSEs */
4083  break;
4084 
4085  case KEYWORD_DO: // start of new DO group (also picks up LOOP instruction)
4086  case KEYWORD_LOOP:
4087  this->pushDo(_instruction); /* add this to the control queue */
4088  break;
4089 
4090  case KEYWORD_SELECT: /* start of new SELECT group */
4091  this->pushDo(_instruction); /* and also to the control queue */
4092  break;
4093 
4094  default: /* other types of instruction */
4095  break;
4096  }
4097  dumpTokens("RexxSource::translateBlock#7", this, this->clause);
4098  this->nextClause(); /* get the next physical clause */
4099  dumpClause("RexxSource::translateBlock#7", this, this->clause);
4100  }
4101  /* now go resolve any label targets */
4102  _instruction = (RexxInstruction *)(this->calls->removeFirst());
4103  /* while still more references */
4104  while (_instruction != (RexxInstruction *)TheNilObject)
4105  {
4106  /* actually a function call? */
4107  if (isOfClass(FunctionCallTerm, _instruction))
4108  {
4109  /* resolve the function call */
4110  ((RexxExpressionFunction *)_instruction)->resolve(this->labels);
4111  }
4112  else
4113  {
4114  /* resolve the CALL/SIGNAL/FUNCTION */
4115  /* label targets */
4116  ((RexxInstructionCallBase *)_instruction)->resolve(this->labels);
4117  }
4118  /* now get the next instruction */
4119  _instruction = (RexxInstruction *)(this->calls->removeFirst());
4120  }
4121  /* remove the first instruction */
4122  OrefSet(this, this->first, this->first->nextInstruction);
4123  /* no labels needed? */
4124  if (this->labels != OREF_NULL && this->labels->items() == 0)
4125  {
4126  /* release that directory also */
4127  OrefSet(this, this->labels, OREF_NULL);
4128  }
4129  /* create a rexx code object */
4130  return new RexxCode(this, this->first, this->labels, (this->maxstack+ 10), this->variableindex);
4131 }
4132 
4134 /******************************************************************************/
4135 /* Function: Process an individual REXX clause */
4136 /******************************************************************************/
4137 {
4138  RexxToken *_first; /* first token of clause */
4139  RexxToken *second; /* second token of clause */
4140  RexxInstruction *_instruction; /* current working instruction */
4141  RexxObject *term; /* term for a message send */
4142  RexxObject *subexpression; /* subexpression of a clause */
4143  int _keyword; /* resolved instruction keyword */
4144 
4145  _instruction = OREF_NULL; /* default to no instruction found */
4146  _first = nextReal(); /* get the first token */
4147 
4148  if (_first->classId == TOKEN_DCOLON)
4149  {/* reached the end of a block? */
4150  firstToken(); /* reset the location */
4151  this->reclaimClause(); /* give back the clause */
4152  }
4153  else
4154  { /* have a real instruction to process*/
4155  second = nextToken(); /* now get the second token */
4156  /* is this a label? (can be either */
4157  /* a symbol or a literal) */
4158  if ((_first->classId == TOKEN_SYMBOL || _first->classId == TOKEN_LITERAL) && second->classId == TOKEN_COLON)
4159  {
4160  if (this->flags&_interpret) /* is this an interpret? */
4161  {
4162  /* this is an error */
4164  }
4165  firstToken(); /* reset to the beginning */
4166  _instruction = this->labelNew(); /* create a label instruction */
4167  second = nextToken(); /* get the next token */
4168  /* not the end of the clause? */
4169  if (!second->isEndOfClause())
4170  {
4171  previousToken(); /* give this token back */
4172  trimClause(); /* make this start of the clause */
4173  this->reclaimClause(); /* give the remaining clause back */
4174  }
4175  return _instruction;
4176  }
4177 
4178  // this is potentially an assignment of the form "symbol = expr"
4179  if (_first->isSymbol())
4180  {
4181  // "symbol == expr" is considered an error
4182  if (second->subclass == OPERATOR_STRICT_EQUAL)
4183  {
4184  // With implicit return, an expression like value==1 is quite common, and not an error.
4185  // So, next line deactivated...
4186  // syntaxError(Error_Invalid_expression_general, second);
4187  }
4188  // true assignment instruction?
4189  if (second->subclass == OPERATOR_EQUAL)
4190  {
4191  return this->assignmentNew(_first);
4192  }
4193  // this could be a special assignment operator such as "symbol += expr"
4194  else if (second->classId == TOKEN_ASSIGNMENT)
4195  {
4196  return this->assignmentOpNew(_first, second);
4197  }
4198  // other
4199 
4200  }
4201 
4202  /* some other type of instruction */
4203  /* we need to skip over the first */
4204  /* term of the instruction to */
4205  /* determine the type of clause, */
4206  /* including recognition of keyword */
4207  /* instructions */
4208  firstToken(); /* reset to the first token */
4209  term = this->messageTerm(); /* get the first term of instruction */
4210  second = nextToken(); /* get the next token */
4211 
4212 
4213  // some sort of recognizable message term? Need to check for the
4214  // special cases.
4215  if (term != OREF_NULL)
4216  {
4217  // if parsing the message term consumed everything, this is a message instruction
4218  if (second->isEndOfClause())
4219  {
4220  return this->messageNew((RexxExpressionMessage *)term);
4221  }
4222 #if 0 // JLF : I want to support ~select{index~left(1) == "S"}
4223  else if (second->subclass == OPERATOR_STRICT_EQUAL)
4224  {
4225  // messageterm == something is an invalid assignment
4227  }
4228 #endif
4229  // messageterm = something is a pseudo assignment
4230  else if (second->subclass == OPERATOR_EQUAL)
4231  {
4232  this->saveObject(term); /* protect this */
4233  // we need an expression following the op token
4234  subexpression = this->subExpression(TERM_EOC);
4235  if (subexpression == OREF_NULL)
4236  {
4238  }
4239  // this is a message assignment
4240  _instruction = this->messageAssignmentNew((RexxExpressionMessage *)term, subexpression);
4241  this->toss(term); /* release the term */
4242  return _instruction;
4243  }
4244  // one of the special operator forms?
4245  else if (second->classId == TOKEN_ASSIGNMENT)
4246  {
4247  this->saveObject(term); /* protect this */
4248  // we need an expression following the op token
4249  subexpression = this->subExpression(TERM_EOC);
4250  if (subexpression == OREF_NULL)
4251  {
4253  }
4254  // this is a message assignment
4255  _instruction = this->messageAssignmentOpNew((RexxExpressionMessage *)term, second, subexpression);
4256  this->toss(term); /* release the term */
4257  return _instruction;
4258  }
4259  }
4260 
4261  // ok, none of the special cases passed....not start the keyword processing
4262 
4263  firstToken(); /* reset to the first token */
4264  _first = nextToken(); /* get the first token again */
4265  {
4266  size_t mark = markPosition();
4267  second = nextToken();
4268  resetPosition(mark);
4269  }
4270  /* is first a symbol that matches a */
4271  /* defined REXX keyword? */
4272  /* Not a keyword if the symbol is followed by a left paren (it's a function call) */
4273  /* [jlf] Not a keyword if the symbol is followed by a source literal (abbreviated syntax of a block passed as last argument) */
4274  if (_first->isSymbol() && (second->classId != TOKEN_LEFT) && (second->classId != TOKEN_SOURCE_LITERAL) && (_keyword = this->keyword(_first)))
4275  {
4276 
4277  switch (_keyword)
4278  { /* process each instruction type */
4279 
4280  case KEYWORD_NOP: /* NOP instruction */
4281  refineSubclass(_first, IS_KEYWORD);
4282  /* add the instruction to the parse */
4283  _instruction = this->nopNew();
4284  break;
4285 
4286  case KEYWORD_DROP: /* DROP instruction */
4287  refineSubclass(_first, IS_KEYWORD);
4288  /* add the instruction to the parse */
4289  _instruction = this->dropNew();
4290  break;
4291 
4292  case KEYWORD_SIGNAL: /* various forms of SIGNAL */
4293  refineSubclass(_first, IS_KEYWORD);
4294  /* add the instruction to the parse */
4295  _instruction = this->signalNew();
4296  break;
4297 
4298  case KEYWORD_CALL: /* various forms of CALL */
4299  refineSubclass(_first, IS_KEYWORD);
4300  /* add the instruction to the parse */
4301  _instruction = this->callNew();
4302  break;
4303 
4304  case KEYWORD_RAISE: /* RAISE instruction */
4305  refineSubclass(_first, IS_KEYWORD);
4306  /* add the instruction to the parse */
4307  _instruction = this->raiseNew();
4308  break;
4309 
4310  case KEYWORD_ADDRESS: /* ADDRESS instruction */
4311  refineSubclass(_first, IS_KEYWORD);
4312  /* add the instruction to the parse */
4313  _instruction = this->addressNew();
4314  break;
4315 
4316  case KEYWORD_NUMERIC: /* NUMERIC instruction */
4317  refineSubclass(_first, IS_KEYWORD);
4318  /* add the instruction to the parse */
4319  _instruction = this->numericNew();
4320  break;
4321 
4322  case KEYWORD_TRACE: /* TRACE instruction */
4323  refineSubclass(_first, IS_KEYWORD);
4324  /* add the instruction to the parse */
4325  _instruction = this->traceNew();
4326  break;
4327 
4328  case KEYWORD_DO: /* all variations of DO instruction */
4329  refineSubclass(_first, IS_KEYWORD);
4330  /* add the instruction to the parse */
4331  _instruction = this->doNew();
4332  break;
4333 
4334  case KEYWORD_LOOP: /* all variations of LOOP instruction */
4335  refineSubclass(_first, IS_KEYWORD);
4336  /* add the instruction to the parse */
4337  _instruction = this->loopNew();
4338  break;
4339 
4340  case KEYWORD_EXIT: /* EXIT instruction */
4341  refineSubclass(_first, IS_KEYWORD);
4342  /* add the instruction to the parse */
4343  _instruction = this->exitNew();
4344  break;
4345 
4346  case KEYWORD_INTERPRET: /* INTERPRET instruction */
4347  refineSubclass(_first, IS_KEYWORD);
4348  /* add the instruction to the parse */
4349  _instruction = this->interpretNew();
4350  break;
4351 
4352  case KEYWORD_PUSH: /* PUSH instruction */
4353  refineSubclass(_first, IS_KEYWORD);
4354  /* add the instruction to the parse */
4355  _instruction = this->queueNew(QUEUE_LIFO);
4356  break;
4357 
4358  case KEYWORD_QUEUE: /* QUEUE instruction */
4359  refineSubclass(_first, IS_KEYWORD);
4360  /* add the instruction to the parse */
4361  _instruction = this->queueNew(QUEUE_FIFO);
4362  break;
4363 
4364  case KEYWORD_REPLY: /* REPLY instruction */
4365  refineSubclass(_first, IS_KEYWORD);
4366  /* interpreted? */
4367  if (this->flags&_interpret)
4369  /* add the instruction to the parse */
4370  _instruction = this->replyNew();
4371  break;
4372 
4373  case KEYWORD_RETURN: /* RETURN instruction */
4374  refineSubclass(_first, IS_KEYWORD);
4375  /* add the instruction to the parse */
4376  _instruction = this->returnNew();
4377  break;
4378 
4379  case KEYWORD_IF: /* IF instruction */
4380  refineSubclass(_first, IS_KEYWORD);
4381  /* add the instruction to the parse */
4382  _instruction = this->ifNew(KEYWORD_IF);
4383  break;
4384 
4385  case KEYWORD_ITERATE: /* ITERATE instruction */
4386  refineSubclass(_first, IS_KEYWORD);
4387  /* add the instruction to the parse */
4388  _instruction = this->leaveNew(KEYWORD_ITERATE);
4389  break;
4390 
4391  case KEYWORD_LEAVE: /* LEAVE instruction */
4392  refineSubclass(_first, IS_KEYWORD);
4393  /* add the instruction to the parse */
4394  _instruction = this->leaveNew(KEYWORD_LEAVE);
4395  break;
4396 
4397  case KEYWORD_EXPOSE: /* EXPOSE instruction */
4398  refineSubclass(_first, IS_KEYWORD);
4399  /* interpreted? */
4400  if (this->flags&_interpret)
4402  /* add the instruction to the parse */
4403  _instruction = this->exposeNew();
4404  break;
4405 
4406  case KEYWORD_FORWARD: /* FORWARD instruction */
4407  refineSubclass(_first, IS_KEYWORD);
4408  /* interpreted? */
4409  if (this->flags&_interpret)
4411  /* add the instruction to the parse */
4412  _instruction = this->forwardNew();
4413  break;
4414 
4415  case KEYWORD_PROCEDURE: /* PROCEDURE instruction */
4416  refineSubclass(_first, IS_KEYWORD);
4417  /* add the instruction to the parse */
4418  _instruction = this->procedureNew();
4419  break;
4420 
4421  case KEYWORD_GUARD: /* GUARD instruction */
4422  refineSubclass(_first, IS_KEYWORD);
4423  /* interpreted? */
4424  if (this->flags&_interpret)
4426  /* add the instruction to the parse */
4427  _instruction = this->guardNew();
4428  break;
4429 
4430  case KEYWORD_USE: /* USE instruction */
4431  refineSubclass(_first, IS_KEYWORD);
4432  /* interpreted? */
4433  if (this->flags&_interpret)
4435  /* add the instruction to the parse */
4436  _instruction = this->useNew();
4437  break;
4438 
4439  case KEYWORD_ARG: /* ARG instruction */
4440  refineSubclass(_first, IS_KEYWORD);
4441  /* add the instruction to the parse */
4442  _instruction = this->parseNew(SUBKEY_ARG);
4443  break;
4444 
4445  case KEYWORD_PULL: /* PULL instruction */
4446  refineSubclass(_first, IS_KEYWORD);
4447  /* add the instruction to the parse */
4448  _instruction = this->parseNew(SUBKEY_PULL);
4449  break;
4450 
4451  case KEYWORD_PARSE: /* PARSE instruction */
4452  refineSubclass(_first, IS_KEYWORD);
4453  /* add the instruction to the parse */
4454  _instruction = this->parseNew(KEYWORD_PARSE);
4455  break;
4456 
4457  case KEYWORD_SAY: /* SAY instruction */
4458  refineSubclass(_first, IS_KEYWORD);
4459  /* add the instruction to the parse */
4460  _instruction = this->sayNew();
4461  break;
4462 
4463  case KEYWORD_OPTIONS: /* OPTIONS instruction */
4464  refineSubclass(_first, IS_KEYWORD);
4465  /* add the instruction to the parse */
4466  _instruction = this->optionsNew();
4467  break;
4468 
4469  case KEYWORD_SELECT: /* SELECT instruction */
4470  refineSubclass(_first, IS_KEYWORD);
4471  /* add the instruction to the parse */
4472  _instruction = this->selectNew();
4473  break;
4474 
4475  case KEYWORD_WHEN: /* WHEN in an SELECT instruction */
4476  refineSubclass(_first, IS_KEYWORD);
4477  /* add the instruction to the parse */
4478  _instruction = this->ifNew(KEYWORD_WHEN);
4479  break;
4480 
4481  case KEYWORD_OTHERWISE: /* OTHERWISE in a SELECT */
4482  refineSubclass(_first, IS_KEYWORD);
4483  /* add the instruction to the parse */
4484  _instruction = this->otherwiseNew(_first);
4485  break;
4486 
4487  case KEYWORD_ELSE: /* unexpected ELSE */
4488  refineSubclass(_first, IS_KEYWORD);
4489  /* add the instruction to the parse */
4490  _instruction = this->elseNew(_first);
4491  break;
4492 
4493  case KEYWORD_END: /* END for a block construct */
4494  refineSubclass(_first, IS_KEYWORD);
4495  /* add the instruction to the parse */
4496  _instruction = this->endNew();
4497  break;
4498 
4499  case KEYWORD_THEN: /* unexpected THEN */
4500  /* raise an error */
4502  break;
4503 
4504  case KEYWORD_UPPER: /* UPPER instruction */
4505  refineSubclass(_first, IS_KEYWORD);
4506  /* add the instruction to the parse */
4507  _instruction = this->upperNew();
4508  break;
4509  }
4510  }
4511  else
4512  { /* this is a "command" instruction */
4513  firstToken(); /* reset to the first token */
4514  /* process this instruction */
4515  _instruction = this->commandNew();
4516  }
4517  }
4518  return _instruction; /* return the created instruction */
4519 }
4520 
4522  RexxString *varname) /* variable to add */
4523 /******************************************************************************/
4524 /* Function: Resolve a variable name to a single common retriever object */
4525 /* per method */
4526 /******************************************************************************/
4527 {
4528  /* check the directory for an entry */
4529  RexxVariableBase *retriever = (RexxVariableBase *)this->variables->fastAt(varname);
4530  if (retriever == OREF_NULL) /* not in the table yet? */
4531  {
4532  if (!(this->flags&_interpret)) /* not in an interpret? */
4533  {
4534  this->variableindex++; /* step the counter */
4535  /* create a new variable retriever */
4536  retriever = new RexxParseVariable(varname, this->variableindex);
4537  }
4538  else /* force dynamic lookup each time */
4539  {
4540  retriever = new RexxParseVariable(varname, 0);
4541  }
4542  /* add to the variable table */
4543  this->variables->put((RexxObject *)retriever, varname);
4544  }
4545  /* collecting guard variables? */
4546  if (this->guard_variables != OREF_NULL)
4547  {
4548  /* in the list of exposed variables? */
4549  if (this->exposed_variables != OREF_NULL && this->exposed_variables->fastAt(varname) != OREF_NULL)
4550  {
4551  /* add this to the guard list */
4552  this->guard_variables->put((RexxObject *)retriever, (RexxObject *)retriever);
4553  }
4554  }
4555  return retriever; /* return variable accesser */
4556 }
4557 
4559  RexxString *stemName) /* stem to add */
4560 /******************************************************************************/
4561 /* Function: Process creation of stem variables */
4562 /******************************************************************************/
4563 {
4564  /* check the table for an entry */
4565  RexxStemVariable *retriever = (RexxStemVariable *)(this->variables->fastAt(stemName));
4566  if (retriever == OREF_NULL) /* not in the table yet? */
4567  {
4568  if (!(this->flags&_interpret)) /* not in an interpret? */
4569  {
4570  this->variableindex++; /* step the counter */
4571  /* create a new variable retriever */
4572  retriever = new RexxStemVariable(stemName, this->variableindex);
4573  }
4574  else /* force dynamic lookup each time */
4575  {
4576  retriever = new RexxStemVariable(stemName, 0);
4577  }
4578  /* add to the variable table */
4579  this->variables->put((RexxObject *)retriever, stemName);
4580  }
4581  /* collecting guard variables? */
4582  if (this->guard_variables != OREF_NULL)
4583  {
4584  /* in the list of exposed variables? */
4585  if (this->exposed_variables != OREF_NULL && this->exposed_variables->fastAt(stemName) != OREF_NULL)
4586  {
4587  /* add this to the guard list */
4588  this->guard_variables->put((RexxObject *)retriever, (RexxObject *)retriever);
4589  }
4590  }
4591  return retriever; /* return variable accesser */
4592 }
4593 
4594 
4596  RexxString *name) /* name of the compound variable */
4597 /******************************************************************************/
4598 /* Function: Parse to completion a compound variable */
4599 /******************************************************************************/
4600 {
4601  RexxStemVariable *stemRetriever; /* retriever for the stem value */
4602  RexxString *stemName; /* stem part of compound variable */
4603  RexxString *tail; /* tail section string value */
4604  const char * start; /* starting scan position */
4605  sizeB_t length; /* length of tail section */
4606  const char * _position; /* current position */
4607  const char * end; // the end scanning position
4608  size_t tailCount; /* count of tails in compound */
4609 
4610  length = name->getBLength(); /* get the string length */
4611  _position = name->getStringData(); /* start scanning at first character */
4612  start = _position; /* save the starting point */
4613  end = _position + length; // save our end marker
4614 
4615  // we know this is a compound, so there must be at least one period.
4616  /* scan to the first period */
4617  while (*_position != '.')
4618  {
4619  _position++; /* step to the next character */
4620  }
4621  /* get the stem string */
4622  stemName = new_string(start, sizeB_v(_position - start + 1));
4623  stemRetriever = this->addStem(stemName); /* get a retriever item for this */
4624 
4625  tailCount = 0; /* no tails yet */
4626  do /* process rest of the variable */
4627  {
4628  // we're here because we just saw a previous period. that's either the
4629  // stem variable period or the last tail element we processed.
4630  // either way, we step past it. If this period is a trailing one,
4631  // we'll add a null tail element, which is exactly what we want.
4632  _position++; /* step past previous period */
4633  start = _position; /* save the start position */
4634  /* scan for the next period */
4635  while (_position < end)
4636  {
4637  if (*_position == '.') // found the next one?
4638  {
4639  break; // stop scanning now
4640  }
4641  _position++; // continue looking
4642  }
4643  /* extract the tail piece */
4644  tail = new_string(start, sizeB_v(_position - start));
4645  /* have a null tail piece or */
4646  /* section begin with a digit? */
4647  if (!(tail->getBLength() == 0 || (*start >= '0' && *start <= '9')))
4648  {
4649  /* push onto the term stack */
4650  this->subTerms->push((RexxObject *)(this->addVariable(tail)));
4651  }
4652  else
4653  {
4654  /* just use the string value directly*/
4655  this->subTerms->push(this->commonString(tail));
4656  }
4657  tailCount++; /* up the tail count */
4658  } while (_position < end);
4659  /* finally, create the compound var */
4660  return new (tailCount) RexxCompoundVariable(name, stemName, stemRetriever->index, this->subTerms, tailCount);
4661 }
4662 
4663 
4665  RexxString *name ) /* variable name to add to list */
4666 /******************************************************************************/
4667 /* Function: Add a variable name to the list of exposed variables for the */
4668 /* method. */
4669 /******************************************************************************/
4670 {
4671  /* add to the exposed variables list */
4672  this->exposed_variables->put(name, name);
4673 }
4674 
4675 
4677  RexxString *string ) /* string token to "collapse" */
4678 /******************************************************************************/
4679 /* Function: Compress all string tokens needed by a group of programs into */
4680 /* a single, common set of strings. */
4681 /******************************************************************************/
4682 {
4683  /* check the global table first */
4684  RexxString *result = (RexxString *)this->strings->fastAt(string);
4685  /* not in the table */
4686  if (result == OREF_NULL)
4687  {
4688  ProtectedObject p(string); // often string is a non-protected object on the caller side, better to protect it now
4689  this->strings->put(string, string);/* add this to the table */
4690  result = string; /* also the final value */
4691  }
4692  return result; /* return the string */
4693 }
4694 
4695 
4697 {
4698  needVariable(token);
4699  return addText(token);
4700 }
4701 
4702 
4704  RexxToken *token) /* token to process */
4705 /******************************************************************************/
4706 /* Function: Generalized text token addition */
4707 /******************************************************************************/
4708 {
4709  RexxObject *retriever; /* created retriever */
4710  RexxObject *value; /* evaluated literal value */
4711 
4712  RexxString *name = token->value; /* get the string value for this */
4713  switch (token->classId)
4714  {
4715 
4716  case TOKEN_SYMBOL: /* various types of symbols */
4717  /* each symbol subtype requires a */
4718  /* different retrieval method */
4719  switch (token->subclass)
4720  {
4721 
4722  case SYMBOL_DUMMY: /* just a dot symbol */
4723  case SYMBOL_CONSTANT: /* a literal symbol */
4724 
4725  /* see if we've had this before */
4726  retriever = this->literals->fastAt(name);
4727  /* first time literal? */
4728  if (retriever == OREF_NULL)
4729  {
4730  /* can we create an integer object? */
4731  if (token->numeric == INTEGER_CONSTANT)
4732  {
4733  /* create this as an integer */
4735  /* conversion error? */
4736  if (value == TheNilObject)
4737  {
4738  value = name; /* just go with the string value */
4739  }
4740  else
4741  /* snip off the string number string */
4742  /* value that was created when the */
4743  /* integer value was created. This */
4744  /* is rarely used, but contributes */
4745  /* to the saved program size */
4746  name->setNumberString(OREF_NULL);
4747  }
4748  else
4749  {
4750  value = name; /* just use the string value */
4751  /* give it a number string value */
4752  name->setNumberString((RexxObject *)value->numberString());
4753  }
4754  /* the constant is the retriever */
4755  this->literals->put(value, name);
4756  retriever = value; /* the retriever is the value itthis */
4757  }
4758  break;
4759 
4760  case SYMBOL_VARIABLE: /* simple variable symbol */
4761  /* add variable to proper dictionary */
4762  retriever = (RexxObject *)this->addVariable(name);
4763  break;
4764 
4765  case SYMBOL_STEM: /* stem variable */
4766  /* add variable to proper dictionary */
4767  retriever = (RexxObject *)this->addStem(name);
4768  break;
4769 
4770  case SYMBOL_COMPOUND: /* compound variable, need more */
4771  /* add variable to proper dictionary */
4772  retriever = (RexxObject *)this->addCompound(name);
4773  break;
4774 
4775  case SYMBOL_DOTSYMBOL: /* variable with a leading dot */
4776  /* get a lookup object */
4777  /* see if we've had this before */
4778  retriever = this->variables->fastAt(name);
4779  /* first time dot variable? */
4780  if (retriever == OREF_NULL)
4781  {
4782  /* create the shorter name */
4783  value = name->extractB(1, name->getBLength() - 1);
4784  /* add this to the common pile */
4785  value = this->commonString((RexxString *)value);
4786  /* create a retriever for this */
4787  retriever = (RexxObject *)new RexxDotVariable((RexxString *)value);
4788  /* add this to the common table */
4789  this->variables->put(retriever, name);
4790  }
4791  break;
4792 
4793  default: /* all other types (shouldn't happen)*/
4794  retriever = OREF_NULL; /* return nothing */
4795  break;
4796  }
4797  break;
4798 
4799  case TOKEN_LITERAL: /* literal strings */
4800  /* get a lookup object */
4801  /* see if we've had this before */
4802  retriever = this->literals->fastAt(name);
4803  /* first time literal? */
4804  if (retriever == OREF_NULL)
4805  {
4806  /* the constant is the retriever */
4807  this->literals->put(name, name);
4808  retriever = name; /* use the name directly */
4809  }
4810  break;
4811 
4812  case TOKEN_SOURCE_LITERAL: /* source literal strings */
4813  {
4814  // can't optimize like TOKEN_LITERAL because need a distinct source object for each source literal
4815  RexxString *source = new_string(name->getStringData()+1, name->getBLength()-2); // Remove surrounding {}
4816  ProtectedObject p(source); // an array of lines will be derived from it, which could trigger GC
4817  PackageClass *package = this->isInterpret() ? this->interpret_activation->getPackage() : this->getPackage();
4818  // Remember : I pass only the startLine instead of the complete tokenLocation because the source array built
4819  // from the string MAY be one line smaller than tokenLocation.endLine (that happens when the final '}' is
4820  // the first character of the last line. The "real" endLine will be calculated using the source array size.
4821  retriever = (RexxObject *) new RexxSourceLiteral(source, package, token->tokenLocation.getLineNumber());
4822  p = retriever; // Now protect the source literal
4823  this->sourceLiterals->append(retriever); // Hooked, to not GC it.
4824  }
4825  break;
4826 
4827  default: /* all other tokens */
4828  retriever = OREF_NULL; /* don't return anything */
4829  break;
4830  }
4831  return retriever; /* return created retriever */
4832 }
4833 
4835  RexxString *name) /* name of the variable to process */
4836 /******************************************************************************/
4837 /* Function: Generalized method attribute retriever */
4838 /******************************************************************************/
4839 {
4840  RexxVariableBase *retriever = OREF_NULL; /* created retriever */
4841 
4842  /* go validate the symbol */
4843  switch (name->isSymbol())
4844  {
4845 
4846  case STRING_NAME: /* valid simple name */
4847  /* get a simple dynamic retriever */
4848  retriever = (RexxVariableBase *)new RexxParseVariable(name, 0);
4849  break;
4850 
4851  case STRING_STEM: /* this is a stem name */
4852  /* force dynamic lookup each time */
4853  retriever = (RexxVariableBase *)new RexxStemVariable(name, 0);
4854  break;
4855 
4856  case STRING_COMPOUND_NAME: /* compound variable name */
4857  /* get a direct retriever for this */
4859  break;
4860 
4861  default: /* all other invalid cases */
4862  /* have an invalid attribute */
4864  }
4865  return retriever; /* return created retriever */
4866 }
4867 
4868 
4870  RexxInstruction *_instruction) /* new label to add */
4871 /******************************************************************************/
4872 /* Add an instruction to the tree code execution stream */
4873 /******************************************************************************/
4874 {
4875 #ifdef _DEBUG
4877  {
4878  RexxString *instructionSource = this->extract(_instruction->instructionLocation, true);
4879  ProtectedObject p(instructionSource);
4880  if (Utilities::traceConcurrency()) dbgprintf(CONCURRENCY_TRACE "...... ... ", Utilities::currentThreadId(), NULL, NULL, 0, ' ');
4881  dbgprintf("(Parsing)Add RexxInstruction : instructionType=\"%s\" instructionFlags=%i ", RexxToken::keywordText(_instruction->instructionType), _instruction->instructionFlags);
4882  dbgprintf("startLine=%i startCol=%i endLine=%i endCol=%i ", _instruction->instructionLocation.getLineNumber(), size_v(_instruction->instructionLocation.getOffset()), _instruction->instructionLocation.getEndLine(), size_v(_instruction->instructionLocation.getEndOffset()));
4883  dbgprintf("instruction={%s}\n", instructionSource->getStringData());
4884  }
4885 #endif
4886 
4887  /* is this the first one? */
4888  if (this->first == OREF_NULL)
4889  {
4890  /* make this the first one */
4891  OrefSet(this, this->first, _instruction);
4892  /* and the last one */
4893  OrefSet(this, this->last, _instruction);
4894  }
4895  /* non-root instruction */
4896  else
4897  {
4898  this->last->setNext(_instruction); /* add on to the last instruction */
4899  /* this is the new last instruction */
4900  OrefSet(this, this->last, _instruction);
4901  }
4902  /* now safe from garbage collection */
4903  this->toss((RexxObject *)_instruction);
4904 }
4905 
4906 
4908  RexxInstruction *label, /* new label to add */
4909  RexxString *labelname ) /* the label name */
4910 /******************************************************************************/
4911 /* Function: add a label to the global label table. */
4912 /******************************************************************************/
4913 {
4914  /* not already in the table? */
4915  if (this->labels->fastAt(labelname) == OREF_NULL)
4916  {
4917  /* add this item */
4918  this->labels->put((RexxObject *)label, labelname);
4919  }
4920 }
4921 
4922 
4924  RexxString *labelname) /* target label */
4925 /******************************************************************************/
4926 /* Search the label table for a label name match */
4927 /******************************************************************************/
4928 {
4929  if (this->labels != OREF_NULL) /* have labels? */
4930  {
4931  /* just return entry from the table */
4932  return(RexxInstruction *)this->labels->fastAt(labelname);
4933  }
4934  else
4935  {
4936  return OREF_NULL; /* don't return anything */
4937  }
4938 }
4939 
4941 /******************************************************************************/
4942 /* Function: Set on guard expression variable "gathering" */
4943 /******************************************************************************/
4944 {
4945  /* just starting to trap? */
4946  if (this->guard_variables == OREF_NULL)
4947  {
4948  /* create the guard table */
4949  OrefSet(this, this->guard_variables, new_identity_table());
4950  }
4951 }
4952 
4954 /******************************************************************************/
4955 /* Function: Complete guard expression variable collection and return the */
4956 /* table of variables. */
4957 /******************************************************************************/
4958 {
4959  /* convert into an array */
4960  RexxArray *guards = this->guard_variables->makeArray();
4961  /* discard the table */
4962  OrefSet(this, this->guard_variables, OREF_NULL);
4963  /* just starting to trap? */
4964  return guards; /* return the guards array */
4965 }
4966 
4968 /******************************************************************************/
4969 /* Function: Evaluate a "constant" expression for REXX instruction keyword */
4970 /* values. A constant expression is a literal string, constant */
4971 /* symbol, or an expression enclosed in parentheses. */
4972 /******************************************************************************/
4973 {
4974  RexxToken *token; /* current token */
4975  RexxToken *second; /* second token */
4976  RexxObject *_expression = OREF_NULL; /* parse expression */
4977 
4978  token = nextReal(); /* get the first token */
4979  if (token->isLiteral()) /* literal string expression? */
4980  {
4981  _expression = this->addText(token); /* get the literal retriever */
4982  }
4983  else if (token->isSourceLiteral()) /* source literal expression? */
4984  {
4985  _expression = this->addText(token); /* get the literal retriever */
4986  }
4987  else if (token->isConstant()) /* how about a constant symbol? */
4988  {
4989  _expression = this->addText(token); /* get the literal retriever */
4990  }
4991  /* got an end of expression? */
4992  else if (token->isEndOfClause())
4993  {
4994  previousToken(); /* push the token back */
4995  return OREF_NULL; /* nothing here (may be optional) */
4996  }
4997  /* not a left paren here? */
4998  else if (token->classId != TOKEN_LEFT)
4999  {
5000  /* this is an invalid expression */
5002  }
5003  else
5004  {
5005  /* get the subexpression */
5006  _expression = this->subExpression(TERM_EOC | TERM_RIGHT);
5007  second = nextToken(); /* get the terminator token */
5008  /* not terminated by a right paren? */
5009  if (second->classId != TOKEN_RIGHT)
5010  {
5011  /* this is an error */
5013  }
5014  }
5015  this->holdObject(_expression); /* protect the expression */
5016  return _expression; /* and return it */
5017 }
5018 
5020 /******************************************************************************/
5021 /* Function: Evaluate a "constant" expression for REXX instruction keyword */
5022 /* values. A constant expression is a literal string, constant */
5023 /* symbol, or an expression enclosed in parentheses. The */
5024 /* expression inside parens can be a complex logical expression. */
5025 /******************************************************************************/
5026 {
5027  RexxToken *token; /* current token */
5028  RexxToken *second; /* second token */
5029  RexxObject *_expression = OREF_NULL; /* parse expression */
5030 
5031  token = nextReal(); /* get the first token */
5032  if (token->isLiteral()) /* literal string expression? */
5033  {
5034 
5035  _expression = this->addText(token); /* get the literal retriever */
5036  }
5037  else if (token->isSourceLiteral()) /* source literal expression? */
5038  {
5039  _expression = this->addText(token); /* get the literal retriever */
5040  }
5041  else if (token->isConstant()) /* how about a constant symbol? */
5042  {
5043  _expression = this->addText(token); /* get the literal retriever */
5044  }
5045  /* got an end of expression? */
5046  else if (token->isEndOfClause())
5047  {
5048  previousToken(); /* push the token back */
5049  return OREF_NULL; /* nothing here (may be optional) */
5050  }
5051  /* not a left paren here? */
5052  else if (token->classId != TOKEN_LEFT)
5053  {
5054  /* this is an invalid expression */
5056  }
5057  else
5058  {
5059  /* get the subexpression */
5060  _expression = this->parseLogical(token, TERM_EOC | TERM_RIGHT);
5061  second = nextToken(); /* get the terminator token */
5062  /* not terminated by a right paren? */
5063  if (second->classId != TOKEN_RIGHT)
5064  {
5065  /* this is an error */
5067  }
5068  }
5069  this->holdObject(_expression); /* protect the expression */
5070  return _expression; /* and return it */
5071 }
5072 
5074 /******************************************************************************/
5075 /* Function: Evaluate a "parenthetical" expression for REXX instruction */
5076 /* values. A parenthetical expression is an expression enclosed */
5077 /* in parentheses. */
5078 /******************************************************************************/
5079 {
5080  // NB, the opening paren has already been parsed off
5081 
5082  RexxObject *_expression = this->subExpression(TERM_EOC | TERM_RIGHT);
5083  RexxToken *second = nextToken(); /* get the terminator token */
5084  /* not terminated by a right paren? */
5085  if (second->classId != TOKEN_RIGHT)
5086  {
5088  }
5089  /* this is an error */
5090  this->holdObject(_expression); /* protect the expression */
5091  return _expression; /* and return it */
5092 }
5093 
5095  int terminators ) /* expression termination context */
5096 /******************************************************************************/
5097 /* Function: Parse off an expression, stopping when one of the possible set */
5098 /* of terminator tokens is reached. The terminator token is */
5099 /* placed back on the token queue. */
5100 /******************************************************************************/
5101 {
5102  nextReal(); /* get the first real token */
5103  previousToken(); /* now put it back */
5104  /* parse off the subexpression */
5105  // return this->subExpression(terminators);
5106  return this->fullSubExpression(terminators);
5107 }
5108 
5109 /**
5110  * Perform the parsing of an expression where the expression
5111  * can be treated as a comma-separated list of subexpressions.
5112  * If we have just a simple single subexpression, the
5113  * return value is the parsed subexpression. If a comma
5114  * is found as a terminator, then we turn this expression
5115  * into an operator that will create an array object from the
5116  * list of expressions. Omitted expressions are allowed and
5117  * no effort is made to remove trailing null expressions.
5118  *
5119  * @param terminators
5120  * The list of terminators for this expression type.
5121  *
5122  * @return Either a simple expression, or an expression object for
5123  * creating an array item.
5124  */
5126 {
5127  size_t total = 0; // total is the full count of arguments we attempt to parse.
5128  RexxToken *terminatorToken; // the terminator token that ended a sub expression
5129 
5130  // now loop until we get a terminator. Note that COMMAs are always a terminator
5131  // token now that list expressions are possible.
5132  for (;;)
5133  {
5134  // parse off an argument expression
5135  RexxObject *subExpr = subExpression(terminators | TERM_COMMA); // jlf: here I differ from ooRexx5 which FORCES "comma is separator" in the method terminator.
5136  // We have two term stacks. The main term stack is used for expression evaluation.
5137  // the subTerm stack is used for processing expression lists like this.
5138  // NOTE that we need to use pushSubTerm here so that the required expression stack
5139  // calculation comes out right.
5140  pushSubTerm(subExpr);
5141 
5142  // now check the total. Real count will be the last
5143  // expression that requires evaluation.
5144  total++;
5145 
5146  // the next token will be our terminator. If this is not
5147  // a comma, we have more expressions to parse.
5148  terminatorToken = nextToken();
5149  if (!terminatorToken->isType(TOKEN_COMMA))
5150  {
5151  // push this token back and stop parsing
5152  previousToken();
5153  break;
5154  }
5155  }
5156 
5157  // if we only saw the single expression, then return that expression
5158  // as the result
5159  if (total == 1)
5160  {
5161  return popSubTerm();
5162  }
5163 
5164  // we have an array creation list, so create the operator type for
5165  // building the array.
5166  return (RexxObject*) new (total) RexxExpressionList(total, subTerms);
5167 }
5168 
5169 
5171  int terminators ) /* expression termination context */
5172 /******************************************************************************/
5173 /* Function: Parse off a sub- expression, stopping when one of the possible */
5174 /* set of terminator tokens is reached. The terminator token is */
5175 /* placed back on the token queue. */
5176 /******************************************************************************/
5177 {
5178  RexxObject *left; /* left term of operation */
5179  RexxObject *right; /* right term of operation */
5180  RexxToken *token; /* current working token */
5181  RexxToken *second; /* look ahead token */
5182  RexxObject *subexpression; /* final subexpression */
5183  SourceLocation location; /* token location info */
5184 
5185  /* get the left term */
5186  left = this->messageSubterm(terminators);
5187  if (left == OREF_NULL) /* end of the expression? */
5188  {
5189  return OREF_NULL; /* done processing here */
5190  }
5191  this->pushTerm(left); /* add the term to the term stack */
5192  /* add a fence item to operator stack*/
5194  token = nextToken(); /* get the next token */
5195  /* loop until end of expression */
5196  while (!this->terminator(terminators, token))
5197  {
5198  switch (token->classId)
5199  {
5200 
5201  case TOKEN_TILDE: /* have a message send operation */
5202  case TOKEN_DTILDE: /* have a double twiddle operation */
5203  left = this->popTerm(); /* get the left term from the stack */
5204  if (left == OREF_NULL) /* not there? */
5205  {
5206  /* this is an invalid expression */
5208  }
5209  /* process a message term */
5210  subexpression = this->message(left, token->classId == TOKEN_DTILDE, terminators);
5211  this->pushTerm(subexpression); /* push this back on the term stack */
5212  break;
5213 
5214  case TOKEN_SQLEFT: /* collection syntax message */
5215  left = this->popTerm(); /* get the left term from the stack */
5216  if (left == OREF_NULL) /* not there? */
5217  {
5218  /* this is an invalid expression */
5220  }
5221  /* process a message term */
5222  subexpression = this->collectionMessage(token, left, terminators);
5223  this->pushTerm(subexpression); /* push this back on the term stack */
5224  break;
5225 
5226  case TOKEN_SYMBOL: /* Symbol in the expression */
5227  case TOKEN_LITERAL: /* Literal in the expression */
5228  //case TOKEN_SOURCE_LITERAL: /* Source literal in the expression */
5229  case TOKEN_LEFT: /* start of subexpression */
5230 
5231  location = token->getLocation(); /* get the token start position */
5232  /* abuttal ends on the same line */
5233  location.setEnd(location.getLineNumber(), location.getOffset());
5234  /* This is actually an abuttal */
5235  token = new RexxToken (TOKEN_OPERATOR, OPERATOR_ABUTTAL, OREF_NULLSTRING, location);
5236  previousToken(); /* step back on the token list */
5237 
5238  case TOKEN_BLANK: /* possible blank concatenate */
5239  second = nextReal(); /* get the next token */
5240  /* blank prior to a terminator? */
5241  if (this->terminator(terminators, second))
5242  {
5243  break; /* not a real operator */
5244  }
5245  else /* have a blank operator */
5246  {
5247  previousToken(); /* push this back */
5248  }
5249  /* fall through to operator logic */
5250 
5251  case TOKEN_OPERATOR: /* have a dyadic operator */
5252  /* actually a prefix only one? */
5253  if (token->subclass == OPERATOR_BACKSLASH)
5254  {
5255  /* this is an invalid expression */
5257  }
5258  /* handle operator precedence */
5259  for (;;)
5260  {
5261  second = this->topOperator();/* get the top term */
5262  /* hit the fence term? */
5263  if (second == (RexxToken *)TheNilObject)
5264  {
5265  break; /* out of here */
5266  }
5267  /* current have higher precedence? */
5268  if (this->precedence(token) > this->precedence(second))
5269  {
5270  break; /* finished also */
5271  }
5272  right = this->popTerm(); /* get the right term */
5273  left = this->popTerm(); /* and the left term */
5274  /* not enough terms? */
5275  if (right == OREF_NULL || left == OREF_NULL)
5276  {
5277  /* this is an invalid expression */
5279  }
5280  /* create a new operation */
5281  RexxToken *op = popOperator();
5282  subexpression = (RexxObject *)new RexxBinaryOperator(op->subclass, left, right);
5283  /* push this back on the term stack */
5284  this->pushTerm(subexpression);
5285  }
5286  this->pushOperator(token); /* push this operator onto stack */
5287  right = this->messageSubterm(terminators);
5288  /* end of the expression? */
5289  if (right == OREF_NULL && token->subclass != OPERATOR_BLANK)
5290  {
5291  /* have a bad expression */
5293  }
5294  this->pushTerm(right); /* add the term to the term stack */
5295  break;
5296 
5297  case TOKEN_ASSIGNMENT:
5298  // special assignment token in a bad context. We report this as an error.
5299  /* this is an invalid expression */
5301  break;
5302 
5303  case TOKEN_COMMA: /* found a comma in the expression */
5304  /* should have been trapped as an */
5305  /* expression terminator, so this is */
5306  /* not a valid expression */
5308  break;
5309 
5310  case TOKEN_RIGHT: /* found a paren in the expression */
5312  break;
5313 
5314  case TOKEN_SQRIGHT: /* found a bracket in the expression */
5316  break;
5317 
5318  default: /* something unexpected */
5319  /* not a valid expression */
5321  break;
5322  }
5323  token = nextToken(); /* get the next token */
5324  }
5325  token= this->popOperator(); /* get top operator token */
5326  /* process pending operations */
5327  while (token != (RexxToken *)TheNilObject)
5328  {
5329  right = this->popTerm(); /* get the right term */
5330  left = this->popTerm(); /* now get the left term */
5331  /* missing any terms? */
5332  if (left == OREF_NULL || right == OREF_NULL)
5333  {
5334  /* this is an invalid expression */
5336  }
5337  /* create a new operation */
5338  subexpression = (RexxObject *)new RexxBinaryOperator(token->subclass, left, right);
5339  this->pushTerm(subexpression); /* push this back on the term stack */
5340  token = this->popOperator(); /* get top operator token */
5341  }
5342  return this->popTerm(); /* expression is top of term stack */
5343 }
5344 
5345 /*RexxArray* */ void RexxSource::argArray(
5346  RexxToken *_first, /* token starting arglist */
5347  int terminators, /* expression termination context */
5348  bool namedArgumentAllowed,
5349  RexxArray* &_argArray, // output argument: either OREF_NULL or an array
5350  RexxArray* &_namedArgArray) // output argument: either OREF_NULL or an array
5351 /******************************************************************************/
5352 /* Function: Parse off an array of argument expressions */
5353 /******************************************************************************/
5354 {
5355  size_t argCount=0; /* count of positional arguments */
5356  size_t namedArgCount=0; /* count of named arguments */
5357  //RexxArray *_argArray; /* returned array */
5358 
5359  /* scan off the argument list */
5360  /*argCount =*/ this->argList(_first, terminators, namedArgumentAllowed, /*byref*/argCount, /*byref*/namedArgCount);
5361 
5362  _argArray = new_array(argCount); /* get a new argument list */
5363  this->holdObject(_argArray); // protect
5364  /* now copy the argument pointers */
5365  while (argCount > 0)
5366  {
5367  /* in reverse order */
5368  _argArray->put(this->subTerms->pop(), argCount--);
5369  }
5370 
5371  _namedArgArray = new_array(2 * namedArgCount); /* get a new named argument list */
5372  this->holdObject(_namedArgArray); // protect
5373  /* now copy the arguments name,expression */
5374  while (namedArgCount > 0)
5375  {
5376  /* in reverse order */
5377  _namedArgArray->put(this->namedSubTerms->pop(), (2 * namedArgCount)); // expression
5378  _namedArgArray->put(this->namedSubTerms->pop(), (2 * namedArgCount) - 1); // name
5379  namedArgCount--;
5380  }
5381 
5382  //return _argArray; /* return the argument array */
5383 }
5384 
5386  RexxToken *_first, /* token starting arglist */
5387  int terminators, /* expression termination context */
5388  bool namedArgumentAllowed,
5389  size_t &positionalArgumentCount,
5390  size_t &namedArgumentCount)
5391 /******************************************************************************/
5392 /* Function: Parse off a list of argument expressions */
5393 /******************************************************************************/
5394 // jlf : keep the trailing omitted arguments !
5395 // .array~of(10,20,30,)~dimensions= --> [3] (not ok, should be [4])
5396 
5397 {
5398  RexxQueue *arglist; /* positional argument list */
5399  RexxQueue *namedArglist; /* named argument list */
5400  RexxObject *subexpr; /* current subexpression */
5401  RexxToken *token; /* current working token */
5402  //size_t realcount; /* count of real arguments */
5403  size_t total; /* total positional arguments */
5404  size_t namedTotal;
5405 
5406  arglist = this->subTerms; /* use the subterms list for the positional parameters */
5407  namedArglist = this->namedSubTerms; /* use the namedsubterms list for the named parameters */
5408 
5409  /*
5410  JLF
5411  I don't really understand how is working subTerms and namedSubTerms...
5412  I added namedSubTerms by replicating the code I saw for subTerms.
5413  And one day, I stumbled on this bug:
5414  r = myroutine(1, 2, a1:1, a2:2, a3:myroutine(10, 20, a1:10, a2:20))
5415  Error 35.900: Named argument: The name "A1" is passed more than once
5416  It's because this->namedSubTerms contains : ("A1", 1, "A2", 2) when parsing the inner call of myroutine...
5417  Seems correct because it's the same for this->subTerms which contains (1, 2) when parsing the inner call.
5418  I bypassed this bug by using a queue local to this method, but I should investigate more !
5419  */
5420  RexxQueue *localNamedArglist = new_queue();
5421  ProtectedObject p(localNamedArglist);
5422 
5423 
5424  //realcount = 0; /* no arguments yet */
5425  total = 0; // count positional arguments
5426  namedTotal = 0; // count named arguments
5427  bool namedArgument = false; // will become true when the first named argument is met
5428 
5429  /* Shortcut syntax : f{...} is equivalent to f({...}) */
5430  if (_first && _first->isSourceLiteral())
5431  {
5432  RexxObject *expr = this->addText(_first);
5433  arglist->push(expr); /* add next argument to list */
5434  positionalArgumentCount = 1;
5435  namedArgumentCount = 0;
5436  return;
5437  }
5438 
5439  /* get the first real token, which */
5440  nextReal(); /* skips any leading blanks on CALL */
5441  previousToken(); /* now put it back */
5442  /* loop until get a full terminator */
5443  for (;;)
5444  {
5445  if (!namedArgument)
5446  {
5447  // The first named argument indicates the end of the positional arguments
5448  // A named argument is a variable symbol followed by ":"
5449  size_t position = markPosition();
5450  token = nextReal();
5451  if (token->isVariable())
5452  {
5453  token = nextReal();
5454  if (token->classId == TOKEN_COLON) namedArgument = true;
5455  }
5457 
5458  if (namedArgument && !namedArgumentAllowed) syntaxError(Error_Invalid_expression_user_defined,
5459  new_string("Named argument not supported"));
5460  }
5461 
5462  // JLF remember: for retrofit array literal, I can keep this part unchanged.
5463  // In particular, I don't try to simplify and use pushSubTerm.
5464  if (!namedArgument)
5465  {
5466  /* parse off next positional argument expression*/
5467  subexpr = this->subExpression(terminators | TERM_COMMA);
5468  arglist->push(subexpr); /* add next argument to list */
5469  this->pushTerm(subexpr); /* add the term to the term stack */
5470  total++; /* increment the total */
5471  //if (subexpr != OREF_NULL) /* real expression? */
5472  //{
5473  // realcount = total; /* update the real count */
5474  //}
5475  }
5476  else
5477  {
5478  // A named argument is a symbol followed by ":"
5479  token = nextReal();
5481  new_string("Named argument: expected symbol followed by colon"));
5482  this->needVariable(token);
5484  token->value->concatToCstring("Named argument: The name \"")->concatWithCstring("\" is passed more than once"));
5485  localNamedArglist->push(token->value); // Bypass the bug described above by using a queue local to this method.
5486  namedArglist->push(token->value); /* add argument name to list */
5487  this->pushTerm(token->value); // For a proper stack size, must count also the named parameters
5488 
5489  token = nextReal();
5491  new_string("Named argument: expected symbol followed by colon"));
5492 
5493  /* parse off named argument expression*/
5494  RexxObject *subexpr = this->subExpression(terminators | TERM_COMMA);
5496  new_string("Named argument: expected expression after colon"));
5497  namedArglist->push(subexpr); /* add next argument to list */
5498  this->pushTerm(subexpr); // For a proper stack size, must count also the named parameters
5499 
5500  namedTotal++;
5501  }
5502 
5503  token = nextToken(); /* get the next token */
5504  if (token->classId != TOKEN_COMMA) /* start of next argument? */
5505  {
5506  break; /* no, all finished */
5507  }
5508  }
5509 
5510  /* not closed with expected ')'? */
5511  if (terminators & TERM_RIGHT && token->classId != TOKEN_RIGHT)
5512  {
5513  /* raise an error */
5515  }
5516 
5517  /* not closed with expected ']'? */
5518  if (terminators&TERM_SQRIGHT && token->classId != TOKEN_SQRIGHT)
5519  {
5520  /* have an unmatched bracket */
5522  }
5523 
5524  this->popNTerms(total + ((2 * namedTotal))); /* pop all items off the term stack */
5525  /* pop off any trailing omitteds */
5526  //while (total > realcount)
5527  //{
5528  // arglist->pop(); /* just pop off the dummy */
5529  // total--; /* reduce the total */
5530  //}
5531  if (total == 1 && subexpr == OREF_NULL)
5532  {
5533  // case f() : no arg, must pop this OREF_NULL
5534  // case f(,) : 2 omitted args, we don't enter here
5535  arglist->pop();
5536  total--;
5537  }
5538 
5539  if (!token->isEndOfClause())
5540  {
5541  /* Shortcut syntax : f(a1,a2,...){...} is equivalent to f(a1,a2,...,{...}) */
5542  token = nextToken();
5543  if (token && token->isSourceLiteral())
5544  {
5545  RexxObject *expr = this->addText(token);
5546  arglist->push(expr); /* add next argument to list */
5547  //realcount++; /* increment the total */
5548  total++;
5549  }
5550  else previousToken(); /* put it back */
5551  }
5552 
5553  positionalArgumentCount = total;
5554  namedArgumentCount = namedTotal;
5555 
5556  //return realcount; /* return the argument count */
5557  //return total;
5558 }
5559 
5561  RexxToken *token, /* arglist start (for error reports) */
5562  RexxToken *name, /* function name */
5563  int terminators ) /* expression termination context */
5564 /******************************************************************************/
5565 /* Function: Parse off a REXX function call */
5566 /******************************************************************************/
5567 {
5568  size_t argCount=0; /* count of function arguments */
5569  size_t namedArgCount=0;
5570  RexxExpressionFunction *_function; /* newly created function argument */
5571 
5572  saveObject((RexxObject *)name); // protect while parsing the argument list
5573 
5574  /* process the argument list */
5575  /*argCount =*/ this->argList(token, ((terminators | TERM_RIGHT) & ~TERM_SQRIGHT), true, /*byref*/argCount, /*byref*/namedArgCount);
5576 
5577  /* create a new function item */
5578  _function = new (argCount + (2 * namedArgCount)) RexxExpressionFunction(name->value, argCount, this->subTerms, namedArgCount, this->namedSubTerms, this->resolveBuiltin(name->value), name->isLiteral());
5579  /* add to table of references */
5580  this->addReference((RexxObject *)_function);
5581  removeObj((RexxObject *)name); // end of protected windoww.
5582  return (RexxObject *)_function; /* and return this to the caller */
5583 }
5584 
5585 #if 0
5586 // It works, but not activated... Since there is also the tilde-call message
5587 // I prefer to keep things simple : only one way to do function calls.
5589  RexxToken *token, /* arglist start (for error reports) */
5590  RexxObject *target, /* target term */
5591  int terminators ) /* expression termination context */
5592 /******************************************************************************/
5593 /* Function: Process an expression term of the form "target(arg,arg)" */
5594 /******************************************************************************/
5595 {
5596  size_t argCount=0; /* count of function arguments */
5597  size_t namedArgCount=0;
5598  RexxObject *_message; /* new message term */
5599 
5600  this->saveObject((RexxObject *)target); /* save target until it gets connected to message */
5601  /* process the argument list */
5602  /*argCount =*/ this->argList(token, ((terminators | TERM_RIGHT) & ~TERM_SQRIGHT), true, /*byref*/argCount, /*byref*/namedArgCount);
5603  /* create a new message item */
5604  _message = (RexxObject *)new (argCount + (2 * namedArgCount)) RexxExpressionMessage(target, (RexxString *)OREF_ROUND_BRACKETS, (RexxObject *)OREF_NULL, argCount, this->subTerms, namedArgCount, this->namedSubTerms, false);
5605  this->holdObject(_message); /* hold this here for a while */
5606  this->removeObj((RexxObject *)target); /* target is now connected to message, remove from savelist without hold */
5607  return _message; /* return the message item */
5608 }
5609 #endif
5610 
5612  RexxToken *token, /* arglist start (for error reports) */
5613  RexxObject *target, /* target term */
5614  int terminators ) /* expression termination context */
5615 /******************************************************************************/
5616 /* Function: Process an expression term of the form "target[arg,arg]" */
5617 /******************************************************************************/
5618 {
5619  size_t argCount=0; /* count of function arguments */
5620  size_t namedArgCount=0;
5621  RexxObject *_message; /* new message term */
5622 
5623  this->saveObject((RexxObject *)target); /* save target until it gets connected to message */
5624  /* process the argument list */
5625  /*argCount =*/ this->argList(token, ((terminators | TERM_SQRIGHT) & ~TERM_RIGHT), true, /*byref*/argCount, /*byref*/namedArgCount);
5626  /* create a new message item */
5627  _message = (RexxObject *)new (argCount + (2 * namedArgCount)) RexxExpressionMessage(target, (RexxString *)OREF_BRACKETS, (RexxObject *)OREF_NULL, argCount, this->subTerms, namedArgCount, this->namedSubTerms, false);
5628  this->holdObject(_message); /* hold this here for a while */
5629  this->removeObj((RexxObject *)target); /* target is now connected to message, remove from savelist without hold */
5630  return _message; /* return the message item */
5631 }
5632 
5634  int terminators, /* expression termination context */
5635  int errorcode) /* expected error code */
5636 /******************************************************************************/
5637 /* Function: Get a token, checking to see if this is a terminatore token */
5638 /******************************************************************************/
5639 {
5640  RexxToken *token = nextToken(); /* get the next token */
5641  /* this a terminator token? */
5642  if (this->terminator(terminators, token))
5643  {
5644  if (errorcode != 0) /* want an error raised? */
5645  {
5646  syntaxError(errorcode); /* report this */
5647  }
5648  return OREF_NULL; /* just return a null */
5649  }
5650  return token; /* return the token */
5651 }
5652 
5654  RexxObject *target, /* message send target */
5655  bool doubleTilde, /* class of message send */
5656  int terminators ) /* expression termination context */
5657 /******************************************************************************/
5658 /* Function: Parse a full message send expression term */
5659 /******************************************************************************/
5660 {
5661  size_t argCount; /* list of function arguments */
5662  size_t namedArgCount;
5663  RexxString *messagename = OREF_NULL; /* message name */
5664  bool messagenameProvided = true;
5665  RexxObject *super; /* super class target */
5666  RexxToken *token; /* current working token */
5667  RexxExpressionMessage *_message; /* new message term */
5668 
5669  super = OREF_NULL; /* default no super class */
5670  argCount = 0; /* and no arguments */
5671  namedArgCount = 0;
5672  this->saveObject(target); /* save target until it gets connected to message */
5673 
5674  /* add the term to the term stack so that the calculations */
5675  /* include this in the processing. */
5676  this->pushTerm(target);
5677  /* get the next token */
5678  token = this->getToken(terminators, 0 /*Error_Symbol_or_string_tilde*/);
5679  /* unexpected type? */
5680  if (token == OREF_NULL || token->classId == TOKEN_COLON || token->classId == TOKEN_LEFT || token->isSourceLiteral())
5681  {
5682  // no explicit message name, this is the implicit tilde-call
5683  messagename = (RexxString *)OREF_TILDE_ROUND_BRACKETS;
5684  messagenameProvided = false;
5685  if (token != OREF_NULL) previousToken();
5686  }
5687  else if (token->isSymbolOrLiteral())
5688  {
5689  messagename = token->value; /* get the message name */
5690  }
5691  else
5692  {
5693  /* error! */
5695  }
5696  /* get the next token */
5697  token = this->getToken(terminators, 0);
5698  if (token != OREF_NULL)
5699  { /* not reached the clause end? */
5700  /* have a super class? */
5701  if (token->classId == TOKEN_COLON)
5702  {
5703  /* get the next token */
5704  token = this->getToken(terminators, Error_Symbol_expected_colon);
5705  /* not a variable symbol? */
5706  if (!token->isVariable() && token->subclass != SYMBOL_DOTSYMBOL)
5707  {
5708  /* have an error */
5710  }
5711  super = this->addText(token); /* get the variable retriever */
5712  /* get the next token */
5713  token = this->getToken(terminators, 0);
5714  }
5715  }
5716  if (!messagenameProvided)
5717  {
5718  // Message name or argument list is mandatory
5719  if (token == OREF_NULL || (token->classId != TOKEN_LEFT && !token->isSourceLiteral()))
5720  {
5722  }
5723  }
5724  if (token != OREF_NULL)
5725  { /* not reached the clause end? */
5726  if (token->classId == TOKEN_LEFT || token->isSourceLiteral()) /* have an argument list? */
5727  {
5728  /* process the argument list */
5729  /*argCount =*/ this->argList(token, ((terminators | TERM_RIGHT) & ~TERM_SQRIGHT), true, /*byref*/argCount, /*byref*/namedArgCount);
5730  }
5731  else
5732  {
5733  previousToken(); /* something else, step back */
5734  }
5735  }
5736 
5737  this->popTerm(); /* it is now safe to pop the message target */
5738  /* create a message send node */
5739  _message = new (argCount + (2 * namedArgCount)) RexxExpressionMessage(target, messagename, super, argCount, this->subTerms, namedArgCount, this->namedSubTerms, doubleTilde);
5740  /* protect for a bit */
5741  this->holdObject((RexxObject *)_message);
5742  this->removeObj(target); /* target is now connected to message, remove from savelist without hold */
5743  return(RexxObject *)_message; /* return the message item */
5744 }
5745 
5746 
5747 /**
5748  * Parse off a single variable symbol or a message term that
5749  * can be used for an assignment.
5750  *
5751  * NOTE: If this is a message term, then the message term
5752  * will be configured as an assignment term.
5753  *
5754  * @return The object for an assignment target, or OREF_NULL if something
5755  * other than a variable or a message term was found. On return,
5756  * the clause position pointer will either be unchanged or
5757  * positioned at the next token of the clause.
5758  */
5760 {
5761  // try for a message term first. If not successful, see if the
5762  // next token is a variable symbol.
5763  RexxObject *result = messageTerm();
5764  if (result == OREF_NULL)
5765  {
5766  RexxToken *_first = nextReal();
5767  if (_first->isSymbol())
5768  {
5769  // ok, add the variable to the processing list
5770  this->needVariable(_first);
5771  result = this->addText(_first);
5772  }
5773  else
5774  {
5775  previousToken(); // just push back on for the caller to sort out
5776  }
5777  }
5778  else
5779  {
5780  // we need to convert this into an assignment message.
5781  ((RexxExpressionMessage *)result)->makeAssignment(this);
5782  }
5783  return result;
5784 }
5785 
5786 
5787 
5789 /******************************************************************************/
5790 /* Function: Parse off an instruction leading message term element */
5791 /******************************************************************************/
5792 {
5793  RexxToken *token; /* current working token */
5794  RexxObject *term; /* working term */
5795  RexxObject *start; /* starting term */
5796  int classId; /* token class */
5797 
5798  size_t mark = markPosition(); // save the current position so we can reset cleanly
5799 
5800  // jlf: add TERM_COMMA to support ",;" which is evaluated as an array of 2 elements
5801  start = this->subTerm(TERM_EOC | TERM_COMMA); /* get the first term of instruction */
5802  this->holdObject(start); /* save the starting term */
5803  term = OREF_NULL; /* default to no term */
5804  token = nextToken(); /* get the next token */
5805  classId = token->classId; /* get the token class */
5806  /* while cascading message sends */
5807  while (classId == TOKEN_TILDE || classId == TOKEN_DTILDE || classId == TOKEN_SQLEFT )
5808  {
5809  if (classId == TOKEN_SQLEFT) /* left bracket form? */
5810  {
5811  term = this->collectionMessage(token, start, TERM_EOC);
5812  }
5813  else
5814  {
5815  /* process a message term */
5816  term = this->message(start, classId == TOKEN_DTILDE, TERM_EOC);
5817  }
5818  start = term; /* set for the next pass */
5819  token = nextToken(); /* get the next token */
5820  classId = token->classId; /* get the token class */
5821  }
5822  previousToken(); /* push this term back */
5823  // if this was not a valid message term, reset the position to the beginning
5824  if (term == OREF_NULL)
5825  {
5826  resetPosition(mark); // reset back to the entry conditions
5827  }
5828  /* return the message term (returns */
5829  return term; /* OREF_NULL if not a message term) */
5830 }
5831 
5833  int terminators ) /* expression termination context */
5834 /******************************************************************************/
5835 /* Function: Parse off a message subterm within an expression */
5836 /******************************************************************************/
5837 {
5838  RexxToken *token; /* current working token */
5839  RexxObject *term = OREF_NULL; /* working term */
5840  int classId; /* token class */
5841 
5842  token = nextToken(); /* get the next token */
5843  /* this the expression end? */
5844  if (this->terminator(terminators, token))
5845  {
5846  return OREF_NULL; /* nothing to do here */
5847  }
5848  /* have potential prefix operator? */
5849  if (token->classId == TOKEN_OPERATOR)
5850  {
5851 
5852  /* handle prefix operators as terms */
5853  switch (token->subclass)
5854  {
5855 
5856  case OPERATOR_PLUS: /* prefix plus */
5857  case OPERATOR_SUBTRACT: /* prefix minus */
5858  case OPERATOR_BACKSLASH: /* prefix backslash */
5859  /* handle following term */
5860  term = this->messageSubterm(terminators);
5861  if (term == OREF_NULL) /* nothing found? */
5862  {
5863  /* this is an error */
5865  }
5866  /* create the new operator term */
5867  term = (RexxObject *)new RexxUnaryOperator(token->subclass, term);
5868  break;
5869 
5870  default: /* other operators not allowed here */
5871  /* this is an error */
5873  }
5874  }
5875  /* non-prefix operator code */
5876  else
5877  {
5878  previousToken(); /* put back the first token */
5879  term = this->subTerm(TERM_EOC); /* get the first term of instruction */
5880  this->holdObject(term); /* save the starting term */
5881  token = nextToken(); /* get the next token */
5882  classId = token->classId; /* get the token class */
5883  /* while cascading message sends */
5884  while (classId == TOKEN_TILDE || classId == TOKEN_DTILDE || classId == TOKEN_SQLEFT )
5885  {
5886  if (classId == TOKEN_SQLEFT) /* left bracket form? */
5887  {
5888  term = this->collectionMessage(token, term, TERM_EOC);
5889  }
5890  else
5891  {
5892  /* process a message term */
5893  term = this->message(term, classId == TOKEN_DTILDE, TERM_EOC);
5894  }
5895  token = nextToken(); /* get the next token */
5896  classId = token->classId; /* get the token class */
5897  }
5898  previousToken(); /* push this term back */
5899  }
5900  /* return the message term (returns */
5901  return term; /* OREF_NULL if not a message term) */
5902 }
5903 
5905  int terminators ) /* expression termination context */
5906 /******************************************************************************/
5907 /* Function: Parse off a subterm of an expression, from simple ones like */
5908 /* variable names, to more complex such as message sends */
5909 /******************************************************************************/
5910 {
5911  RexxToken *token; /* current token being processed */
5912  RexxObject *term = OREF_NULL; /* parsed out term */
5913  RexxToken *second; /* second token of term */
5914 
5915  token = nextToken(); /* get the next token */
5916  /* this the expression end? */
5917  if (this->terminator(terminators, token))
5918  {
5919  return OREF_NULL; /* nothing to do here */
5920  }
5921 
5922  switch (token->classId)
5923  {
5924 
5925  case TOKEN_LEFT: /* have a left parentheses */
5926  /* get the subexpression */
5927  //term = this->subExpression(((terminators | TERM_RIGHT) & ~TERM_SQRIGHT));
5928 
5929  // parse off the parenthetical. This might not return anything if there
5930  // is nothing in the parens. This is an error. Also, in this context,
5931  // we are back in a mode where the array-creation syntax is allowed.
5932  term = fullSubExpression(TERM_RIGHT);
5933  if (term == OREF_NULL) /* nothing found? */
5934  {
5935  /* this is an error */
5937  }
5938  second = nextToken(); /* get the terminator token */
5939  /* not terminated by a right paren? */
5940  if (second->classId != TOKEN_RIGHT)
5941  {
5942  /* this is an error */
5944  }
5945  break;
5946 
5947  case TOKEN_SYMBOL: /* Symbol in the expression */
5948  case TOKEN_LITERAL: /* Literal in the expression */
5949  case TOKEN_SOURCE_LITERAL: /* Source literal in the expression */
5950  second = nextToken(); /* get the next token */
5951  /* have a function call? */
5952  if (second->classId == TOKEN_LEFT || second->isSourceLiteral())
5953  {
5954  /* process the function call */
5955  if (token->classId == TOKEN_SOURCE_LITERAL)
5956  {
5957 #if 0
5958  // It works but not activated... Tilde-call is more general.
5959  term = this->addText(token);
5960  term = this->functionCallMessage(second, term, terminators);
5961 #else
5962  // Function-call not activated. Just return the source literal.
5963  previousToken(); /* push the token back */
5964  term = this->addText(token); /* variable or literal access */
5965 #endif
5966  }
5967  else
5968  {
5969  term = this->function(second, token, terminators);
5970  }
5971  }
5972  else
5973  {
5974  previousToken(); /* push the token back */
5975  term = this->addText(token); /* variable or literal access */
5976  }
5977  break;
5978 
5979  case TOKEN_RIGHT: /* have a right parentheses */
5980  /* this is an error here */
5982  break;
5983 
5984  case TOKEN_COMMA: /* have a comma */
5985  /* this is an error here */
5987  break;
5988 
5989  case TOKEN_SQRIGHT: /* have a right square bracket */
5990  /* this is an error here */
5992  break;
5993 
5994  case TOKEN_OPERATOR: /* operator token */
5995  switch (token->subclass)
5996  { /* handle prefix operators as terms */
5997 
5998  case OPERATOR_PLUS: /* prefix plus */
5999  case OPERATOR_SUBTRACT: /* prefix minus */
6000  case OPERATOR_BACKSLASH: /* prefix backslash */
6001  previousToken(); /* put the token back */
6002  return OREF_NULL; /* just return null (processed later)*/
6003 
6004  default: /* other operators not allowed here */
6005  /* this is an error */
6007  }
6008  break;
6009 
6010  default: /* unknown thing in expression */
6011  /* this is an error */
6013  }
6014  return term; /* return this term */
6015 }
6016 
6018  RexxObject *term ) /* term to push */
6019 /******************************************************************************/
6020 /* Function: Push a term onto the expression term stack */
6021 /******************************************************************************/
6022 {
6023  this->terms->push(term); /* push the term on the stack */
6024  this->currentstack++; /* step the stack depth */
6025  /* new "high water" mark? */
6026  if (this->currentstack > this->maxstack)
6027  {
6028  /* make it the highest point */
6029  this->maxstack = this->currentstack;
6030  }
6031 }
6032 
6034 /******************************************************************************/
6035 /* Function: Pop a term off of the expression term stack */
6036 /******************************************************************************/
6037 {
6038  RexxObject *term; /* returned term */
6039 
6040  this->currentstack--; /* reduce the size count */
6041  term = this->terms->pop(); /* pop the term */
6042  this->holdObject(term); /* give it a little protection */
6043  return term; /* and return it */
6044 }
6045 
6046 /**
6047  * Push a term on to the expression sub term stack. The
6048  * subterms normally contribute to the total required stack
6049  * size, so make sure we account for these when calculating the
6050  * total required stack size. Only use this method of pushing
6051  * the term when the max stack size is affected.
6052  *
6053  * @param term The term object.
6054  */
6056 {
6057  // push the term on to the stack.
6058  subTerms->push(term);
6059 
6060  // we keep track of how large the term stack gets during parsing. This
6061  // tells us how much stack space we need to allocate at run time.
6062  currentstack++;
6063  // maxStack = Numerics::maxVal(currentStack, maxStack);
6065 }
6066 
6067 
6068 /**
6069  * Pop a term off of the expression sub term stack.
6070  *
6071  * @return The popped object.
6072  */
6074 {
6075  // reduce the stack count
6076  currentstack--;
6077  // pop the object off of the stack and give it some short-term
6078  // GC protection.
6079  RexxObject *term = subTerms->pop();
6080  holdObject(term);
6081  return term;
6082 }
6083 
6084 
6086  size_t count ) /* number of terms to pop */
6087 /******************************************************************************/
6088 /* Function: Pop multiple terms off of the operator stack */
6089 /******************************************************************************/
6090 {
6091  RexxObject *result = OREF_NULL; /* final popped element */
6092 
6093  this->currentstack -= count; /* reduce the size count */
6094  while (count--) /* while more to remove */
6095  {
6096  result = this->terms->pop(); /* pop the next item */
6097  }
6098  this->holdObject(result); /* protect this a little */
6099  return result; /* and return it */
6100 }
6101 
6103 /******************************************************************************/
6104 /* Function: Validate placement of an EXPOSE instruction. The EXPOSE must */
6105 /* be the first instruction and this must not be an interpret */
6106 /* invocation. NOTE: labels are not allowed preceeding, as that */
6107 /* will give a target for SIGNAL or CALL that will result in an */
6108 /* invalid EXPOSE execution. */
6109 /******************************************************************************/
6110 {
6111  if (this->flags&_interpret) /* is this an interpret? */
6112  {
6113  /* give the interpret error */
6115  }
6116  /* not the first instruction? */
6117  if (this->last->getType() != KEYWORD_FIRST)
6118  {
6119  /* general placement error */
6121  }
6122 }
6123 
6125  RexxString *string) /* target string */
6126 /******************************************************************************/
6127 /* Function: Break up a string into an array of words for parsing and */
6128 /* interpretation. */
6129 /******************************************************************************/
6130 {
6131  RexxQueue *wordlist; /* created list of words */
6132  RexxArray *wordarray; /* array version of the list */
6133  RexxString *word; /* current word */
6134  size_t count; /* count of words */
6135  size_t i; /* loop counter */
6136 
6137  wordlist = this->subTerms; /* use the subterms list */
6138  /* get the first word */
6139  word = ((RexxString *)(string->word(IntegerOne)))->upper();
6140  word = this->commonString(word); /* get the common version of this */
6141  wordlist->push(word); /* add to the word list */
6142  count = 1; /* one word so far */
6143  /* while still more words */
6144  for (i = 3, word = (RexxString *)(string->word(IntegerTwo)); word->getBLength() != 0; i++)
6145  {
6146  count++; /* have another word */
6147  word = this->commonString(word); /* get the common version of this */
6148  wordlist->push(word); /* add this word to the list */
6149  /* get the next word */
6150  word = (RexxString *)string->word(new_integer(i));
6151  }
6152  wordarray = new_array(count); /* get an array return value */
6153  while (count > 0) /* while more words */
6154  {
6155  /* copy into the array */
6156  wordarray->put(wordlist->pop(), count--);
6157  }
6158  return wordarray; /* return as an array */
6159 }
6160 
6162 /******************************************************************************/
6163 /* Function: Free up all of the parsing elements because of an error */
6164 /******************************************************************************/
6165 {
6166  this->cleanup(); /* do needed cleanup */
6167 }
6168 
6169 void RexxSource::error(int errorcode)
6170 /******************************************************************************/
6171 /* Function: Raise an error caused by source translation problems. */
6172 /******************************************************************************/
6173 {
6174  this->errorCleanup(); /* release any saved objects */
6175  /* pass on the exception info */
6177 }
6178 
6179 void RexxSource::error(int errorcode, SourceLocation &location, RexxArray *subs)
6180 /******************************************************************************/
6181 /* Function: Raise an error caused by source translation problems. */
6182 /******************************************************************************/
6183 {
6184  this->errorCleanup(); /* release any saved objects */
6185  clauseLocation = location; // set the error location
6186  /* pass on the exception info */
6188 }
6189 
6191  int errorcode, /* error to raise */
6192  RexxInstruction *_instruction) /* instruction for the line number */
6193 /******************************************************************************/
6194 /* Function: Raise an error where one of the error message substitutions is */
6195 /* the line number of another instruction object */
6196 /******************************************************************************/
6197 {
6198  this->errorCleanup(); /* release any saved objects */
6199  /* pass on the exception info */
6201 }
6202 
6204  int errorcode, /* error to raise */
6205  SourceLocation token_location ) /* token location for description */
6206 /******************************************************************************/
6207 /* Function: Raise an error, displaying the location of a token associated */
6208 /* with the error. */
6209 /******************************************************************************/
6210 {
6211  this->errorCleanup(); /* release any saved objects */
6212  /* pass on the exception info */
6214 }
6215 
6217  int errorcode, /* error to raise */
6218  RexxToken *token ) /* token value for description */
6219 /******************************************************************************/
6220 /* Function: Raise an error, displaying the value of a token in the error */
6221 /* message. */
6222 /******************************************************************************/
6223 {
6224  RexxString *value = token->value; /* get the token value */
6225  if (value == OREF_NULL)
6226  {
6227  switch (token->classId)
6228  {
6229 
6230  case TOKEN_BLANK: /* blank operator */
6231  value = new_string(" ", 1); /* use a blank */
6232  break;
6233 
6234  case TOKEN_EOC: /* source terminator */
6235  value = new_string(";", 1); /* use a semicolon */
6236  break;
6237 
6238  case TOKEN_COMMA: /* comma */
6239  value = new_string(",", 1); /* display a comma */
6240  break;
6241 
6242  case TOKEN_LEFT: /* left parentheses */
6243  value = new_string("(", 1); /* display that */
6244  break;
6245 
6246  case TOKEN_RIGHT: /* right parentheses */
6247  value = new_string(")", 1); /* display that */
6248  break;
6249 
6250  case TOKEN_SQLEFT: /* left square bracket */
6251  value = new_string("[", 1); /* display that */
6252  break;
6253 
6254  case TOKEN_SQRIGHT: /* right square bracket */
6255  value = new_string("]", 1); /* display that */
6256  break;
6257 
6258  case TOKEN_COLON: /* colon */
6259  value = new_string(":", 1); /* display that */
6260  break;
6261 
6262  case TOKEN_TILDE: /* twiddle operator */
6263  value = new_string("~", 1); /* display that */
6264  break;
6265 
6266  case TOKEN_DTILDE: /* double twiddle operator */
6267  value = new_string("~~", 2); /* display that */
6268  break;
6269 
6270  case TOKEN_DCOLON: /* double colon operator */
6271  value = new_string("::", 2); /* display that */
6272  break;
6273 
6274  default: /* ????? token */
6275  /* just use a null string */
6276  value = (RexxString *)OREF_NULLSTRING;
6277  break;
6278  }
6279  }
6280  else if (token->getLocation().isLimitedTrace())
6281  { /* multi-line value, display only the first line*/
6282  const char *string = value->getStringData();
6283  const char *newline = strchr(string, '\n');
6284  if (newline) value = new_string(string, sizeB_v(newline - string));
6285  this->clauseLocation.setLimitedTrace(true);
6286  }
6287  this->errorCleanup(); /* release any saved objects */
6288  /* pass on the exception info */
6290 }
6291 
6293  int errorcode, /* error to raise */
6294  RexxObject *value ) /* value for description */
6295 /******************************************************************************/
6296 /* Function: Issue an error message with a single substitution parameter. */
6297 /******************************************************************************/
6298 {
6299  this->errorCleanup(); /* release any saved objects */
6300  /* pass on the exception info */
6302 }
6303 
6305  int errorcode, /* error to raise */
6306  RexxObject *value1, /* first value for description */
6307  RexxObject *value2 ) /* second value for description */
6308 /******************************************************************************/
6309 /* Function: Issue an error message with two substitution parameters. */
6310 /******************************************************************************/
6311 {
6312  this->errorCleanup(); /* release any saved objects */
6313  /* pass on the exception info */
6315 }
6316 
6318  int errorcode, /* error to raise */
6319  RexxObject *value1, /* first value for description */
6320  RexxObject *value2, /* second value for description */
6321  RexxObject *value3 ) /* third value for description */
6322 /****************************************************************************/
6323 /* Function: Issue an error message with three substitution parameters. */
6324 /****************************************************************************/
6325 {
6326  this->errorCleanup(); /* release any saved objects */
6327  /* pass on the exception info */
6328  ActivityManager::currentActivity->raiseException(errorcode, OREF_NULL, new_array(value1, value2, value3), OREF_NULL);
6329 }
6330 
6332  RexxInstruction *_instruction ) /* unclosed control instruction */
6333 /******************************************************************************/
6334 /* Function: Raise an error for an unclosed block instruction. */
6335 /******************************************************************************/
6336 {
6337  // get the instruction location and set as the current error location
6338  clauseLocation = this->last->getLocation();
6339 
6340  switch (_instruction->getType())
6341  { /* issue proper message type */
6342  case KEYWORD_DO: /* incomplete DO */
6343  /* raise an error */
6344  syntaxError(Error_Incomplete_do_do, _instruction);
6345  break;
6346  case KEYWORD_LOOP: /* incomplete LOOP */
6347  /* raise an error */
6348  syntaxError(Error_Incomplete_do_loop, _instruction);
6349  break;
6350 
6351  case KEYWORD_SELECT: /* incomplete SELECT */
6352  syntaxError(Error_Incomplete_do_select, _instruction);
6353  break;
6354 
6355  case KEYWORD_OTHERWISE: /* incomplete SELECT */
6357  break;
6358 
6359  case KEYWORD_IF: /* incomplete IF */
6360  case KEYWORD_IFTHEN: /* incomplete IF */
6361  case KEYWORD_WHENTHEN: /* incomplete IF */
6362  syntaxError(Error_Incomplete_do_then, _instruction);
6363  break;
6364 
6365  case KEYWORD_ELSE: /* incomplete ELSE */
6366  syntaxError(Error_Incomplete_do_else, _instruction);
6367  break;
6368  }
6369 }
6370 
6371 void *RexxSource::operator new (size_t size)
6372 /******************************************************************************/
6373 /* Function: Create a new translator object from an array */
6374 /******************************************************************************/
6375 {
6376  /* Get new object */
6377  return new_object(sizeof(RexxSource), T_RexxSource);
6378 }
6379 
6380 
6382  size_t size, /* Object size */
6383  RexxBehaviour *_behaviour, /* Object's behaviour */
6384  int type ) /* Type of instruction */
6385 /******************************************************************************/
6386 /* Function: Create a "raw" translator instruction object */
6387 /******************************************************************************/
6388 {
6389  RexxObject *newObject = new_object(size); /* Get new object */
6390  newObject->setBehaviour(_behaviour); /* Give new object its behaviour */
6391  /* do common initialization */
6392  new ((void *)newObject) RexxInstruction (this->clause, type);
6393  /* now protect this */
6394  OrefSet(this, this->currentInstruction, (RexxInstruction *)newObject);
6395  return (RexxInstruction *)newObject; /* return the new object */
6396 }
6397 
6398 /**
6399  * Parse a trace setting value into a decoded setting
6400  * and the RexxActivation debug flag set to allow
6401  * new trace settings to be processed more quickly.
6402  *
6403  * @param value The string source of the trace setting.
6404  * @param newSetting The returned setting in binary form.
6405  * @param debugFlags The debug flag representation of the trace setting.
6406  */
6407 bool RexxSource::parseTraceSetting(RexxString *value, size_t &newSetting, size_t &debugFlags, char &badOption)
6408 {
6409  size_t setting = TRACE_IGNORE; /* don't change trace setting yet */
6410  size_t debug = DEBUG_IGNORE; /* and the default debug change */
6411 
6412  sizeB_t length = value->getBLength(); /* get the string length */
6413  /* null string? */
6414  if (length == 0)
6415  {
6416  setting = TRACE_NORMAL; /* use default trace setting */
6417  debug = DEBUG_OFF; /* turn off debug mode */
6418  }
6419  else
6420  {
6421  /* start at the beginning */
6422  /* while more length to process */
6423  /* step one each character */
6424  for (size_t _position = 0; _position < length; _position++)
6425  {
6426 
6427  /* process the next character */
6428  switch (value->getCharB(_position))
6429  {
6430 
6431  case '?': /* debug toggle character */
6432  /* already toggling? */
6433  if (debug == DEBUG_TOGGLE)
6434  {
6435  debug = DEBUG_IGNORE; /* this is back to no change at all */
6436  }
6437  else
6438  {
6439  debug = DEBUG_TOGGLE; /* need to toggle the debug mode */
6440  }
6441  continue; /* go loop again */
6442 
6443  case 'a': /* TRACE ALL */
6444  case 'A':
6445  setting = TRACE_ALL;
6446  break;
6447 
6448  case 'c': /* TRACE COMMANDS */
6449  case 'C':
6450  setting = TRACE_COMMANDS;
6451  break;
6452 
6453  case 'l': /* TRACE LABELS */
6454  case 'L':
6455  setting = TRACE_LABELS;
6456  break;
6457 
6458  case 'e': /* TRACE ERRORS */
6459  case 'E':
6460  setting = TRACE_ERRORS;
6461  break;
6462 
6463  case 'f': /* TRACE FAILURES */
6464  case 'F':
6465  setting = TRACE_FAILURES;
6466  break;
6467 
6468  case 'n': /* TRACE NORMAL */
6469  case 'N':
6470  setting = TRACE_NORMAL;
6471  break;
6472 
6473  case 'o': /* TRACE OFF */
6474  case 'O':
6475  setting = TRACE_OFF;
6476  break;
6477 
6478  case 'r': /* TRACE RESULTS */
6479  case 'R':
6480  setting = TRACE_RESULTS;
6481  break;
6482 
6483  case 'i': /* TRACE INTERMEDIATES */
6484  case 'I':
6485  setting = TRACE_INTERMEDIATES;
6486  break;
6487 
6488  default: /* unknown trace setting */
6489  // each context handles it's own error reporting, so give back the
6490  // information needed for the message.
6491  badOption = value->getCharB(_position);
6492  return false;
6493  break;
6494  }
6495  break; /* non-prefix char found */
6496  }
6497  }
6498  // return the merged setting
6499  newSetting = setting | debug;
6500  // create the activation-specific flags
6501  debugFlags = RexxActivation::processTraceSetting(newSetting);
6502  return true;
6503 }
6504 
6505 
6506 /**
6507  * Format an encoded trace setting back into human readable form.
6508  *
6509  * @param setting The source setting.
6510  *
6511  * @return The string representation of the trace setting.
6512  */
6514 {
6515  char setting[3]; /* returned trace setting */
6516  setting[0] = '\0'; /* start with a null string */
6517  /* debug mode? */
6518  if (source & DEBUG_ON)
6519  {
6520  setting[0] = '?'; /* add the question mark */
6521  /* add current trace option */
6522  setting[1] = (char)source&TRACE_SETTING_MASK;
6523  /* create a string form */
6524  return new_string(setting, 2);
6525  }
6526  else /* no debug prefix */
6527  {
6528  /* add current trace option */
6529  setting[0] = (char)source&TRACE_SETTING_MASK;
6530  /* create a string form */
6531  return new_string(setting, 1);
6532  }
6533 }
6534 
6536  int type ) /* type of instruction */
6537 /****************************************************************************/
6538 /* Function: Process a variable list for PROCEDURE, DROP, UPPER and USE */
6539 /****************************************************************************/
6540 {
6541  RexxToken *token; /* current working token */
6542  int list_count; /* count of variables in list */
6543  RexxObject *retriever; /* variable retriever object */
6544 
6545  list_count = 0; /* no variables yet */
6546  token = nextReal(); /* get the first variable */
6547 
6548  /* while not at the end of the clause*/
6549  while (!token->isEndOfClause())
6550  {
6551  /* have a variable name? */
6552  if (token->isSymbol())
6553  {
6554  /* non-variable symbol? */
6555  if (token->subclass == SYMBOL_CONSTANT)
6556  {
6557  /* report the error */
6559  }
6560  else if (token->subclass == SYMBOL_DUMMY)
6561  {
6562  /* report the error */
6564  }
6565  retriever = this->addText(token);/* get a retriever for this */
6566  this->subTerms->push(retriever); /* add to the variable list */
6567  if (type == KEYWORD_EXPOSE) /* this an expose operation? */
6568  {
6569  this->expose(token->value); /* add to the expose list too */
6570  }
6571  list_count++; /* record the variable */
6572  }
6573  /* have a variable reference */
6574  else if (token->classId == TOKEN_LEFT)
6575  {
6576  list_count++; /* record the variable */
6577  token = nextReal(); /* get the next token */
6578  /* not a symbol? */
6579  if (!token->isSymbol())
6580  {
6581  /* must be a symbol here */
6583  }
6584  /* non-variable symbol? */
6585  if (token->subclass == SYMBOL_CONSTANT)
6586  {
6587  /* report the error */
6589  }
6590  else if (token->subclass == SYMBOL_DUMMY)
6591  {
6592  /* report the error */
6594  }
6595 
6596  retriever = this->addText(token);/* get a retriever for this */
6597  /* make this an indirect reference */
6598  retriever = (RexxObject *)new RexxVariableReference((RexxVariableBase *)retriever);
6599  this->subTerms->queue(retriever);/* add to the variable list */
6600  this->currentstack++; /* account for the varlists */
6601 
6602  token = nextReal(); /* get the next token */
6603  if (token->isEndOfClause()) /* nothing following? */
6604  {
6605  /* report the missing paren */
6607  }
6608  /* must be a right paren here */
6609  else if (token->classId != TOKEN_RIGHT)
6610  {
6611  /* this is an error */
6613  }
6614  }
6615  /* something bad.... */
6616  else
6617  { /* this is invalid */
6618  if (type == KEYWORD_DROP) /* DROP form? */
6619  {
6620  /* give appropriate message */
6622  }
6623  else if (type == KEYWORD_UPPER) /* UPPER form? */
6624  {
6625  /* give appropriate message */
6627  }
6628  else /* else give message for EXPOSEs */
6629  {
6631  }
6632  }
6633  token = nextReal(); /* get the next variable */
6634  }
6635  if (list_count == 0)
6636  { /* no variables? */
6637  if (type == KEYWORD_DROP) /* DROP form? */
6638  {
6639  /* give appropriate message */
6641  }
6642  else if (type == KEYWORD_UPPER) /* UPPER form? */
6643  {
6644  /* give appropriate message */
6646  }
6647  else /* else give message for EXPOSEs */
6648  {
6650  }
6651  }
6652  return list_count; /* return the count */
6653 }
6654 
6656  int *condition_type, /* type of condition */
6657  int error_message ) /* extra "stuff" error message */
6658 /******************************************************************************/
6659 /* Function: Allow for WHILE or UNTIL keywords following some other looping */
6660 /* construct. This returns SUBKEY_WHILE or SUBKEY_UNTIL to flag */
6661 /* the caller that a conditional has been used. */
6662 /******************************************************************************/
6663 {
6664  RexxToken *token; /* current working token */
6665  int _keyword; /* keyword of parsed conditional */
6666  RexxObject *_condition; /* parsed out condition */
6667 
6668  _condition = OREF_NULL; /* default to no condition */
6669  _keyword = 0; /* no conditional yet */
6670  token = nextReal(); /* get the terminator token */
6671 
6672  /* real end of instruction? */
6673  if (!token->isEndOfClause())
6674  {
6675  /* may have WHILE/UNTIL */
6676  if (token->isSymbol())
6677  {
6678  /* process the symbol */
6679  switch (this->subKeyword(token) )
6680  {
6681 
6682  case SUBKEY_WHILE: /* DO WHILE exprw */
6683  refineSubclass(token, IS_SUBKEY);
6684  /* get next subexpression */
6685  _condition = this->parseLogical(OREF_NULL, TERM_COND);
6686  if (_condition == OREF_NULL) /* nothing really there? */
6687  {
6688  /* another invalid DO */
6690  }
6691  token = nextToken(); /* get the terminator token */
6692  /* must be end of instruction */
6693  if (!token->isEndOfClause())
6694  {
6696  }
6697  _keyword = SUBKEY_WHILE; /* this is the WHILE form */
6698  break;
6699 
6700  case SUBKEY_UNTIL: /* DO UNTIL expru */
6701  refineSubclass(token, IS_SUBKEY);
6702  /* get next subexpression */
6703  /* get next subexpression */
6704  _condition = this->parseLogical(OREF_NULL, TERM_COND);
6705 
6706  if (_condition == OREF_NULL) /* nothing really there? */
6707  {
6708  /* another invalid DO */
6710  }
6711  token = nextToken(); /* get the terminator token */
6712  /* must be end of instruction */
6713  if (!token->isEndOfClause())
6714  {
6716  }
6717  _keyword = SUBKEY_UNTIL; /* this is the UNTIL form */
6718  break;
6719 
6720  default: /* nothing else is valid here! */
6721  /* raise an error */
6722  syntaxError(error_message, token);
6723  break;
6724  }
6725  }
6726  }
6727  if (condition_type != NULL) /* need the condition type? */
6728  {
6729  *condition_type = _keyword; /* set the keyword */
6730  }
6731  return _condition; /* return the condition expression */
6732 }
6733 
6734 
6735 /**
6736  * Parse off a "logical list expression", consisting of a
6737  * list of conditionals separated by commas.
6738  *
6739  * @param terminators
6740  * The set of terminators for this logical context.
6741  *
6742  * @return OREF_NULL if no expressions is found, a single expression
6743  * element if a single expression is located, and a complex
6744  * logical expression operator for a list of expressions.
6745  */
6747 {
6748  size_t count;
6749  size_t namedCount; // named arguments not allowed, will be always zero
6750  argList(_first, terminators, false, /*byref*/count, /*byref*/namedCount);
6751  // arglist has swallowed the terminator token, so we need to back up one.
6752  previousToken();
6753  // let the caller deal with completely missing expressions
6754  if (count == 0)
6755  {
6756  return OREF_NULL;
6757  }
6758 
6759  // just a single item (common)? Just pop the top item and return it.
6760  if (count == 1)
6761  {
6762  return subTerms->pop();
6763  }
6764 
6765  /* create a new function item */
6766  return (RexxObject *)new (count) RexxExpressionLogical(this, count, this->subTerms);
6767 }
6768 
6769 
6770 /**
6771  * Load a ::REQUIRES directive when the source file is first
6772  * invoked.
6773  *
6774  * @param target The name of the ::REQUIRES
6775  * @param instruction
6776  * The directive instruction being processed.
6777  */
6779 {
6780  // we need the instance this is associated with
6781  InterpreterInstance *instance = activity->getInstance();
6782 
6783  // get a fully resolved name for this....we might locate this under either name, but the
6784  // fully resolved name is generated from this source file context.
6785  RexxString *fullName = resolveProgramName(activity, target);
6786  ProtectedObject p(fullName);
6787 
6788  // if we've already loaded this in this instance, just return it.
6789  PackageClass *packageInstance = instance->loadRequires(activity, target, fullName);
6790 
6791  if (packageInstance == OREF_NULL) /* couldn't create this? */
6792  {
6793  /* report an error */
6795  }
6796  // add this to the source context
6797  addPackage(packageInstance);
6798  return packageInstance;
6799 }
6800 
6801 
6802 /**
6803  * Load a ::REQUIRES directive from an provided source target
6804  *
6805  * @param target The name of the ::REQUIRES
6806  */
6808 {
6809  // we need the instance this is associated with
6810  InterpreterInstance *instance = activity->getInstance();
6811 
6812  // if we've already loaded this in this instance, just return it.
6813  PackageClass *packageInstance = instance->loadRequires(activity, target, s);
6814 
6815  if (packageInstance == OREF_NULL) /* couldn't create this? */
6816  {
6817  /* report an error */
6819  }
6820  // add this to the source context
6821  addPackage(packageInstance);
6822  return packageInstance;
6823 }
6824 
6825 
6826 /**
6827  * Add a package to a source file context. This allows new
6828  * packages to be imported into a source.
6829  *
6830  * @param p
6831  */
6833 {
6834  // force the directives to be processed first
6835  install();
6836  // we only create this on the first use
6837  if (loadedPackages == OREF_NULL)
6838  {
6840  }
6841  else
6842  {
6843  // we only add a given package item once.
6845  {
6846  return;
6847  }
6848  }
6849 
6850  // add this to the list and merge the information
6851  loadedPackages->append(p);
6852  // not merge all of the info from the imported package
6854 }
6855 
6856 
6857 /**
6858  * Retrieve the package wrapper associated with this source.
6859  *
6860  * @return The package instance that fronts for this source in Rexx code.
6861  */
6863 {
6864  if (package == OREF_NULL)
6865  {
6866  OrefSet(this, this->package, new PackageClass(this));
6867  }
6868  return package;
6869 }
6870 
6871 
6872 /**
6873  * Add an installed class to this source package
6874  *
6875  * @param name The class name
6876  * @param classObject
6877  * The class object
6878  * @param publicClass
6879  * Indicates whether this needs to be added to the public list as well.
6880  */
6881 void RexxSource::addInstalledClass(RexxString *name, RexxClass *classObject, bool publicClass)
6882 {
6883  // force the directives to be processed first
6884  install();
6885  // make sure we have this created
6887  {
6889  }
6890  installed_classes->setEntry(name, classObject);
6891  if (publicClass)
6892  {
6893  // make sure we have this created also
6895  {
6897  }
6898  installed_public_classes->setEntry(name, classObject);
6899  }
6900 }
6901 
6902 
6903 /**
6904  * Add an installed routine to this source package
6905  *
6906  * @param name The routine name
6907  * @param classObject
6908  * The routine object
6909  * @param publicClass
6910  * Indicates whether this needs to be added to the public list as well.
6911  */
6912 void RexxSource::addInstalledRoutine(RexxString *name, RoutineClass *routineObject, bool publicRoutine)
6913 {
6914  // force the directives to be processed first
6915  install();
6916  // make sure we have this created
6917  if (routines == OREF_NULL)
6918  {
6919  OrefSet(this, routines, new_directory());
6920  }
6921  routines->setEntry(name, routineObject);
6922  if (publicRoutine)
6923  {
6924  // make sure we have this created
6925  if (public_routines == OREF_NULL)
6926  {
6928  }
6929  public_routines->setEntry(name, routineObject);
6930  }
6931 }
6932 
6933 
6934 
void reportException(wholenumber_t error)
RexxArray * new_array(size_t s)
Definition: ArrayClass.hpp:259
RexxBuffer * new_buffer(sizeB_t s)
@ T_RexxSource
RexxDirectory * new_directory()
RexxIdentityTable * new_identity_table()
RexxInteger * new_integer(wholenumber_t v)
#define LIST_END
Definition: ListClass.hpp:60
RexxList * new_list()
Definition: ListClass.hpp:147
size_t number_digits()
Definition: Numerics.hpp:155
RexxQueue * new_queue()
Definition: QueueClass.hpp:89
#define OREF_NULL
Definition: RexxCore.h:60
#define TheNullArray
Definition: RexxCore.h:183
#define IntegerOne
Definition: RexxCore.h:190
#define TheEnvironment
Definition: RexxCore.h:174
#define OrefSet(o, r, v)
Definition: RexxCore.h:94
#define TheCommonRetrievers
Definition: RexxCore.h:177
#define TheTrueObject
Definition: RexxCore.h:186
bool isMethod(RexxObject *o)
Definition: RexxCore.h:276
#define IntegerTwo
Definition: RexxCore.h:191
#define isOfClass(t, r)
Definition: RexxCore.h:212
#define TheNilObject
Definition: RexxCore.h:181
#define Error_Translation_body_error
#define Error_Invalid_expression_until
#define Error_Translation_external_routine
#define Error_Translation_invalid_line
#define Error_Unexpected_then_else
#define Error_Symbol_or_string_fuzz_value
#define Error_Translation_bad_external
#define Error_Symbol_or_string_external
#define Error_Symbol_or_string_constant_value
#define Message_Translations_no_source_available
#define Error_Symbol_or_string_constant
#define Error_Unmatched_parenthesis_square
#define Error_Translation_constant_body
#define Error_Symbol_expected_colon
#define Error_Translation_attribute_method
#define Error_Translation_reply_interpret
#define Error_Invalid_subkeyword_method
#define Error_Symbol_or_string_trace_value
#define Error_Invalid_subkeyword_requires
#define Error_Invalid_expression_message_term
#define Error_Invalid_variable_period
#define Error_Execution_cyclic
#define Error_Unexpected_end_else
#define Error_Unexpected_comma_paren
#define Error_Unmatched_parenthesis_paren
#define Error_Translation_duplicate_constant
#define Error_Symbol_or_string_mixinclass
#define Error_Unexpected_comma_bracket
#define Error_Invalid_subkeyword_class
#define Error_Invalid_do_whileuntil
#define Error_External_name_not_found_routine
#define Error_Unexpected_end_then
#define Error_Translation_directive_interpret
#define Error_Program_unreadable_name
#define Error_Invalid_trace_trace
#define Error_Invalid_subkeyword_attribute
#define Error_Incomplete_do_otherwise
#define Error_Unexpected_comma_comma
#define Error_Routine_not_found_requires
#define Error_Symbol_or_string_attribute
#define Error_Symbol_or_string_inherit
#define Error_Invalid_expression_after_tilde
#define Error_Invalid_variable_number
#define Error_Symbol_or_string_digits_value
#define Error_Translation_bad_directive
#define Error_Symbol_or_string_routine
#define Error_Symbol_expected_varref
#define Error_Invalid_expression_general
#define Error_Symbol_expected_expose
#define Error_Translation_expose_interpret
#define Error_Translation_forward_interpret
#define Error_Symbol_or_string_subclass
#define Error_Symbol_expected_drop
#define Error_Invalid_subkeyword_options
#define Error_Translation_external_method
#define Error_Invalid_data_constant_dir
#define Error_Invalid_expression_prefix
#define Error_Symbol_expected_upper
#define Error_Translation_duplicate_attribute
#define Error_Translation_abstract_attribute
#define Error_Unexpected_when_when
#define Error_Symbol_or_string_method
#define Error_Symbol_or_string_requires
#define Error_Translation_external_attribute
#define Error_Then_expected_if
#define Error_Unexpected_then_then
#define Error_Variable_reference_missing
#define Error_Symbol_expected_directive
#define Error_Symbol_or_string_class
#define Error_Symbol_or_string_metaclass
#define Error_Expression_result_digits
#define Error_Translation_use_interpret
#define Error_Incomplete_do_then
#define Error_Incomplete_do_else
#define Error_Translation_missing_class
#define Error_When_expected_whenotherwise
#define Error_Invalid_subkeyword_routine
#define Error_Invalid_whole_number_fuzz
#define Error_Translation_invalid_attribute
#define Message_Translations_internal_code
#define Error_Unexpected_end_nodo
#define Error_Translation_guard_interpret
#define Error_External_name_not_found_method
#define Error_Unexpected_label_interpret
#define Error_Translation_abstract_method
#define Error_Invalid_expression_user_defined
#define Error_Incomplete_do_do
#define Error_Variable_reference_extra
#define Error_Unexpected_when_otherwise
#define Error_Translation_duplicate_method
#define Error_Invalid_expression_while
#define Error_Incomplete_do_loop
#define Error_Translation_duplicate_routine
#define Error_Invalid_whole_number_digits
#define Error_Translation_duplicate_class
#define Error_Translation_expose
#define Error_Invalid_subkeyword_form
#define Error_Incomplete_do_select
size_t HashLink
#define FIRST_VARIABLE_INDEX
RexxMemory memoryObject
Definition: RexxMemory.cpp:85
#define memory_mark(oref)
Definition: RexxMemory.hpp:445
RexxObject * new_object(size_t s)
Definition: RexxMemory.hpp:431
#define flatten_reference(oref, envel)
Definition: RexxMemory.hpp:493
#define memory_mark_general(oref)
Definition: RexxMemory.hpp:446
#define cleanUpFlatten
Definition: RexxMemory.hpp:479
#define setUpFlatten(type)
Definition: RexxMemory.hpp:473
@ QUEUE_FIFO
@ QUEUE_LIFO
#define PUBLIC_SCOPE
#define GUARDED_METHOD
#define ATTRIBUTE_GET
#define PREFIX_LENGTH
Definition: SourceFile.cpp:986
#define UNGUARDED_METHOD
#define line_delimiters
Definition: SourceFile.cpp:102
#define DEFAULT_PROTECTION
#define DEFAULT_GUARD
#define dumpClause(from, source, clause)
Definition: SourceFile.cpp:862
#define dumpTokens(from, source, clause)
Definition: SourceFile.cpp:884
#define HOLDSIZE
Definition: SourceFile.cpp:95
#define ctrl_z
Definition: SourceFile.cpp:103
#define DEFAULT_ACCESS_SCOPE
#define INDENT_SPACING
Definition: SourceFile.cpp:987
#define UNPROTECTED_METHOD
void dumpTokensImpl(const char *from, RexxSource *source, RexxClause *clause)
Definition: SourceFile.cpp:887
#define ATTRIBUTE_SET
#define INSTRUCTION_OVERHEAD
Definition: SourceFile.cpp:983
#define PREFIX_OFFSET
Definition: SourceFile.cpp:985
#define PRIVATE_SCOPE
#define PROTECTED_METHOD
#define ATTRIBUTE_BOTH
struct _LINE_DESCRIPTOR LINE_DESCRIPTOR
void dumpClauseImpl(const char *from, RexxSource *source, RexxClause *clause)
Definition: SourceFile.cpp:865
#define LINENUMBER
Definition: SourceFile.cpp:984
#define reclaimed
Definition: SourceFile.hpp:107
#define _install
Definition: SourceFile.hpp:106
#define _interpret
Definition: SourceFile.hpp:105
#define no_clause
Definition: SourceFile.hpp:109
#define reclaim_possible
Definition: SourceFile.hpp:108
#define FRAME_PARSE
#define STRING_NAME
Definition: StringClass.hpp:60
RexxString * new_string(const char *s, stringsizeB_t bl, sizeC_t cl=-1)
#define STRING_COMPOUND_NAME
Definition: StringClass.hpp:56
RexxString * raw_string(stringsizeB_t bl, stringsizeC_t cl=-1)
#define STRING_STEM
Definition: StringClass.hpp:55
#define IS_SUBDIRECTIVE
Definition: Token.hpp:275
#define TERM_SQRIGHT
Definition: Token.hpp:58
#define SUBKEY_UNTIL
Definition: Token.hpp:230
#define SUBKEY_WHILE
Definition: Token.hpp:236
#define SUBDIRECTIVE_NOCOMMANDS
Definition: Token.hpp:298
#define SUBDIRECTIVE_EXTERNAL
Definition: Token.hpp:282
#define KEYWORD_OTHERWISE
Definition: Token.hpp:180
#define KEYWORD_PULL
Definition: Token.hpp:162
#define KEYWORD_SELECT
Definition: Token.hpp:168
#define SUBDIRECTIVE_LIBRARY
Definition: Token.hpp:292
#define TOKEN_LITERAL
Definition: Token.hpp:79
#define SUBKEY_SCIENTIFIC
Definition: Token.hpp:226
#define KEYWORD_UPPER
Definition: Token.hpp:201
#define SUBDIRECTIVE_MIXINCLASS
Definition: Token.hpp:285
#define KEYWORD_PARSE
Definition: Token.hpp:160
#define DIRECTIVE_CLASS
Definition: Token.hpp:266
#define OPERATOR_SUBTRACT
Definition: Token.hpp:111
#define TOKEN_COLON
Definition: Token.hpp:87
#define TERM_COMMA
Definition: Token.hpp:63
#define TOKEN_OPERATOR
Definition: Token.hpp:80
#define SUBDIRECTIVE_FORM
Definition: Token.hpp:294
#define KEYWORD_NOP
Definition: Token.hpp:157
#define SUBKEY_BY
Definition: Token.hpp:206
#define KEYWORD_ENDTHEN
Definition: Token.hpp:193
#define OPERATOR_BACKSLASH
Definition: Token.hpp:141
#define OPERATOR_EQUAL
Definition: Token.hpp:120
#define KEYWORD_REPLY
Definition: Token.hpp:165
#define IS_DIRECTIVE
Definition: Token.hpp:264
#define TERM_COND
Definition: Token.hpp:70
#define KEYWORD_SIGNAL
Definition: Token.hpp:169
#define TOKEN_LEFT
Definition: Token.hpp:84
#define TERM_RIGHT
Definition: Token.hpp:57
#define DIRECTIVE_METHOD
Definition: Token.hpp:267
#define SUBDIRECTIVE_COMMANDS
Definition: Token.hpp:297
#define DIRECTIVE_EXTENSION
Definition: Token.hpp:272
#define SUBDIRECTIVE_MACROSPACE
Definition: Token.hpp:299
#define KEYWORD_RETURN
Definition: Token.hpp:166
#define SYMBOL_CONSTANT
Definition: Token.hpp:98
#define DIRECTIVE_REQUIRES
Definition: Token.hpp:265
#define KEYWORD_DO
Definition: Token.hpp:149
#define TERM_THEN
Definition: Token.hpp:65
#define KEYWORD_OPTIONS
Definition: Token.hpp:159
#define KEYWORD_CALL
Definition: Token.hpp:148
#define KEYWORD_PUSH
Definition: Token.hpp:163
#define TOKEN_BLANK
Definition: Token.hpp:77
#define KEYWORD_ITERATE
Definition: Token.hpp:154
#define SUBDIRECTIVE_SET
Definition: Token.hpp:291
#define IS_SUBKEY
Definition: Token.hpp:204
#define SUBKEY_THEN
Definition: Token.hpp:228
#define SUBDIRECTIVE_GUARDED
Definition: Token.hpp:280
#define DIRECTIVE_ROUTINE
Definition: Token.hpp:268
#define KEYWORD_IFTHEN
Definition: Token.hpp:181
#define KEYWORD_WHENTHEN
Definition: Token.hpp:182
#define KEYWORD_PROCEDURE
Definition: Token.hpp:161
#define SYMBOL_DOTSYMBOL
Definition: Token.hpp:104
#define KEYWORD_LEAVE
Definition: Token.hpp:155
#define SUBDIRECTIVE_UNGUARDED
Definition: Token.hpp:284
#define SUBDIRECTIVE_INHERIT
Definition: Token.hpp:278
#define OPERATOR_PLUS
Definition: Token.hpp:110
#define TOKEN_DCOLON
Definition: Token.hpp:92
#define SUBDIRECTIVE_SUBCLASS
Definition: Token.hpp:283
#define OPERATOR_ABUTTAL
Definition: Token.hpp:117
#define SUBDIRECTIVE_ATTRIBUTE
Definition: Token.hpp:286
#define refineSubclass(token, refinedSubclass)
Definition: Token.hpp:51
#define SUBKEY_ENGINEERING
Definition: Token.hpp:210
#define SUBDIRECTIVE_UNPROTECTED
Definition: Token.hpp:289
#define OPERATOR_STRICT_EQUAL
Definition: Token.hpp:128
#define IS_KEYWORD
Definition: Token.hpp:145
#define TERM_WITH
Definition: Token.hpp:64
#define KEYWORD_WHEN
Definition: Token.hpp:183
#define KEYWORD_NUMERIC
Definition: Token.hpp:158
#define TOKEN_COMMA
Definition: Token.hpp:82
#define KEYWORD_ADDRESS
Definition: Token.hpp:146
#define TERM_KEYWORD
Definition: Token.hpp:66
#define SUBDIRECTIVE_TRACE
Definition: Token.hpp:296
#define SUBKEY_FOR
Definition: Token.hpp:212
#define SYMBOL_COMPOUND
Definition: Token.hpp:101
#define SUBDIRECTIVE_FUZZ
Definition: Token.hpp:295
#define KEYWORD_QUEUE
Definition: Token.hpp:164
#define KEYWORD_ARG
Definition: Token.hpp:147
#define KEYWORD_ELSE
Definition: Token.hpp:177
#define KEYWORD_IF
Definition: Token.hpp:152
#define KEYWORD_USE
Definition: Token.hpp:173
#define SYMBOL_STEM
Definition: Token.hpp:102
#define TERM_EOC
Definition: Token.hpp:56
#define SUBDIRECTIVE_DIGITS
Definition: Token.hpp:293
#define SUBDIRECTIVE_NOMACROSPACE
Definition: Token.hpp:300
#define KEYWORD_LABEL
Definition: Token.hpp:187
#define TERM_BY
Definition: Token.hpp:60
#define KEYWORD_FORWARD
Definition: Token.hpp:198
#define DIRECTIVE_ATTRIBUTE
Definition: Token.hpp:269
#define SUBDIRECTIVE_GET
Definition: Token.hpp:290
#define SYMBOL_VARIABLE
Definition: Token.hpp:99
#define SUBDIRECTIVE_ABSTRACT
Definition: Token.hpp:288
#define DIRECTIVE_OPTIONS
Definition: Token.hpp:271
#define SUBDIRECTIVE_CLASS
Definition: Token.hpp:281
#define KEYWORD_GUARD
Definition: Token.hpp:172
#define TOKEN_SQRIGHT
Definition: Token.hpp:91
#define TERM_FOR
Definition: Token.hpp:61
#define TERM_WHILE
Definition: Token.hpp:62
#define SUBDIRECTIVE_PRIVATE
Definition: Token.hpp:279
#define KEYWORD_EXPOSE
Definition: Token.hpp:175
#define SUBKEY_TO
Definition: Token.hpp:229
#define KEYWORD_THEN
Definition: Token.hpp:178
#define KEYWORD_INTERPRET
Definition: Token.hpp:153
#define TOKEN_DTILDE
Definition: Token.hpp:89
#define KEYWORD_RAISE
Definition: Token.hpp:176
#define TOKEN_EOC
Definition: Token.hpp:81
#define KEYWORD_EXIT
Definition: Token.hpp:151
#define TERM_TO
Definition: Token.hpp:59
#define SUBKEY_ARG
Definition: Token.hpp:205
#define KEYWORD_DROP
Definition: Token.hpp:150
#define SUBKEY_WITH
Definition: Token.hpp:237
#define SUBDIRECTIVE_PUBLIC
Definition: Token.hpp:276
#define KEYWORD_FIRST
Definition: Token.hpp:190
#define SUBKEY_PULL
Definition: Token.hpp:225
#define TOKEN_RIGHT
Definition: Token.hpp:85
#define SUBDIRECTIVE_METACLASS
Definition: Token.hpp:277
#define TOKEN_SQLEFT
Definition: Token.hpp:90
#define KEYWORD_TRACE
Definition: Token.hpp:170
#define TOKEN_ASSIGNMENT
Definition: Token.hpp:94
#define KEYWORD_LOOP
Definition: Token.hpp:199
#define KEYWORD_SAY
Definition: Token.hpp:167
#define KEYWORD_ENDWHEN
Definition: Token.hpp:194
#define TOKEN_TILDE
Definition: Token.hpp:88
#define DIRECTIVE_CONSTANT
Definition: Token.hpp:270
#define INTEGER_CONSTANT
Definition: Token.hpp:105
#define TOKEN_SYMBOL
Definition: Token.hpp:78
#define OPERATOR_BLANK
Definition: Token.hpp:119
#define SUBDIRECTIVE_PROTECTED
Definition: Token.hpp:287
#define KEYWORD_END
Definition: Token.hpp:179
#define SYMBOL_DUMMY
Definition: Token.hpp:103
#define TOKEN_SOURCE_LITERAL
Definition: Token.hpp:95
#define CONCURRENCY_TRACE
Definition: Utilities.hpp:50
static RexxObject * getLocalEnvironment(RexxString *name)
static RexxActivity *volatile currentActivity
BaseExecutable * setSourceObject(RexxSource *s)
RexxString * getMetaClass()
void removeDependency(RexxString *name)
bool checkDuplicateMethod(RexxString *name, bool classMethod)
RexxClass * install(RexxSource *source, RexxActivation *activation)
RexxString * getSubClass()
void addConstantMethod(RexxString *name, RexxMethod *method)
RexxString * getName()
void addMethod(RexxString *name, RexxMethod *method, bool classMethod)
bool dependenciesResolved()
void addDependencies(RexxDirectory *class_directives)
void addMethod(RexxString *name, RexxMethod *method, bool classMethod)
bool checkDuplicateMethod(RexxString *name, bool classMethod)
void addConstantMethod(RexxString *name, RexxMethod *method)
void install(RexxSource *source, RexxActivation *activation)
PackageClass * loadRequires(RexxActivity *activity, RexxString *shortName, const char *data, size_t length)
RexxString * resolveProgramName(RexxString *name, RexxString *dir, RexxString *ext)
void install(RexxActivation *context)
static const bool DEFAULT_FORM
Definition: Numerics.hpp:81
static const bool FORM_SCIENTIFIC
Definition: Numerics.hpp:76
static const size_t DEFAULT_FUZZ
Definition: Numerics.hpp:79
static const bool FORM_ENGINEERING
Definition: Numerics.hpp:77
static const size_t DEFAULT_DIGITS
Definition: Numerics.hpp:66
RexxSource * getSourceObject()
static RoutineClass * resolveRoutine(RexxString *function, RexxString *packageName, RexxString *procedure)
static RexxNativeMethod * resolveMethod(RexxString *packageName, RexxString *methodName)
void install(RexxActivation *context)
RexxString * formatSourcelessTraceLine(RexxString *packageName)
static const bool default_enable_macrospace
static size_t processTraceSetting(size_t traceSetting)
static const size_t default_trace_flags
static const bool default_enable_commands
void raiseException(wholenumber_t, RexxString *, RexxArray *, RexxObject *)
RexxString * buildMessage(wholenumber_t, RexxArray *)
InterpreterInstance * getInstance()
void put(RexxObject *eref, size_t pos)
Definition: ArrayClass.cpp:208
size_t size()
Definition: ArrayClass.hpp:202
RexxObject * get(size_t pos)
Definition: ArrayClass.hpp:203
sizeB_t getDataLength()
Definition: BufferClass.hpp:53
virtual char * getData()
void newClause()
Definition: Clause.cpp:130
void setEnd(size_t, sizeB_t)
Definition: Clause.cpp:106
void setStart(size_t, sizeB_t)
Definition: Clause.cpp:96
size_t free
Definition: Clause.hpp:84
SourceLocation clauseLocation
Definition: Clause.hpp:79
RexxArray * tokens
Definition: Clause.hpp:82
const SourceLocation & getLocation()
Definition: Clause.hpp:72
void setLocation(SourceLocation &l)
Definition: Clause.hpp:73
RexxObject * setEntry(RexxString *, RexxObject *)
RexxObject * put(RexxObject *, RexxString *)
RexxObject * fastAt(RexxString *name)
RexxObject * entry(RexxString *)
bool available(HashLink pos)
RexxObject * value(HashLink pos)
HashLink next(HashLink pos)
RexxObject * index(HashLink pos)
virtual RexxObject * put(RexxObject *, RexxObject *)
virtual RexxObject * remove(RexxObject *key)
SourceLocation instructionLocation
const SourceLocation & getLocation()
uint16_t instructionType
void setNext(RexxInstruction *next)
uint16_t instructionFlags
RexxInstruction * nextInstruction
void setBehaviour(RexxBehaviour *b)
RexxObject * removeIndex(size_t i)
Definition: ListClass.hpp:113
RexxObject * append(RexxObject *)
Definition: ListClass.cpp:538
size_t firstIndex()
Definition: ListClass.hpp:84
size_t nextIndex(size_t i)
Definition: ListClass.cpp:804
size_t items()
Definition: ListClass.hpp:97
RexxObject * hasItem(RexxObject *)
Definition: ListClass.cpp:994
RexxObject * removeFirst()
Definition: ListClass.hpp:109
RexxObject * getValue(size_t i)
Definition: ListClass.cpp:276
bool savingImage()
Definition: RexxMemory.hpp:217
RexxDirectory * getGlobalStrings()
Definition: RexxMemory.hpp:285
void setAttributes(bool _private, bool _protected, bool _guarded)
void setUnguarded()
virtual BaseCode * setSourceObject(RexxSource *s)
RexxNumberString * numberString()
bool requestUnsignedNumber(stringsize_t &, size_t)
RexxInteger * requestInteger(size_t)
void sendMessage(RexxString *, RexxArray *, RexxDirectory *, ProtectedObject &)
void push(RexxObject *obj)
Definition: QueueClass.hpp:81
RexxObject * pop()
Definition: QueueClass.hpp:80
void queue(RexxObject *obj)
Definition: QueueClass.hpp:82
size_t copyData(void *, size_t)
RexxBuffer * getBuffer()
RexxInstruction * loopNew()
RexxQueue * subTerms
Definition: SourceFile.hpp:513
RexxStemVariable * addStem(RexxString *)
void createAttributeGetterMethod(RexxString *name, RexxVariableBase *retriever, bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
RexxDirectory * literals
Definition: SourceFile.hpp:508
RexxDirectory * class_dependencies
Definition: SourceFile.hpp:516
void resetPosition(size_t p)
Definition: SourceFile.hpp:318
RexxObject * subExpression(int)
static const size_t TRACE_COMMANDS
Definition: SourceFile.hpp:423
void pushDo(RexxInstruction *i)
Definition: SourceFile.hpp:296
void createConstantGetterMethod(RexxString *name, RexxObject *value)
sizeB_t line_offset
Definition: SourceFile.hpp:468
void install()
PackageClass * loadRequires(RexxActivity *activity, RexxString *target)
static const size_t TRACE_ERRORS
Definition: SourceFile.hpp:427
RexxToken * sourceNextToken(RexxToken *)
Definition: Scanner.cpp:672
RexxList * sourceLiterals
Definition: SourceFile.hpp:509
RexxToken * popOperator()
Definition: SourceFile.hpp:307
static int subDirective(RexxToken *)
RexxInstruction * labelNew()
void decodeExternalMethod(RexxString *methodName, RexxString *externalSpec, RexxString *&library, RexxString *&procedure)
static int keyDirective(RexxToken *)
RexxDirectory * public_routines
Definition: SourceFile.hpp:479
RexxObject * parseLogical(RexxToken *first, int terminators)
RexxCode * translateBlock(RexxDirectory *)
RexxInstruction * forwardNew()
static const size_t TRACE_INTERMEDIATES
Definition: SourceFile.hpp:429
size_t line_adjust
Definition: SourceFile.hpp:469
RexxInstruction * traceNew()
static const size_t TRACE_SETTING_MASK
Definition: SourceFile.hpp:436
RexxObject * collectionMessage(RexxToken *, RexxObject *, int)
void extensionDirective()
RexxInstruction * ifNew(int)
void previousToken()
Definition: SourceFile.hpp:314
RexxString * programDirectory
Definition: SourceFile.hpp:456
void addClause(RexxInstruction *)
PackageClass * package
Definition: SourceFile.hpp:475
RexxQueue * terms
Definition: SourceFile.hpp:512
RexxClause * clause
Definition: SourceFile.hpp:461
static int precedence(RexxToken *)
Definition: Scanner.cpp:53
RexxString * programExtension
Definition: SourceFile.hpp:458
void argList(RexxToken *, int, bool, size_t &, size_t &)
RexxCode * interpret(RexxString *, RexxDirectory *, size_t, RexxActivation *)
RexxMethod * createNativeMethod(RexxString *name, RexxString *library, RexxString *procedure)
void resolveDependencies()
RexxToken * nextToken()
Definition: SourceFile.hpp:312
RexxObject * expression(int)
void setGuard()
bool reconnect()
Definition: SourceFile.cpp:344
RexxInstruction * messageAssignmentNew(RexxExpressionMessage *, RexxObject *)
void checkDuplicateMethod(RexxString *name, bool classMethod, int errorMsg)
void extractNameInformation()
Definition: SourceFile.cpp:318
RexxInstruction * exitNew()
void directive()
RexxString * traceBack(RexxActivation *, SourceLocation &, size_t, bool)
RexxInstruction * findLabel(RexxString *)
RexxInstruction * topDo()
Definition: SourceFile.hpp:298
RexxInstruction * exposeNew()
void flatten(RexxEnvelope *)
Definition: SourceFile.cpp:716
RexxSource * parentSource
Definition: SourceFile.hpp:476
RexxInstruction * instruction()
static int subKeyword(RexxToken *)
RexxObject * fullSubExpression(int)
RexxCode * initCode
Definition: SourceFile.hpp:472
void syntaxError(int errorcode, RexxInstruction *i)
Definition: SourceFile.hpp:319
RexxObject * popNTerms(size_t)
RexxString * resolveProgramName(RexxActivity *activity, RexxString *name)
RexxString * programName
Definition: SourceFile.hpp:455
RexxString * programFile
Definition: SourceFile.hpp:457
RoutineClass * findPublicRoutine(RexxString *)
RexxInstruction * elseNew(RexxToken *)
RexxInstruction * raiseNew()
size_t line_number
Definition: SourceFile.hpp:467
RexxObject * messageSubterm(int)
SourceLocation clauseLocation
Definition: SourceFile.hpp:462
void constantDirective()
RexxInstruction * assignmentNew(RexxToken *)
RexxArray * extractSource()
RexxList * classes
Definition: SourceFile.hpp:482
RexxToken * getToken(int, int)
RexxObject * messageTerm()
RexxObject * subTerm(int)
static const size_t TRACE_LABELS
Definition: SourceFile.hpp:424
RexxInstruction * messageAssignmentOpNew(RexxExpressionMessage *, RexxToken *, RexxObject *)
void addLabel(RexxInstruction *, RexxString *)
size_t flags
Definition: SourceFile.hpp:453
RexxVariableBase * getRetriever(RexxString *)
size_t variableindex
Definition: SourceFile.hpp:532
ExtensionDirective * active_extension
Definition: SourceFile.hpp:518
void pushOperator(RexxToken *operatorToken)
Definition: SourceFile.hpp:306
RexxObject * functionCallMessage(RexxToken *, RexxObject *, int)
void globalSetup()
void libraryDirective(RexxString *name, RexxToken *token)
ClassDirective * active_class
Definition: SourceFile.hpp:517
RexxObject * toss(RexxObject *)
void syntaxErrorAt(int errorcode, RexxToken *token)
Definition: SourceFile.hpp:321
void errorLine(int, RexxInstruction *)
RexxInstruction * signalNew()
RexxObject * parseConditional(int *, int)
RexxInstruction * leaveNew(int)
void createAttributeSetterMethod(RexxString *name, RexxVariableBase *retriever, bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
RexxActivation * interpret_activation
Definition: SourceFile.hpp:470
size_t line_count
Definition: SourceFile.hpp:466
void createAbstractMethod(RexxString *name, bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
RexxInstruction * addressNew()
RexxCompoundVariable * addCompound(RexxString *)
void firstToken()
Definition: SourceFile.hpp:315
RexxInstruction * numericNew()
void addReference(RexxObject *reference)
Definition: SourceFile.hpp:295
SecurityManager * securityManager
Definition: SourceFile.hpp:459
size_t traceFlags
Definition: SourceFile.hpp:496
RexxInstruction * upperNew()
StackFrameClass * createStackFrame()
Definition: SourceFile.cpp:995
bool hasBody()
void pushSubTerm(RexxObject *)
RexxCode * translate(RexxDirectory *)
RexxInstruction * endNew()
RexxCode * generateCode(bool isMethod)
void addInstalledRoutine(RexxString *name, RoutineClass *routineObject, bool publicRoutine)
void routineDirective()
RexxObject * constantLogicalExpression()
void isExposeValid()
void cleanup()
static const size_t DEBUG_ON
Definition: SourceFile.hpp:443
void removeObj(RexxObject *object)
Definition: SourceFile.hpp:377
RexxList * loadedPackages
Definition: SourceFile.hpp:474
RexxDirectory * strings
Definition: SourceFile.hpp:510
RexxList * requires
Definition: SourceFile.hpp:481
RexxInstruction * parseNew(int)
sizeB_t current_length
Definition: SourceFile.hpp:465
void blockSyntaxError(RexxInstruction *i)
Definition: SourceFile.hpp:320
RexxObject * popTerm()
void errorToken(int, RexxToken *)
void argArray(RexxToken *, int, bool, RexxArray *&, RexxArray *&)
void methodDirective()
RexxArray * getGuard()
static RexxString * formatTraceSetting(size_t source)
RexxInstruction * useNew()
RexxInstruction * thenNew(RexxToken *, RexxInstructionIf *)
RexxCode * interpretMethod(RexxDirectory *, RexxActivation *)
RexxToken * topOperator()
Definition: SourceFile.hpp:308
void liveGeneral(int reason)
Definition: SourceFile.cpp:642
RexxInstruction * returnNew()
RexxArray * sourceArray
Definition: SourceFile.hpp:454
RoutineClass * findRoutine(RexxString *)
RexxInstruction * dropNew()
static const size_t TRACE_IGNORE
Definition: SourceFile.hpp:431
RexxQueue * operators
Definition: SourceFile.hpp:515
static const size_t DEBUG_OFF
Definition: SourceFile.hpp:444
void blockError(RexxInstruction *)
RexxInstruction * optionsNew()
void adjustLine(size_t, size_t)
Definition: SourceFile.cpp:365
void expose(RexxString *)
RexxInstruction * messageNew(RexxExpressionMessage *)
RexxInstruction * replyNew()
RexxString * commonString(RexxString *)
RexxInstruction * popDo()
Definition: SourceFile.hpp:297
RexxSource(RexxString *, RexxArray *)
Definition: SourceFile.cpp:113
void addInstalledClass(RexxString *name, RexxClass *classObject, bool publicClass)
void errorCleanup()
RexxQueue * control
Definition: SourceFile.hpp:511
void classDirective()
RexxInstruction * interpretNew()
void initFile()
Definition: SourceFile.cpp:275
RexxInstruction * sourceNewObject(size_t, RexxBehaviour *, int)
RexxString * extract(SourceLocation &, bool=false)
size_t processVariableList(int)
RexxClass * findPublicClass(RexxString *name)
RexxObject * constantExpression()
RexxInstruction * doNew()
PackageClass * getPackage()
void errorPosition(int, SourceLocation)
RexxDirectory * variables
Definition: SourceFile.hpp:525
RexxInstruction * commandNew()
bool atEnd(void)
Definition: SourceFile.hpp:310
size_t sourceSize()
Definition: SourceFile.cpp:783
void error(int)
size_t maxstack
Definition: SourceFile.hpp:531
void pushTerm(RexxObject *)
bool needsInstallation()
Definition: SourceFile.hpp:293
static const size_t TRACE_NORMAL
Definition: SourceFile.hpp:425
void createMethod(RexxString *name, bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
RexxInstruction * nopNew()
void holdObject(RexxObject *object)
Definition: SourceFile.hpp:375
RexxList * libraries
Definition: SourceFile.hpp:480
void addMethod(RexxString *name, RexxMethod *method, bool classMethod)
void live(size_t)
Definition: SourceFile.cpp:589
const char * current
Definition: SourceFile.hpp:460
RexxObject * message(RexxObject *, bool, int)
RexxObject * variableOrMessageTerm()
void optionsDirective()
void mergeRequired(RexxSource *)
bool isInternalCode()
Definition: SourceFile.hpp:328
size_t traceSetting
Definition: SourceFile.hpp:495
RexxDirectory * installed_classes
Definition: SourceFile.hpp:486
void initBuffered(RexxBuffer *)
Definition: SourceFile.cpp:181
RexxInstruction * first
Definition: SourceFile.hpp:522
RexxInstruction * queueNew(int)
RexxInstruction * sayNew()
RexxToken * nextReal()
Definition: SourceFile.hpp:313
void setProgramName(RexxString *name)
Definition: SourceFile.cpp:338
RexxInstruction * assignmentOpNew(RexxToken *, RexxToken *)
RexxObject * popSubTerm()
void saveObject(RexxObject *object)
Definition: SourceFile.hpp:376
void setReconnect()
Definition: SourceFile.cpp:357
RexxVariableBase * addVariable(RexxString *)
static const size_t TRACE_RESULTS
Definition: SourceFile.hpp:428
RexxDirectory * methods
Definition: SourceFile.hpp:490
void needVariableOrDotSymbol(RexxToken *)
Definition: SourceFile.cpp:403
RexxIdentityTable * guard_variables
Definition: SourceFile.hpp:527
bool isTraceable()
Definition: SourceFile.cpp:801
RexxDirectory * installed_public_classes
Definition: SourceFile.hpp:485
void checkDirective(int errorCode)
void processInstall(RexxActivation *)
RexxIdentityTable * savelist
Definition: SourceFile.hpp:506
void inheritSourceContext(RexxSource *source)
RexxInstruction * last
Definition: SourceFile.hpp:523
size_t fuzz
Definition: SourceFile.hpp:493
RexxInstruction * otherwiseNew(RexxToken *)
RexxInstruction * currentInstruction
Definition: SourceFile.hpp:524
void trimClause()
Definition: SourceFile.hpp:316
RexxClass * findInstalledClass(RexxString *name)
size_t currentstack
Definition: SourceFile.hpp:530
void nextClause()
Definition: SourceFile.cpp:909
void flushControl(RexxInstruction *)
RexxObject * function(RexxToken *, RexxToken *, int)
RexxDirectory * merged_public_classes
Definition: SourceFile.hpp:487
static const size_t TRACE_OFF
Definition: SourceFile.hpp:430
RexxBuffer * sourceBuffer
Definition: SourceFile.hpp:463
RexxString * get(size_t)
Definition: SourceFile.cpp:815
RexxDirectory * merged_public_routines
Definition: SourceFile.hpp:489
RexxDirectory * exposed_variables
Definition: SourceFile.hpp:528
RexxInstruction * guardNew()
RexxInstruction * endIfNew(RexxInstructionIf *)
bool enableMacrospace
Definition: SourceFile.hpp:498
RexxObject * parenExpression(RexxToken *)
void attributeDirective()
void position(size_t, sizeB_t)
Definition: SourceFile.cpp:518
RexxQueue * namedSubTerms
Definition: SourceFile.hpp:514
RexxArray * words(RexxString *)
RexxClass * findClass(RexxString *)
RexxStack * holdstack
Definition: SourceFile.hpp:507
static const size_t DEBUG_IGNORE
Definition: SourceFile.hpp:442
void needVariable(RexxToken *)
Definition: SourceFile.cpp:382
RexxObject * addText(RexxToken *)
bool terminator(int, RexxObject *)
static const size_t TRACE_ALL
Definition: SourceFile.hpp:422
RexxList * calls
Definition: SourceFile.hpp:529
static bool parseTraceSetting(RexxString *, size_t &, size_t &, char &)
size_t digits
Definition: SourceFile.hpp:492
void reclaimClause()
Definition: SourceFile.hpp:309
void nextLine()
Definition: SourceFile.cpp:504
void addPackage(PackageClass *package)
RexxList * extensions
Definition: SourceFile.hpp:483
static const size_t DEFAULT_TRACE_SETTING
Definition: SourceFile.hpp:433
static const size_t DEBUG_TOGGLE
Definition: SourceFile.hpp:445
RexxDirectory * labels
Definition: SourceFile.hpp:526
RoutineClass * findLocalRoutine(RexxString *)
bool enableCommands
Definition: SourceFile.hpp:497
void requiresDirective()
RexxInstruction * procedureNew()
size_t markPosition()
Definition: SourceFile.hpp:317
RexxDirectory * routines
Definition: SourceFile.hpp:478
static const size_t TRACE_FAILURES
Definition: SourceFile.hpp:426
RexxInstruction * selectNew()
RexxInstruction * callNew()
RexxBuffer * sourceIndices
Definition: SourceFile.hpp:464
RexxString * stringValue()
RexxString * extractB(sizeB_t offset, sizeB_t sublength)
const char * getStringData()
void setNumberString(RexxObject *)
RexxString * word(RexxInteger *)
char getCharB(sizeB_t p)
RexxString * concatWithCstring(const char *)
RexxString * concat(RexxString *)
void set(sizeB_t s, int c, sizeB_t l)
RexxString * concatToCstring(const char *)
void put(sizeB_t s, const void *b, sizeB_t l)
codepoint_t getCharC(sizeC_t p)
RexxString * upper()
sizeB_t getBLength()
int numeric
Definition: Token.hpp:450
RexxString * value
Definition: Token.hpp:447
SourceLocation tokenLocation
Definition: Token.hpp:446
static const char * keywordText(int code)
Definition: Token.cpp:236
static const char * codeText(int code)
Definition: Token.cpp:128
const SourceLocation & getLocation()
Definition: Token.hpp:442
bool isSymbol()
Definition: Token.hpp:438
bool isSymbolOrLiteral()
Definition: Token.hpp:436
bool isType(TokenClass t)
Definition: Token.hpp:429
bool isVariable()
Definition: Token.hpp:433
bool isOperator()
Definition: Token.hpp:439
bool isSourceLiteral()
Definition: Token.hpp:435
bool isLiteral()
Definition: Token.hpp:434
bool isConstant()
Definition: Token.hpp:437
bool isEndOfClause()
Definition: Token.hpp:440
int classId
Definition: Token.hpp:448
int subclass
Definition: Token.hpp:449
static RexxObject * buildCompoundVariable(RexxString *variable_name, bool direct)
void call(RexxActivity *, RexxString *, RexxObject **, size_t, size_t, RexxString *, RexxString *, int, ProtectedObject &)
RexxObject * checkEnvironmentAccess(RexxString *index)
RexxObject * checkLocalAccess(RexxString *index)
sizeB_t getOffset() const
size_t getEndLine() const
void setOffset(sizeB_t l)
size_t getLineNumber() const
void setEnd(SourceLocation &l)
void setEndOffset(sizeB_t l)
void setEndLine(size_t l)
sizeB_t getEndOffset() const
void setLineNumber(size_t l)
bool isLimitedTrace() const
void setLimitedTrace(bool b)
static RexxString * extractFile(RexxString *file)
static RexxString * extractDirectory(RexxString *file)
static RexxString * extractExtension(RexxString *file)
static RexxBuffer * readProgram(const char *file_name)
static wholenumber_t currentThreadId()
static bool traceConcurrency()
static bool traceParsing()
static int strCaselessCompare(const char *opt1, const char *opt2)
Definition: Utilities.cpp:82
static const char * locateCharacter(const char *s, const char *set, sizeB_t l)
Definition: Utilities.cpp:52
int type
Definition: cmdparse.cpp:383
#define sizeB_v(X)
Definition: rexx.h:250
#define size_v(X)
Definition: rexx.h:237
stringsizeB_t sizeB_t
Definition: rexx.h:248
void dbgprintf(const char *format,...)
char line[LINEBUFSIZE]