( USBDOS - Tool to read FAT Drives )
( Version 0.1 080103  )
( SL811 HOST Controller ) 
( ABBUC RAF / Carsten Strotmann )

CR
." USBDOS 0.1 " CR
." Loading ..." CR

HEX

: NOT 0= ;

: BINARY ( -- )
  ( Switch to binary base )
  2 BASE ! ;

: UNUSED ( -- n )
  ( put free FORTH Ram on stack )
  2E5 ( memtop ) @ HERE - ;

: FREE ( -- )
  ( print free FORTH memory )
  UNUSED U. ." Bytes free" CR ;

HERE CONSTANT PGMSTRT
  ( Start Address of USB Tool )

D500 CONSTANT USB1ADR
  ( Addr Reg USB1 )
D501 CONSTANT USB1DTA
  ( Data Reg USB1 )

: RSEL ( addr -- )
  ( Select USB Register )
  USB1ADR C! ;
    
: RC! ( n addr -- )
  ( Store USB Register )
  RSEL USB1DTA C! ;

: RC@ ( addr -- n )
  ( Fetch USB Register )
  RSEL USB1DTA C@ ;

: RW@ ( addr -- w )
  ( Fetch USB Register Word )
  RSEL USB1DTA DUP C@ C@ 100 * + ;

: DOS BYE ;

00 CONSTANT DEBUG

: SWITCHDEBUG
  DEBUG 0= ' DEBUG ! ;

: AT ( y x -- ) 55 ! 54 C! ;
: AT? ( -- y x ) 54 C@ 55 @ ;
: CRSON  0 2F0 C! ;
: CRSOFF 1 2F0 C! ; 
: CLS 7D EMIT ;
: C? ( addr - ) ( Print Byte at addr )
  C@ . ;
: D>MEM ( d addr -- )
  >R 100 /MOD R C! R 1+ C!
     100 /MOD R 2+ C! R> 3 + C! ;
: MEM>D ( d addr -- )
  >R R 2+ C@ 
  R 3 + C@ 100 * OR 
  R C@ R> 1+ C@ 100 * OR ;
  
: 2@ ( addr -- d )
  DUP @ SWAP 2+ @ ;
: 2! ( d addr -- )
  SWAP OVER 2+ ! ! ;
: 2VARIABLE VARIABLE 2 ALLOT ;
: 2CONSTANT <BUILDS , , DOES> 2@ ;
: 2DUP OVER OVER ;
: 2DROP DROP DROP ;
: BSWAP ( n -- 'n )
  100 /MOD SWAP 100 * OR ;
    
FF VARIABLE full-speed
00 VARIABLE pktsize
10 VARIABLE timeout
00 VARIABLE CUREP ( current EP )
00 VARIABLE DDIRA 
   ( Data Direction array for )
   ( endpoint 0-15 )
   0E ALLOT

00 VARIABLE SECBUF 1FF ALLOT
( Sector Buffer )

: SEC@  SECBUF +  @ ;
: SECC@ SECBUF + C@ ;
: SEC2@ SECBUF + 2@ ;
: SEC-C? ( offs -- )
  SECC@ U. ;
: SEC-?  ( offs -- )
  SEC@ U. ;
: SEC-D? ( offs -- )
  SEC2@ D. ;
: SEC-TYPE ( len offs )
  SECBUF + SWAP OVER + SWAP 
  DO I C@ EMIT LOOP ; 

00 CONSTANT EP0
01 CONSTANT EP1
02 CONSTANT EP2
03 CONSTANT EP3

EP1 VARIABLE 'EPIN
EP2 VARIABLE 'EPOUT

0500 VARIABLE SET-ADDRESS
     01 C,
     0000 , 0000 , 00 C,

0900 VARIABLE SET-CONFIG
     01 C, ( Config = 1 )
     0000 , 0000 , 00 C,

( SCSI )

0 VARIABLE SCSIADDR
0 VARIABLE SCSILEN 

0 VARIABLE SCSIRST -2 ALLOT
     21 C,  ( bmRequestType )
     FF C,  ( Device Request Code )
     0000 , ( wValue )
     0000 , ( bInterfaceNumber )
     0000 , ( Data none )

0 VARIABLE SCSIINQ -2 ALLOT
     12 C, 00 C, 0000 ,
     24 C, 0000 , 0000 , 0000 , 00 ,

0 VARIABLE SCSICAP -2 ALLOT
     25 C, 00 C, 0000 , 0000 ,
     0000 , 0000 , 0000 ,

( SCSI Read Logical Block )
0 VARIABLE SCSIREAD -2 ALLOT
  28 C,       ( Operation Code )
  00 C,       ( LUN )
  0000 , 0000 , ( Address/Sector )
  00 C,       ( reserved )
  00 C, 01 C, ( Transfer Length )
  0000 , 00 C, ( reserved )

( RCB SCSI USB Storage )

0 VARIABLE CBW -2 ALLOT
  5355 , 4342 ,   ( bCBWSignature )
  0000 , 0000 ,   ( dCBWTag       )
  0000 , 0000 ,   ( dCBWDataTransLen )
           00 C,  ( bmCBWFlags    )
           00 C,  ( bCBWLUN       )
           00 C,  ( bCBWCBLength  )
  12 ALLOT        ( CBWCB         )

CBW 0F + 0F ERASE ( CLEAR CBWCB   )

80 CONSTANT cbwdatain
00 CONSTANT cbwdataout

0 2VARIABLE PARTSEC
( Partition Startsec, 0 = no Part )

0 2VARIABLE STARTFAT
0 2VARIABLE STARTCLUSTER
0 VARIABLE  SECPERCLUSTER
0 2VARIABLE STARTROOTDIR
0 2VARIABLE STARTDIR
0 2VARIABLE CURDIRSEC

: PAUSE ( n -- )
  10 * 0 DO I DROP LOOP ;

: CTL!    00 RC! ;
: PID-EP! 03 RC! ;
: PKTSTA@ 03 RC@ ;
: FNADDR! 04 RC! ;
: MCTRL!  05 RC! ;
: INTSTA! 0D RC! ;
: INTSTA@ 0D RC@ ;
: SOFCNT! 0F RC! ;
: CDTSET! 0E RC! ;
: CDTSET@ 0E RC@ ;
: BUFADR! 01 RC! ;
: BUFADR@ 01 RC@ ;
: BUFLEN! 02 RC! ;
: BUFLEN@ 02 RC@ ;

( Check if there is a SL811 USB Controller )
: CHECKUSB1 ." USB1 is "
   CDTSET@ F0 AND 
   DUP 20 = IF ." SL811HS Rev 1.5 " THEN
   DUP 10 = IF ." SL811HS Rev 1.2 " THEN
   DUP 00 = IF ." SL811H " THEN
       20 > IF ." not ok " THEN
    CR ;

: Speed? ( -- n )
  AE SOFCNT! 08 MCTRL!  10 PAUSE
  00 MCTRL!  FF INTSTA! 10 PAUSE

  INTSTA@ 40 AND IF FF INTSTA! 0 ELSE
   INTSTA@ 80 AND
   IF ( Full speed ? )
     AE SOFCNT! E0 CDTSET! 01 MCTRL! 
     20 full-speed ! 
   ELSE
     EE SOFCNT! E0 CDTSET! 21 MCTRL! 
     00 full-speed ! 
   THEN
   
   50 PID-EP! 00 FNADDR! 01 CTL! 
   25 PAUSE
   FF INTSTA! 
   40 pktsize ! 1  
  THEN
;

: BUFREAD ( daddr c addr -- )
  RSEL OVER + SWAP DO USB1DTA C@ I C! LOOP ;

: BUFWRITE ( saddr c addr -- )
  RSEL OVER + SWAP DO I C@ USB1DTA C! LOOP ;

: BUFCOPY ( daddr -- )
  ( copy 40 Bytes from USB to Mem )
  40 BUFADR@ BUFREAD ;

: BUFCLEAR ( len -- )
  BUFADR@ RSEL 0 DO 0 USB1DTA C! LOOP ;  

: BUF@ ( addr )
  BUFADR@ + RC@ ;

: BUFDUMP
  BUFADR@ DUP BUFLEN@ + SWAP 
  DO I RC@ 3 .R I 8 MOD 0= IF CR THEN LOOP ;

: RTYPE ( addr len -- ) ( Print String buf USB Buffer )
  SWAP BUFADR@ +
  SWAP OVER + SWAP DO I RC@ EMIT LOOP ;

: DDIR@
  CUREP C@ DDIRA + C@ ;

: DDIR!
  CUREP C@ DDIRA + C! ;

: CUREP! CUREP ! ;

: RSETDTA 
  8 0 DO 0 I DDIRA + C! LOOP ;

: PROCESS ( cmd -- rc )
  01 INTSTA! 
  full-speed @ OR 
  DDIR@ + CTL!
  BEGIN
    INTSTA@ 01 AND 
  UNTIL
  DDIR@ 40 XOR DDIR!
  PKTSTA@ ;

: !SETUP ( addr -- )
  ( send Setup Packet  to device )
  8 BUFADR@ BUFWRITE
  0 CUREP!  
  D0 PID-EP! 0 DDIR!  
  BEGIN
    07 PROCESS 04 AND 0=  
  UNTIL ;

: !OUT ( addr -- )
  8 BUFADR@ BUFWRITE
  10 PID-EP! 0 CUREP!
  BEGIN 07 PROCESS 04 AND 0= UNTIL ;

: DOIN ( ep -- )
  ( configure for IN Packet )
  DUP CUREP! 90 + PID-EP! 
  BEGIN 03 PROCESS 04 AND 0= UNTIL ;

: DOOUT ( ep -- )
  DUP CUREP! 10 + PID-EP! 
  BEGIN 07 PROCESS 04 AND 0= UNTIL ;

: STATUSIN  ( -- )
  ( send status/empty in packet )
  0 BUFLEN! 'EPIN @ DOIN 8 BUFLEN! ;

: STATUSOUT ( -- )
  ( send status/empty out packet )
  0 BUFLEN! 'EPOUT @ DOOUT 8 BUFLEN! ;

: GETP-IN ( get IN Packet on Endpoint )
  SCSILEN @ BUFLEN! 'EPIN @ DOIN 8 BUFLEN! ;

: SENDP-OUT ( send OUT Packet on Endpoint )
  SCSILEN @ BUFLEN! 'EPOUT @ DOOUT 8 BUFLEN! ;

: SCSIRESET ( -- )
  SCSIRST !OUT ;

: CBWTAG+
  1 CBW 4 + +! ;
: CBWDataLen! ( n -- )
  CBW 8 + ! ;
: CBWDataLen@ ( -- n )
  CBW 8 + @ ;
: CBWDir! ( f -- )
  CBW C + C! ;
: CBWCBLen! ( n -- )
  CBW E + C! ;
: RBC>CBW ( rbcaddr n -- )
  DUP CBWCBLen! CBW 0F + SWAP CMOVE ; 

: SendCBW ( send CBW on BulkOut )
  40 BUFCLEAR   1F SCSILEN !
  CBW 1F BUFADR@ BUFWRITE 
  SENDP-OUT ;

: RcvData ( n -- ) ( recieve Data on BulkIn )
  40 BUFCLEAR SCSILEN ! GETP-IN ;
  
: CBWInq ( -- )
  SCSIINQ 06 RBC>CBW  CBWTAG+
  cbwdatain CBWDir! 24 CBWDataLen!
  SendCBW CBWDataLen@ RcvData ;

: CBWGetCapacity ( -- )
  SCSICAP 0A RBC>CBW  CBWTAG+
  cbwdatain CBWDir! 8 CBWDataLen!
  SendCBW CBWDataLen@ RcvData ;

: CBWTestUnitReady ( -- )
  SCSIRESET 25 PAUSE 
  CBW 0F + 10 ERASE CBWTAG+ 6 CBWCBLen!
  cbwdataout CBWDir! 0 CBWDataLen!
  SendCBW ;

: CBWReadLBA ( -- )
  SCSIREAD 0A RBC>CBW CBWTAG+
  cbwdatain CBWDir! 200 CBWDataLen!
  SendCBW 
  8 0 DO ( recv sec 8x$40=$200 )
     pktsize @ RcvData
     I 40 * SECBUF + BUFCOPY
  LOOP ;

: (CBS 0D RcvData ;

: .CBS
  (CBS CBW 4 + C@ 4 BUF@ =
  IF ." ok" ELSE ." Error invalid CBS" THEN
  CR ;

: WAITFRAMES ( n -- )
  0 DO FF INTSTA!
    BEGIN INTSTA@ 10 AND UNTIL
  LOOP
;

: INITUSB
  08 MCTRL!
  10 PAUSE
  full-speed @ IF
    01 MCTRL!
  ELSE
    21 MCTRL!
  THEN
  10 BUFADR! 08 BUFLEN! 
  00 FNADDR!  
  SET-ADDRESS !SETUP EP0 DOIN
  SET-ADDRESS 2 + C@ FNADDR! 
  SET-CONFIG !SETUP EP0 DOIN 
  RSETDTA EP1 'EPIN  ! EP2 'EPOUT !
;

: WAITDEVICE
  CR ." Wait for device..." CR
  BEGIN Speed? UNTIL
  full-speed @
  IF ." Full " 
  ELSE ." Low "
  THEN
  ." Speed Device Detected."
  CR
;

CHECKUSB1

: VER
  CR
  ." USBDOS 0.1 08.01.2006" CR
  ." (c) 2006 ABBUC/C.Strotmann " CR
  CR CHECKUSB1
;

: SETEP ( inep outep -- )
  'EPOUT ! 'EPIN ! ;

: INIT?
  full-speed @ FF = IF
    WAITDEVICE INITUSB
  THEN
;
  
: WAITKEY 
  CR ." Press any key."
  KEY DROP ;

: ATTACH ( attach USB Device )
  WAITDEVICE INITUSB
;

: CAP?
  CBWGetCapacity
  BASE @ DECIMAL
  2 BUF@ 100 *
  3 BUF@ +
  0 BUF@ 100 *
  1 BUF@ + D. ." Sec /"
  6 BUF@ 100 *
  7 BUF@ +
  4 BUF@ 100 *
  5 BUF@ + D. ." Byte"
  BASE ! CR .CBS ;

: PRINTINQ
  CR ." Device Type   :"
  BUFADR@ 1+ RC@ 80 AND IF
    ." Removeable Media"
  ELSE
    ." Fixed Media" THEN
  CR ." Vendor Info   :"  8  8 RTYPE
  CR ." Product Ident :" 10 10 RTYPE
  CR ." Product Rev   :" 20  4 RTYPE
  CR
;

: SCSIDEV? 
  CBWInq PRINTINQ .CBS ;

: SCSIREADY
  CBWTestUnitReady .CBS ;

: (READSEC ( Read Logical Block )
  SCSIREAD 2+ D>MEM CBWReadLBA ;

: READSEC (READSEC CR .CBS ;

: DUMP ( addr len -- )
  OVER + SWAP DO I 8 + I OVER OVER
  DO I C@ 3 .R LOOP BL EMIT
  DO 80 2FE C! I C@ EMIT 0 2FE C! LOOP CR
  ?TERMINAL IF KEY DROP LEAVE THEN 8 +LOOP ;
 
: DUMPSEC
  CR SECBUF 200 DUMP ;

: READMBR 0 0 (READSEC (CBS ;

: .PARTTAB ( addr -- )
  ( Print Partition Table Entry )
  DUP 4 + C@ IF
  ." Bootable?       :" DUP C@ IF ." TRUE" ELSE ." FALSE" THEN CR
  ." Start (CHS)     :" 1+ DUP
  C@ U. 1+ DUP C@ U. 1+ DUP C@ U. CR
  ." Filesystem ID   :" 1+ DUP C@ U. CR
  ." End   (CHS)     :" 1+ DUP
  C@ U. 1+ DUP C@ U. 1+ DUP C@ U. CR
  ." Startsector     :" 1+ DUP 2@ D. CR
  ." Number of Sector:" 1+ MEM>D D. 
  ELSE ." Not Used." THEN CR
;

: MBR?
  READMBR CR
  ." Boot Signature  :" SECBUF 1FE + DUP 
  BASE @ SWAP HEX DUP C@ U. 1+ C@ U. BASE !
  @ AA55 = IF ." valid" ELSE ." invalid" THEN 
  4 0 DO
    CR ." Partition #" I . CR
    I 10 * SECBUF + 1BE + .PARTTAB 
  LOOP CR ; 

: SETPART ( part -- ) 
  ( Select Partition )
  CR READMBR 10 * SECBUF + 1BE + 
  8 + 2@ PARTSEC 2! ;

: READVOLID PARTSEC 2@ (READSEC (CBS ;

: VOLUMEID?
  ( Print FAT32 Volume ID )
  READVOLID CR
  ." FAT Volume ID Sector " CR
  ." Volume Signature  :" SECBUF 1FE + DUP 
  BASE @ SWAP HEX DUP C@ U. 1+ C@ U. BASE !
  @ AA55 = IF ." valid" ELSE ." invalid" THEN 
  CR ." Bytes per Sector  :" 0B SEC-?
  CR ." Sector per Cluster:" 0D SEC-C?
  CR ." Reserved Sectors  :" 0E SEC-?
  CR ." Number of FATs    :" 10 SEC-C?
  CR ." Sectors per FAT   :" 24 SEC-D?
  CR ." Root Directory 1st:" 2C SEC-D?
  CR ." Volume Label      :" 0B 47 SEC-TYPE
  CR ." FAT Type          :" 08 52 SEC-TYPE
;

: MOUNT ( part -- )
  SETPART READVOLID
  PARTSEC 2@ SECBUF 0E + @ S>D D+ 
  STARTFAT 2!
  STARTFAT 2@ SECBUF 24 + 2@ 2DUP D+
  D+ -1 S>D D+ STARTCLUSTER 2!
  SECBUF 0D + C@ SECPERCLUSTER !
  SECBUF 2C + 2@ STARTROOTDIR 2! 
  STARTCLUSTER 2@ STARTDIR 2! ;
 
: MOUNT?
  CR ." Start of Fat   :" STARTFAT 2@ D.
  CR ." Start of Data  :" STARTCLUSTER 2@ D.
  CR ." Sec per Cluster:" SECPERCLUSTER ?
  CR ." Start Root Dir :" STARTROOTDIR 2@ D.
  CR ." Start Cur. Dir :" STARTDIR 2@ D. 
;

: FASTMOUNT ( inep outep -- )
  ATTACH SETEP 0 MOUNT ;

0 VARIABLE (DIR
0 VARIABLE (DIRE

: PrintDirEntry ( addr -- )
  (DIRE ! 
  80 2FE C!
  (DIRE @ 0B + SECC@ 
  0F AND 0F = NOT IF
     (DIRE @ SECC@ E5 = NOT IF
     (DIRE @ SECC@ IF
       0B (DIRE @ + SECC@ 
       DUP 01 AND IF 52 EMIT THEN
       DUP 02 AND IF 48 EMIT THEN
       DUP 04 AND IF 53 EMIT THEN
       DUP 08 AND IF 56 EMIT THEN
       DUP 10 AND IF 44 EMIT THEN
           20 AND IF 41 EMIT THEN
           BL EMIT
           AT? DROP 8 AT
           0B (DIRE @ SEC-TYPE 
           1C (DIRE @ + SEC2@ 0A D.R CR
  THEN THEN THEN 0 2FE C!
;

: DIRNXTSEC
  CURDIRSEC 2@ 1 S>D D+ CURDIRSEC 2!
  CURDIRSEC 2@ (READSEC (CBS ;
    
: DIR
  STARTDIR 2@ CURDIRSEC 2!
  0 (DIR ! CR
  BEGIN
    DIRNXTSEC 
    10 0 DO
      I 20 * PrintDirEntry 
      1 (DIR +!
    LOOP
    (DIRE @ SEC@ 0=
  UNTIL ;

: SHELL 
  full-speed @ FF = IF CLS VER THEN
  BEGIN CR ." >" 
  QUERY INTERPRET AGAIN ;

( Patch Abort and Error    )
( replace QUIT with SHELL )

' SHELL CFA ' ERROR 1B + !
' SHELL CFA ' ABORT 0A + !

CR ." USBDOS loaded!" CR
FREE CR KEY DROP

SHELL



