rexx/src/maintest.c

   1 /*
   2  * $Header$
   3  * $Log$
   4  * Revision 1.1  2001/04/04 05:43:39  wang
   5  * First commit: compiles on Linux, Amiga, Windows, Windows CE, generic gcc
   6  *
   7  * Revision 1.3  1999/11/26 13:13:47  bnv
   8  * *** empty log message ***
   9  *
  10  * Revision 1.2  1999/05/14 12:31:22  bnv
  11  * Fork test routine
  12  *
  13  * Revision 1.1  1998/07/02 17:34:50  bnv
  14  * Initial revision
  15  *
  16  */
  17 #include <stdio.h>
  18 #include <string.h>
  19 #include <lstring.h>
  20
  21 #include <rexx.h>
  22 #include <rxdefs.h>
  23 #include <compile.h>
  24
  25 /* ----------- MyFunc -------- */
  26 void
  27 MyFunc( int test )
  28 {
  29         if (test)
  30                 Lscpy(ARGR,"Banana");
  31         else
  32                 Lscpy(ARGR,"Bingo");
  33 } /* MyFunc */
  34
  35 /* ----------- RxFork ---------- *
  36 void
  37 RxFork( )
  38 {
  39         Licpy(ARGR,fork());
  40 } * RxFork */
  41
  42 /* ----------- RxIndirectCall ---------- */
  43 TBltFunc        *C_isBuiltin( PLstr );
  44 void            RxProcResize();
  45 void
  46 RxIndirectCall( )
  47 {
  48         PBinLeaf        leaf;
  49         TBltFunc        *bltfunc;       // Is a builtin function?
  50
  51         if (ARGN<1)
  52                 Lerror(ERR_INCORRECT_CALL,0);
  53
  54         must_exist(1);
  55         Lupper(ARG1);
  56
  57         /* ---- Search for the label ---- */
  58         leaf = BinFind(&_labels,ARG1);
  59         if (leaf==NULL || ((RxFunc*)(leaf->value))->label==UNKNOWN_LABEL) {
  60                 /* ---- Last chance, trye a builtin ----- */
  61                 if ((bltfunc=C_isBuiltin(ARG1))!=NULL) {
  62                         int i;
  63                         /* setup arguments */
  64                         ARGN--;
  65                         for (i=0; i<ARGN; i++)
  66                                 Rxarg.a[i] = Rxarg.a[i+1];
  67                         Rxarg.a[i] = NULL;
  68                         (bltfunc->func)(bltfunc->opt);
  69                 } else
  70                         Lerror(ERR_UNEXISTENT_LABEL,1,ARG1);
  71                 return;
  72         }
  73
  74         // -- Label found, prepare the arguments and do the function call --
  75 printf("Label FOUND\n");
  76 //      func = (RxFunc*)(leaf->value);
  77 //      RxSetSpecialVar(SIGLVAR,TraceCurline(NULL,FALSE));
  78 //      Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart + (size_t)(func->label));
  79 } /* RxIndirectCall */
  80
  81         PBinLeaf        leaf,litleaf;
  82         RxFunc  *func;
  83         int     ct,nargs,realarg,st;
  84         CTYPE   existarg, line;
  85         Lstr    cmd;
  86         PLstr   res;
  87 #ifdef __DEBUG__
  88         size_t  inst_ip;
  89 #endif
  90
  91         /* --- read the arguments here --- */
  92         PLEAF(leaf);                    /* function number      */
  93         nargs = *(Rxcip++);             /* number of args       */
  94         realarg = *(Rxcip++);           /* real arguments       */
  95         existarg = *(CWORD *)Rxcip;     /* existing arguments   */
  96                 INCWORD(Rxcip);
  97         line  = *(CWORD *)Rxcip;        /* SIGL line            */
  98                 INCWORD(Rxcip);
  99         ct = *(Rxcip++);                /* call type            */
 100         func = (RxFunc *)(leaf->value);
 101
 102                 } else {
 103                         Rxcip++;
 104                         RxSetSpecialVar(SIGLVAR,line);
 105                         I_MakeArgs(ct,nargs,existarg);
 106                         Rxcip = (CIPTYPE*)((byte huge *)Rxcodestart+func->label);
 107                         Rxcip++;        /* skip the newclause_mn */
 108                         if (_trace) TraceClause();
 109
 110                         /* handle proc_mn code */
 111                         if (*Rxcip == proc_mn) {
 112                                 int     exposed;
 113
 114                                 /* give a unique program id */
 115                                 /* we might have a problem after 2*32 routine calls!! */
 116                                 _procidcnt++;
 117                                 _Proc[_rx_proc].id = _procidcnt;
 118                                 Rx_id  = _procidcnt;
 119 #ifdef __DEBUG__
 120                                 if (__debug__)
 121                                         inst_ip = (size_t)((byte huge *)Rxcip - (byte huge *)Rxcodestart);
 122 #endif
 123                                 DEBUGDISPLAY0nl("PROC ");
 124                                 Rxcip++;
 125                                 _Proc[_rx_proc].scope = RxScopeMalloc();
 126                                 VarScope = _Proc[_rx_proc].scope;
 127
 128                                 /* handle exposed variables */
 129                                 exposed = *(Rxcip++);
 130 #ifdef __DEBUG__
 131                                 if (__debug__ && exposed>0)
 132                                         printf("EXPOSE");
 133 #endif
 134                                 for (;exposed>0;exposed--) {
 135                                         PLEAF(litleaf);         /* Get pointer to variable */
 136 #ifdef __DEBUG__
 137                                         if (__debug__) {
 138                                                 putchar(' ');
 139                                                 Lprint(STDOUT,&(litleaf->key));
 140                                         }
 141 #endif
 142                                         RxVarExpose(VarScope,litleaf);
 143                                 }
 144 #ifdef __DEBUG__
 145                                 if (__debug__)
 146                                         putchar('\n');
 147 #endif
 148                         }
 149                 }
 150                 return FALSE;
 151         }
 152 } /* RxIndirectCall */
 153
 154 /* --------------------- main ---------------------- */
 155 int
 156 main(int ac, char *av[])
 157 {
 158         Lstr    args, tracestr, file;
 159         int     input,ia,ir;
 160
 161         input = FALSE;
 162         LINITSTR(args);
 163         LINITSTR(tracestr);
 164         LINITSTR(file);
 165
 166         if (ac<2) {
 167                 puts("\nsyntax: rexx [-[trace]] <filename> <args>...\nrexx - (to use stdin)\n");
 168                 puts(VERSION);
 169                 puts("Author: "AUTHOR);
 170                 puts("Please report any bugs, fatal errors or comments to the");
 171                 puts("above address, or to <bnv@nisyros.physics.auth.gr>\n");
 172                 return 0;
 173         }
 174 #ifdef __DEBUG__
 175         __debug__ = FALSE;
 176 #endif
 177
 178         /* --- Initialise --- */
 179         RxInitialize(av[0]);
 180
 181         /* --- User registered functions --- */
 182         RxRegFunction("BINGO",  MyFunc, 0);
 183         RxRegFunction("BANANA", MyFunc, 1);
 184         //RxRegFunction("FORK", RxFork, 0);
 185
 186         RxRegFunction("THE",    RxIndirectCall, 0);
 187
 188         /* --- scan arguments --- */
 189         ia = 1;
 190         if (av[ia][0]=='-') {
 191                 if (av[ia][1]==0)
 192                         input = TRUE;
 193                 else
 194                         Lscpy(&tracestr,av[ia]+1);
 195                 ia++;
 196         } else
 197         if (av[ia][0]=='?' || av[ia][0]=='!') {
 198                 Lscpy(&tracestr,av[ia]);
 199                 ia++;
 200         }
 201
 202         /* --- let's read a normal file --- */
 203         if (!input && ia<ac) {
 204                 /* prepare arguments for program */
 205                 for (ir=ia+1; ir<ac; ir++) {
 206                         Lcat(&args,av[ir]);
 207                         if (ir<ac-1) Lcat(&args," ");
 208                 }
 209                 RxRun(av[ia],NULL,&args,&tracestr,NULL);
 210         } else {
 211                 if (ia>=ac)
 212                         Lread(STDIN,&file,LREADFILE);
 213                 else
 214                         for (;ia<ac; ia++) {
 215                                 Lcat(&file,av[ia]);
 216                                 if (ia<ac-1) Lcat(&file," ");
 217                         }
 218                 RxRun(NULL,&file,&args,&tracestr,NULL);
 219         }
 220
 221         /* --- Free everything --- */
 222         RxFinalize();
 223         LFREESTR(args);
 224         LFREESTR(tracestr);
 225         LFREESTR(file);
 226
 227 #ifdef __DEBUG__
 228         if (mem_allocated()!=0) {
 229                 fprintf(STDERR,"\nMemory left allocated: %ld\n",mem_allocated());
 230                 mem_list();
 231         }
 232 #endif
 233
 234         return RxReturnCode;
 235 } /* main */