( GPIOForth)
( 2nd June 2015)

CR ." GPIOForth" 

( copied from GPio_pi: *****************)
HEX
( 58FBE CONSTANT GPIO_GetBoard)
( 68 CONSTANT OS_Memory  -  defined in GetBoard)
16 CONSTANT OS_EnterOS   ( enter Supervisor Mode)
7C CONSTANT OS_LeaveOS   ( back to User Mode)
0 VARIABLE pinmode

( get bus addr for SPI control/status register)
( CODE SPI_reg - moved to GetBoard)     ( space,addr,reason code{13} .... bus addr)       
 
( Read from peripheral in SVC mode)
CODE rd_SVCmode ( - moved to GetBoard)   ( addr....n)
 R1 POP,           ( address in R1) 
 OS_EnterOS SWI,   ( enter Supervisor Mode)
 R0 [ R1 ]  LDR,   ( read value to R0)
 OS_LeaveOS SWI,
 R0 PUSH,          ( put to stack)
PC R14 MOV,
END-CODE

( Write to peripheral in SVC mode)
CODE wr_SVCmode    ( n,addr....)
 R1 POP,           ( address in R1)
 R0 POP,           ( value in R0)
 OS_EnterOS SWI,   ( enter Supervisor Mode)
 R0 [ R1 ]  STR,   ( store value at addr)
 OS_LeaveOS SWI,
PC R14 MOV,
END-CODE

( Info on register addresses: ***********)
( Note: Rev 1 Pi uses BSC0 on pins 3 & 5; Rev 2 uses BSC1)
(       Rev 1: &2020_0000; Rev 2: 2080_0000 for base address of registers
          Pi2: &3F200000  for GPIO base address)
( board nos: 12 for Rev2; 17 for B+)

HEX
GPIOsel_fn 1C + CONSTANT OutSet0
GPIOsel_fn 28 + CONSTANT OutClr0
GPIOsel_fn 34 + CONSTANT GPLEV0
GPIOsel_fn 38 + CONSTANT GPLEV1

( Start of Forth GPIO control: ************)
DECIMAL
0 VARIABLE FNsel_addr     ( address of Function select register for pin no)
0 VARIABLE 3bits_addr     ( offset address for selection code in above register)
0 VARIABLE OPSetReg       ( addr of Pin Set regs 0 to 1 - for pin no)
0 VARIABLE OPClrReg       ( addr of Pin Clear "" ) 
0 VARIABLE 1bit_addr      ( offset into Set/Clear registers)
0 VARIABLE IPReg          ( address of GPLEV0 or 1)
0 VARIABLE 1bit_IP        ( offset into IPreg)

HEX
( swap 0s and 1s)
: NOT  ( n...n)  FFFFFFFF XOR ;
DECIMAL

( 3 bits cleared using AND NOT and then 001 inserted using OR)
: pin_out   ( pin no...)  ( configure pin as an output - code in GPIOsel_fn register)
   DUP
   7  SWAP 3 *  <<   ( 7=111)
   NOT
   GPIOsel_fn rd_SVCmode                 
   AND
   ( 001 for output:)
   1  ROT  3 *  << OR
   GPIOsel_fn wr_SVCmode ;
DECIMAL

( **** General, using >=1 registers: ****)
( show contents of registers via SVC mode)
: see_reg ( addr...n)  rd_SVCmode BINARY U. DECIMAL ;
: ?GPIOsel_fn  GPIOsel_fn see_reg ;
: ?OutSet0     OutSet0  see_reg ;
: ?OutClr0     OutClr0  see_reg ;

( show address, not contents)
: ?FNsel_addr  FNsel_addr @ CR BINARY U. SPACE GPIOsel_fn U. DECIMAL ;
: ?3bits_addr  3bits_addr @ CR BINARY U. DECIMAL ;
: ?OPSetReg    OPSetReg   @ CR BINARY U. SPACE OutSet0 U. DECIMAL ;
: ?OPClrReg    OPClrReg   @ CR BINARY U. SPACE OutClr0 U. DECIMAL ;
: ?1bit_addr   1bit_addr  @ CR BINARY U. DECIMAL ;
: showregs ?FNsel_addr ?3bits_addr ?OPSetReg ?OPClrReg ?1bit_addr ; 


( set Function select register stuff:)
( selects Function Select Register base address for this pin and stores in FNsel_addr)
( - also works out position of 3bits for function required in the same Function Register)       
: GPIOFNsetup ( pin no...)
  ( set Function select register stuff:)
  10 /MOD                   ( remainder,ratio...)
  4* GPIOsel_fn +           ( remainder,addr of sel register...)
  FNsel_addr !              ( remainder...)
  3 * ( <<) 3bits_addr ! ;  ( ...)  ( points to l.sig bit of 3)

( set write/clear register stuff:)
( finds correct register - 1 of 2 - and the position therein for this pin)
: SetClrsetup ( pin no...)
  32 /MOD                     ( remainder,ratio...)
  4* DUP OutSet0 + OPSetReg !
         OutClr0 + OPClrReg !
  1bit_addr ! ;

( 3 bits cleared using AND NOT and then 001 inserted using OR)
: gpin_out   ( pin no...)  ( set a Function Reg to output for this pin no)
   DUP GPIOFNsetup
   7 SWAP 3 * <<           ( 7=111)
   NOT
   FNsel_addr @ rd_SVCmode                 
   AND
   ( 001 for output:)
   1  3bits_addr @ ( 3 *)  << OR
   FNsel_addr @  wr_SVCmode ;

( select high/low by writing '1' in either OutSet0 {0 or 1} or OutClr0 {0 or 1})
: gpin_high ( pin_no...)
  SetClrsetup  OPSetReg @  1bit_addr @  ( SET reg address,effective pin no...)
  1 SWAP << SWAP  wr_SVCmode ;

: gpin_low   ( pin no...)
  SetClrsetup   OPClrReg @  1bit_addr @     ( CLR reg address,effective pin no...)
  1 SWAP << SWAP  wr_SVCmode ;

: gWrData    ( 0/1,pin...)  ( write 0 or 1 to pin)
   SWAP 0= IF   gpin_low
           ELSE gpin_high
           ENDIF ;

( SPI stuff - pins 8 to 11 - choose alternate function 0 - code 100 ****)
( use value in pinmode to select function)
( 3 bits cleared using AND NOT and then mode code inserted using OR)
: set_pinmode  ( pin...)
  DUP GPIOFNsetup
   7 SWAP 3 * <<           ( 7=111)
   NOT
   FNsel_addr @ rd_SVCmode                 
   AND
   ( write mode:)
   pinmode @  3bits_addr @  << OR
   FNsel_addr @  wr_SVCmode ;

: set_SPIForth
  4 pinmode !     ( 4=100)
  12 8 DO  I  set_pinmode LOOP ;

: unset_SPIForth   ( make inputs)
  0 pinmode !
  12 8 DO  I  set_pinmode LOOP ;

: gpin_in  ( pin...)   ( pin as input)
  0 pinmode !
  set_pinmode ;

: gRdData   ( pin...0/1)  ( read 0 or 1 from pin no.)
  32 /MOD                     ( remainder,ratio...)
  4* GPLEV0 + IPReg !
  1bit_IP ! 
  IPReg @  rd_SVCmode   ( read complete register)
  1 1bit_IP @ << AND 0= 0= ;






