(FILECREATED "18-Apr-85 19:18:41" {DSK}<LISPFILES>HTHOMPSON>DSL>TESTBUS.;7 8093
changes to: (VARS TESTBUSCOMS)
(FNS BM16LOOP BM8LOOP)
previous date: "14-Apr-85 14:38:44" {DSK}<LISPFILES>HTHOMPSON>DSL>TESTBUS.;6)
(* Copyright (c) 1985 by Henry Thompson. All rights reserved.)
(PRETTYCOMPRINT TESTBUSCOMS)
(RPAQQ TESTBUSCOMS ((VARS MBBMenuItems MBBMenus)
(FNS BUS.RESET BM16LOOP BM8LOOP MBBRead MakeBusBox DoMMBCmd)
(MACROS \DEVICE.INPUT \DEVICE.OUTPUT)
(FILES BUSMASTER)
(BITMAPS BusBoxIcon)))
(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))))
(DEFINEQ
(BUS.RESET
[LAMBDA NIL (* ht: "18-Apr-85 17:24")
(* * reset the BusMaster and do a reset cycle on the external bus -- emit a control code then write a dummy datum to
trigger the cycle)
(BX.OUTPUT 32 4)
(BX.OUTPUT 0 5])
(BM16LOOP
[LAMBDA (D) (* ht: "18-Apr-85 18:03")
(BX.OUTPUT 15 6)
(BX.OUTPUT 0 7)
(BX.OUTPUT 33026 4)
(BX.OUTPUT D 5)
D=(BX.INPUT 5])
(BM8LOOP
[LAMBDA (D) (* ht: "18-Apr-85 17:56")
(BX.OUTPUT 15 6)
(BX.OUTPUT 0 7)
(BX.OUTPUT 2 4)
(BX.OUTPUT D 5)
D=(BX.INPUT 5])
(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])
(MakeBusBox
[LAMBDA NIL (* edited: "14-Apr-85 14:33")
(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)
"Bus Box")
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) (* edited: "14-Apr-85 13:19")
(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 (BUS.READHL ha la)
else (RESETFORM (RADIX 16)
(printout ow T "Mem " (IPLUS (LLSH ha 16)
la)
": "
(BUS.READHL ha la]
(MemWrite [if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Mem "
(IPLUS (LLSH ha 16)
la]
(BUS.WRITEHL ha la datum))
[PortRead (if silent
then (BUS.INPUT pa)
else (RESETFORM (RADIX 16)
(printout ow T "Port " pa ": " (BUS.INPUT pa]
(PortWrite (if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Port " pa)))
(BUS.OUTPUT pa datum))
[MemW/R [if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Mem "
(IPLUS (LLSH ha 16)
la]
(BUS.WRITEHL ha la datum)
(if silent
then (BUS.READHL ha la)
else (RESETFORM (RADIX 16)
(printout ow T "Mem " (IPLUS (LLSH ha 16)
la)
": "
(BUS.READHL ha la]
[PortW/R (if (NOT silent)
then (RESETFORM (RADIX 16)
(printout ow T datum " -> Port " pa)))
(BUS.OUTPUT pa datum)
(if silent
then (BUS.INPUT pa)
else (RESETFORM (RADIX 16)
(printout ow T "Port " pa ": " (BUS.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]
(BUS.WRITEHL ha la datum)
(if silent
then (BUS.INPUT pa)
else (RESETFORM (RADIX 16)
(printout ow T "Port " pa ": " (BUS.INPUT pa]
(SHOULDNT))
repeatuntil (OR loop=NIL (KEYDOWNP 'STOP])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \DEVICE.INPUT MACRO (X (LIST '(OPCODES MISC1 1)
(CAR X))))
(PUTPROPS \DEVICE.OUTPUT MACRO (X (LIST '(OPCODES MISC2 2)
(CAR X)
(CADR X))))
)
(FILESLOAD BUSMASTER)
(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@G@@@@@@G@@@@@C"
"L@DH@@@@@DH@@@@C"
"L@DHHHN@@DHGAA@C"
"L@GHHIA@@GHHHJ@C"
"L@DDHHL@@DDHHD@C"
"L@DDHHB@@DDHHD@C"
"L@DDIIA@@DDHHJ@C"
"L@GHFHN@@GHGAA@C"
"L@@@@@@@@@@@@@@C"
"L@@@@@@@@@@@@@@C"
"L@@@@@@@@@@@@@@C"
"OOOOOOOOOOOOOOOO")
(PUTPROPS TESTBUS COPYRIGHT ("Henry Thompson" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1328 6515 (BUS.RESET 1338 . 1653) (BM16LOOP 1655 . 1884) (BM8LOOP 1886 . 2110) (MBBRead
2112 . 2479) (MakeBusBox 2481 . 3493) (DoMMBCmd 3495 . 6513)))))
STOP