(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "15-May-87 17:56:33" {PHYLUM}<CTAMARIN>EMULATOR>SIMSUPPORT.;2 53244  

      previous date%: "20-Oct-86 09:46:40" {PHYLUM}<CTAMARIN>EMULATOR>SIMSUPPORT.;1)


(* "
Copyright (c) 1986, 1987 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT SIMSUPPORTCOMS)

(RPAQQ SIMSUPPORTCOMS 
       [(* * Printout Functions)
        (FNS printnode)
        (FNS printtransvalue printgatenodes printsourcenodes printdevice fc)
        (FNS reducetran reducenors removenots findground finddevice finddeviceoutput finddevicegate 
             findgate findoutput findgateoutput name&val checktran compprint seem)
        (* * Service Functions)
        (FNS concatsimfiles putsimfile fixfile findend findunconns optest romtest findcx ctltest 
             misctest run listnodes findname)
        (* * Other Print Functions)
        (FNS CollectNet CollectSourceNet FindConnectedNodes GetDrainNodes GetGateNodes GetSourceNodes 
             GetSourceTrans GetSourceTransNode PrintChain PrintGate PrintOutList Print01List 
             PrintSourceNet PrintSourceNetTr pg pn printnode1 printnode2 psNode psTran PrintLst)
        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
                                                                             (NLAML pg)
                                                                             (LAMA])
(* * Printout Functions)

(DEFINEQ

(printnode
  [LAMBDA (n)                                                (* rtk "27-Jun-86 10:54")
    (PRINTOUT T (fetch (node name) of n)
           ": "
           (fetch (node npot) of n)
           T])
)
(DEFINEQ

(printtransvalue
  [LAMBDA (nnode)                                            (* rtk "17-Jul-86 11:48")
    (SETQ nnode (findnode nnode))
    (PRINTOUT T "Node: " (fetch (node name) of nnode)
           (if (fetch (node pullup) of nnode)
               then " Pullup "
             else "")
           (if (fetch (node pulldown) of nnode)
               then " Pulldown "
             else "")
           T)
    (PROG (tran (drains NIL)
                (gates NIL))
          (for tran in (fetch (node nsource) of nnode)
             do tran (PRINTOUT T (gatetbl (fetch (trans type) of tran)
                                        (fetch (node npot) of (fetch (trans gate) of tran)))
                            " Node: "
                            (fetch (node name) of (fetch (trans drain) of tran))
                            " = "
                            (fetch (node npot) of (fetch (trans drain) of tran))
                            " Gate: "
                            (fetch (node name) of (fetch (trans gate) of tran))
                            " = "
                            (fetch (node npot) of (fetch (trans gate) of tran))
                            T))
          (for tran in (fetch (node ndrain) of nnode)
             do (PRINTOUT T (gatetbl (fetch (trans type) of tran)
                                   (fetch (node npot) of (fetch (trans gate) of tran)))
                       " Node: "
                       (fetch (node name) of (fetch (trans source) of tran))
                       " = "
                       (fetch (node npot) of (fetch (trans source) of tran))
                       " Gate: "
                       (fetch (node name) of (fetch (trans gate) of tran))
                       " = "
                       (fetch (node npot) of (fetch (trans gate) of tran))
                       T])

(printgatenodes
  [LAMBDA (nnode)                                            (* rtk "17-Jul-86 11:49")
    (SETQ nnode (findnode nnode))
    (PROG (tran (drains NIL)
                (gates NIL))
          (for tran in (fetch (node ngate) of nnode) do (SETQ drains
                                                         (CONS (fetch (node name)
                                                                  of (fetch (trans drain)
                                                                        of tran))
                                                               drains))
                                                        (SETQ drains
                                                         (CONS (fetch (node name)
                                                                  of (fetch (trans source)
                                                                        of tran))
                                                               drains)))
          (RETURN (LIST (CONS 'drains%: (SORT (INTERSECTION drains drains])

(printsourcenodes
  [LAMBDA (nnode)                                            (* rtk "17-Jul-86 11:50")
    (SETQ nnode (findnode nnode))
    (PROG (tran (drains NIL)
                (gates NIL))
          (for tran in (fetch (node nsource) of nnode)
             do (SETQ drains (CONS (fetch (node name) of (fetch (trans drain) of tran))
                                   drains))
                (SETQ gates (CONS (fetch (node name) of (fetch (trans gate) of tran))
                                  gates)))
          (for tran in (fetch (node ndrain) of nnode)
             do (SETQ drains (CONS (fetch (node name) of (fetch (trans source) of tran))
                                   drains))
                (SETQ gates (CONS (fetch (node name) of (fetch (trans gate) of tran))
                                  gates)))
          (RETURN (LIST (CONS 'drains%: (SORT (INTERSECTION drains drains)))
                        (CONS 'gates%: (SORT (INTERSECTION gates gates])

(printdevice
  [LAMBDA (n decend)                                         (* rtk "25-Jul-86 17:21")
    (SETQ lastdevice (finddevice n decend))
    (PRINTDEF lastdevice)
    (PRINTOUT T T])

(fc
  [LAMBDA (n)                                                (* edited%: " 2-Sep-86 18:04")
    (SETQ n (findnode n))
    (PROG (x)
          (PRINTOUT T "< ------------ " (name&val n)
                 "  cap: "
                 (fetch (node ncap) of n)
                 " ------------->" T)                        (* SETQ x (finddevice n NIL T))
                                                             (* if (NOT deviceerror) then
                                                             (PRINTOUT T x T))
          (for tran in (fetch (node nsource) of n) do (checktran n tran ON))
          (for tran in (fetch (node ndrain) of n) do (checktran n tran ON))
          (for tran in (fetch (node nsource) of n) do (checktran n tran OFF))
          (for tran in (fetch (node ndrain) of n) do (checktran n tran OFF))
          (PRINTOUT T "<-------------------GATES-------------------->" T)
          (for tran in (fetch (node ngate) of n) do (checktran n tran])
)
(DEFINEQ

(reducetran
  [LAMBDA (tran n val connnode)                              (* rtk "11-Aug-86 20:42")
    (PROG (x gnode)
          [SETQ x (COND
                     [(LISTP val)
                      (SELECTQ (CAR val)
                          (TRAN (APPEND (LIST 'NAND (name&val (fetch (trans gate) of tran)))
                                       (CDR val)))
                          (PASS (APPEND (LIST 'NAND (name&val (fetch (trans gate) of tran)))
                                       (CADR val)))
                          (NAND (APPEND (LIST 'NAND (name&val (fetch (trans gate) of tran)))
                                       (CDR val)))
                          (PROG NIL
                                (if (NOT infind)
                                    then (PRINTOUT T "Error at " (name&val (fetch (trans gate)
                                                                              of tran))
                                                " : " val))
                                (SETQ deviceerror T)
                                (RETURN NIL]
                     [(OR (EQ val 'GND)
                          (EQ connnode GNDNode))
                      (CONS (if (fetch (node pullup) of n)
                                then 'NOT
                              else 'TRAN)
                            (if (SETQ x (name&val n T))
                                then [CONS x (LIST (name&val (fetch (trans gate) of tran]
                              else (LIST (name&val (fetch (trans gate) of tran]
                     (T (if (AND tran n val)
                            then (LIST 'PASS (if passtran
                                                 then (LIST (name&val (fetch (trans gate)
                                                                         of tran))
                                                            (name&val connnode))
                                               else (LIST (name&val (fetch (trans gate) of tran))
                                                          (name&val connnode)
                                                          val]
          (if x
              then (SETQ norlist (CONS x norlist])

(reducenors
  [LAMBDA (nors n)                                           (* rtk " 5-Aug-86 11:07")
    (if (AND nors (LISTP nors))
        then (if (GREATERP (LENGTH nors)
                        1)
                 then (CONS 'NOR (removenots nors))
               else (CAR nors))
      else nors])

(removenots
  [LAMBDA (lst)                                              (* rtk "28-Jul-86 19:03")
    (for i in lst collect (if (LISTP i)
                              then (SELECTQ (CAR i)
                                       (NAND (CONS 'AND (CDR i)))
                                       (NOT (CADR i))
                                       (NOR (CONS 'OR (CDR i)))
                                       i)
                            else i])

(findground
  [LAMBDA (n)                                                (* rtk " 6-Aug-86 18:25")
    (if (GREATERP decend tlevel)
        then (PROG (outnode tran norlist (activelist walklist)
                          (savelevel tlevel))
                   (if (FMEMB n (LIST VDDNode GNDNode))
                       then (RETURN (fetch (node name) of n)))
                   (if (FMEMB n walklist)
                       then (RETURN NIL))
                   (SETQ tlevel (ADD1 tlevel))
                   (SETQ walklist (CONS n walklist))
                   (for tran in (fetch (node ndrain) of n)
                      do (reducetran tran n (if (AND passtran (fetch (node pullup)
                                                                 of (fetch (trans source)
                                                                       of tran)))
                                                then (fetch (node name) of (fetch (trans source)
                                                                              of tran))
                                              else (findground (fetch (trans source) of tran)))
                                (fetch (trans source) of tran)))
                   (for tran in (fetch (node nsource) of n)
                      do (reducetran tran n (if (AND passtran (fetch (node pullup)
                                                                 of (fetch (trans drain) of tran)))
                                                then (fetch (node name) of (fetch (trans drain)
                                                                              of tran))
                                              else (findground (fetch (trans drain) of tran)))
                                (fetch (trans drain) of tran)))
                   (SETQ tlevel savelevel)
                   (SETQ walklist activelist)
                   (RETURN (reducenors norlist n)))
      else '&&&])

(finddevice
  [LAMBDA (n decend infind)                                  (* edited%: "27-Aug-86 15:06")
    (SETQ deviceerror NIL)
    (if (NOT decend)
        then (SETQ decend 5))
    (SETQ n (findnode n))
    (PROG (outnode walklist result tlevel)
          (SETQ tlevel 0)
          [SETQ outnode (OR (if (OR (fetch (node pullup) of n)
                                    (fetch (node ngate) of n))
                                then n
                              else NIL)
                            (AND NIL (OR (findoutput n)
                                         (findgate n]
          [if outnode
              then (SETQ passtran (NOT (fetch (node pullup) of outnode)))
                   (SETQ result (LIST (LIST (name&val outnode))
                                      (findground outnode]
          (RETURN result])

(finddeviceoutput
  [LAMBDA (n)                                                (* rtk "17-Jul-86 11:54")
    (SETQ n (findnode n))
    (PROG (tran (node (findnode n)))
          (SETQ foundnode (fetch (node pullup) of n))
          (if foundnode
              then (RETURN (SETQ outputnode n)))
          (if (FMEMB n tracednodes)
              then (RETURN NIL))
          (SETQ tracednodes (CONS n tracednodes))
          (for tran in (fetch (node ndrain) of n) while (NOT foundnode)
             do (finddeviceoutput (fetch (trans source) of tran)))
          (for tran in (fetch (node nsource) of n) while (NOT foundnode)
             do (finddeviceoutput (fetch (trans drain) of tran)))
          (RETURN outputnode])

(finddevicegate
  [LAMBDA (n)                                                (* rtk "17-Jul-86 11:55")
    (SETQ n (findnode n))
    (PROG (tran (node (findnode n)))
          (SETQ foundnode (OR (fetch (node pullup) of n)
                              (fetch (node ngate) of n)))
          (if foundnode
              then (RETURN (SETQ outputnode n)))
          (if (FMEMB n tracednodes)
              then (RETURN NIL))
          (SETQ tracednodes (CONS n tracednodes))
          (for tran in (fetch (node ndrain) of n) while (NOT foundnode)
             do (finddevicegate (fetch (trans source) of tran)))
          (for tran in (fetch (node nsource) of n) while (NOT foundnode)
             do (finddevicegate (fetch (trans drain) of tran)))
          (RETURN outputnode])

(findgate
  [LAMBDA (n)                                                (* rtk " 8-Jul-86 16:38")
    (PROG (foundnode outputnode tracednodes)
          (SETQ foundnode NIL)
          (SETQ outputnode NIL)
          (SETQ tracednodes '(VDD GND PHIOP PHIMICRO))
          (RETURN (finddevicegate n])

(findoutput
  [LAMBDA (n)                                                (* rtk " 7-Jul-86 17:44")
    (PROG (foundnode outputnode tracednodes)
          (SETQ foundnode NIL)
          (SETQ outputnode NIL)
          (SETQ tracednodes '(VDD GND PHIOP PHIMICRO))
          (RETURN (finddeviceoutput n])

(findgateoutput
  [LAMBDA (n)                                                (* rtk "17-Jul-86 11:56")
    (SETQ n (findnode n))
    (PROG (tran (node (findnode n)))
          (SETQ foundnode (fetch (node pullup) of n))
          (if (FMEMB n tracednodes)
              then (RETURN NIL))
          (SETQ tracednodes (CONS n tracednodes))
          (for tran in (fetch (node ndrain) of n) while (NOT foundnode)
             do (FindGateOutput (fetch (trans source) of tran)))
          (for tran in (fetch (node nsource) of n) while (NOT foundnode)
             do (FindGateOutput (fetch (trans drain) of tran)))
          (RETURN outputnode])

(name&val
  [LAMBDA (n tempval)                                        (* rtk "17-Oct-86 17:59")
    (if (OR (NOT tempval)
            includetemps)
        then (PROG [(nls (LIST (fetch (node name) of n]
                   [if (fetch (node pullup) of n)
                       then (SETQ nls (APPEND nls (COPY '(↑]
                   [if (fetch (node pulldown) of n)
                       then (SETQ nls (APPEND nls (COPY '(!]
                   [if (fetch (node input) of n)
                       then (SETQ nls (APPEND nls (COPY '(←]
                   (RETURN (PACK (APPEND nls (LIST '= (ELT pottoatom (fetch (node npot) of n])

(checktran
  [LAMBDA (n tran gateon?)                                   (* edited%: " 2-Sep-86 12:28")
    (if [OR (EQ n (fetch (trans gate) of tran))
            (OR (EQ (gatetbl nchannel (fetch (node npot) of (fetch (trans gate) of tran)))
                    gateon?)
                (AND (NEQ (gatetbl nchannel (fetch (node npot) of (fetch (trans gate) of tran)))
                          ON)
                     (EQ gateon? OFF]
        then (COND
                ((EQ n (fetch (trans gate) of tran))
                 (PRINTOUT T "Source: " (name&val (fetch (trans source) of tran))
                        .TAB 20 " Drain: " (name&val (fetch (trans drain) of tran))
                        T))
                ((EQ n (fetch (trans source) of tran))
                 (PRINTOUT T "Gate: " (name&val (fetch (trans gate) of tran))
                        .TAB 20 " Drain: " (name&val (fetch (trans drain) of tran))
                        T))
                ((EQ n (fetch (trans drain) of tran))
                 (PRINTOUT T "Gate: " (name&val (fetch (trans gate) of tran))
                        .TAB 20 " Source: " (name&val (fetch (trans source) of tran))
                        T])

(compprint
  [LAMBDA (n)                                                (* edited%: "15-Sep-86 13:53")
    (PROG (compsectionlist noerrors errortracefile iolist complist (cbs (FASSOC (fetch (node name)
                                                                                   of n)
                                                                               nodemapnames)))
          (SETQ compsectionlist (LIST (CADR cbs)))
          (SETQ CompList (APPEND CompList (CompOneNode n (CADR cbs)
                                                 (if (LISTP (CADDR cbs))
                                                     then (IF (LISTP (CAADDR cbs))
                                                              THEN (CAR (CAADDR cbs))
                                                            ELSE (CAADDR cbs))
                                                   else (CADDR cbs))
                                                 (if (LISTP (CADDR cbs))
                                                     then (ConcatBits (LIST 'QUOTE (CADDR cbs)))
                                                   else (LIST 'EvalElt (CADDR cbs])

(seem
  [LAMBDA NIL                                                (* agb%: " 4-Jul-86 12:40")
    (SetTransSim)
    (steps)
    (PrintOutList muxlist])
)
(* * Service Functions)

(DEFINEQ

(concatsimfiles
  [LAMBDA (infilenames outfilename)                          (* edited%: "26-Aug-86 12:36")
    (PROG (outfile (nodecount 0))
          (SETQ outfile (OPENSTREAM outfilename 'OUTPUT))
          (for i in infilenames do (SETQ nodecount (putsimfile i outfile nodecount)))
          (CLOSEF outfile])

(putsimfile
  [LAMBDA (infilename outfile offset)                        (* edited%: "12-Sep-86 10:16")
    (PRINTOUT T "Concat of file: " infilename T)
    (PROG (ch1 ch2 file end symb Args inputlist (maxnode 0))
          (CLOSEF? infilename)
          (SETQ file (OPENSTREAM infilename 'INPUT))
          (SETQ end (DIFFERENCE (GETEOFPTR file)
                           4))
          (SETQ errorlist NIL)
          (SETQ Args (LIST (RATOM file)
                           (RATOM file)
                           (RATOM file)))
          (if (EQ 0 offset)
              then (for i in Args do (PRIN1 i outfile)
                                     (PRIN1 " " outfile))
                   (TERPRI outfile))
          (PRINTOUT outfile "NEXTFILE " infilename T)
          (SETQ ch1 (BIN file))
          (while (AND (NOT (EOFP file))
                      (OR (EQ ch1 32)
                          (EQ ch1 13))) do (SETQ ch1 (BIN file)))
          (until (EOFP file)
             do (for i from 0 to 7 do (while (EQ ch1 32) do (SETQ ch1 (BIN file)))
                                      (if (EQ ch1 (CHARCODE N))
                                          then (SETQ ch2 (BIN file))
                                               (if (OR (GREATERP ch2 57)
                                                       (LESSP ch2 48))
                                                   then (BOUT outfile ch1))
                                               (SETQ ch1 ch2))
                                      (while (AND (NEQ ch1 32)
                                                  (NEQ ch1 13)) do (BOUT outfile ch1)
                                                                   (SETQ ch1 (BIN file)))
                                      (while (AND (NOT (EOFP file))
                                                  (OR (EQ ch1 32)
                                                      (EQ ch1 13))) do (SETQ ch1 (BIN file)))
                                      (if (NEQ i 7)
                                          then (BOUT outfile 32)))
                (BOUT outfile 13))
          (CLOSEF? file])

(fixfile
  [LAMBDA (filename)                                         (* rtk "30-Jul-86 15:47")
    (if (NOT filename)
        then (SETQ filename LastTranSimFile))
    (PROG (file outfile end symb Args i x nodes)
          (CLOSEF? filename)
          (CLOSEF? "NodeFile")
          (SETQ file (OPENSTREAM filename 'INPUT))
          (SETQ outfile (OPENSTREAM "NodeFile" 'OUTPUT))
          (PRINTOUT T "Making nodefile of: " LastTranSimFile T)
          (SETQ LastTranSimFile filename)
          (SETQ end (DIFFERENCE (GETEOFPTR file)
                           4))
          (SETQ LastTranSimFile filename)
          (RATOM file)
          (RATOM file)
          (RATOM file)
          (until (GEQ (GETFILEPTR file)
                      end)
             do (SETQ Args (for i from 1 to (SELECTQ (SETQ symb (RATOM file))
                                                (N 7)
                                                (e 7)
                                                (z 7)
                                                (d 7)
                                                (HELP)) collect (RATOM file)))
                (SELECTQ symb
                    (N (SETQ x (UNPACK (CAR Args)))
                       (if [OR (NEQ (CAR x)
                                    'N)
                               (NOT (FMEMB (CADR x)
                                           '(0 1 2 3 4 5 6 7 8 9]
                           then (SETQ nodes (CONS Args nodes))))
                    (d NIL)
                    (e NIL)
                    (z NIL)
                    (l NIL)
                    (h NIL)
                    (x NIL)
                    (BREAK1 NIL T (Illegal command in file)
                           NIL)))
          (SETQ nodes (SORT nodes T))
          (for i in nodes do (PRINTOUT outfile (CAR (NTH i 1))
                                    %,
                                    (CAR (NTH Args 2))
                                    %,
                                    (CAR (NTH i 3))
                                    %,
                                    (CAR (NTH i 4))
                                    %,
                                    (CAR (NTH i 5))
                                    %,
                                    (CAR (NTH i 6))
                                    %,
                                    (CAR (NTH i 7))
                                    T))
          (CLOSEF? file)
          (CLOSEF? outfile])

(findend
  [LAMBDA (n)                                                (* rtk "10-Jul-86 14:01")
    (PROG ((x n)
           (c 0)
           l)
          (SETQ l (while (AND x (NEQ x 'end)) collect (SETQ c (ADD1 c))
                                                    (SETQ n x)
                                                    (SETQ x (fetch (node elink) of n))
                                                    (fetch (node name) of n)))
          (PRINTOUT T "length " c T)
          (RETURN l])

(findunconns
  [LAMBDA NIL                                                (* rtk "10-Oct-86 15:37")
    (walknet (FUNCTION (LAMBDA (n)
                         (if [AND [NOT (OR (fetch (node input) of n)
                                           (AND (fetch (node ngate) of n)
                                                (OR (fetch (node ndrain) of n)
                                                    (fetch (node nsource) of n)))
                                           (GREATERP (PLUS (LENGTH (fetch (node ndrain) of n))
                                                           (LENGTH (fetch (node nsource) of n)))
                                                  1)
                                           (AND (fetch (node pullup) of n)
                                                (NOT (fetch (node ngate) of n]
                                  (OR (fetch (node ndrain) of n)
                                      (fetch (node nsource) of n)
                                      (fetch (node ngate) of n))
                                  (NOT (OR (fetch (node sectioninput) of n)
                                           (fetch (node sectionoutput) of n]
                             then (PRINTOUT T "Node: " (fetch (node name) of n)
                                         " Not connected" T])

(optest
  [LAMBDA NIL                                                (* rtk "12-Aug-86 19:21")
    [SETQ compsections (COPY '(OpPla-Out]
    [SETQ setsections (COPY '(Rom-Out ClockPla Misc-Out RegMux CCode-Out]
          
          (* * RegMux SNI-Out DataPath-Out CCode-Out)
                                                             (* SETQ plist (COPY (QUOTE
                                                             ((%#STARTADDR) (%#OPLENGTH)
                                                             (CTL.*DORESET %#INTERRUPT %#REFILLRQ 
                                                             %#FRAMESEMPTY %#FRAMESFULL %#$REFCNT 
                                                             %#REFRESH %#$STACKREFILL)
                                                             (%#MODSTARTADDR %#MODSTARTADDR~)))))
    (SETQ *DoReset 1)
    (SETQ pOp 1)
    (SETQ pClock 0)
    (SETQ pMicro 0)
    (SetupTransSim)                                          (* ilist%: (*DoReset %#Interrupt 
                                                             %#RefillRq %#FramesEmpty %#FramesFull 
                                                             %#$RefCnt %#$Refresh %#$StackRefill))
    [PROG [(ilist '(*DoReset %#Interrupt %#RefillRq %#FramesEmpty %#FramesFull %#$RefCnt %#Refresh 
                          %#$StackRefill]
          (for i from 0 to 255
             do (SETQ %#Opcode i)
                (SETQ *DoReset 0)
                (SETQ %#Interrupt 0)
                (SETQ %#RefillRq 0)
                (SETQ %#FramesEmpty 0)
                (SETQ %#FramesFull 0)
                (SETQ %#$RefCnt 0)
                (SETQ %#Refresh 0)
                (SETQ %#$StackRefill 0)
                (for j in ilist do (SET j 0))
                (PRINTOUT T "Loop: " i " #Opcode: " %#Opcode " Rst/Irq/Rfl/FE/FF/RC/Rf/SR " *DoReset 
                       %#Interrupt %#RefillRq %#FramesEmpty %#FramesFull %#$RefCnt %#$Refresh 
                       %#$StackRefill T)
                (SetTransSim)
                (OpPla)
                (clock 'op)                                  (* Print01List plist)
                (CompTransSim)
                (for j in ilist
                   do (for l in ilist do (SET l 0))
                      (SET j 1)
                      (SETQ %#$Refresh %#Refresh)
                      (PRINTOUT T "Loop: " i " #Opcode: " %#Opcode " Rst/Irq/Rfl/FE/FF/RC/Rf/SR " 
                             *DoReset %#Interrupt %#RefillRq %#FramesEmpty %#FramesFull %#$RefCnt 
                             %#Refresh %#$StackRefill T)
                      (SetTransSim)
                      (OpPla)
                      (clock 'op)
                      (Print01List plist)
                      (CompTransSim]
    (SETQ pOp 0])

(romtest
  [LAMBDA NIL                                                (* rtk "22-Jul-86 10:20")
    [SETQ setsections (COPY '(ClockPla Input Misc-Out DataPath-Out RegMux-Out RegMux CCode-Out 
                                    SNI-Out]
    [SETQ compsections (COPY '(Rom-Out]
    [SETQ plist (COPY '((%#UPC)
                        (%#UNEXTINSTA)
                        (%#UNEXTINSTB)
                        (%#UCONDCODE]
    (SETQ *DoReset 1)
    (SETQ pOp 1)
    (for i from 0 to 255 do (SETQ %#Opcode (RAND 0 255))
                            (SETQ %#Opcode i)
                            (SETQ %#Interrupt 0)
                            (SETQ %#RefillRq 0)
                            (SETQ %#FramesEmpty 0)
                            (SETQ %#FramesFull 0)
                            (SETQ %#$RefCnt 0)
                            (SETQ %#$Refresh 0)
                            (SETQ %#$StackRefill 0)
                            (SETQ *Micro 1)
                            (SETQ *Op 0)
                            (SETQ %#SelNextInstA 0)
                            (SETQ %#SelNextInstB 0)
                            (SETQ %#NewOp 1)
                            (SETQ %#uPC i)
                            (SETQ $uPC i)
                            (GetUCode)
                            (SETQ %#MIR $MIR)
                            (PRINTOUT T "Loop: " i " #uPC: " %#uPC T)
                            (SetTransSim)
                            (clock T T T)
                            (PRINTOUT T "#Startaddr: " %#StartAddr " #OpLength: " %#OpLength T)
                            (Print01List plist)
                            (CompTransSim)
                            (SETQ *DoReset 0])

(findcx
  [LAMBDA NIL                                                (* rtk "17-Jul-86 10:41")
    (PROG ((l (for i in netlist
                 when [AND (FMEMB (fetch (node npot) of (CADR i))
                                  '(CLOW CSHARE CX DX DXHIGH DXLOW INIT))
                           (OR (fetch (node ngate) of (CADR i))
                               (fetch (node nsource) of (CADR i))
                               (fetch (node ndrain) of (CADR i] collect i)))
          (if l
              then (BREAK1 NIL T (Cx's)
                          NIL])

(ctltest
  [LAMBDA (testtype)                                         (* edited%: "12-Sep-86 17:11")
    [SETQ setsections (COPY '(Pads-In]
    (SETQ compsections NIL)
    (SETQ ionodes NIL)
    (SETQ plist NIL)
    (SETQ DoTransSim T)
    [if (NOT testtype)
        then (SETQ testtype '(ClockPla RegMux OpPla SNI-Out CCode-Out Misc-Out PadLogic VMM-Out 
                                    Rom-Out DataPath-Out]
    [if (EQ testtype 'Ctl&Rom)
        then (SETQ testtype '(ClockPla RegMux OpPla SNI-Out CCode-Out Misc-Out PadLogic VMM-Out 
                                    Rom-Out]
    [if (EQ testtype 'Ctl)
        then (SETQ testtype '(ClockPla RegMux OpPla SNI-Out CCode-Out Misc-Out PadLogic VMM-Out]
    [if (EQ testtype 'Ctl&DataPath)
        then (SETQ testtype '(ClockPla RegMux OpPla SNI-Out CCode-Out Misc-Out PadLogic VMM-Out 
                                    DataPath-Out]
    [if (EQ testtype 'Ctl&DataPath&Rom)
        then (SETQ testtype '(ClockPla RegMux OpPla SNI-Out CCode-Out Misc-Out PadLogic VMM-Out 
                                    DataPath-Out Rom-Out]
    [if (EQ testtype 'DataPath&RegFile)
        then (SETQ testtype '(DataPath-Out RegFile]
    (if (NOT (LISTP testtype))
        then (SETQ testtype (LIST testtype)))
    (for i in testtype
       do (SELECTQ i
              (DataPath-Out [SETQ compsections (APPEND compsections
                                                      (COPY '(DataPath-Out DataPath-Op DataPathD2Set 
                                                                    Euop-CCodes CondA]
                            [SETQ setsections
                             (APPEND setsections
                                    (COPY '(Pins-In Rom-Out Dswap-In ClockPla Misc-Out RegMux-Out 
                                                  CCode-Out SNI-Out OpPla-Out]
                            [SETQ ionodes (APPEND ionodes (COPY '(DataPathD2Set CondA])
              (RegFile [SETQ compsections (APPEND compsections (COPY '(Dswap-In])
              (Rom-Out (SETQ compsections (CONS 'Rom-Out compsections))
                       [SETQ setsections (APPEND setsections
                                                (COPY '(ClockPla Misc-Out DataPath-Out RegMux-Out 
                                                              CCode-Out SNI-Out])
              (VMM-Out (SETQ compsections (CONS 'VMM-Out compsections))
                       [SETQ setsections (APPEND setsections (COPY '(ClockPla DataPath-Out])
              (PadLogic (SETQ ionodes (APPEND (COPY '(RPads DPads DPads-Out))
                                             ionodes))
                        (SETQ compsections (APPEND (COPY '(PadLogic Pins-In Pads-Out RPads DPads 
                                                                 DPads-Out))
                                                  compsections))
                        [SETQ setsections (APPEND setsections (COPY '(ClockPla VMM-Out])
              (RegMux (SETQ compsections (CONS 'RegMux-Out compsections))
                      [SETQ setsections (APPEND setsections (COPY '(Rom-Out ClockPla DataPath-Out 
                                                                          Misc-Out]
                      [SETQ plist (COPY '((@REGADDR~)
                                          (%#TOS)
                                          (%#ARG)
                                          (%#ARG2])
              (ClockPla (SETQ compsections (CONS 'ClockPla compsections))
                        [SETQ setsections (APPEND setsections
                                                 (COPY '(Pins-In Rom-Out VMM-Out CCode-Out Pads-In 
                                                               Misc-Out])
              (OpPla (SETQ compsections (CONS 'OpPla-Out compsections))
                     [SETQ setsections (APPEND setsections (COPY '(Rom-Out ClockPla RegMux-Out 
                                                                         CCode-Out Misc-Out]
                                                             (* SETQ plist (COPY (QUOTE
                                                             ((%#STARTADDR) (%#OPLENGTH)
                                                             (%#FORCENEWOP) (%#MODSTARTADDR)))))
                     )
              (SNI-Out (SETQ compsections (CONS 'SNI-Out compsections))
                       [SETQ setsections (APPEND setsections
                                                (COPY '(OpPla-Out Rom-Out ClockPla RegMux-Out 
                                                              CCode-Out Misc-Out])
              (CCode-Out (SETQ compsections (CONS 'CCode-Out compsections))
                         [SETQ setsections (APPEND setsections
                                                  (COPY '(OpPla-Out Rom-Out ClockPla RegMux-Out 
                                                                CCode-Out Misc-Out DataPath-Out])
              (MiscPla (SETQ compsections (CONS 'Misc-Pla compsections))
                       [SETQ setsections (APPEND setsections (COPY '(Rom-Out ClockPla])
              (Misc-Out (SETQ compsections (APPEND (COPY '(Misc-Out Misc-Pla))
                                                  compsections))
                        [SETQ setsections (APPEND setsections (COPY '(Rom-Out ClockPla])
              (HELP)))
    (SETQ compsections (INTERSECTION compsections compsections))
    (SETQ setsections (INTERSECTION setsections setsections))
    (SETQ setsections (LDIFFERENCE setsections compsections))
    [if (FMEMB 'DataPath-Out setsections)
        then (SETQ setsections (APPEND setsections (COPY '(DataPath-Op DataPathD2Set CondA 
                                                                 Euop-CCodes DataPath-Set]
    (if (AND (FMEMB 'PadLogic compsections)
             (FMEMB 'DataPath-Out compsections))
        then [SETQ setsections (LDIFFERENCE setsections '(DataPathD2Set]
             [SETQ ionodes (LDIFFERENCE ionodes '(DataPathD2Set]
             (SETQ compsections (CONS 'DataPathD2Set compsections)))
    (SETQ plist NIL)
    (MakeTransCompList])

(misctest
  [LAMBDA NIL                                                (* rtk "12-Aug-86 16:12")
    (StartDrawClocks)
    (SETQ DoTransSim T)
    (SETQ %#MIR (create MI))
    [SETQ compsections (COPY '(Misc-Out Misc-Pla]
    [SETQ setsections (COPY '(Pins-In Rom-Out ClockPla]
    [SETQ plist
     (COPY '((%#UMISC)
             (MISC.MISCLOGIC.FFS.$SETOUTPUTINTERRPUT~ MISC.MISCLOGIC.FFS.$RESETOUTPUTINTERRUPT~ 
                    MISC.MISCLOGIC.FFS.$SETINITIALREFILL~ 
                    MISC.MISCLOGIC.FFS.RSFFIE.@RESETINITIALREFILL~ 
                    MISC.MISCLOGIC.FFS.$SETSTACKREFILL~ MISC.MISCLOGIC.FFS.$RESETSTACKREFILL~ 
                    MISC.MISCLOGIC.FFS.$SETINTERRUPTENABLE~ MISC.MISCLOGIC.FFS.$RESETINTERRUPTENABLE~ 
                    MISC.MISCLOGIC.FFS.$SETMEMLOCK~ MISC.MISCLOGIC.FFS.$RESETMEMLOCK~ 
                    MISC.MISCLOGIC.FFS.$SETREFCNT~ MISC.MISCLOGIC.FFS.$RESETREFCNT~ 
                    MISC.MISCLOGIC.FFS.$RESETREFRESH MISC.MISCLOGIC.FFS.$RESETINTERRUPT 
                    MISC.MISCLOGIC.FFS.$OPLENGTH=0 MISC.MISCLOGIC.FFS.@WRITEOCTALA 
                    MISC.MISCLOGIC.FFS.@RESET-VMMA]
    (SetupTransSim)
    (SETQ Refresh 0)
    (SETQ Interrupt 0)
    (SETQ Hold 0)
    (SETQ setlist '(Reset Interrupt Hold Refresh))
    (for i
       in '(18 18 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 31)
       do (replace (MI Misc) of %#MIR with i)
          (for k in setlist do (for l in setlist do (SET l 0))
                               (SET k 1)
                               (for j from 0 to 1 do (SETQ *Op (LNOT j))
                                                     (SETQ *Micro j)
                                                     (DoMisc)
                                                     (SetSymClocks T)
                                                     (SetClocks 0 0)
                                                     (SetSymClocks)
                                                     (CompTransSim)
                                                     (SetClocks 1 0)
                                                     (PrechargeSync)
                                                     (SetSymClocks T)
                                                     (SetClocks 0 0)
                                                     (SetSymClocks T)
                                                     (SetClocks 0 1)
                                                     (ClockMisc)
                                                     (ClockSync)))
          (SETQ Reset 0])

(run
  [LAMBDA (val)                                              (* rtk " 6-Aug-86 11:54")
    (if val
        then (setinputh 'REFRESH)
      else (setinputl 'REFRESH))
    (clock T NIL T)
    (PrintOutList plist])

(listnodes
  [LAMBDA (sections)                                         (* rtk "19-Aug-86 17:34")
    (if (NOT (LISTP sections))
        then (SETQ sections (LIST sections)))
    (for i in nodemaplist when (FMEMB (CADR i)
                                      sections) collect (fetch (node name) of (CAR i])

(findname
  [LAMBDA (pat)                                              (* edited%: "11-Sep-86 12:17")
    (MAPHASH nethash (FUNCTION (LAMBDA (v k)
                                 (if (STRPOS pat k)
                                     THEN (PRINT k])
)
(* * Other Print Functions)

(DEFINEQ

(CollectNet
  [LAMBDA (nnode path)                                       (* agb%: " 2-Jul-86 14:04")
    (PROG (drains sources pendNodes resNodes)
          (SETQ pendNodes (LIST nnode))
      L1  (if (NOT pendNodes)
              then (RETURN resNodes))
          (SETQ cNode (CAR pendNodes))
          (SETQ pendNodes (CDR pendNodes))
          (SETQ resNodes (CONS cNode resNodes))
          (SETQ drains (GetDrainNodes cNode))
          (SETQ sources (GetSourceNodes cNode))
          (for i in (APPEND sources drains) when (AND (NEQ i VDDNode)
                                                      (NEQ i GNDNode)
                                                      (NOT (MEMB i pendNodes))
                                                      (NOT (MEMB i resNodes)))
             do (SETQ pendNodes (CONS i pendNodes)))
          (GO L1])

(CollectSourceNet
  [LAMBDA (nnode ctran depth)                                (* agb%: " 2-Jul-86 21:57")
    (PROG (lst term tranList)
          (if (NOT depth)
              then (SETQ depth 0))
          (if (IGEQ depth 10)
              then (BREAK1 NIL T))
          (if (EQ nnode GNDNode)
              then (RETURN nnode))
      L1  (SETQ tranList (GetSourceTrans nnode ctran))
          [SETQ lst (for tran in tranList collect (SETQ term (fetch (trans source) of tran))
                                                (if (EQ term nnode)
                                                    then (SETQ term (fetch (trans drain) of tran)))
                                                (LIST tran (CollectSourceNet term tran (ADD1 depth]
          (RETURN (CONS nnode lst])

(FindConnectedNodes
  [LAMBDA (nnode)                                            (* agb%: " 2-Jul-86 20:38")
    (PROG (drains sources pendNodes resNodes cNode pullupn)
          (SETQ pendNodes (LIST nnode))
          (if (EQ nnode GNDNode)
              then (RETURN NIL))
      L1  (if (NOT pendNodes)
              then (SETQ pullupn (for i in resNodes thereis (fetch (node pullup) of i)))
                   (RETURN (CONS pullupn resNodes)))
          (SETQ cNode (CAR pendNodes))
          (SETQ pendNodes (CDR pendNodes))
          (SETQ resNodes (CONS cNode resNodes))
          (SETQ drains (GetDrainNodes cNode))
          (SETQ sources (GetSourceNodes cNode))
          (for i in (APPEND sources drains) when (AND (NEQ i VDDNode)
                                                      (NEQ i GNDNode)
                                                      (NOT (MEMB i pendNodes))
                                                      (NOT (MEMB i resNodes)))
             do (SETQ pendNodes (CONS i pendNodes)))
          (GO L1])

(GetDrainNodes
  [LAMBDA (nnode)                                            (* rtk "17-Jul-86 12:01")
    (PROG (tran drains)
          (RETURN (for i in (fetch (node ndrain) of nnode) collect (fetch (trans source) of i])

(GetGateNodes
  [LAMBDA (nnode)                                            (* rtk "17-Jul-86 11:58")
    (PROG (tran drains)
          (for tran in (fetch (node ngate) of nnode)
             do (SETQ drains (CONS (if (EQ GNDNode (fetch (trans drain) of tran))
                                       then (fetch (trans source) of tran)
                                     else (fetch (trans drain) of tran))
                                   drains)))
          (RETURN drains])

(GetSourceNodes
  [LAMBDA (nnode)                                            (* rtk "17-Jul-86 12:02")
    (PROG (tran drains)
          (RETURN (for i in (fetch (node nsource) of nnode) collect (fetch (trans drain) of i])

(GetSourceTrans
  [LAMBDA (nnode ctran)                                      (* rtk "17-Jul-86 12:06")
    (PROG (tran)
          (SETQ tran (LDIFFERENCE (UNION (fetch (node nsource) of nnode)
                                         (fetch (node ndrain) of nnode))
                            (LIST ctran)))
          (RETURN (LDIFFERENCE tran tran])

(GetSourceTransNode
  [LAMBDA (ntran cnode)                                      (* rtk "17-Jul-86 16:48")
          
          (* * PROG (nnode nodes) (SETQ nnode (fetch
          (trans source) of ntran)) (while nnode do
          (if (NEQ nnode cnode) then (SETQ nodes (CONS nnode nodes)))
          (SETQ tran (fetch (trans slink) of tran)))
          (SETQ nnode (fetch (trans drain) of nnode))
          (while nnode do (if (NEQ tran ctran) then
          (SETQ trans (CONS tran trans))) (SETQ nnode
          (fetch (trans dlink) of nnode))) (RETURN nodes))

    NIL])

(PrintChain
  [LAMBDA (node)                                             (* agb%: " 2-Jul-86 20:43")
    (PROG (gates seenNodes)
          (SETQ gates (LIST (findnode node)))
      L1  (if (NOT gates)
              then (RETURN))
          (if (MEMB (CAR gates)
                    seenNodes)
              then (GO L2))
          (SETQ nodes (FindConnectedNodes (CAR gates)))
          (for i in nodes when i do (PRINTOUT T (fetch (node name) of i)
                                           "  "))
          (TERPRI T)
          [SETQ gates (APPEND gates (GetGateNodes (OR (CAR nodes)
                                                      (CADR nodes]
          (SETQ seenNodes (CONS (CAR gates)
                                seenNodes))
      L2  (SETQ gates (CDR gates))
          (GO L1])

(PrintGate
  [LAMBDA (node prnodeflg)                                   (* agb%: " 3-Jul-86 21:12")
    (if (LISTP node)
        then (for i in node join (PrintGate i))
      else (SETQ nnode (findnode node))
           (SETQ net (CollectSourceNet nnode))
           (SETQ gates (GetGateNodes (CAR net)))
           (PRINT (for i in gates collect (fetch (node name) of i)))
           (PrintSourceNet net 0)
           gates])

(PrintOutList
  [LAMBDA (list nonumbers)                                   (* rtk "15-Oct-86 13:55")
    (for i in list do (SETQ BOLflg T)
                      (walknet (if nonumbers
                                   then 'printnode1
                                 else 'printnode2)
                             i)
                      (TERPRI])

(Print01List
  [LAMBDA (list)                                             (* rtk " 4-Aug-86 15:29")
    (for i in list do (SETQ CompList NIL)
                      (walknet 'compprint i)
                      (PRINTOUT T (CAR i)
                             " = " .TAB 15)
                      [for j in CompList do [if (NEQ (CADR j)
                                                     (CADDR j))
                                                then (PRINTOUT T .FONT '(GACHA 10 BOLD]
                                            (PRINTOUT T (CADR j)
                                                   .FONT
                                                   '(GACHA 10 STANDARD]
                      (PRINTOUT T " " T)
                      (PRINTOUT T .TAB 15)
                      (for j in CompList do (PRINTOUT T (CADDR j)))
                      (PRINTOUT T " " T])

(PrintSourceNet
  [LAMBDA (net indent)                                       (* agb%: " 2-Jul-86 22:10")
    (if (NOT net)
        then (PRINTOUT T " //" T)
      elseif (NLISTP net)
        then (psNode net)
             (PRINTOUT T "/// " T)
      else (psNode (CAR net))
           (PRINTOUT T " ")
           (PrintSourceNetTr (CDR net)
                  indent])

(PrintSourceNetTr
  [LAMBDA (tranList indent)                                  (* agb%: " 2-Jul-86 22:06")
    (if (EQ 1 (LENGTH tranList))
        then (psTran (CAAR tranList))
             (PrintSourceNet (CADAR tranList)
                    (PLUS 2 indent))
      else (TERPRI)
           (TAB indent)
           (for i in tranList do (psTran (CAR i))
                                 (PrintSourceNet (CADR i)
                                        (PLUS 2 indent])

(pg
  [NLAMBDA (n)                                               (* agb%: " 2-Jul-86 22:16")
    (PrintGate n])

(pn
  [LAMBDA NIL                                                (* edited%: " 5-Sep-86 22:49")
    (PRINTOUT T (fetch (node name) of n)
           "  pot: "
           (ELT pottoatom ac)
           T])

(printnode1
  [LAMBDA (n)                                                (* agb%: " 1-Sep-86 18:39")
    (if BOLflg
        then (PRINTOUT T (fetch (node name) of n)
                    ": "))
    (PRINTOUT T (ELT pottoatom (fetch (node npot) of n))
           ", ")
    (SETQ BOLflg NIL])

(printnode2
  [LAMBDA (n)                                                (* agb%: "28-Aug-86 14:53")
    (if BOLflg
        then (PRINTOUT T (fetch (node name) of n)
                    ": "))
    (PRINTOUT T (ELT potto01array (fetch (node npot) of n)))
    (SETQ BOLflg NIL])

(psNode
  [LAMBDA (node)                                             (* agb%: " 3-Jul-86 21:12")
    (if prnodeflg
        then (PRINTOUT T (fetch (node name) of node)
                    "=n="
                    (fetch (node npot) of node])

(psTran
  [LAMBDA (tran)                                             (* agb%: " 2-Jul-86 22:09")
    (PRINTOUT T (fetch (node name) of (fetch (trans gate) of tran))
           "="
           (fetch (node npot) of (fetch (trans gate) of tran))
           "  "])

(PrintLst
  [LAMBDA (plst)                                             (* rtk "14-Oct-86 17:28")
    (for i in plst do (if (LITATOM i)
                          then (if (EVAL i)
                                   then (PrintData (EVAL i))
                                 else (PRIN1 "Not Set"))
                        else (PRIN1 i)))
    (TERPRI])
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML pg)

(ADDTOVAR LAMA )
)
(PUTPROPS SIMSUPPORT COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1493 1738 (printnode 1503 . 1736)) (1739 7434 (printtransvalue 1749 . 3870) (
printgatenodes 3872 . 4998) (printsourcenodes 5000 . 6094) (printdevice 6096 . 6301) (fc 6303 . 7432))
 (7435 20305 (reducetran 7445 . 9830) (reducenors 9832 . 10172) (removenots 10174 . 10663) (findground
 10665 . 12841) (finddevice 12843 . 13760) (finddeviceoutput 13762 . 14592) (finddevicegate 14594 . 
15487) (findgate 15489 . 15802) (findoutput 15804 . 16121) (findgateoutput 16123 . 16858) (name&val 
16860 . 17577) (checktran 17579 . 18927) (compprint 18929 . 20133) (seem 20135 . 20303)) (20336 42433 
(concatsimfiles 20346 . 20687) (putsimfile 20689 . 22914) (fixfile 22916 . 25453) (findend 25455 . 
25994) (findunconns 25996 . 27456) (optest 27458 . 30349) (romtest 30351 . 32086) (findcx 32088 . 
32717) (ctltest 32719 . 38922) (misctest 38924 . 41558) (run 41560 . 41804) (listnodes 41806 . 42158) 
(findname 42160 . 42431)) (42468 53022 (CollectNet 42478 . 43370) (CollectSourceNet 43372 . 44234) (
FindConnectedNodes 44236 . 45348) (GetDrainNodes 45350 . 45611) (GetGateNodes 45613 . 46160) (
GetSourceNodes 46162 . 46424) (GetSourceTrans 46426 . 46805) (GetSourceTransNode 46807 . 47426) (
PrintChain 47428 . 48283) (PrintGate 48285 . 48783) (PrintOutList 48785 . 49171) (Print01List 49173 . 
50103) (PrintSourceNet 50105 . 50516) (PrintSourceNetTr 50518 . 51039) (pg 51041 . 51168) (pn 51170 . 
51392) (printnode1 51394 . 51719) (printnode2 51721 . 52033) (psNode 52035 . 52313) (psTran 52315 . 
52619) (PrintLst 52621 . 53020)))))
STOP