/[emacs]/emacs/src/ccl.c
ViewVC logotype

Diff of /emacs/src/ccl.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.76 by monnier, Wed Nov 28 07:25:03 2001 UTC revision 1.76.4.1 by miles, Fri Apr 4 06:20:57 2003 UTC
# Line 1  Line 1 
1  /* CCL (Code Conversion Language) interpreter.  /* CCL (Code Conversion Language) interpreter.
2     Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.     Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
3     Copyright (C) 2001 Free Software Foundation, Inc.     Copyright (C) 2001, 2002 Free Software Foundation, Inc.
4     Licensed to the Free Software Foundation.     Licensed to the Free Software Foundation.
5    
6  This file is part of GNU Emacs.  This file is part of GNU Emacs.
# Line 20  along with GNU Emacs; see the file COPYI Line 20  along with GNU Emacs; see the file COPYI
20  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,  the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21  Boston, MA 02111-1307, USA.  */  Boston, MA 02111-1307, USA.  */
22    
 #ifdef emacs  
23  #include <config.h>  #include <config.h>
 #endif  
24    
25  #include <stdio.h>  #include <stdio.h>
26    
 #ifdef emacs  
   
27  #include "lisp.h"  #include "lisp.h"
28  #include "charset.h"  #include "charset.h"
29  #include "ccl.h"  #include "ccl.h"
30  #include "coding.h"  #include "coding.h"
31    
 #else  /* not emacs */  
   
 #include "mulelib.h"  
   
 #endif /* not emacs */  
   
32  /* This contains all code conversion map available to CCL.  */  /* This contains all code conversion map available to CCL.  */
33  Lisp_Object Vcode_conversion_map_vector;  Lisp_Object Vcode_conversion_map_vector;
34    
# Line 65  Lisp_Object Qccl_program_idx; Line 55  Lisp_Object Qccl_program_idx;
55     already resolved to index numbers or not.  */     already resolved to index numbers or not.  */
56  Lisp_Object Vccl_program_table;  Lisp_Object Vccl_program_table;
57    
58    /* Vector of registered hash tables for translation.  */
59    Lisp_Object Vtranslation_hash_table_vector;
60    
61    /* Return a hash table of id number ID.  */
62    #define GET_HASH_TABLE(id) \
63      (XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
64    
65  /* CCL (Code Conversion Language) is a simple language which has  /* CCL (Code Conversion Language) is a simple language which has
66     operations on one input buffer, one output buffer, and 7 registers.     operations on one input buffer, one output buffer, and 7 registers.
67     The syntax of CCL is described in `ccl.el'.  Emacs Lisp function     The syntax of CCL is described in `ccl.el'.  Emacs Lisp function
# Line 429  Lisp_Object Vccl_program_table; Line 426  Lisp_Object Vccl_program_table;
426                                          extended_command (rrr,RRR,Rrr,ARGS)                                          extended_command (rrr,RRR,Rrr,ARGS)
427                                        */                                        */
428    
429  /*  /*
430     Here after, Extended CCL Instructions.     Here after, Extended CCL Instructions.
431     Bit length of extended command is 14.     Bit length of extended command is 14.
432     Therefore, the instruction code range is 0..16384(0x3fff).     Therefore, the instruction code range is 0..16384(0x3fff).
# Line 487  Lisp_Object Vccl_program_table; Line 484  Lisp_Object Vccl_program_table;
484                                          3:MAP-ID1                                          3:MAP-ID1
485                                          4:MAP-ID2                                          4:MAP-ID2
486                                          ...                                          ...
487                                       */                                       */
488    
489  /* Map the code in reg[rrr] by MAPs starting from the Nth (N =  /* Map the code in reg[rrr] by MAPs starting from the Nth (N =
490     reg[RRR]) map.     reg[RRR]) map.
# Line 565  Lisp_Object Vccl_program_table; Line 562  Lisp_Object Vccl_program_table;
562     where     where
563          STARTPOINT is an offset to be used for indexing a map,          STARTPOINT is an offset to be used for indexing a map,
564          ENDPOINT is a maximum index number of a map,          ENDPOINT is a maximum index number of a map,
565          VAL and VALn is a number, nil, t, or lambda.            VAL and VALn is a number, nil, t, or lambda.
566    
567     Valid index range of a map of type (a) is:     Valid index range of a map of type (a) is:
568          STARTPOINT <= index < STARTPOINT + map_size - 1          STARTPOINT <= index < STARTPOINT + map_size - 1
# Line 652  while (0) Line 649  while (0)
649                                            set reg[RRR] to -1.                                            set reg[RRR] to -1.
650                                       */                                       */
651    
652    #define CCL_LookupIntConstTbl 0x13 /* Lookup multibyte character by
653                                          integer key.  Afterwards R7 set
654                                          to 1 iff lookup succeeded.
655                                          1:ExtendedCOMMNDRrrRRRXXXXXXXX
656                                          2:ARGUMENT(Hash table ID) */
657    
658    #define CCL_LookupCharConstTbl 0x14 /* Lookup integer by multibyte
659                                           character key.  Afterwards R7 set
660                                           to 1 iff lookup succeeded.
661                                           1:ExtendedCOMMNDRrrRRRrrrXXXXX
662                                           2:ARGUMENT(Hash table ID) */
663    
664  /* CCL arithmetic/logical operators. */  /* CCL arithmetic/logical operators. */
665  #define CCL_PLUS        0x00    /* X = Y + Z */  #define CCL_PLUS        0x00    /* X = Y + Z */
666  #define CCL_MINUS       0x01    /* X = Y - Z */  #define CCL_MINUS       0x01    /* X = Y - Z */
# Line 843  while(0) Line 852  while(0)
852    
853  #ifdef CCL_DEBUG  #ifdef CCL_DEBUG
854  #define CCL_DEBUG_BACKTRACE_LEN 256  #define CCL_DEBUG_BACKTRACE_LEN 256
855  int ccl_backtrace_table[CCL_BACKTRACE_TABLE];  int ccl_backtrace_table[CCL_DEBUG_BACKTRACE_LEN];
856  int ccl_backtrace_idx;  int ccl_backtrace_idx;
857  #endif  #endif
858    
# Line 853  struct ccl_prog_stack Line 862  struct ccl_prog_stack
862      int ic;                     /* Instruction Counter.  */      int ic;                     /* Instruction Counter.  */
863    };    };
864    
865  /* For the moment, we only support depth 256 of stack.  */  /* For the moment, we only support depth 256 of stack.  */
866  static struct ccl_prog_stack ccl_prog_stack_struct[256];  static struct ccl_prog_stack ccl_prog_stack_struct[256];
867    
868  int  int
# Line 1087  ccl_driver (ccl, source, destination, sr Line 1096  ccl_driver (ccl, source, destination, sr
1096                    }                    }
1097                  CCL_INVALID_CMD;                  CCL_INVALID_CMD;
1098                }                }
1099                
1100              ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;              ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
1101              ccl_prog_stack_struct[stack_idx].ic = ic;              ccl_prog_stack_struct[stack_idx].ic = ic;
1102              stack_idx++;              stack_idx++;
# Line 1251  ccl_driver (ccl, source, destination, sr Line 1260  ccl_driver (ccl, source, destination, sr
1260                    src++;                    src++;
1261                    goto ccl_read_multibyte_character_suspend;                    goto ccl_read_multibyte_character_suspend;
1262                  }                  }
1263                  
1264                if (!ccl->multibyte)                if (!ccl->multibyte)
1265                  {                  {
1266                    int bytes;                    int bytes;
# Line 1265  ccl_driver (ccl, source, destination, sr Line 1274  ccl_driver (ccl, source, destination, sr
1274                i = *src++;                i = *src++;
1275                if (i == '\n' && ccl->eol_type != CODING_EOL_LF)                if (i == '\n' && ccl->eol_type != CODING_EOL_LF)
1276                  {                  {
1277                    /* We are encoding.  */                    /* We are encoding.  */
1278                    if (ccl->eol_type == CODING_EOL_CRLF)                    if (ccl->eol_type == CODING_EOL_CRLF)
1279                      {                      {
1280                        if (ccl->cr_consumed)                        if (ccl->cr_consumed)
# Line 1390  ccl_driver (ccl, source, destination, sr Line 1399  ccl_driver (ccl, source, destination, sr
1399                SPLIT_CHAR (op, reg[RRR], i, j);                SPLIT_CHAR (op, reg[RRR], i, j);
1400                if (j != -1)                if (j != -1)
1401                  i = (i << 7) | j;                  i = (i << 7) | j;
1402                  
1403                reg[rrr] = i;                reg[rrr] = i;
1404                break;                break;
1405    
# Line 1402  ccl_driver (ccl, source, destination, sr Line 1411  ccl_driver (ccl, source, destination, sr
1411                SPLIT_CHAR (op, reg[RRR], i, j);                SPLIT_CHAR (op, reg[RRR], i, j);
1412                if (j != -1)                if (j != -1)
1413                  i = (i << 7) | j;                  i = (i << 7) | j;
1414                  
1415                reg[rrr] = i;                reg[rrr] = i;
1416                break;                break;
1417    
1418                case CCL_LookupIntConstTbl:
1419                  op = XINT (ccl_prog[ic]); /* table */
1420                  ic++;
1421                  {
1422                    struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1423    
1424                    op = hash_lookup (h, make_number (reg[RRR]), NULL);
1425                    if (op >= 0)
1426                      {
1427                        Lisp_Object opl;
1428                        opl = HASH_VALUE (h, op);
1429                        if (!CHAR_VALID_P (XINT (opl), 0))
1430                          CCL_INVALID_CMD;
1431                        SPLIT_CHAR (XINT (opl), reg[RRR], i, j);
1432                        if (j != -1)
1433                          i = (i << 7) | j;
1434                        reg[rrr] = i;
1435                        reg[7] = 1; /* r7 true for success */
1436                      }
1437                    else
1438                      reg[7] = 0;
1439                  }
1440                  break;
1441    
1442                case CCL_LookupCharConstTbl:
1443                  op = XINT (ccl_prog[ic]); /* table */
1444                  ic++;
1445                  CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
1446                  {
1447                    struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
1448    
1449                    op = hash_lookup (h, make_number (i), NULL);
1450                    if (op >= 0)
1451                      {
1452                        Lisp_Object opl;
1453                        opl = HASH_VALUE (h, op);
1454                        if (!INTEGERP (opl))
1455                          CCL_INVALID_CMD;
1456                        reg[RRR] = XINT (opl);
1457                        reg[7] = 1; /* r7 true for success */
1458                      }
1459                    else
1460                      reg[7] = 0;
1461                  }
1462                  break;
1463    
1464              case CCL_IterateMultipleMap:              case CCL_IterateMultipleMap:
1465                {                {
1466                  Lisp_Object map, content, attrib, value;                  Lisp_Object map, content, attrib, value;
# Line 1462  ccl_driver (ccl, source, destination, sr Line 1517  ccl_driver (ccl, source, destination, sr
1517                          else                          else
1518                            continue;                            continue;
1519                        }                        }
1520                      else                      else
1521                        continue;                        continue;
1522    
1523                      if (NILP (content))                      if (NILP (content))
# Line 1498  ccl_driver (ccl, source, destination, sr Line 1553  ccl_driver (ccl, source, destination, sr
1553                  ic = fin_ic;                  ic = fin_ic;
1554                }                }
1555                break;                break;
1556                  
1557              case CCL_MapMultiple:              case CCL_MapMultiple:
1558                {                {
1559                  Lisp_Object map, content, attrib, value;                  Lisp_Object map, content, attrib, value;
# Line 1585  ccl_driver (ccl, source, destination, sr Line 1640  ccl_driver (ccl, source, destination, sr
1640                        }                        }
1641                    }                    }
1642                  map_vector_size = ASIZE (Vcode_conversion_map_vector);                  map_vector_size = ASIZE (Vcode_conversion_map_vector);
1643                    
1644                  do {                  do {
1645                    for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)                    for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
1646                      {                      {
# Line 1635  ccl_driver (ccl, source, destination, sr Line 1690  ccl_driver (ccl, source, destination, sr
1690                            else                            else
1691                              continue;                              continue;
1692                          }                          }
1693                        else                        else
1694                          continue;                          continue;
1695    
1696                        if (NILP (content))                        if (NILP (content))
# Line 1753  ccl_driver (ccl, source, destination, sr Line 1808  ccl_driver (ccl, source, destination, sr
1808                    }                    }
1809                }                }
1810                break;                break;
1811                  
1812              default:              default:
1813                CCL_INVALID_CMD;                CCL_INVALID_CMD;
1814              }              }
# Line 1826  ccl_driver (ccl, source, destination, sr Line 1881  ccl_driver (ccl, source, destination, sr
1881            bcopy (msg, dst, msglen);            bcopy (msg, dst, msglen);
1882            dst += msglen;            dst += msglen;
1883          }          }
1884          
1885        if (ccl->status == CCL_STAT_INVALID_CMD)        if (ccl->status == CCL_STAT_INVALID_CMD)
1886          {          {
1887  #if 0 /* If the remaining bytes contain 0x80..0x9F, copying them  #if 0 /* If the remaining bytes contain 0x80..0x9F, copying them
# Line 2008  setup_ccl_program (ccl, ccl_prog) Line 2063  setup_ccl_program (ccl, ccl_prog)
2063    return 0;    return 0;
2064  }  }
2065    
 #ifdef emacs  
   
2066  DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,  DEFUN ("ccl-program-p", Fccl_program_p, Sccl_program_p, 1, 1, 0,
2067         doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code.         doc: /* Return t if OBJECT is a CCL program name or a compiled CCL program code.
2068  See the documentation of  `define-ccl-program' for the detail of CCL program.  */)  See the documentation of  `define-ccl-program' for the detail of CCL program.  */)
# Line 2135  See the documentation of `define-ccl-pro Line 2188  See the documentation of `define-ccl-pro
2188        if (ccl.ic < i && i < ccl.size)        if (ccl.ic < i && i < ccl.size)
2189          ccl.ic = i;          ccl.ic = i;
2190      }      }
2191    outbufsize = STRING_BYTES (XSTRING (str)) * ccl.buf_magnification + 256;    outbufsize = SBYTES (str) * ccl.buf_magnification + 256;
2192    outbuf = (char *) xmalloc (outbufsize);    outbuf = (char *) xmalloc (outbufsize);
2193    ccl.last_block = NILP (contin);    ccl.last_block = NILP (contin);
2194    ccl.multibyte = STRING_MULTIBYTE (str);    ccl.multibyte = STRING_MULTIBYTE (str);
2195    produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,    produced = ccl_driver (&ccl, SDATA (str), outbuf,
2196                           STRING_BYTES (XSTRING (str)), outbufsize, (int *) 0);                           SBYTES (str), outbufsize, (int *) 0);
2197    for (i = 0; i < 8; i++)    for (i = 0; i < 8; i++)
2198      XSET (AREF (status, i), Lisp_Int, ccl.reg[i]);      XSET (AREF (status, i), Lisp_Int, ccl.reg[i]);
2199    XSETINT (AREF (status, 8), ccl.ic);    XSETINT (AREF (status, 8), ccl.ic);
# Line 2264  Return index number of the registered ma Line 2317  Return index number of the registered ma
2317    
2318    CHECK_SYMBOL (symbol);    CHECK_SYMBOL (symbol);
2319    CHECK_VECTOR (map);    CHECK_VECTOR (map);
2320      
2321    for (i = 0; i < len; i++)    for (i = 0; i < len; i++)
2322      {      {
2323        Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);        Lisp_Object slot = AREF (Vcode_conversion_map_vector, i);
# Line 2336  The code point in the font is set in CCL Line 2389  The code point in the font is set in CCL
2389   If the font is single-byte font, the register R2 is not used.  */);   If the font is single-byte font, the register R2 is not used.  */);
2390    Vfont_ccl_encoder_alist = Qnil;    Vfont_ccl_encoder_alist = Qnil;
2391    
2392      DEFVAR_LISP ("translation-hash-table-vector", &Vtranslation_hash_table_vector,
2393        doc: /* Vector containing all translation hash tables ever defined.
2394    Comprises pairs (SYMBOL . TABLE) where SYMBOL and TABLE were set up by calls
2395    to `define-translation-hash-table'.  The vector is indexed by the table id
2396    used by CCL.  */);
2397        Vtranslation_hash_table_vector = Qnil;
2398    
2399    defsubr (&Sccl_program_p);    defsubr (&Sccl_program_p);
2400    defsubr (&Sccl_execute);    defsubr (&Sccl_execute);
2401    defsubr (&Sccl_execute_on_string);    defsubr (&Sccl_execute_on_string);
2402    defsubr (&Sregister_ccl_program);    defsubr (&Sregister_ccl_program);
2403    defsubr (&Sregister_code_conversion_map);    defsubr (&Sregister_code_conversion_map);
2404  }  }
   
 #endif  /* emacs */  

Legend:
Removed from v.1.76  
changed lines
  Added in v.1.76.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26