]> code.delx.au - gnu-emacs/blobdiff - src/ccl.c
*** empty log message ***
[gnu-emacs] / src / ccl.c
index d85045252b81d232a3df7485b786e4ed869f7c82..5bff1f3a0ad97f50679734fa280439468ad8586f 100644 (file)
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -20,25 +20,15 @@ along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 Boston, MA 02111-1307, USA.  */
 
-#ifdef emacs
 #include <config.h>
-#endif
 
 #include <stdio.h>
 
-#ifdef emacs
-
 #include "lisp.h"
 #include "charset.h"
 #include "ccl.h"
 #include "coding.h"
 
-#else  /* not emacs */
-
-#include "mulelib.h"
-
-#endif /* not emacs */
-
 /* This contains all code conversion map available to CCL.  */
 Lisp_Object Vcode_conversion_map_vector;
 
@@ -436,7 +426,7 @@ Lisp_Object Vtranslation_hash_table_vector;
                                        extended_command (rrr,RRR,Rrr,ARGS)
                                      */
 
-/* 
+/*
    Here after, Extended CCL Instructions.
    Bit length of extended command is 14.
    Therefore, the instruction code range is 0..16384(0x3fff).
@@ -494,7 +484,7 @@ Lisp_Object Vtranslation_hash_table_vector;
                                        3:MAP-ID1
                                        4:MAP-ID2
                                        ...
-                                    */ 
+                                    */
 
 /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
    reg[RRR]) map.
@@ -572,7 +562,7 @@ Lisp_Object Vtranslation_hash_table_vector;
    where
        STARTPOINT is an offset to be used for indexing a map,
        ENDPOINT is a maximum index number of a map,
-       VAL and VALn is a number, nil, t, or lambda.  
+       VAL and VALn is a number, nil, t, or lambda.
 
    Valid index range of a map of type (a) is:
        STARTPOINT <= index < STARTPOINT + map_size - 1
@@ -636,14 +626,17 @@ do                                                                \
          {                                                     \
            ccl_prog = ccl_prog_stack_struct[0].ccl_prog;       \
            ic = ccl_prog_stack_struct[0].ic;                   \
+           eof_ic = ccl_prog_stack_struct[0].eof_ic;           \
          }                                                     \
        CCL_INVALID_CMD;                                        \
       }                                                                \
     ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;      \
     ccl_prog_stack_struct[stack_idx].ic = (ret_ic);            \
+    ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic;          \
     stack_idx++;                                               \
     ccl_prog = called_ccl.prog;                                        \
     ic = CCL_HEADER_MAIN;                                      \
+    eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);              \
     goto ccl_repeat;                                           \
   }                                                            \
 while (0)
@@ -720,6 +713,8 @@ while (0)
 
 /* Terminate CCL program because of invalid command.  Should not occur
    in the normal case.  */
+#ifndef CCL_DEBUG
+
 #define CCL_INVALID_CMD                        \
 do                                     \
   {                                    \
@@ -728,6 +723,19 @@ do                                 \
   }                                    \
 while(0)
 
+#else
+
+#define CCL_INVALID_CMD                        \
+do                                     \
+  {                                    \
+    ccl_debug_hook (this_ic);          \
+    ccl->status = CCL_STAT_INVALID_CMD;        \
+    goto ccl_error_handler;            \
+  }                                    \
+while(0)
+
+#endif
+
 /* Encode one character CH to multibyte form and write to the current
    output buffer.  If CH is less than 256, CH is written as is.  */
 #define CCL_WRITE_CHAR(ch)                                             \
@@ -740,7 +748,7 @@ while(0)
        if (bytes == 1)                                                 \
          {                                                             \
            *dst++ = (ch);                                              \
-           if ((ch) >= 0x80 && (ch) < 0xA0)                            \
+           if (extra_bytes && (ch) >= 0x80 && (ch) < 0xA0)             \
              /* We may have to convert this eight-bit char to          \
                 multibyte form later.  */                              \
              extra_bytes++;                                            \
@@ -819,7 +827,8 @@ while(0)
       }                                                        \
     else if (ccl->last_block)                          \
       {                                                        \
-        ic = ccl->eof_ic;                              \
+       REG = -1;                                       \
+        ic = eof_ic;                                   \
         goto ccl_repeat;                               \
       }                                                        \
     else                                               \
@@ -862,17 +871,25 @@ while(0)
 
 #ifdef CCL_DEBUG
 #define CCL_DEBUG_BACKTRACE_LEN 256
-int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
+int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
 int ccl_backtrace_idx;
+
+int
+ccl_debug_hook (int ic)
+{
+  return ic;
+}
+
 #endif
 
 struct ccl_prog_stack
   {
     Lisp_Object *ccl_prog;     /* Pointer to an array of CCL code.  */
     int ic;                    /* Instruction Counter.  */
+    int eof_ic;                        /* Instruction Counter to jump on EOF.  */
   };
 
-/* For the moment, we only support depth 256 of stack.  */ 
+/* For the moment, we only support depth 256 of stack.  */
 static struct ccl_prog_stack ccl_prog_stack_struct[256];
 
 int
@@ -897,9 +914,11 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
      each of them will be converted to multibyte form of 2-byte
      sequence.  For that conversion, we remember how many more bytes
      we must keep in DESTINATION in this variable.  */
-  int extra_bytes = 0;
+  int extra_bytes = ccl->eight_bit_control;
+  int eof_ic = ccl->eof_ic;
+  int eof_hit = 0;
 
-  if (ic >= ccl->eof_ic)
+  if (ic >= eof_ic)
     ic = CCL_HEADER_MAIN;
 
   if (ccl->buf_magnification == 0) /* We can't produce any bytes.  */
@@ -1103,15 +1122,18 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
                  {
                    ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
                    ic = ccl_prog_stack_struct[0].ic;
+                   eof_ic = ccl_prog_stack_struct[0].eof_ic;
                  }
                CCL_INVALID_CMD;
              }
-           
+
            ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
            ccl_prog_stack_struct[stack_idx].ic = ic;
+           ccl_prog_stack_struct[stack_idx].eof_ic = eof_ic;
            stack_idx++;
            ccl_prog = XVECTOR (AREF (slot, 1))->contents;
            ic = CCL_HEADER_MAIN;
+           eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);
          }
          break;
 
@@ -1141,6 +1163,9 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
              stack_idx--;
              ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
              ic = ccl_prog_stack_struct[stack_idx].ic;
+             eof_ic = ccl_prog_stack_struct[stack_idx].eof_ic;
+             if (eof_hit)
+               ic = eof_ic;
              break;
            }
          if (src)
@@ -1270,7 +1295,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
                  src++;
                  goto ccl_read_multibyte_character_suspend;
                }
-             
+
              if (!ccl->multibyte)
                {
                  int bytes;
@@ -1284,7 +1309,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
              i = *src++;
              if (i == '\n' && ccl->eol_type != CODING_EOL_LF)
                {
-                 /* We are encoding.  */ 
+                 /* We are encoding.  */
                  if (ccl->eol_type == CODING_EOL_CRLF)
                    {
                      if (ccl->cr_consumed)
@@ -1377,7 +1402,8 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
              src--;
              if (ccl->last_block)
                {
-                 ic = ccl->eof_ic;
+                 ic = eof_ic;
+                 eof_hit = 1;
                  goto ccl_repeat;
                }
              else
@@ -1409,7 +1435,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
              SPLIT_CHAR (op, reg[RRR], i, j);
              if (j != -1)
                i = (i << 7) | j;
-             
+
              reg[rrr] = i;
              break;
 
@@ -1421,23 +1447,24 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
              SPLIT_CHAR (op, reg[RRR], i, j);
              if (j != -1)
                i = (i << 7) | j;
-             
+
              reg[rrr] = i;
              break;
 
            case CCL_LookupIntConstTbl:
              op = XINT (ccl_prog[ic]); /* table */
              ic++;
-             {         
+             {
                struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
 
                op = hash_lookup (h, make_number (reg[RRR]), NULL);
                if (op >= 0)
                  {
-                   op = HASH_VALUE (h, op);
-                   if (!CHAR_VALID_P (op, 0))
+                   Lisp_Object opl;
+                   opl = HASH_VALUE (h, op);
+                   if (!CHAR_VALID_P (XINT (opl), 0))
                      CCL_INVALID_CMD;
-                   SPLIT_CHAR (XINT (op), reg[RRR], i, j);
+                   SPLIT_CHAR (XINT (opl), reg[RRR], i, j);
                    if (j != -1)
                      i = (i << 7) | j;
                    reg[rrr] = i;
@@ -1452,16 +1479,17 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
              op = XINT (ccl_prog[ic]); /* table */
              ic++;
              CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
-             {         
+             {
                struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
 
                op = hash_lookup (h, make_number (i), NULL);
                if (op >= 0)
                  {
-                   op = HASH_VALUE (h, op);
-                   if (!INTEGERP (op))
+                   Lisp_Object opl;
+                   opl = HASH_VALUE (h, op);
+                   if (!INTEGERP (opl))
                      CCL_INVALID_CMD;
-                   reg[RRR] = XINT (op);
+                   reg[RRR] = XINT (opl);
                    reg[7] = 1; /* r7 true for success */
                  }
                else
@@ -1525,7 +1553,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
                        else
                          continue;
                      }
-                   else 
+                   else
                      continue;
 
                    if (NILP (content))
@@ -1561,7 +1589,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
                ic = fin_ic;
              }
              break;
-             
+
            case CCL_MapMultiple:
              {
                Lisp_Object map, content, attrib, value;
@@ -1648,7 +1676,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
                      }
                  }
                map_vector_size = ASIZE (Vcode_conversion_map_vector);
-               
+
                do {
                  for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
                    {
@@ -1698,7 +1726,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
                          else
                            continue;
                        }
-                     else 
+                     else
                        continue;
 
                      if (NILP (content))
@@ -1816,7 +1844,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
                  }
              }
              break;
-             
+
            default:
              CCL_INVALID_CMD;
            }
@@ -1880,7 +1908,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
          break;
 
        default:
-         sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
+         sprintf(msg, "\nCCL: Unknown error type (%d)", ccl->status);
        }
 
       msglen = strlen (msg);
@@ -1889,7 +1917,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
          bcopy (msg, dst, msglen);
          dst += msglen;
        }
-      
+
       if (ccl->status == CCL_STAT_INVALID_CMD)
        {
 #if 0 /* If the remaining bytes contain 0x80..0x9F, copying them
@@ -1913,7 +1941,7 @@ ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
   ccl->ic = ic;
   ccl->stack_idx = stack_idx;
   ccl->prog = ccl_prog;
-  ccl->eight_bit_control = (extra_bytes > 0);
+  ccl->eight_bit_control = (extra_bytes > 1);
   if (consumed)
     *consumed = src - source;
   return (dst ? dst - destination : 0);
@@ -2068,11 +2096,10 @@ setup_ccl_program (ccl, ccl_prog)
   ccl->stack_idx = 0;
   ccl->eol_type = CODING_EOL_LF;
   ccl->suppress_error = 0;
+  ccl->eight_bit_control = 0;
   return 0;
 }
 
-#ifdef emacs
-
 DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
        doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code.
 See the documentation of  `define-ccl-program' for the detail of CCL program.  */)
@@ -2205,8 +2232,8 @@ See the documentation of `define-ccl-program' for the detail of CCL program.  */
   produced = ccl_driver (&ccl, SDATA (str), outbuf,
                         SBYTES (str), outbufsize, (int *) 0);
   for (i = 0; i < 8; i++)
-    XSET (AREF (status, i), Lisp_Int, ccl.reg[i]);
-  XSETINT (AREF (status, 8), ccl.ic);
+    ASET (status, i, make_number (ccl.reg[i]));
+  ASET (status, 8, make_number (ccl.ic));
   UNGCPRO;
 
   if (NILP (unibyte_p))
@@ -2327,7 +2354,7 @@ Return index number of the registered map.  */)
 
   CHECK_SYMBOL (symbol);
   CHECK_VECTOR (map);
-  
+
   for (i = 0; i < len; i++)
     {
       Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
@@ -2413,4 +2440,5 @@ used by CCL.  */);
   defsubr (&Sregister_code_conversion_map);
 }
 
-#endif  /* emacs */
+/* arch-tag: bb9a37be-68ce-4576-8d3d-15d750e4a860
+   (do not change this comment) */