Changeset 254


Ignore:
Timestamp:
08/18/11 15:09:13 (3 years ago)
Author:
rjs
Message:

Update.

Location:
trunk/lisp/lmio1
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/lisp/lmio1/cdrive.lisp

    r253 r254  
    665665                    (CALIBRATE-AT-LOC (1+ C) (FORMAT NIL "~DA1-10" (1+ C)) CALIBRATOR)
    666666                    (CALIBRATE-AT-LOC (1+ C) (FORMAT NIL "~DF1-10" (1+ C)) CALIBRATOR))
    667                   (CALIBRATE-AT-LOC NBOARDS (FORMAT NIL "~DA30-10" NBOARDS) CALIBRATOR)
     667                  (CALIBRATE-AT-LOC NBOARDS (FORMAT NIL "~DA29-10" NBOARDS) CALIBRATOR)
    668668                  (CALIBRATE-AT-LOC NBOARDS (FORMAT NIL "~DF25-10" NBOARDS) CALIBRATOR))
    669669                 (LG684
  • trunk/lisp/lmio1/chatst.lisp

    r253 r254  
    177177  (SETQ CSR (%UNIBUS-READ CONTROL-STATUS-REGISTER-TEST))
    178178  (SETQ ME (%UNIBUS-READ MY-NUMBER-REGISTER-TEST))
    179   (IF (NOT (ZEROP (LDB-TEST %%CHAOS-CSR-TRANSMIT-ABORT CSR)))
     179  (IF (LDB-TEST %%CHAOS-CSR-TRANSMIT-ABORT CSR)
    180180      (FORMAT t "~%Transmit aborted, then~%"))
    181181  (COND ((NOT (LDB-TEST %%CHAOS-CSR-RECEIVE-DONE CSR))
  • trunk/lisp/lmio1/dplt.lisp

    r253 r254  
    143143  (UNWIND-PROTECT
    144144    (PROGN
    145       (SETQ STREAM (OPEN (SI:FILE-DEFAULT-FN2 FILE "PLT") '(:IN :FIXNUM :BYTE-SIZE 9.))
     145      (SETQ STREAM (OPEN (FUNCALL (FS:FILE-PARSE-NAME FILE)
     146                                  ':COPY-WITH-TYPE
     147                                  "PLT")
     148                         '(:IN :FIXNUM :BYTE-SIZE 9.))
    146149            X-OFFSET 0 Y-OFFSET 0                       ;no offsets initially
    147150            MIN-X  #.(ASH 1 16.)                        ;init to largest and smallest possible
     
    306309                          (// BINARY-TIME 60.)
    307310                          (\ BINARY-TIME 60.)))
    308      (FILE-NAME   (FORMAT NIL "~A:~A; ~A"
    309                           (FIRST (SI:FILE-SPREAD-PATHNAME (FUNCALL STREAM ':NAME)))
    310                           (SIXBIT-TO-STRING SIXBIT-DIR) (SIXBIT-TO-STRING SIXBIT-FN1)))
     311     (FILE-NAME (FUNCALL (FUNCALL STREAM ':FILENAME) ':STRING-FOR-PRINTING))
    311312     (LEFT   (FLEFT FRAME))
    312313     (RIGHT  (FRIGHT FRAME))
  • trunk/lisp/lmio1/press.lisp

    r253 r254  
    209209                       (FERROR NIL "~A - cannot connect to DOVER server at AI-CHAOS-11" CONN))
    210210                  (CHAOS:STREAM CONN)))
    211             (OPEN (SI:FILE-MERGE-PATHNAMES
    212                     HOST-ADDRESS
    213                     (FORMAT NIL "MC:.DOVR.;~A >" USER-ID))
     211            (OPEN (SI:FILE-PARSE-NAME
     212                    HOST-ADDRESS NIL
     213                    (SI:FILE-PARSE-NAME (FORMAT NIL "MC:.DOVR.;~A >" USER-ID)))
    214214                  '(:WRITE :FIXNUM :BYTE-SIZE 8)))
    215215        PRESS-CURRENT-RECORD-NUMBER 0
  • trunk/lisp/lmio1/rfontw.lisp

    r253 r254  
    4242; to avoid any possible package problems.
    4343
    44 (declare (special widths-file widths-file-next-word widths-file-pos
    45                   code-alist))
     44#M (eval-when (compile eval)
     45        (defmacro dotimes ((var val) &rest forms)
     46                  `(do ((,var ,val (1- ,var))) ((not (> ,var 0))) ,.forms)))
     47
     48
     49(declare (special widths-file code-alist #M widths-file-next-word))
    4650
    4751;Fixnum array (so no number cons) contains -1 or buffered word
     
    4953       (setq widths-file-next-word (*array nil 'fixnum 1)))
    5054
    51 #M (declare (fixnum (next-word) i j k m n wd))
     55#M (declare (fixnum (next-word) (widths-file-pos) i j k m n wd))
    5256
    5357(eval-when (compile eval)
     
    6165;Get next 16-bit word from widths-file
    6266(defun next-word ()
    63   (setq widths-file-pos (1+ widths-file-pos))
    6467  #M (cond ((minusp (arraycall fixnum widths-file-next-word 0))
    6568            (let ((wd (in widths-file)))
     
    7174  #Q (funcall widths-file ':tyi "Unexpected EOF on widths file"))
    7275
     76
     77(defun widths-file-pos ()
     78   #M (- (* 2 (filepos widths-file))
     79         (cond ((minusp (arraycall fixnum widths-file-next-word 0)) 0)
     80               (t 1)))
     81   #Q (funcall widths-file ':read-pointer))
     82
    7383;2's complement form of next-word
    7484(defun next-word2 ()
     
    7787    wd))
    7888
     89             
    7990(defun bcpl-string (n) ;n = max-length-including-header-byte and is even
    8091  (let ((wd (next-word)))
     
    131142        (segment-data nil)
    132143        (wd 0))
    133     (setq widths-file-pos 0)
    134144 #M (store (arraycall fixnum widths-file-next-word 0) -1)
    135145    (setq wd (next-word))
     
    169179        ((null segment-data))
    170180      (setq seg (car segment-data))
    171       (let ((gap (- (cadddr (cdddr seg)) widths-file-pos)))
     181      (let ((gap (- (cadddr (cdddr seg)) (widths-file-pos))))
     182        #M (declare (fixnum gap))
    172183        (cond ((minusp gap) (break file-out-of-phase t)))
    173184        (dotimes (i gap) (next-word)))
     
    284295        family-code tem segment
    285296        (wd 0))
    286     (setq widths-file-pos 0)
    287297    (setq wd (next-word))
    288298    ;; Read IXN entries (type 1)
  • trunk/lisp/lmio1/time.lisp

    r253 r254  
    335335
    336336
    337 ;;; Some useful strings and accessing functions
    338 (DEFVAR *DAYS-OF-THE-WEEK* '(("Mon" "Monday")
    339                              ("Tue" "Tuesday" "Tues")
    340                              ("Wed" "Wednesday")
    341                              ("Thu" "Thursday" "Thurs")
    342                              ("Fri" "Friday")
    343                              ("Sat" "Saturday")
    344                              ("Sun" "Sunday")))
     337;;; Some useful strings and accessing functions.
     338
     339;;; Days of the week.  Elements must be (in order):
     340;;; (1) Three-letter form.
     341;;; (2) Full spelling.
     342;;; (3) Middle-length form if any, else NIL.
     343;;; (4) Francais.
     344;;; (5) Deutsch.
     345(DEFVAR *DAYS-OF-THE-WEEK* '(("Mon" "Monday" NIL "Lundi" "Montag")
     346                             ("Tue" "Tuesday" "Tues" "Mardi" "Dienstag")
     347                             ("Wed" "Wednesday" NIL "Mercredi" "Mittwoch")
     348                             ("Thu" "Thursday" "Thurs" "Jeudi" "Donnerstag")
     349                             ("Fri" "Friday" NIL "Vendredi" "Freitag")
     350                             ("Sat" "Saturday" NIL "Samedi" "Samstag")
     351                             ("Sun" "Sunday" NIL "Dimanche" "Sonntag")))
    345352
    346353(DEFUN DAY-OF-THE-WEEK-STRING (DAY-OF-THE-WEEK &OPTIONAL (MODE ':LONG) &AUX STRINGS)
     
    350357    (:LONG (SECOND STRINGS))
    351358    (:MEDIUM (OR (THIRD STRINGS) (FIRST STRINGS)))
     359    (:FRENCH (FOURTH STRINGS))
     360    (:GERMAN (FIFTH STRINGS))
    352361    (OTHERWISE (FERROR NIL "~S is not a known mode" MODE))))
    353362
    354 (DEFVAR *MONTHS* '(("Jan" "January")
    355                    ("Feb" "February")
    356                    ("Mar" "March")
    357                    ("Apr" "April")
    358                    ("May" "May")
    359                    ("Jun" "June")
    360                    ("Jul" "July")
    361                    ("Aug" "August")
    362                    ("Sep" "September")
    363                    ("Oct" "October")
    364                    ("Nov" "November")
    365                    ("Dec" "December")))
     363
     364;;; Months of the year:  Elements must be (in order):
     365;;; (1) Three-letter form.
     366;;; (2) Full spelling.
     367;;; (3) Middle-length form if any, else NIL.
     368;;; (4) Francais.
     369;;; (5) Roman numberals (used in Europe).
     370(DEFVAR *MONTHS* '(("Jan" "January" NIL "Janvier" "I" "Januar")
     371                   ("Feb" "February" NIL "Fevrier" "II" "Februar")
     372                   ("Mar" "March" NIL "Mars" "III" "Maerz")
     373                   ("Apr" "April" NIL "Avril" "IV" "April")
     374                   ("May" "May" NIL "Mai" "V" "Mai")
     375                   ("Jun" "June" NIL "Juin" "VI" "Juni")
     376                   ("Jul" "July" NIL "Juillet" "VII" "Juli")
     377                   ("Aug" "August" NIL "Aout" "VIII" "August")
     378                   ("Sep" "September" "Sept" "Septembre" "IX" "September")
     379                   ("Oct" "October" NIL "Octobre" "X" "Oktober")
     380                   ("Nov" "November" "Novem" "Novembre" "XI" "November")
     381                   ("Dec" "December" "Decem" "Decembre" "XII" "Dezember")))
    366382
    367383(DEFUN MONTH-STRING (MONTH &OPTIONAL (MODE ':LONG) &AUX STRINGS)
     
    370386    (:SHORT (FIRST STRINGS))
    371387    (:LONG (SECOND STRINGS))
     388    (:MEDIUM (OR (THIRD STRINGS) (FIRST STRINGS)))
     389    (:FRENCH (FOURTH STRINGS))
     390    (:ROMAN (FIFTH STRINGS))
     391    (:GERMAN (SIXTH STRINGS))
    372392    (OTHERWISE (FERROR NIL "~S is not a known mode" MODE))))
    373393
  • trunk/lisp/lmio1/xgp.lisp

    r253 r254  
    8383                                    (substring date-time 0 midpt)))
    8484     (format q-stream ";Status ~A       LM ~C ~A  1 page        ~A ~%"
    85              user-id user-group-affiliation date-time file)
     85             user-id fs:user-group-affiliation date-time file)
    8686     (if xgp-delete-scan-file (format q-stream ";DELETE~%"))
    8787     (format q-stream ";SCAN~2%~A~%" file)
Note: See TracChangeset for help on using the changeset viewer.