[BACK]Return to xecline.c CVS log [TXT] [DIR] Up to [Coherent Logic Development] / freem / src

Diff for /freem/src/xecline.c between versions 1.3 and 1.15

version 1.3, 2025/03/01 04:45:51 version 1.15, 2025/04/15 16:49:36
Line 1 Line 1
 /*  /*
  *                            *   *   $Id$
  *                           * *  
  *                          *   *  
  *                     ***************  
  *                      * *       * *  
  *                       *  MUMPS  *  
  *                      * *       * *  
  *                     ***************  
  *                          *   *  
  *                           * *  
  *                            *  
  *  
  *   xecline.c  
  *    freem interpreter proper   *    freem interpreter proper
  *   *
  *     *  
  *   Author: Serena Willis <jpw@coherent-logic.com>   *   Author: Serena Willis <snw@coherent-logic.com>
  *    Copyright (C) 1998 MUG Deutschland   *    Copyright (C) 1998 MUG Deutschland
  *    Copyright (C) 2020 Coherent Logic Development LLC   *    Copyright (C) 2020, 2025 Coherent Logic Development LLC
  *   *
  *   *
  *   This file is part of FreeM.   *   This file is part of FreeM.
Line 35 Line 23
  *   You should have received a copy of the GNU Affero Public License   *   You should have received a copy of the GNU Affero Public License
  *   along with FreeM.  If not, see <https://www.gnu.org/licenses/>.   *   along with FreeM.  If not, see <https://www.gnu.org/licenses/>.
  *   *
    *   $Log$
    *   Revision 1.15  2025/04/15 16:49:36  snw
    *   Make use of logprintf throughout codebase
    *
    *   Revision 1.14  2025/04/13 04:22:43  snw
    *   Fix snprintf calls
    *
    *   Revision 1.13  2025/04/10 01:24:39  snw
    *   Remove C++ style comments
    *
    *   Revision 1.12  2025/04/09 19:52:02  snw
    *   Eliminate as many warnings as possible while building with -Wall
    *
    *   Revision 1.11  2025/04/02 03:02:42  snw
    *   Stop requiring users to pass -e to fmadm when -u or -g are passed
    *
    *   Revision 1.10  2025/03/27 03:27:35  snw
    *   Install init scripts to share/freem/examples/init and fix regression in method dispatch
    *
    *   Revision 1.9  2025/03/24 04:13:12  snw
    *   Replace action macro dat with fra_dat to avoid symbol conflict on OS/2
    *
    *   Revision 1.8  2025/03/24 04:05:36  snw
    *   Replace crlf with frm_crlf to avoid symbol conflict with readline on OS/2
    *
    *   Revision 1.7  2025/03/22 22:52:24  snw
    *   Add STRLEN_GBL macro to manage global string length
    *
    *   Revision 1.6  2025/03/22 21:44:32  snw
    *   Make the startup messages fewer and add environment name to direct-mode prompt
    *
    *   Revision 1.5  2025/03/09 19:50:47  snw
    *   Second phase of REUSE compliance and header reformat
    *
    *
    * SPDX-FileCopyrightText:  (C) 2025 Coherent Logic Development LLC
    * SPDX-License-Identifier: AGPL-3.0-or-later
  **/   **/
   
 #include <stdlib.h>  #include <stdlib.h>
Line 512  next0: Line 537  next0:
             else if (tmp2[0] == '<') {           /* call write output to %-array */              else if (tmp2[0] == '<') {           /* call write output to %-array */
                                   
                 FILE *pipdes;                  FILE *pipdes;
                 char key[STRLEN + 1 /*was 256 */ ];                  char key[STRLEN];
                 char data[STRLEN + 1 /*was 256 */ ];                  char data[STRLEN];
                 char data_kill[256];                  char data_kill[256];
                 data_kill[255] = EOL;                  data_kill[255] = EOL;
                                   
                 for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL;                  for (i = 0; i < STRLEN - 1; i++) vn[i] = EOL;
                                   
                 snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);                  snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
                 ssvn (get_sym, key, vn);                  ssvn (get_sym, key, vn);
   
                 if (vn[0] == '^') {                  if (vn[0] == '^') {
Line 537  next0: Line 562  next0:
                     symtab (kill_sym, vn, data);                      symtab (kill_sym, vn, data);
                 }                  }
   
                 snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);                  snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
                 ssvn (get_sym, key, vn);                  ssvn (get_sym, key, vn);
   
                 data[0] = '0';                  data[0] = '0';
Line 566  next0: Line 591  next0:
                     int glvn_len = 0;                      int glvn_len = 0;
                                           
                     while (fgets (data, STRLEN, pipdes)) {                      while (fgets (data, STRLEN, pipdes)) {
                         snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);                          snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
                         ssvn (get_sym, key, vn);                          ssvn (get_sym, key, vn);
   
                         glvn_len = stlen (vn);                                                  glvn_len = stlen (vn);                        
Line 627  next0: Line 652  next0:
                                   
                 for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL;                  for (i = 0; i < STRLEN + 1; i++) vn[i] = EOL;
                                   
                 snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);                  snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
                 ssvn (get_sym, key, vn);                  ssvn (get_sym, key, vn);
   
                 if (vn[0] == '^') {                  if (vn[0] == '^') {
Line 656  next0: Line 681  next0:
                     int glvn_len = 0;                      int glvn_len = 0;
                                           
                     for (i = 1; i <= k; i++) {                      for (i = 1; i <= k; i++) {
                         snprintf (key, 255, "^$JOB\202%d\202PIPE_GLVN\201", pid);                          snprintf (key, STRLEN - 1, "^$JOB\202%d\202PIPE_GLVN\201", pid);
                         ssvn (get_sym, key, vn);                          ssvn (get_sym, key, vn);
   
                         glvn_len = stlen (vn);                                                  glvn_len = stlen (vn);                        
Line 891  set0: Line 916  set0:
   
                 if (isalpha (vn[0]) && *(codptr + 1) == ':') {                  if (isalpha (vn[0]) && *(codptr + 1) == ':') {
                     char sc_string[255];                      char sc_string[255];
                     register int sci;  
                       
                     codptr += 2;                      codptr += 2;
                     expr (NAME);                      expr (NAME);
   
Line 928  set0: Line 952  set0:
   
                     if (*++codptr != '=') {                      if (*++codptr != '=') {
   
 /* SET A++ or SET A-- equivalent to SET A+=1 SET A-=1 currently disabled */                          /* unary ++/-- */
 //#ifdef NEVER  
                         if ((ch == '+' || ch == '-') && ch == *codptr) {                          if ((ch == '+' || ch == '-') && ch == *codptr) {
                             codptr++;                              codptr++;
                             setop = ch;                              setop = ch;
Line 938  set0: Line 961  set0:
                                                           
                             goto set2;                              goto set2;
                         }                          }
 //#endif /* NEVER */  
   
                         merr_raise (ASSIGNER);                          merr_raise (ASSIGNER);
                         break;                          break;
Line 1024  set2: Line 1046  set2:
   
                 if (new_and_set == TRUE) new_and_set = FALSE;                  if (new_and_set == TRUE) new_and_set = FALSE;
                 if (new_object == TRUE) new_object = FALSE;                  if (new_object == TRUE) new_object = FALSE;
   /*                
 set1:  set1:
   */
                 if (*codptr != ',') break;                  if (*codptr != ',') break;
   
                 if (*++codptr == '@') goto again;                  if (*++codptr == '@') goto again;
Line 1076  set: Line 1100  set:
                         goto err;                          goto err;
                     }                      }
   
                     expr (STRING);                      expr (STRING);                    
                       
                     if (merr () > OK) goto err;                      if (merr () > OK) goto err;
   
                     stcpy (tmp2, argptr);                      stcpy (tmp2, argptr);
Line 1588  set10: Line 1612  set10:
                     }                      }
   
                     if (stcat (tmp2, &tmp3[arg4]) == 0) {                      if (stcat (tmp2, &tmp3[arg4]) == 0) {
                         merr_raise (M56); //JPW                          merr_raise (M56); /* snw */
                         goto err;                          goto err;
                     }                      }
   
Line 2367  s_end: Line 2391  s_end:
 #ifdef DEBUG_NEWSTACK  #ifdef DEBUG_NEWSTACK
                 printf ("EXTRINSIC\r\n");                  printf ("EXTRINSIC\r\n");
 #endif  #endif
                 //printf (" extr_types[%d] = '%d'\r\n", nstx, extr_types[nstx]);  
                 if (*codptr == EOL || *codptr == SP) {                  if (*codptr == EOL || *codptr == SP) {
   
 #ifdef DEBUG_NEWSTACK  #ifdef DEBUG_NEWSTACK
Line 3753  off3: Line 3776  off3:
             break;              break;
   
         case KILL:          case KILL:
               
             /* argumentless: KILL all local variables */              /* argumentless: KILL all local variables */
             if (((ch = *codptr) == SP) || ch == EOL) {              if (((ch = *codptr) == SP) || ch == EOL) {
                 symtab (kill_all, "", "");                  symtab (kill_all, "", "");
Line 3787  off3: Line 3810  off3:
                 if (destructor_ct) {                  if (destructor_ct) {
   
                     for (cd = 0; cd < destructor_ct; cd++) {                      for (cd = 0; cd < destructor_ct; cd++) {
                         strcat (destc, destructors[cd]);                          if (strlen (destructors[cd]) > 0) {
                         strcat (destc, ",");                              strcat (destc, destructors[cd]);
                               strcat (destc, ",");
                           }
                     }                      }
   
                     destructor_ct = 0;                                          destructor_ct = 0;                    
Line 3936  off3: Line 3961  off3:
                                                           
                             stcpy (objvar, vn);                              stcpy (objvar, vn);
   
                             symtab (dat, objvar, datres);                              symtab (fra_dat, objvar, datres);
                             dat_res = atoi (datres);                              dat_res = atoi (datres);
   
                             if (dat_res > 0) {                              if (dat_res > 0) {
Line 3970  off3: Line 3995  off3:
   
                             if (merr () > OK) goto err;                              if (merr () > OK) goto err;
   
                               /* TODO: check this snprintf for proper sizing */
                             snprintf (&tmp3[1], 255, "%s\201", &constructor[1]);                              snprintf (&tmp3[1], 255, "%s\201", &constructor[1]);
                             goto private;                              goto private;
   
Line 3990  off3: Line 4016  off3:
                     goto set2;                      goto set2;
                 }                  }
   
   /*                
 post_new:  post_new:
                   */                
                 ch = nstx;                  ch = nstx;
                                   
                 while (nestc[ch] == FOR) ch--;       /* FOR does not define a NEW level */                  while (nestc[ch] == FOR) ch--;       /* FOR does not define a NEW level */
Line 4320  use0:          /* entry point for proces Line 4347  use0:          /* entry point for proces
                                 break;                                  break;
   
                             case 2:                              case 2:
                                 crlf[io] = tvexpr (argptr);                                  frm_crlf[io] = tvexpr (argptr);
                                 break;                                  break;
                                                           
                             case 3:                              case 3:
Line 4422  use_socket: Line 4449  use_socket:
   
                 /* need to evaluate the following 6 lines carefully - smw 2023-10-15 */                  /* need to evaluate the following 6 lines carefully - smw 2023-10-15 */
                 if (k != HOME) {                  if (k != HOME) {
                     crlf[k] = FALSE;                      frm_crlf[k] = FALSE;
                     fm_nodelay[k] = FALSE;                      fm_nodelay[k] = FALSE;
                     xpos[k] = 0;                      xpos[k] = 0;
                     ypos[k] = 0;                      ypos[k] = 0;
Line 5080  open_socket: Line 5107  open_socket:
 #endif  #endif
   
                     if (nestc[nstx] == BREAK) {                      if (nestc[nstx] == BREAK) {
 //                        printf ("nestc[nstx] was BREAK\r\n");  
                         if (repQUIT) continue;                          if (repQUIT) continue;
                         merr_raise (OK - CTRLB);                          merr_raise (OK - CTRLB);
                                                   
                         goto zgo;   /*cont. single step */                          goto zgo;   /*cont. single step */
                     }                      }
 //                    else {  
 //                        printf ("nestc[nstx] was _not_ BREAK\r\n");  
 //                    }  
   
                     if (nestc[nstx] == FOR) {                      if (nestc[nstx] == FOR) {
   
Line 5538  zgo: Line 5561  zgo:
   
                 for (; beg < end; beg += UNSIGN (*beg) + 2) {                  for (; beg < end; beg += UNSIGN (*beg) + 2) {
                                           
                     if (crlf[io]) {                      if (frm_crlf[io]) {
                         write_m ("\012\201");                          write_m ("\012\201");
                     }                      }
                     else {                      else {
Line 5554  zgo: Line 5577  zgo:
                 rouins = beg;                  rouins = beg;
             }              }
   
             if (crlf[io]) {              if (frm_crlf[io]) {
                 write_m ("\012\201");                  write_m ("\012\201");
             }              }
             else {              else {
Line 5664  zgo: Line 5687  zgo:
             }              }
   
         case ZWRITE:          case ZWRITE:
   
   
 zwrite:  
             {              {
                 short k;                  short k;
                 char w_tmp[512];                  char w_tmp[512];
Line 5790  zwritep: Line 5810  zwritep:
   
                 expr (NAME);                  expr (NAME);
   
                 //if (varnam[0] == '^') merr_raise (GLOBER);  
                 if (merr () > OK) goto err;                  if (merr () > OK) goto err;
                                   
                 codptr++;                  codptr++;
Line 5823  zwritep: Line 5842  zwritep:
                 }                  }
                                   
                 if (varnam[0] != '^') {                  if (varnam[0] != '^') {
                     symtab (dat, varnam, tmp2);                      symtab (fra_dat, varnam, tmp2);
                     zwmode = 'L';                      zwmode = 'L';
                 }                  }
                 else {                  else {
                     if (varnam[1] == '$') {                      if (varnam[1] == '$') {
                         ssvn (dat, varnam, tmp2);                          ssvn (fra_dat, varnam, tmp2);
                         zwmode = '$';                          zwmode = '$';
                     }                      }
                     else {                      else {
                         global (dat, varnam, tmp2);                          global (fra_dat, varnam, tmp2);
                         zwmode = '^';                          zwmode = '^';
                     }                      }
                 }                  }
Line 5943  zwritep: Line 5962  zwritep:
                     switch (zwmode) {                      switch (zwmode) {
   
                         case 'L':                          case 'L':
                             symtab (dat, tmp, tmp3);                              symtab (fra_dat, tmp, tmp3);
                             symtab (get_sym, tmp, &w_tmp[1]);                              symtab (get_sym, tmp, &w_tmp[1]);
   
                             break;                              break;
   
   
                         case '$':                          case '$':
                             ssvn (dat, tmp, tmp3);                              ssvn (fra_dat, tmp, tmp3);
                             ssvn (get_sym, tmp, &w_tmp[1]);                              ssvn (get_sym, tmp, &w_tmp[1]);
   
                             break;                              break;
   
   
                         case '^':                          case '^':
                             global (dat, tmp, tmp3);                              global (fra_dat, tmp, tmp3);
                             global (get_sym, tmp, &w_tmp[1]);                              global (get_sym, tmp, &w_tmp[1]);
   
                             break;                              break;
Line 6032  zwritep: Line 6051  zwritep:
             break;              break;
   
   
         case ZALLOCATE:          /* user defined Z-COMMAND */
   
             /* argumentless is not permitted */  
             if (*codptr == SP || *codptr == EOL) {  
                 merr_raise (ARGLIST);  
                 break;  
             }  
   
             expr (NAME);  
               
             if (merr () > OK) goto err;  
               
             tmp[0] = SP;  
             stcpy (&tmp[1], varnam);  
             stcat (tmp, "\001\201");  
   
             frm_timeout = (-1L);        /* no timeout */  
               
             if (*++codptr == ':') {  
                 codptr++;  
               
                 expr (STRING);  
               
                 frm_timeout = intexpr (argptr);  
               
                 if (merr () > OK) goto err;  
                 if (frm_timeout < 0L) frm_timeout = 0L;  
             }  
   
             lock (tmp, frm_timeout, ZALLOCATE);  
             break;  
               
   
         case ZDEALLOCATE:  
   
             tmp[0] = SP;  
               
             if (*codptr == SP || *codptr == EOL) {  
                 tmp[1] = EOL;  
             }  
             else {  
                 expr (NAME);  
               
                 if (merr () > OK) goto err;  
               
                 stcpy (&tmp[1], varnam);  
               
                 codptr++;  
             }  
   
             lock (tmp, -1L, ZDEALLOCATE);   /* -1: no timeout */  
             break;  
   
             /* user defined Z-COMMAND */  
   
   
         case PRIVATE:          case PRIVATE:
   
 private:            /* for in-MUMPS defined commands */  private:            /* for in-MUMPS defined commands */
Line 6626  evthandler:            /* for event hand Line 6590  evthandler:            /* for event hand
   
                                           
                     /* run the next iteration of GTK's event loop */                      /* run the next iteration of GTK's event loop */
                     //TODO: replace with libXt event loop                      /* TODO: replace with libXt event loop */
                     //gtk_main_iteration_do (TRUE);                      /* gtk_main_iteration_do (TRUE); */
   
                     /* dequeue any events */                      /* dequeue any events */
                     evt_count = mwapi_dequeue_events (syn_handlers);                      evt_count = mwapi_dequeue_events (syn_handlers);
   
                     if (evt_count) {                      if (evt_count) {
                         /* write them out */                          /* write them out */
                         //printf ("event handlers = '%s'\r\n", syn_handlers);                          /* printf ("event handlers = '%s'\r\n", syn_handlers); */
   
                         syn_event_entry_nstx = nstx;                          syn_event_entry_nstx = nstx;
                                                   
Line 6745  err: Line 6709  err:
         stcnv_m2c (er_buf);          stcnv_m2c (er_buf);
   
 #if !defined(MSDOS)  #if !defined(MSDOS)
         m_log (LOG_ERR, er_buf);          logprintf (FM_LOG_DEBUG, "xecline:  interpreter error %d [%s]", ierr, er_buf);
 #endif  #endif
                   
     }      }
Line 7079  restart: Line 7043  restart:
   
         DSW &= ~BIT0;       /* enable ECHO */          DSW &= ~BIT0;       /* enable ECHO */
   
         // print here          /* print here */
         {          {
             char *t_rtn;              char *t_rtn;
             char *t_nsn = (char *) malloc (STRLEN * sizeof (char));              char *t_nsn = (char *) malloc (STRLEN * sizeof (char));
Line 7210  direct_mode: Line 7174  direct_mode:
   
                 if (quiet_mode == FALSE) {                  if (quiet_mode == FALSE) {
                     if (tp_level == 0) {                      if (tp_level == 0) {
                         snprintf (fmrl_prompt, 255, "\r\n%s> ", nsname);                          snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s.%s> ", shm_env, nsname);
                     }                      }
                     else {                      else {
                         snprintf (fmrl_prompt, 255, "\r\nTL%d:%s> ", tp_level, nsname);                          snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1 , "\r\nTL%d:%s.%s> ", tp_level, shm_env, nsname);
                     }                      }
                 }                  }
                 set_io (UNIX);                  set_io (UNIX);
Line 7238  direct_mode: Line 7202  direct_mode:
                 if (fmrl_buf[0] == '?') {                  if (fmrl_buf[0] == '?') {
   
                     char kb[20];                      char kb[20];
                     char db[255];                      char db[STRLEN];
                                           
                     snprintf (kb, 19, "%%SYS.HLP\201");                      snprintf (kb, sizeof (kb) - 1, "%%SYS.HLP\201");
                     snprintf (db, 19, "\201");                      snprintf (db, STRLEN - 1, "\201");
   
                     symtab (kill_sym, kb, db);                      symtab (kill_sym, kb, db);
                                           
Line 7251  direct_mode: Line 7215  direct_mode:
                     stcpy (code, "DO ^%ZHELP\201");                      stcpy (code, "DO ^%ZHELP\201");
                                           
                     if (strlen (fmrl_buf) > 1) {                      if (strlen (fmrl_buf) > 1) {
                         snprintf (db, 254, "%s\201", &fmrl_buf[1]);                          snprintf (db, STRLEN - 1, "%s\201", &fmrl_buf[1]);
                         symtab (set_sym, kb, db);                          symtab (set_sym, kb, db);
                     }                      }
                                           
Line 7320  direct_mode: Line 7284  direct_mode:
                 }                  }
                 else if (isdigit(fmrl_buf[0]) || (fmrl_buf[0] == '(') || (fmrl_buf[0] == '-') || (fmrl_buf[0] == '\'') || (fmrl_buf[0] == '+') || (fmrl_buf[0] == '$') || (fmrl_buf[0] == '^')) {                  else if (isdigit(fmrl_buf[0]) || (fmrl_buf[0] == '(') || (fmrl_buf[0] == '-') || (fmrl_buf[0] == '\'') || (fmrl_buf[0] == '+') || (fmrl_buf[0] == '$') || (fmrl_buf[0] == '^')) {
   
                     snprintf (code, 255, "W %s", fmrl_buf);                      snprintf (code, STRLEN - 1, "W %s", fmrl_buf);
                     stcnv_c2m (code);                      stcnv_c2m (code);
   
                     set_io (MUMPS);                      set_io (MUMPS);
Line 7402  direct_mode: Line 7366  direct_mode:
                 char fmrl_prompt[256];                  char fmrl_prompt[256];
   
                 if (tp_level == 0) {                  if (tp_level == 0) {
                     snprintf (fmrl_prompt, 256, "\r\n%s> \201", nsname);                      snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\n%s> \201", nsname);
                 }                  }
                 else {                  else {
                     snprintf (fmrl_prompt, 256, "\r\nTL%d:%s> \201", tp_level, nsname);                      snprintf (fmrl_prompt, sizeof (fmrl_prompt) - 1, "\r\nTL%d:%s> \201", tp_level, nsname);
                 }                  }
                                   
                 write_m (fmrl_prompt);                  write_m (fmrl_prompt);
Line 7417  direct_mode: Line 7381  direct_mode:
 #endif  #endif
   
             if (merr () > OK) goto err;              if (merr () > OK) goto err;
   
   
             //      printf ("zbflag = %d\r\n", zbflag);  
                           
             if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) {              if (code[0] == EOL && zbflag && nestc[nstx] == BREAK) {
   
                 //printf ("cont single step\r\n");  
                 debug_mode = TRUE;                  debug_mode = TRUE;
                 merr_raise (OK - CTRLB);                  merr_raise (OK - CTRLB);
   
                 //printf ("ierr now '%d'\r\n", ierr);  
                 goto zgo;                  goto zgo;
             }           /* single step */              }           /* single step */
         }          }
Line 7493  void rbuf_dump(void) Line 7452  void rbuf_dump(void)
           
     for (i = 0; i < NO_OF_RBUF; i++) {      for (i = 0; i < NO_OF_RBUF; i++) {
   
         sprintf (flgs, "");          flgs[0] = '\0';
                   
         if (ages[i] == 0) {          if (ages[i] == 0) {
             sprintf (rnam, "---------");              sprintf (rnam, "---------");
Removed from v.1.3  
changed lines
  Added in v.1.15

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>