(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "27-Apr-94 15:43:27" {DSK}<king>export>lispcore>sources>RENAMEMACROS.;2
)


(* ; "
Copyright (c) 1982, 1985, 1986, 1990, 1994 by Venue & Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT RENAMEMACROSCOMS)

(RPAQQ RENAMEMACROSCOMS
 
       (
        (* ;; "MACROS FOR CODE THAT NEEDS TO CHANGE WHEN YOU RUN IT RENAMED.")


        [COMS                                                (* ; 

                                        "Things that change when we're renaming for RDSYS/TELERAID")

              (ADDVARS (RD.SUBFNS (UNLESSRDSYS . 2ND)
                              (\GETBITS . RNGETBITS)
                              (\PUTBITS . RNPUTBITS]
        [COMS                                                (* ; 

                           "Things that change when we're making I-NEW, for building a new loadup.")

              (ADDVARS (MKI.SUBFNS (UNLESSINEW . 2ND)
                              (\GETBITS . RNGETBITS)
                              (\PUTBITS . RNPUTBITS]
        
        (* ;; "Force these macros to be expanded while renaming:")


        (ADDVARS (EXPANDMACROFNS 1ST 2ND UNLESSRDSYS UNLESSINEW RNGETBITS RNPUTBITS \TESTBITS)
               (EXPANDMACROFNS ADDBASE GETBASE GETBASEBYTE GETBASEPTR HILOC LOLOC PUTBASE PUTBASEBYTE
                      PUTBASEPTR REPLACEPTRFIELD VAG2 PAGEBASE PAGELOC))
        
        (* ;; "MACROS TO CONTROL EFFECTS:")


        
        (* ;; "(UNLESSRDSYS normal rdsys) expands to one form or the other, depending on whether you're making a RDSYS.")


        
        (* ;; "(UNLESSINEW normal inew) expandes to one form or the other, depending on whether you're makeing an I-NEW.")


        
        (* ;; "(1ST ...) expands to its first argument")


        
        (* ;; "(2ND ...) expands to its second argument.  These are used in epxanding UNLESS...")


        (EXPORT (MACROS UNLESSRDSYS UNLESSINEW 1ST 2ND LOCAL ALLOCAL)
               (MACROS ADDBASE GETBASE GETBASEBYTE GETBASEPTR HILOC LOLOC PUTBASE PUTBASEBYTE 
                      PUTBASEPTR REPLACEPTRFIELD VAG2 PAGEBASE PAGELOC))
        (MACROS RNPUTBITS RNGETBITS)))



(* ;; "MACROS FOR CODE THAT NEEDS TO CHANGE WHEN YOU RUN IT RENAMED.")





(* ; "Things that change when we're renaming for RDSYS/TELERAID")



(ADDTOVAR RD.SUBFNS
 (UNLESSRDSYS . 2ND)
                        (\GETBITS . RNGETBITS)
                        (\PUTBITS . RNPUTBITS))



(* ; "Things that change when we're making I-NEW, for building a new loadup.")



(ADDTOVAR MKI.SUBFNS
 (UNLESSINEW . 2ND)
                         (\GETBITS . RNGETBITS)
                         (\PUTBITS . RNPUTBITS))



(* ;; "Force these macros to be expanded while renaming:")



(ADDTOVAR EXPANDMACROFNS
 1ST 2ND UNLESSRDSYS UNLESSINEW RNGETBITS RNPUTBITS \TESTBITS)

(ADDTOVAR EXPANDMACROFNS
 ADDBASE GETBASE GETBASEBYTE GETBASEPTR HILOC LOLOC PUTBASE PUTBASEBYTE 
                                   PUTBASEPTR REPLACEPTRFIELD VAG2 PAGEBASE PAGELOC)



(* ;; "MACROS TO CONTROL EFFECTS:")





(* ;; 
"(UNLESSRDSYS normal rdsys) expands to one form or the other, depending on whether you're making a RDSYS."
)





(* ;; 
"(UNLESSINEW normal inew) expandes to one form or the other, depending on whether you're makeing an I-NEW."
)





(* ;; "(1ST ...) expands to its first argument")





(* ;; "(2ND ...) expands to its second argument.  These are used in epxanding UNLESS...")


(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE 

(PUTPROPS UNLESSRDSYS MACRO ((NORMAL RDSYS)
                             NORMAL))

(PUTPROPS UNLESSINEW MACRO ((NORMAL I-NEW)
                            NORMAL))

(PUTPROPS 1ST MACRO ((A . B)
                     A))

(PUTPROPS 2ND MACRO ((A B . C)
                     B))

(PUTPROPS LOCAL MACRO ((X)
                       X))

(PUTPROPS ALLOCAL MACRO ((X)
                         X))
)
(DECLARE%: EVAL@COMPILE 

(PUTPROPS ADDBASE DMACRO (= . \ADDBASE))

(PUTPROPS GETBASE DMACRO (= . \GETBASE))

(PUTPROPS GETBASEBYTE DMACRO (= . \GETBASEBYTE))

(PUTPROPS GETBASEPTR DMACRO (= . \GETBASEPTR))

(PUTPROPS HILOC DMACRO (= . \HILOC))

(PUTPROPS LOLOC DMACRO (= . \LOLOC))

(PUTPROPS PUTBASE DMACRO (= . \PUTBASE))

(PUTPROPS PUTBASEBYTE DMACRO (= . \PUTBASEBYTE))

(PUTPROPS PUTBASEPTR DMACRO (= . \PUTBASEPTR))

(PUTPROPS REPLACEPTRFIELD DMACRO (= . \RPLPTR))

(PUTPROPS VAG2 DMACRO (= . \VAG2))

(PUTPROPS PAGEBASE MACRO ((PTR)
                          (fetch
 (POINTER PAGEBASE) of
 PTR)))

[PUTPROPS PAGELOC MACRO (OPENLAMBDA (PTR)
                               (IPLUS (LLSH (\HILOC PTR)
                                            8)
                                      (LRSH (\LOLOC PTR)
                                            8]
)

(* "END EXPORTED DEFINITIONS")

(DECLARE%: EVAL@COMPILE 

[PUTPROPS RNPUTBITS MACRO (X ([LAMBDA (DATUM OFFSET FD NEWVALUE)
                                (PROG ((MASK (BitFieldMask FD))
                                       (SHIFT (BitFieldShift FD))
                                       (FIRST
 (BitFieldFirst FD)))
                                      (OR (EQ FIRST 0)
                                          (SETQ NEWVALUE (LIST 'LOGAND NEWVALUE MASK)))
                                      (OR (EQ SHIFT 0)
                                          (SETQ NEWVALUE (LIST 'LLSH NEWVALUE SHIFT)))
                                      [COND
                                         ((AND (EQ FIRST 0)
                                               (EQ SHIFT 0))
                                          (SETQ NEWVALUE (LIST '\PUTBASE DATUM OFFSET NEWVALUE)))
                                         (T (SETQ NEWVALUE (LIST 'LOGOR
                                                                 (LIST 'LOGAND (LIST '\GETBASE
                                                                                     '$$PUTBITS 
                                                                                     OFFSET)
                                                                       (LOGXOR 65535 (LLSH MASK SHIFT
                                                                                           )))
                                                                 NEWVALUE))
                                            (SETQ NEWVALUE (LIST (LIST 'OPENLAMBDA '($$PUTBITS)
                                                                       (LIST '\PUTBASE '$$PUTBITS 
                                                                             OFFSET NEWVALUE))
                                                                 DATUM]
                                      [COND
                                         ((NOT EFF)
                                          (OR (EQ SHIFT 0)
                                              (SETQ NEWVALUE (LIST 'LRSH NEWVALUE SHIFT)))
                                          (OR (EQ FIRST 0)
                                              (SETQ NEWVALUE (LIST 'LOGAND NEWVALUE MASK]
                                      (RETURN NEWVALUE]
                              (CAR X)
                              (CADR X)
                              (CADDR X)
                              (CADDDR X]

[PUTPROPS RNGETBITS MACRO (X ([LAMBDA (FORM OFFSET FD)
                                (COND
                                   ((NOT (FIXP FD))
                                    'IGNOREMACRO)
                                   (T (SETQ FORM (LIST '\GETBASE FORM OFFSET))
                                      [OR (EQ (BitFieldShift FD)
                                              0)
                                          (SETQ FORM (LIST 'LRSH FORM (BitFieldShift FD]
                                      [OR (EQ (BitFieldFirst FD)
                                              0)
                                          (SETQ FORM (LIST 'LOGAND FORM (BitFieldMask FD]
                                      FORM]
                              (CAR X)
                              (CADR X)
                              (CADDR X]
)
(PUTPROPS RENAMEMACROS COPYRIGHT ("Venue & Xerox Corporation" 1982 1985 1986 1990 1994))
STOP