← Back to branch summary

~ubuntu-branches/ubuntu/wily/eso-midas/wily-proposed

« back to all changes in this revision

Viewing changes to monit/prepc1.c

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
monit/prepc1.c
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2010 European Southern Observatory (ESO)
 
3
 
 
4
  This program is free software; you can redistribute it and/or 
 
5
  modify it under the terms of the GNU General Public License as 
 
6
  published by the Free Software Foundation; either version 2 of 
 
7
  the License, or (at your option) any later version.
 
8
 
 
9
  This program is distributed in the hope that it will be useful,
 
10
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
  GNU General Public License for more details.
 
13
 
 
14
  You should have received a copy of the GNU General Public 
 
15
  License along with this program; if not, write to the Free 
 
16
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
17
  MA 02139, USA.
 
18
 
 
19
  Correspondence concerning ESO-MIDAS should be addressed as follows:
 
20
        Internet e-mail: midas@eso.org
 
21
        Postal address: European Southern Observatory
 
22
                        Data Management Division 
 
23
                        Karl-Schwarzschild-Strasse 2
 
24
                        D 85748 Garching bei Muenchen 
 
25
                        GERMANY
 
26
===========================================================================*/
 
27
 
 
28
/*++++++++++++++++++++++++  MIDAS monitor module PREPC1  +++++++++++++++++++++
 
29
.LANGUAGE  C
 
30
.IDENTIFICATION Module PREPC1
 
31
.AUTHOR         K. Banse                  ESO - Garching
 
32
.KEYWORDS
 
33
 MIDAS monitor
 
34
.COMMENTS
 
35
  holds ishostcom, break_line, MYBATCH
 
36
.VERSION [1.00] 870722: initial version built on FORTRAN version 4.40
 
37
                        as of 870311
 
38
 100608         last modif
 
39
-----------------------------------------------------------------------------*/
 
40
 
 
41
 
 
42
#include <fileexts.h>
 
43
 
 
44
#include <osyparms.h>
 
45
#include <monitdef.h>
 
46
#include <midback.h>
 
47
 
 
48
#include <stdlib.h>
 
49
 
 
50
void fixout();
 
51
 
 
52
size_t  sdum;
 
53
 
 
54
/*
 
55
 
 
56
*/
 
57
 
 
58
int ishostcom(string)
 
59
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
60
.PURPOSE
 
61
  test, if command is Midas or Host command
 
62
.ALGORITHM
 
63
  if 1. non-blank char. is `$' it's a Host com.
 
64
  else try to translate + see if it's a Midas command
 
65
  if not recognized return Host com
 
66
.RETURNS
 
67
  1 = host command
 
68
  0 = Midas command
 
69
------------------------------------------------------------------*/
 
70
 
 
71
char *string;           /* IN: line to be checked */
 
72
 
 
73
{
 
74
int   defset, n, m, nbra;
 
75
 
 
76
char  *mypntr, *kpntr, mybuf[16];
 
77
char  command[6], qualif[4], defqual[4];
 
78
register char  cc, kk;
 
79
 
 
80
 
 
81
 
 
82
mypntr = string;
 
83
 
 
84
while ((cc = *mypntr))                  /* '\0' => 0 or false */
 
85
   {
 
86
   if ((cc != ' ') && (cc != '\t'))
 
87
      {
 
88
      if (cc == '$') return 1;          /* Yes, it's a Host command */
 
89
 
 
90
      if ((cc == '@') || (cc == '-')) 
 
91
         return 0;              /* No, Midas procedure, Midas-host cmnd */
 
92
   
 
93
      kpntr = mypntr;
 
94
      for (m=1; m<16; m++)
 
95
         {
 
96
         kk = *kpntr++;
 
97
         if ((kk == '\0') || (kk == ' ') || (kk == '\t')) 
 
98
            {                                   /* end of token reached */
 
99
            (void) memcpy(mybuf,mypntr,(size_t)m);
 
100
            mybuf[m] = '\0';
 
101
            EXTRACOM(mybuf,command,qualif);
 
102
            if (command[0] != '\0')
 
103
               {
 
104
               if (FINDCOM(command,qualif,defqual,&defset,&nbra,&mypntr,&n) < 2)
 
105
                  {                     /* Yes, valid Midas command found */
 
106
                  if ((nbra < 0) || (*mypntr != '$')) return 0;
 
107
                  }
 
108
               }
 
109
            return 1;                   /* not recognized as Midas command */
 
110
            }
 
111
         }
 
112
      return 1;
 
113
      }
 
114
 
 
115
   mypntr ++;                           /* skip over white space */
 
116
   }
 
117
 
 
118
return 1;
 
119
} 
 
120
 
 
121
/*
 
122
 
 
123
*/
 
124
 
 
125
int break_line(more_flag,rmaind)
 
126
int   *more_flag;       /* IN/OUT: indicates if we have several commands 
 
127
                                   on the line */
 
128
char  *rmaind;          /* IN/OUT: buffer holding the remainder (if any) 
 
129
                                   of the command line */
 
130
/* return -1 if only comment line, else return value > 0 */
 
131
 
 
132
{
 
133
register int  nr;
 
134
int     ist, apo_mode, apo_off, kk, iwb;
 
135
static int  pipeflag = 0;
 
136
 
 
137
register char sngc;
 
138
static char  pipo[12] = "1234567890";
 
139
static char  Mpipe[12] = "Mid   Pipe ";         /* length = 11 */
 
140
 
 
141
 
 
142
 
 
143
if (*more_flag != 0)            /* get next command from saved remainder */
 
144
   {
 
145
   if (*rmaind == '^')
 
146
      {
 
147
      pipeflag ++;
 
148
      LINE.LEN = CGN_COPY(LINE.STR,rmaind+1);
 
149
      }
 
150
    else
 
151
      LINE.LEN = CGN_COPY(LINE.STR,rmaind);
 
152
   *more_flag = 0;
 
153
   }
 
154
else
 
155
   pipeflag = 0;
 
156
 
 
157
   
 
158
/* process double quotes  " ... " */
 
159
 
 
160
iwb = -1;
 
161
apo_mode = 0;                          /* after first '"' apo_mode = 1 */
 
162
apo_off = 0;
 
163
 
 
164
loop1:
 
165
for (nr=apo_off; nr<LINE.LEN; nr++)
 
166
   {
 
167
   sngc = LINE.STR[nr];
 
168
 
 
169
   if (sngc == '"')
 
170
      {                                 /* switch between 0 and 1 */
 
171
      if (apo_mode == 0) apo_off = nr;
 
172
      apo_mode ^= 1;                    /* XOR with 1: 0 => 1, 1 => 0 */
 
173
      }
 
174
 
 
175
   else if ((apo_mode != 0) || (sngc == ' '))   
 
176
      continue; 
 
177
 
 
178
   else if (sngc == '\t')
 
179
      {
 
180
      LINE.STR[nr] = ' ' ;
 
181
      continue; 
 
182
      }
 
183
 
 
184
   else if (sngc == '!')
 
185
      {
 
186
      if (iwb > 0)                              /* then nr > 0 !  */
 
187
         {
 
188
         kk = nr - 1;
 
189
         if (LINE.STR[kk] == ' ')               /* cut off at comments */
 
190
            {
 
191
            LINE.LEN = kk;
 
192
            LINE.STR[kk] = '\0';
 
193
            goto end_job;
 
194
            }
 
195
         }
 
196
      else
 
197
         return (iwb);                          /* only comments ... */
 
198
      }
 
199
 
 
200
   else if (sngc == ';')
 
201
      {
 
202
      if (iwb < 0)
 
203
         {
 
204
         ist = nr + 1;
 
205
         LINE.LEN -= ist;                       /* omit very 1. `;' */
 
206
         (void) memcpy(LINE.STR,&LINE.STR[ist],(size_t)(LINE.LEN+1));
 
207
         }
 
208
      else
 
209
         {
 
210
         register int mr, pa, pb;
 
211
         register char cr;
 
212
 
 
213
         kk = nr - 1;
 
214
         pa = 0; pb = 0;
 
215
         for (mr=kk; mr>-1; mr--)
 
216
            {
 
217
            cr = LINE.STR[mr];
 
218
            if (cr == ')') 
 
219
               pb ++;
 
220
            else if (cr == '(') 
 
221
               pa ++;
 
222
            }
 
223
         if (pa > pb) continue;         /* ignore ';' in (..) */
 
224
 
 
225
         if (LINE.STR[kk] == '\\') 
 
226
            {
 
227
            CGN_strcpy(&LINE.STR[kk],&LINE.STR[nr]);
 
228
            LINE.LEN -- ;
 
229
            apo_off = nr;                       /* start here in next run */
 
230
            }
 
231
         else                                   /* single `;' found */
 
232
            {                                   /* save remaining part */
 
233
            (void) strcpy(rmaind,&LINE.STR[nr+1]);
 
234
            LINE.LEN = nr;
 
235
            LINE.STR[nr] = '\0';
 
236
            *more_flag = nr;
 
237
            goto end_job;
 
238
            }
 
239
         }
 
240
      goto loop1;                               /* start again */
 
241
      }
 
242
 
 
243
   else if (sngc == '|')                /* also, look for | (pipe) */
 
244
      {
 
245
      if (LINE.STR[nr+1] == ' ')        /* YES */
 
246
         {
 
247
         Mpipe[3] = FRONT.DAZUNIT[0];
 
248
         Mpipe[4] = FRONT.DAZUNIT[1];
 
249
         Mpipe[5] = pipo[pipeflag];
 
250
         ist = ishostcom(LINE.STR);
 
251
         kk = ishostcom(&LINE.STR[nr+2]);
 
252
         if (ist == 0)          /* Midascom `|' Hostcom/Midascom */
 
253
            {           
 
254
            rmaind[0] = '^';                    /* indicate <MidasPipe ... */
 
255
            (void) strcpy(&rmaind[1],&LINE.STR[nr+2]);   /* add last part */
 
256
            LINE.STR[nr++] = '>';
 
257
            (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
 
258
            LINE.LEN = (int)strlen(LINE.STR);
 
259
            *more_flag = nr;
 
260
            goto end_job;
 
261
            }
 
262
             
 
263
         if (kk == 0)           /* Hostcom `|' Midascom */
 
264
            {
 
265
            rmaind[0] = '^';                    /* indicate <MidasPipe ... */
 
266
            (void) strcpy(&rmaind[1],&LINE.STR[nr+2]);   /* add last part */
 
267
            LINE.STR[nr++] = '>';
 
268
            (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
 
269
            LINE.LEN = (int)strlen(LINE.STR);
 
270
            *more_flag = nr;
 
271
            goto end_job;
 
272
            }
 
273
         
 
274
         /* final check is for:  Hostcom `|' Hostcom */
 
275
             
 
276
         if (pipeflag == 1)
 
277
            {                   /* insert input file before `|' */
 
278
            (void) strcpy(rmaind,&LINE.STR[nr]);
 
279
            LINE.STR[nr++] = ' ';
 
280
            LINE.STR[nr++] = '<';
 
281
            Mpipe[5] = pipo[pipeflag-1];
 
282
            (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
 
283
            (void) strcat(LINE.STR,rmaind);
 
284
            LINE.LEN = (int)strlen(LINE.STR);
 
285
            pipeflag = 0;
 
286
            }
 
287
         else if (LINE.STR[nr+2] == '$')
 
288
            LINE.STR[nr+2] = ' ';               /* remove the `$' char. */
 
289
         }
 
290
      }
 
291
 
 
292
   iwb = 1;                             /* all "normal" chars. end up here */
 
293
   }
 
294
 
 
295
if (apo_mode != 0)                      /* = 1, so was just a single '"' */
 
296
   {
 
297
   apo_off ++;
 
298
   apo_mode = 0;        /* avoid infinite loop, if `"' very last char.! */
 
299
   goto loop1;
 
300
   }
 
301
   
 
302
end_job:
 
303
if (pipeflag != 0)
 
304
   {
 
305
   Mpipe[5] = pipo[pipeflag-1];                 /* pipe from last time */
 
306
   for (nr=LINE.LEN-2; nr>0; nr--)              /* omit trailing blank */
 
307
      {
 
308
      if (LINE.STR[nr] == ' ') 
 
309
         { 
 
310
         if (LINE.STR[nr+1] == '>')
 
311
            {
 
312
            if (LINE.STR[nr+2] == '>')
 
313
               sngc = CGN_UPPER(LINE.STR[nr+3]);
 
314
            else
 
315
               sngc = CGN_UPPER(LINE.STR[nr+2]);
 
316
            if ((sngc >= 'A') && (sngc <= 'Z'))
 
317
               {
 
318
               char savbuf[200];
 
319
 
 
320
               (void) strcpy(savbuf,&LINE.STR[nr]);
 
321
               LINE.STR[nr++] = ' ';
 
322
               LINE.STR[nr++] = '<';
 
323
               (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
 
324
               (void) strcat(LINE.STR,savbuf);
 
325
               LINE.LEN = (int) strlen(LINE.STR);
 
326
               return (iwb);
 
327
               }
 
328
            }
 
329
         break;
 
330
         }
 
331
      }
 
332
 
 
333
   nr = LINE.LEN;
 
334
   LINE.STR[nr++] = ' ';
 
335
   LINE.STR[nr++] = '<';
 
336
   (void) memcpy(&LINE.STR[nr],Mpipe,(size_t)12);
 
337
   LINE.LEN += 13;                      /* 2 + 11 (= size of Mpipe) */
 
338
   LINE.STR[LINE.LEN] = '\0';           /* just for safety */
 
339
   }
 
340
return (iwb);
 
341
}
 
342
/*
 
343
 
 
344
*/
 
345
 
 
346
void MYBATCH(cmd,procedu)
 
347
 
 
348
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
349
.PURPOSE
 
350
  1) compile program - @ (@@) or # command
 
351
  2) get next command line in "program" mode - NX command
 
352
  3) execute a "batch" command (like *GO, *INC) - N* command
 
353
.ALGORITHM
 
354
  store program/batch file internally + execute it
 
355
  save procedure level also in key MODE(7)
 
356
.RETURNS
 
357
  nothing
 
358
-------------------------------------------------------------------------*/
 
359
 
 
360
char    *cmd;           /* IN: @ or @% or @@ or #A, #C, #S or NX, N* ... */
 
361
char    *procedu;       /* IN: name of procedure, if needed */
 
362
 
 
363
{
 
364
register int nr;
 
365
int   ibuf[20], ikey, lstep, looplim;
 
366
int   lengthCode, m, mm, n, nn, offset, offset1, off_limit;
 
367
int   prcnt, stat, reclen, igoto, lcount, slen;
 
368
int   iwa, iwb, echo=0, fp=0;
 
369
int   xt, mdebug=0, more_cmnds, unit, iav, nullo;
 
370
static int   perror;
 
371
static int   Mbreak[5] = {-1,-1,-1,-1,-1};
 
372
static int   Mbreaklabl[5] = {-1,-1,-1,-1,-1};
 
373
static int   Mdbindx, Mdbcount = -1, *Mdbline, *Mdbptr, Mdbstep;
 
374
 
 
375
char    save[MAX_LINE], *cptr, string[MAX_LINE], keyname[18];
 
376
char    label[24], compile_flag[2], k_type[12];
 
377
char    trans_name[64];
 
378
register char  *tptr, *sptr, firstch, cc;
 
379
static char  asci[9] = {'0','1','2','3','4','5','6','7','8'};
 
380
 
 
381
float   rwa, rkey;
 
382
double  dwa, dkey;
 
383
 
 
384
 
 
385
 
 
386
 
 
387
 
 
388
 
 
389
/*  find out what to do   */
 
390
 
 
391
prcnt = 0;
 
392
perror = 1; 
 
393
if (*cmd == 'N')
 
394
   {
 
395
   if (KIWORDS[OFF_PRSTAT] > 0)         /*  test key PROGSTAT(1)  */
 
396
      {
 
397
      iwa = KIWORDS[OFF_ERROR+2];
 
398
      if ( (iwa == 0) ||
 
399
           ( (iwa != -1) && (iwa != KIWORDS[OFF_PRSTAT]) ) )
 
400
         {
 
401
         MONIT.LEVEL = 1;                       /* if PROGSTAT  !=  0  */
 
402
         goto sect_3300;                        /* abort procedure...!   */
 
403
         }
 
404
      }
 
405
   goto execute;                                /* jump to execute section  */
 
406
   }
 
407
 
 
408
 
 
409
/* ........................................................................ */
 
410
        
 
411
/*             compilation of MIDAS procedure                               */
 
412
        
 
413
/* ........................................................................ */
 
414
        
 
415
 
 
416
 
 
417
compile_flag[0] = *cmd;                 /* save @, @@ or #A or #S  */
 
418
compile_flag[1] = *(cmd+1);
 
419
xt = 0;
 
420
 
 
421
if (compile_flag[0] == '#') 
 
422
   {
 
423
   if (compile_flag[1] != 'C') 
 
424
      (void) strcpy(trans_name,TOKEN[1].STR);
 
425
   if (compile_flag[1] == 'S') 
 
426
      {
 
427
      MONIT.COMPILED = 0;               /* force it back to not-compiled */
 
428
      CGN_UPSTR(TOKEN[2].STR);
 
429
      if (TOKEN[2].STR[0] == 'X') 
 
430
         {
 
431
         if ((TOKEN[2].STR[1] == ',') && (TOKEN[2].STR[2] == 'S'))
 
432
            xt = 2;
 
433
         else
 
434
            xt = 1;
 
435
         }
 
436
      }
 
437
   }
 
438
lcount = 0;                             /* clear line count */
 
439
        
 
440
iwa = ++ MONIT.LEVEL;                   /* MONIT.LEVEL now in [1,10]  */
 
441
if (iwa > MAX_LEVEL)            /* max. MAX_LEVEL levels of are supported  */
 
442
   {    
 
443
   ERRORS.SYS = 20;
 
444
   goto badcompile;
 
445
   }
 
446
 
 
447
MONIT.MXT[iwa] = MONIT.MXT[iwa-1];              /* inherit timeout */
 
448
if (MONIT.MXT[iwa] > 0)
 
449
   {
 
450
   long int ltime;
 
451
 
 
452
   if (iwa > 1) 
 
453
      {
 
454
      MONIT.ENDT[iwa] = MONIT.ENDT[iwa-1];      /* and end time */
 
455
 
 
456
      if ((ltime=oshtime()) >= MONIT.ENDT[iwa])
 
457
         {                                      /* already timed out ... */
 
458
         (void) sprintf(string,
 
459
                "(ERR) Midas procedure %s timed out (%d seconds)",
 
460
                PROC.FNAME,MONIT.MAXTIME);
 
461
         SCTPUT(string);
 
462
         KIWORDS[OFF_PRSTAT] = 998;
 
463
         KIWORDS[OFF_PRSTAT+1] = 10;
 
464
         MONIT.LEVEL = 1;               /* force return to interactive level */
 
465
         goto sect_3300;
 
466
         }
 
467
      }
 
468
   else
 
469
      MONIT.ENDT[iwa] = oshtime() + MONIT.MXT[iwa];  /* calculate end time */
 
470
   }
 
471
 
 
472
stat = CODE_ALLOC(0);                /* create with default size */
 
473
off_limit = CODE.LEN - 2;               /* hi limit of code  */
 
474
if (stat != 0)
 
475
   {
 
476
   ERRORS.SYS = 25;
 
477
   goto badcompile;
 
478
   }
 
479
 
 
480
 
 
481
/*  check, if we use same code again */
 
482
 
 
483
if (MONIT.LEVEL <= MONIT.TOPLEVL)
 
484
   {  
 
485
   m = CODE_PRNAME + 8;
 
486
   iwa = strcmp(PROC.FNAME,&CODE.CODE[m]);
 
487
   if (iwa == 0)
 
488
      {
 
489
      if (strncmp(PROC.ENTRY,&CODE.CODE[CODE_PRNAME],8) == 0)
 
490
         {
 
491
         MONIT.COMPILED = 1;
 
492
         goto file_ok;
 
493
         }
 
494
      }
 
495
   }
 
496
 
 
497
 
 
498
doit_again:
 
499
*(CODE.CODE+CODE_START) = '\r';          /* set first char. of code to '\r' */
 
500
 
 
501
        
 
502
/*  open procedure file or get already compiled code from internal.cod  */
 
503
 
 
504
if (MONIT.COMPILED == 0)
 
505
   {
 
506
   ERRORS.SYS = 79;
 
507
   fp = osaopen(procedu,0);            /*  means reading only */
 
508
   if (fp == -1) 
 
509
      {                                /* try to open in CPATH directories  */
 
510
      if (compile_flag[1] != '@') 
 
511
         goto badcompile;               /* but only for @@ command */
 
512
 
 
513
      for (nr=0; nr<4; nr++)
 
514
         {
 
515
         if (CPATH[nr].STR[0] != '\0') 
 
516
            {
 
517
            (void) strcpy(string,CPATH[nr].STR);
 
518
            (void) strcat(string,procedu);
 
519
            fp = osaopen(string,0);
 
520
            if (fp != -1) goto open_ok;
 
521
            }
 
522
         }
 
523
      if (fp == -1) goto badcompile;            /* now it's really bad ... */
 
524
      }
 
525
 
 
526
  open_ok:
 
527
   if (PROC.ENTRY[0] != ' ')
 
528
      {
 
529
      for (nr=7; nr>0; nr--)
 
530
          {
 
531
          if (PROC.ENTRY[nr] != ' ')
 
532
             break;
 
533
          }
 
534
      slen = nr + 1;
 
535
      iwa = slen + 6;                           /* length of "ENTRY name"   */
 
536
 
 
537
ent_loop:
 
538
      lcount ++;
 
539
      reclen = osaread(fp,string,MAX_LINE);     /* look for: ENTRY proc_entry */
 
540
      if (reclen == 0)
 
541
         goto ent_loop;
 
542
      else if (reclen < 0)
 
543
         {
 
544
         osaclose(fp);
 
545
         ERRORS.SYS = 18;               /* procedure entry couldn't be found */
 
546
         goto badcompile;
 
547
         }
 
548
 
 
549
      for (nr=0; nr<=(reclen-iwa); nr++)
 
550
         {
 
551
         if ( (string[nr] != '\t') && (string[nr] != ' ') )
 
552
            {
 
553
            if ( (strncmp(&string[nr],"ENTRY",5) != 0) &&
 
554
                 (strncmp(&string[nr],"entry",5) != 0) ) goto ent_loop;
 
555
    
 
556
            nr += 6;              /* skip over `ENTRY' + following blanks */
 
557
            while ( (string[nr] == '\t') || (string[nr] == ' ') ) nr++;
 
558
 
 
559
            CGN_UPCOPY(save,&string[nr],8);
 
560
            if ( (strncmp(save,PROC.ENTRY,slen) == 0) ||
 
561
                 (save[0] == '*') )          /* matching or wild card entry */
 
562
               goto file_ok;
 
563
      
 
564
            break;                                      /* get out of loop */
 
565
            } 
 
566
         }
 
567
      goto ent_loop;                            /* catch blank line ...  */
 
568
      }
 
569
   }
 
570
else
 
571
   {
 
572
   save[0] = 'F';
 
573
   stat = INTERNAL(save,TOKEN[1].STR,&lengthCode);      /* get compiled code */
 
574
   if (unlikely(stat != 0))
 
575
      {
 
576
      ERRORS.SYS = 22;
 
577
      if (stat == 2)                    /* internal.cod not opened */
 
578
         {
 
579
         (void)printf("MID_PROC:internal.cod could not be opened...\n");
 
580
         (void)printf("do  '@ compile.all'  to create a new internal.cod\n");
 
581
         MONIT.LEVEL = 1;               /* force exit */
 
582
         goto badcompile_1;
 
583
         }
 
584
      else
 
585
         goto badcompile;
 
586
      }
 
587
   if (unlikely(lengthCode >= off_limit)) 
 
588
      {                                 /* for compiled code no overflow! */
 
589
      ERRORS.SYS = 25;
 
590
      goto badcompile;
 
591
      }
 
592
   }
 
593
 
 
594
        
 
595
/*  file open o.k. */
 
596
 
 
597
file_ok:
 
598
 
 
599
if (MONIT.PDEBUG[MONIT.LEVEL] == 2)
 
600
   MONIT.PDEBUG[MONIT.LEVEL] = 1;                   /* reset debugging flag  */
 
601
 
 
602
for (nn=MONIT.COUNT; nn>2; nn--)
 
603
   {
 
604
   nr = nn - 1;                         /* move to C-indexing */
 
605
   if ((TOKEN[nr].STR[0] != '?')
 
606
      ||
 
607
      (TOKEN[nr].STR[1] != '\0'))
 
608
      {
 
609
      MONIT.COUNT = nn;
 
610
      break;
 
611
      }
 
612
   }
 
613
*CODE.CODE = asci[MONIT.COUNT-2];        /* save no. of actual pars in proc. */
 
614
CROSS_PARM();                   /* store passed parameters in crossref table */
 
615
                                        /* hold this line until we SAVE_PARM */
 
616
(void) memcpy(save,LINE.STR,(size_t)(LINE.LEN+1));
 
617
        
 
618
 
 
619
/*  initialize default area  */
 
620
 
 
621
(void) 
 
622
memcpy((CODE.CODE+CODE_DEFS),"?\r?\r?\r?\r?\r?\r?\r?\r\r",(size_t)17);
 
623
nn = MONIT.LEVEL * 15;
 
624
(void) 
 
625
memcpy(&PROC.FORMAT[nn],"4.4  15.5 15.5 ",(size_t)15);  /* init FORMATs */
 
626
 
 
627
if (MONIT.COMPILED == 1)
 
628
   goto final_save;             /* if compiled code, we're already done */
 
629
    
 
630
 
 
631
/* check for individually compiled procedure */
 
632
 
 
633
offset = CODE_START;            /* code starts at position CODE_START */
 
634
 
 
635
nn = (int) strlen(procedu);
 
636
if (nn > 3) 
 
637
   {                            /* look for name.prg_o */
 
638
#if vms
 
639
   if ((procedu[nn-1] == 'O') &&
 
640
       (procedu[nn-2] == '_') &&
 
641
       (procedu[nn-3] == 'G'))
 
642
#else
 
643
   if ((procedu[nn-1] == 'o') &&
 
644
       (procedu[nn-2] == '_') &&
 
645
       (procedu[nn-3] == 'g'))
 
646
#endif
 
647
      {                         /* Yes, we already have the compiled code */
 
648
      reclen = osaread(fp,string,MAX_LINE);     /* get size of code */
 
649
      if (reclen < 1) goto badcompile_1;
 
650
 
 
651
      iwa = -1;
 
652
      iwa = atoi(string);
 
653
      if (iwa < 1) goto badcompile_1;
 
654
 
 
655
     lim_check:
 
656
      if (iwa >= off_limit)                   /* CODE overflow?  */
 
657
         {
 
658
         nn = CODE.LEN + CODE.LEN;            /* take twice the current size */
 
659
         if (CODE_ALLOC(nn) == 0)
 
660
            {                                 /* also updates CODE.LEN */
 
661
            off_limit = CODE.LEN - 2;         /* new high limit of code  */
 
662
            (void) memcpy((CODE.CODE+CODE_DEFS),    /* CODE_ALLOC() clears! */
 
663
                          "?\r?\r?\r?\r?\r?\r?\r?\r\r",(size_t)17);
 
664
            goto lim_check;
 
665
            }
 
666
         ERRORS.SYS = 25;                     /* problems with malloc ... */
 
667
         goto badcompile;
 
668
         }
 
669
 
 
670
     opt_loop:
 
671
      reclen = osaread(fp,&CODE.CODE[offset],MAX_LINE);
 
672
      if (reclen < 1)
 
673
         {
 
674
         CODE.CODE[offset++] = '\r';
 
675
         CODE.CODE[offset] = '\0';
 
676
         lengthCode = offset;
 
677
         (void) osaclose(fp);
 
678
         goto final_save;
 
679
         }
 
680
      else
 
681
         {
 
682
         offset += reclen;
 
683
         CODE.CODE[offset++] = '\r';
 
684
         goto opt_loop;
 
685
         }
 
686
      }
 
687
   }
 
688
 
 
689
 
 
690
(void) COMPILE(8,&iwa);                  /* init COMPILER ... */
 
691
more_cmnds = 0;                 /* indicates, if more commands on a line */
 
692
 
 
693
rd_init:                        /*  now work line by line...  */
 
694
nn = 0;
 
695
if (more_cmnds > 0)
 
696
   {
 
697
   mm = break_line(&more_cmnds,string);
 
698
   if (mm != -1) goto start_parser;             /* drop comment line */
 
699
   }
 
700
 
 
701
rd_loop:
 
702
lcount ++;
 
703
reclen = osaread(fp,string,MAX_LINE);           /* read a record from file */
 
704
 
 
705
if (reclen < 1)
 
706
   {
 
707
   if (reclen < 0)
 
708
      goto eof_found;                           /*  EOF encountered  */
 
709
   else
 
710
      goto rd_loop;                             /* empty line */
 
711
   }
 
712
 
 
713
if ( (string[0] == '!') && (nn == 0) )
 
714
   goto rd_loop;                        /* catch comments already here  */
 
715
 
 
716
if ((reclen + nn) >= MAX_LINE)
 
717
   {                            /* check length of combined input line */
 
718
   ERRORS.SYS = 29;
 
719
   goto badcompile;
 
720
   }
 
721
 
 
722
(void) memcpy(&LINE.STR[nn],string,(size_t)(reclen+1));
 
723
LINE.LEN = reclen + nn;
 
724
if (string[reclen-1] == '-')                    /* continuation lines?  */
 
725
   {
 
726
   for (nr=0; nr<reclen-1; nr++)                /* test for " !" first... */
 
727
      {
 
728
      if (string[nr] == '!')
 
729
         {
 
730
         if (nr == 0)
 
731
            goto no_cont;
 
732
         else
 
733
            {
 
734
            iwa = nr - 1;
 
735
            if ((string[iwa] == ' ') ||
 
736
                (string[iwa] == '\t'))          /* tab instead of blank */
 
737
            goto no_cont;
 
738
            }
 
739
         }
 
740
      }
 
741
 
 
742
   nn = LINE.LEN - 1;                   /* drop continuation character  */
 
743
   goto rd_loop;
 
744
   }
 
745
 
 
746
no_cont:
 
747
LINE.STR[LINE.LEN] = '\0';
 
748
more_cmnds = 0;
 
749
mm = break_line(&more_cmnds,string);
 
750
if (mm == -1) goto rd_init;             /* drop comment line */
 
751
        
 
752
 
 
753
/*  now parse command line stored in LINE.STR  */
 
754
 
 
755
start_parser:
 
756
ERRORS.SYS = PARSE(0,0,0);                              /* raw parsing  */
 
757
if (unlikely(ERRORS.SYS != 0))
 
758
   {
 
759
   perror = 0;
 
760
   goto badcompile;
 
761
   }
 
762
 
 
763
if (MONIT.COUNT < 1) goto rd_init;                      /* nothing there */
 
764
        
 
765
        
 
766
/*  look for commands which have to be compiled  */
 
767
 
 
768
tptr = TOKEN[0].STR;
 
769
firstch = *tptr;
 
770
 
 
771
if ( (firstch != '$') &&          /* avoid Host + immediate commands */
 
772
     ((TOKEN[1].STR[0] != '=') || (TOKEN[1].LEN != 1)) )
 
773
   {
 
774
   CGN_UPSTR(tptr);
 
775
 
 
776
   if (TOKEN[0].STR[TOKEN[0].LEN-1] == ':')     /* first, test for labels */
 
777
      {
 
778
      if (unlikely ((firstch >= '0') && (firstch <= '9')) )
 
779
         {
 
780
         ERRORS.SYS = 25;
 
781
         goto badexec;
 
782
         }
 
783
 
 
784
      MONIT.COUNT = 1;                          /* ignore trailing stuff */
 
785
      iwa = offset + TOKEN[0].LEN + 1;
 
786
      goto after_add_star;
 
787
      }
 
788
       
 
789
   if (strcmp(tptr,"END") == 0) /* look for END IF, END DO */
 
790
      {
 
791
      CGN_UPCOPY(KAUX.STR,TOKEN[1].STR,3);
 
792
      if (KAUX.STR[2] == '\0') 
 
793
         {
 
794
         if ((KAUX.STR[0] == 'D') && (KAUX.STR[1] == 'O'))
 
795
            {
 
796
            *(tptr+3) = 'D';
 
797
            *(tptr+4) = 'O';
 
798
            }
 
799
         else if ((KAUX.STR[0] == 'I') && (KAUX.STR[1] == 'F'))
 
800
            {
 
801
            *(tptr+3) = 'I';
 
802
            *(tptr+4) = 'F';
 
803
            }
 
804
         *(tptr+5) = '\0';
 
805
         }
 
806
      }
 
807
 
 
808
   for (n=0; n<MAX_BATCH; n++)
 
809
      {
 
810
      if (strcmp(tptr,BATCH[n].CMND) == 0)
 
811
         {
 
812
         iwa = offset;                  /* check for CODE overflow */
 
813
         for (nr=0; nr<MONIT.COUNT; nr++) 
 
814
            iwa += TOKEN[nr].LEN;
 
815
         iwa += 64;                             /* add space for expansion */
 
816
         if (iwa >= off_limit)                  /* in COMPILE  */
 
817
            goto after_add_star;
 
818
 
 
819
         ERRORS.SYS = COMPILE(n,&offset);
 
820
         if (ERRORS.SYS == 0)           /* check for syntax errors  */
 
821
            goto rd_init;               /* all o.k. - get next line  */
 
822
          
 
823
         perror = 0;                    /* something wrong... */
 
824
         goto badcompile;
 
825
         }
 
826
      }
 
827
 
 
828
 
 
829
/*  if first token is ENTRY, treat it like an EOF  */
 
830
 
 
831
   if (strcmp(tptr,"ENTRY") == 0)
 
832
      goto eof_found;
 
833
 
 
834
 
 
835
/*  look for  GOTO, PAUSE, BRANCH, CROSSREF, RETURN + preprocess it  */
 
836
 
 
837
   if ( (strcmp(tptr,"GOTO") == 0) ||
 
838
        (strcmp(tptr,"BRANCH") == 0) ||
 
839
        (strcmp(tptr,"CROSSREF") == 0) )
 
840
      goto add_star;
 
841
 
 
842
   if (strcmp(tptr,"PAUSE") == 0) 
 
843
      {
 
844
      char  tempy[40];
 
845
 
 
846
      nn = CGN_COPY(tempy,"move/local out^*PA^^");
 
847
      iwa = offset + nn;
 
848
      if (iwa >= off_limit)                   /* CODE overflow?  */
 
849
         goto after_add_star;
 
850
 
 
851
      for (nr=0; nr<nn; nr++)
 
852
         {
 
853
         if (tempy[nr] == '^') tempy[nr] = '\r';
 
854
         }
 
855
      (void) strcpy(&CODE.CODE[offset],tempy);
 
856
      offset += (nn - 1);
 
857
      goto rd_init;
 
858
      }
 
859
 
 
860
   if (strncmp(tptr,"RETURN",6) == 0)
 
861
      {
 
862
      if ( (*(tptr+6) == '/') && (*(tptr+7) == 'E') )
 
863
         *(tptr+1) = 'X';                       /* take care of RETURN/EXIT  */
 
864
 
 
865
add_star:
 
866
      *(tptr+2) = *(tptr+1);
 
867
      *(tptr+1) = *tptr;
 
868
      *tptr = '*';
 
869
      TOKEN[0].LEN = 3;
 
870
      }
 
871
   }
 
872
 
 
873
        
 
874
/*  now fill CODE with command string  */
 
875
 
 
876
iwa = offset;
 
877
for (nr=0; nr<MONIT.COUNT; nr++) iwa += TOKEN[nr].LEN;
 
878
iwa += MONIT.COUNT;                     /* we also need that many blanks */
 
879
 
 
880
after_add_star:
 
881
if (iwa >= off_limit)                   /* CODE overflow?  */
 
882
   {
 
883
   nn = 2 * CODE.LEN;                   /* take twice the current size */
 
884
   stat = CODE_ALLOC(nn);
 
885
   off_limit = CODE.LEN - 2;            /* hi limit of code  */
 
886
   if (unlikely(stat != 0))
 
887
      {
 
888
      ERRORS.SYS = 25;
 
889
      goto badcompile;
 
890
      }
 
891
    
 
892
   (void) osaclose(fp);
 
893
   LINE.LEN = CGN_COPY(LINE.STR,save);  /* get back original */
 
894
   (void) PARSE(1,0,0);                         /* line ... */
 
895
   goto doit_again;
 
896
   }
 
897
 
 
898
for (nr=0; nr<MONIT.COUNT; nr++)
 
899
   {
 
900
   mm = TOKEN[nr].LEN;
 
901
   (void) memcpy(&CODE.CODE[offset],TOKEN[nr].STR,(size_t)mm);
 
902
   offset += mm;
 
903
   CODE.CODE[offset++] = ' ';
 
904
   }
 
905
 
 
906
CODE.CODE[offset-1] = '\r';
 
907
CODE.CODE[offset] = '\r';
 
908
CODE.CODE[offset+1] = '\0';
 
909
goto rd_init;
 
910
        
 
911
 
 
912
/*  EOF encountered  */
 
913
 
 
914
eof_found:
 
915
 
 
916
(void) osaclose(fp);
 
917
stat = COMPILE(9,&offset);              /* check nesting levels...  */
 
918
if (stat != 0)
 
919
   {
 
920
   perror = 0;
 
921
   ERRORS.SYS = 28;
 
922
   goto badcompile;
 
923
   }
 
924
lengthCode = offset + 1;                        /*  get length of code  */
 
925
 
 
926
        
 
927
/* save final parameters in keys P1 ... P8  */
 
928
 
 
929
final_save:                              /*  save program counters  */
 
930
ERRORS.SYS = SAVE_PARM(1,&nn);
 
931
if (ERRORS.SYS != 0)
 
932
   {
 
933
   (void) strncpy(LINE.STR,save,80);
 
934
   LINE.LEN = 80;
 
935
   LINE.STR[LINE.LEN] = '\0';
 
936
   goto badcompile;
 
937
   }
 
938
 
 
939
 
 
940
/* set ProgCounter for higher level to start of code */
 
941
 
 
942
MONIT.PCODE[MONIT.LEVEL-1] = nn; 
 
943
 
 
944
 
 
945
/* now check for debug mode */
 
946
 
 
947
if ((MONIT.PDEBUG[MONIT.LEVEL] > 0) && (compile_flag[0] != '#'))
 
948
   {
 
949
   MONIT.PDEBUG[MONIT.LEVEL] = 1;               /* force to stepwise mode */
 
950
   if (Mdbcount == -1)
 
951
      {                                         /* allocate space for */
 
952
      char  *pbuf;                              /* Mdb line count */
 
953
 
 
954
      pbuf = malloc((size_t)CODE.LEN);
 
955
      if (pbuf == (char *) NULL)
 
956
         {
 
957
         (void) printf("could not allocate memory for Mdbline ...\n");
 
958
         MONIT.PDEBUG[MONIT.LEVEL] = 0;         /* reset switch */
 
959
         goto after_Mdbcount;
 
960
         }
 
961
      Mdbptr = (int *) pbuf;            /* points to allocated space */
 
962
      }
 
963
 
 
964
   /* fill array Mdbline with offsets (in CODE.CODE) for each line */
 
965
 
 
966
   Mdbstep = 0;                         /* no. of steps in `step' command */
 
967
   Mdbline = Mdbptr;
 
968
   Mdbcount = 0;                        /* reset the line counter */
 
969
   iwa = CODE_START;
 
970
 
 
971
   if (strncmp(&CODE.CODE[iwa],"*CR",3) == 0)   /* check, if CROSSREF cmnd */
 
972
      {
 
973
      nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');    /* Yes, so skip it */
 
974
      iwa += (nn + 1);
 
975
      }
 
976
 
 
977
  Mdb_loop1:
 
978
   nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');
 
979
   if (nn > 0)
 
980
      {
 
981
      *Mdbline++ = iwa;                 /* save offset of CODE.CODE */
 
982
      Mdbcount ++;
 
983
      iwa += (nn + 1);
 
984
      goto Mdb_loop1;
 
985
      }
 
986
 
 
987
   for (nr=0; nr<5; nr++)                       /* clear breakpoints */
 
988
      {
 
989
      if (Mbreak[nr] >= MONIT.LEVEL)
 
990
         Mbreak[nr] = -1;                       /* reset it */
 
991
      }
 
992
   (void) 
 
993
   printf("\nMidas debugger (Mdb) running procedure `%s' with  %d lines\n\n",
 
994
          procedu,Mdbcount);
 
995
   }
 
996
 
 
997
 
 
998
/*  if we compile,  call INTERNAL with A(dd) option  */
 
999
 
 
1000
after_Mdbcount:
 
1001
if (compile_flag[0] != '#')
 
1002
   {
 
1003
   KIWORDS[OFF_MODE+6] = MONIT.LEVEL;      /* update MODE(7) for local keys  */
 
1004
   (void) strncpy(&CODE.CODE[CODE_PRNAME],PROC.ENTRY,8);       /* save entry */
 
1005
   m = CODE_PRNAME + 8;
 
1006
   (void) memcpy(&CODE.CODE[m],PROC.FNAME,(size_t)80); /* and procedure name */
 
1007
   CODE.CODE[m+80] = '\0';                          /* limit to 80 chars.    */
 
1008
   return;
 
1009
   }
 
1010
 
 
1011
 
 
1012
 
 
1013
if (compile_flag[1] == 'S')                     /* handle TRANSLATE/SHOW */
 
1014
   {
 
1015
   char    type[4];
 
1016
   int     tokovf, bad;
 
1017
 
 
1018
   offset = CODE_START;
 
1019
   tokovf = 0;                          /* TOKEN overflow flag */
 
1020
   iwb = 0;                             /* error count */
 
1021
 
 
1022
 show_loop:                             /* find end of current command line */
 
1023
   mm = CGN_INDEXC(&CODE.CODE[offset],'\r');
 
1024
   if (mm < 1)                                  /* end of procedure */
 
1025
      {
 
1026
      int  warn[2];
 
1027
 
 
1028
      if (xt == 0)
 
1029
         {
 
1030
         SCTPUT("----------------");
 
1031
         (void) sprintf(LINE.STR,"total length = %d chars",offset);
 
1032
         SCTPUT(LINE.STR); 
 
1033
         }
 
1034
 
 
1035
      CGN_CLEANF(trans_name,6,KAUX.STR,64,&nn,&nn);
 
1036
      if (iwb > 0)
 
1037
         {
 
1038
         (void) sprintf(LINE.STR,"%s: %d warnings encountered ...",
 
1039
                        KAUX.STR,iwb);
 
1040
         SCTPUT(LINE.STR);
 
1041
         }
 
1042
      if (tokovf > 0)
 
1043
         {
 
1044
         (void) sprintf(LINE.STR,"%s: %d severe warnings encountered ...",
 
1045
                        KAUX.STR,tokovf);
 
1046
         SCTPUT(LINE.STR);
 
1047
         }
 
1048
      warn[0] = iwb + tokovf;
 
1049
      warn[1] = tokovf;
 
1050
      if ((warn[0] == 0) && (xt != 2))
 
1051
         {
 
1052
         (void) sprintf(LINE.STR,"%s: all o.k. ",KAUX.STR);
 
1053
         SCTPUT(LINE.STR); 
 
1054
         }
 
1055
 
 
1056
      (void) SCKWRI("MID$INFO",warn,1,2,&unit);
 
1057
      goto sect_2300;           /* move back up */
 
1058
      }
 
1059
   
 
1060
 
 
1061
   /* now check the comm/qualif string */
 
1062
 
 
1063
   (void) strncpy(LINE.STR,&CODE.CODE[offset],mm);
 
1064
   LINE.STR[mm] = '\0';
 
1065
   LINE.LEN = mm;
 
1066
 
 
1067
   nn = PARSE(-1,0,0);          /* parse again to get TOKEN structure filled */
 
1068
   if (nn == -99)
 
1069
      {                                 /* suspicious ... */
 
1070
      if ( ((TOKEN[1].STR[0] == '=') && (TOKEN[1].LEN == 1)) 
 
1071
           || (TOKEN[0].STR[0] == '$') )
 
1072
         goto after_99;
 
1073
 
 
1074
      if (xt != 2)
 
1075
         {
 
1076
         (void) strcpy(string,"----- more than 10 TOKEN in line: ");
 
1077
         SCTPUT(string);
 
1078
         SCTPUT(LINE.STR);
 
1079
         SCTPUT(" " );
 
1080
         }
 
1081
      tokovf ++;
 
1082
      goto do_show_loop;
 
1083
      }
 
1084
 
 
1085
  after_99:
 
1086
   if (xt == 0)
 
1087
      {
 
1088
      SCTPUT(LINE.STR); 
 
1089
      offset += (mm + 1);
 
1090
      goto show_loop;
 
1091
      }
 
1092
 
 
1093
   bad = 0;
 
1094
once_more_1:
 
1095
   cptr = LINE.STR;
 
1096
   type[0] = '"';
 
1097
   type[1] = '{';
 
1098
   type[2] = '\0';
 
1099
   m = CGN_INDEXS(cptr,type);
 
1100
   if ((m > 0) && (*(cptr+m-1) != ' ') && (*(cptr+m-1) != '{') )
 
1101
      {
 
1102
      n = CGN_INDEXC(cptr,'}');
 
1103
      if ((n > m) && (*(cptr+n+1) == '"'))
 
1104
         {
 
1105
         int  sbytelem, snoelem;
 
1106
 
 
1107
         nn = m + 2;
 
1108
         (void) strncpy(string,cptr+nn,n-nn);
 
1109
         string[n-nn] = '\0';
 
1110
         if ( (CGN_INDEXC(string,',') > 0) ||
 
1111
              (CGN_INDEXC(string,'[') > 0) ) goto do_show_loop;
 
1112
 
 
1113
         nn = MID_FNDKEY(string,type,&sbytelem,&snoelem,&unit); 
 
1114
         if ( ((nn == -1) || (type[0] == 'C')) ||
 
1115
              (CGN_INDEXS(cptr,"M$") > 0) )
 
1116
            {
 
1117
            if (bad == 0)
 
1118
               {
 
1119
               bad = 1;
 
1120
               iwb ++;
 
1121
               if (xt == 1)
 
1122
                  {
 
1123
                  SCTPUT(LINE.STR);
 
1124
                  SCTPUT("----- bad coding style");
 
1125
                  }
 
1126
               }
 
1127
            (void) strcpy(string,cptr);
 
1128
            (void) strcpy(&string[m],cptr+m+2);
 
1129
            if (*(cptr+n+2) == '\0')
 
1130
               string[n-2] = '\0';
 
1131
            else
 
1132
               (void) strcpy(&string[n-2],cptr+n+2);
 
1133
            (void) strcpy(LINE.STR,string);
 
1134
            goto once_more_1;
 
1135
            }
 
1136
         }
 
1137
      }
 
1138
   if (bad == 1)
 
1139
      {
 
1140
      bad = 0;
 
1141
      if (xt == 1)
 
1142
         {
 
1143
         (void) strcpy(string,"----- should be: ");  /* length = 17 */
 
1144
         (void) strcpy(&string[17],cptr);
 
1145
         SCTPUT(string);
 
1146
         }
 
1147
      goto do_show_loop;
 
1148
      }
 
1149
 
 
1150
   if ((*cptr == '$') || (*cptr == '-') || 
 
1151
       (*cptr == '@') || (*cptr == '*') || (*(cptr+1) == ','))
 
1152
      goto do_show_loop;                /* skip special commands */
 
1153
 
 
1154
   nn = CGN_INDEXC(cptr,' ');
 
1155
   if (nn > 0)
 
1156
      {                         /* check for immediate commands */
 
1157
      if ((*(cptr+nn+1) == '=') && (*(cptr+nn+2) == ' '))
 
1158
         goto compkey_check;
 
1159
      }
 
1160
   else 
 
1161
      nn = mm;
 
1162
 
 
1163
   if (*(cptr+nn-1) == ':') goto do_show_loop;  /* avoid labels */
 
1164
 
 
1165
   (void) strncpy(string,cptr,nn);
 
1166
   string[nn] = '\0';
 
1167
   EXTRACOM(string,save,label);
 
1168
   (void) strncpy(&save[10],save,6);
 
1169
   (void) strncpy(&label[10],label,4);
 
1170
   if (label[10] == ' ')
 
1171
      {
 
1172
      for (nr=0; nr<6; nr++)
 
1173
         {
 
1174
         if (save[nr] == '{') goto do_show_loop;
 
1175
         }
 
1176
      if ((strncmp(save,"RUN ",4) != 0) /* if it's not RUN */
 
1177
          &&
 
1178
          (strncmp(save,"HELP",4) != 0)         /* nor HELP */
 
1179
          &&
 
1180
          (strncmp(save,"BYE ",4) != 0))        /* nor BYE */
 
1181
         {
 
1182
         iwb ++;
 
1183
         if (xt == 1)
 
1184
            {
 
1185
            SCTPUT(LINE.STR);
 
1186
            SCTPUT("----- command without qualifier");
 
1187
            }
 
1188
         goto do_show_loop;
 
1189
         }
 
1190
      }
 
1191
 
 
1192
   m = FINDCOM(save,label,&string[100],&n,&n,&cptr,&nn);
 
1193
   if (m > 1) goto do_show_loop;                /* command not found */
 
1194
 
 
1195
   for (nr=0; nr<6; nr++)
 
1196
      {
 
1197
      if (save[nr] != save[10+nr])
 
1198
         {
 
1199
         iwb ++;
 
1200
         if (xt == 1)
 
1201
            {
 
1202
            SCTPUT(LINE.STR); 
 
1203
            SCTPUT("----- incomplete command");
 
1204
            }
 
1205
         goto do_show_loop;
 
1206
         }
 
1207
      }
 
1208
   for (nr=0; nr<4; nr++)
 
1209
      {
 
1210
      if (label[nr] != label[10+nr])
 
1211
         {
 
1212
         iwb ++;
 
1213
         if (xt == 1)
 
1214
            {
 
1215
            SCTPUT(LINE.STR); 
 
1216
            SCTPUT("----- incomplete qualifier");
 
1217
            }
 
1218
         goto do_show_loop;
 
1219
         }
 
1220
      }
 
1221
   if ((strncmp(save,"COMPUT",6) != 0)          /* check for COMPUTE/KEYW */
 
1222
         ||
 
1223
       (strncmp(label,"KEYW",4) != 0)) goto do_show_loop;
 
1224
 
 
1225
compkey_check:
 
1226
   nn = CGN_INDEXS(cptr," = ");
 
1227
   m = CGN_INDEXC(cptr,'{');
 
1228
   if ( (m > 0) && (*(cptr+m+1) != '{') )       /* avoid nested substitutions */
 
1229
      {
 
1230
      char  ops[8], *kptr;
 
1231
    
 
1232
      kptr = cptr + nn + 3;                     /* point to expression */
 
1233
      (void)strcpy(ops,"+-*/");
 
1234
      for (nr=0; nr<4; nr++)
 
1235
         {
 
1236
         if (CGN_INDEXC(kptr,ops[nr]) > 0)
 
1237
            {
 
1238
            n = CGN_INDEXC(cptr,'}');
 
1239
            if (n > m)
 
1240
               {
 
1241
               int  unit, sbytelem, snoelem;
 
1242
 
 
1243
               nn = m + 1;
 
1244
               (void) strncpy(string,cptr+nn,n-nn);
 
1245
               string[n-nn] = '\0';
 
1246
               if ( (CGN_INDEXC(string,',') > 0) ||
 
1247
                    (CGN_INDEXC(string,'[') > 0) ) goto do_show_loop;
 
1248
 
 
1249
               nn = MID_FNDKEY(string,type,&sbytelem,&snoelem,&unit);
 
1250
               if ((nn == -1) || (type[0] != 'C')) 
 
1251
                  { 
 
1252
                  if (bad == 0)
 
1253
                     {
 
1254
                     bad = 1;
 
1255
                     iwb ++;
 
1256
                     if (xt == 1)
 
1257
                        {
 
1258
                        SCTPUT(LINE.STR);
 
1259
                        SCTPUT("----- bad coding style");
 
1260
                        }
 
1261
                     }
 
1262
                  (void) strcpy(string,cptr);
 
1263
                  (void) strcpy(&string[m],cptr+m+1);
 
1264
                  if (*(cptr+n+1) == '\0')
 
1265
                     string[n-1] = '\0';
 
1266
                  else
 
1267
                     (void) strcpy(&string[n-1],cptr+n+1);
 
1268
                  (void) strcpy(LINE.STR,string);
 
1269
                  goto compkey_check;
 
1270
                  }
 
1271
               }
 
1272
            }
 
1273
         }
 
1274
      }
 
1275
   if ( (bad == 1) && (xt == 1) )
 
1276
      {
 
1277
      (void) strcpy(string,"----- should be: ");  /* length = 17 */
 
1278
      (void) strcpy(&string[17],cptr);
 
1279
      SCTPUT(string);
 
1280
      }
 
1281
 
 
1282
do_show_loop: 
 
1283
   offset += (mm + 1);
 
1284
   goto show_loop;
 
1285
   }
 
1286
 
 
1287
else if (compile_flag[1] == 'C')                /* handle TRANSLATE/PROC */
 
1288
   {
 
1289
   int  gp;
 
1290
 
 
1291
   n = KIWORDS[OFF_MONPAR+10];                  /* MONITPAR(11) = debug flag */
 
1292
   if (opti_code(&lengthCode,1,n) != 0)
 
1293
      {
 
1294
      ERRORS.SYS = 25;          /* optimized code => output0.cprg */
 
1295
      (void)sprintf(string,"problems in code optimzation...");
 
1296
      SCTPUT(string);
 
1297
      MONIT.LEVEL = 1;          /* force exit */
 
1298
      goto badcompile_1;
 
1299
      }
 
1300
 
 
1301
   fp = osaopen("output0.cprg",0);
 
1302
   if (fp < 1) goto badcompile_1;
 
1303
 
 
1304
   (void) strcpy(string,procedu);               /* build procedu_o name */
 
1305
   (void) strcat(string,"_o");
 
1306
   gp = osaopen(string,1);
 
1307
   if (gp < 1) goto badcompile_1;
 
1308
   nn = sprintf(string,"%d",lengthCode);        /* first line = size of code */
 
1309
   (void) osawrite(gp,string,nn);
 
1310
 
 
1311
  copy_loop:
 
1312
   reclen = osaread(fp,string,MAX_LINE);
 
1313
   if (reclen > 0)
 
1314
      {
 
1315
      (void) osawrite(gp,string,reclen);
 
1316
      goto copy_loop;
 
1317
      }
 
1318
   (void) osaclose(fp);
 
1319
   (void) osaclose(gp);
 
1320
   (void) sprintf(string,"procedure %s: total length = %d chars. ",
 
1321
           procedu,lengthCode);
 
1322
   SCTPUT(string);                              /* show total length */
 
1323
   }
 
1324
 
 
1325
else
 
1326
   {                                             /* store compiled code */
 
1327
   stat = INTERNAL(&compile_flag[1],trans_name,&lengthCode);
 
1328
   if (stat != 0)
 
1329
      {
 
1330
      ERRORS.SYS = 40;
 
1331
      if (stat == 2)                    /* internal.cod not opened */
 
1332
         {
 
1333
         (void)printf("MID_PROC:internal.cod could not be opened...\n");
 
1334
         (void)printf("do  '@ compile.all'  to create a new internal.cod\n");
 
1335
         MONIT.LEVEL = 1;               /* force exit */
 
1336
         goto badcompile_1;
 
1337
         }
 
1338
      else
 
1339
         goto badcompile;
 
1340
      }
 
1341
   (void) sprintf(string,"procedure %s: total length = %d chars. ",
 
1342
           trans_name,lengthCode);
 
1343
   SCTPUT(string);                              /* show total length */
 
1344
   }
 
1345
 
 
1346
 
 
1347
   /*  MONIT.LEVEL has to be reset ... */
 
1348
 
 
1349
sect_2300:
 
1350
MONIT.LEVEL --;
 
1351
if (MONIT.LEVEL > 0)            /* if we are inside a procedure,  */
 
1352
   {
 
1353
   nr = MONIT.LEVEL - 1;
 
1354
   CODE.CODE = TRANSLATE[nr].PNTR[0];
 
1355
   CODE.LEN = TRANSLATE[nr].LEN[0];
 
1356
   }
 
1357
 
 
1358
return;
 
1359
 
 
1360
 
 
1361
 
 
1362
badcompile:
 
1363
if (perror == 1)
 
1364
   {
 
1365
   if (ERRORS.INDEX == -1)
 
1366
      PREPERR("MIDAS",LINE.STR," ");
 
1367
   else
 
1368
      PREPERR("MIDAS",LINE.STR,TOKEN[ERRORS.INDEX].STR);
 
1369
   }
 
1370
if (KIWORDS[OFF_ERROR+3] != 0)
 
1371
   {
 
1372
   (void) sprintf(string,"In Midas procedure: %s, line %d",PROC.FNAME,lcount);
 
1373
   SCTMES(M_RED_COLOR,string);
 
1374
   }
 
1375
 
 
1376
badcompile_1:
 
1377
MONIT.LEVEL --;
 
1378
if (MONIT.LEVEL > 0)                 /* if we are inside a procedure,  */
 
1379
   {
 
1380
   nn = MONIT.LEVEL - 1;
 
1381
   CODE.CODE = TRANSLATE[nn].PNTR[0];
 
1382
   CODE.LEN = TRANSLATE[nn].LEN[0];
 
1383
   }
 
1384
return;
 
1385
/*
 
1386
 
 
1387
*/
 
1388
 
 
1389
/*..............................................................*/
 
1390
        
 
1391
/*              execution of MIDAS procedures                   */
 
1392
        
 
1393
/*..............................................................*/
 
1394
                
 
1395
 
 
1396
execute:                                                /*
 
1397
--------                                                */
 
1398
offset = MONIT.PCODE[MONIT.LEVEL-1];            /* get program counter  */
 
1399
echo = MONIT.ECKO[MONIT.LEVEL];
 
1400
mdebug = MONIT.PDEBUG[MONIT.LEVEL];
 
1401
if ((mdebug == 1) && (echo < 1))
 
1402
   echo = 1;                            /* force echo for stepwise debugging */
 
1403
 
 
1404
if (*(cmd+1) == '*')
 
1405
   {
 
1406
   *(cmd+1) = 'X';                      /*  reset the command to NX  */
 
1407
   goto test_line;              /*  and go execute the stuff stored in TOKEN */
 
1408
   }   
 
1409
 
 
1410
 
 
1411
/* in debugging mode continue only after (some) key is hit  */
 
1412
 
 
1413
get_line:                                               /*
 
1414
--------                                                */
 
1415
tptr = &CODE.CODE[offset];
 
1416
sptr = LINE.STR;
 
1417
for (nr=0; ;nr++)
 
1418
   {                                            /* find end of comline */
 
1419
   cc = *tptr++;
 
1420
   if (cc == '\r') 
 
1421
      { 
 
1422
      LINE.LEN = nr;
 
1423
      if (LINE.LEN < 1) goto sect_3300;         /* check for end of program */
 
1424
 
 
1425
      break;
 
1426
      }
 
1427
   else
 
1428
      *sptr++ = cc;
 
1429
   }
 
1430
*sptr = '\0';
 
1431
 
 
1432
prcnt = offset + LINE.LEN + 1;          /* update ProgCounter  */
 
1433
offset1 = offset;
 
1434
offset = prcnt;                 /* let 'offset' point to next command  */
 
1435
 
 
1436
ERRORS.SYS = PARSE(2,echo,MONIT.LEVEL);     /* parse command string  */
 
1437
if (ERRORS.SYS != 0)                         /* error in parsing the string  */
 
1438
   {
 
1439
   perror = 0;
 
1440
   goto badexec;
 
1441
   }
 
1442
 
 
1443
 
 
1444
if (mdebug > 0)
 
1445
   {
 
1446
   Mdbline = Mdbptr;                            /* reset to begin of array */
 
1447
   Mdbindx = 0;
 
1448
   for (nr=0; nr<Mdbcount; nr++)
 
1449
      {
 
1450
      iwa = *Mdbline++;
 
1451
      if (iwa == offset1)
 
1452
         {
 
1453
         Mdbindx = nr + 1;                      /* line count starts at 1 */
 
1454
         break;
 
1455
         }
 
1456
      }
 
1457
 
 
1458
   if (Mdbindx == 0)
 
1459
      {
 
1460
      printf("problems with Midas debugger - please, report it to ESO...\n");
 
1461
      }
 
1462
 
 
1463
   if (mdebug == 77)
 
1464
      {
 
1465
      MONIT.PDEBUG[MONIT.LEVEL] = 1;            /* enable stepwise debugging */
 
1466
      (void) strcpy(TOKEN[0].STR,"*PA");
 
1467
      prcnt = offset;
 
1468
      goto test_line; 
 
1469
      }
 
1470
 
 
1471
   if (mdebug > 1)                              /* test for break point */
 
1472
      {
 
1473
      for (nr=0; nr<5; nr++)
 
1474
         {
 
1475
         if ( (Mbreak[nr] == MONIT.LEVEL) &&
 
1476
              (Mbreaklabl[nr] == Mdbindx) )
 
1477
            {
 
1478
            (void) printf("breakpoint: %4.4d %s\n\r",Mdbindx,LINE.STR);
 
1479
            goto debug_loop;
 
1480
            }
 
1481
         }
 
1482
      goto test_line;                           /* no breakpoint matches */
 
1483
      }
 
1484
 
 
1485
   if (Mdbstep > 1)                             /* step count */
 
1486
      {
 
1487
      for (nr=0; nr<5; nr++)
 
1488
         {
 
1489
         if ( (Mbreak[nr] == MONIT.LEVEL) &&
 
1490
              (Mbreaklabl[nr] == Mdbindx) )
 
1491
            {
 
1492
            (void) printf("breakpoint: %4.4d %s\n\r",Mdbindx,LINE.STR);
 
1493
            goto debug_loop;
 
1494
            }
 
1495
         }
 
1496
      Mdbstep --;
 
1497
      goto test_line;                           /* continue */
 
1498
      }
 
1499
         
 
1500
 
 
1501
debug_loop:
 
1502
   if (MONIT.CTRLC == 1)
 
1503
      {
 
1504
      MONIT.LEVEL = 1;                          /* if Cntrl/C   */
 
1505
      MONIT.CTRLC = 0;                          /* clear flag again */
 
1506
      goto sect_3300;                           /* and abort procedure !   */
 
1507
      }
 
1508
 
 
1509
   (void) printf("Mdb (%4.4d) > ",Mdbindx);     /* get input the standard way */
 
1510
   CGN_GETLINE(string,40);
 
1511
 
 
1512
   if (string[0] == '\0')                       /* RETURN */
 
1513
      {
 
1514
      if (mdebug == 2)
 
1515
         {
 
1516
         MONIT.PDEBUG[MONIT.LEVEL] = 1;         /* enable stepwise debugging */
 
1517
         mdebug = MONIT.PDEBUG[MONIT.LEVEL];
 
1518
         }
 
1519
      }
 
1520
   else if (string[0] == 'c')                   /* continue */
 
1521
      {
 
1522
      MONIT.PDEBUG[MONIT.LEVEL] = 2;           /* disable stepwise debugging */
 
1523
      mdebug = MONIT.PDEBUG[MONIT.LEVEL];
 
1524
      }
 
1525
   else if ((string[0] == 'r') && (string[1] == 'e'))   /* rerun */
 
1526
      {
 
1527
      offset = CODE_START;
 
1528
      CLEAR_LOCAL(MONIT.LEVEL);         /* clear local keyw.at curr. level */
 
1529
      goto get_line;
 
1530
      }
 
1531
   else if (string[0] == 'q')                   /* quit */
 
1532
      {
 
1533
      MONIT.LEVEL = 1;                        /* return to interactive level */
 
1534
      goto sect_3300;
 
1535
      }
 
1536
   else if ((string[0] == 'p') && (string[1] == 'a'))           /* pause  */
 
1537
      {
 
1538
      prcnt = offset1;          /* reset to begin of current command line */
 
1539
      MONIT.PDEBUG[MONIT.LEVEL] = 77;   /* indicate `PAUSE' for next round */
 
1540
      LINE.LEN = CGN_COPY(LINE.STR,"move/local out");   /* save local keys */
 
1541
      (void) PARSE(2,0,0);                              /* in this round */
 
1542
      }
 
1543
   else if (string[0] == 'p')                   /* print keyword */
 
1544
      {
 
1545
      iwa = MID_DSPKEY(&string[2],'x');
 
1546
      if (iwa != ERR_NORMAL) (void) printf("invalid keyname...\n\r");
 
1547
      goto debug_loop;
 
1548
      }
 
1549
   else if (string[0] == 's')                   /* step `nostp' */
 
1550
      {
 
1551
      mm = 1;
 
1552
      if (string[1] != '\0')
 
1553
         {
 
1554
         (void) CGN_CNVT(&string[2],1,1,&mm,&rwa,&dwa);
 
1555
         if (mm < 1) mm = 1;
 
1556
         }
 
1557
      Mdbstep = mm;
 
1558
      }
 
1559
   else if (string[0] == 'l')                   /* list */
 
1560
      {
 
1561
      mm = 20;                                  /* no. of lines to show */
 
1562
      if (string[1] != '\0')
 
1563
         {
 
1564
         ibuf[0] = ibuf[1] = -1;
 
1565
         (void) CGN_CNVT(&string[2],1,2,ibuf,&rwa,&dwa);
 
1566
         if (ibuf[0] < 1) 
 
1567
            ibuf[0] = Mdbindx;
 
1568
         else if (ibuf[0] > Mdbcount) ibuf[0] = Mdbcount;
 
1569
         if (ibuf[1] < ibuf[0]) ibuf[1] = ibuf[0] + mm - 1;
 
1570
         mm = ibuf[1] - ibuf[0] + 1;
 
1571
 
 
1572
         if (ibuf[0] == Mdbindx)
 
1573
            iwa = offset1;
 
1574
         else
 
1575
            {
 
1576
            Mdbline = Mdbptr;                   /* reset to begin of array */
 
1577
            Mdbindx = 1;
 
1578
            iwa = CODE_START;
 
1579
            iwb = ibuf[0] - 1;
 
1580
 
 
1581
            if (iwb > 0)
 
1582
               {
 
1583
               for (nr=0; nr<iwb; nr++)
 
1584
                  {
 
1585
                  nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');
 
1586
                  iwa += (nn + 1);
 
1587
                  }
 
1588
               Mdbindx = ibuf[0];
 
1589
               }
 
1590
            }
 
1591
         }
 
1592
 
 
1593
      for (nr=0; nr<mm; nr++)
 
1594
         {
 
1595
         nn = CGN_INDEXC(&CODE.CODE[iwa],'\r');
 
1596
         if (nn > 0)
 
1597
            {
 
1598
            (void) sprintf(string,"%4.4d ",Mdbindx);
 
1599
            (void) strncpy(&string[5],&CODE.CODE[iwa],nn);
 
1600
            string[nn+5] = '\0';
 
1601
            (void) printf("%s\n\r",string);
 
1602
            Mdbindx++;
 
1603
            iwa += (nn + 1);
 
1604
            }
 
1605
         else
 
1606
            break;                              /* end of procedure */
 
1607
         }
 
1608
      goto debug_loop;                  
 
1609
      }
 
1610
   else if (string[0] == 'b')                   /* breakpoint handling */
 
1611
      {
 
1612
      if (string[1] == 's')                             /* bs(how)  */
 
1613
         {
 
1614
         for (nr=0; nr<5; nr++)
 
1615
            {
 
1616
            if (Mbreak[nr] != -1)
 
1617
               {
 
1618
               (void) printf("breakpoint at line %4.4d for level = %d\n\r",
 
1619
                      Mbreaklabl[nr],Mbreak[nr]);
 
1620
               }
 
1621
            }
 
1622
         }
 
1623
      else if (string[1] == 'c')                                /* bc(ancel) */
 
1624
         {
 
1625
         n = CGN_CNVT(&string[3],1,1,ibuf,&rwa,&dwa);
 
1626
         if (n != 1)
 
1627
            {
 
1628
            if (string[3] == 'a')
 
1629
               {
 
1630
               for (nr=0; nr<5; nr++)
 
1631
                   Mbreak[nr] = -1;
 
1632
               }
 
1633
             else
 
1634
               (void) printf("invalid breakpoint...\n\r");
 
1635
            }
 
1636
         else
 
1637
            {
 
1638
            for (nr=0; nr<5; nr++)
 
1639
               {
 
1640
               if (Mbreaklabl[nr] == ibuf[0])
 
1641
                  {
 
1642
                  Mbreak[nr] = -1;
 
1643
                  break;
 
1644
                  }
 
1645
               }
 
1646
            }
 
1647
         }
 
1648
      else
 
1649
         {
 
1650
         n = CGN_CNVT(&string[2],1,1,ibuf,&rwa,&dwa);
 
1651
         if (n != 1)
 
1652
            (void) printf("invalid breakpoint...\n\r");
 
1653
         else
 
1654
            {
 
1655
            for (nr=0; nr<5; nr++)
 
1656
               {
 
1657
               if (Mbreak[nr] == -1)
 
1658
                  {
 
1659
                  Mbreak[nr] = MONIT.LEVEL;
 
1660
                  Mbreaklabl[nr] = ibuf[0];
 
1661
                  break;
 
1662
                  }
 
1663
               }
 
1664
            }
 
1665
         }
 
1666
      goto debug_loop;
 
1667
      }
 
1668
   else if ((string[0] == 'h') || (string[0] == '?'))
 
1669
      {
 
1670
      (void) printf("RETURN    - execute displayed command\n");
 
1671
      (void) printf("s count   - step through (execute) `count' commands\n");
 
1672
      (void) printf
 
1673
("c         - continue until end of current procedure or next breakpoint\n");
 
1674
      (void) 
 
1675
      (void) printf("rerun     - restart procedure again\n");
 
1676
      printf("quit      - stop debugging + return to interactive level\n");
 
1677
      (void) printf
 
1678
             ("l la,lb   - list the procedure from line `la' to `lb'\n");
 
1679
      (void) printf
 
1680
             ("b bp      - set breakpoint at line `bp' of current proc.\n");
 
1681
      (void) printf("bs        - show current breakpoints \n");
 
1682
      (void) printf("bc bp     - cancel breakpoint at line `bp' \n");
 
1683
      (void) printf
 
1684
("pause     - interrupt debugging + return to interactive level\n");
 
1685
      (void) printf("            there you can execute any MIDAS command\n");
 
1686
      (void) printf("            to resume debugging enter CONTINUE ...\n");
 
1687
      (void) printf
 
1688
("p keyname - print (display) contents of keyword 'keyname'\n");
 
1689
      (void) printf("h (or ?)  - display this help\n");
 
1690
      goto debug_loop;
 
1691
      }
 
1692
   }
 
1693
 
 
1694
 
 
1695
        
 
1696
/*  test, if special command, 
 
1697
    i.e. label:, *IF, *JF, *INC, *JNC, *BR, *GO, *JO, *RE, *PA    */
 
1698
 
 
1699
 
 
1700
test_line:
 
1701
        
 
1702
/*         label:            */
 
1703
 
 
1704
if (TOKEN[0].STR[TOKEN[0].LEN-1] == ':') goto get_line;         /* skip */
 
1705
 
 
1706
 
 
1707
/*  only check for '*' as first char.  */
 
1708
 
 
1709
if (TOKEN[0].STR[0] != '*')
 
1710
   {                                    /*  update program flags + bye, bye  */
 
1711
   MONIT.PCODE[MONIT.LEVEL-1] = prcnt;          /* save Program Counter   */
 
1712
   return;
 
1713
   } 
 
1714
 
 
1715
firstch = TOKEN[0].STR[1];
 
1716
 
 
1717
 
 
1718
 
 
1719
/*         *INC                 */
 
1720
 
 
1721
if (firstch == 'I')
 
1722
   {
 
1723
  inc_section:
 
1724
   if (TOKEN[0].STR[2] == 'N') 
 
1725
      {
 
1726
      ERRORS.INDEX = 1;
 
1727
      KEY_PARSE(TOKEN[1].STR,keyname,k_type,&iwb,&iwa,&n,&n);
 
1728
      if (k_type[0] != 'I') goto badinc;        /* has to be integer key */
 
1729
 
 
1730
      stat = SCKRDI(keyname,iwa,1,&iav,&ikey,&unit,&nullo);
 
1731
      if (stat != 0) goto badinc;
 
1732
 
 
1733
      n = CGN_CNVT(TOKEN[2].STR,1,1,&lstep,&rwa,&dwa);
 
1734
      ERRORS.INDEX = 2;
 
1735
      if (n != 1) 
 
1736
         {
 
1737
         (void) memcpy(save,"        ",(size_t)9);      /* include the '\0' */
 
1738
         KEY_PARSE(TOKEN[2].STR,save,k_type,&iwb,&mm,&n,&n);
 
1739
         if (k_type[0] != 'I') goto badinc;        /* has to be integer key */
 
1740
 
 
1741
         stat = SCKRDI(save,mm,1,&iav,&lstep,&unit,&nullo);
 
1742
         if (stat != 0) goto badinc;
 
1743
         }
 
1744
 
 
1745
      n = CGN_CNVT(TOKEN[3].STR,1,1,&looplim,&rwa,&dwa);
 
1746
      if (n != 1) 
 
1747
         {
 
1748
         ERRORS.INDEX = 3;
 
1749
         (void) memcpy(save,"        ",(size_t)9);      /* include the '\0' */
 
1750
         KEY_PARSE(TOKEN[3].STR,save,k_type,&iwb,&mm,&n,&n);
 
1751
         if (k_type[0] != 'I') goto badinc;        /* has to be integer key */
 
1752
 
 
1753
         stat = SCKRDI(save,mm,1,&iav,&looplim,&unit,&nullo);
 
1754
         if (stat != 0) goto badinc;
 
1755
         }
 
1756
 
 
1757
      ikey += lstep;                    /* in/decrement loop variable */
 
1758
      if (lstep < 0)
 
1759
         {
 
1760
         if (ikey < looplim) goto get_line;
 
1761
         }
 
1762
      else
 
1763
         {
 
1764
         if (ikey > looplim) goto get_line;
 
1765
         }
 
1766
 
 
1767
      stat = SCKWRI(keyname,&ikey,iwa,1,&unit);  /* only now update */
 
1768
      if (firstch == 'J')
 
1769
         {
 
1770
         offset = ibuf[0];
 
1771
         goto get_line;  
 
1772
         }
 
1773
      else
 
1774
         {
 
1775
         nn = 4;                        /* emulate goto TOKEN[4].STR:  */
 
1776
         offset = CODE_START+1;
 
1777
         igoto = 1;                     /* we start at the top  */
 
1778
         goto sect_2800;                /* continue like normal goto command */
 
1779
         }
 
1780
 
 
1781
badinc:
 
1782
      (void) strcpy(LINE.STR,"DO ");    /* rebuild original DO command */
 
1783
      (void) strcat(LINE.STR,TOKEN[1].STR);
 
1784
      n = TOKEN[1].LEN+3;
 
1785
      (void) strcpy(&LINE.STR[n]," = ");
 
1786
      n += 3;
 
1787
      (void) sprintf(save,"%d ",ikey);
 
1788
      (void) strcpy(&LINE.STR[n],save);
 
1789
      (void) strcat(LINE.STR,TOKEN[3].STR);
 
1790
      n = (int) strlen(LINE.STR);
 
1791
      LINE.STR[n++] = ' ';
 
1792
      (void) strcpy(&LINE.STR[n],TOKEN[2].STR);
 
1793
      ERRORS.SYS = 5;   
 
1794
      goto badexec;
 
1795
      }
 
1796
 
 
1797
        
 
1798
/*        *IF                 */
 
1799
 
 
1800
   else 
 
1801
      {
 
1802
      mm = EVALU(1);         /* evaluate logical expr. starting at TOKEN(2) */
 
1803
      if (mm < 0)
 
1804
         {
 
1805
         ERRORS.SYS = 26;
 
1806
         goto badexec;
 
1807
         }
 
1808
      else if (mm == 1)
 
1809
         {
 
1810
         if (TOKEN[4].STR[0] == '*')            /* IF a .xy. b *RE  */
 
1811
            goto sect_3300;
 
1812
         else
 
1813
            {
 
1814
            nn = 4;                                     /* .TRUE.   */
 
1815
            igoto = 9;
 
1816
            goto sect_2800;           /* emulate a forward:  GOTO TOKEN[4]:  */
 
1817
            }
 
1818
         }
 
1819
 
 
1820
      goto get_line;            /* .FALSE. => get next command line  */
 
1821
      }
 
1822
   }
 
1823
 
 
1824
        
 
1825
/*        *BR              */
 
1826
 
 
1827
if (firstch == 'B')
 
1828
   {
 
1829
   GETOP(TOKEN[1].STR,TOKEN[1].LEN,&ikey,&rkey,save,&dkey,&sdum,
 
1830
         k_type,82);                    /* get branch variable/constant...  */
 
1831
        
 
1832
   if (k_type[0] == 'I')
 
1833
      {                                         /* convert comparisons  */
 
1834
      m = CGN_CNVT(TOKEN[2].STR,1,20,ibuf,&rwa,&dwa);
 
1835
      if (m < 1)
 
1836
         {
 
1837
         ERRORS.SYS = 5;
 
1838
         goto badexec;
 
1839
         }
 
1840
      else
 
1841
         {
 
1842
         for (nr=0; nr<m; nr++)
 
1843
            {
 
1844
            if (ikey == ibuf[nr])
 
1845
               {
 
1846
               mm = nr;
 
1847
               goto sect_2500;
 
1848
               }
 
1849
            }
 
1850
         }
 
1851
      }
 
1852
        
 
1853
   else if (k_type[0] == 'C')
 
1854
      {
 
1855
      iwa = 0;
 
1856
      CGN_UPSTR(save);
 
1857
 
 
1858
      for (nr=0; nr<20; nr++)
 
1859
         {
 
1860
         m = CGN_EXTRSS(TOKEN[2].STR,TOKEN[2].LEN,',',&iwa,string,40);
 
1861
         if (m < 1) goto get_line;              /* no match, goto next line */
 
1862
 
 
1863
         CGN_UPSTR(string);
 
1864
         if (strcmp(save,string) == 0)
 
1865
            {
 
1866
            mm = nr;
 
1867
            goto sect_2500;
 
1868
            }
 
1869
         }
 
1870
      }
 
1871
 
 
1872
   else
 
1873
      {
 
1874
      ERRORS.SYS = 17;                  /* invalid type of branch variable */
 
1875
      goto badexec;
 
1876
      }
 
1877
 
 
1878
   goto get_line;                       /* no match, goto next line  */
 
1879
 
 
1880
 
 
1881
/*  match found, now branch   */
 
1882
 
 
1883
sect_2500:
 
1884
   iwa = 0;
 
1885
 
 
1886
   for (nr=0; nr<=mm; nr++)                  /* extract corresponding label */
 
1887
      {
 
1888
      m = CGN_EXTRSS(TOKEN[3].STR,TOKEN[3].LEN,',',&iwa,string,40);
 
1889
      if (m < 0) goto get_line; 
 
1890
      }
 
1891
   (void) strcpy(TOKEN[4].STR,string);
 
1892
   TOKEN[4].LEN = m;
 
1893
   nn = 4;
 
1894
   igoto = 0;                                   /* first, try from here on  */
 
1895
   goto sect_2800;                              /* simulate a forward goto  */
 
1896
   }
 
1897
 
 
1898
        
 
1899
/*         *GO                */
 
1900
 
 
1901
if (firstch == 'G')
 
1902
   {
 
1903
   nn =  1;                                     /* TOKEN[1] holds label  */
 
1904
   igoto = 0;                                   /* first try forward jump  */
 
1905
  
 
1906
sect_2800:
 
1907
   label[0] = '\r';
 
1908
   nr = TOKEN[nn].LEN;
 
1909
   CGN_UPCOPY(&label[1],TOKEN[nn].STR,nr);
 
1910
   label[++nr] = ':';
 
1911
   label[++nr] = '\r';                          /* build search string  */
 
1912
   label[++nr] = '\0';                          /* build search string  */
 
1913
   offset --;                             /* label may come right now...*/
 
1914
  
 
1915
sect_2900:
 
1916
   n = CGN_INDEXS(&CODE.CODE[offset],label);
 
1917
   if (n >= 0)                                  /* all o.k.  */
 
1918
      {
 
1919
      offset += (n + nr);
 
1920
      goto get_line;                            /*  get next line  ...  */
 
1921
      }
 
1922
 
 
1923
 
 
1924
   /* required label not found...  */
 
1925
 
 
1926
   if (igoto == 0)                              /* try backward jump  */
 
1927
      {
 
1928
      igoto = 1;
 
1929
      offset = CODE_START;
 
1930
      goto sect_2900;
 
1931
      }
 
1932
 
 
1933
   if (igoto == 1)
 
1934
      {
 
1935
      n = nr - 1;
 
1936
      if ( strncmp(&CODE.CODE[offset],&label[1],n) == 0 )
 
1937
         {                           /* at beginning of code (no leading \r) */
 
1938
         offset += n;                   /* offset was set to CODE_START */
 
1939
         goto get_line;
 
1940
         }
 
1941
      }
 
1942
 
 
1943
   /*  no. We really have no chance...  */
 
1944
 
 
1945
   (void) strcpy(LINE.STR,"GOTO ");
 
1946
   (void) strcat(LINE.STR,TOKEN[nn].STR);
 
1947
   ERRORS.INDEX = nn;
 
1948
   ERRORS.SYS = 21;
 
1949
   goto badexec;
 
1950
   }
 
1951
 
 
1952
        
 
1953
/*         *JF, *JNC, *JO                */
 
1954
 
 
1955
if (firstch == 'J')
 
1956
   {                            
 
1957
   cc = TOKEN[0].STR[2];
 
1958
   if (cc == 'O')                               /* GO offset */
 
1959
      nn = 1;
 
1960
   else
 
1961
      nn = 4;                                   /* *IF / *INC . . . offset */
 
1962
                                        /* get new offset in CODE.CODE */
 
1963
   n = CGN_CNVT(TOKEN[nn].STR,1,1,ibuf,&rwa,&dwa);
 
1964
   if (n != 1)
 
1965
      {
 
1966
      ERRORS.INDEX = nn;
 
1967
      ERRORS.SYS = 21;
 
1968
      goto badexec;
 
1969
      }
 
1970
   
 
1971
   if (cc == 'O')                       /* GO ... */
 
1972
      {
 
1973
      offset = ibuf[0];
 
1974
      goto get_line;  
 
1975
      }
 
1976
 
 
1977
   else if (cc == 'F')                  /* IF ... */
 
1978
      {
 
1979
      mm = EVALU(1);         /* same stuff as in *IF section above */
 
1980
      if (mm < 0)
 
1981
         {
 
1982
         ERRORS.SYS = 26;
 
1983
         goto badexec;
 
1984
         }
 
1985
      else if (mm == 1)
 
1986
         {
 
1987
         if (TOKEN[4].STR[0] == '*')            /* IF a .xy. b *RE  */
 
1988
            goto sect_3300;
 
1989
         else
 
1990
            offset = ibuf[0];
 
1991
         }
 
1992
      goto get_line;            /* .FALSE. => get next command line  */
 
1993
      }
 
1994
 
 
1995
   else                                 /* *INC ... */
 
1996
      goto inc_section;
 
1997
   }
 
1998
 
 
1999
 
 
2000
        
 
2001
/*       *RE          */
 
2002
 
 
2003
if (firstch == 'R')                         /* RETURN q1 q2 q3 */
 
2004
   {
 
2005
   if (TOKEN[0].STR[2] == 'X')
 
2006
      MONIT.LEVEL = 1;           /* RETURN/EXIT terminates everything... !  */
 
2007
   else
 
2008
      {                                                 /* for Q1, Q2, Q3   */
 
2009
      for (nr=0; nr<3; nr++)
 
2010
         {
 
2011
         nn = MONIT.POFF[8+nr];
 
2012
         (void) memcpy(&KCWORDS[nn],TOKEN[nr+1].STR,(size_t)60);
 
2013
         }
 
2014
      }
 
2015
   goto sect_3300;                   /* terminate this level (at least...)  */
 
2016
   }
 
2017
 
 
2018
 
 
2019
/*        *PA         */
 
2020
 
 
2021
if (firstch == 'P')
 
2022
   {
 
2023
   if (MONIT.PAUSLEVL >= 0)             /* avoid nested PAUSE commands */
 
2024
      {
 
2025
      if (TOKEN[0].STR[2] == 'D')          /*  here from Mdb */
 
2026
         (void) printf("Old PAUSEd procedure code is overwritten...\n");
 
2027
      else
 
2028
         {
 
2029
         (void) strcpy(LINE.STR,"PAUSE ");
 
2030
         ERRORS.INDEX = -1;
 
2031
         ERRORS.SYS = 110;
 
2032
         goto badexec;
 
2033
         }
 
2034
      }
 
2035
 
 
2036
   MONIT.PCODE[MONIT.LEVEL-1] = prcnt;                  /* save the PC  */
 
2037
   for (nr=0; nr<MAX_LEVEL; nr++)
 
2038
      {
 
2039
      MONIT.QDEBUG[nr+1] = MONIT.PDEBUG[nr+1];
 
2040
      MONIT.QCODE[nr] = MONIT.PCODE[nr];
 
2041
      TRANSLATE[nr].LEN[1] = TRANSLATE[nr].LEN[0];
 
2042
      TRANSLATE[nr].LEN[0] = 0;         /* we should not free that memory... */
 
2043
      TRANSLATE[nr].PNTR[1] = TRANSLATE[nr].PNTR[0];
 
2044
      }
 
2045
 
 
2046
   (void) strcpy(PROC.QNAME,PROC.FNAME);   /* save name of interrupted proc. */
 
2047
   MONIT.PAUSLEVL = MONIT.LEVEL;
 
2048
   MONIT.INTERRUPT = 1;
 
2049
 
 
2050
   if (TOKEN[0].STR[2] == 'D')          /*  here from Mdb */
 
2051
      {
 
2052
      for (nr=1; nr<MAX_LEV1; nr++)     /* to avoid nr<=MAX_LEVEL ... */
 
2053
         MONIT.PDEBUG[nr] = 0;          /* no debugging initially */
 
2054
      }
 
2055
 
 
2056
   MONIT.LEVEL = 1;                             /*  like RETURN/EXIT  */
 
2057
   goto sect_3300;
 
2058
   }
 
2059
        
 
2060
ERRORS.SYS = 5;                   /* all that remains is "wrong syntax" ...*/
 
2061
 
 
2062
 
 
2063
/*  problems during compilation and execution    */
 
2064
 
 
2065
badexec:
 
2066
if (perror == 1) 
 
2067
   {
 
2068
   if (ERRORS.INDEX == -1)
 
2069
      PREPERR("MIDAS",LINE.STR," ");
 
2070
   else
 
2071
      PREPERR("MIDAS",LINE.STR,TOKEN[ERRORS.INDEX].STR);
 
2072
   }
 
2073
if (KIWORDS[OFF_ERROR+3] != 0)
 
2074
   {
 
2075
   (void) sprintf(string,"In Midas procedure: %s",PROC.FNAME);
 
2076
   SCTMES(M_RED_COLOR,string);
 
2077
   }
 
2078
 
 
2079
if (KIWORDS[OFF_ERROR+6] == 0)          /* error _flag for `batch' mode */
 
2080
   MONIT.LEVEL = 1;                     /* force return to interactive level */
 
2081
else
 
2082
   goto get_line;
 
2083
 
 
2084
/*
 
2085
 
 
2086
*/
 
2087
  
 
2088
/*  ...........................................................  */
 
2089
        
 
2090
        
 
2091
/*             end of program - backup to higher level           */
 
2092
        
 
2093
/*  ...........................................................  */
 
2094
 
 
2095
        
 
2096
sect_3300:
 
2097
CLEAR_LOCAL(MONIT.LEVEL);                       /* clear any local keys...  */
 
2098
 
 
2099
 
 
2100
/*  if, next higher level still > 0, get back corresponding code   */
 
2101
 
 
2102
if (MONIT.LEVEL <= 1)
 
2103
   {
 
2104
   MONIT.TOPLEVL = 0;
 
2105
   MONIT.LEVEL = 0 ;            
 
2106
   KIWORDS[OFF_MODE+6] = 0;
 
2107
   KIWORDS[OFF_LOG+3] = 0;              /* make sure to enable display */
 
2108
   fixout(0,0);
 
2109
   (void) MID_CCLO(-1); 
 
2110
   if (MONIT.FRAME_USED != ' ')         /* close all open images/tables */
 
2111
      FRAMACC('X',KAUX.OUT,0,&iav);
 
2112
   return;                              /* in interactive mode */
 
2113
   }
 
2114
 
 
2115
 
 
2116
if (MONIT.TOPLEVL < MONIT.LEVEL)        /* follow highest level */
 
2117
   MONIT.TOPLEVL = MONIT.LEVEL;
 
2118
 
 
2119
KIWORDS[OFF_MODE+6] = -- MONIT.LEVEL;   /* decrement procedure level */
 
2120
nn = MONIT.LEVEL - 1;
 
2121
CODE.CODE = TRANSLATE[nn].PNTR[0];
 
2122
CODE.LEN = TRANSLATE[nn].LEN[0];
 
2123
fixout(0,MONIT.LEVEL);                  /* try to close output file */
 
2124
(void) MID_CCLO(-1);                    /* close all catalogs */
 
2125
 
 
2126
 
 
2127
/*  do not forget to reset the parameter keys also...   */
 
2128
 
 
2129
SAVE_PARM(2,&n);        
 
2130
goto execute;          /* fetch next instruction from higher level procedure */
 
2131
}