ooRexx  4.2.0-source
About: ooRexx (Open Object Rexx) is a free implementation of Object Rexx. Object Rexx is an enhancement of the classic Rexx interpreter; a full-featured programming language with a human-oriented syntax.
  Fossies Dox: ooRexx-4.2.0-source.tar.gz  ("inofficial" and yet experimental doxygen-generated source code documentation)  

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 
65 #include "ExpressionBaseVariable.hpp" /* base variable management class */
68 #include "ExpressionVariable.hpp"
70 #include "ExpressionStem.hpp"
71 
72 #include "RexxInstruction.hpp" /* base instruction definition */
73 #include "SelectInstruction.hpp"
74 #include "ElseInstruction.hpp"
75 #include "EndIf.hpp"
76 #include "DoInstruction.hpp"
77 #include "CallInstruction.hpp"
78 #include "ProtectedObject.hpp"
79 #include "CPPCode.hpp"
80 #include "SystemInterpreter.hpp"
81 #include "PackageClass.hpp"
82 #include "InterpreterInstance.hpp"
83 #include "ClassDirective.hpp"
84 #include "LibraryDirective.hpp"
85 #include "RequiresDirective.hpp"
86 #include "PackageManager.hpp"
87 #include "SysFileSystem.hpp"
88 #include "RoutineClass.hpp"
89 #include "ActivationFrame.hpp"
90 #include "StackFrameClass.hpp"
91 
92 #define HOLDSIZE 60 /* room for 60 temporaries */
93 
94 typedef struct _LINE_DESCRIPTOR {
95  size_t position; /* position within the buffer */
96  size_t length; /* length of the line */
97 } LINE_DESCRIPTOR; /* line within a source buffer */
98 
99 #define line_delimiters "\r\n" /* stream file line end characters */
100 #define ctrl_z 0x1a // the end of file marker
101 
110 RexxSource::RexxSource(RexxString *programname, RexxArray *source_array)
111 {
112  /* fill in the name */
113  setProgramName(programname);
114  /* fill in the source array */
115  OrefSet(this, this->sourceArray, source_array);
116  /* fill in the source size */
117  this->line_count = sourceArray->size();
118  this->position(1, 0); /* set position at the first line */
119 }
120 
121 
130 RexxSource::RexxSource(RexxString *programname, RexxBuffer *source_buffer)
131 {
132  /* fill in the name */
133  setProgramName(programname);
134  // we require a bit of protection while doing this
135  ProtectedObject p(this);
136  // initialize from the buffer data
137  initBuffered(source_buffer);
138 }
139 
140 
150 RexxSource::RexxSource(RexxString *programname, const char *data, size_t length)
151 {
152  /* fill in the name */
153  setProgramName(programname);
154  // we require a bit of protection while doing this
155  ProtectedObject p(this);
156  // initialize from the buffer data
157  initBuffered(new_buffer(data, length));
158 }
159 
160 
168 {
169  /* fill in the name */
170  setProgramName(programname);
171  // we require a bit of protection while doing this
172  ProtectedObject p(this);
173  // read the file data and initialize.
174  initFile();
175 }
176 
177 
179  RexxBuffer *source_buffer) /* containing source buffer */
180 /******************************************************************************/
181 /* Function: Initialize a source object using the entire source as a */
182 /* stream buffer */
183 /******************************************************************************/
184 {
185  LINE_DESCRIPTOR descriptor; /* line description */
186  const char *scan; /* line scanning pointer */
187  const char *_current; /* current scan location */
188  char *start; /* start of the buffer */
189  size_t length; /* length of the buffer */
190 
191  extractNameInformation(); // make sure we have name information to work with
192  /* set the source buffer */
193  OrefSet(this, this->sourceBuffer, source_buffer);
194  RexxSmartBuffer *indices = new RexxSmartBuffer(1024);
195  ProtectedObject p(indices);
196  /* point to the data part */
197  start = this->sourceBuffer->getData();
198  /* get the buffer length */
199  length = this->sourceBuffer->getDataLength();
200 
201  // neutralize shell '#!...'
202  if (start[0] == '#' && start[1] == '!')
203  {
204  memcpy(start, "--", 2);
205  }
206 
207  descriptor.position = 0; /* fill in the "zeroth" position */
208  descriptor.length = 0; /* and the length */
209  /* add to the line list */
210  indices->copyData(&descriptor, sizeof(descriptor));
211  this->line_count = 0; /* start with zero lines */
212  /* look for an EOF mark */
213  scan = (const char *)memchr(start, ctrl_z, length);
214  if (scan != NULL) /* found one? */
215  {
216  length = scan - start; /* reduce the length */
217  }
218  _current = start; /* start at the beginning */
219  while (length != 0)
220  { /* loop until all done */
221  this->line_count++; /* add in another line */
222  /* set the start position */
223  descriptor.position = _current - start;
224  /* scan for a important character */
225  scan = Utilities::locateCharacter(_current, line_delimiters, length);
226  /* need to skip over null chars */
227  while (scan != OREF_NULL && *scan == '\0')
228  {
229  /* scan for a linend */
230  scan = Utilities::locateCharacter(scan + 1, line_delimiters, length - (scan - _current - 1));
231  }
232  if (scan == NULL)
233  { /* not found, go to the end */
234  _current = _current + length; /* step to the end */
235  descriptor.length = length; /* use the entire line */
236  length = 0; /* nothing left to process */
237  }
238  else
239  {
240  /* calculate this line length */
241  descriptor.length = scan - _current;
242  /* adjust scan at line end */
243  if (*scan == line_delimiters[0])
244  {/* CR encountered */
245  scan++; /* step the scan position */
246  /* now check for LF */
247  if (length > (size_t)(scan - _current))
248  {
249  if (*scan != '\0' && *scan == line_delimiters[1]) /* */
250  {
251  scan++; /* step again, if required */
252  }
253  }
254  }
255  else /* just a LF */
256  {
257  scan++; /* step the scan position */
258  }
259 
260  length -= scan - _current; /* reduce the length */
261  _current = scan; /* copy the scan pointer */
262  }
263  /* add to the line list */
264  indices->copyData(&descriptor, sizeof(descriptor));
265  }
266  /* throw away the buffer "wrapper" */
267  OrefSet(this, this->sourceIndices, indices->getBuffer());
268  this->position(1, 0); /* set position at the first line */
269 }
270 
271 
273 /******************************************************************************/
274 /* Function: Initialize a source object, reading the source from a file */
275 /******************************************************************************/
276 {
277  /* load the program file */
279  if (program_source == OREF_NULL) /* Program not found or read error? */
280  {
281  /* report this */
283  }
284 
285 #ifdef SCRIPTING
286  if (program_source->getDataLength() > 9)
287  {
288  char begin[10];
289  char end[4];
290  // check, if XML comments have to be removed from the script... (engine situation)
291  memcpy(begin,program_source->getData(), 9);
292  // hashvalue is the length of the buffer
293  memcpy(end, program_source->getData()+ (program_source->getDataLength()-3), 3);
294  begin[9]=end[3]=0x00;
295  if (!Utilities::strCaselessCompare("<![CDATA[",begin) && !Utilities::strCaselessCompare("]]>",end))
296  {
297  memcpy(program_source->getData(), " ", 9);
298  memcpy(program_source->getData() + (program_source->getDataLength() - 3), " ", 3);
299  }
300  }
301 #endif
302 
303  /* save the returned buffer */
304  OrefSet(this, this->sourceBuffer, program_source);
305  /* go process the buffer now */
306  this->initBuffered(this->sourceBuffer);
307 }
308 
309 
316 {
317  if (programName == OREF_NULL)
318  {
319  return;
320  }
321 
325 }
326 
327 
336 {
337  OrefSet(this, this->programName, name);
339 }
340 
342 /******************************************************************************/
343 /* Function: Attempt to reconnect to the original source code file */
344 /******************************************************************************/
345 {
346  if (!(this->flags&reclaim_possible)) /* no chance of getting this? */
347  {
348  return false; /* just get out of here */
349  }
350  this->initFile(); /* go reinit this */
351  return true; /* give back the success return */
352 }
353 
355 /******************************************************************************/
356 /* Function: Allow a source reconnect to occur */
357 /******************************************************************************/
358 {
359  this->flags |= reclaim_possible; /* we have a shot at this! */
360 }
361 
362 void RexxSource::interpretLine(size_t _line_number)
363 /******************************************************************************/
364 /* Arguments: interpret line location */
365 /* */
366 /* Function: Adjust the source object so that it thinks it is scanning a */
367 /* 1-line source file with a line number other than 1 so that */
368 /* errors and trace of an interpreted instruction will display */
369 /* the interpret instructions line number. */
370 /******************************************************************************/
371 {
372  /* fill in the source size */
373  this->line_count = _line_number; /* size is now the line number */
374  this->line_number = _line_number; /* we are now on line "nn of nn" */
375  /* remember for positioning */
376  this->interpret_adjust = _line_number - 1;
377 }
378 
380  RexxToken *token) /* current token */
381 /******************************************************************************/
382 /* Function: validate that the current token is a variable token */
383 /******************************************************************************/
384 {
385  /* not a variable token? */
386  if (!token->isVariable())
387  {
388  /* begin with a dot? */
389  if (token->value->getChar(0) == '.')
390  {
392  }
393  else
394  {
396  }
397  }
398 }
399 
401  RexxToken *token) /* current token */
402 /******************************************************************************/
403 /* Function: validate that the current token is a variable token */
404 /******************************************************************************/
405 {
406  /* not a variable token or dot symbol*/
407  if (!token->isVariable() && (token->subclass != SYMBOL_DOTSYMBOL)) {
409  }
410 }
411 
413  int terminators, /* set of possible terminators */
414  RexxToken *token) /* token being processed */
415 /******************************************************************************/
416 /* Function: test for a terminator token in the given context */
417 /******************************************************************************/
418 {
419  bool endtoken; /* found the end flag */
420 
421  endtoken = false; /* not found the end yet */
422 
423  /* process based on terminator class */
424  switch (token->classId)
425  {
426 
427  case TOKEN_EOC: /* found the end-of-clause */
428  endtoken = true; /* this is always an end marker */
429  break;
430 
431  case TOKEN_RIGHT: /* found a right paren */
432  if (terminators&TERM_RIGHT) /* terminate on this? */
433  endtoken = true; /* set the flag */
434  break;
435 
436  case TOKEN_SQRIGHT: /* found a right square bracket */
437  if (terminators&TERM_SQRIGHT) /* terminate on this? */
438  endtoken = true; /* set the flag */
439  break;
440 
441  case TOKEN_COMMA: /* found a comma */
442  if (terminators&TERM_COMMA) /* terminate on this? */
443  endtoken = true; /* set the flag */
444  break;
445 
446  case TOKEN_SYMBOL: /* have a symbol, need to resolve */
447  if (terminators&TERM_KEYWORD)
448  { /* need to do keyword checks? */
449  /* process based on the keyword */
450  switch (this->subKeyword(token))
451  {
452 
453  case SUBKEY_TO: /* TO subkeyword */
454  if (terminators&TERM_TO) /* terminate on this? */
455  endtoken = true; /* set the flag */
456  break;
457 
458  case SUBKEY_BY: /* BY subkeyword */
459  if (terminators&TERM_BY) /* terminate on this? */
460  endtoken = true; /* set the flag */
461  break;
462 
463  case SUBKEY_FOR: /* FOR subkeyword */
464  if (terminators&TERM_FOR) /* terminate on this? */
465  {
466  endtoken = true; /* set the flag */
467  }
468  break;
469 
470  case SUBKEY_WHILE: /* WHILE subkeyword */
471  case SUBKEY_UNTIL: /* UNTIL subkeyword */
472  if (terminators&TERM_WHILE)/* terminate on this? */
473  endtoken = true; /* set the flag */
474  break;
475 
476  case SUBKEY_WITH: /* WITH subkeyword */
477  if (terminators&TERM_WITH) /* terminate on this? */
478  endtoken = true; /* set the flag */
479  break;
480 
481  case SUBKEY_THEN: /* THEN subkeyword */
482  if (terminators&TERM_THEN) /* terminate on this? */
483  endtoken = true; /* set the flag */
484  break;
485 
486  default: /* not a terminator for others */
487  break;
488  }
489  }
490  default: /* not a terminator for others */
491  break;
492  }
493  if (endtoken) /* found the end one? */
494  {
495  previousToken(); /* push it back on the clause */
496  }
497  return endtoken; /* return the true/false flag */
498 }
499 
501 /******************************************************************************/
502 /* Function: Advance the current position to the next source line */
503 /******************************************************************************/
504 {
505  if (this->clause) /* have a clause object? */
506  {
507  /* record current position in clause */
508  this->clause->setEnd(this->line_number, this->line_offset);
509  }
510  /* move to the start of the next line*/
511  this->position(this->line_number + 1, 0);
512 }
513 
515  size_t line, /* target line number */
516  size_t offset) /* target line offset */
517 /******************************************************************************/
518 /* Function: Move the current scan position to a new spot */
519 /******************************************************************************/
520 {
521  LINE_DESCRIPTOR *descriptors; /* line descriptors */
522  const char *buffer_start; /* start of source buffer */
523  RexxString *new_line; /* new line to scan */
524 
525  this->line_number = line; /* set the line number */
526  this->line_offset = offset; /* and the offset */
527  /* past the end? */
528  if (line > this->line_count)
529  {
530  this->current = OREF_NULL; /* null out the current line */
531  this->current_length = 0; /* tag this as a null line */
532  }
533  else
534  {
535  /* working from an array? */
536  if (this->sourceArray != OREF_NULL)
537  {
538  /* get the next line */
539  new_line = (RexxString *)(this->sourceArray->get(line - this->interpret_adjust));
540  if (new_line == OREF_NULL) /* missing line? */
541  {
542  /* this is an error */
544  }
545  /* not working with a string? */
546  if (!isOfClass(String, new_line))
547  {
548  /* get this as a string */
549  new_line = (RexxString *)new_line->stringValue();
550  if (new_line == TheNilObject) /* got back .nil? */
551  {
552  /* this is an error */
554  }
555  }
556  /* set the program pointer */
557  this->current = new_line->getStringData();
558  /* get the string length */
559  this->current_length = new_line->getLength();
560  }
561  /* single buffer source */
562  else
563  {
564  /* get the descriptors pointer */
565  descriptors = (LINE_DESCRIPTOR *)(this->sourceIndices->getData());
566  /* source buffered in a string? */
567  if (isOfClass(String, this->sourceBuffer))
568  {
569  /* point to the data part */
570  buffer_start = ((RexxString *)(this->sourceBuffer))->getStringData();
571  }
572  else
573  {
574  /* point to the data part */
575  buffer_start = this->sourceBuffer->getData();
576  }
577  /* calculate the line start */
578  this->current = buffer_start + descriptors[line - this->interpret_adjust].position;
579  /* and get the length */
580  this->current_length = descriptors[line - this->interpret_adjust].length;
581  }
582  }
583 }
584 
585 void RexxSource::live(size_t liveMark)
586 /******************************************************************************/
587 /* Perform garbage collection marking of a source object */
588 /******************************************************************************/
589 {
590  memory_mark(this->parentSource);
591  memory_mark(this->sourceArray);
592  memory_mark(this->programName);
595  memory_mark(this->programFile);
596  memory_mark(this->clause);
598  memory_mark(this->sourceBuffer);
599  memory_mark(this->sourceIndices);
600  memory_mark(this->first);
601  memory_mark(this->last);
603  memory_mark(this->savelist);
604  memory_mark(this->holdstack);
605  memory_mark(this->variables);
606  memory_mark(this->literals);
607  memory_mark(this->labels);
608  memory_mark(this->strings);
611  memory_mark(this->control);
612  memory_mark(this->terms);
613  memory_mark(this->subTerms);
614  memory_mark(this->operators);
615  memory_mark(this->calls);
616  memory_mark(this->routines);
619  memory_mark(this->requires);
620  memory_mark(this->libraries);
622  memory_mark(this->package);
623  memory_mark(this->classes);
628  memory_mark(this->methods);
629  memory_mark(this->active_class);
630  memory_mark(this->initCode);
631 }
632 
633 void RexxSource::liveGeneral(int reason)
634 /******************************************************************************/
635 /* Function: Perform generalized marking of a source object */
636 /******************************************************************************/
637 {
638 #ifndef KEEPSOURCE
639  if (memoryObject.savingImage()) { /* save image time? */
640  /* don't save the source image */
641  OrefSet(this, this->sourceArray, OREF_NULL);
642  OrefSet(this, this->sourceBuffer, OREF_NULL);
643  OrefSet(this, this->sourceIndices, OREF_NULL);
644  OrefSet(this, this->clause, OREF_NULL);
645  /* don't save the install information*/
646  OrefSet(this, this->methods, OREF_NULL);
647  OrefSet(this, this->requires, OREF_NULL);
648  OrefSet(this, this->classes, OREF_NULL);
649  OrefSet(this, this->routines, OREF_NULL);
650  OrefSet(this, this->libraries, OREF_NULL);
651  OrefSet(this, this->installed_classes, OREF_NULL);
655  this->flags &= ~reclaim_possible; /* can't recover source immediately */
656  }
657 #endif
668  memory_mark_general(this->first);
670  memory_mark_general(this->last);
680  memory_mark_general(this->terms);
683  memory_mark_general(this->calls);
699 }
700 
702 /******************************************************************************/
703 /* Function: Flatten a source object */
704 /******************************************************************************/
705 {
706 
708  /* if we are flattening for EA's, we */
709  /* don't need to to keep source info */
710  /* so ask the envelope if this is a */
711  /* flatten to save the method image */
712  this->sourceArray = OREF_NULL;
713  this->sourceBuffer = OREF_NULL;
714  this->sourceIndices = OREF_NULL;
715  this->securityManager = OREF_NULL;
716  flatten_reference(newThis->sourceArray, envelope);
717  flatten_reference(newThis->parentSource, envelope);
718  flatten_reference(newThis->programName, envelope);
719  flatten_reference(newThis->programDirectory, envelope);
720  flatten_reference(newThis->programExtension, envelope);
721  flatten_reference(newThis->programFile, envelope);
722  flatten_reference(newThis->clause, envelope);
723  flatten_reference(newThis->securityManager, envelope);
724  flatten_reference(newThis->sourceBuffer, envelope);
725  flatten_reference(newThis->sourceIndices, envelope);
726  flatten_reference(newThis->first, envelope);
727  flatten_reference(newThis->last, envelope);
728  flatten_reference(newThis->currentInstruction, envelope);
729  flatten_reference(newThis->savelist, envelope);
730  flatten_reference(newThis->holdstack, envelope);
731  flatten_reference(newThis->variables, envelope);
732  flatten_reference(newThis->literals, envelope);
733  flatten_reference(newThis->labels, envelope);
734  flatten_reference(newThis->strings, envelope);
735  flatten_reference(newThis->guard_variables, envelope);
736  flatten_reference(newThis->exposed_variables, envelope);
737  flatten_reference(newThis->control, envelope);
738  flatten_reference(newThis->terms, envelope);
739  flatten_reference(newThis->subTerms, envelope);
740  flatten_reference(newThis->operators, envelope);
741  flatten_reference(newThis->calls, envelope);
742  flatten_reference(newThis->routines, envelope);
743  flatten_reference(newThis->public_routines, envelope);
744  flatten_reference(newThis->class_dependencies, envelope);
745  flatten_reference(newThis->requires, envelope);
746  flatten_reference(newThis->libraries, envelope);
747  flatten_reference(newThis->loadedPackages, envelope);
748  flatten_reference(newThis->package, envelope);
749  flatten_reference(newThis->classes, envelope);
750  flatten_reference(newThis->installed_public_classes, envelope);
751  flatten_reference(newThis->installed_classes, envelope);
752  flatten_reference(newThis->merged_public_classes, envelope);
753  flatten_reference(newThis->merged_public_routines, envelope);
754  flatten_reference(newThis->methods, envelope);
755  flatten_reference(newThis->active_class, envelope);
756  flatten_reference(newThis->initCode, envelope);
757 
759 }
760 
761 
763 /******************************************************************************/
764 /* Function: Return count of lines in the source. If the source is not */
765 /* available, return 0 */
766 /******************************************************************************/
767 {
768  /* currently no source? */
769  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
770  {
771  if (!this->reconnect()) /* unable to recover the source? */
772  {
773  return 0; /* we have no source lines */
774  }
775  }
776  return this->line_count; /* return the line count */
777 }
778 
779 
781 /******************************************************************************/
782 /* Function: Determine if a program is traceable (i.e., the program source */
783 /* is available) */
784 /******************************************************************************/
785 {
786  /* currently no source? */
787  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
788  {
789  return this->reconnect(); /* unable to recover the source? */
790  }
791  return true; /* return the line count */
792 }
793 
795  size_t _position) /* requested source line */
796 /******************************************************************************/
797 /* Function: Extract a give source line from the source program */
798 /******************************************************************************/
799 {
800  LINE_DESCRIPTOR *descriptors; /* line descriptors */
801  const char *buffer_start; /* start of source buffer */
802 
803  if (_position > this->line_count) /* beyond last line? */
804  {
805  return OREF_NULLSTRING; /* just return a null string */
806  }
807  /* working from an array? */
808  if (this->sourceArray != OREF_NULL)
809  {
810  /* return the array line */
811  return(RexxString *)(this->sourceArray->get(_position));
812  }
813  /* buffered version? */
814  else if (this->sourceBuffer != OREF_NULL)
815  {
816  /* get the descriptors pointer */
817  descriptors = (LINE_DESCRIPTOR *)(this->sourceIndices->getData());
818  /* source buffered in a string? */
819  if (isOfClass(String, this->sourceBuffer))
820  {
821  /* point to the data part */
822  buffer_start = ((RexxString *)(this->sourceBuffer))->getStringData();
823  }
824  else
825  {
826  /* point to the data part */
827  buffer_start = this->sourceBuffer->getData();
828  }
829  /* create a new string version */
830  return new_string(buffer_start + descriptors[_position].position, descriptors[_position].length);
831  }
832  else
833  {
834  return OREF_NULLSTRING; /* we have no line */
835  }
836 }
837 
839 /*********************************************************************/
840 /* Extract a clause from the source and return as a clause object. */
841 /* The clause object contains a list of all of the tokens contained */
842 /* within the clause and is used by the parser to determine the */
843 /* type of instruction and create the instruction parse tree. */
844 /*********************************************************************/
845 {
846  RexxToken *token; /* current token being processed */
847  SourceLocation location; /* location of the clause */
848  SourceLocation token_location; /* location of each token */
849 
850  /* need to scan off a clause? */
851  if (!(this->flags&reclaimed))
852  {
853  this->clause->newClause(); /* reset the clause object */
854  /* loop until we get an non-null */
855  for (;;)
856  {
857  /* record the start position */
858  this->clause->setStart(this->line_number, this->line_offset);
859  /* get the next source token */
860  /* (blanks are not significant here) */
861  token = this->sourceNextToken(OREF_NULL);
862  /* hit the end of the file? */
863  if (token == OREF_NULL)
864  {
865  this->flags |= no_clause; /* flag this as a no clause */
866  return; /* we're finished */
867  }
868  /* is this the end of the clause? */
869  if (!token->isEndOfClause())
870  {
871  break; /* we've got what we need */
872  }
873  this->clause->newClause(); /* reset the clause object */
874  }
875  /* get the start position */
876  token_location = token->getLocation();
877  location = token_location; /* copy the location info */
878  /* record in clause for errors */
879  this->clause->setLocation(location);
880  /* loop until physical end of clause */
881  for (;;)
882  {
883  /* get the next token of real clause */
884  /* (blanks can be significant) */
885  token = this->sourceNextToken(token);
886  /* get this tokens location */
887  token_location = token->getLocation();
888  if (token->isEndOfClause()) /* end of the clause now? */
889  {
890  break; /* hit the physical end of clause */
891  }
892  }
893  location.setEnd(token_location);
894  /* record the clause position */
895  this->clause->setLocation(location);
896  }
897  this->flags &= ~reclaimed; /* no reclaimed clause */
898  // always set the error information
900 }
901  /* extra space required to format a */
902  /* result line. This overhead is */
903  /* 8 leading spaces for the line */
904  /* number, + 1 space + length of the */
905  /* message prefix (3) + 1 space + */
906  /* 2 for an indent + 2 for the */
907  /* quotes surrounding the value */
908 #define TRACE_OVERHEAD 16
909  /* overhead for a traced instruction */
910  /* (8 digit line number, blank, */
911  /* 3 character prefix, and a blank */
912 #define INSTRUCTION_OVERHEAD 11
913 #define LINENUMBER 6 /* size of a line number */
914 #define PREFIX_OFFSET (LINENUMBER + 1) /* location of the prefix field */
915 #define PREFIX_LENGTH 3 /* length of the prefix flag */
916 #define INDENT_SPACING 2 /* spaces per indentation amount */
917 
918 
925 {
926  // construct the traceback line before we allocate the stack frame object.
927  // calling this in the constructor argument list can cause the stack frame instance
928  // to be inadvertently reclaimed if a GC is triggered while evaluating the constructor
929  // arguments.
930  RexxString *traceback = traceBack(OREF_NULL, clauseLocation, 0, true);
932 }
933 
934 
947  size_t indent, bool trace)
948 {
949  RexxString *buffer; /* buffer for building result */
950  RexxString *line; /* actual line data */
951  size_t outlength; /* output length */
952  char *linepointer; /* pointer to the line number */
953  char linenumber[11]; /* formatted line number */
954 
955  /* format the value */
956  sprintf(linenumber,"%u", location.getLineNumber());
957 
958  line = this->extract(location); /* extract the source string */
959  /* doesn't exist and this isn't a */
960  /* trace instruction format? */
961  if (line == OREF_NULLSTRING)
962  {
963  // old space code means this is part of the interpreter image. Don't include
964  // the package name in the message
965  if (this->isOldSpace())
966  {
968  }
969  // if we have an activation (and we should, since the only time we won't would be for a
970  // translation time error...and we have source then), ask it to provide a line describing
971  // the invocation situation
972  if (activation != OREF_NULL)
973  {
974  line = activation->formatSourcelessTraceLine(isInternalCode() ? OREF_REXX : this->programName);
975  }
976  // this could be part of the internal code...give a generic message that doesn't identify
977  // the actual package.
978  else if (this->isInternalCode())
979  {
981  }
982  else
983  {
984  // generic package message.
985  RexxArray *args = new_array(this->programName);
986  ProtectedObject p(args);
988  }
989  }
990 
991  if (indent < 0) /* possible negative indentation? */
992  {
993  indent = 0; /* just reset it */
994  }
995  /* get an output string */
996  buffer = raw_string(line->getLength() + INSTRUCTION_OVERHEAD + indent * INDENT_SPACING);
997  /* blank out the first part */
998  buffer->set(0, ' ', INSTRUCTION_OVERHEAD + indent * INDENT_SPACING);
999  /* copy in the line */
1000  buffer->put(INSTRUCTION_OVERHEAD + indent * INDENT_SPACING, line->getStringData(), line->getLength());
1001  outlength = strlen(linenumber); /* get the line number length */
1002  linepointer = linenumber; /* point to number start */
1003  /* too long for defined field? */
1004  if (outlength > LINENUMBER)
1005  {
1006  /* step over extra numbers */
1007  linepointer += outlength - LINENUMBER;
1008  *linepointer = '?'; /* overlay a question mark */
1009  outlength = LINENUMBER; /* shorten the length */
1010  }
1011  /* copy in the line number */
1012  buffer->put(LINENUMBER - outlength, linepointer, outlength);
1013  buffer->put(PREFIX_OFFSET, "*-*", PREFIX_LENGTH);
1014  return buffer; /* return formatted buffer */
1015 }
1016 
1018  SourceLocation &location ) /* target retrieval structure */
1019 /******************************************************************************/
1020 /* Extrace a line from the source using the given location information */
1021 /******************************************************************************/
1022 {
1023  RexxString *line; /* returned source line */
1024  RexxString *source_line; /* current extracting line */
1025  size_t counter; /* line counter */
1026 
1027  /* currently no source? */
1028  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
1029  {
1030  if (!this->reconnect()) /* unable to recover the source? */
1031  return OREF_NULLSTRING; /* return a null array */
1032  }
1033  /* is the location out of bounds? */
1034  if (location.getLineNumber() == 0 || location.getLineNumber() > this->line_count)
1035  line = OREF_NULLSTRING; /* just give back a null string */
1036  /* all on one line? */
1037  else if (location.getLineNumber() >= location.getEndLine())
1038  /* just extract the string */
1039  line = this->get(location.getLineNumber() - this->interpret_adjust)->extract(location.getOffset(),
1040  location.getEndOffset() - location.getOffset());
1041  /* multiple line clause */
1042  else
1043  {
1044  /* get the source line */
1045  source_line = this->get(location.getLineNumber());
1046  /* extract the first part */
1047  line = source_line->extract(location.getOffset(), source_line->getLength() - location.getOffset());
1048  /* loop down to end line */
1049  for (counter = location.getLineNumber() + 1 - this->interpret_adjust; counter < location.getEndLine(); counter++)
1050  {
1051  /* concatenate the next line on */
1052  line = line->concat(this->get(counter));
1053  }
1054  /* now add on the last part */
1055  line = line->concat(this->get(counter)->extract(0, location.getEndOffset()));
1056  }
1057  return line; /* return the extracted line */
1058 }
1059 
1060 
1067 {
1068  SourceLocation location;
1069 
1070  location.setLineNumber(1);
1071  location.setEndLine(0);
1072  location.setOffset(0);
1073 
1074  return extractSource(location);
1075 }
1076 
1077 
1078 
1080  SourceLocation &location ) /* target retrieval structure */
1081 /******************************************************************************/
1082 /* Function: Extract a section of source from a method source object, using */
1083 /* the created bounds for the method. */
1084 /******************************************************************************/
1085 {
1086  /* currently no source? */
1087  if ((this->sourceArray == OREF_NULL && this->sourceBuffer == OREF_NULL))
1088  {
1089  if (!this->reconnect()) /* unable to recover the source? */
1090  {
1091  /* return a null array */
1092  return(RexxArray *)TheNullArray->copy();
1093  }
1094  }
1095  /* is the location out of bounds? */
1096  if (location.getLineNumber() == 0 || location.getLineNumber() - this->interpret_adjust > this->line_count)
1097  {
1098  /* just give back a null array */
1099  return (RexxArray *)TheNullArray->copy();
1100  }
1101  else
1102  {
1103  if (location.getEndLine() == 0)
1104  { /* no ending line? */
1105  /* use the last line */
1106  location.setEnd(this->line_count, this->get(line_count)->getLength());
1107  }
1108  /* end at the line start? */
1109  else if (location.getEndOffset() == 0)
1110  {
1111  // step back a line
1112  location.setEndLine(location.getEndLine() - 1); /* step back a line */
1113  /* end at the line end */
1114  location.setEndOffset(this->get(location.getEndLine())->getLength());
1115  }
1116  /* get the result array */
1117  RexxArray *source = new_array(location.getEndLine() - location.getLineNumber() + 1);
1118  ProtectedObject p(source);
1119  /* all on one line? */
1120  if (location.getLineNumber() == location.getEndLine())
1121  {
1122  /* get the line */
1123  RexxString *source_line = this->get(location.getLineNumber());
1124  /* extract the line segment */
1125  source_line = source_line->extract(location.getOffset(), location.getEndOffset() - location.getOffset());
1126  source->put(source_line, 1); /* insert the trailing piece */
1127  return source; /* all done */
1128  }
1129  if (location.getOffset() == 0) /* start on the first location? */
1130  {
1131  /* copy over the entire line */
1132  source->put(this->get(location.getLineNumber()), 1);
1133  }
1134  else
1135  {
1136  /* get the line */
1137  RexxString *source_line = this->get(location.getLineNumber());
1138  /* extract the end portion */
1139  source_line = source_line->extract(location.getOffset(), source_line->getLength() - location.getOffset());
1140  source->put(source_line, 1); /* insert the trailing piece */
1141  }
1142 
1143  size_t i = 2;
1144  /* loop until the last line */
1145  for (size_t counter = location.getLineNumber() + 1; counter < location.getEndLine(); counter++, i++)
1146  {
1147  /* copy over the entire line */
1148  source->put(this->get(counter), i);
1149  }
1150  /* get the last line */
1151  RexxString *source_line = this->get(location.getEndLine());
1152  /* more than one line? */
1153  if (location.getEndLine() > location.getLineNumber())
1154  {
1155  /* need the entire line? */
1156  if (location.getEndOffset() >= source_line->getLength())
1157  {
1158  source->put(source_line, i); /* just use it */
1159  }
1160  else
1161  {
1162  /* extract the tail part */
1163  source->put(source_line->extract(0, location.getEndOffset() - 1), i);
1164  }
1165  }
1166  return source;
1167  }
1168 }
1169 
1171 /******************************************************************************/
1172 /* Function: Perform global parsing initialization */
1173 /******************************************************************************/
1174 {
1175  /* holding pen for temporaries */
1176  OrefSet(this, this->holdstack, new (HOLDSIZE, false) RexxStack(HOLDSIZE));
1177  /* create a save table */
1178  OrefSet(this, this->savelist, new_identity_table());
1179  /* allocate global control tables */
1180  OrefSet(this, this->control, new_queue());
1181  OrefSet(this, this->terms, new_queue());
1182  OrefSet(this, this->subTerms, new_queue());
1183  OrefSet(this, this->operators, new_queue());
1184  OrefSet(this, this->literals, new_directory());
1185  // during an image build, we have a global string table. If this is
1186  // available now, use it.
1187  OrefSet(this, this->strings, memoryObject.getGlobalStrings());
1188  if (this->strings == OREF_NULL)
1189  {
1190  // no global string table, use a local copy
1191  OrefSet(this, this->strings, new_directory());
1192  }
1193  /* get the clause object */
1194  OrefSet(this, this->clause, new RexxClause());
1195 }
1196 
1197 
1199 /******************************************************************************/
1200 /* Function: Convert a source object into an executable method */
1201 /******************************************************************************/
1202 {
1203  this->globalSetup(); /* do the global setup part */
1204  /* translate the source program */
1205  RexxCode *newCode = this->translate(OREF_NULL);
1206  ProtectedObject p(newCode);
1207  this->cleanup(); /* release temporary tables */
1208  // if generating a method object, then process the directive installation now
1209  if (isMethod)
1210  {
1211  // force this to install now
1212  install();
1213  }
1214  return newCode; /* return the method */
1215 }
1216 
1218  RexxDirectory *_labels ) /* parent label set */
1219 /******************************************************************************/
1220 /* Function: Convert a source object into an executable interpret method */
1221 /******************************************************************************/
1222 {
1223  this->globalSetup(); /* do the global setup part */
1224  this->flags |= _interpret; /* this is an interpret */
1225  RexxCode *newCode = this->translate(_labels); /* translate the source program */
1226  ProtectedObject p(newCode);
1227  this->cleanup(); /* release temporary tables */
1228  return newCode; /* return the method */
1229 }
1230 
1232  RexxString *string, /* interpret string value */
1233  RexxDirectory *_labels, /* parent labels */
1234  size_t _line_number ) /* line number of interpret */
1235 /******************************************************************************/
1236 /* Function: Interpret a string in the current activation context */
1237 /******************************************************************************/
1238 {
1239  /* create a source object */
1240  RexxSource *source = new RexxSource (this->programName, new_array(string));
1241  ProtectedObject p(source);
1242  source->interpretLine(_line_number); /* fudge the line numbering */
1243  /* convert to executable form */
1244  return source->interpretMethod(_labels);
1245 }
1246 
1247 void RexxSource::checkDirective(int errorCode)
1248 /******************************************************************************/
1249 /* Function: Verify that no code follows a directive except for more */
1250 /* directive instructions. */
1251 /******************************************************************************/
1252 {
1253  // save the clause location so we can reset for errors
1254  SourceLocation location = clauseLocation;
1255 
1256  this->nextClause(); /* get the next clause */
1257  /* have a next clause? */
1258  if (!(this->flags&no_clause))
1259  {
1260  RexxToken *token = nextReal(); /* get the first token */
1261  /* not a directive start? */
1262  if (token->classId != TOKEN_DCOLON)
1263  {
1264  /* this is an error */
1265  syntaxError(errorCode);
1266  }
1267  firstToken(); /* reset to the first token */
1268  this->reclaimClause(); /* give back to the source object */
1269  }
1270  // this resets the current clause location so that any errors on the current
1271  // clause detected after the clause check reports this on the correct line
1272  // number
1273  clauseLocation = location;
1274 }
1275 
1276 
1285 {
1286  // assume there's no body here
1287  bool result = false;
1288 
1289  // if we have anything to look at, see if it is a directive or not.
1290  this->nextClause();
1291  if (!(this->flags&no_clause))
1292  {
1293  // we have a clause, now check if this is a directive or not
1294  RexxToken *token = nextReal();
1295  // not a "::", not a directive, which means we have real code to deal with
1296  result = token->classId != TOKEN_DCOLON;
1297  // reset this clause entirely so we can start parsing for real.
1298  firstToken();
1299  this->reclaimClause();
1300  }
1301  return result;
1302 }
1303 
1304 
1306  RexxObject *object) /* object to "release" */
1307 /******************************************************************************/
1308 /* Function: Remove an object from the save list */
1309 /******************************************************************************/
1310 {
1311  /* have a real object */
1312  if (object != OREF_NULL)
1313  {
1314  this->savelist->remove(object); /* remove from the save table */
1315  this->holdObject(object); /* return this object as held */
1316  }
1317  return object; /* return the object */
1318 }
1319 
1321 /******************************************************************************/
1322 /* Function: Final cleanup after parsing */
1323 /******************************************************************************/
1324 {
1325  /* global area cleanup */
1326  /* release the holding pen */
1327  OrefSet(this, this->holdstack, OREF_NULL);
1328  /* release any saved objects */
1329  OrefSet(this, this->savelist, OREF_NULL);
1330  OrefSet(this, this->literals, OREF_NULL);
1331  OrefSet(this, this->strings, OREF_NULL);
1332  OrefSet(this, this->clause, OREF_NULL);
1333  OrefSet(this, this->control, OREF_NULL);
1334  OrefSet(this, this->terms, OREF_NULL);
1335  OrefSet(this, this->subTerms, OREF_NULL);
1336  OrefSet(this, this->operators, OREF_NULL);
1337  OrefSet(this, this->class_dependencies, OREF_NULL);
1338  OrefSet(this, this->active_class, OREF_NULL);
1339  /* now method parsing areas */
1340  OrefSet(this, this->calls, OREF_NULL);
1341  OrefSet(this, this->variables, OREF_NULL);
1342  OrefSet(this, this->guard_variables, OREF_NULL);
1343  OrefSet(this, this->exposed_variables, OREF_NULL);
1344  OrefSet(this, this->labels, OREF_NULL);
1345  OrefSet(this, this->first, OREF_NULL);
1346  OrefSet(this, this->last, OREF_NULL);
1347  OrefSet(this, this->currentInstruction, OREF_NULL);
1348 }
1349 
1350 
1359 {
1360  // set this as a parent
1361  OrefSet(this, this->parentSource, source);
1362 }
1363 
1364 
1366 /******************************************************************************/
1367 /* Function: Merge all public class and routine information from a called */
1368 /* program into the full public information of this program. */
1369 /******************************************************************************/
1370 {
1371  // has the source already merged in some public routines? pull those in first,
1372  // so that the direct set will override
1373  if (source->merged_public_routines != OREF_NULL)
1374  {
1375  /* first merged attempt? */
1376  if (this->merged_public_routines == OREF_NULL)
1377  {
1378  /* get the directory */
1380  }
1381  /* loop through the list of routines */
1382  for (HashLink i = source->merged_public_routines->first(); source->merged_public_routines->available(i); i = source->merged_public_routines->next(i))
1383  {
1384  /* copy the routine over */
1386  }
1387 
1388  }
1389 
1390  // now process the direct set
1391  if (source->public_routines != OREF_NULL)
1392  {
1393  /* first merged attempt? */
1394  if (this->merged_public_routines == OREF_NULL)
1395  {
1396  /* get the directory */
1398  }
1399  /* loop through the list of routines */
1400  for (HashLink i = source->public_routines->first(); source->public_routines->available(i); i = source->public_routines->next(i))
1401  {
1402  /* copy the routine over */
1404  }
1405  }
1406 
1407 
1408  // now do the same process for any of the class contexts
1409  if (source->merged_public_classes != OREF_NULL)
1410  {
1411  if (this->merged_public_classes == OREF_NULL)
1412  {
1413  /* get the directory */
1415  }
1416  /* loop through the list of classes, */
1417  for (HashLink i = source->merged_public_classes->first(); source->merged_public_classes->available(i); i = source->merged_public_classes->next(i))
1418  {
1419  /* copy the routine over */
1421  }
1422  }
1423 
1424  // the installed ones are processed second as they will overwrite the imported one, which
1425  // is the behaviour we want
1426  if (source->installed_public_classes != OREF_NULL)
1427  {
1428  if (this->merged_public_classes == OREF_NULL)
1429  {
1430  /* get the directory */
1432  }
1433  /* loop through the list of classes, */
1435  {
1436  /* copy the routine over */
1438  }
1439  }
1440 }
1441 
1442 
1452 {
1453  // if we have one locally, then return it.
1454  if (this->routines != OREF_NULL)
1455  {
1456  /* try for a local one first */
1457  RoutineClass *result = (RoutineClass *)(this->routines->fastAt(name));
1458  if (result != OREF_NULL)
1459  {
1460  return result;
1461  }
1462  }
1463 
1464  // we might have a chained context, so check it also
1465  if (parentSource != OREF_NULL)
1466  {
1467  return parentSource->findLocalRoutine(name);
1468  }
1469  // nope, no got one
1470  return OREF_NULL;
1471 }
1472 
1473 
1482 {
1483  // if we have one locally, then return it.
1484  if (this->merged_public_routines != OREF_NULL)
1485  {
1486  /* try for a local one first */
1487  RoutineClass *result = (RoutineClass *)(this->merged_public_routines->fastAt(name));
1488  if (result != OREF_NULL)
1489  {
1490  return result;
1491  }
1492  }
1493 
1494  // we might have a chained context, so check it also
1495  if (parentSource != OREF_NULL)
1496  {
1497  return parentSource->findPublicRoutine(name);
1498  }
1499  // nope, no got one
1500  return OREF_NULL;
1501 }
1502 
1503 
1514 {
1515  // These lookups are case insensive, so the table are all created using the opper
1516  // case names. Use it once and reuse it.
1517  RexxString *upperName = routineName->upper();
1518  ProtectedObject p1(upperName);
1519  RoutineClass *routineObject = findLocalRoutine(upperName);
1520  if (routineObject != OREF_NULL)
1521  {
1522  return routineObject;
1523  }
1524 
1525  // now try for one pulled in from ::REQUIRES objects
1526  return findPublicRoutine(upperName);
1527 }
1528 
1529 
1542 {
1544 }
1545 
1546 
1556 {
1557  // if we have one locally, then return it.
1558  if (this->installed_classes != OREF_NULL)
1559  {
1560  /* try for a local one first */
1561  RexxClass *result = (RexxClass *)(this->installed_classes->fastAt(name));
1562  if (result != OREF_NULL)
1563  {
1564  return result;
1565  }
1566  }
1567 
1568  // we might have a chained context, so check it also
1569  if (parentSource != OREF_NULL)
1570  {
1571  return parentSource->findInstalledClass(name);
1572  }
1573  // nope, no got one
1574  return OREF_NULL;
1575 }
1576 
1577 
1579 {
1580  // if we have one locally, then return it.
1581  if (this->merged_public_classes != OREF_NULL)
1582  {
1583  /* try for a local one first */
1584  RexxClass *result = (RexxClass *)(this->merged_public_classes->fastAt(name));
1585  if (result != OREF_NULL)
1586  {
1587  return result;
1588  }
1589  }
1590 
1591  // we might have a chained context, so check it also
1592  if (parentSource != OREF_NULL)
1593  {
1594  return parentSource->findPublicClass(name);
1595  }
1596  // nope, no got one
1597  return OREF_NULL;
1598 }
1599 
1600 
1610 {
1611  RexxString *internalName = className->upper(); /* upper case it */
1612  // check for a directly defined one in the source context chain
1613  RexxClass *classObject = findInstalledClass(internalName);
1614  // return if we got one
1615  if (classObject != OREF_NULL)
1616  {
1617  return classObject;
1618  }
1619  // now try for public classes we pulled in from other contexts
1620  classObject = findPublicClass(internalName);
1621  // return if we got one
1622  if (classObject != OREF_NULL)
1623  {
1624  return classObject;
1625  }
1626 
1627  // give the security manager a go
1628  if (this->securityManager != OREF_NULL)
1629  {
1630  classObject = (RexxClass *)securityManager->checkLocalAccess(internalName);
1631  if (classObject != OREF_NULL)
1632  {
1633  return classObject;
1634  }
1635  }
1636 
1637  /* send message to .local */
1638  classObject = (RexxClass *)(ActivityManager::getLocalEnvironment(internalName));
1639  if (classObject != OREF_NULL)
1640  {
1641  return classObject;
1642  }
1643 
1644  /* normal execution? */
1645  if (this->securityManager != OREF_NULL)
1646  {
1647  classObject = (RexxClass *)securityManager->checkEnvironmentAccess(internalName);
1648  if (classObject != OREF_NULL)
1649  {
1650  return classObject;
1651  }
1652  }
1653 
1654  /* last chance, try the environment */
1655  return(RexxClass *)(TheEnvironment->at(internalName));
1656 }
1657 
1658 
1663 {
1664  if (needsInstallation())
1665  {
1666  // In order to install, we need to call something. We manage this by
1667  // creating a dummy stub routine that we can call to force things to install
1668  RexxCode *stub = new RexxCode(this, OREF_NULL, OREF_NULL, 10, FIRST_VARIABLE_INDEX);
1669  ProtectedObject p2(stub);
1670  RoutineClass *code = new RoutineClass(programName, stub);
1671  p2 = code;
1672  ProtectedObject dummy;
1673  code->call(ActivityManager::currentActivity, programName, NULL, 0, dummy);
1674  }
1675 }
1676 
1677 
1679  RexxActivation *activation) /* invoking activation */
1680 /******************************************************************************/
1681 /* Function: Process directive information contained within a method, calling*/
1682 /* all ::requires routines, creating all ::class methods, and */
1683 /* processing all ::routines. */
1684 /******************************************************************************/
1685 {
1686  /* turn the install flag off */
1687  /* immediately, otherwise we may */
1688  /* run into a recursion problem */
1689  /* when class init methods are */
1690  /* processed */
1691  this->flags &= ~_install; /* we are now installed */
1692 
1693  // native packages are processed first. The requires might actually need
1694  // functons loaded by the packages
1695  if (this->libraries != OREF_NULL)
1696  {
1697  /* classes and routines */
1698  // now loop through the requires items
1699  for (size_t i = libraries->firstIndex(); i != LIST_END; i = libraries->nextIndex(i))
1700  {
1701  // and have it do the installs processing
1702  LibraryDirective *library = (LibraryDirective *)this->libraries->getValue(i);
1703  library->install(activation);
1704  }
1705  }
1706 
1707  // native methods and routines are lazy resolved on first use, so we don't
1708  // need to process them here.
1709 
1710  if (this->requires != OREF_NULL) /* need to process ::requires? */
1711  {
1712  /* classes and routines */
1713  // now loop through the requires items
1714  for (size_t i = requires->firstIndex(); i != LIST_END; i = requires->nextIndex(i))
1715  {
1716  // and have it do the installs processing. This is a little roundabout, but
1717  // we end up back in our own context while processing this, and the merge
1718  // of the information happens then.
1719  RequiresDirective *_requires = (RequiresDirective *)this->requires->getValue(i);
1720  _requires->install(activation);
1721  }
1722  }
1723 
1724  // and finally process classes
1725  if (this->classes != OREF_NULL)
1726  {
1727  /* get an installed classes directory*/
1728  OrefSet(this, this->installed_classes, new_directory());
1729  /* and the public classes */
1731  RexxArray *createdClasses = new_array(classes->items());
1732 
1733  ProtectedObject p(createdClasses);
1734  size_t index = 1; // used for keeping track of install order
1735  for (size_t i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1736  {
1737  /* get the class info */
1738  ClassDirective *current_class = (ClassDirective *)this->classes->getValue(i);
1739  // save the newly created class in our array so we can send the activate
1740  // message at the end
1741  RexxClass *newClass = current_class->install(this, activation);
1742  createdClasses->put(newClass, index++);
1743  }
1744  // now send an activate message to each of these classes
1745  for (size_t j = 1; j < index; j++)
1746  {
1747  RexxClass *clz = (RexxClass *)createdClasses->get(j);
1748  clz->sendMessage(OREF_ACTIVATE);
1749  }
1750  }
1751 }
1752 
1754  RexxDirectory *_labels) /* interpret labels */
1755 /******************************************************************************/
1756 /* Function: Translate a source object into a method object */
1757 /******************************************************************************/
1758 {
1760 
1761  // set up the package global defaults
1767 
1768  /* go translate the lead block */
1769  RexxCode *newMethod = this->translateBlock(_labels);
1770  // we save this in case we need to explicitly run this at install time
1771  OrefSet(this, this->initCode, newMethod);
1772  if (!this->atEnd()) /* have directives to process? */
1773  {
1774  /* create the routines directory */
1775  OrefSet(this, this->routines, new_directory());
1776  /* create the routines directory */
1777  OrefSet(this, this->public_routines, new_directory());
1778  /* and a directory of dependencies */
1779  OrefSet(this, this->class_dependencies, new_directory());
1780  /* create the requires directory */
1781  OrefSet(this, this->requires, new_list());
1782  // and a list of load libraries requiring loading.
1783  OrefSet(this, this->libraries, new_list());
1784  /* create the classes list */
1785  OrefSet(this, this->classes, new_list());
1786  /* no active class definition */
1787  OrefSet(this, this->active_class, OREF_NULL);
1788  /* translation stopped by a directive*/
1789  if (this->flags&_interpret) /* is this an interpret? */
1790  {
1791  this->nextClause(); /* get the directive clause */
1792  /* raise an error */
1794  }
1795  /* create a directory for ..methods */
1796  OrefSet(this, this->methods, new_directory());
1797 
1798  while (!this->atEnd()) /* loop until end of source */
1799  {
1800  this->directive(); /* process the directive */
1801  }
1802  this->resolveDependencies(); /* go resolve class dependencies */
1803  }
1804  return newMethod; /* return the method */
1805 }
1806 
1807 
1809 /*********************************************************************/
1810 /* Function: Resolve dependencies between ::CLASS directives, */
1811 /* rearranging the order of the directives to preserve */
1812 /* relative ordering wherever possible. Classes with no */
1813 /* dependencies in this source file will be done first, */
1814 /* followed by those with dependencies in the appropriate */
1815 /* order */
1816 /*********************************************************************/
1817 {
1818  // get our class list
1819  if (classes->items() == 0) /* nothing to process? */
1820  {
1821  /* clear out the classes list */
1822  OrefSet(this, this->classes, OREF_NULL);
1823  }
1824  else /* have classes to process */
1825  {
1826  size_t i;
1827  // run through the class list having each directive set up its
1828  // dependencies
1829  for (i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1830  {
1831  /* get the next class */
1832  ClassDirective *current_class = (ClassDirective *)(classes->getValue(i));
1833  // have the class figure out it's in-package dependencies
1834  current_class->addDependencies(class_dependencies);
1835  }
1836 
1837  RexxList *class_order = new_list(); // get a list for doing the order
1838  ProtectedObject p(class_order);
1839 
1840 /* now we repeatedly scan the pending directory looking for a class */
1841 /* with no in-program dependencies - it's an error if there isn't one */
1842 /* as we build the classes we have to remove them (their names) from */
1843 /* pending list and from the remaining dependencies */
1844  while (classes->items() > 0)
1845  {
1846  // this is the next one we process
1847  ClassDirective *next_install = OREF_NULL;
1848  for (i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1849  {
1850  /* get the next class */
1851  ClassDirective *current_class = (ClassDirective *)(classes->getValue(i));
1852  // if this class doesn't have any additional dependencies, pick it next.
1853  if (current_class->dependenciesResolved())
1854  {
1855  next_install = current_class;
1856  // add this to the class ordering
1857  class_order->append((RexxObject *)next_install);
1858  // remove this from the processing list
1859  classes->removeIndex(i);
1860  }
1861  }
1862  if (next_install == OREF_NULL) /* nothing located? */
1863  {
1864  // directive line where we can give as the source of the error
1866  clauseLocation = error_class->getLocation();
1867  /* raise an error */
1869  }
1870  RexxString *class_name = next_install->getName();
1871 
1872  // now go through the pending list telling each of the remaining classes that
1873  // they can remove this dependency from their list
1874  for (i = classes->firstIndex(); i != LIST_END; i = classes->nextIndex(i))
1875  { /* go remove the dependencies */
1876  /* get a class */
1877  ClassDirective *current_class = (ClassDirective *)classes->getValue(i);
1878  current_class->removeDependency(class_name);
1879  }
1880  }
1881 
1882  /* replace the original class list */
1883  OrefSet(this, this->classes, class_order);
1884  /* don't need the dependencies now */
1885  OrefSet(this, this->class_dependencies, OREF_NULL);
1886  }
1887 
1888  if (this->requires->items() == 0) /* nothing there? */
1889  {
1890  /* just clear it out */
1891  OrefSet(this, this->requires, OREF_NULL);
1892  }
1893  if (this->libraries->items() == 0) /* nothing there? */
1894  {
1895  /* just clear it out */
1896  OrefSet(this, this->libraries, OREF_NULL);
1897  }
1898  if (this->routines->items() == 0) /* no routines to process? */
1899  {
1900  /* just clear it out also */
1901  OrefSet(this, this->routines, OREF_NULL);
1902  }
1903  /* now finally the public routines */
1904  if (this->public_routines->items() == 0)
1905  {
1906  /* just clear it out also */
1907  OrefSet(this, this->public_routines, OREF_NULL);
1908  }
1909  if (this->methods->items() == 0) /* and also the methods directory */
1910  {
1911  /* just clear it out also */
1912  OrefSet(this, this->methods, OREF_NULL);
1913  }
1914 }
1915 
1916 
1917 #define DEFAULT_GUARD 0 /* using defualt guarding */
1918 #define GUARDED_METHOD 1 /* method is a guarded one */
1919 #define UNGUARDED_METHOD 2 /* method is unguarded */
1920 
1921 #define DEFAULT_PROTECTION 0 /* using defualt protection */
1922 #define PROTECTED_METHOD 1 /* security manager permission needed*/
1923 #define UNPROTECTED_METHOD 2 /* no protection. */
1924 
1925 #define DEFAULT_ACCESS_SCOPE 0 /* using defualt scope */
1926 #define PUBLIC_SCOPE 1 /* publicly accessible */
1927 #define PRIVATE_SCOPE 2 /* private scope */
1928 
1933 {
1934  RexxToken *token = nextReal(); /* get the next token */
1935  /* not a symbol or a string */
1936  if (!token->isSymbolOrLiteral())
1937  {
1938  /* report an error */
1940  }
1941  RexxString *name = token->value; /* get the routine name */
1942  /* get the exposed name version */
1943  RexxString *public_name = this->commonString(name->upper());
1944  /* does this already exist? */
1945  if (this->class_dependencies->entry(public_name) != OREF_NULL)
1946  {
1947  /* have an error here */
1949  }
1950  /* create a dependencies list */
1951  this->flags |= _install; /* have information to install */
1952 
1953  // create a class directive and add this to the dependency list
1954  OrefSet(this, this->active_class, new ClassDirective(name, public_name, this->clause));
1955  this->class_dependencies->put((RexxObject *)active_class, public_name);
1956  // and also add to the classes list
1957  this->classes->append((RexxObject *)this->active_class);
1958 
1959  int Public = DEFAULT_ACCESS_SCOPE; /* haven't seen the keyword yet */
1960  for (;;)
1961  { /* now loop on the option keywords */
1962  token = nextReal(); /* get the next token */
1963  /* reached the end? */
1964  if (token->isEndOfClause())
1965  {
1966  break; /* get out of here */
1967  }
1968  /* not a symbol token? */
1969  else if (!token->isSymbol())
1970  {
1971  /* report an error */
1973  }
1974  else
1975  { /* have some sort of option keyword */
1976  /* get the keyword type */
1977  int type = this->subDirective(token);
1978  switch (type)
1979  { /* process each sub keyword */
1980  /* ::CLASS name METACLASS metaclass */
1982  /* already had a METACLASS? */
1984  {
1986  }
1987  token = nextReal(); /* get the next token */
1988  /* not a symbol or a string */
1989  if (!token->isSymbolOrLiteral())
1990  {
1991  /* report an error */
1993  }
1994  /* tag the active class */
1995  this->active_class->setMetaClass(token->value);
1996  break;
1997 
1998 
1999  case SUBDIRECTIVE_PUBLIC: /* ::CLASS name PUBLIC */
2000  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
2001  {
2002  /* duplicates are invalid */
2004  }
2005  Public = PUBLIC_SCOPE; /* turn on the seen flag */
2006  /* just set this as a public object */
2007  this->active_class->setPublic();
2008  break;
2009 
2010  case SUBDIRECTIVE_PRIVATE: /* ::CLASS name PUBLIC */
2011  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
2012  {
2013  /* duplicates are invalid */
2015  }
2016  Public = PRIVATE_SCOPE; /* turn on the seen flag */
2017  break;
2018  /* ::CLASS name SUBCLASS sclass */
2019  case SUBDIRECTIVE_SUBCLASS:
2020  // If we have a subclass set already, this is an error
2022  {
2023  /* duplicates are invalid */
2025  }
2026  token = nextReal(); /* get the next token */
2027  /* not a symbol or a string */
2028  if (!token->isSymbolOrLiteral())
2029  {
2030  /* report an error */
2032  }
2033  /* set the subclass information */
2034  this->active_class->setSubClass(token->value);
2035  break;
2036  /* ::CLASS name MIXINCLASS mclass */
2038  // If we have a subclass set already, this is an error
2040  {
2041  /* duplicates are invalid */
2043  }
2044  token = nextReal(); /* get the next token */
2045  /* not a symbol or a string */
2046  if (!token->isSymbolOrLiteral())
2047  {
2048  /* report an error */
2050  }
2051  /* set the subclass information */
2052  this->active_class->setMixinClass(token->value);
2053  break;
2054  /* ::CLASS name INHERIT iclasses */
2055  case SUBDIRECTIVE_INHERIT:
2056  token = nextReal(); /* get the next token */
2057  /* nothing after the keyword? */
2058  if (token->isEndOfClause())
2059  {
2060  /* report an error */
2062  }
2063  while (!token->isEndOfClause())
2064  {
2065  /* not a symbol or a string */
2066  if (!token->isSymbolOrLiteral())
2067  {
2068  /* report an error */
2070  }
2071  /* add to the inherit list */
2072  this->active_class->addInherits(token->value);
2073  token = nextReal(); /* step to the next token */
2074  }
2075  previousToken(); /* step back a token */
2076  break;
2077 
2078  default: /* invalid keyword */
2079  /* this is an error */
2081  break;
2082  }
2083  }
2084  }
2085 }
2086 
2087 
2097 void RexxSource::checkDuplicateMethod(RexxString *name, bool classMethod, int errorMsg)
2098 {
2099  /* no previous ::CLASS directive? */
2100  if (this->active_class == OREF_NULL)
2101  {
2102  if (classMethod) /* supposed to be a class method? */
2103  {
2104  /* this is an error */
2106  }
2107  /* duplicate method name? */
2108  if (this->methods->entry(name) != OREF_NULL)
2109  {
2110  /* this is an error */
2111  syntaxError(errorMsg);
2112  }
2113  }
2114  else
2115  { /* add the method to the active class*/
2116  if (active_class->checkDuplicateMethod(name, classMethod))
2117  {
2118  /* this is an error */
2119  syntaxError(errorMsg);
2120  }
2121  }
2122 }
2123 
2124 
2133 void RexxSource::addMethod(RexxString *name, RexxMethod *method, bool classMethod)
2134 {
2135  if (this->active_class == OREF_NULL)
2136  {
2137  this->methods->setEntry(name, method);
2138  }
2139  else
2140  {
2141  active_class->addMethod(name, method, classMethod);
2142  }
2143 }
2144 
2145 
2146 
2151 {
2152  int Private = DEFAULT_ACCESS_SCOPE; /* this is a public method */
2153  int Protected = DEFAULT_PROTECTION; /* and is not protected yet */
2154  int guard = DEFAULT_GUARD; /* default is guarding */
2155  bool Class = false; /* default is an instance method */
2156  bool Attribute = false; /* init Attribute flag */
2157  bool abstractMethod = false; // this is an abstract method
2158  RexxToken *token = nextReal(); /* get the next token */
2159  RexxString *externalname = OREF_NULL; /* not an external method yet */
2160 
2161  /* not a symbol or a string */
2162  if (!token->isSymbolOrLiteral())
2163  {
2164  /* report an error */
2166  }
2167  RexxString *name = token->value; /* get the string name */
2168  /* and the name form also */
2169  RexxString *internalname = this->commonString(name->upper());
2170  for (;;)
2171  { /* now loop on the option keywords */
2172  token = nextReal(); /* get the next token */
2173  /* reached the end? */
2174  if (token->isEndOfClause())
2175  {
2176  break; /* get out of here */
2177  }
2178  /* not a symbol token? */
2179  else if (!token->isSymbol())
2180  {
2181  /* report an error */
2183  }
2184  else
2185  { /* have some sort of option keyword */
2186  /* process each sub keyword */
2187  switch (this->subDirective(token))
2188  {
2189  /* ::METHOD name CLASS */
2190  case SUBDIRECTIVE_CLASS:
2191  if (Class) /* had one of these already? */
2192  {
2193  /* duplicates are invalid */
2195  }
2196  Class = true; /* flag this for later processing */
2197  break;
2198  /* ::METHOD name EXTERNAL extname */
2199  case SUBDIRECTIVE_EXTERNAL:
2200  /* already had an external? */
2201  if (externalname != OREF_NULL || abstractMethod)
2202  {
2203  /* duplicates are invalid */
2205  }
2206  token = nextReal(); /* get the next token */
2207  /* not a string? */
2208  if (!token->isLiteral())
2209  {
2210  /* report an error */
2212  }
2213  externalname = token->value;
2214  break;
2215  /* ::METHOD name PRIVATE */
2216  case SUBDIRECTIVE_PRIVATE:
2217  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2218  {
2219  /* duplicates are invalid */
2221  }
2222  Private = PRIVATE_SCOPE; /* flag for later processing */
2223  break;
2224  /* ::METHOD name PUBLIC */
2225  case SUBDIRECTIVE_PUBLIC:
2226  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2227  {
2228  /* duplicates are invalid */
2230  }
2231  Private = PUBLIC_SCOPE; /* flag for later processing */
2232  break;
2233  /* ::METHOD name PROTECTED */
2235  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2236  {
2237  /* duplicates are invalid */
2239  }
2240  Protected = PROTECTED_METHOD; /* flag for later processing */
2241  break;
2242  /* ::METHOD name UNPROTECTED */
2244  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2245  {
2246  /* duplicates are invalid */
2248  }
2249  Protected = UNPROTECTED_METHOD; /* flag for later processing */
2250  break;
2251  /* ::METHOD name UNGUARDED */
2253  /* already seen one of these? */
2254  if (guard != DEFAULT_GUARD)
2255  {
2256  /* duplicates are invalid */
2258  }
2259  guard = UNGUARDED_METHOD;/* flag for later processing */
2260  break;
2261  /* ::METHOD name GUARDED */
2262  case SUBDIRECTIVE_GUARDED:
2263  /* already seen one of these? */
2264  if (guard != DEFAULT_GUARD)
2265  {
2266  /* duplicates are invalid */
2268  }
2269  guard = GUARDED_METHOD; /* flag for later processing */
2270  break;
2271  /* ::METHOD name ATTRIBUTE */
2273 
2274  if (Attribute) /* already seen one of these? */
2275  {
2276  /* duplicates are invalid */
2278  }
2279  // cannot have an abstract attribute
2280  if (abstractMethod)
2281  {
2282  /* EXTERNAL and ATTRIBUTE are */
2283  /* mutually exclusive */
2285  }
2286  Attribute = true; /* flag for later processing */
2287  break;
2288 
2289  /* ::METHOD name ABSTRACT */
2290  case SUBDIRECTIVE_ABSTRACT:
2291 
2292  if (abstractMethod || externalname != OREF_NULL)
2293  {
2295  }
2296  // not compatible with ATTRIBUTE or EXTERNAL
2297  if (externalname != OREF_NULL || Attribute)
2298  {
2300  }
2301  abstractMethod = true; /* flag for later processing */
2302  break;
2303 
2304 
2305  default: /* invalid keyword */
2306  /* this is an error */
2308  break;
2309  }
2310  }
2311  }
2312 
2313  // go check for a duplicate and validate the use of the CLASS modifier
2315 
2316 
2317  RexxMethod *_method = OREF_NULL;
2318  // is this an attribute method?
2319  if (Attribute)
2320  {
2321  // now get this as the setter method.
2322  RexxString *setterName = commonString(internalname->concatWithCstring("="));
2323  // need to check for duplicates on that too
2325 
2326  /* Go check the next clause to make */
2327  this->checkDirective(Error_Translation_attribute_method); /* sure that no code follows */
2328  // this might be externally defined setters and getters.
2329  if (externalname != OREF_NULL)
2330  {
2331  RexxString *library = OREF_NULL;
2332  RexxString *procedure = OREF_NULL;
2333  decodeExternalMethod(internalname, externalname, library, procedure);
2334  // now create both getter and setting methods from the information.
2335  _method = createNativeMethod(internalname, library, procedure->concatToCstring("GET"));
2336  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2337  // add to the compilation
2338  addMethod(internalname, _method, Class);
2339 
2340  _method = createNativeMethod(setterName, library, procedure->concatToCstring("SET"));
2341  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2342  // add to the compilation
2343  addMethod(setterName, _method, Class);
2344  }
2345  else
2346  {
2347  // now get a variable retriever to get the property
2348  RexxVariableBase *retriever = this->getRetriever(name);
2349 
2350  // create the method pair and quit.
2351  createAttributeGetterMethod(internalname, retriever, Class, Private == PRIVATE_SCOPE,
2352  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2353  createAttributeSetterMethod(setterName, retriever, Class, Private == PRIVATE_SCOPE,
2354  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2355  }
2356  return;
2357  }
2358  // abstract method?
2359  else if (abstractMethod)
2360  {
2361  /* Go check the next clause to make */
2362  this->checkDirective(Error_Translation_abstract_method); /* sure that no code follows */
2363  // this uses a special code block
2364  BaseCode *code = new AbstractCode();
2365  _method = new RexxMethod(name, code);
2366  }
2367  /* not an external method? */
2368  else if (externalname == OREF_NULL)
2369  {
2370  // NOTE: It is necessary to translate the block and protect the code
2371  // before allocating the RexxMethod object. The new operator allocates the
2372  // the object first, then evaluates the constructor arguments after the allocation.
2373  // Since the translateBlock() call will allocate a lot of new objects before returning,
2374  // there's a high probability that the method object can get garbage collected before
2375  // there is any opportunity to protect the object.
2376  RexxCode *code = this->translateBlock(OREF_NULL);
2377  this->saveObject((RexxObject *)code);
2378 
2379  /* go do the next block of code */
2380  _method = new RexxMethod(name, code);
2381  }
2382  else
2383  {
2384  RexxString *library = OREF_NULL;
2385  RexxString *procedure = OREF_NULL;
2386  decodeExternalMethod(internalname, externalname, library, procedure);
2387 
2388  /* go check the next clause to make */
2390  // and make this into a method object.
2391  _method = createNativeMethod(name, library, procedure);
2392  }
2393  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2394  // add to the compilation
2395  addMethod(internalname, _method, Class);
2396 }
2397 
2398 
2399 
2404 {
2405  // all options are of a keyword/value pattern
2406  for (;;)
2407  {
2408  RexxToken *token = nextReal(); /* get the next token */
2409  /* reached the end? */
2410  if (token->isEndOfClause())
2411  {
2412  break; /* get out of here */
2413  }
2414  /* not a symbol token? */
2415  else if (!token->isSymbol())
2416  {
2417  /* report an error */
2419  }
2420  else
2421  { /* have some sort of option keyword */
2422  /* process each sub keyword */
2423  switch (this->subDirective(token))
2424  {
2425  // ::OPTIONS DIGITS nnnn
2426  case SUBDIRECTIVE_DIGITS:
2427  {
2428  token = nextReal(); /* get the next token */
2429  /* not a string? */
2430  if (!token->isSymbolOrLiteral())
2431  {
2432  /* report an error */
2434  }
2435  RexxString *value = token->value; /* get the string value */
2436 
2437  if (!value->requestUnsignedNumber(digits, number_digits()) || digits < 1)
2438  {
2439  /* report an exception */
2441  }
2442  /* problem with the fuzz setting? */
2443  if (digits <= fuzz)
2444  {
2445  /* this is an error */
2447  }
2448  break;
2449  }
2450  // ::OPTIONS FORM ENGINEERING/SCIENTIFIC
2451  case SUBDIRECTIVE_FORM:
2452  token = nextReal(); /* get the next token */
2453  /* not a string? */
2454  if (!token->isSymbol())
2455  {
2456  /* report an error */
2458  }
2459  /* resolve the subkeyword */
2460  /* and process */
2461  switch (this->subKeyword(token))
2462  {
2463 
2464  case SUBKEY_SCIENTIFIC: /* NUMERIC FORM SCIENTIFIC */
2466  break;
2467 
2468  case SUBKEY_ENGINEERING: /* NUMERIC FORM ENGINEERING */
2470  break;
2471 
2472  default: /* invalid subkeyword */
2473  /* raise an error */
2475  break;
2476 
2477  }
2478  break;
2479  // ::OPTIONS FUZZ nnnn
2480  case SUBDIRECTIVE_FUZZ:
2481  {
2482  token = nextReal(); /* get the next token */
2483  /* not a string? */
2484  if (!token->isSymbolOrLiteral())
2485  {
2486  /* report an error */
2488  }
2489  RexxString *value = token->value; /* get the string value */
2490 
2491  if (!value->requestUnsignedNumber(fuzz, number_digits()))
2492  {
2493  /* report an exception */
2495  }
2496  /* problem with the digits setting? */
2497  if (fuzz >= digits)
2498  {
2499  /* and issue the error */
2501  }
2502  break;
2503  }
2504  // ::OPTIONS TRACE setting
2505  case SUBDIRECTIVE_TRACE:
2506  {
2507  token = nextReal(); /* get the next token */
2508  /* not a string? */
2509  if (!token->isSymbolOrLiteral())
2510  {
2511  /* report an error */
2513  }
2514  RexxString *value = token->value; /* get the string value */
2515  char badOption = 0;
2516  /* process the setting */
2517  if (!parseTraceSetting(value, traceSetting, traceFlags, badOption))
2518  {
2520  }
2521  break;
2522  }
2523 
2524  default: /* invalid keyword */
2525  /* this is an error */
2527  break;
2528  }
2529  }
2530  }
2531 }
2532 
2543 {
2544  /* create a new native method */
2545  RexxNativeCode *nmethod = PackageManager::resolveMethod(library, procedure);
2546  // raise an exception if this entry point is not found.
2547  if (nmethod == OREF_NULL)
2548  {
2550  }
2551  // this might return a different object if this has been used already
2552  nmethod = (RexxNativeCode *)nmethod->setSourceObject(this);
2553  /* turn into a real method object */
2554  return new RexxMethod(name, nmethod);
2555 }
2556 
2566 void RexxSource::decodeExternalMethod(RexxString *methodName, RexxString *externalSpec, RexxString *&library, RexxString *&procedure)
2567 {
2568  // this is the default
2569  procedure = methodName;
2570  library = OREF_NULL;
2571 
2572  /* convert external into words */
2573  RexxArray *_words = this->words(externalSpec);
2574  /* not 'LIBRARY library [entry]' form? */
2575  if (((RexxString *)(_words->get(1)))->strCompare(CHAR_LIBRARY))
2576  {
2577  // full library with entry name version?
2578  if (_words->size() == 3)
2579  {
2580  library = (RexxString *)_words->get(2);
2581  procedure = (RexxString *)_words->get(3);
2582  }
2583  else if (_words->size() == 2)
2584  {
2585  library = (RexxString *)_words->get(2);
2586  }
2587  else // wrong number of tokens
2588  {
2589  /* this is an error */
2591  }
2592  }
2593  else
2594  {
2595  /* unknown external type */
2597  }
2598 }
2599 
2600 #define ATTRIBUTE_BOTH 0
2601 #define ATTRIBUTE_GET 1
2602 #define ATTRIBUTE_SET 2
2603 
2604 
2609 {
2610  int Private = DEFAULT_ACCESS_SCOPE; /* this is a public method */
2611  int Protected = DEFAULT_PROTECTION; /* and is not protected yet */
2612  int guard = DEFAULT_GUARD; /* default is guarding */
2613  int style = ATTRIBUTE_BOTH; // by default, we create both methods for the attribute.
2614  bool Class = false; /* default is an instance method */
2615  bool abstractMethod = false; // by default, creating a concrete method
2616  RexxToken *token = nextReal(); /* get the next token */
2617 
2618  /* not a symbol or a string */
2619  if (!token->isSymbolOrLiteral())
2620  {
2621  /* report an error */
2623  }
2624  RexxString *name = token->value; /* get the string name */
2625  /* and the name form also */
2626  RexxString *internalname = this->commonString(name->upper());
2627  RexxString *externalname = OREF_NULL;
2628 
2629  for (;;)
2630  { /* now loop on the option keywords */
2631  token = nextReal(); /* get the next token */
2632  /* reached the end? */
2633  if (token->isEndOfClause())
2634  {
2635  break; /* get out of here */
2636  }
2637  /* not a symbol token? */
2638  else if (!token->isSymbol())
2639  {
2640  /* report an error */
2642  }
2643  else
2644  { /* have some sort of option keyword */
2645  /* process each sub keyword */
2646  switch (this->subDirective(token))
2647  {
2648  case SUBDIRECTIVE_GET:
2649  // only one of GET/SET allowed
2650  if (style != ATTRIBUTE_BOTH)
2651  {
2653  }
2654  style = ATTRIBUTE_GET;
2655  break;
2656 
2657  case SUBDIRECTIVE_SET:
2658  // only one of GET/SET allowed
2659  if (style != ATTRIBUTE_BOTH)
2660  {
2662  }
2663  style = ATTRIBUTE_SET;
2664  break;
2665 
2666 
2667  /* ::ATTRIBUTE name CLASS */
2668  case SUBDIRECTIVE_CLASS:
2669  if (Class) /* had one of these already? */
2670  {
2671  /* duplicates are invalid */
2673  }
2674  Class = true; /* flag this for later processing */
2675  break;
2676  case SUBDIRECTIVE_PRIVATE:
2677  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2678  {
2679  /* duplicates are invalid */
2681  }
2682  Private = PRIVATE_SCOPE; /* flag for later processing */
2683  break;
2684  /* ::METHOD name PUBLIC */
2685  case SUBDIRECTIVE_PUBLIC:
2686  if (Private != DEFAULT_ACCESS_SCOPE) /* already seen one of these? */
2687  {
2688  /* duplicates are invalid */
2690  }
2691  Private = PUBLIC_SCOPE; /* flag for later processing */
2692  break;
2693  /* ::METHOD name PROTECTED */
2695  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2696  {
2697  /* duplicates are invalid */
2699  }
2700  Protected = PROTECTED_METHOD; /* flag for later processing */
2701  break;
2703  if (Protected != DEFAULT_PROTECTION) /* already seen one of these? */
2704  {
2705  /* duplicates are invalid */
2707  }
2708  Protected = UNPROTECTED_METHOD; /* flag for later processing */
2709  break;
2710  /* ::METHOD name UNGUARDED */
2712  /* already seen one of these? */
2713  if (guard != DEFAULT_GUARD)
2714  {
2715  /* duplicates are invalid */
2717  }
2718  guard = UNGUARDED_METHOD;/* flag for later processing */
2719  break;
2720  /* ::METHOD name GUARDED */
2721  case SUBDIRECTIVE_GUARDED:
2722  /* already seen one of these? */
2723  if (guard != DEFAULT_GUARD)
2724  {
2725  /* duplicates are invalid */
2727  }
2728  guard = GUARDED_METHOD; /* flag for later processing */
2729  break;
2730  /* ::METHOD name ATTRIBUTE */
2731  case SUBDIRECTIVE_EXTERNAL:
2732  /* already had an external? */
2733  if (externalname != OREF_NULL || abstractMethod)
2734  {
2735  /* duplicates are invalid */
2737  }
2738  token = nextReal(); /* get the next token */
2739  /* not a string? */
2740  if (!token->isLiteral())
2741  {
2742  /* report an error */
2744  }
2745  externalname = token->value;
2746  break;
2747  /* ::METHOD name ABSTRACT */
2748  case SUBDIRECTIVE_ABSTRACT:
2749 
2750  if (abstractMethod || externalname != OREF_NULL)
2751  {
2753  }
2754  abstractMethod = true; /* flag for later processing */
2755  break;
2756 
2757 
2758  default: /* invalid keyword */
2759  /* this is an error */
2761  break;
2762  }
2763  }
2764  }
2765 
2766  // both attributes same default properties?
2767 
2768  // now get a variable retriever to get the property (do this before checking the body
2769  // so errors get diagnosed on the correct line),
2770  RexxVariableBase *retriever = this->getRetriever(name);
2771 
2772  switch (style)
2773  {
2774  case ATTRIBUTE_BOTH:
2775  {
2777  // now get this as the setter method.
2778  RexxString *setterName = commonString(internalname->concatWithCstring("="));
2780 
2781  // no code can follow the automatically generated methods
2783  if (externalname != OREF_NULL)
2784  {
2785  RexxString *library = OREF_NULL;
2786  RexxString *procedure = OREF_NULL;
2787  decodeExternalMethod(internalname, externalname, library, procedure);
2788  // now create both getter and setting methods from the information.
2789  RexxMethod *_method = createNativeMethod(internalname, library, procedure->concatToCstring("GET"));
2790  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2791  // add to the compilation
2792  addMethod(internalname, _method, Class);
2793 
2794  _method = createNativeMethod(setterName, library, procedure->concatToCstring("SET"));
2795  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2796  // add to the compilation
2797  addMethod(setterName, _method, Class);
2798  }
2799  // abstract method?
2800  else if (abstractMethod)
2801  {
2802  // create the method pair and quit.
2803  createAbstractMethod(internalname, Class, Private == PRIVATE_SCOPE,
2804  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2805  createAbstractMethod(setterName, Class, Private == PRIVATE_SCOPE,
2806  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2807  }
2808  else
2809  {
2810  // create the method pair and quit.
2811  createAttributeGetterMethod(internalname, retriever, Class, Private == PRIVATE_SCOPE,
2812  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2813  createAttributeSetterMethod(setterName, retriever, Class, Private == PRIVATE_SCOPE,
2814  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2815  }
2816  break;
2817 
2818  }
2819 
2820  case ATTRIBUTE_GET: // just the getter method
2821  {
2823  // external? resolve the method
2824  if (externalname != OREF_NULL)
2825  {
2826  // no code can follow external methods
2828  RexxString *library = OREF_NULL;
2829  RexxString *procedure = OREF_NULL;
2830  decodeExternalMethod(internalname, externalname, library, procedure);
2831  // if there was no procedure explicitly given, create one using the GET/SET convention
2832  if (internalname == procedure)
2833  {
2834  procedure = procedure->concatToCstring("GET");
2835  }
2836  // now create both getter and setting methods from the information.
2837  RexxMethod *_method = createNativeMethod(internalname, library, procedure);
2838  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2839  // add to the compilation
2840  addMethod(internalname, _method, Class);
2841  }
2842  // abstract method?
2843  else if (abstractMethod)
2844  {
2845  // no code can follow abstract methods
2847  // create the method pair and quit.
2848  createAbstractMethod(internalname, Class, Private == PRIVATE_SCOPE,
2849  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2850  }
2851  // either written in ooRexx or is automatically generated.
2852  else {
2853  if (hasBody())
2854  {
2855  createMethod(internalname, Class, Private == PRIVATE_SCOPE,
2856  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2857  }
2858  else
2859  {
2860  createAttributeGetterMethod(internalname, retriever, Class, Private == PRIVATE_SCOPE,
2861  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2862  }
2863  }
2864  break;
2865  }
2866 
2867  case ATTRIBUTE_SET:
2868  {
2869  // now get this as the setter method.
2870  RexxString *setterName = commonString(internalname->concatWithCstring("="));
2872  // external? resolve the method
2873  if (externalname != OREF_NULL)
2874  {
2875  // no code can follow external methods
2877  RexxString *library = OREF_NULL;
2878  RexxString *procedure = OREF_NULL;
2879  decodeExternalMethod(internalname, externalname, library, procedure);
2880  // if there was no procedure explicitly given, create one using the GET/SET convention
2881  if (internalname == procedure)
2882  {
2883  procedure = procedure->concatToCstring("SET");
2884  }
2885  // now create both getter and setting methods from the information.
2886  RexxMethod *_method = createNativeMethod(setterName, library, procedure);
2887  _method->setAttributes(Private == PRIVATE_SCOPE, Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2888  // add to the compilation
2889  addMethod(setterName, _method, Class);
2890  }
2891  // abstract method?
2892  else if (abstractMethod)
2893  {
2894  // no code can follow abstract methods
2896  // create the method pair and quit.
2897  createAbstractMethod(setterName, Class, Private == PRIVATE_SCOPE,
2898  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2899  }
2900  else
2901  {
2902  if (hasBody()) // just the getter method
2903  {
2904  createMethod(setterName, Class, Private == PRIVATE_SCOPE,
2905  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2906  }
2907  else
2908  {
2909  createAttributeSetterMethod(setterName, retriever, Class, Private == PRIVATE_SCOPE,
2910  Protected == PROTECTED_METHOD, guard != UNGUARDED_METHOD);
2911  }
2912  }
2913  break;
2914  }
2915  }
2916 }
2917 
2918 
2923 {
2924  RexxToken *token = nextReal(); /* get the next token */
2925  /* not a symbol or a string */
2926  if (!token->isSymbolOrLiteral())
2927  {
2928  /* report an error */
2930  }
2931  RexxString *name = token->value; /* get the string name */
2932  /* and the name form also */
2933  RexxString *internalname = this->commonString(name->upper());
2934 
2935  // we only expect just a single value token here
2936  token = nextReal(); /* get the next token */
2937  RexxObject *value;
2938  /* not a symbol or a string */
2939  if (!token->isSymbolOrLiteral())
2940  {
2941  // if not a "+" or "-" operator, this is an error
2942  if (!token->isOperator() || (token->subclass != OPERATOR_SUBTRACT && token->subclass != OPERATOR_PLUS))
2943  {
2944  /* report an error */
2946  }
2947  RexxToken *second = nextReal();
2948  // this needs to be a constant symbol...we check for
2949  // numeric below
2950  if (!second->isSymbol() || second->subclass != SYMBOL_CONSTANT)
2951  {
2952  /* report an error */
2954  }
2955  // concat with the sign operator
2956  value = token->value->concat(second->value);
2957  // and validate that this a valid number
2958  if (value->numberString() == OREF_NULL)
2959  {
2960  /* report an error */
2962  }
2963  }
2964  else
2965  {
2966  // this will be some sort of literal value
2967  value = this->commonString(token->value);
2968  }
2969 
2970  token = nextReal(); /* get the next token */
2971  // No other options on this instruction
2972  if (!token->isEndOfClause())
2973  {
2974  /* report an error */
2976  }
2977  // this directive does not allow a body
2979 
2980  // check for duplicates. We only do the class duplicate check if there
2981  // is an active class, otherwise we'll get a syntax error
2983  if (this->active_class != OREF_NULL)
2984  {
2986  }
2987 
2988  // create the method pair and quit.
2989  createConstantGetterMethod(internalname, value);
2990 }
2991 
2992 
3006 void RexxSource::createMethod(RexxString *name, bool classMethod,
3007  bool privateMethod, bool protectedMethod, bool guardedMethod)
3008 {
3009  // NOTE: It is necessary to translate the block and protect the code
3010  // before allocating the RexxMethod object. The new operator allocates the
3011  // the object first, then evaluates the constructor arguments after the allocation.
3012  // Since the translateBlock() call will allocate a lot of new objects before returning,
3013  // there's a high probability that the method object can get garbage collected before
3014  // there is any opportunity to protect the object.
3015  RexxCode *code = this->translateBlock(OREF_NULL);
3016  this->saveObject((RexxObject *)code);
3017 
3018  /* go do the next block of code */
3019  RexxMethod *_method = new RexxMethod(name, code);
3020  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3021  // go add the method to the accumulator
3022  addMethod(name, _method, classMethod);
3023 }
3024 
3025 
3041  bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
3042 {
3043  // create the kernel method for the accessor
3044  BaseCode *code = new AttributeGetterCode(retriever);
3045  RexxMethod *_method = new RexxMethod(name, code);
3046  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3047  // add this to the target
3048  addMethod(name, _method, classMethod);
3049 }
3050 
3051 
3066  bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
3067 {
3068  // create the kernel method for the accessor
3069  BaseCode *code = new AttributeSetterCode(retriever);
3070  RexxMethod *_method = new RexxMethod(name, code);
3071  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3072  // add this to the target
3073  addMethod(name, _method, classMethod);
3074 }
3075 
3076 
3091  bool classMethod, bool privateMethod, bool protectedMethod, bool guardedMethod)
3092 {
3093  // create the kernel method for the accessor
3094  // this uses a special code block
3095  BaseCode *code = new AbstractCode();
3096  RexxMethod * _method = new RexxMethod(name, code);
3097  _method->setAttributes(privateMethod, protectedMethod, guardedMethod);
3098  // add this to the target
3099  addMethod(name, _method, classMethod);
3100 }
3101 
3102 
3110 {
3111  ConstantGetterCode *code = new ConstantGetterCode(value);
3112  // add this as an unguarded method
3113  RexxMethod *method = new RexxMethod(name, code);
3114  method->setUnguarded();
3115  if (active_class == OREF_NULL)
3116  {
3117  addMethod(name, method, false);
3118  }
3119  else
3120  {
3121  active_class->addConstantMethod(name, method);
3122  }
3123 }
3124 
3125 
3130 {
3131  RexxToken *token = nextReal(); /* get the next token */
3132  /* not a symbol or a string */
3133  if (!token->isSymbolOrLiteral())
3134  {
3135  /* report an error */
3137  }
3138  RexxString *name = token->value; /* get the routine name */
3139  /* does this already exist? */
3140  if (this->routines->entry(name) != OREF_NULL)
3141  {
3142  /* have an error here */
3144  }
3145  this->flags |= _install; /* have information to install */
3146  RexxString *externalname = OREF_NULL; /* no external name yet */
3147  int Public = DEFAULT_ACCESS_SCOPE; /* not a public routine yet */
3148  for (;;) /* now loop on the option keywords */
3149  {
3150  token = nextReal(); /* get the next token */
3151  /* reached the end? */
3152  if (token->isEndOfClause())
3153  {
3154  break; /* get out of here */
3155  }
3156  /* not a symbol token? */
3157  else if (!token->isSymbol())
3158  {
3159  /* report an error */
3161  }
3162  /* process each sub keyword */
3163  switch (this->subDirective(token))
3164  {
3165  /* ::ROUTINE name EXTERNAL []*/
3166  case SUBDIRECTIVE_EXTERNAL:
3167  /* already had an external? */
3168  if (externalname != OREF_NULL)
3169  {
3170  /* duplicates are invalid */
3172  }
3173  token = nextReal(); /* get the next token */
3174  /* not a string? */
3175  if (!token->isLiteral())
3176  {
3177  /* report an error */
3179  }
3180  /* external name is token value */
3181  externalname = token->value;
3182  break;
3183  /* ::ROUTINE name PUBLIC */
3184  case SUBDIRECTIVE_PUBLIC:
3185  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
3186  {
3187  /* duplicates are invalid */
3189 
3190  }
3191  Public = PUBLIC_SCOPE; /* turn on the seen flag */
3192  break;
3193  /* ::ROUTINE name PUBLIC */
3194  case SUBDIRECTIVE_PRIVATE:
3195  if (Public != DEFAULT_ACCESS_SCOPE) /* already had one of these? */
3196  {
3197  /* duplicates are invalid */
3199 
3200  }
3201  Public = PRIVATE_SCOPE; /* turn on the seen flag */
3202  break;
3203 
3204  default: /* invalid keyword */
3205  /* this is an error */
3207  break;
3208  }
3209  }
3210  {
3211  this->saveObject(name); /* protect the name */
3212 
3213  if (externalname != OREF_NULL) /* have an external routine? */
3214  {
3215  /* convert external into words */
3216  RexxArray *_words = this->words(externalname);
3217  // ::ROUTINE foo EXTERNAL "LIBRARY libbar [foo]"
3218  if (((RexxString *)(_words->get(1)))->strCompare(CHAR_LIBRARY))
3219  {
3220  RexxString *library = OREF_NULL;
3221  // the default entry point name is the internal name
3222  RexxString *entry = name;
3223 
3224  // full library with entry name version?
3225  if (_words->size() == 3)
3226  {
3227  library = (RexxString *)_words->get(2);
3228  entry = (RexxString *)_words->get(3);
3229  }
3230  else if (_words->size() == 2)
3231  {
3232  library = (RexxString *)_words->get(2);
3233  }
3234  else // wrong number of tokens
3235  {
3236  /* this is an error */
3238  }
3239 
3240  /* go check the next clause to make */
3241  this->checkDirective(Error_Translation_external_routine); /* sure no code follows */
3242  /* create a new native method */
3243  RoutineClass *routine = PackageManager::resolveRoutine(library, entry);
3244  // raise an exception if this entry point is not found.
3245  if (routine == OREF_NULL)
3246  {
3248  }
3249  // make sure this is attached to the source object for context information
3250  routine->setSourceObject(this);
3251  /* add to the routine directory */
3252  this->routines->setEntry(name, routine);
3253  if (Public == PUBLIC_SCOPE) /* a public routine? */
3254  {
3255  /* add to the public directory too */
3256  this->public_routines->setEntry(name, routine);
3257  }
3258  }
3259 
3260  // ::ROUTINE foo EXTERNAL "REGISTERED libbar [foo]"
3261  else if (((RexxString *)(_words->get(1)))->strCompare(CHAR_REGISTERED))
3262  {
3263  RexxString *library = OREF_NULL;
3264  // the default entry point name is the internal name
3265  RexxString *entry = name;
3266 
3267  // full library with entry name version?
3268  if (_words->size() == 3)
3269  {
3270  library = (RexxString *)_words->get(2);
3271  entry = (RexxString *)_words->get(3);
3272  }
3273  else if (_words->size() == 2)
3274  {
3275  library = (RexxString *)_words->get(2);
3276  }
3277  else // wrong number of tokens
3278  {
3279  /* this is an error */
3281  }
3282 
3283  /* go check the next clause to make */
3284  this->checkDirective(Error_Translation_external_routine); /* sure no code follows */
3285  /* create a new native method */
3286  RoutineClass *routine = PackageManager::resolveRoutine(name, library, entry);
3287  // raise an exception if this entry point is not found.
3288  if (routine == OREF_NULL)
3289  {
3291  }
3292  // make sure this is attached to the source object for context information
3293  routine->setSourceObject(this);
3294  /* add to the routine directory */
3295  this->routines->setEntry(name, routine);
3296  if (Public == PUBLIC_SCOPE) /* a public routine? */
3297  {
3298  /* add to the public directory too */
3299  this->public_routines->setEntry(name, routine);
3300  }
3301  }
3302  else
3303  {
3304  /* unknown external type */
3306  }
3307  }
3308  else
3309  {
3310  // NOTE: It is necessary to translate the block and protect the code
3311  // before allocating the RexxMethod object. The new operator allocates the
3312  // the object first, then evaluates the constructor arguments after the allocation.
3313  // Since the translateBlock() call will allocate a lot of new objects before returning,
3314  // there's a high probability that the method object can get garbage collected before
3315  // there is any opportunity to protect the object.
3316  RexxCode *code = this->translateBlock(OREF_NULL);
3317  this->saveObject((RexxObject *)code);
3318  RoutineClass *routine = new RoutineClass(name, code);
3319  /* add to the routine directory */
3320  this->routines->setEntry(name, routine);
3321  if (Public == PUBLIC_SCOPE) /* a public routine? */
3322  {
3323  /* add to the public directory too */
3324  this->public_routines->setEntry(name, routine);
3325 
3326  }
3327  }
3328  this->toss(name); /* release the "Gary Cole" (GC) lock */
3329  }
3330 }
3331 
3336 {
3337  RexxToken *token = nextReal(); /* get the next token */
3338  /* not a symbol or a string */
3339  if (!token->isSymbolOrLiteral())
3340  {
3341  /* report an error */
3343  }
3344  RexxString *name = token->value; /* get the requires name */
3345  token = nextReal(); /* get the next token */
3346  if (!token->isEndOfClause()) /* something appear after this? */
3347  {
3348  // this is potentially a library directive
3349  libraryDirective(name, token);
3350  return;
3351  }
3352  this->flags |= _install; /* have information to install */
3353  /* save the ::requires location */
3354  this->requires->append((RexxObject *)new RequiresDirective(name, this->clause));
3355 }
3356 
3357 
3362 {
3363  // we have an extra token on a ::REQUIRES directive. The only thing accepted here
3364  // is the token LIBRARY.
3365  if (!token->isSymbol())
3366  {
3368  }
3369  /* process each sub keyword */
3370  if (subDirective(token) != SUBDIRECTIVE_LIBRARY)
3371  {
3373  }
3374  token = nextReal(); /* get the next token */
3375  if (!token->isEndOfClause()) /* something appear after this? */
3376  {
3377  // nothing else allowed after this
3379  }
3380  this->flags |= _install; /* have information to install */
3381  // add this to the library list
3382  this->libraries->append((RexxObject *)new LibraryDirective(name, this->clause));
3383 }
3384 
3385 
3387 /********************************************************************/
3388 /* Function: parse a directive statement */
3389 /********************************************************************/
3390 {
3391  RexxToken *token; /* current token under processing */
3392 
3393  this->nextClause(); /* get the directive clause */
3394  if (this->flags&no_clause) /* reached the end? */
3395  return; /* all finished */
3396  token = nextReal(); /* skip the leading :: */
3397  if (token->classId != TOKEN_DCOLON) /* reached the end of a block? */
3398  /* have an error here */
3400  token = nextReal(); /* get the keyword token */
3401  if (!token->isSymbol()) /* not a symbol? */
3402  /* have an error here */
3404 
3405  switch (this->keyDirective(token))
3406  { /* match against the directive list */
3407 
3408  case DIRECTIVE_CLASS: /* ::CLASS directive */
3409  classDirective();
3410  break;
3411 
3412  case DIRECTIVE_METHOD: /* ::METHOD directive */
3413  methodDirective();
3414  break;
3415 
3416  case DIRECTIVE_ROUTINE: /* ::ROUTINE directive */
3417  routineDirective();
3418  break;
3419 
3420  case DIRECTIVE_REQUIRES: /* ::REQUIRES directive */
3422  break;
3423 
3424  case DIRECTIVE_ATTRIBUTE: /* ::ATTRIBUTE directive */
3426  break;
3427 
3428  case DIRECTIVE_CONSTANT: /* ::CONSTANT directive */
3430  break;
3431 
3432  case DIRECTIVE_OPTIONS: /* ::OPTIONS directive */
3433  optionsDirective();
3434  break;
3435 
3436  default: /* unknown directive */
3438  break;
3439  }
3440 }
3441 
3442 
3444  RexxInstruction *_instruction) /* next instruction */
3445 /******************************************************************************/
3446 /* Function: Flush any pending compound instructions from the control stack */
3447 /* for new added instructions */
3448 /******************************************************************************/
3449 {
3450  size_t type; /* instruction type */
3451  RexxInstruction *second; /* additional created instructions */
3452 
3453  /* loop through the control stack */
3454  for (;;)
3455  {
3456  type = this->topDo()->getType(); /* get the instruction type */
3457  /* pending ELSE close? */
3458  if (type == KEYWORD_ELSE)
3459  {
3460  second = this->popDo(); /* pop the item off of the control */
3461  /* create a new end marker */
3462  second = this->endIfNew((RexxInstructionIf *)second);
3463  /* have an instruction? */
3464  if (_instruction != OREF_NULL)
3465  {
3466  this->addClause(_instruction); /* add this here */
3467  _instruction = OREF_NULL; /* don't process more instructions */
3468  }
3469  this->addClause(second); /* add the clause to the list */
3470  }
3471  /* nested IF-THEN situation? */
3472  else if (type == KEYWORD_IFTHEN || type == KEYWORD_WHENTHEN)
3473  {
3474  second = this->popDo(); /* pop the item off of the control */
3475  /* have an instruction? */
3476  if (_instruction != OREF_NULL)
3477  {
3478  this->addClause(_instruction); /* add this here */
3479  _instruction = OREF_NULL; /* don't process more instructions */
3480  /* create a new end marker */
3481  second = this->endIfNew((RexxInstructionIf *)second);
3482  this->addClause(second); /* add the clause to the list */
3483  this->pushDo(second); /* add to the control stack too */
3484  }
3485  else
3486  {
3487  /* create a new end marker */
3488  second = this->endIfNew((RexxInstructionIf *)second);
3489  this->addClause(second); /* add the clause to the list */
3490  this->pushDo(second); /* add to the control stack too */
3491  }
3492  break; /* finish up here */
3493  }
3494  /* some other type of construct */
3495  else
3496  {
3497  if (_instruction != OREF_NULL) /* have an instruction? */
3498  {
3499  this->addClause(_instruction); /* add this here */
3500  }
3501  break; /* finished flushing */
3502  }
3503  }
3504 }
3505 
3507  RexxDirectory *_labels ) /* labels (for interpret) */
3508 /******************************************************************************/
3509 /* Function: Translate a block of REXX code (delimited by possible */
3510 /* directive instructions */
3511 /******************************************************************************/
3512 {
3513  RexxInstruction *_instruction; /* created instruction item */
3514  RexxInstruction *second; /* secondary clause for IF/WHEN */
3515  RexxToken *token; /* current working token */
3516  size_t type; /* instruction type information */
3517  size_t controltype; /* type on the control stack */
3518 
3519  /* no instructions yet */
3520  OrefSet(this, this->first, OREF_NULL);
3521  OrefSet(this, this->last, OREF_NULL);
3522  /* allocate the call list */
3523  OrefSet(this, this->calls, new_list());
3524  /* create variables and lit tables */
3525  OrefSet(this, this->variables, (RexxDirectory *)TheCommonRetrievers->copy());
3526  /* restart the variable index */
3528  OrefSet(this, this->exposed_variables, new_directory());
3529  if (this->flags&_interpret) /* this an interpret? */
3530  {
3531  /* just use the existing label set */
3532  OrefSet(this, this->labels, _labels);
3533  }
3534  else
3535  {
3536  /* create a new labels directory */
3537  OrefSet(this, this->labels, new_directory());
3538  }
3539  /* not collecting guard variables yet*/
3540  OrefSet(this, this->guard_variables, OREF_NULL);
3541  this->maxstack = 0; /* clear all of the stack accounting */
3542  this->currentstack = 0; /* fields */
3543  this->flags &= ~no_clause; /* not reached the end yet */
3544 
3545  /* add the first dummy instruction */
3546  _instruction = new RexxInstruction(OREF_NULL, KEYWORD_FIRST);
3547  this->pushDo(_instruction); /* set bottom of control stack */
3548  this->addClause(_instruction); /* add to the instruction list */
3549  this->nextClause(); /* get the next physical clause */
3550  for (;;) /* process all clauses */
3551  {
3552  _instruction = OREF_NULL; /* zero the instruction pointer */
3553  while (!(this->flags&no_clause)) /* scan through all labels */
3554  {
3555  /* resolve the instruction type */
3556  _instruction = this->instruction();
3557  if (_instruction == OREF_NULL) /* found a directive clause? */
3558  {
3559  break; /* return to higher level */
3560  }
3561  /* is this a label? */
3562  if (_instruction->getType() != KEYWORD_LABEL)
3563  {
3564  break; /* have a non-label clause */
3565  }
3566  this->addClause(_instruction); /* add this to clause list */
3567  this->nextClause(); /* get the next physical clause */
3568  _instruction = OREF_NULL; /* no instruction any more */
3569  }
3570  /* get an end-of-clause? */
3571  if (this->flags&no_clause || _instruction == OREF_NULL)
3572  {
3573  /* get the control stack type */
3574  controltype = this->topDo()->getType();
3575  /* while end of an IF or WHEN */
3576  while (controltype == KEYWORD_ENDTHEN || controltype == KEYWORD_ENDWHEN)
3577  {
3578  this->popDo(); /* pop pending closing IFs */
3579  this->flushControl(OREF_NULL); /* flush any IFs or ELSEs */
3580  /* get the control stack type */
3581  controltype = this->topDo()->getType();
3582  }
3583  /* any unclosed composite clauses? */
3584  if (this->topDo()->getType() != KEYWORD_FIRST)
3585  {
3586  /* report the block error */
3587  blockSyntaxError(this->topDo());
3588  }
3589  this->popDo(); /* remove the top one */
3590  break; /* done parsing this section */
3591  }
3592  type = _instruction->getType(); /* get the top instruction type */
3593  if (type != KEYWORD_ELSE) /* have a pending THEN to finish */
3594  {
3595  /* get the control stack type */
3596  controltype = this->topDo()->getType();
3597  /* while end of an IF or WHEN */
3598  while (controltype == KEYWORD_ENDTHEN || controltype == KEYWORD_ENDWHEN)
3599  {
3600  this->popDo(); /* pop pending closing IFs */
3601  this->flushControl(OREF_NULL); /* flush any IFs or ELSEs */
3602  /* get the control stack type */
3603  controltype = this->topDo()->getType();
3604  }
3605  }
3606  if (type == KEYWORD_IF || type == KEYWORD_SELECT || type == KEYWORD_DO || type == KEYWORD_LOOP)
3607  {
3608  this->addClause(_instruction); /* add to instruction heap */
3609  }
3610  else if (type != KEYWORD_ELSE) /* not a new control level */
3611  {
3612  this->flushControl(_instruction); /* flush any IFs or ELSEs */
3613  }
3614  /* have a bad instruction within a */
3615  /* SELECT instruction? */
3616  if (this->topDo()->getType() == KEYWORD_SELECT &&
3618  {
3620  }
3621 
3622  switch (type) /* post process the instructions */
3623  {
3624  case KEYWORD_WHEN: /* WHEN clause of SELECT */
3625  second = this->topDo(); /* get the top of the queue */
3626  /* not working on a SELECT? */
3627  if (second->getType() != KEYWORD_SELECT)
3628  {
3630  }
3631  /* add this to the select list */
3632  ((RexxInstructionSelect *)second)->addWhen((RexxInstructionIf *)_instruction);
3633  /* just fall into IF logic */
3634 
3635  case KEYWORD_IF: /* start of an IF instruction */
3636  token = nextReal(); /* get the terminator token */
3637  /* have a terminator before the THEN?*/
3638  if (token->isEndOfClause())
3639  {
3640  this->nextClause(); /* get the next physical clause */
3641  if (this->flags&no_clause) /* get an end-of-file? */
3642  {
3643  /* raise an error */
3644  syntaxError(Error_Then_expected_if, _instruction);
3645  }
3646  token = nextReal(); /* get the first token */
3647  /* not a THEN keyword? */
3648  if (!token->isSymbol() || this->keyword(token) != KEYWORD_THEN)
3649  {
3650  /* have an error */
3651  syntaxError(Error_Then_expected_if, _instruction);
3652  }
3653  /* create a new then clause */
3654  second = this->thenNew(token, (RexxInstructionIf *)_instruction);
3655  token = nextReal(); /* get token after THEN keyword */
3656  /* terminator here? */
3657  if (token->isEndOfClause())
3658  {
3659  this->nextClause(); /* get the next physical clause */
3660  if (this->flags&no_clause) /* get an end-of-file? */
3661  {
3662  /* raise an error */
3663  syntaxError(Error_Incomplete_do_then, _instruction);
3664  }
3665  }
3666  else
3667  {
3668  previousToken(); /* step back a token */
3669  trimClause(); /* make this start of the clause */
3670  }
3671  }
3672  else /* if expr THEN form */
3673  {
3674  /* create a new then clause */
3675  second = this->thenNew(token, (RexxInstructionIf *)_instruction);
3676  token = nextReal(); /* get token after THEN keyword */
3677  /* terminator here? */
3678  if (token->isEndOfClause())
3679  {
3680  this->nextClause(); /* get the next physical clause */
3681  if (this->flags&no_clause) /* get an end-of-file? */
3682  {
3683  /* raise an error */
3684  syntaxError(Error_Incomplete_do_then, _instruction);
3685  }
3686  }
3687  else
3688  {
3689  previousToken(); /* step back a token */
3690  trimClause(); /* make this start of the clause */
3691  }
3692  }
3693  this->addClause(second); /* add this to the instruction list */
3694  this->pushDo(second); /* add to top of control queue */
3695  continue; /* straight around to process clause */
3696  /* remainder */
3697  case KEYWORD_ELSE: /* have an ELSE instruction */
3698  second = this->topDo(); /* get the top block */
3699  if (this->topDo()->getType() != KEYWORD_ENDTHEN)
3700  {
3701  /* have an error */
3703  }
3704  this->addClause(_instruction); /* add to instruction heap */
3705  second = this->popDo(); /* pop the ENDTHEN item */
3706  this->pushDo(_instruction); /* add to the control list */
3707  /* join the THEN and ELSE together */
3708  ((RexxInstructionElse *)_instruction)->setParent((RexxInstructionEndIf *)second);
3709  ((RexxInstructionEndIf *)second)->setEndInstruction((RexxInstructionEndIf *)_instruction);
3710  token = nextReal(); /* get the next token */
3711  /* have an ELSE keyword alone? */
3712  if (token->isEndOfClause())
3713  {
3714  this->nextClause(); /* get the next physical clause */
3715  if (this->flags&no_clause) /* get an end-of-file? */
3716  {
3717  /* raise an error */
3718  syntaxError(Error_Incomplete_do_else, _instruction);
3719  }
3720  }
3721  else /* ELSE instruction form */
3722  {
3723  previousToken(); /* step back a token */
3724  trimClause(); /* make this start of the clause */
3725  }
3726  continue; /* straight around to process clause */
3727  /* remainder */
3728 
3729  case KEYWORD_OTHERWISE: /* start of an OTHERWISE group */
3730  second = this->topDo(); /* get the top of the queue */
3731  /* not working on a SELECT? */
3732  if (second->getType() != KEYWORD_SELECT)
3733  {
3735  }
3736  /* hook up the OTHERWISE instruction */
3737  ((RexxInstructionSelect *)second)->setOtherwise((RexxInstructionOtherwise *)_instruction);
3738  this->pushDo(_instruction); /* add this to the control queue */
3739  token = nextReal(); /* get the next token */
3740  /* OTHERWISE instr form? */
3741  if (!token->isEndOfClause())
3742  {
3743  previousToken(); /* step back a token */
3744  trimClause(); /* make this start of the clause */
3745  continue; /* straight around to process clause */
3746  /* remainder */
3747  }
3748  break; /* normal OTHERWISE processing */
3749 
3750 
3751  case KEYWORD_END: /* END instruction for DO or SELECT */
3752  second = this->popDo(); /* get the top of the queue */
3753  type = second->getType(); /* get the instruction type */
3754  /* not working on a block? */
3756  {
3757  if (type == KEYWORD_ELSE) /* on an else? */
3758  {
3759  /* give the specific error */
3761  }
3762  else if (type == KEYWORD_IFTHEN || type == KEYWORD_WHENTHEN)
3763  {
3764  /* this is a different error */
3766  }
3767  else
3768  {
3769  /* have a misplaced END */
3771  }
3772  }
3773  if (type == KEYWORD_OTHERWISE) /* OTHERWISE part of a SELECT? */
3774  {
3775  second = this->popDo(); /* need to pop one more item off */
3776  }
3777  /* matching a select? */
3778  if (second->getType() == KEYWORD_SELECT)
3779  {
3780  /* match up the instruction */
3781  ((RexxInstructionSelect *)second)->matchEnd((RexxInstructionEnd *)_instruction, this);
3782  }
3783  else /* must be a DO block */
3784  {
3785  /* match up the instruction */
3786  ((RexxInstructionDo *)second)->matchEnd((RexxInstructionEnd *)_instruction, this);
3787  }
3788  this->flushControl(OREF_NULL); /* finish pending IFs or ELSEs */
3789  break;
3790 
3791  case KEYWORD_DO: // start of new DO group (also picks up LOOP instruction)
3792  case KEYWORD_LOOP:
3793  this->pushDo(_instruction); /* add this to the control queue */
3794  break;
3795 
3796  case KEYWORD_SELECT: /* start of new SELECT group */
3797  this->pushDo(_instruction); /* and also to the control queue */
3798  break;
3799 
3800  default: /* other types of instruction */
3801  break;
3802  }
3803  this->nextClause(); /* get the next physical clause */
3804  }
3805  /* now go resolve any label targets */
3806  _instruction = (RexxInstruction *)(this->calls->removeFirst());
3807  /* while still more references */
3808  while (_instruction != (RexxInstruction *)TheNilObject)
3809  {
3810  /* actually a function call? */
3811  if (isOfClass(FunctionCallTerm, _instruction))
3812  {
3813  /* resolve the function call */
3814  ((RexxExpressionFunction *)_instruction)->resolve(this->labels);
3815  }
3816  else
3817  {
3818  /* resolve the CALL/SIGNAL/FUNCTION */
3819  /* label targets */
3820  ((RexxInstructionCallBase *)_instruction)->resolve(this->labels);
3821  }
3822  /* now get the next instruction */
3823  _instruction = (RexxInstruction *)(this->calls->removeFirst());
3824  }
3825  /* remove the first instruction */
3826  OrefSet(this, this->first, this->first->nextInstruction);
3827  /* no labels needed? */
3828  if (this->labels != OREF_NULL && this->labels->items() == 0)
3829  {
3830  /* release that directory also */
3831  OrefSet(this, this->labels, OREF_NULL);
3832  }
3833  /* create a rexx code object */
3834  return new RexxCode(this, this->first, this->labels, (this->maxstack+ 10), this->variableindex);
3835 }
3836 
3838 /******************************************************************************/
3839 /* Function: Process an individual REXX clause */
3840 /******************************************************************************/
3841 {
3842  RexxToken *_first; /* first token of clause */
3843  RexxToken *second; /* second token of clause */
3844  RexxInstruction *_instruction; /* current working instruction */
3845  RexxObject *term; /* term for a message send */
3846  RexxObject *subexpression; /* subexpression of a clause */
3847  int _keyword; /* resolved instruction keyword */
3848 
3849  _instruction = OREF_NULL; /* default to no instruction found */
3850  _first = nextReal(); /* get the first token */
3851 
3852  if (_first->classId == TOKEN_DCOLON)
3853  {/* reached the end of a block? */
3854  firstToken(); /* reset the location */
3855  this->reclaimClause(); /* give back the clause */
3856  }
3857  else
3858  { /* have a real instruction to process*/
3859  second = nextToken(); /* now get the second token */
3860  /* is this a label? (can be either */
3861  /* a symbol or a literal) */
3862  if ((_first->classId == TOKEN_SYMBOL || _first->classId == TOKEN_LITERAL) && second->classId == TOKEN_COLON)
3863  {
3864  if (this->flags&_interpret) /* is this an interpret? */
3865  {
3866  /* this is an error */
3868  }
3869  firstToken(); /* reset to the beginning */
3870  _instruction = this->labelNew(); /* create a label instruction */
3871  second = nextToken(); /* get the next token */
3872  /* not the end of the clause? */
3873  if (!second->isEndOfClause())
3874  {
3875  previousToken(); /* give this token back */
3876  trimClause(); /* make this start of the clause */
3877  this->reclaimClause(); /* give the remaining clause back */
3878  }
3879  return _instruction;
3880  }
3881 
3882  // this is potentially an assignment of the form "symbol = expr"
3883  if (_first->isSymbol())
3884  {
3885  // "symbol == expr" is considered an error
3886  if (second->subclass == OPERATOR_STRICT_EQUAL)
3887  {
3889  }
3890  // true assignment instruction?
3891  if (second->subclass == OPERATOR_EQUAL)
3892  {
3893  return this->assignmentNew(_first);
3894  }
3895  // this could be a special assignment operator such as "symbol += expr"
3896  else if (second->classId == TOKEN_ASSIGNMENT)
3897  {
3898  return this->assignmentOpNew(_first, second);
3899  }
3900  // other
3901 
3902  }
3903 
3904  /* some other type of instruction */
3905  /* we need to skip over the first */
3906  /* term of the instruction to */
3907  /* determine the type of clause, */
3908  /* including recognition of keyword */
3909  /* instructions */
3910  firstToken(); /* reset to the first token */
3911  term = this->messageTerm(); /* get the first term of instruction */
3912  second = nextToken(); /* get the next token */
3913 
3914 
3915  // some sort of recognizable message term? Need to check for the
3916  // special cases.
3917  if (term != OREF_NULL)
3918  {
3919  // if parsing the message term consumed everything, this is a message instruction
3920  if (second->isEndOfClause())
3921  {
3922  return this->messageNew((RexxExpressionMessage *)term);
3923  }
3924  else if (second->subclass == OPERATOR_STRICT_EQUAL)
3925  {
3926  // messageterm == something is an invalid assignment
3928  }
3929  // messageterm = something is a pseudo assignment
3930  else if (second->subclass == OPERATOR_EQUAL)
3931  {
3932  this->saveObject(term); /* protect this */
3933  // we need an expression following the op token
3934  subexpression = this->subExpression(TERM_EOC);
3935  if (subexpression == OREF_NULL)
3936  {
3938  }
3939  // this is a message assignment
3940  _instruction = this->messageAssignmentNew((RexxExpressionMessage *)term, subexpression);
3941  this->toss(term); /* release the term */
3942  return _instruction;
3943  }
3944  // one of the special operator forms?
3945  else if (second->classId == TOKEN_ASSIGNMENT)
3946  {
3947  this->saveObject(term); /* protect this */
3948  // we need an expression following the op token
3949  subexpression = this->subExpression(TERM_EOC);
3950  if (subexpression == OREF_NULL)
3951  {
3953  }
3954  // this is a message assignment
3955  _instruction = this->messageAssignmentOpNew((RexxExpressionMessage *)term, second, subexpression);
3956  this->toss(term); /* release the term */
3957  return _instruction;
3958  }
3959  }
3960 
3961  // ok, none of the special cases passed....not start the keyword processing
3962 
3963  firstToken(); /* reset to the first token */
3964  _first = nextToken(); /* get the first token again */
3965  /* is first a symbol that matches a */
3966  /* defined REXX keyword? */
3967  if (_first->isSymbol() && (_keyword = this->keyword(_first)))
3968  {
3969 
3970  switch (_keyword)
3971  { /* process each instruction type */
3972 
3973  case KEYWORD_NOP: /* NOP instruction */
3974  /* add the instruction to the parse */
3975  _instruction = this->nopNew();
3976  break;
3977 
3978  case KEYWORD_DROP: /* DROP instruction */
3979  /* add the instruction to the parse */
3980  _instruction = this->dropNew();
3981  break;
3982 
3983  case KEYWORD_SIGNAL: /* various forms of SIGNAL */
3984  /* add the instruction to the parse */
3985  _instruction = this->signalNew();
3986  break;
3987 
3988  case KEYWORD_CALL: /* various forms of CALL */
3989  /* add the instruction to the parse */
3990  _instruction = this->callNew();
3991  break;
3992 
3993  case KEYWORD_RAISE: /* RAISE instruction */
3994  /* add the instruction to the parse */
3995  _instruction = this->raiseNew();
3996  break;
3997 
3998  case KEYWORD_ADDRESS: /* ADDRESS instruction */
3999  /* add the instruction to the parse */
4000  _instruction = this->addressNew();
4001  break;
4002 
4003  case KEYWORD_NUMERIC: /* NUMERIC instruction */
4004  /* add the instruction to the parse */
4005  _instruction = this->numericNew();
4006  break;
4007 
4008  case KEYWORD_TRACE: /* TRACE instruction */
4009  /* add the instruction to the parse */
4010  _instruction = this->traceNew();
4011  break;
4012 
4013  case KEYWORD_DO: /* all variations of DO instruction */
4014  /* add the instruction to the parse */
4015  _instruction = this->doNew();
4016  break;
4017 
4018  case KEYWORD_LOOP: /* all variations of LOOP instruction */
4019  /* add the instruction to the parse */
4020  _instruction = this->loopNew();
4021  break;
4022 
4023  case KEYWORD_EXIT: /* EXIT instruction */
4024  /* add the instruction to the parse */
4025  _instruction = this->exitNew();
4026  break;
4027 
4028  case KEYWORD_INTERPRET: /* INTERPRET instruction */
4029  /* add the instruction to the parse */
4030  _instruction = this->interpretNew();
4031  break;
4032 
4033  case KEYWORD_PUSH: /* PUSH instruction */
4034  /* add the instruction to the parse */
4035  _instruction = this->queueNew(QUEUE_LIFO);
4036  break;
4037 
4038  case KEYWORD_QUEUE: /* QUEUE instruction */
4039  /* add the instruction to the parse */
4040  _instruction = this->queueNew(QUEUE_FIFO);
4041  break;
4042 
4043  case KEYWORD_REPLY: /* REPLY instruction */
4044  /* interpreted? */
4045  if (this->flags&_interpret)
4047  /* add the instruction to the parse */
4048  _instruction = this->replyNew();
4049  break;
4050 
4051  case KEYWORD_RETURN: /* RETURN instruction */
4052  /* add the instruction to the parse */
4053  _instruction = this->returnNew();
4054  break;
4055 
4056  case KEYWORD_IF: /* IF instruction */
4057  /* add the instruction to the parse */
4058  _instruction = this->ifNew(KEYWORD_IF);
4059  break;
4060 
4061  case KEYWORD_ITERATE: /* ITERATE instruction */
4062  /* add the instruction to the parse */
4063  _instruction = this->leaveNew(KEYWORD_ITERATE);
4064  break;
4065 
4066  case KEYWORD_LEAVE: /* LEAVE instruction */
4067  /* add the instruction to the parse */
4068  _instruction = this->leaveNew(KEYWORD_LEAVE);
4069  break;
4070 
4071  case KEYWORD_EXPOSE: /* EXPOSE instruction */
4072  /* interpreted? */
4073  if (this->flags&_interpret)
4075  /* add the instruction to the parse */
4076  _instruction = this->exposeNew();
4077  break;
4078 
4079  case KEYWORD_FORWARD: /* FORWARD instruction */
4080  /* interpreted? */
4081  if (this->flags&_interpret)
4083  /* add the instruction to the parse */
4084  _instruction = this->forwardNew();
4085  break;
4086 
4087  case KEYWORD_PROCEDURE: /* PROCEDURE instruction */
4088  /* add the instruction to the parse */
4089  _instruction = this->procedureNew();
4090  break;
4091 
4092  case KEYWORD_GUARD: /* GUARD instruction */
4093  /* interpreted? */
4094  if (this->flags&_interpret)
4096  /* add the instruction to the parse */
4097  _instruction = this->guardNew();
4098  break;
4099 
4100  case KEYWORD_USE: /* USE instruction */
4101  /* interpreted? */
4102  if (this->flags&_interpret)
4104  /* add the instruction to the parse */
4105  _instruction = this->useNew();
4106  break;
4107 
4108  case KEYWORD_ARG: /* ARG instruction */
4109  /* add the instruction to the parse */
4110  _instruction = this->parseNew(SUBKEY_ARG);
4111  break;
4112 
4113  case KEYWORD_PULL: /* PULL instruction */
4114  /* add the instruction to the parse */
4115  _instruction = this->parseNew(SUBKEY_PULL);
4116  break;
4117 
4118  case KEYWORD_PARSE: /* PARSE instruction */
4119  /* add the instruction to the parse */
4120  _instruction = this->parseNew(KEYWORD_PARSE);
4121  break;
4122 
4123  case KEYWORD_SAY: /* SAY instruction */
4124  /* add the instruction to the parse */
4125  _instruction = this->sayNew();
4126  break;
4127 
4128  case KEYWORD_OPTIONS: /* OPTIONS instruction */
4129  /* add the instruction to the parse */
4130  _instruction = this->optionsNew();
4131  break;
4132 
4133  case KEYWORD_SELECT: /* SELECT instruction */
4134  /* add the instruction to the parse */
4135  _instruction = this->selectNew();
4136  break;
4137 
4138  case KEYWORD_WHEN: /* WHEN in an SELECT instruction */
4139  /* add the instruction to the parse */
4140  _instruction = this->ifNew(KEYWORD_WHEN);
4141  break;
4142 
4143  case KEYWORD_OTHERWISE: /* OTHERWISE in a SELECT */
4144  /* add the instruction to the parse */
4145  _instruction = this->otherwiseNew(_first);
4146  break;
4147 
4148  case KEYWORD_ELSE: /* unexpected ELSE */
4149  /* add the instruction to the parse */
4150  _instruction = this->elseNew(_first);
4151  break;
4152 
4153  case KEYWORD_END: /* END for a block construct */
4154  /* add the instruction to the parse */
4155  _instruction = this->endNew();
4156  break;
4157 
4158  case KEYWORD_THEN: /* unexpected THEN */
4159  /* raise an error */
4161  break;
4162 
4163  }
4164  }
4165  else
4166  { /* this is a "command" instruction */
4167  firstToken(); /* reset to the first token */
4168  /* process this instruction */
4169  _instruction = this->commandNew();
4170  }
4171  }
4172  return _instruction; /* return the created instruction */
4173 }
4174 
4176  RexxString *varname) /* variable to add */
4177 /******************************************************************************/
4178 /* Function: Resolve a variable name to a single common retriever object */
4179 /* per method */
4180 /******************************************************************************/
4181 {
4182  /* check the directory for an entry */
4183  RexxVariableBase *retriever = (RexxVariableBase *)this->variables->fastAt(varname);
4184  if (retriever == OREF_NULL) /* not in the table yet? */
4185  {
4186  if (!(this->flags&_interpret)) /* not in an interpret? */
4187  {
4188  this->variableindex++; /* step the counter */
4189  /* create a new variable retriever */
4190  retriever = new RexxParseVariable(varname, this->variableindex);
4191  }
4192  else /* force dynamic lookup each time */
4193  {
4194  retriever = new RexxParseVariable(varname, 0);
4195  }
4196  /* add to the variable table */
4197  this->variables->put((RexxObject *)retriever, varname);
4198  }
4199  /* collecting guard variables? */
4200  if (this->guard_variables != OREF_NULL)
4201  {
4202  /* in the list of exposed variables? */
4203  if (this->exposed_variables != OREF_NULL && this->exposed_variables->fastAt(varname) != OREF_NULL)
4204  {
4205  /* add this to the guard list */
4206  this->guard_variables->put((RexxObject *)retriever, (RexxObject *)retriever);
4207  }
4208  }
4209  return retriever; /* return variable accesser */
4210 }
4211 
4213  RexxString *stemName) /* stem to add */
4214 /******************************************************************************/
4215 /* Function: Process creation of stem variables */
4216 /******************************************************************************/
4217 {
4218  /* check the table for an entry */
4219  RexxStemVariable *retriever = (RexxStemVariable *)(this->variables->fastAt(stemName));
4220  if (retriever == OREF_NULL) /* not in the table yet? */
4221  {
4222  if (!(this->flags&_interpret)) /* not in an interpret? */
4223  {
4224  this->variableindex++; /* step the counter */
4225  /* create a new variable retriever */
4226  retriever = new RexxStemVariable(stemName, this->variableindex);
4227  }
4228  else /* force dynamic lookup each time */
4229  {
4230  retriever = new RexxStemVariable(stemName, 0);
4231  }
4232  /* add to the variable table */
4233  this->variables->put((RexxObject *)retriever, stemName);
4234  }
4235  /* collecting guard variables? */
4236  if (this->guard_variables != OREF_NULL)
4237  {
4238  /* in the list of exposed variables? */
4239  if (this->exposed_variables != OREF_NULL && this->exposed_variables->fastAt(stemName) != OREF_NULL)
4240  {
4241  /* add this to the guard list */
4242  this->guard_variables->put((RexxObject *)retriever, (RexxObject *)retriever);
4243  }
4244  }
4245  return retriever; /* return variable accesser */
4246 }
4247 
4248 
4250  RexxString *name) /* name of the compound variable */
4251 /******************************************************************************/
4252 /* Function: Parse to completion a compound variable */
4253 /******************************************************************************/
4254 {
4255  RexxStemVariable *stemRetriever; /* retriever for the stem value */
4256  RexxString *stemName; /* stem part of compound variable */
4257  RexxString *tail; /* tail section string value */
4258  const char * start; /* starting scan position */
4259  size_t length; /* length of tail section */
4260  const char * _position; /* current position */
4261  const char * end; // the end scanning position
4262  size_t tailCount; /* count of tails in compound */
4263 
4264  length = name->getLength(); /* get the string length */
4265  _position = name->getStringData(); /* start scanning at first character */
4266  start = _position; /* save the starting point */
4267  end = _position + length; // save our end marker
4268 
4269  // we know this is a compound, so there must be at least one period.
4270  /* scan to the first period */
4271  while (*_position != '.')
4272  {
4273  _position++; /* step to the next character */
4274  }
4275  /* get the stem string */
4276  stemName = new_string(start, _position - start + 1);
4277  stemRetriever = this->addStem(stemName); /* get a retriever item for this */
4278 
4279  tailCount = 0; /* no tails yet */
4280  do /* process rest of the variable */
4281  {
4282  // we're here because we just saw a previous period. that's either the
4283  // stem variable period or the last tail element we processed.
4284  // either way, we step past it. If this period is a trailing one,
4285  // we'll add a null tail element, which is exactly what we want.
4286  _position++; /* step past previous period */
4287  start = _position; /* save the start position */
4288  /* scan for the next period */
4289  while (_position < end)
4290  {
4291  if (*_position == '.') // found the next one?
4292  {
4293  break; // stop scanning now
4294  }
4295  _position++; // continue looking
4296  }
4297  /* extract the tail piece */
4298  tail = new_string(start, _position - start);
4299  /* have a null tail piece or */
4300  /* section begin with a digit? */
4301  if (!(tail->getLength() == 0 || (*start >= '0' && *start <= '9')))
4302  {
4303  /* push onto the term stack */
4304  this->subTerms->push((RexxObject *)(this->addVariable(tail)));
4305  }
4306  else
4307  {
4308  /* just use the string value directly*/
4309  this->subTerms->push(this->commonString(tail));
4310  }
4311  tailCount++; /* up the tail count */
4312  } while (_position < end);
4313  /* finally, create the compound var */
4314  return new (tailCount) RexxCompoundVariable(stemName, stemRetriever->index, this->subTerms, tailCount);
4315 }
4316 
4317 
4319  RexxString *name ) /* variable name to add to list */
4320 /******************************************************************************/
4321 /* Function: Add a variable name to the list of exposed variables for the */
4322 /* method. */
4323 /******************************************************************************/
4324 {
4325  /* add to the exposed variables list */
4326  this->exposed_variables->put(name, name);
4327 }
4328 
4329 
4331  RexxString *string ) /* string token to "collapse" */
4332 /******************************************************************************/
4333 /* Function: Compress all string tokens needed by a group of programs into */
4334 /* a single, common set of strings. */
4335 /******************************************************************************/
4336 {
4337  /* check the global table first */
4338  RexxString *result = (RexxString *)this->strings->fastAt(string);
4339  /* not in the table */
4340  if (result == OREF_NULL)
4341  {
4342  this->strings->put(string, string);/* add this to the table */
4343  result = string; /* also the final value */
4344  }
4345  return result; /* return the string */
4346 }
4347 
4348 
4350 {
4351  needVariable(token);
4352  return addText(token);
4353 }
4354 
4355 
4357  RexxToken *token) /* token to process */
4358 /******************************************************************************/
4359 /* Function: Generalized text token addition */
4360 /******************************************************************************/
4361 {
4362  RexxObject *retriever; /* created retriever */
4363  RexxObject *value; /* evaluated literal value */
4364 
4365  RexxString *name = token->value; /* get the string value for this */
4366  switch (token->classId)
4367  {
4368 
4369  case TOKEN_SYMBOL: /* various types of symbols */
4370  /* each symbol subtype requires a */
4371  /* different retrieval method */
4372  switch (token->subclass)
4373  {
4374 
4375  case SYMBOL_DUMMY: /* just a dot symbol */
4376  case SYMBOL_CONSTANT: /* a literal symbol */
4377 
4378  /* see if we've had this before */
4379  retriever = this->literals->fastAt(name);
4380  /* first time literal? */
4381  if (retriever == OREF_NULL)
4382  {
4383  /* can we create an integer object? */
4384  if (token->numeric == INTEGER_CONSTANT)
4385  {
4386  /* create this as an integer */
4388  /* conversion error? */
4389  if (value == TheNilObject)
4390  {
4391  value = name; /* just go with the string value */
4392  }
4393  else
4394  /* snip off the string number string */
4395  /* value that was created when the */
4396  /* integer value was created. This */
4397  /* is rarely used, but contributes */
4398  /* to the saved program size */
4399  name->setNumberString(OREF_NULL);
4400  }
4401  else
4402  {
4403  value = name; /* just use the string value */
4404  /* give it a number string value */
4405  name->setNumberString((RexxObject *)value->numberString());
4406  }
4407  /* the constant is the retriever */
4408  this->literals->put(value, name);
4409  retriever = value; /* the retriever is the value itthis */
4410  }
4411  break;
4412 
4413  case SYMBOL_VARIABLE: /* simple variable symbol */
4414  /* add variable to proper dictionary */
4415  retriever = (RexxObject *)this->addVariable(name);
4416  break;
4417 
4418  case SYMBOL_STEM: /* stem variable */
4419  /* add variable to proper dictionary */
4420  retriever = (RexxObject *)this->addStem(name);
4421  break;
4422 
4423  case SYMBOL_COMPOUND: /* compound variable, need more */
4424  /* add variable to proper dictionary */
4425  retriever = (RexxObject *)this->addCompound(name);
4426  break;
4427 
4428  case SYMBOL_DOTSYMBOL: /* variable with a leading dot */
4429  /* get a lookup object */
4430  /* see if we've had this before */
4431  retriever = this->variables->fastAt(name);
4432  /* first time dot variable? */
4433  if (retriever == OREF_NULL)
4434  {
4435  /* create the shorter name */
4436  value = name->extract(1, name->getLength() - 1);
4437  /* add this to the common pile */
4438  value = this->commonString((RexxString *)value);
4439  /* create a retriever for this */
4440  retriever = (RexxObject *)new RexxDotVariable((RexxString *)value);
4441  /* add this to the common table */
4442  this->variables->put(retriever, name);
4443  }
4444  break;
4445 
4446  default: /* all other types (shouldn't happen)*/
4447  retriever = OREF_NULL; /* return nothing */
4448  break;
4449  }
4450  break;
4451 
4452  case TOKEN_LITERAL: /* literal strings */
4453  /* get a lookup object */
4454  /* see if we've had this before */
4455  retriever = this->literals->fastAt(name);
4456  /* first time literal? */
4457  if (retriever == OREF_NULL)
4458  {
4459  /* the constant is the retriever */
4460  this->literals->put(name, name);
4461  retriever = name; /* use the name directly */
4462  }
4463  break;
4464 
4465  default: /* all other tokens */
4466  retriever = OREF_NULL; /* don't return anything */
4467  break;
4468  }
4469  return retriever; /* return created retriever */
4470 }
4471 
4473  RexxString *name) /* name of the variable to process */
4474 /******************************************************************************/
4475 /* Function: Generalized method attribute retriever */
4476 /******************************************************************************/
4477 {
4478  RexxVariableBase *retriever = OREF_NULL; /* created retriever */
4479 
4480  /* go validate the symbol */
4481  switch (name->isSymbol())
4482  {
4483 
4484  case STRING_NAME: /* valid simple name */
4485  /* get a simple dynamic retriever */
4486  retriever = (RexxVariableBase *)new RexxParseVariable(name, 0);
4487  break;
4488 
4489  case STRING_STEM: /* this is a stem name */
4490  /* force dynamic lookup each time */
4491  retriever = (RexxVariableBase *)new RexxStemVariable(name, 0);
4492  break;
4493 
4494  case STRING_COMPOUND_NAME: /* compound variable name */
4495  /* get a direct retriever for this */
4497  break;
4498 
4499  default: /* all other invalid cases */
4500  /* have an invalid attribute */
4502  }
4503  return retriever; /* return created retriever */
4504 }
4505 
4506 
4508  RexxInstruction *_instruction) /* new label to add */
4509 /******************************************************************************/
4510 /* Add an instruction to the tree code execution stream */
4511 /******************************************************************************/
4512 {
4513  /* is this the first one? */
4514  if (this->first == OREF_NULL)
4515  {
4516  /* make this the first one */
4517  OrefSet(this, this->first, _instruction);
4518  /* and the last one */
4519  OrefSet(this, this->last, _instruction);
4520  }
4521  /* non-root instruction */
4522  else
4523  {
4524  this->last->setNext(_instruction); /* add on to the last instruction */
4525  /* this is the new last instruction */
4526  OrefSet(this, this->last, _instruction);
4527  }
4528  /* now safe from garbage collection */
4529  this->toss((RexxObject *)_instruction);
4530 }
4531 
4532 
4534  RexxInstruction *label, /* new label to add */
4535  RexxString *labelname ) /* the label name */
4536 /******************************************************************************/
4537 /* Function: add a label to the global label table. */
4538 /******************************************************************************/
4539 {
4540  /* not already in the table? */
4541  if (this->labels->fastAt(labelname) == OREF_NULL)
4542  {
4543  /* add this item */
4544  this->labels->put((RexxObject *)label, labelname);
4545  }
4546 }
4547 
4548 
4550  RexxString *labelname) /* target label */
4551 /******************************************************************************/
4552 /* Search the label table for a label name match */
4553 /******************************************************************************/
4554 {
4555  if (this->labels != OREF_NULL) /* have labels? */
4556  {
4557  /* just return entry from the table */
4558  return(RexxInstruction *)this->labels->fastAt(labelname);
4559  }
4560  else
4561  {
4562  return OREF_NULL; /* don't return anything */
4563  }
4564 }
4565 
4567 /******************************************************************************/
4568 /* Function: Set on guard expression variable "gathering" */
4569 /******************************************************************************/
4570 {
4571  /* just starting to trap? */
4572  if (this->guard_variables == OREF_NULL)
4573  {
4574  /* create the guard table */
4575  OrefSet(this, this->guard_variables, new_identity_table());
4576  }
4577 }
4578 
4580 /******************************************************************************/
4581 /* Function: Complete guard expression variable collection and return the */
4582 /* table of variables. */
4583 /******************************************************************************/
4584 {
4585  /* convert into an array */
4586  RexxArray *guards = this->guard_variables->makeArray();
4587  /* discard the table */
4588  OrefSet(this, this->guard_variables, OREF_NULL);
4589  /* just starting to trap? */
4590  return guards; /* return the guards array */
4591 }
4592 
4594 /******************************************************************************/
4595 /* Function: Evaluate a "constant" expression for REXX instruction keyword */
4596 /* values. A constant expression is a literal string, constant */
4597 /* symbol, or an expression enclosed in parentheses. */
4598 /******************************************************************************/
4599 {
4600  RexxToken *token; /* current token */
4601  RexxToken *second; /* second token */
4602  RexxObject *_expression = OREF_NULL; /* parse expression */
4603 
4604  token = nextReal(); /* get the first token */
4605  if (token->isLiteral()) /* literal string expression? */
4606  {
4607  _expression = this->addText(token); /* get the literal retriever */
4608  }
4609  else if (token->isConstant()) /* how about a constant symbol? */
4610  {
4611  _expression = this->addText(token); /* get the literal retriever */
4612  }
4613  /* got an end of expression? */
4614  else if (token->isEndOfClause())
4615  {
4616  previousToken(); /* push the token back */
4617  return OREF_NULL; /* nothing here (may be optional) */
4618  }
4619  /* not a left paren here? */
4620  else if (token->classId != TOKEN_LEFT)
4621  {
4622  /* this is an invalid expression */
4624  }
4625  else
4626  {
4627  /* get the subexpression */
4628  _expression = this->subExpression(TERM_EOC | TERM_RIGHT);
4629  second = nextToken(); /* get the terminator token */
4630  /* not terminated by a right paren? */
4631  if (second->classId != TOKEN_RIGHT)
4632  {
4633  /* this is an error */
4635  }
4636  }
4637  this->holdObject(_expression); /* protect the expression */
4638  return _expression; /* and return it */
4639 }
4640 
4642 /******************************************************************************/
4643 /* Function: Evaluate a "constant" expression for REXX instruction keyword */
4644 /* values. A constant expression is a literal string, constant */
4645 /* symbol, or an expression enclosed in parentheses. The */
4646 /* expression inside parens can be a complex logical expression. */
4647 /******************************************************************************/
4648 {
4649  RexxToken *token; /* current token */
4650  RexxToken *second; /* second token */
4651  RexxObject *_expression = OREF_NULL; /* parse expression */
4652 
4653  token = nextReal(); /* get the first token */
4654  if (token->isLiteral()) /* literal string expression? */
4655  {
4656 
4657  _expression = this->addText(token); /* get the literal retriever */
4658  }
4659  else if (token->isConstant()) /* how about a constant symbol? */
4660  {
4661  _expression = this->addText(token); /* get the literal retriever */
4662  }
4663  /* got an end of expression? */
4664  else if (token->isEndOfClause())
4665  {
4666  previousToken(); /* push the token back */
4667  return OREF_NULL; /* nothing here (may be optional) */
4668  }
4669  /* not a left paren here? */
4670  else if (token->classId != TOKEN_LEFT)
4671  {
4672  /* this is an invalid expression */
4674  }
4675  else
4676  {
4677  /* get the subexpression */
4678  _expression = this->parseLogical(token, TERM_EOC | TERM_RIGHT);
4679  second = nextToken(); /* get the terminator token */
4680  /* not terminated by a right paren? */
4681  if (second->classId != TOKEN_RIGHT)
4682  {
4683  /* this is an error */
4685  }
4686  }
4687  this->holdObject(_expression); /* protect the expression */
4688  return _expression; /* and return it */
4689 }
4690 
4692 /******************************************************************************/
4693 /* Function: Evaluate a "parenthetical" expression for REXX instruction */
4694 /* values. A parenthetical expression is an expression enclosed */
4695 /* in parentheses. */
4696 /******************************************************************************/
4697 {
4698  // NB, the opening paren has already been parsed off
4699 
4700  RexxObject *_expression = this->subExpression(TERM_EOC | TERM_RIGHT);
4701  RexxToken *second = nextToken(); /* get the terminator token */
4702  /* not terminated by a right paren? */
4703  if (second->classId != TOKEN_RIGHT)
4704  {
4706  }
4707  /* this is an error */
4708  this->holdObject(_expression); /* protect the expression */
4709  return _expression; /* and return it */
4710 }
4711 
4713  int terminators ) /* expression termination context */
4714 /******************************************************************************/
4715 /* Function: Parse off an expression, stopping when one of the possible set */
4716 /* of terminator tokens is reached. The terminator token is */
4717 /* placed back on the token queue. */
4718 /******************************************************************************/
4719 {
4720  nextReal(); /* get the first real token */
4721  previousToken(); /* now put it back */
4722  /* parse off the subexpression */
4723  return this->subExpression(terminators);
4724 }
4725 
4727  int terminators ) /* expression termination context */
4728 /******************************************************************************/
4729 /* Function: Parse off a sub- expression, stopping when one of the possible */
4730 /* set of terminator tokens is reached. The terminator token is */
4731 /* placed back on the token queue. */
4732 /******************************************************************************/
4733 {
4734  RexxObject *left; /* left term of operation */
4735  RexxObject *right; /* right term of operation */
4736  RexxToken *token; /* current working token */
4737  RexxToken *second; /* look ahead token */
4738  RexxObject *subexpression; /* final subexpression */
4739  SourceLocation location; /* token location info */
4740 
4741  /* get the left term */
4742  left = this->messageSubterm(terminators);
4743  if (left == OREF_NULL) /* end of the expression? */
4744  {
4745  return OREF_NULL; /* done processing here */
4746  }
4747  this->pushTerm(left); /* add the term to the term stack */
4748  /* add a fence item to operator stack*/
4750  token = nextToken(); /* get the next token */
4751  /* loop until end of expression */
4752  while (!this->terminator(terminators, token))
4753  {
4754  switch (token->classId)
4755  {
4756 
4757  case TOKEN_TILDE: /* have a message send operation */
4758  case TOKEN_DTILDE: /* have a double twiddle operation */
4759  left = this->popTerm(); /* get the left term from the stack */
4760  if (left == OREF_NULL) /* not there? */
4761  {
4762  /* this is an invalid expression */
4764  }
4765  /* process a message term */
4766  subexpression = this->message(left, token->classId == TOKEN_DTILDE, terminators);
4767  this->pushTerm(subexpression); /* push this back on the term stack */
4768  break;
4769 
4770  case TOKEN_SQLEFT: /* collection syntax message */
4771  left = this->popTerm(); /* get the left term from the stack */
4772  if (left == OREF_NULL) /* not there? */
4773  {
4774  /* this is an invalid expression */
4776  }
4777  /* process a message term */
4778  subexpression = this->collectionMessage(token, left, terminators);
4779  this->pushTerm(subexpression); /* push this back on the term stack */
4780  break;
4781 
4782  case TOKEN_SYMBOL: /* Symbol in the expression */
4783  case TOKEN_LITERAL: /* Literal in the expression */
4784  case TOKEN_LEFT: /* start of subexpression */
4785 
4786  location = token->getLocation(); /* get the token start position */
4787  /* abuttal ends on the same line */
4788  location.setEnd(location.getLineNumber(), location.getOffset());
4789  /* This is actually an abuttal */
4790  token = new RexxToken (TOKEN_OPERATOR, OPERATOR_ABUTTAL, OREF_NULLSTRING, location);
4791  previousToken(); /* step back on the token list */
4792 
4793  case TOKEN_BLANK: /* possible blank concatenate */
4794  second = nextReal(); /* get the next token */
4795  /* blank prior to a terminator? */
4796  if (this->terminator(terminators, second))
4797  {
4798  break; /* not a real operator */
4799  }
4800  else /* have a blank operator */
4801  {
4802  previousToken(); /* push this back */
4803  }
4804  /* fall through to operator logic */
4805 
4806  case TOKEN_OPERATOR: /* have a dyadic operator */
4807  /* actually a prefix only one? */
4808  if (token->subclass == OPERATOR_BACKSLASH)
4809  {
4810  /* this is an invalid expression */
4812  }
4813  /* handle operator precedence */
4814  for (;;)
4815  {
4816  second = this->topOperator();/* get the top term */
4817  /* hit the fence term? */
4818  if (second == (RexxToken *)TheNilObject)
4819  {
4820  break; /* out of here */
4821  }
4822  /* current have higher precedence? */
4823  if (this->precedence(token) > this->precedence(second))
4824  {
4825  break; /* finished also */
4826  }
4827  right = this->popTerm(); /* get the right term */
4828  left = this->popTerm(); /* and the left term */
4829  /* not enough terms? */
4830  if (right == OREF_NULL || left == OREF_NULL)
4831  {
4832  /* this is an invalid expression */
4834  }
4835  /* create a new operation */
4836  RexxToken *op = popOperator();
4837  subexpression = (RexxObject *)new RexxBinaryOperator(op->subclass, left, right);
4838  /* push this back on the term stack */
4839  this->pushTerm(subexpression);
4840  }
4841  this->pushOperator(token); /* push this operator onto stack */
4842  right = this->messageSubterm(terminators);
4843  /* end of the expression? */
4844  if (right == OREF_NULL && token->subclass != OPERATOR_BLANK)
4845  {
4846  /* have a bad expression */
4848  }
4849  this->pushTerm(right); /* add the term to the term stack */
4850  break;
4851 
4852  case TOKEN_ASSIGNMENT:
4853  // special assignment token in a bad context. We report this as an error.
4854  /* this is an invalid expression */
4856  break;
4857 
4858  case TOKEN_COMMA: /* found a comma in the expression */
4859  /* should have been trapped as an */
4860  /* expression terminator, so this is */
4861  /* not a valid expression */
4863  break;
4864 
4865  case TOKEN_RIGHT: /* found a paren in the expression */
4867  break;
4868 
4869  case TOKEN_SQRIGHT: /* found a bracket in the expression */
4871  break;
4872 
4873  default: /* something unexpected */
4874  /* not a valid expression */
4876  break;
4877  }
4878  token = nextToken(); /* get the next token */
4879  }
4880  token= this->popOperator(); /* get top operator token */
4881  /* process pending operations */
4882  while (token != (RexxToken *)TheNilObject)
4883  {
4884  right = this->popTerm(); /* get the right term */
4885  left = this->popTerm(); /* now get the left term */
4886  /* missing any terms? */
4887  if (left == OREF_NULL || right == OREF_NULL)
4888  {
4889  /* this is an invalid expression */
4891  }
4892  /* create a new operation */
4893  subexpression = (RexxObject *)new RexxBinaryOperator(token->subclass, left, right);
4894  this->pushTerm(subexpression); /* push this back on the term stack */
4895  token = this->popOperator(); /* get top operator token */
4896  }
4897  return this->popTerm(); /* expression is top of term stack */
4898 }
4899 
4901  RexxToken *_first, /* token starting arglist */
4902  int terminators ) /* expression termination context */
4903 /******************************************************************************/
4904 /* Function: Parse off an array of argument expressions */
4905 /******************************************************************************/
4906 {
4907  size_t argCount; /* count of arguments */
4908  RexxArray *_argArray; /* returned array */
4909 
4910  /* scan off the argument list */
4911  argCount = this->argList(_first, terminators);
4912  _argArray = new_array(argCount); /* get a new argument list */
4913  /* now copy the argument pointers */
4914  while (argCount > 0)
4915  {
4916  /* in reverse order */
4917  _argArray->put(this->subTerms->pop(), argCount--);
4918  }
4919  return _argArray; /* return the argument array */
4920 }
4921 
4923  RexxToken *_first, /* token starting arglist */
4924  int terminators ) /* expression termination context */
4925 /******************************************************************************/
4926 /* Function: Parse off a list of argument expressions */
4927 /******************************************************************************/
4928 {
4929  RexxQueue *arglist; /* argument list */
4930  RexxObject *subexpr; /* current subexpression */
4931  RexxToken *token; /* current working token */
4932  size_t realcount; /* count of real arguments */
4933  size_t total; /* total arguments */
4934 
4935  arglist = this->subTerms; /* use the subterms list */
4936  realcount = 0; /* no arguments yet */
4937  total = 0;
4938  /* get the first real token, which */
4939  nextReal(); /* skips any leading blanks on CALL */
4940  previousToken(); /* now put it back */
4941  /* loop until get a full terminator */
4942  for (;;)
4943  {
4944  /* parse off next argument expression*/
4945  subexpr = this->subExpression(terminators | TERM_COMMA);
4946  arglist->push(subexpr); /* add next argument to list */
4947  this->pushTerm(subexpr); /* add the term to the term stack */
4948  total++; /* increment the total */
4949  if (subexpr != OREF_NULL) /* real expression? */
4950  {
4951  realcount = total; /* update the real count */
4952  }
4953  token = nextToken(); /* get the next token */
4954  if (token->classId != TOKEN_COMMA) /* start of next argument? */
4955  {
4956  break; /* no, all finished */
4957  }
4958  }
4959  /* not closed with expected ')'? */
4960  if (terminators & TERM_RIGHT && token->classId != TOKEN_RIGHT)
4961  {
4962  /* raise an error */
4964  }
4965  /* not closed with expected ']'? */
4966  if (terminators&TERM_SQRIGHT && token->classId != TOKEN_SQRIGHT)
4967  {
4968  /* have an unmatched bracket */
4970  }
4971  this->popNTerms(total); /* pop all items off the term stack */
4972  /* pop off any trailing omitteds */
4973  while (total > realcount)
4974  {
4975  arglist->pop(); /* just pop off the dummy */
4976  total--; /* reduce the total */
4977  }
4978  return realcount; /* return the argument count */
4979 }
4980 
4982  RexxToken *token, /* arglist start (for error reports) */
4983  RexxToken *name, /* function name */
4984  int terminators ) /* expression termination context */
4985 /******************************************************************************/
4986 /* Function: Parse off a REXX function call */
4987 /******************************************************************************/
4988 {
4989  size_t argCount; /* count of function arguments */
4990  RexxExpressionFunction *_function; /* newly created function argument */
4991 
4992  saveObject((RexxObject *)name); // protect while parsing the argument list
4993 
4994  /* process the argument list */
4995  argCount = this->argList(token, ((terminators | TERM_RIGHT) & ~TERM_SQRIGHT));
4996 
4997  /* create a new function item */
4998  _function = new (argCount) RexxExpressionFunction(name->value, argCount, this->subTerms, this->resolveBuiltin(name->value), name->isLiteral());
4999  /* add to table of references */
5000  this->addReference((RexxObject *)_function);
5001  removeObj((RexxObject *)name); // end of protected windoww.
5002  return (RexxObject *)_function; /* and return this to the caller */
5003 }
5004 
5006  RexxToken *token, /* arglist start (for error reports) */
5007  RexxObject *target, /* target term */
5008  int terminators ) /* expression termination context */
5009 /******************************************************************************/
5010 /* Function: Process an expression term of the form "target[arg,arg]" */
5011 /******************************************************************************/
5012 {
5013  size_t argCount; /* count of function arguments */
5014  RexxObject *_message; /* new message term */
5015 
5016  this->saveObject((RexxObject *)target); /* save target until it gets connected to message */
5017  /* process the argument list */
5018  argCount = this->argList(token, ((terminators | TERM_SQRIGHT) & ~TERM_RIGHT));
5019  /* create a new function item */
5020  _message = (RexxObject *)new (argCount) RexxExpressionMessage(target, (RexxString *)OREF_BRACKETS, (RexxObject *)OREF_NULL, argCount, this->subTerms, false);
5021  this->holdObject(_message); /* hold this here for a while */
5022  this->removeObj((RexxObject *)target); /* target is now connected to message, remove from savelist without hold */
5023  return _message; /* return the message item */
5024 }
5025 
5027  int terminators, /* expression termination context */
5028  int errorcode) /* expected error code */
5029 /******************************************************************************/
5030 /* Function: Get a token, checking to see if this is a terminatore token */
5031 /******************************************************************************/
5032 {
5033  RexxToken *token = nextToken(); /* get the next token */
5034  /* this a terminator token? */
5035  if (this->terminator(terminators, token))
5036  {
5037  if (errorcode != 0) /* want an error raised? */
5038  {
5039  syntaxError(errorcode); /* report this */
5040  }
5041  return OREF_NULL; /* just return a null */
5042  }
5043  return token; /* return the token */
5044 }
5045 
5047  RexxObject *target, /* message send target */
5048  bool doubleTilde, /* class of message send */
5049  int terminators ) /* expression termination context */
5050 /******************************************************************************/
5051 /* Function: Parse a full message send expression term */
5052 /******************************************************************************/
5053 {
5054  size_t argCount; /* list of function arguments */
5055  RexxString *messagename = OREF_NULL; /* message name */
5056  RexxObject *super; /* super class target */
5057  RexxToken *token; /* current working token */
5058  RexxExpressionMessage *_message; /* new message term */
5059 
5060  super = OREF_NULL; /* default no super class */
5061  argCount = 0; /* and no arguments */
5062  this->saveObject(target); /* save target until it gets connected to message */
5063 
5064  /* add the term to the term stack so that the calculations */
5065  /* include this in the processing. */
5066  this->pushTerm(target);
5067  /* get the next token */
5068  token = this->getToken(terminators, Error_Symbol_or_string_tilde);
5069  /* unexpected type? */
5070  if (token->isSymbolOrLiteral())
5071  {
5072  messagename = token->value; /* get the message name */
5073  }
5074  else
5075  {
5076  /* error! */
5078  }
5079  /* get the next token */
5080  token = this->getToken(terminators, 0);
5081  if (token != OREF_NULL)
5082  { /* not reached the clause end? */
5083  /* have a super class? */
5084  if (token->classId == TOKEN_COLON)
5085  {
5086  /* get the next token */
5087  token = this->getToken(terminators, Error_Symbol_expected_colon);
5088  /* not a variable symbol? */
5089  if (!token->isVariable() && token->subclass != SYMBOL_DOTSYMBOL)
5090  {
5091  /* have an error */
5093  }
5094  super = this->addText(token); /* get the variable retriever */
5095  /* get the next token */
5096  token = this->getToken(terminators, 0);
5097  }
5098  }
5099  if (token != OREF_NULL)
5100  { /* not reached the clause end? */
5101  if (token->classId == TOKEN_LEFT) /* have an argument list? */
5102  {
5103  /* process the argument list */
5104  argCount = this->argList(token, ((terminators | TERM_RIGHT) & ~TERM_SQRIGHT));
5105  }
5106  else
5107  {
5108  previousToken(); /* something else, step back */
5109  }
5110  }
5111 
5112  this->popTerm(); /* it is now safe to pop the message target */
5113  /* create a message send node */
5114  _message = new (argCount) RexxExpressionMessage(target, messagename, super, argCount, this->subTerms, doubleTilde);
5115  /* protect for a bit */
5116  this->holdObject((RexxObject *)_message);
5117  this->removeObj(target); /* target is now connected to message, remove from savelist without hold */
5118  return(RexxObject *)_message; /* return the message item */
5119 }
5120 
5121 
5135 {
5136  // try for a message term first. If not successful, see if the
5137  // next token is a variable symbol.
5138  RexxObject *result = messageTerm();
5139  if (result == OREF_NULL)
5140  {
5141  RexxToken *_first = nextReal();
5142  if (_first->isSymbol())
5143  {
5144  // ok, add the variable to the processing list
5145  this->needVariable(_first);
5146  result = this->addText(_first);
5147  }
5148  else
5149  {
5150  previousToken(); // just push back on for the caller to sort out
5151  }
5152  }
5153  else
5154  {
5155  // we need to convert this into an assignment message.
5156  ((RexxExpressionMessage *)result)->makeAssignment(this);
5157  }
5158  return result;
5159 }
5160 
5161 
5162 
5164 /******************************************************************************/
5165 /* Function: Parse off an instruction leading message term element */
5166 /******************************************************************************/
5167 {
5168  RexxToken *token; /* current working token */
5169  RexxObject *term; /* working term */
5170  RexxObject *start; /* starting term */
5171  int classId; /* token class */
5172 
5173  size_t mark = markPosition(); // save the current position so we can reset cleanly
5174 
5175  start = this->subTerm(TERM_EOC); /* get the first term of instruction */
5176  this->holdObject(start); /* save the starting term */
5177  term = OREF_NULL; /* default to no term */
5178  token = nextToken(); /* get the next token */
5179  classId = token->classId; /* get the token class */
5180  /* while cascading message sends */
5181  while (classId == TOKEN_TILDE || classId == TOKEN_DTILDE || classId == TOKEN_SQLEFT )
5182  {
5183  if (classId == TOKEN_SQLEFT) /* left bracket form? */
5184  {
5185  term = this->collectionMessage(token, start, TERM_EOC);
5186  }
5187  else
5188  {
5189  /* process a message term */
5190  term = this->message(start, classId == TOKEN_DTILDE, TERM_EOC);
5191  }
5192  start = term; /* set for the next pass */
5193  token = nextToken(); /* get the next token */
5194  classId = token->classId; /* get the token class */
5195  }
5196  previousToken(); /* push this term back */
5197  // if this was not a valid message term, reset the position to the beginning
5198  if (term == OREF_NULL)
5199  {
5200  resetPosition(mark); // reset back to the entry conditions
5201  }
5202  /* return the message term (returns */
5203  return term; /* OREF_NULL if not a message term) */
5204 }
5205 
5207  int terminators ) /* expression termination context */
5208 /******************************************************************************/
5209 /* Function: Parse off a message subterm within an expression */
5210 /******************************************************************************/
5211 {
5212  RexxToken *token; /* current working token */
5213  RexxObject *term = OREF_NULL; /* working term */
5214  int classId; /* token class */
5215 
5216  token = nextToken(); /* get the next token */
5217  /* this the expression end? */
5218  if (this->terminator(terminators, token))
5219  {
5220  return OREF_NULL; /* nothing to do here */
5221  }
5222  /* have potential prefix operator? */
5223  if (token->classId == TOKEN_OPERATOR)
5224  {
5225 
5226  /* handle prefix operators as terms */
5227  switch (token->subclass)
5228  {
5229 
5230  case OPERATOR_PLUS: /* prefix plus */
5231  case OPERATOR_SUBTRACT: /* prefix minus */
5232  case OPERATOR_BACKSLASH: /* prefix backslash */
5233  /* handle following term */
5234  term = this->messageSubterm(terminators);
5235  if (term == OREF_NULL) /* nothing found? */
5236  {
5237  /* this is an error */
5239  }
5240  /* create the new operator term */
5241  term = (RexxObject *)new RexxUnaryOperator(token->subclass, term);
5242  break;
5243 
5244  default: /* other operators not allowed here */
5245  /* this is an error */
5247  }
5248  }
5249  /* non-prefix operator code */
5250  else
5251  {
5252  previousToken(); /* put back the first token */
5253  term = this->subTerm(TERM_EOC); /* get the first term of instruction */
5254  this->holdObject(term); /* save the starting term */
5255  token = nextToken(); /* get the next token */
5256  classId = token->classId; /* get the token class */
5257  /* while cascading message sends */
5258  while (classId == TOKEN_TILDE || classId == TOKEN_DTILDE || classId == TOKEN_SQLEFT )
5259  {
5260  if (classId == TOKEN_SQLEFT) /* left bracket form? */
5261  {
5262  term = this->collectionMessage(token, term, TERM_EOC);
5263  }
5264  else
5265  {
5266  /* process a message term */
5267  term = this->message(term, classId == TOKEN_DTILDE, TERM_EOC);
5268  }
5269  token = nextToken(); /* get the next token */
5270  classId = token->classId; /* get the token class */
5271  }
5272  previousToken(); /* push this term back */
5273  }
5274  /* return the message term (returns */
5275  return term; /* OREF_NULL if not a message term) */
5276 }
5277 
5279  int terminators ) /* expression termination context */
5280 /******************************************************************************/
5281 /* Function: Parse off a subterm of an expression, from simple ones like */
5282 /* variable names, to more complex such as message sends */
5283 /******************************************************************************/
5284 {
5285  RexxToken *token; /* current token being processed */
5286  RexxObject *term = OREF_NULL; /* parsed out term */
5287  RexxToken *second; /* second token of term */
5288 
5289  token = nextToken(); /* get the next token */
5290  /* this the expression end? */
5291  if (this->terminator(terminators, token))
5292  {
5293  return OREF_NULL; /* nothing to do here */
5294  }
5295 
5296  switch (token->classId)
5297  {
5298 
5299  case TOKEN_LEFT: /* have a left parentheses */
5300  /* get the subexpression */
5301  term = this->subExpression(((terminators | TERM_RIGHT) & ~TERM_SQRIGHT));
5302  if (term == OREF_NULL) /* nothing found? */
5303  {
5304  /* this is an error */
5306  }
5307  second = nextToken(); /* get the terminator token */
5308  /* not terminated by a right paren? */
5309  if (second->classId != TOKEN_RIGHT)
5310  {
5311  /* this is an error */
5313  }
5314  break;
5315 
5316  case TOKEN_SYMBOL: /* Symbol in the expression */
5317  case TOKEN_LITERAL: /* Literal in the expression */
5318  second = nextToken(); /* get the next token */
5319  /* have a function call? */
5320  if (second->classId == TOKEN_LEFT)
5321  {
5322  /* process the function call */
5323  term = this->function(second, token, terminators);
5324  }
5325  else
5326  {
5327  previousToken(); /* push the token back */
5328  term = this->addText(token); /* variable or literal access */
5329  }
5330  break;
5331 
5332  case TOKEN_RIGHT: /* have a right parentheses */
5333  /* this is an error here */
5335  break;
5336 
5337  case TOKEN_COMMA: /* have a comma */
5338  /* this is an error here */
5340  break;
5341 
5342  case TOKEN_SQRIGHT: /* have a right square bracket */
5343  /* this is an error here */
5345  break;
5346 
5347  case TOKEN_OPERATOR: /* operator token */
5348  switch (token->subclass)
5349  { /* handle prefix operators as terms */
5350 
5351  case OPERATOR_PLUS: /* prefix plus */
5352  case OPERATOR_SUBTRACT: /* prefix minus */
5353  case OPERATOR_BACKSLASH: /* prefix backslash */
5354  previousToken(); /* put the token back */
5355  return OREF_NULL; /* just return null (processed later)*/
5356 
5357  default: /* other operators not allowed here */
5358  /* this is an error */
5360  }
5361  break;
5362 
5363  default: /* unknown thing in expression */
5364  /* this is an error */
5366  }
5367  return term; /* return this term */
5368 }
5369 
5371  RexxObject *term ) /* term to push */
5372 /******************************************************************************/
5373 /* Function: Push a term onto the expression term stack */
5374 /******************************************************************************/
5375 {
5376  this->terms->push(term); /* push the term on the stack */
5377  this->currentstack++; /* step the stack depth */
5378  /* new "high water" mark? */
5379  if (this->currentstack > this->maxstack)
5380  {
5381  /* make it the highest point */
5382  this->maxstack = this->currentstack;
5383  }
5384 }
5385 
5387 /******************************************************************************/
5388 /* Function: Pop a term off of the expression term stack */
5389 /******************************************************************************/
5390 {
5391  RexxObject *term; /* returned term */
5392 
5393  this->currentstack--; /* reduce the size count */
5394  term = this->terms->pop(); /* pop the term */
5395  this->holdObject(term); /* give it a little protection */
5396  return term; /* and return it */
5397 }
5398 
5400  size_t count ) /* number of terms to pop */
5401 /******************************************************************************/
5402 /* Function: Pop multiple terms off of the operator stack */
5403 /******************************************************************************/
5404 {
5405  RexxObject *result = OREF_NULL; /* final popped element */
5406 
5407  this->currentstack -= count; /* reduce the size count */
5408  while (count--) /* while more to remove */
5409  {
5410  result = this->terms->pop(); /* pop the next item */
5411  }
5412  this->