4 files changed, 33 insertions, 5 deletions
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 1c45d60f..4e909d60 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -450,7 +450,7 @@ $VMsideEffectFreeOperators ==
         %fsinh %fcosh %ftanh %fcsch %fcoth %fsech %fasinh %facsch
         %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
         %lreverse %lempty? %hash %ismall? %string? %f2s
-        %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %sname
+        %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %sname
         %vref %vlength %before?)
 
 ++ List of simple VM operators
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 96bbe1fd..e8fe239c 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -61,6 +61,19 @@ usedSymbol?(s,x) ==
     usedSymbol?(s,body)
   or/[usedSymbol?(s,x') for x' in x]
   
+
+++ Return the character designated by the string `s'.
+stringToChar: %String -> %Char
+stringToChar s ==
+  #s = 1 => char s
+  s = '"\a" => $Bell
+  s = '"\n" => $Newline
+  s = '"\f" => $FormFeed
+  s = '"\r" => $CarriageReturn
+  s = '"\b" => $Backspace
+  s = '"\t" => $HorizontalTab
+  s = '"\v" => $VerticalTab
+  error strconc("invalid character designator: ", s)
   
 --% VM forms
 
@@ -253,9 +266,14 @@ expandBcompl ['%bcompl,x] ==
 
 -- Character operations
 expandCcst ['%ccst,s] ==
+  -- FIXME: this expander should return forms, instead of character constants
   not string? s => error "operand is not a string constant"
-  #s ~= 1 => error "string constant must contain exactly one character"
-  char s
+  stringToChar s
+
+++ string-to-character conversion.  
+expandS2c ['%s2c, x] ==
+  string? x => expandCcst ['%ccst, x]
+  ['stringToChar, x]
 
 -- Integer operations
 expandIneg ['%ineg,x] ==
@@ -364,7 +382,7 @@ for x in [
     ['%and, :'AND],
     ['%or,  :'OR],
 
-    -- character binary operations
+    -- character operations
     ['%ceq, :'CHAR_=],
     ['%clt, :'CHAR_<],
     ['%cle, :'CHAR_<_=],
@@ -479,6 +497,7 @@ for x in [
    ['%bcompl,  :function expandBcompl],
 
    ['%ccst,    :function expandCcst],
+   ['%s2c,     :function expandS2c],
 
    ['%ieq,     :function expandIeq],
    ['%igt,     :function expandIgt],
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 4342ca96..8410f52e 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -42,7 +42,6 @@
 
 ;;; Common  Block
 
-(defconstant |$Newline| #\Newline)
 (defvar |$preserveSystemLisplib| t "if nil finalizeLisplib does MA REP")
 (defvar |$reportInstantiations| nil)
 (defvar |$reportEachInstantiation| nil)
diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp
index 0979262e..fac17612 100644
--- a/src/interp/sys-macros.lisp
+++ b/src/interp/sys-macros.lisp
@@ -42,6 +42,16 @@
 ;; -*- Charcters and Strings -*-
 ;; 
 
+;; Special character constants
+(defconstant |$Bell| (code-char 7))
+(defconstant |$Backspace| #\Backspace)
+(defconstant |$HorizontalTab| #\Tab)
+(defconstant |$Newline| #\Newline)
+(defconstant |$VerticalTab| (code-char 11))
+(defconstant |$FormFeed| #\Page)
+(defconstant |$CarriageReturn| #\Return)
+
+
 (defmacro |char| (arg)
   (cond ((stringp arg)
 	 (character arg))