/[cmucl]/src/code/string.lisp
ViewVC logotype

Diff of /src/code/string.lisp

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

revision 1.1 by ram, Tue Feb 6 17:27:06 1990 UTC revision 1.2 by wlott, Fri Aug 24 18:14:26 1990 UTC
# Line 59  Line 59 
59          (data-end (gensym))          (data-end (gensym))
60          (offset (gensym)))          (offset (gensym)))
61      `(progn      `(progn
62        (if (symbolp ,string) (setq ,string (symbol-name ,string)))         (if (symbolp ,string)
63        (if (array-header-p ,string)             (setf ,string (symbol-name ,string)))
64            (with-array-data ((,data ,string :offset-var ,offset)         (if (array-header-p ,string)
65                              (,data-start ,start)             (with-array-data ((,data ,string :offset-var ,offset)
66                              (,data-end (or ,end                               (,data-start ,start)
67                                             (%primitive header-ref ,string                               (,data-end (or ,end
68                                                         %array-fill-pointer-slot))))                                              (length (the vector ,string)))))
69                             (psetq ,string ,data               (psetq ,string ,data
70                                    ,cum-offset ,offset                      ,cum-offset ,offset
71                                    ,start ,data-start                      ,start ,data-start
72                                    ,end ,data-end))                      ,end ,data-end))
73            (if (not ,end) (setq ,end (length (the simple-string ,string)))))             (if (not ,end) (setq ,end (length (the simple-string ,string)))))
74        ,@forms)))        ,@forms)))
75    
76  )  )
# Line 86  Line 86 
86       (if (array-header-p ,string)       (if (array-header-p ,string)
87           (with-array-data ((data ,string)           (with-array-data ((data ,string)
88                             (data-start start)                             (data-start start)
89                             (data-end (%primitive header-ref ,string                             (data-end (length (the vector ,string))))
                                                  %array-fill-pointer-slot)))  
90             (psetq ,string data             (psetq ,string data
91                    start data-start                    start data-start
92                    end data-end))                    end data-end))
# Line 114  Line 113 
113            (with-array-data ((,data ,string1 :offset-var ,offset)            (with-array-data ((,data ,string1 :offset-var ,offset)
114                              (,data-start ,start1)                              (,data-start ,start1)
115                              (,data-end (or ,end1                              (,data-end (or ,end1
116                                             (%primitive header-ref ,string1                                             (length (the vector ,string1)))))
117                                                         %array-fill-pointer-slot))))              (psetq ,string1 ,data
118                             (psetq ,string1 ,data                     ,cum-offset-1 ,offset
119                                    ,cum-offset-1 ,offset                     ,start1 ,data-start
120                                    ,start1 ,data-start                     ,end1 ,data-end))
                                   ,end1 ,data-end))  
121            (if (not ,end1) (setq ,end1 (length (the simple-string ,string1)))))            (if (not ,end1) (setq ,end1 (length (the simple-string ,string1)))))
122        (if (array-header-p ,string2)        (if (array-header-p ,string2)
123            (with-array-data ((,data ,string2)            (with-array-data ((,data ,string2)
124                              (,data-start ,start2)                              (,data-start ,start2)
125                              (,data-end (or ,end2                              (,data-end (or ,end2
126                                             (%primitive header-ref ,string2                                             (length (the vector ,string2)))))
127                                                         %array-fill-pointer-slot))))              (psetq ,string2 ,data
128                             (psetq ,string2 ,data                     ,start2 ,data-start
129                                    ,start2 ,data-start                     ,end2 ,data-end))
                                   ,end2 ,data-end))  
130            (if (not ,end2) (setq ,end2 (length (the simple-string ,string2)))))            (if (not ,end2) (setq ,end2 (length (the simple-string ,string2)))))
131        ,@forms)))        ,@forms)))
132    
133  )  )
134    
135    
136  (defun char (string index)  (defun char (string index)
137    "Given a string and a non-negative integer index less than the length of    "Given a string and a non-negative integer index less than the length of
138    the string, returns the character object representing the character at    the string, returns the character object representing the character at

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.5