(FILECREATED "18-Sep-85 11:26:41" {DSK}<DSK>HTHOMPSON>DSL>BUSTEST.;2 7504
changes to: (VARS BUSTESTCOMS)
(FNS BUS.MAKETEST)
previous date: " 4-Jun-85 15:18:37" {DSK}<DSK>HTHOMPSON>DSL>BUSTEST.;1)
(* Copyright (c) 1985 by XEROX. All rights reserved.)
(PRETTYCOMPRINT BUSTESTCOMS)
(RPAQQ BUSTESTCOMS ((* Busmaster and PC connection tests - should have Multibus too but not yet)
(FNS MBBRead BUS.MAKETEST DoMMBCmd)
(VARS MBBMenuItems MBBMenus)
(BITMAPS BusBoxIcon)
(FILES (SYSLOAD)
BUSMASTER TOGMENU TRUEHAX)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T))
(FILES (LOADCOMP)
BUSEXTENDER.DCOM))))
(* Busmaster and PC connection tests - should have Multibus too but not yet)
(DEFINEQ
(MBBRead
[LAMBDA (message) (* ht: "12-Apr-85 18:03")
(RESETFORM (TTYDISPLAYSTREAM (GETPROMPTWINDOW (MAINWINDOW $$TogWindow$$ T)))
(printout NIL message " (in hex) : ")
(PROG1 (TrueRadixRead 16)
(CLOSEW (GETPROMPTWINDOW (MAINWINDOW $$TogWindow$$ T])
(BUS.MAKETEST
[LAMBDA NIL (* ht: " 4-Jun-85 15:18")
(bind (mw ←(TogMenu (MakeTogMenu (CDAR MBBMenus))
(CAAR MBBMenus)
NIL LASTMOUSEX LASTMOUSEY))
tw bbw tm
first (tw←mw)
(WINDOWPROP mw (PACK* MBBMenus:1:1)
(WINDOWPROP mw 'ToggleMenu))
for menu in MBBMenus::1
do (ATTACHWINDOW (TogMenu tm←(MakeTogMenu menu::1)
menu:1 NIL 0 0)
tw
'RIGHT)
(WINDOWPROP mw (PACK* menu:1)
tm)
finally (ATTACHMENU (create MENU
ITEMS ← MBBMenuItems
WHENSELECTEDFN ←(FUNCTION DoMMBCmd))
(ATTACHWINDOW bbw←(CREATEW '(0 0 100 100)
"Busmaster Test")
mw
'BOTTOM
'JUSTIFY)
'LEFT
'TOP)
(WINDOWPROP mw 'BBWindow
bbw)
(DSPSCROLL T bbw)
(WINDOWPROP bbw 'NOPAGEHOLD
T)
(WINDOWPROP mw 'ICON
BusBoxIcon])
(DoMMBCmd
[LAMBDA (item menu key) (* ht: "25-May-85 17:34")
(LET*[(mw (MAINWINDOW (WFROMMENU menu)
T))
(ow (WINDOWPROP mw 'BBWindow))
[ha (TogMenuValue (WINDOWPROP mw 'High% Address]
[la (TogMenuValue (WINDOWPROP mw 'Low% Address]
[pa (TogMenuValue (WINDOWPROP mw 'Port% Address]
[datum (TogMenuValue (WINDOWPROP mw 'Datum]
[silent (TogMenuValue (WINDOWPROP mw 'Quiet]
(loop (TogMenuValue (WINDOWPROP mw 'Loop]
(do (SELECTQ item
[MemRead (if silent
then (PCBUS.READHL ha la)
else (RESETFORM (RADIX 16)
(printout ow T "Mem " (IPLUS (LLSH ha 16)
la)
": "
(PCBUS.READHL ha la]
(MemWrite [if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Mem "
(IPLUS (LLSH ha 16)
la]
(PCBUS.WRITEHL ha la datum))
[PortRead (if silent
then (PCBUS.INPUT pa)
else (RESETFORM (RADIX 16)
(printout ow T "Port " pa ": " (PCBUS.INPUT pa]
(PortWrite (if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Port " pa)))
(PCBUS.OUTPUT pa datum))
[MemW/R [if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Mem "
(IPLUS (LLSH ha 16)
la]
(PCBUS.WRITEHL ha la datum)
(if silent
then (PCBUS.READHL ha la)
else (RESETFORM (RADIX 16)
(printout ow T "Mem " (IPLUS (LLSH ha 16)
la)
": "
(PCBUS.READHL ha la]
[PortW/R (if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Port " pa)))
(PCBUS.OUTPUT pa datum)
(if silent
then (PCBUS.INPUT pa)
else (RESETFORM (RADIX 16)
(printout ow T "Port " pa ": " (PCBUS.INPUT pa]
[MW/PR (if (AND silent loop)
then (do (PROGN (BX.OUTPUT ha 6)
(BX.OUTPUT la 7)
(BX.OUTPUT 2 4)
(BX.OUTPUT datum 5))
(PROGN (BX.OUTPUT pa 7)
(BX.OUTPUT 4 4)
(BX.OUTPUT 0 5)
(BX.INPUT 5)))
else [if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Mem "
(IPLUS (LLSH ha 16)
la]
(PCBUS.WRITEHL ha la datum)
(if silent
then (PCBUS.INPUT pa)
else (RESETFORM (RADIX 16)
(printout ow T "Port " pa ": " (PCBUS.INPUT pa]
(SHOULDNT))
repeatuntil (OR (NULL loop)
(KEYDOWNP 'STOP])
)
(RPAQQ MBBMenuItems (MemRead MemWrite PortRead PortWrite MemW/R PortW/R MW/PR))
(RPAQQ MBBMenus (("High Address" 1 (F 15)
((TRS (TogMenuValue)
16)
(MBBRead "High Address")
NIL "Will prompt and read (in hex)" Other))
("Low Address" 0 ((TRS (TogMenuValue)
16)
(MBBRead "Low Address")
NIL "Will prompt and read (in hex)" Other))
("Port Address" 0 (data 532)
(HiAddr 533)
(LoAddr 534)
((TRS (TogMenuValue)
16)
(MBBRead "Port Address")
NIL "Will prompt and read (in hex)" Other))
(Datum 0 (FF 255)
((TRS (TogMenuValue)
16)
(MBBRead 'Datum)
NIL "Will prompt and read (in hex)" Other))
(Quiet (No (NILL))
(Yes T))
(Loop (No (NILL))
(Yes T))))
(RPAQ BusBoxIcon (READBITMAP))
(64 64
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"LBBBBBBBBBBBBB@C"
"LBBBBBBNCOOOOOHC"
"L@HHHHHLKOOOOOHC"
"L@HLIHHLKOOOOOHC"
"LBBNCJBNCOOOOOHC"
"LBBNCJBNCOOOOOHC"
"L@HLIHHLKOOOOOHC"
"L@HNKHHLKOOOOOHC"
"LBBOOJBNCOOOOOHC"
"LBBGOBBNCOOOOOHC"
"L@HKNHHLHHIOHHHC"
"L@HILHHLHHIOHHHC"
"LBBCNBBNBBCOBB@C"
"LBBCNBBNBBCOJB@C"
"L@HKLHHLHHIOHHHC"
"L@HILHHLHHIOHHHC"
"LBBCNBBNBBCOBB@C"
"LBBCNBBNBBCOBB@C"
"L@HILHHLHHIOHHHC"
"L@HILHHLHHIOHHHC"
"LBBCNBBNBBCOBB@C"
"LBBCNBBNBBCOBB@C"
"L@HILHHLHHIOHHHC"
"L@HILHHLHHIOHHHC"
"LBBCNBBNBBCOBB@C"
"LBBCNBBNBBCOBB@C"
"L@HILHHLHHIOHHHC"
"L@HILHHLHHIOHHHC"
"LBBCNBBNBBCOBB@C"
"LBBCNBBNBBCOBB@C"
"L@HILHHLHHIOHHHC"
"L@HILHINHHIOHHHC"
"LBBCNBCOBBCOBB@C"
"LBBCNBGOJBCOBB@C"
"L@HILHOOHHIOHHHC"
"L@HILHOOHHIOHHHC"
"LBBCNBGOJBCOBB@C"
"LBBCNBGOJBCOBB@C"
"L@HILHOOHHIOHHHC"
"L@HKNHOOHHIOHHHC"
"LBBCOBGOJBCOBB@C"
"LBBOOJGOJBCOBB@C"
"L@HOOHOOHHIOHHHC"
"L@HNKHOOHHIOHHHC"
"LBBNCJGOJBCOBB@C"
"LBBNCJGOJBCOBB@C"
"L@HLIHKOHHIOHHHC"
"L@HLIHINHHHHHHHC"
"L@@@@@@@@@@@@@@C"
"L@@@@@@@@@@@@@@C"
"L@@@@@@@@@@@@@@C"
"L@@@@@@@@@@@@@@C"
"LAN@@@@@@@@D@@@C"
"LAABDGEKAHGNFBHC"
"LANBDHFMBDHDICHC"
"LAABDFDIALFDOB@C"
"LAABLADIBDADHB@C"
"LANCDNDICJNFGB@C"
"L@@@@@@@@@@@@@@C"
"L@@@@@@@@@@@@@@C"
"L@@@@@@@@@@@@@@C"
"OOOOOOOOOOOOOOOO")
(FILESLOAD (SYSLOAD)
BUSMASTER TOGMENU TRUEHAX)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(RESETSAVE DWIMIFYCOMPFLG T)
(FILESLOAD (LOADCOMP)
BUSEXTENDER.DCOM)
)
(PUTPROPS BUSTEST COPYRIGHT ("XEROX" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (802 5231 (MBBRead 812 . 1179) (BUS.MAKETEST 1181 . 2198) (DoMMBCmd 2200 . 5229)))))
STOP