Changeset 254

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

Update.

Location:
trunk/lisp/lmio1
Files:
7 modified

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  
    141141  (UNWIND-PROTECT  
    142142    (PROGN 
    143       (SETQ STREAM (OPEN (SI:FILE-DEFAULT-FN2 FILE "PLT") '(:IN :FIXNUM :BYTE-SIZE 9.)) 
     143      (SETQ STREAM (OPEN (FUNCALL (FS:FILE-PARSE-NAME FILE) 
     144                                  ':COPY-WITH-TYPE 
     145                                  "PLT") 
     146                         '(:IN :FIXNUM :BYTE-SIZE 9.)) 
    144147            X-OFFSET 0 Y-OFFSET 0                       ;no offsets initially 
    145148            MIN-X  #.(ASH 1 16.)                        ;init to largest and smallest possible 
     
    301304                          (// BINARY-TIME 60.) 
    302305                          (\ BINARY-TIME 60.))) 
    303      (FILE-NAME   (FORMAT NIL "~A:~A; ~A" 
    304                           (FIRST (SI:FILE-SPREAD-PATHNAME (FUNCALL STREAM ':NAME))) 
    305                           (SIXBIT-TO-STRING SIXBIT-DIR) (SIXBIT-TO-STRING SIXBIT-FN1))) 
     306     (FILE-NAME (FUNCALL (FUNCALL STREAM ':FILENAME) ':STRING-FOR-PRINTING)) 
    306307     (LEFT   (FLEFT FRAME)) 
    307308     (RIGHT  (FRIGHT FRAME)) 
  • trunk/lisp/lmio1/press.lisp

    r253 r254  
    205205                       (FERROR NIL "~A - cannot connect to DOVER server at AI-CHAOS-11" CONN)) 
    206206                  (CHAOS:STREAM CONN))) 
    207             (OPEN (SI:FILE-MERGE-PATHNAMES 
    208                     HOST-ADDRESS 
    209                     (FORMAT NIL "MC:.DOVR.;~A >" USER-ID)) 
     207            (OPEN (SI:FILE-PARSE-NAME 
     208                    HOST-ADDRESS NIL 
     209                    (SI:FILE-PARSE-NAME (FORMAT NIL "MC:.DOVR.;~A >" USER-ID))) 
    210210                  '(:WRITE :FIXNUM :BYTE-SIZE 8))) 
    211211        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))) 
     
    283294        family-code tem segment 
    284295        (wd 0)) 
    285     (setq widths-file-pos 0) 
    286296    (setq wd (next-word)) 
    287297    ;; Read IXN entries (type 1) 
  • trunk/lisp/lmio1/time.lisp

    r253 r254  
    332332           (ASET DIG2 STR (1+ I))))) 
    333333 
    334 ;;; Some useful strings and accessing functions 
    335 (DEFVAR *DAYS-OF-THE-WEEK* '(("Mon" "Monday") 
    336                              ("Tue" "Tuesday" "Tues") 
    337                              ("Wed" "Wednesday") 
    338                              ("Thu" "Thursday" "Thurs") 
    339                              ("Fri" "Friday") 
    340                              ("Sat" "Saturday") 
    341                              ("Sun" "Sunday"))) 
     334;;; Some useful strings and accessing functions. 
     335 
     336;;; Days of the week.  Elements must be (in order): 
     337;;; (1) Three-letter form. 
     338;;; (2) Full spelling. 
     339;;; (3) Middle-length form if any, else NIL. 
     340;;; (4) Francais. 
     341;;; (5) Deutsch. 
     342(DEFVAR *DAYS-OF-THE-WEEK* '(("Mon" "Monday" NIL "Lundi" "Montag") 
     343                             ("Tue" "Tuesday" "Tues" "Mardi" "Dienstag") 
     344                             ("Wed" "Wednesday" NIL "Mercredi" "Mittwoch") 
     345                             ("Thu" "Thursday" "Thurs" "Jeudi" "Donnerstag") 
     346                             ("Fri" "Friday" NIL "Vendredi" "Freitag") 
     347                             ("Sat" "Saturday" NIL "Samedi" "Samstag") 
     348                             ("Sun" "Sunday" NIL "Dimanche" "Sonntag"))) 
    342349 
    343350(DEFUN DAY-OF-THE-WEEK-STRING (DAY-OF-THE-WEEK &OPTIONAL (MODE ':LONG) &AUX STRINGS) 
     
    347354    (:LONG (SECOND STRINGS)) 
    348355    (:MEDIUM (OR (THIRD STRINGS) (FIRST STRINGS))) 
     356    (:FRENCH (FOURTH STRINGS)) 
     357    (:GERMAN (FIFTH STRINGS)) 
    349358    (OTHERWISE (FERROR NIL "~S is not a known mode" MODE)))) 
    350359 
    351 (DEFVAR *MONTHS* '(("Jan" "January") 
    352                    ("Feb" "February") 
    353                    ("Mar" "March") 
    354                    ("Apr" "April") 
    355                    ("May" "May") 
    356                    ("Jun" "June") 
    357                    ("Jul" "July") 
    358                    ("Aug" "August") 
    359                    ("Sep" "September") 
    360                    ("Oct" "October") 
    361                    ("Nov" "November") 
    362                    ("Dec" "December"))) 
     360 
     361;;; Months of the year:  Elements must be (in order): 
     362;;; (1) Three-letter form. 
     363;;; (2) Full spelling. 
     364;;; (3) Middle-length form if any, else NIL. 
     365;;; (4) Francais. 
     366;;; (5) Roman numberals (used in Europe). 
     367(DEFVAR *MONTHS* '(("Jan" "January" NIL "Janvier" "I" "Januar") 
     368                   ("Feb" "February" NIL "Fevrier" "II" "Februar") 
     369                   ("Mar" "March" NIL "Mars" "III" "Maerz") 
     370                   ("Apr" "April" NIL "Avril" "IV" "April") 
     371                   ("May" "May" NIL "Mai" "V" "Mai") 
     372                   ("Jun" "June" NIL "Juin" "VI" "Juni") 
     373                   ("Jul" "July" NIL "Juillet" "VII" "Juli") 
     374                   ("Aug" "August" NIL "Aout" "VIII" "August") 
     375                   ("Sep" "September" "Sept" "Septembre" "IX" "September") 
     376                   ("Oct" "October" NIL "Octobre" "X" "Oktober") 
     377                   ("Nov" "November" "Novem" "Novembre" "XI" "November") 
     378                   ("Dec" "December" "Decem" "Decembre" "XII" "Dezember"))) 
    363379 
    364380(DEFUN MONTH-STRING (MONTH &OPTIONAL (MODE ':LONG) &AUX STRINGS) 
     
    367383    (:SHORT (FIRST STRINGS)) 
    368384    (:LONG (SECOND STRINGS)) 
     385    (:MEDIUM (OR (THIRD STRINGS) (FIRST STRINGS))) 
     386    (:FRENCH (FOURTH STRINGS)) 
     387    (:ROMAN (FIFTH STRINGS)) 
     388    (:GERMAN (SIXTH STRINGS)) 
    369389    (OTHERWISE (FERROR NIL "~S is not a known mode" MODE)))) 
    370390 
  • 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)