Changeset 213

Show
Ignore:
Timestamp:
08/18/11 04:56:14 (22 months ago)
Author:
rjs
Message:

Update.

Location:
trunk/lisp/lmcons
Files:
11 modified

Legend:

Unmodified
Added
Removed

  • trunk/lisp/lmcons/cadld.lisp

    r212 r213  
    22 
    33(INCLUDE |LMDOC;.COMPL PRELUD|) 
    4 ;(DECLARE (EVAL (READ))) 
    5 ;(PROGN (LOAD '(MACROS > DSK LISPM)) 
    6 ;       (LOAD '(DEFMAC FASL DSK LISPM2)) 
    7 ;       (LOAD '(LMMAC > DSK LISPM2))) 
    84 
    95(IF-FOR-MACLISP (DECLARE (EVAL (READ)))) 

  • trunk/lisp/lmcons/cadrd.lisp

    r212 r213  
    11;*CAUTION** THIS FILE ONLY FOR MACLISP!!  LCADR;LCADRD FOR LISPM!! -*-LISP-*- 
     2;       ** (c) Copyright 1980 Massachusetts Institute of Technology ** 
    23;LOW-LEVEL CADR-MUNGING ROUTINES FOR CC 
    34; FOR TEMPORARY DIAG INTERFACE, NO DIRECT PATH TO MD 

  • trunk/lisp/lmcons/cc.lisp

    r212 r213  
    165165(DECLARE (NOTYPE (CC-R-E FIXNUM) (CC-R-D FIXNUM NOTYPE))) 
    166166(DECLARE (SPECIAL CC-SYMBOLS-NAME CC-SYMBOLS-VALUE CC-SYMBOLS-SIZE CC-SYMBOLS-ARRAY-SIZE)) 
    167 (SETQ CC-SYMBOLS-ARRAY-SIZE 3000) ;CURRENT SIZE OF ARRAYS 
     167(SETQ CC-SYMBOLS-ARRAY-SIZE 5000) ;CURRENT SIZE OF ARRAYS 
    168168 
    169169;alist (<file-name> cc-symbols-size cc-symbols-name cc-symbols-value) 

  • trunk/lisp/lmcons/ccgsyl.lisp

    r212 r213  
    88                (LOAD '(LMMAC > DSK LISPM2)) 
    99                (MACROS T))))   ;SEND OVER THE REST OF THE MACROS IN THIS FILE 
     10 
     11(IF-FOR-LISPM 
     12(DEFUN USER:CC () 
     13   (LET ((PACKAGE (PKG-FIND-PACKAGE 'CADR))) 
     14      (CADR:CC)))) 
    1015 
    1116(DECLARE (SPECIAL CC-GETSYL-UNRCH CC-GETSYL-UNRCH-TOKEN CC-LOW-LEVEL-FLAG)) 

  • trunk/lisp/lmcons/cclow.lisp

    r212 r213  
    11; LOW-LEVEL CONS-MUNGING ROUTINES FOR CC                -*-LISP-*- 
     2 
     3;       ** (c) Copyright 1980 Massachusetts Institute of Technology ** 
    24 
    35;** Still have to worry about how to detect that the pdp11 has 

  • trunk/lisp/lmcons/cl.lisp

    r212 r213  
     1;       ** (c) Copyright 1980 Massachusetts Institute of Technology ** 
    12;LOADS LVL 1 AND 2 MAPS TO MAP 32K ADR SPACE STRAIGHT 
    23; (32K BEING A RANDOM NUMBER, WOULD WORK FOR UP TO 128K) 

  • trunk/lisp/lmcons/dcheck.lisp

    r212 r213  
    1 ;;; DCHECK - for checking out newly-constructed disk controls           -*-LISP-*- 
     1;;; -*- Mode:Lisp; Package:CADR; Base:8; Lowercase:yes -*- 
     2 
     3;;; DCHECK - for checking out newly-constructed disk controls 
    24;;; Goes in CADR package 
    35 
    … …  
    125127    (dc-print-status) 
    126128    (terpri) 
     129    (let ((da (phys-mem-read dc-da-adr))) 
     130      (format t "~%Disk address: cylinder ~o, head ~o, block ~o (octal)~%" 
     131                (ldb 2020 da) (ldb 1010 da) (ldb 0010 da))) 
     132    (princ "Current status: ") 
     133    (setq sts (logldb 3010 (phys-mem-read dc-ma-adr))) 
     134    (cc-print-set-bits sts '( track-zero landing-zone ill-cmd ready 
     135                              spin-out-of-limit end-of-cyl diag-error track-zero-error )) 
     136    (princ ", Re-read status: ") 
    127137    (dc-exec-1 5) 
    128138    (setq sts (logldb 3010 (phys-mem-read dc-ma-adr))) 
    129139    (cc-print-set-bits sts '( track-zero landing-zone ill-cmd ready 
    130140                              spin-out-of-limit end-of-cyl diag-error track-zero-error )) 
     141 
    131142    (dc-exec-1 200005) 
    132143    (setq sts (logldb 3010 (phys-mem-read dc-ma-adr))) 
    … …  
    440451            (FORMAT T "~&Problems with block counter.  May be disk not spinning, lack of 
    441452 index or sector pulse, or problem with block counter logic.~%")) 
    442        (AND BAD-VALUES (FORMAT T "Erroneous values seen (octal): ~{~O~}~%" BAD-VALUES)) 
    443        (AND MISSING-VALUES (FORMAT T "Values not seen (octal): ~{~O~} 
    444 Good values that were seen: ~{~O~}~%" MISSING-VALUES GOOD-VALUES))) 
     453       (AND BAD-VALUES (FORMAT T "Erroneous values seen (octal): ~{~O~^,~}~%" BAD-VALUES)) 
     454       (AND MISSING-VALUES (FORMAT T "Values not seen (octal): ~{~O~^,~} 
     455Good values that were seen: ~{~O~^,~}~%" MISSING-VALUES GOOD-VALUES))) 
    445456    (SETQ BCTR (LDB 3010 (PHYS-MEM-READ DC-STS-ADR))) 
    446457    (IF (MEMQ BCTR DESIRED-VALUES) 
    … …  
    746757             (dc-step-addr-specs (list pattern-func blk head cyl)))))) 
    747758 
     759;Useful for debugging disk problems, particularly read-compare errors 
     760(defvar copy-page-buffer) 
     761 
     762(defun copy-page (start-address) 
     763  (or (boundp 'copy-page-buffer) (setq copy-page-buffer (make-array nil 'art-q page-size))) 
     764  (dotimes (i page-size) 
     765    (aset (phys-mem-read (+ start-address i)) copy-page-buffer i))) 
     766 
     767(defun compare-page (start-address) 
     768  (dotimes (i page-size) 
     769    (let ((old (aref copy-page-buffer i)) 
     770          (new (phys-mem-read (+ start-address i)))) 
     771      (cond ((not (= old new)) 
     772             (format t "~&~O// old ~O new ~O, xor ~O bits " 
     773                       (+ start-address i) old new (logxor old new)) 
     774             (do ((bitlist nil) 
     775                  (bits (logxor old new)) 
     776                  (bitno 0 (1+ bitno))) 
     777                 ((= bitno 32.) 
     778                  (cc-print-bit-list "" bitlist)) 
     779               (and (bit-test (ash 1 bitno) bits) 
     780                    (push bitno bitlist)))))))) 
    748781 
    749782;;; Formatting stuff 

  • trunk/lisp/lmcons/dpdiag.lisp

    r212 r213  
    33 
    44(INCLUDE |LMDOC;.COMPL PRELUD|) 
    5 ;(DECLARE (EVAL (READ))) 
    6 ;(PROGN (LOAD '(MACROS > DSK LISPM)) 
    7 ;       (LOAD '(DEFMAC FASL DSK LISPM2)) 
    8 ;       (LOAD '(LMMAC > DSK LISPM2))) 
    95 
    106(IF-FOR-MACLISP (DECLARE (EVAL (READ)))) 
    … …  
    1915(SETQ CC-DIAG-TRACE NIL)  ;T PRINTS ALL ERRORS AS THEY OCCUR 
    2016 
    21 (IF-FOR-MACLISP (DEFMACRO LOGAND* (&REST X) `(BOOLE 1 . ,X))) 
    22  
    23 (IF-FOR-MACLISP (DEFMACRO LOGXOR* (&REST X) `(BOOLE 6 . ,X))) 
    24  
    25 (IF-FOR-LISPM 
    26 (DEFMACRO LOGXOR* (X Y) `(+ (ASH (LOGXOR (LDB 2020 ,X) (LDB 2020 ,Y)) 20) 
    27                               (LOGXOR (LDB 0020 ,X) (LDB 0020 ,Y)))) ) 
    28 (IF-FOR-LISPM 
    29 (DEFMACRO LOGAND* (X Y) `(+ (ASH (LOGAND (LDB 2020 ,X) (LDB 2020 ,Y)) 20) 
    30                               (LOGAND (LDB 0020 ,X) (LDB 0020 ,Y)))) ) 
    3117 
    3218;TESTS 
    … …  
    8773    (PRINC '|Shift=|)(PRIN1 SHIFT) 
    8874    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG) 
    89         (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LSH RELAD SHIFT)))) 
     75        (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LSH RELAD SHIFT)))) 
    9076    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG) 
    9177        (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 
    92                        (LOGAND* ONES (LSH RELAD SHIFT)))) 
     78                       (LOGAND ONES (LSH RELAD SHIFT)))) 
    9379               (SETQ ERRORS (1+ ERRORS)) 
    94                (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND* ONES (LSH RELAD SHIFT)) ACTUAL)))) 
    95     (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG) 
    96         (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT))))) 
     80               (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND ONES (LSH RELAD SHIFT)) ACTUAL)))) 
     81    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG) 
     82        (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT))))) 
    9783    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG) 
    9884        (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 
    99                        (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT))))) 
     85                       (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT))))) 
    10086               (SETQ ERRORS (1+ ERRORS)) 
    101                (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT))) 
     87               (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT))) 
    10288                                 ACTUAL)))) 
    10389;IF THERE WERE ERRORS, GO THRU THE OPPOSITE DIRECTION TO ATTEMPT TO DETERMINE 
    … …  
    10793           (TERPRI) 
    10894           (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 
    109                (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LSH RELAD SHIFT)))) 
     95               (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LSH RELAD SHIFT)))) 
    11096           (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 
    11197               (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 
    112                               (LOGAND* ONES (LSH RELAD SHIFT)))) 
     98                              (LOGAND ONES (LSH RELAD SHIFT)))) 
    11399                      (SETQ ERRORS (1+ ERRORS)) 
    114100                      (CC-TEST-ADR-BARF MESSAGE RELAD 
    115                                         (LOGAND* ONES (LSH RELAD SHIFT)) ACTUAL)))) 
    116            (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 
    117                (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT))))) 
     101                                        (LOGAND ONES (LSH RELAD SHIFT)) ACTUAL)))) 
     102           (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD) 
     103               (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT))))) 
    118104           (DO RELAD (1- NREG) (1- RELAD) (< RELAD NREG) 
    119105               (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD))) 
    120                               (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT))))) 
     106                              (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT))))) 
    121107                      (SETQ ERRORS (1+ ERRORS)) 
    122108                      (CC-TEST-ADR-BARF MESSAGE RELAD 
    123                                         (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT))) 
     109                                        (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT))) 
    124110                                        ACTUAL)))) 
    125111           (TERPRI))) 

  • trunk/lisp/lmcons/lmtv.lisp

    r212 r213  
    1 ;;;Random declarations, etc.                    -*-lisp-*- 
    2 (DECLARE (EVAL (READ))) 
    3 (PROGN (LOAD '(MACROS > DSK LISPM)) 
    4        (LOAD '(DEFMAC FASL DSK LISPM2)) 
    5        (LOAD '(LMMAC > DSK LISPM2))) 
    6  
    7 (DECLARE (EVAL (READ))) 
    8        (DEFUN **STRING** MACRO (X) `',(CADR X)) ;Bubbles in my brain 
    9  
    10 (INCLUDE ((LMCONS)CADMAC >)) 
    11  
    12 (DECLARE (FIXNUM I J K M N NBITS BITNO REGADR PPSS SHIFT RELAD) 
    13          (SPECIAL CC-SUSPECT-BIT-LIST CC-DIAG-TRACE CC-TEST-ADR-BARFED) 
    14          (FIXNUM (CC-SYNC-E FIXNUM)(PHYS-MEM-READ FIXNUM)) 
    15          (MUZZLED T)) ;WHY? 
    16  
    17 (DEFMACRO LOGAND* (&REST X) `(BOOLE 1 . ,X)) 
    18  
    19 (DEFMACRO LOGXOR* (&REST X) `(BOOLE 6 . ,X)) 
     1;;; -*- Mode: LISP;  Package: CADR;  Base: 8 -*- 
    202 
    213;;;Subrs for data path diagnostics (which don't work)  
    … …  
    236218)) 
    237219 
     220(DEFVAR SYNC-CPT) 
    238221(DEFUN CPT () 
    239     (cadpmi) 
    240222    (PHYS-MEM-WRITE VSP 0) 
    241223    (TV-FILL SYNC-CPT) 
    … …  
    244226    (PHYS-MEM-WRITE VSP 200)) 
    245227 
    246 (SETQ BOW 0) 
     228(SETQ BOW 1) 
    247229 
    248230(DEFUN OLD-TV (RELOAD) 

  • trunk/lisp/lmcons/qfmac.lisp

    r212 r213  
    252252     ,ITEM)) 
    253253 
    254 (IF-FOR-MACLISP 
    255 (DEFUN LET MACRO (X) 
    256    ((LAMBDA (LS BOD) 
    257        (CONS (CONS 'LAMBDA 
    258                    (CONS (MAPCAR (FUNCTION CAR) LS) 
    259                          BOD)) 
    260              (MAPCAR (FUNCTION CADR) LS))) 
    261     (CADR X) 
    262     (CDDR X))) 
    263 ) 

  • trunk/lisp/lmcons/unfasl.lisp

    r212 r213  
    11 ;;;QFASL FILE DISASSEMBLER  -*-LISP-*- 
     2;       ** (c) Copyright 1980 Massachusetts Institute of Technology ** 
    23 ;FOR BEST RESULTS, RUN THIS INSIDE A CC 
    34