* interp/g-opt.boot ($VMsideEffectFreeOperators): Include %strlength.

	* interp/g-util.boot: Expand it.
	* algebra/string.spad.pamphlet (String): Remove use of QCSIZE.

9 files changed, 62 insertions, 51 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 7912902e..532ef386 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2010-12-29  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/g-opt.boot ($VMsideEffectFreeOperators): Include %strlength.
+	* interp/g-util.boot: Expand it.
+	* algebra/string.spad.pamphlet (String): Remove use of QCSIZE.
+
 2010-12-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/initial-env.lisp (IDENTP): Remove.
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 4b5f1be6..b6f386f0 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -12,10 +12,13 @@
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
                 |ISTRING;empty?;$B;3|)) 
 
+(PUT '|ISTRING;empty?;$B;3| '|SPADreplace|
+     '(XLAM (|s|) (|%ieq| (|%strlength| |s|) 0))) 
+
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
                 |ISTRING;#;$Nni;4|)) 
 
-(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| 'QCSIZE) 
+(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| '|%strlength|) 
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
                 |ISTRING;=;2$B;5|)) 
@@ -134,9 +137,11 @@
 
 (DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0)) 
 
-(DEFUN |ISTRING;empty?;$B;3| (|s| $) (ZEROP (QCSIZE |s|))) 
+(DEFUN |ISTRING;empty?;$B;3| (|s| $)
+  (DECLARE (IGNORE $))
+  (ZEROP (LENGTH |s|))) 
 
-(DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (QCSIZE |s|)) 
+(DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (LENGTH |s|)) 
 
 (DEFUN |ISTRING;=;2$B;5| (|s| |t| $)
   (DECLARE (IGNORE $))
@@ -234,7 +239,7 @@
                  (EXIT |c|)))))) 
 
 (DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
-  (LET ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|)))
+  (LET ((|np| (LENGTH |part|)) (|nw| (LENGTH |whole|)))
     (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
          (EXIT (COND
                  ((MINUSP |startpos|) (|error| "index out of bounds"))
@@ -262,7 +267,7 @@
            (EXIT (COND
                    ((MINUSP |startpos|)
                     (|error| "index out of bounds"))
-                   ((NOT (< |startpos| (QCSIZE |t|)))
+                   ((NOT (< |startpos| (LENGTH |t|)))
                     (- (|getShellEntry| $ 6) 1))
                    (T (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL)
                                  |ISTRING;position;2$2I;18|)
@@ -275,10 +280,10 @@
   (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
        (EXIT (COND
                ((MINUSP |startpos|) (|error| "index out of bounds"))
-               ((NOT (< |startpos| (QCSIZE |t|)))
+               ((NOT (< |startpos| (LENGTH |t|)))
                 (- (|getShellEntry| $ 6) 1))
                (T (SEQ (LET ((|r| |startpos|)
-                             (#0=#:G1514 (- (QCSIZE |t|) 1)))
+                             (#0=#:G1514 (- (LENGTH |t|) 1)))
                          (LOOP
                            (COND
                              ((> |r| #0#) (RETURN NIL))
@@ -294,10 +299,10 @@
   (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6)))
        (EXIT (COND
                ((MINUSP |startpos|) (|error| "index out of bounds"))
-               ((NOT (< |startpos| (QCSIZE |t|)))
+               ((NOT (< |startpos| (LENGTH |t|)))
                 (- (|getShellEntry| $ 6) 1))
                (T (SEQ (LET ((|r| |startpos|)
-                             (#0=#:G1515 (- (QCSIZE |t|) 1)))
+                             (#0=#:G1515 (- (LENGTH |t|) 1)))
                          (LOOP
                            (COND
                              ((> |r| #0#) (RETURN NIL))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index dcbbd6a0..2f459f95 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -542,9 +542,7 @@
   (|mathprint| |x|)) 
 
 (DEFUN |OUTFORM;message;S$;7| (|s| $)
-  (COND
-    ((SPADCALL |s| (|getShellEntry| $ 12)) (|OUTFORM;empty;$;73| $))
-    (T |s|))) 
+  (COND ((ZEROP (LENGTH |s|)) (|OUTFORM;empty;$;73| $)) (T |s|))) 
 
 (DEFUN |OUTFORM;messagePrint;SV;8| (|s| $)
   (|mathprint| (|OUTFORM;message;S$;7| |s| $))) 
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 45a9c215..1ab934bc 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -278,7 +278,7 @@
     (RETURN
       (LET ((|s| (PNAME (SPADCALL |e| (|getShellEntry| $ 100)))))
         (SEQ (COND
-               ((< 1 (QCSIZE |s|))
+               ((< 1 (LENGTH |s|))
                 (COND
                   ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106))
                        (SPADCALL "\\" (|getShellEntry| $ 43))
@@ -390,7 +390,7 @@
             (NIL (RETURN NIL))
             (T (SEQ (LETT |qr|
                           (MULTIPLE-VALUE-CALL #'CONS
-                              (TRUNCATE |n| (QCSIZE |s|)))
+                              (TRUNCATE |n| (LENGTH |s|)))
                           |SYMBOL;anyRadix|)
                     (SETQ |n| (CAR |qr|))
                     (SETQ |ns|
@@ -489,7 +489,7 @@
                                $)
                            |SYMBOL;name;2$;31|)
                      (LET ((|i| (+ (|getShellEntry| $ 41) 1))
-                           (#0=#:G1526 (QCSIZE |str|)))
+                           (#0=#:G1526 (LENGTH |str|)))
                        (LOOP
                          (COND
                            ((> |i| #0#) (RETURN NIL))
@@ -501,7 +501,7 @@
                                  (RETURN-FROM |SYMBOL;name;2$;31|
                                    (|SYMBOL;coerce;S$;8|
                                     (SPADCALL |str|
-                                     (SPADCALL |i| (QCSIZE |str|)
+                                     (SPADCALL |i| (LENGTH |str|)
                                       (|getShellEntry| $ 141))
                                      (|getShellEntry| $ 142))
                                     $))))))
@@ -524,7 +524,7 @@
                                    (|getShellEntry| $ 137))
                                $)
                            |SYMBOL;scripts;$R;32|)
-                     (LETT |nstr| (QCSIZE |str|)
+                     (LETT |nstr| (LENGTH |str|)
                            |SYMBOL;scripts;$R;32|)
                      (LETT |m|
                            (SPADCALL |nscripts|
@@ -652,7 +652,7 @@
     (|setShellEntry| $ 20 "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
     (|setShellEntry| $ 21 "abcdefghijklmnopqrstuvwxyz")
     (|setShellEntry| $ 38 "*")
-    (|setShellEntry| $ 41 (QCSIZE (|getShellEntry| $ 38)))
+    (|setShellEntry| $ 41 (LENGTH (|getShellEntry| $ 38)))
     (|setShellEntry| $ 45
         (SPADCALL (SPADCALL "0" (|getShellEntry| $ 43))
             (|getShellEntry| $ 44)))
diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet
index 59b45648..2dd8ec2e 100644
--- a/src/algebra/string.spad.pamphlet
+++ b/src/algebra/string.spad.pamphlet
@@ -268,7 +268,7 @@ CharacterClass: Join(SetCategory, ConvertibleTo String,
 ++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991
 -- The following Lisp dependencies are divided into two groups
 -- Those that are required
--- QENUM QESET QCSIZE MAKE-FULL-CVEC EQ QSLESSP QSGREATERP
+-- QENUM QESET MAKE-FULL-CVEC EQ QSLESSP QSGREATERP
 -- Those that can are included for efficiency only
 -- COPY STRCONC SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP
 ++ Description:
@@ -287,8 +287,8 @@ IndexedString(mn:Integer): Export == Implementation where
     Qelt    ==> CHAR$Lisp
     Qequal  ==> EQUAL$Lisp
     Qsetelt ==> QESET$Lisp
-    Qsize   ==> QCSIZE$Lisp
     Cheq    ==> CHAR_=$Lisp
+    import %strlength: % -> N from Foreign Builtin
 
     c:	Character
     cc: CharacterClass
@@ -296,8 +296,8 @@ IndexedString(mn:Integer): Export == Implementation where
 --  new n		   == MAKE_-FULL_-CVEC(n, space$C)$Lisp
     new(n, c)		   == MAKE_-FULL_-CVEC(n, c)$Lisp
     empty()		   == MAKE_-FULL_-CVEC(0@I)$Lisp
-    empty?(s)		   == Qsize(s) = 0
-    #s			   == Qsize(s)
+    empty?(s)		   == %strlength s = 0
+    #s			   == %strlength s
     s = t		   == Qequal(s, t)
     s < t		   == CGREATERP(t,s)$Lisp
     concat(s:%,t:%)	   == STRCONC(s,t)$Lisp
@@ -335,8 +335,8 @@ IndexedString(mn:Integer): Export == Implementation where
 	c
 
     substring?(part, whole, startpos) ==
-	np:I := Qsize part
-	nw:I := Qsize whole
+	np:I := %strlength part
+	nw:I := %strlength whole
 	(startpos := startpos - mn) < 0 => error "index out of bounds"
 	np > nw - startpos => false
 	for ip in 0..np-1 for iw in startpos.. repeat
@@ -345,20 +345,20 @@ IndexedString(mn:Integer): Export == Implementation where
 
     position(s:%, t:%, startpos:I) ==
 	(startpos := startpos - mn) < 0 => error "index out of bounds"
-	startpos >= Qsize t => mn - 1
+	startpos >= %strlength t => mn - 1
 	r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
 	%peq(r, NIL$Lisp)$Foreign(Builtin) => mn - 1
 	r + mn
     position(c: Character, t: %, startpos: I) ==
 	(startpos := startpos - mn) < 0 => error "index out of bounds"
-	startpos >= Qsize t => mn - 1
-	for r in startpos..Qsize t - 1 repeat
+	startpos >= %strlength t => mn - 1
+	for r in startpos..%strlength t - 1 repeat
 	    if Cheq(Qelt(t, r), c) then return r + mn
 	mn - 1
     position(cc: CharacterClass, t: %, startpos: I) ==
 	(startpos := startpos - mn) < 0 => error "index out of bounds"
-	startpos >= Qsize t => mn - 1
-	for r in startpos..Qsize t - 1 repeat
+	startpos >= %strlength t => mn - 1
+	for r in startpos..%strlength t - 1 repeat
 	    if member?(Qelt(t,r), cc) then return r + mn
 	mn - 1
 
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 36f369ec..cd078397 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -451,6 +451,7 @@ $VMsideEffectFreeOperators ==
         %nil %pair? %lconcat %llength %lfirst %lsecond %lthird
         %lreverse %lempty? %hash %ismall? %string? %f2s
         %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %sname
+        %strlength
         %vref %vlength %before?)
 
 ++ List of simple VM operators
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 9737c712..3a2504cf 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -512,6 +512,7 @@ for x in [
 
     -- string unary functions
     ['%string?, :'STRINGP],
+    ['%strlength, :'LENGTH],
 
     -- general utility
     ['%hash,     :'SXHASH],
@@ -600,7 +601,7 @@ isSharpVar x ==
  
 isSharpVarWithNum x ==
   not isSharpVar x => nil
-  (n := QCSIZE(p := PNAME x)) < 2 => nil
+  (n := #(p := PNAME x)) < 2 => nil
   ok := true
   c := 0
   for i in 1..(n-1) while ok repeat
@@ -977,8 +978,8 @@ stringPrefix?(pref,str) ==
   -- sees if the first #pref letters of str are pref
   -- replaces STRINGPREFIXP
   not (string?(pref) and string?(str)) => NIL
-  (lp := QCSIZE pref) = 0 => true
-  lp > QCSIZE str => NIL
+  (lp := # pref) = 0 => true
+  lp > # str => NIL
   ok := true
   i := 0
   while ok and (i < lp) repeat
@@ -992,13 +993,13 @@ stringChar2Integer(str,pos) ==
   -- in string str. Returns NIL if not a digit or other error.
   if IDENTP str then str := PNAME str
   not (string?(str) and
-    integer?(pos) and (pos >= 0) and (pos < QCSIZE(str))) => NIL
+    integer?(pos) and (pos >= 0) and (pos < #str)) => NIL
   not digit?(d := SCHAR(str,pos)) => NIL
   DIG2FIX d
 
 dropLeadingBlanks str ==
   str := object2String str
-  l := QCSIZE str
+  l := # str
   nb := NIL
   i := 0
   while (i < l) and not nb repeat
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 37939a6a..e58d4a3a 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -1016,7 +1016,7 @@ selectMmsGen(op,tar,args1,args2) ==
   $Subst: local := NIL
   $SymbolType: local := NIL
 
-  null (S := getModemapsFromDatabase(op,QLENGTH args1)) => NIL
+  null (S := getModemapsFromDatabase(op,#args1)) => NIL
 
   if (op = 'map) and (2 = #args1) and
     (first(args1) is ['Mapping,., elem]) and
@@ -1702,7 +1702,7 @@ printMms(mmS) ==
   sayMSG '" "
   for [sig,imp,.] in mmS for i in 1.. repeat
     istr := strconc('"[",STRINGIMAGE i,'"]")
-    if QCSIZE(istr) = 3 then istr := strconc(istr,'" ")
+    if #istr = 3 then istr := strconc(istr,'" ")
     sayMSG [:bright istr,'"signature:   ",:formatSignature rest sig]
     first sig='local =>
       sayMSG ['"      implemented: local function ",imp]
diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot
index 9d650bd6..36281057 100644
--- a/src/interp/msgdb.boot
+++ b/src/interp/msgdb.boot
@@ -175,7 +175,7 @@ substituteSegmentedMsg(msg,args) ==
     cons? x =>
       l := [substituteSegmentedMsg(x,args),:l]
     c := x.0
-    n := STRINGLENGTH x
+    n := # x
 
     -- x is a special case
     (n > 2) and c = char "%" and x.1 = char "k" =>
@@ -573,14 +573,14 @@ brightPrint(x,out == $OutputStream) ==
 
 brightPrint0(x,out == $OutputStream) ==
   $texFormatting => brightPrint0AsTeX(x,out)
-  if IDENTP x then x := PNAME x
+  if IDENTP x then x := symbolName x
   not string? x => brightPrintHighlight(x,out)
 
   -- if the first character is a backslash and the second is a percent sign,
   -- don't try to give the token any special interpretation. Just print
   -- it without the backslash.
 
-  STRINGLENGTH x > 1 and x.0 = char "\" and x.1 = char "%" =>
+  # x > 1 and x.0 = char "\" and x.1 = char "%" =>
     sayString(subString(x,1),out)
   x = '"%l" =>
     sayNewLine(out)
@@ -639,7 +639,7 @@ brightPrint0AsTeX(x, out == $OutputStream) ==
   brightPrintHighlight(x,out)
 
 blankIndicator x ==
-  if IDENTP x then x := PNAME x
+  if IDENTP x then x := symbolName x
   not string? x or MAXINDEX x < 1 => nil
   x.0 = char '% and x.1 = char 'x =>
     MAXINDEX x > 1 => readInteger subString(x,2)
@@ -655,7 +655,7 @@ brightPrint1(x, out == $OutputStream) ==
 brightPrintHighlight(x, out == $OutputStream) ==
   $texFormatting => brightPrintHighlightAsTeX(x,out)
   x is [key,:rst] =>
-    if IDENTP key then key := PNAME key
+    if IDENTP key then key := symbolName key
     key is '"%m" => mathprint(rst,out)
     string? key and key in '("%p" "%s") => PRETTYPRIN0(rst,out)
     key is '"%ce" => brightPrintCenter(rst,out)
@@ -672,7 +672,7 @@ brightPrintHighlight(x, out == $OutputStream) ==
       sayString('" . ",out)
       brightPrint1(la,out)
     sayString('")",out)
-  IDENTP x => sayString(PNAME x,out)
+  IDENTP x => sayString(symbolName x,out)
   -- following line helps find certain bugs that slip through
   -- also see sayBrightlyLength1
   vector? x => sayString('"UNPRINTABLE",out)
@@ -699,7 +699,7 @@ brightPrintHighlightAsTeX(x, out == $OutputStream) ==
       sayString('" . ",out)
       brightPrint1(la,out)
     sayString('")",out)
-  IDENTP x => sayString(PNAME x,out)
+  IDENTP x => sayString(symbolName x,out)
   vector? x => sayString('"UNPRINTABLE",out)
   sayString(object2String x,out)
 
@@ -713,7 +713,7 @@ brightPrintCenter(x,out == $OutputStream) ==
   -- centers rst within $LINELENGTH, checking for %l's
   atom x =>
     x := object2String x
-    wid := STRINGLENGTH x
+    wid := # x
     if wid < $LINELENGTH then
       f := DIVIDE($LINELENGTH - wid,2)
       x := [fillerSpaces(f.0,'" "),x]
@@ -759,7 +759,7 @@ brightPrintRightJustify(x, out == $OutputStream) ==
   -- right justifies rst within $LINELENGTH, checking for %l's
   atom x =>
     x := object2String x
-    wid := STRINGLENGTH x
+    wid := # x
     wid < $LINELENGTH =>
       x := [fillerSpaces($LINELENGTH-wid,'" "),x]
       for y in x repeat brightPrint0(y,out)
@@ -794,14 +794,14 @@ sayBrightlyLength1 x ==
     null $highlightAllowed => 1
     1
   member(x,'("%l" %l)) => 0
-  string? x and STRINGLENGTH x > 2 and x.0 = '"%" and x.1 = '"x" =>
-    INTERN x.3
-  string? x => STRINGLENGTH x
-  IDENTP x => STRINGLENGTH PNAME x
+  string? x and # x > 2 and x.0 = char "%" and x.1 = char "x" =>
+    readInteger(x,2)
+  string? x => # x
+  IDENTP x => # symbolName x
   -- following line helps find certain bugs that slip through
   -- also see brightPrintHighlight
-  vector? x => STRINGLENGTH '"UNPRINTABLE"
-  atom x => STRINGLENGTH STRINGIMAGE x
+  vector? x => # '"UNPRINTABLE"
+  atom x => # toString x
   2 + sayBrightlyLength x
 
 sayAsManyPerLineAsPossible l ==