Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
157 lines (118 sloc) 4.55 KB
\ (C) 2009 Wager Labs, SA
\ Author: Joel Reymont
\ Web: http://tinyco.de
\ FORTHdrive interface
\ end-user API compatibility with USBdriveSF.f
HOST
: CSTR ( -- n ) BL WORD COUNT TUCK 0 DO COUNT C, LOOP DROP 0 C, ;
: ZSTR ( -- ) CSTR DROP ;
LIBRARY /usr/lib/libc.dylib
GLOBAL: mach_task_self_
LIBRARY /System/Library/Frameworks/CoreFoundation.framework/CoreFoundation
FUNCTION: CFRelease ( ref -- )
LIBRARY /System/Library/Frameworks/IOKit.framework/IOKit
FUNCTION: IOServiceOpen ( svc port type handle-addr -- kr )
FUNCTION: IOServiceClose ( handle -- kr )
FUNCTION: IOServiceMatching ( cstr -- dict )
FUNCTION: IOServiceGetMatchingServices ( port dict iter-addr -- kr )
FUNCTION: IOIteratorNext ( iter -- obj )
FUNCTION: IOObjectRelease ( iter -- kr )
FUNCTION: IOConnectCallScalarMethod ( port u addr u addr u -- kr )
\ Dispatch selectors
0 ENUM kS24UserClientOpen
ENUM kS24UserClientClose
ENUM kS24InitMethod
ENUM kS24ReadMethod
ENUM kS24WriteMethod
ENUM kNumberOfMethods
DROP
0 CONSTANT kIOMasterPortDefault
mach_task_self_ @ CONSTANT OUR-MACH-TASK
CREATE DRIVER-CLASS-NAME ZSTR com_wagerlabs_driver_SEAforth24
VARIABLE ITERATOR
: LOOKUP-DRIVER ( -- svc )
DRIVER-CLASS-NAME IOServiceMatching ( dictRef | 0)
?DUP 0= ABORT" IOServiceMatching did not return a dictionary"
\ consumes dictRef on success
kIOMasterPortDefault OVER ITERATOR IOServiceGetMatchingServices
( dictRef kr) ?DUP IF
CFRelease ABORT" IOServiceGetMatchingServices failed"
THEN DROP
ITERATOR @ DUP IOIteratorNext ( iter svc)
?DUP 0= ABORT" No driver found!"
SWAP IOObjectRelease DROP ;
\ This call will cause the user client to be instantiated.
\ It returns an io_connect_t handle that is used for all
\ subsequent calls to the user client.
VARIABLE DRIVER-PORT
: OPEN-DRIVER-PORT ( svc -- )
OUR-MACH-TASK 0 DRIVER-PORT IOServiceOpen
ABORT" Could not open driver port"
\ connect to the driver
DRIVER-PORT @ kS24UserClientOpen 0 0 0 0 IOConnectCallScalarMethod
ABORT" Could not connect to the driver" ;
: CLOSE-DRIVER-PORT ( port -- )
DUP kS24UserClientClose 0 0 0 0 IOConnectCallScalarMethod
ABORT" Could not disconnect from the driver"
( port) IOServiceClose
ABORT" Could not close driver port" ;
CREATE SCALAR 8 4 * ALLOT
SCALAR CONSTANT SCALAR0
SCALAR0 2 CELLS + CONSTANT SCALAR1
SCALAR1 2 CELLS + CONSTANT SCALAR2
SCALAR2 2 CELLS + CONSTANT SCALAR3
CREATE SPT-DBUF 256 1024 * ALLOT
VARIABLE SPT-DataTransferLength
0 VALUE WRITE-LAST
: setWrite 0 to WRITE-LAST ;
: thenRead 1 to WRITE-LAST ;
: DRIVER-INIT ( port -- )
kS24InitMethod 0 0 0 0 IOConnectCallScalarMethod
ABORT" Driver init failed" ;
: DRIVER-READ ( port size bits -- )
0 SPT-DBUF SCALAR0 2! \ scalarI_64[0] = (uint32_t)buffer;
0 SWAP SCALAR2 2! \ scalarI_64[2] = bits;
0 SWAP SCALAR1 2! \ scalarI_64[1] = size;
kS24ReadMethod SCALAR0 3 0 0 IOConnectCallScalarMethod
ABORT" Driver read failed" ;
: DRIVER-WRITE ( port size bits -- )
0 SPT-DBUF SCALAR0 2! \ scalarI_64[0] = (uint32_t)buffer;
0 SWAP SCALAR2 2! \ scalarI_64[2] = bits;
0 SWAP SCALAR1 2! \ scalarI_64[1] = size;
0 WRITE-LAST SCALAR3 2! \ scalarI_64[3] = write-last;
kS24WriteMethod SCALAR0 4 0 0 IOConnectCallScalarMethod
ABORT" Driver write failed" ;
{ --------------------------------------------------------------------
16>OnStream appends a 16-bit word to the stream in the data buffer.
-------------------------------------------------------------------- }
: 16>OnStream ( x -- )
SPT-DBUF SPT-DataTransferLength @ + W!
2 SPT-DataTransferLength +! ;
{ --------------------------------------------------------------------
SEAforth [x] buffer transfers
/USBdrive initializes the drive (which must already be open!).
[x]>USBdrive sends the [x] buffer to the drive.
USBdrive>[x] reads from the drive, compiling into the [x] memory.
-------------------------------------------------------------------- }
HOST
: FIND-DRIVE ( -- )
LOOKUP-DRIVER
OPEN-DRIVER-PORT ;
: CLOSE-DRIVE ( -- )
DRIVER-PORT @ CLOSE-DRIVER-PORT ;
: /USBdrive ( -- )
DRIVER-PORT @ DRIVER-INIT ;
: [x]>USBdrive ( -- )
0 SPT-DataTransferLength !
0 18 BEGIN @16<18 16>OnStream OVER HERE = UNTIL
2 = IF -2 SPT-DataTransferLength +! THEN 18 * ( bits)
DRIVER-PORT @ SPT-DataTransferLength @ ROT DRIVER-WRITE ;
: USBdrive>[x] ( addr u -- )
2DUP SCRUB SWAP ORG
DUP 18 * DUP ( bits)
14 + 16 / 2* ( size)
DRIVER-PORT @ SWAP ROT DRIVER-READ
SPT-DBUF 16 ROT 0 DO
@18<16 TARGET , HOST
LOOP 2DROP ;
ONLY FORTH DEFINITIONS