Changeset 204

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

Update.

Location:
trunk/lisp/lcadr
Files:
1 removed
13 modified

Legend:

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

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

    r203 r204  
    220220   ;OTHER AREAS 
    221221        COLD-EXTRA-PDL-AREA 10 
    222         COLD-MICRO-CODE-ENTRY-AREA 1 
    223         COLD-MICRO-CODE-ENTRY-NAME-AREA 1 
    224         COLD-MICRO-CODE-ENTRY-ARGS-INFO-AREA 1 
    225         COLD-MICRO-CODE-ENTRY-MAX-PDL-USAGE 1 
     222        COLD-MICRO-CODE-ENTRY-AREA 2 
     223        COLD-MICRO-CODE-ENTRY-NAME-AREA 2 
     224        COLD-MICRO-CODE-ENTRY-ARGS-INFO-AREA 2 
     225        COLD-MICRO-CODE-ENTRY-MAX-PDL-USAGE 2 
    226226        COLD-MICRO-CODE-EXIT-AREA 0 
    227227    )) 
  • trunk/lisp/lcadr/diags.lisp

    r203 r204  
    4141        CC-TEST-PP-DP CC-TEST-PI-DP CC-TEST-PDL-DP CC-TEST-Q-DP CC-TEST-C-MEM-DP 
    4242        CC-TEST-LC-DP CC-TEST-A-PASS-DP CC-TEST-M-PASS-DP 
     43        CC-TEST-ALU-SHIFT-LEFT-DP CC-TEST-ALU-SHIFT-RIGHT-DP 
    4344        CC-TEST-UNIBUS-MAP-DP CC-TEST-BUSINT-BUFFERS-DP)) 
    4445(SETQ ALL-MEMORIES 
     
    219220(DEFUN CC-TEST-M-PASS-DP () 
    220221  (CC-TEST-DATA-PATH "->L->MPASS->MF->M->ALU" '(CC-M-PASS-HANDLER) 32.)) 
     222 
     223(DEFUN CC-TEST-ALU-SHIFT-LEFT-DP () 
     224  (CC-TEST-DATA-PATH "MD,Q(31) -> ALU-SHIFT-LEFT-1" '(CC-ALU-SHIFT-LEFT-HANDLER) 32.)) 
     225 
     226(DEFUN CC-TEST-ALU-SHIFT-RIGHT-DP () 
     227  (CC-TEST-DATA-PATH "MD -> M+M -> ALU-SHIFT-RIGHT-1" '(CC-ALU-SHIFT-RIGHT-HANDLER) 32.)) 
    221228 
    222229(DEFUN CC-TEST-UNIBUS-MAP-DP () 
     
    271278               (FORMAT T "~%M-PASS WROTE ~S READ ~S" DATA ACTUAL))) 
    272279        ACTUAL)) 
     280    (OTHERWISE (FERROR NIL "UNKNOWN OP")))) 
     281 
     282(DEFUN CC-ALU-SHIFT-LEFT-HANDLER (OP DATA) 
     283  (SELECTQ OP 
     284    (WRITE-READ 
     285     (CC-WRITE-Q (ASH (LOGAND DATA 1) 31.))     ;low bit to high bit of Q 
     286     (CC-WRITE-MD (ASH DATA -1)) 
     287     (CC-EXECUTE                                ;NOTE NO WRITE, JUST PUT IT IN IR 
     288       CONS-IR-M-SRC CONS-M-SRC-MD 
     289       CONS-IR-ALUF CONS-ALU-SETM  
     290       CONS-IR-OB CONS-OB-ALU-LEFT-1) 
     291     (LET ((ACTUAL (CC-READ-OBUS))) 
     292       (COND ((AND CC-DIAG-TRACE (NOT (= ACTUAL DATA))) 
     293              (FORMAT T "~%ALU-LEFT WROTE ~S READ ~S" DATA ACTUAL))) 
     294       ACTUAL)) 
     295    (OTHERWISE (FERROR NIL "UNKNOWN OP")))) 
     296 
     297(DEFUN CC-ALU-SHIFT-RIGHT-HANDLER (OP DATA) 
     298  (SELECTQ OP 
     299    (WRITE-READ 
     300     (CC-WRITE-MD DATA) 
     301     (CC-EXECUTE 
     302       CONS-IR-M-SRC CONS-M-SRC-MD 
     303       CONS-IR-ALUF CONS-ALU-M+M 
     304       CONS-IR-OB CONS-OB-ALU-RIGHT-1) 
     305     (LET ((ACTUAL (CC-READ-OBUS))) 
     306       (COND ((AND CC-DIAG-TRACE (NOT (= ACTUAL DATA))) 
     307              (FORMAT T "~%ALU-RIGHT WROTE ~S READ ~S" DATA ACTUAL))) 
     308       ACTUAL)) 
    273309    (OTHERWISE (FERROR NIL "UNKNOWN OP")))) 
    274310 
  • 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  
    190190  CONS-IR-ALUF 0207  ;INCLUDING CARRY 
    191191    CONS-ALU-SETZ 0_1 
     192    CONS-ALU-AND 1_1 
     193    CONS-ALU-SETM 3_1 
     194    CONS-ALU-SETA 5_1 
     195    CONS-ALU-XOR 6_1 
     196    CONS-ALU-IOR 7_1 
    192197    CONS-ALU-SETO 17_1 
    193     CONS-ALU-SETA 5_1 
    194     CONS-ALU-SETM 3_1 
    195198    CONS-ALU-SUB 55           ;includes ALU-CARRY-IN-ONE 
    196199    CONS-ALU-ADD 31_1 
     
    198201    CONS-ALU-M+M+1 77 
    199202    CONS-ALU-M+1 71 
     203    CONS-ALU-MSTEP 100 
     204    CONS-ALU-DSTEP 102 
     205    CONS-ALU-RSTEP 112 
     206    CONS-ALU-DFSTEP 122 
    200207  CONS-IR-Q 0002 
    201208    CONS-Q-LEFT 1 
  • trunk/lisp/lcadr/lcadrd.lisp

    r203 r204  
    13251325(DEFUN CC-SHOW-MODE (ARG) 
    13261326  (AND CC-LOW-LEVEL-FLAG (PRIN1-THEN-SPACE 'LOW-LEVEL-MODE)) 
    1327   (CC-TYPE-OUT (OR ARG CC-MODE-REG) CC-MODE-REG-DESC NIL)) 
     1327  (CC-TYPE-OUT (OR ARG CC-MODE-REG) CC-MODE-REG-DESC NIL T)) 
    13281328 
    13291329(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 
     
    98101     ,ITEM)) 
    99102 
     103 
     104;Really wants to be a bignum LSH.  On LISPM, LSH doesnt win for bignums, ASH does. 
     105; In MACLISP, LSH wins sufficiently. 
     106(DEFMACRO CC-SHIFT (QUAN AMT) 
     107  `(#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;;; Higher-level operations 
  • trunk/lisp/lcadr/packed.lisp

    r203 r204  
    379379(IF-FOR-LISPM 
    380380(DEFUN DISPLAY-LABEL (LINE) 
    381   (TV-CLEAR-SCREEN) 
    382   (CURSORPOS 0 0) 
     381  (FUNCALL TERMINAL-IO ':CLEAR-SCREEN) 
    383382  (FORMAT T "Pack name = ~A.   Check word = ~A.    Version Number = ~D.~%" 
    384383          (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  
    361361        ((INTERRUPT-CONTROL) DPB M-ONES         ;CLEAR RESET, SET HALFWORD-MODE, 
    362362                (BYTE-FIELD 1 27.) A-ZERO)      ;AND ENABLE INTERRUPTS 
    363         ((M-A) DPB M-ONES (BYTE-FIELD 1 22.) A-ZERO)    ;DELAY FOR 1.5 SECONDS FOR MARKSMAN 
    364 RSTDLY  (JUMP-NOT-EQUAL-XCT-NEXT M-A A-ZERO RSTDLY) 
    365        ((M-A) SUB M-A A-1) 
    366363 
    367364;;; Set up the map.  First, write a 0 into the first location of the level 
     
    422419;;; memory on disk.  Block 1 is allocated to us for this purpose. 
    423420SAVE-A-PAGE 
     421        ((M-A) DPB M-ONES (BYTE-FIELD 1 18.) A-ZERO)    ;Delay for 0.1 second in case 
     422SAPDLY  (JUMP-NOT-EQUAL-XCT-NEXT M-A A-ZERO SAPDLY)     ; something random is happening 
     423       ((M-A) SUB M-A A-1) 
    424424        ((M-TEMP-1) A-1) 
    425425        (CALL-XCT-NEXT DISK-WRITE) 
    426426       ((M-A) SETZ) 
     427        ((M-TEMP-1) A-1)                                ;Now do a read-compare 
     428        (CALL-XCT-NEXT DISK-OP-LOW) 
     429       ((M-TEMP-2) DPB M-ONES (BYTE-FIELD 1 3) A-ZERO)  ;OP 10 = read-compare 
     430        ((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR) 
     431        (JUMP-NOT-EQUAL M-TEMP-1 A-ZERO SAVE-A-PAGE)    ;Got an error on readback, retry 
     432        (JUMP-IF-BIT-SET (BYTE-FIELD 1 22.) READ-MEMORY-DATA SAVE-A-PAGE)       ;R/C failed 
    427433 
    428434;;; Read the label (block 0) into physical memory page 0, get disk 
     
    674680 
    675681DISK-OP 
     682        (CALL DISK-OP-LOW) 
     683        ((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR) 
     684        (JUMP-NOT-EQUAL M-TEMP-1 A-ZERO ERROR-DISK-ERROR) 
     685        (POPJ) 
     686 
     687DISK-OP-LOW 
    676688        ;; Wait for the disk controller to be ready. 
    677689        ((VMA-START-READ) A-DISK-REGS) 
     
    718730        (JUMP-IF-BIT-CLEAR (BYTE-FIELD 1 0) READ-MEMORY-DATA DISK-WAIT) 
    719731    (ERROR-TABLE AWAIT-DISK-DONE)               ;Hangs near here while waiting for disk 
    720         ((M-TEMP-1) AND READ-MEMORY-DATA A-DISK-ERROR) 
    721         (JUMP-NOT-EQUAL M-TEMP-1 A-ZERO ERROR-DISK-ERROR) 
    722732        (POPJ) 
    723733 
  • 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.