Changeset 204


Ignore:
Timestamp:
08/18/11 11:36:51 (3 years ago)
Author:
rjs
Message:

Update.

Location:
trunk/lisp/lcadr
Files:
1 deleted
13 edited

Legend:

Unmodified
Added
Removed
  • trunk/lisp/lcadr/ccdisk.lisp

    r203 r204  
    593593  (SETQ CC-DISK-TYPE NIL)))
    594594
    595 (IF-FOR-LISPM (ADD-INITIALIZATION "CADR" '(CC-INITIALIZE-ON-STARTUP) '(COLD)))
     595(IF-FOR-LISPM (ADD-INITIALIZATION "CADR" '(CC-INITIALIZE-ON-STARTUP) '(BEFORE-COLD)))
  • trunk/lisp/lcadr/cload.lisp

    r203 r204  
    222222   ;OTHER AREAS
    223223        COLD-EXTRA-PDL-AREA 10
    224         COLD-MICRO-CODE-ENTRY-AREA 1
    225         COLD-MICRO-CODE-ENTRY-NAME-AREA 1
    226         COLD-MICRO-CODE-ENTRY-ARGS-INFO-AREA 1
    227         COLD-MICRO-CODE-ENTRY-MAX-PDL-USAGE 1
     224        COLD-MICRO-CODE-ENTRY-AREA 2
     225        COLD-MICRO-CODE-ENTRY-NAME-AREA 2
     226        COLD-MICRO-CODE-ENTRY-ARGS-INFO-AREA 2
     227        COLD-MICRO-CODE-ENTRY-MAX-PDL-USAGE 2
    228228        COLD-MICRO-CODE-EXIT-AREA 0
    229229    ))
  • trunk/lisp/lcadr/diags.lisp

    r203 r204  
    4242        CC-TEST-PP-DP CC-TEST-PI-DP CC-TEST-PDL-DP CC-TEST-Q-DP CC-TEST-C-MEM-DP
    4343        CC-TEST-LC-DP CC-TEST-A-PASS-DP CC-TEST-M-PASS-DP
     44        CC-TEST-ALU-SHIFT-LEFT-DP CC-TEST-ALU-SHIFT-RIGHT-DP
    4445        CC-TEST-UNIBUS-MAP-DP CC-TEST-BUSINT-BUFFERS-DP))
    4546(SETQ ALL-MEMORIES
     
    221222(DEFUN CC-TEST-M-PASS-DP ()
    222223  (CC-TEST-DATA-PATH "->L->MPASS->MF->M->ALU" '(CC-M-PASS-HANDLER) 32.))
     224
     225(DEFUN CC-TEST-ALU-SHIFT-LEFT-DP ()
     226  (CC-TEST-DATA-PATH "MD,Q(31) -> ALU-SHIFT-LEFT-1" '(CC-ALU-SHIFT-LEFT-HANDLER) 32.))
     227
     228(DEFUN CC-TEST-ALU-SHIFT-RIGHT-DP ()
     229  (CC-TEST-DATA-PATH "MD -> M+M -> ALU-SHIFT-RIGHT-1" '(CC-ALU-SHIFT-RIGHT-HANDLER) 32.))
    223230
    224231(DEFUN CC-TEST-UNIBUS-MAP-DP ()
     
    274281               (FORMAT T "~%M-PASS WROTE ~S READ ~S" DATA ACTUAL)))
    275282        ACTUAL))
     283    (OTHERWISE (FERROR NIL "UNKNOWN OP"))))
     284
     285(DEFUN CC-ALU-SHIFT-LEFT-HANDLER (OP DATA)
     286  (SELECTQ OP
     287    (WRITE-READ
     288     (CC-WRITE-Q (ASH (LOGAND DATA 1) 31.))     ;low bit to high bit of Q
     289     (CC-WRITE-MD (ASH DATA -1))
     290     (CC-EXECUTE                                ;NOTE NO WRITE, JUST PUT IT IN IR
     291       CONS-IR-M-SRC CONS-M-SRC-MD
     292       CONS-IR-ALUF CONS-ALU-SETM
     293       CONS-IR-OB CONS-OB-ALU-LEFT-1)
     294     (LET ((ACTUAL (CC-READ-OBUS)))
     295       (COND ((AND CC-DIAG-TRACE (NOT (= ACTUAL DATA)))
     296              (FORMAT T "~%ALU-LEFT WROTE ~S READ ~S" DATA ACTUAL)))
     297       ACTUAL))
     298    (OTHERWISE (FERROR NIL "UNKNOWN OP"))))
     299
     300(DEFUN CC-ALU-SHIFT-RIGHT-HANDLER (OP DATA)
     301  (SELECTQ OP
     302    (WRITE-READ
     303     (CC-WRITE-MD DATA)
     304     (CC-EXECUTE
     305       CONS-IR-M-SRC CONS-M-SRC-MD
     306       CONS-IR-ALUF CONS-ALU-M+M
     307       CONS-IR-OB CONS-OB-ALU-RIGHT-1)
     308     (LET ((ACTUAL (CC-READ-OBUS)))
     309       (COND ((AND CC-DIAG-TRACE (NOT (= ACTUAL DATA)))
     310              (FORMAT T "~%ALU-RIGHT WROTE ~S READ ~S" DATA ACTUAL)))
     311       ACTUAL))
    276312    (OTHERWISE (FERROR NIL "UNKNOWN OP"))))
    277313
  • trunk/lisp/lcadr/dmon.lisp

    r203 r204  
    1212       (COND ((NULL ALREADY-LOADED)
    1313              (CC-ZERO-ENTIRE-MACHINE)
    14               (CC-UCODE-LOADER NIL '(MEMD ULOAD DSK LISPM1) NIL)))
     14              (CC-UCODE-LOADER NIL "AI:LISPM1;MEMD ULOAD" NIL)))
    1515       (COND ((ZEROP MAP-OFFSET) (CC-FAST-LOAD-STRAIGHT-MAP))
    1616             (T (CC-LOAD-STRAIGHT-MAP MAP-OFFSET)))
  • trunk/lisp/lcadr/lcadmc.lisp

    r203 r204  
    192192  CONS-IR-ALUF 0207  ;INCLUDING CARRY
    193193    CONS-ALU-SETZ 0_1
     194    CONS-ALU-AND 1_1
     195    CONS-ALU-SETM 3_1
     196    CONS-ALU-SETA 5_1
     197    CONS-ALU-XOR 6_1
     198    CONS-ALU-IOR 7_1
    194199    CONS-ALU-SETO 17_1
    195     CONS-ALU-SETA 5_1
    196     CONS-ALU-SETM 3_1
    197200    CONS-ALU-SUB 55           ;includes ALU-CARRY-IN-ONE
    198201    CONS-ALU-ADD 31_1
     
    200203    CONS-ALU-M+M+1 77
    201204    CONS-ALU-M+1 71
     205    CONS-ALU-MSTEP 100
     206    CONS-ALU-DSTEP 102
     207    CONS-ALU-RSTEP 112
     208    CONS-ALU-DFSTEP 122
    202209  CONS-IR-Q 0002
    203210    CONS-Q-LEFT 1
  • trunk/lisp/lcadr/lcadrd.lisp

    r203 r204  
    13401340(DEFUN CC-SHOW-MODE (ARG)
    13411341  (AND CC-LOW-LEVEL-FLAG (PRIN1-THEN-SPACE 'LOW-LEVEL-MODE))
    1342   (CC-TYPE-OUT (OR ARG CC-MODE-REG) CC-MODE-REG-DESC NIL))
     1342  (CC-TYPE-OUT (OR ARG CC-MODE-REG) CC-MODE-REG-DESC NIL T))
    13431343
    13441344(DEFPROP CHMODE CC-EDIT-MODE CC-COLON-CMD)
  • trunk/lisp/lcadr/ldbg.lisp

    r203 r204  
    9090
    9191;;; Print the error status bits
    92 (DEFVAR SERIAL-STREAM (SI:MAKE-SERIAL-STREAM
    93                         ':PARITY NIL ':NUMBER-OF-DATA-BITS 8 ':BAUD 300.))
     92(DEFVAR SERIAL-STREAM)
    9493
    9594(DEFUN DBG-PRINT-STATUS ()
     
    122121;;; Dummy stream for SERIAL I/O
    123122(DEFUN SERIAL-STREAM (OP &OPTIONAL ARG1)
     123  ;; Don't do this at load time since it doesn't work if the machine doesn't have
     124  ;; the serial interface hardware
     125  (OR (BOUNDP 'SERIAL-STREAM)
     126      (SETQ SERIAL-STREAM (SI:MAKE-SERIAL-STREAM ':PARITY NIL ':NUMBER-OF-DATA-BITS 8
     127                                                 ':BAUD 300.)))
    124128  (SELECTQ OP
    125129    (:WHICH-OPERATIONS '(TYI TYO))
  • trunk/lisp/lcadr/lqfmac.lisp

    r203 r204  
    1 ;;;-*-LISP-*-    macros for QF, CC: version of console program that runs on machine
    2 ;       ** (c) Copyright 1980 Massachusetts Institute of Technology **
     1;;; -*- Mode:Lisp; Package:CADR; Base:8 -*-
     2;;;     ** (c) Copyright 1980 Massachusetts Institute of Technology **
     3;;; ***CAUTION!! This file runs only on LISPM.  The MACLISP version is LMCONS;QFMAC***
     4;;;    macros for QF, CC: version of console program that runs on machine
     5
    36
    47;SPECIAL VARIABLES FOR ARRAY STUFF
     
    99102     ,ITEM))
    100103
     104
     105;Really wants to be a bignum LSH.  On LISPM, LSH doesnt win for bignums, ASH does.
     106; In MACLISP, LSH wins sufficiently.
     107(DEFMACRO CC-SHIFT (QUAN AMT)
     108  `(#Q ASH #M LSH ,QUAN ,AMT))
  • trunk/lisp/lcadr/nldbg.lisp

    r203 r204  
    3232      DBG-DL11-HIGH-BIT -1
    3333      DBG-HOST NIL
    34       DBG-CHAOS-STRING (STRING-APPEND "$ UISCAADD")
    35       DBG-CHAOS-16 (MAKE-ARRAY NIL 'ART-16B 5 DBG-CHAOS-STRING)
     34      DBG-CHAOS-STRING (MAKE-ARRAY NIL 'ART-STRING
     35                                   (* 2 CHAOS:MAX-DATA-WORDS-PER-PKT) NIL '(2))
     36      DBG-CHAOS-16 (MAKE-ARRAY NIL 'ART-16B  CHAOS:MAX-DATA-WORDS-PER-PKT DBG-CHAOS-STRING)
    3637      DBG-UNIQUE-ID NIL)
    3738
     
    4243
    4344;;; Read a location on the debuggee's Unibus
    44 (DEFUN DBG-READ (ADR)
     45(DEFUN DBG-READ (ADR &OPTIONAL (CHAOS-DBG-TYPE 'DATA))
    4546  (SELECTQ DBG-ACCESS-PATH
    4647    (DL11
     
    5354      (%UNIBUS-READ 766100))
    5455    (CHAOS
    55       (LET ((PKT (DBG-CHAOS 'DATA ADR)))
     56      (LET ((PKT (DBG-CHAOS CHAOS-DBG-TYPE ADR)))
    5657        (PROG1 (AREF PKT CHAOS:FIRST-DATA-WORD-IN-PKT)
    5758               (CHAOS:RETURN-PKT PKT))))
    5859    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH))))
    5960
    60 
    6161;;; Write a location on the debuggee's Unibus
    62 (DEFUN DBG-WRITE (ADR VAL)
     62(DEFUN DBG-WRITE (ADR VAL &OPTIONAL (CHAOS-DBG-TYPE 'DATA))
    6363  (SELECTQ DBG-ACCESS-PATH
    6464    (DL11
     
    7070      (%UNIBUS-WRITE 766100 (LOGAND VAL 177777)))
    7171    (CHAOS
    72       (CHAOS:RETURN-PKT (DBG-CHAOS 'DATA ADR VAL)))
     72     (DBG-CHAOS CHAOS-DBG-TYPE ADR VAL))
    7373    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH)))   
    7474  T)
     
    8585            (%UNIBUS-WRITE 766110 (COND (DBG-NXM-INHIBIT 4) (T 0))))
    8686    (CHAOS
    87       (CHAOS:RETURN-PKT (DBG-CHAOS 'RESET 0 0)))
     87     (DBG-CHAOS 'RESET 0 0))
    8888    (OTHERWISE (FERROR NIL "~A is illegal DBG-ACCESS-PATH" DBG-ACCESS-PATH)))
    8989  T)
     
    144144  (DPB (LOGXOR 1 (CHARACTER-PARITY (LOGAND CHAR 177))) 0701 CHAR))
    145145
    146 ;;; DBG-CHAOS: Take a unibus cycle over the Chaos net
    147 ;;; First arg is type of cycle (DATA, STATUS, RESET), second is address, third is value
     146;;; DBG-CHAOS: Take a debug cycle over the Chaos net
     147;;; First arg is type of cycle (DATA, STATUS, RESET, ANALOG, INTERNAL-8748,EXTERNAL-8748)
     148;;;  second is address, third is value
    148149(DEFUN DBG-CHAOS (TYPE ADR &OPTIONAL DATA
    149150                  &AUX PKT (TIMEOUT (COND (DBG-NXM-INHIBIT 4) (T 0))))
     
    152153         (FORMAT QUERY-IO "~&Chaos host to debug? ")
    153154         (SETQ DBG-HOST (CHAOS:ADDRESS-PARSE (READLINE QUERY-IO)))))
    154   (COND ((OR (NULL DBG-UNIQUE-ID) (> DBG-UNIQUE-ID 370))
    155          (ASET 2_8. DBG-CHAOS-16 1)             ;0 Unique ID, Reset
    156          (CHAOS:RETURN-PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING))
    157          (SETQ DBG-UNIQUE-ID 0)))
    158   (SETQ DBG-UNIQUE-ID (1+ DBG-UNIQUE-ID))
    159   (ASET (+ 2_8. DBG-UNIQUE-ID) DBG-CHAOS-16 1)
     155  (COND ((= (ARRAY-LEADER DBG-CHAOS-STRING 0) 2)
     156         (COND ((OR (NULL DBG-UNIQUE-ID) (> DBG-UNIQUE-ID 370))
     157                (ASET #/$ DBG-CHAOS-STRING 0)
     158                (ASET #\SPACE DBG-CHAOS-STRING 1)
     159                (ASET 1_8. DBG-CHAOS-16 1)              ;0 Unique ID, Reset
     160                (STORE-ARRAY-LEADER 4 DBG-CHAOS-STRING 0)
     161                (CHAOS:RETURN-PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING))
     162                (STORE-ARRAY-LEADER 2 DBG-CHAOS-STRING 0)
     163                (SETQ DBG-UNIQUE-ID 0)))
     164         (SETQ DBG-UNIQUE-ID (1+ DBG-UNIQUE-ID))
     165         (ASET (+ 1_8. DBG-UNIQUE-ID) DBG-CHAOS-16 1)
     166         (ASET #/$ DBG-CHAOS-STRING 0)
     167         (ASET #\SPACE DBG-CHAOS-STRING 1)
     168         (STORE-ARRAY-LEADER 4 DBG-CHAOS-STRING 0)))
    160169  (SELECTQ TYPE
    161170    (RESET (SETQ TIMEOUT (LOGIOR TIMEOUT DATA))
    162171           (SETQ TYPE 120))
    163172    (DATA (SETQ TYPE (IF DATA 200 000)))
     173    (ANALOG (SETQ TYPE 040)                     ; ADR specifies which channel
     174            (SETQ ADR (LOGIOR 400 (LSH ADR 1))))
    164175    (STATUS (SETQ TYPE (IF DATA 240 040)
    165176                  ADR 2))
     177    (DEBUGGER-HIBERNATE (SETQ TYPE 040)
     178                        (SETQ ADR 200))
     179    (INTERNAL-8748 (SETQ TYPE (IF DATA 300 100))  ; DATA specifies address
     180                   (SETQ ADR (LSH ADR 1)))
     181    (EXTERNAL-8748 (SETQ TYPE (IF DATA 340 140))
     182                   (SETQ ADR (LSH ADR 1)))
    166183    (OTHERWISE (FERROR NIL "Unknown request type ~S" TYPE)))
    167   (ASET (+ (LSH TIMEOUT 8.) TYPE) DBG-CHAOS-16 2)
    168   (ASET (LSH ADR -1) DBG-CHAOS-16 3)
    169   (AND DATA (ASET (LOGAND DATA 177777) DBG-CHAOS-16 4))
    170   (SETQ PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING))
    171   (AND (STRINGP PKT)
    172        (FERROR NIL "~S" PKT))
    173   PKT)
     184  (LET ((WORD (AREF DBG-CHAOS-16 1))
     185        (PTR))
     186    (SETQ PTR (1- (LSH WORD -8.)))
     187    (ASET (+ (LSH TYPE 8.) TIMEOUT) DBG-CHAOS-16 (+ 2 (* PTR 3)))
     188    (ASET (LSH ADR -1) DBG-CHAOS-16 (+ 3 (* PTR 3)))
     189    (AND DATA (ASET (LOGAND DATA 177777) DBG-CHAOS-16 (+ 4 (* PTR 3))))
     190    (ASET (DPB (SETQ PTR (+ PTR 2)) 1010 WORD) DBG-CHAOS-16 1)
     191    (COND ((OR (> (+ PTR 3) (// CHAOS:MAX-DATA-WORDS-PER-PKT 3))
     192               (NOT (BIT-TEST TYPE 200)))
     193           ;; Conservative, or a read
     194           (STORE-ARRAY-LEADER (+ 4 (* (1- PTR) 6)) DBG-CHAOS-STRING 0)
     195           (SETQ PKT (CHAOS:SIMPLE DBG-HOST DBG-CHAOS-STRING))
     196           (AND (BIT-TEST TYPE 200) (CHAOS:RETURN-PKT PKT))
     197           (STORE-ARRAY-LEADER 2 DBG-CHAOS-STRING 0)
     198           PKT))))
    174199
    175200(DEFUN DBG-CHAOS-WRITE-FROB ()
    176   (ASET 340 DBG-CHAOS-16 2)
     201  (ASET 340_8. DBG-CHAOS-16 2)
    177202  (ASET 060 DBG-CHAOS-16 3)
    178   (ASET -1 DBG-CHAOS-16 4)
     203  (ASET 525252 DBG-CHAOS-16 4)
    179204  (DO () (())
    180205    (ERRSET
     
    185210      NIL)))
    186211
     212(DEFUN DBG-ANALOG ()
     213   (DOLIST (X '(0 1 2 3 4 5 6 7))
     214     (DBG-WRITE (LOGIOR 20 X) 0 'EXTERNAL-8748)
     215     (DBG-WRITE 30 -1 'EXTERNAL-8748)
     216     (PRINT (LDB 0010 (DBG-READ 40 'EXTERNAL-8748)))))
    187217
    188218
  • trunk/lisp/lcadr/packed.lisp

    r203 r204  
    383383(IF-FOR-LISPM
    384384(DEFUN DISPLAY-LABEL (LINE)
    385   (TV-CLEAR-SCREEN)
    386   (CURSORPOS 0 0)
     385  (FUNCALL TERMINAL-IO ':CLEAR-SCREEN)
    387386  (FORMAT T "Pack name = ~A.   Check word = ~A.    Version Number = ~D.~%"
    388387          (CONVERT-SYMBOL-TO-STRING-WITHOUT-NULLS PACK-NAME)
  • trunk/lisp/lcadr/praid.lisp

    r203 r204  
    171171  (DO () (()) (CC-WRITE-A-MEM ADR N)))
    172172
     173(DEFUN P-A-MEM-R-LOOP (&OPTIONAL (ADR 0))
     174  (DO () (()) (CC-READ-A-MEM ADR)))
     175
    173176(defun p-m-rw-a-pass (n &optional (adr 0))
    174177  (CC-WRITE-MD n)               ;PUT VALUE INTO THE MRD REGISTER
  • trunk/lisp/lcadr/promh.lisp

    r203 r204  
    365365        ((INTERRUPT-CONTROL) DPB M-ONES         ;CLEAR RESET, SET HALFWORD-MODE,
    366366                (BYTE-FIELD 1 27.) A-ZERO)      ;AND ENABLE INTERRUPTS
    367         ((M-A) DPB M-ONES (BYTE-FIELD 1 22.) A-ZERO)    ;DELAY FOR 1.5 SECONDS FOR MARKSMAN
    368 RSTDLY  (JUMP-NOT-EQUAL-XCT-NEXT M-A A-ZERO RSTDLY)
    369        ((M-A) SUB M-A A-1)
    370367
    371368;;; Set up the map.  First, write a 0 into the first location of the level
     
    426423;;; memory on disk.  Block 1 is allocated to us for this purpose.
    427424SAVE-A-PAGE
     425        ((M-A) DPB M-ONES (BYTE-FIELD 1 18.) A-ZERO)    ;Delay for 0.1 second in case
     426SAPDLY  (JUMP-NOT-EQUAL-XCT-NEXT M-A A-ZERO SAPDLY)     ; something random is happening
     427       ((M-A) SUB M-A A-1)
    428428        ((M-TEMP-1) A-1)
    429429        (CALL-XCT-NEXT DISK-WRITE)
    430430       ((M-A) SETZ)
     431        ((M-TEMP-1) A-1)                                ;Now do a read-compare
     432        (CALL-XCT-NEXT DISK-OP-LOW)
     433       ((M-TEMP-2) DPB M-ONES (BYTE-FIELD 1 3) A-ZERO)  ;OP 10 = read-compare
     434        ((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR)
     435        (JUMP-NOT-EQUAL M-TEMP-1 A-ZERO SAVE-A-PAGE)    ;Got an error on readback, retry
     436        (JUMP-IF-BIT-SET (BYTE-FIELD 1 22.) READ-MEMORY-DATA SAVE-A-PAGE)       ;R/C failed
    431437
    432438
     
    684690
    685691DISK-OP
     692        (CALL DISK-OP-LOW)
     693        ((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR)
     694        (JUMP-NOT-EQUAL M-TEMP-1 A-ZERO ERROR-DISK-ERROR)
     695        (POPJ)
     696
     697DISK-OP-LOW
    686698        ;; Wait for the disk controller to be ready.
    687699        ((VMA-START-READ) A-DISK-REGS)
     
    728740        (JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 0) READ-MEMORY-DATA DISK-WAIT)
    729741    (ERROR-TABLE AWAIT-DISK-DONE)               ;Hangs near here while waiting for disk
    730         ((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR)
    731         (JUMP-NOT-EQUAL M-TEMP-1 A-ZERO ERROR-DISK-ERROR)
    732742        (POPJ)
    733743
  • trunk/lisp/lcadr/qf.lisp

    r203 r204  
    1 ;;; PHONEY -*-LISP-*- MACHINE MICROCODE -- CADR VERSION
    2 ;       ** (c) Copyright 1980 Massachusetts Institute of Technology **
     1;;; -*- Mode:Lisp; Package:CADR; Base:8 -*-
     2;;; PHONEY LISP MACHINE MICROCODE -- CADR VERSION
     3;;;     ** (c) Copyright 1980 Massachusetts Institute of Technology **
    34
    45;2/4/79 MODIFIED FOR CHANGES TO MAP-STATUS-CODE IN PAGE MAP
     
    1415(IF-FOR-MACLISP
    1516 (INCLUDE |LMCONS;QFMAC >|) )
    16 
    17 ;Really wants to be a bignum LSH.  On LISPM, LSH doesnt win for bignums, ASH does.
    18 ; In MACLISP, LSH wins sufficiently.
    19 (DEFMACRO CC-SHIFT (QUAN AMT)
    20   `(#Q ASH #M LSH ,QUAN ,AMT))
    2117
    2218;ALSO SEE FIXNUM DECLARATIONS BELOW WHEN THESE ARE CHANGED.
Note: See TracChangeset for help on using the changeset viewer.