Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/format.cmp
There are no other files named format.cmp in the archive.
;COMPARISON OF SS:<CLISP.UPSALA>FORMAT.CLISP.1 AND PS:<VICTOR.CLISP>FORMAT.CLISP.27
;OPTIONS ARE /3
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 1-44 (1340)
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 1-44 (1340)
;;; This is bound in FORMAT-INIT.
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 4-53 (7288)
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 4-53 (7325)
(#\-
(nextchar)
(case (format-peek)
((#\0 #\1 #\2 #\3 #\4
#\5 #\6 #\7 #\8 #\9)
(do* ((number (digit-char-p (format-peek))
(+ (* 10 number) (digit-char-p (format-peek)))))
((not (digit-char-p (nextchar))) (- number))))
(t (decf *format-index*) ; put back to out of place "-"
nil)))
(#\+
(nextchar)
(case (format-peek)
((#\0 #\1 #\2 #\3 #\4
#\5 #\6 #\7 #\8 #\9)
(do* ((number (digit-char-p (format-peek))
(+ (* 10 number) (digit-char-p (format-peek)))))
((not (digit-char-p (nextchar))) number)))
(t (decf *format-index*) ; put back to out of place "+"
nil)))
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 5-13 (7886)
(member ch '(#\, #\# #\V #\v #\') :test #'char=))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 5-13 (8599)
(member ch '(#\, #\# #\V #\v #\' #\+ #\-) :test #'char=))
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 8-6 (14094)
(format-error "No parameters allowed to ~~\("))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 8-6 (14815)
(format-error "No parameters allowed to ~~("))
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 8-15 (14458)
(cond ((and atsign colon)
(nstring-upcase string))
(colon
(nstring-capitalize string))
(atsign
;; Capitalize the first word only
(nstring-downcase string)
(dotimes (i (length string) string)
(when (alpha-char-p (char string i))
(setf (char string i) (char-upcase (char string i)))
(return string))))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 8-15 (15178)
(cond ((and atsign colon) (nstring-upcase string))
(colon (nstring-capitalize string))
;; Capitalize the first word only
(atsign (nstring-downcase string)
(dotimes (i (length string) string)
(when (alpha-char-p (char string i))
(setf (char string i)
(char-upcase (char string i)))
(return string))))
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 18-5 (34547)
;;; The following are initialized in FORMAT-INIT to get around cold-loader
;;; lossage.
(defvar cardinal-ones () "Table of cardinal ones-place digits in English")
(defvar cardinal-tens () "Table of cardinal tens-place digits in English")
(defvar cardinal-teens () "Table of cardinal 'teens' digits in English")
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 18-4 (35258)
(defvar cardinal-ones
'#(nil "one" "two" "three" "four" "five" "six" "seven" "eight" "nine")
"Table of cardinal ones-place digits in English")
(defvar cardinal-tens
'#(nil nil "twenty" "thirty" "forty" "fifty" "sixty" "seventy"
"eighty" "ninety")
"Table of cardinal tens-place digits in English")
(defvar cardinal-teens
'#("ten" "eleven" "twelve" "thirteen" "fourteen"
"fifteen" "sixteen" "seventeen" "eighteen" "nineteen")
"Table of cardinal 'teens' digits in English")
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 18-35 (35546)
(defvar cardinal-periods () "Table of cardinal 'illions' in English")
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 18-39 (36440)
(defconstant cardinal-periods
'#("" " thousand" " million" " billion" " trillion" " quadrillion"
" quintillion" " sextillion" " septillion" " octillion" " nonillion"
" decillion" " undecillion" " duodecillion" " tredecillion"
" quattuordecillion" " quindecillion" " sexdecillion"
" septendecillion" " octodecillion" " novemdecillion"
" vigintillion")
"Table of cardinal 'illions' in English")
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 18-47 (35934)
(unless (<= period 10)
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 18-58 (37174)
(unless (<= period 21)
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 19-5 (36346)
(defvar ordinal-ones () "Table of ordinal ones-place digits in English")
(defvar ordinal-tens () "Table of ordinal tens-place digits in English")
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 19-5 (37586)
(defvar ordinal-ones
'#(nil "first" "second" "third" "fourth" "fifth" "sixth"
"seventh" "eighth" "ninth")
"Table of ordinal ones-place digits in English")
(defvar ordinal-tens
'#(nil "tenth" "twentieth" "thirtieth" "fortieth"
"fiftieth" "sixtieth" "seventieth" "eightieth" "ninetieth")
"Table of ordinal tens-place digits in English")
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 22-9 (41704)
((w nil) (d nil) (e 2) (k 1) (ovf nil) (pad #\space) (marker nil))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 22-9 (43151)
((w nil) (d nil) (e nil) (k 1) (ovf nil) (pad #\space) (marker nil))
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 22-56 (43523)
(when w
(decf spaceleft flen)
(when tpoint (decf spaceleft))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 22-56 (44972)
(declare (ignore tpoint))
(when w
(decf spaceleft flen)
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 22-73 (44024)
(when tpoint (write-char #\0))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 22-73 (45466)
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 23-44 (45968)
number w d (or e 2) (or k 1) ovf pad marker atsign))))))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 23-44 (47374)
number w d e (or k 1) ovf pad marker atsign))))))
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 23-51 (46185)
(let* ((number (pop-format-arg))
(signstr (if (minusp number) "-" (if atsign "+" "")))
(signlen (length signstr)))
(multiple-value-bind (str strlen ig2 ig3 pointplace)
(flonum-to-string number nil d nil)
(declare (ignore ig2 ig3))
(when colon (write-string signstr))
(dotimes (i (- w signlen (- n pointplace) strlen)) (write-char pad))
(unless colon (write-string signstr))
(dotimes (i (- n pointplace)) (write-char #\0))
(write-string str)))))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 23-51 (47584)
(let ((number (pop-format-arg)))
(if (rationalp number)
(setq number (coerce number 'short-float)))
(if (floatp number)
(let* ((signstr (if (minusp number) "-" (if atsign "+" "")))
(signlen (length signstr)))
(multiple-value-bind (str strlen ig2 ig3 pointplace)
(flonum-to-string number nil d nil)
(declare (ignore ig2 ig3))
(when colon (write-string signstr))
(dotimes (i (- w signlen (- n pointplace) strlen))
(write-char pad))
(unless colon (write-string signstr))
(dotimes (i (- n pointplace)) (write-char #\0))
(write-string str)))
(let ((*print-base* 10))
(format-write-field (princ-to-string number) w 1 0 #\space t))))))
***************
**** FILE SS:<CLISP.UPSALA>FORMAT.CLISP.1, 24-38 (47834)
;;; These initializations properly belong in the DEFVARs for these objects.
;;; At present, they must be done after loading due to a limitation in the
;;; cold loader.
(defun format-init ()
(setq cardinal-ones
'#(nil "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"))
(setq cardinal-tens
'#(nil nil "twenty" "thirty" "forty"
"fifty" "sixty" "seventy" "eighty" "ninety"))
(setq cardinal-teens
'#("ten" "eleven" "twelve" "thirteen" "fourteen"
"fifteen" "sixteen" "seventeen" "eighteen" "nineteen"))
(setq cardinal-periods
'#("" " thousand" " million" " billion" " trillion" " quadrillion"
" quintillion" " sextillion" " septillion" " octillion" " nonillion"
" decillion"))
(setq ordinal-ones
'#(nil "first" "second" "third" "fourth"
"fifth" "sixth" "seventh" "eighth" "ninth"))
(setq ordinal-tens
'#(nil "tenth" "twentieth" "thirtieth" "fortieth"
"fiftieth" "sixtieth" "seventieth" "eightieth" "ninetieth"))
**** FILE PS:<VICTOR.CLISP>FORMAT.CLISP.27, 24-37 (49478)
(defun format-init ()
***************