rexx/src/rexx.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.2  1999/11/26 13:13:47  bnv
   8  * Changed: To use the new macros.
   9  *
  10  * Revision 1.1  1998/07/02 17:34:50  bnv
  11  * Initial revision
  12  *
  13  */
  14
  15 #define __REXX_C__
  16
  17 #include <string.h>
  18 #include <setjmp.h>
  19
  20 #include <bmem.h>
  21 #include <lerror.h>
  22 #include <lstring.h>
  23
  24 #include <rexx.h>
  25 #include <stack.h>
  26 #include <trace.h>
  27 #include <bintree.h>
  28 #include <compile.h>
  29 #include <interpre.h>
  30 #include <nextsymb.h>
  31
  32 /* ----------- Function prototypes ------------ */
  33 void    Rerror(int,int,...);
  34 void    RxInitFiles(void);
  35 void    RxDoneFiles(void);
  36 void    RxRegFunctionDone(void);
  37
  38 /* ----------- External variables ------------- */
  39 extern Lstr     errmsg;
  40
  41 /* ---------------- RxInitProc ---------------- */
  42 static void
  43 RxInitProc( void )
  44 {
  45         _rx_proc = -1;
  46         _Proc_size = PROC_INC;
  47         _Proc = (RxProc*) MALLOC( _Proc_size * sizeof(RxProc), "RxProc" );
  48         MEMSET(_Proc,0,_Proc_size*sizeof(RxProc));
  49 } /* RxInitProc */
  50
  51 /* ----------------- RxInitialize ----------------- */
  52 void
  53 RxInitialize( char *prorgram_name )
  54 {
  55         Lstr    str;
  56
  57         _prgname = prorgram_name;
  58 #if defined(WIN32) || defined(WCE)
  59         _szRxAppKey = REGAPPKEY;
  60 #endif
  61
  62         LINITSTR(str);
  63
  64         /* do the basic initialisation */
  65         Linit(Rerror);          /* initialise with Lstderr as error function */
  66         LINITSTR(symbolstr);
  67                 Lfx(&symbolstr,250);    /* create symbol string */
  68         LINITSTR(errmsg);
  69                 Lfx(&errmsg,250);       /* create error message string */
  70
  71         /* --- first locate configuration file --- */
  72         /* rexx.rc for DOS in the executable program directory */
  73         /* .rexxrc for unix in the HOME directory */
  74
  75         _procidcnt = 1;         /* Program id counter   */
  76
  77         DQINIT(StackList);      /* initialise stacks    */
  78         CreateStack();          /* create first stack   */
  79         rxfile = NULL;          /* intialise rexx files */
  80         LPMALLOC(_code);
  81         CompileClause = NULL;
  82
  83         RxInitProc();           /* initialize prg list  */
  84         RxInitInterpret();      /* initialise interpreter*/
  85         RxInitFiles();          /* initialise files     */
  86         RxInitVariables();      /* initialise hash table for variables  */
  87
  88         BINTREEINIT(_labels);   /* initialise labels    */
  89         BINTREEINIT(Litterals); /* initialise litterals */
  90
  91                 Lscpy(&str,"HALT");     HaltStr   = _Add2Lits( &str, FALSE );
  92
  93                 Lscpy(&str,"1");        OneStr    = _Add2Lits( &str, FALSE );
  94                 Lscpy(&str,"");         NullStr   = _Add2Lits( &str, FALSE );
  95                 Lscpy(&str,"0");        ZeroStr   = _Add2Lits( &str, FALSE );
  96                 Lscpy(&str,"ERROR");    ErrorStr  = _Add2Lits( &str, FALSE );
  97
  98                 Lscpy(&str,"RESULT");   ResultStr = _Add2Lits( &str, FALSE );
  99                 Lscpy(&str,"NOVALUE");  NoValueStr= _Add2Lits( &str, FALSE );
 100                 Lscpy(&str,"NOTREADY");NotReadyStr= _Add2Lits( &str, FALSE );
 101                 Lscpy(&str,"SIGL");     SiglStr   = _Add2Lits( &str, FALSE );
 102                 Lscpy(&str,"RC");       RCStr     = _Add2Lits( &str, FALSE );
 103                 Lscpy(&str,"SYNTAX");   SyntaxStr = _Add2Lits( &str, FALSE );
 104                 Lscpy(&str,"SYSTEM");   SystemStr = _Add2Lits( &str, FALSE );
 105
 106         LFREESTR(str);
 107 } /* RxInitialize */
 108
 109 /* ----------------- RxFinalize ----------------- */
 110 void
 111 RxFinalize( void )
 112 {
 113         LFREESTR(symbolstr);    /* delete symbol string */
 114         LFREESTR(errmsg);       /* delete error msg str */
 115         RxDoneInterpret();
 116         FREE(_Proc);            /* free prg list        */
 117         while (StackList.items>0) DeleteStack();
 118         LPFREE(_code);  _code = NULL;
 119
 120         RxDoneFiles();          /* close all files      */
 121
 122                 /* will free also NullStr, Zero and OneStr      */
 123         BinDisposeLeaf(&Litterals,Litterals.parent,FREE);
 124         BinDisposeLeaf(&_labels,_labels.parent,FREE);
 125         RxDoneVariables();
 126         RxRegFunctionDone();    /* initialise register functions        */
 127 } /* RxFinalize */
 128
 129 /* ----------------- RxLoadFile ------------------- */
 130 int
 131 RxLoadFile( RxFile *rxf )
 132 {
 133         FILEP f;
 134
 135         if ((f=FOPEN(LSTR(rxf->filename),"r"))==NULL)
 136                 return FALSE;
 137         Lread(f,&(rxf->file), LREADFILE);
 138         FCLOSE(f);
 139         return TRUE;
 140 } /* RxLoadFile */
 141
 142 /* ----------------- RxRun ------------------ */
 143 int
 144 RxRun( char *filename, PLstr programstr,
 145         PLstr arguments, PLstr tracestr, char *environment )
 146 {
 147         RxFile  *rxf;
 148         RxProc  *pr;
 149         char    *c;
 150         int     i;
 151
 152         /* --- set exit jmp position --- */
 153         if ((i=setjmp(_exit_trap))!=0)
 154                 goto run_exit;
 155         /* --- set temporary error trap --- */
 156         if (setjmp(_error_trap)!=0)
 157                 return RxReturnCode;
 158
 159         /* ====== first load the file ====== */
 160         rxfile = (RxFile*)MALLOC(sizeof(RxFile),"RxFile");
 161         MEMSET(rxfile,0,sizeof(RxFile));
 162
 163         if (filename) {
 164                 /* --- copy the filename --- */
 165                 Lscpy(&(rxfile->filename), filename);
 166                 LASCIIZ(rxfile->filename);
 167
 168                 /* find file type */
 169                 rxfile->filetype = NULL;
 170                 c = LSTR(rxfile->filename)+LLEN(rxfile->filename);
 171                 for (;c>LSTR(rxfile->filename) && *c!='.';c--) ;;
 172                 if (*c=='.')
 173                         rxfile->filetype = c+1;
 174
 175                 /* --- Load file --- */
 176                 if (!RxLoadFile( rxfile )) {
 177 #ifndef WCE
 178                         fprintf(STDERR,"Error %d running \"%s\": File not found\n",
 179                                         ERR_FILE_NOT_FOUND, LSTR(rxfile->filename));
 180 #else
 181                         PUTS("Error: File not found.");
 182 #endif
 183                         LFREESTR(rxfile->filename);
 184                         FREE(rxfile);
 185                         return 1;
 186                 }
 187         } else {
 188                 Lscpy(&(rxfile->filename), "<STDIN>");
 189                 rxfile->filetype = NULL;
 190                 LASCIIZ(rxfile->filename);
 191                 Lstrcpy(&(rxfile->file), programstr);
 192         }
 193         LASCIIZ(rxfile->file);
 194
 195 #ifdef __DEBUG__
 196         if (__debug__) {
 197                 printf("File is:\n%s\n",LSTR(rxfile->file));
 198                 getchar();
 199         }
 200 #endif
 201
 202         /* ====== setup procedure ====== */
 203         _rx_proc++;             /* increase program items       */
 204         pr = _Proc+_rx_proc;    /* pr = Proc pointer            */
 205
 206         /* set program id counter */
 207         pr->id = _procidcnt++;
 208
 209         /* --- initialise Proc structure --- */
 210                                 /* arguments...         */
 211         pr->arg.n = 0;
 212         for (i=0; i<MAXARGS; i++)
 213                 pr->arg.a[i] = NULL;
 214         pr->arg.r = NULL;
 215         if (LLEN(*arguments)) {
 216                 pr->arg.n = 1;
 217                 pr->arg.a[0] = arguments;
 218         } else
 219                 pr->arg.n = 0;
 220
 221         pr->calltype = CT_PROGRAM;      /* call type...         */
 222         pr->ip = 0;                     /* procedure ip         */
 223         pr->stack = -1;         /* prg stck, will be set in interpret   */
 224         pr->stacktop = -1;              /* no arguments         */
 225
 226         pr->scope = RxScopeMalloc();
 227         LPMALLOC(pr->env);
 228         if (environment)
 229                 Lscpy(pr->env,environment);
 230         else
 231                 Lstrcpy(pr->env,&(SystemStr->key));
 232         pr->digits = LMAXNUMERICDIGITS;
 233         pr->fuzz = 0;
 234         pr->form = SCIENTIFIC;
 235         pr->condition = 0;
 236         pr->lbl_error    = &(ErrorStr->key);
 237         pr->lbl_halt     = &(HaltStr->key);
 238         pr->lbl_novalue  = &(NoValueStr->key);
 239         pr->lbl_notready = &(NotReadyStr->key);
 240         pr->lbl_syntax   = &(SyntaxStr->key);
 241         pr->codelen = 0;
 242         pr->trace = normal_trace;
 243         pr->interactive_trace = FALSE;
 244         if (tracestr && LLEN(*tracestr)) TraceSet(tracestr);
 245
 246         /* ======= Compile file ====== */
 247         RxInitCompile(rxfile,NULL);
 248         RxCompile();
 249
 250 #ifdef __DEBUG__
 251         if (__debug__) {
 252                 printf("Litterals are:\n");
 253                 BinPrint(Litterals.parent);
 254                 getchar();
 255
 256                 printf("Labels(&functions) are:\n");
 257                 BinPrint(_labels.parent);
 258                 printf("Code Size: %d\n\n",LLEN(*_code));
 259                 getchar();
 260         }
 261 #endif
 262
 263         /* ======= Execute code ======== */
 264         if (!RxReturnCode)
 265                 RxInterpret();
 266
 267 run_exit:
 268                 /* pr pointer might have changed if Proc was resized */
 269         pr = _Proc+_rx_proc;
 270 #ifdef __DEBUG__
 271         if (__debug__)
 272                 printf("Return Code = %d\n",RxReturnCode);
 273 #endif
 274
 275         /* ======== free up memory ======== */
 276         while (rxfile) {
 277                 rxf = rxfile;
 278                 rxfile = rxfile->next;
 279                 LFREESTR(rxf->filename);
 280                 LFREESTR(rxf->file);
 281                 FREE(rxf);
 282         }
 283
 284         LPFREE(pr->env);
 285         if (CompileClause) {
 286                 FREE(CompileClause);
 287                 CompileClause = NULL;
 288         }
 289
 290         RxScopeFree(pr->scope);
 291         FREE(pr->scope);
 292         _rx_proc--;
 293
 294         return RxReturnCode;
 295 } /* RxRun */