From d05164b7bc0d0998e9e220497386ff7d7cc9a445 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Mon, 26 Jul 2010 16:33:38 +0000
Subject: 	* interp/g-opt.boot ($VMsideEffectFreeOperators): Include new 
 opcodes %icst0,	%icst1, %when, and %ccst. 	* interp/g-util.boot:
 Expand %ccst. 	* algebra/alql.spad.pamphlet: Clean up. 	*
 algebra/array1.spad.pamphlet: Likewise. 	* algebra/c02.spad.pamphlet:
 Likewise. 	* algebra/d03.spad.pamphlet: Likewise. 	*
 algebra/e04.spad.pamphlet: Likewise. 	* algebra/integer.spad.pamphlet:
 Likewise. 	* algebra/si.spad.pamphlet: Likewise. 	*
 algebra/string.spad.pamphlet: Likewise.

---
 src/interp/g-opt.boot  | 20 ++++++++++----------
 src/interp/g-util.boot |  8 ++++++++
 2 files changed, 18 insertions(+), 10 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 2a2f5a60..c7121f01 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -439,17 +439,17 @@ $VMsideEffectFreeOperators ==
     SPADfirst QVELT _+ _- _* _< _= _<_= _> _>_= ASH INTEGER_-LENGTH
      QEQCAR QCDR QCAR IDENTP SYMBOLP
       GREATERP ZEROP ODDP FLOAT_-RADIX FLOAT FLOAT_-SIGN
-       CGREATERP GGREATERP CHAR GET BVEC_-GREATER %false %true
+       CGREATERP GGREATERP CHAR GET BVEC_-GREATER %when %false %true
         %and %or %not %peq %ieq %ilt %ile %igt %ige %head %tail %integer?
-         %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl
-         %icst0 %icst1
-          %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc
-           %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
-            %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc
-             %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
-              %lreverse %lempty? %hash %ismall? %string? %f2s
-               %ceq %clt %cle %cgt %cge %c2i %i2c %sname
-                %vref %vlength %before?)
+        %beq %blt %ble %bgt %bge %bitand %bitior %bitnot %bcompl
+        %icst0 %icst1
+        %imul %iadd %isub %igcd %ilcm %ipow %imin %imax %ieven? %iodd? %iinc
+        %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
+        %fpow %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc
+        %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
+        %lreverse %lempty? %hash %ismall? %string? %f2s
+        %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %sname
+        %vref %vlength %before?)
 
 ++ List of simple VM operators
 $simpleVMoperators == 
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 9817e8e4..c1cc9217 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -251,6 +251,12 @@ expandBcompl ['%bcompl,x] ==
   integer? x => 255 - x
   ['_+,256,['LOGNOT,expandToVMForm x]]
 
+-- Character operations
+expandCcst ['%ccst,s] ==
+  not string? s => error "operand is not a string constant"
+  #s ~= 1 => error "string constant must contain exactly one character"
+  char s
+
 -- Integer operations
 expandIneg ['%ineg,x] ==
   x := expandToVMForm x
@@ -449,6 +455,8 @@ for x in [
 
    ['%bcompl,  :function expandBcompl],
 
+   ['%ccst,    :function expandCcst],
+
    ['%ieq,     :function expandIeq],
    ['%igt,     :function expandIgt],
    ['%ilt,     :function expandIlt],
-- 
cgit v1.2.3