Changeset 213


Ignore:
Timestamp:
08/18/11 11:56:14 (3 years ago)
Author:
rjs
Message:

Update.

Location:
trunk/lisp/lmcons
Files:
11 edited

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  
    166166(DECLARE (NOTYPE (CC-R-E FIXNUM) (CC-R-D FIXNUM NOTYPE)))
    167167(DECLARE (SPECIAL CC-SYMBOLS-NAME CC-SYMBOLS-VALUE CC-SYMBOLS-SIZE CC-SYMBOLS-ARRAY-SIZE))
    168 (SETQ CC-SYMBOLS-ARRAY-SIZE 3000) ;CURRENT SIZE OF ARRAYS
     168(SETQ CC-SYMBOLS-ARRAY-SIZE 5000) ;CURRENT SIZE OF ARRAYS
    169169
    170170;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
     
    126128    (dc-print-status)
    127129    (terpri)
     130    (let ((da (phys-mem-read dc-da-adr)))
     131      (format t "~%Disk address: cylinder ~o, head ~o, block ~o (octal)~%"
     132                (ldb 2020 da) (ldb 1010 da) (ldb 0010 da)))
     133    (princ "Current status: ")
     134    (setq sts (logldb 3010 (phys-mem-read dc-ma-adr)))
     135    (cc-print-set-bits sts '( track-zero landing-zone ill-cmd ready
     136                              spin-out-of-limit end-of-cyl diag-error track-zero-error ))
     137    (princ ", Re-read status: ")
    128138    (dc-exec-1 5)
    129139    (setq sts (logldb 3010 (phys-mem-read dc-ma-adr)))
    130140    (cc-print-set-bits sts '( track-zero landing-zone ill-cmd ready
    131141                              spin-out-of-limit end-of-cyl diag-error track-zero-error ))
     142
    132143    (dc-exec-1 200005)
    133144    (setq sts (logldb 3010 (phys-mem-read dc-ma-adr)))
     
    443454            (FORMAT T "~&Problems with block counter.  May be disk not spinning, lack of
    444455 index or sector pulse, or problem with block counter logic.~%"))
    445        (AND BAD-VALUES (FORMAT T "Erroneous values seen (octal): ~{~O~}~%" BAD-VALUES))
    446        (AND MISSING-VALUES (FORMAT T "Values not seen (octal): ~{~O~}
    447 Good values that were seen: ~{~O~}~%" MISSING-VALUES GOOD-VALUES)))
     456       (AND BAD-VALUES (FORMAT T "Erroneous values seen (octal): ~{~O~^,~}~%" BAD-VALUES))
     457       (AND MISSING-VALUES (FORMAT T "Values not seen (octal): ~{~O~^,~}
     458Good values that were seen: ~{~O~^,~}~%" MISSING-VALUES GOOD-VALUES)))
    448459    (SETQ BCTR (LDB 3010 (PHYS-MEM-READ DC-STS-ADR)))
    449460    (IF (MEMQ BCTR DESIRED-VALUES)
     
    753764             (dc-step-addr-specs (list pattern-func blk head cyl))))))
    754765
     766;Useful for debugging disk problems, particularly read-compare errors
     767(defvar copy-page-buffer)
     768
     769(defun copy-page (start-address)
     770  (or (boundp 'copy-page-buffer) (setq copy-page-buffer (make-array nil 'art-q page-size)))
     771  (dotimes (i page-size)
     772    (aset (phys-mem-read (+ start-address i)) copy-page-buffer i)))
     773
     774(defun compare-page (start-address)
     775  (dotimes (i page-size)
     776    (let ((old (aref copy-page-buffer i))
     777          (new (phys-mem-read (+ start-address i))))
     778      (cond ((not (= old new))
     779             (format t "~&~O// old ~O new ~O, xor ~O bits "
     780                       (+ start-address i) old new (logxor old new))
     781             (do ((bitlist nil)
     782                  (bits (logxor old new))
     783                  (bitno 0 (1+ bitno)))
     784                 ((= bitno 32.)
     785                  (cc-print-bit-list "" bitlist))
     786               (and (bit-test (ash 1 bitno) bits)
     787                    (push bitno bitlist))))))))
    755788
    756789
  • 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
     
    8975    (PRINC '|Shift=|)(PRIN1 SHIFT)
    9076    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG)
    91         (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LSH RELAD SHIFT))))
     77        (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LSH RELAD SHIFT))))
    9278    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG)
    9379        (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD)))
    94                        (LOGAND* ONES (LSH RELAD SHIFT))))
     80                       (LOGAND ONES (LSH RELAD SHIFT))))
    9581               (SETQ ERRORS (1+ ERRORS))
    96                (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND* ONES (LSH RELAD SHIFT)) ACTUAL))))
    97     (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG)
    98         (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT)))))
     82               (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND ONES (LSH RELAD SHIFT)) ACTUAL))))
     83    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG)
     84        (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT)))))
    9985    (DO RELAD IRELAD (1+ RELAD) (= RELAD NREG)
    10086        (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD)))
    101                        (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT)))))
     87                       (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT)))))
    10288               (SETQ ERRORS (1+ ERRORS))
    103                (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT)))
     89               (CC-TEST-ADR-BARF MESSAGE RELAD (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT)))
    10490                                 ACTUAL))))
    10591;IF THERE WERE ERRORS, GO THRU THE OPPOSITE DIRECTION TO ATTEMPT TO DETERMINE
     
    10995           (TERPRI)
    11096           (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD)
    111                (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LSH RELAD SHIFT))))
     97               (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LSH RELAD SHIFT))))
    11298           (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD)
    11399               (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD)))
    114                               (LOGAND* ONES (LSH RELAD SHIFT))))
     100                              (LOGAND ONES (LSH RELAD SHIFT))))
    115101                      (SETQ ERRORS (1+ ERRORS))
    116102                      (CC-TEST-ADR-BARF MESSAGE RELAD
    117                                         (LOGAND* ONES (LSH RELAD SHIFT)) ACTUAL))))
    118            (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD)
    119                (CC-R-D (+ REGADR RELAD) (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT)))))
     103                                        (LOGAND ONES (LSH RELAD SHIFT)) ACTUAL))))
     104           (DO RELAD (1- NREG) (1- RELAD) (< RELAD IRELAD)
     105               (CC-R-D (+ REGADR RELAD) (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT)))))
    120106           (DO RELAD (1- NREG) (1- RELAD) (< RELAD NREG)
    121107               (COND ((NOT (= (SETQ ACTUAL (CC-R-E (+ REGADR RELAD)))
    122                               (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT)))))
     108                              (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT)))))
    123109                      (SETQ ERRORS (1+ ERRORS))
    124110                      (CC-TEST-ADR-BARF MESSAGE RELAD
    125                                         (LOGAND* ONES (LOGXOR* -1 (LSH RELAD SHIFT)))
     111                                        (LOGAND ONES (LOGXOR -1 (LSH RELAD SHIFT)))
    126112                                        ACTUAL))))
    127113           (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  
    255255     ,ITEM))
    256256
    257 (IF-FOR-MACLISP
    258 (DEFUN LET MACRO (X)
    259    ((LAMBDA (LS BOD)
    260        (CONS (CONS 'LAMBDA
    261                    (CONS (MAPCAR (FUNCTION CAR) LS)
    262                          BOD))
    263              (MAPCAR (FUNCTION CADR) LS)))
    264     (CADR X)
    265     (CDDR X)))
    266 )
  • 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
Note: See TracChangeset for help on using the changeset viewer.