\ serial 05.4.12 NAB 
\ updated 00.5.14 10:43pm WDM 
\ based on Wade Johnson's work 

needs zstrings 
needs toolkit 
needs struct

hex 
1 0 2constant serSetFlagStopBitsM 
0 0 2constant serSetFlagStopBits1 
1 0 2constant serSetFlagStopBits2 
2 0 2constant serSetFlagParityOnM 
4 0 2constant serSetFlagParityEvenM 
8 0 2constant serSetFlagXonXoffM 
10 0 2constant serSetFlagRTSAutoM 
20 0 2constant serSetFlagCTSAutoM 
C0 0 
2constant serSetFlagBitsPerCharM 
0 0 2constant serSetFlagBitsPerChar5 
40 0 
2constant serSetFlagBitsPerChar6 
80 0 
2constant serSetFlagBitsPerChar7 
C0 0 
2constant serSetFlagBitsPerChar8 
decimal 

: 2or ( d1. d2. -- d3. ) 
rot or rot rot or swap ; 

serSetFlagBitsPerChar8 
serSetFlagStopBits1 2or 
serSetFlagRTSAutoM 2or 
2constant serDefaultSettings 
500 constant serDefaultCTSTimeout 

1 constant serLnErrParity 
2 constant serLnErrHWOverrun 
4 constant serLnErrFraming 
8 constant serLnErrBreak 
16 constant serLnErrHShake 
32 constant serLnErrSWOverrun 

variable SerLib# 
variable serErr 

\ Iinit the serial library: 
: InitSerLib ( -- err ) 
SerLib# >abs 
z" Serial Library" drop >abs 
SysLibFind ; 

: serSysTrap ( # -- ) 
SerLib# @ swap systrap drop ; 

: serSysTrap2n ( a b # -- n ) 
serSysTrap 2drop d0.L drop ; 

: serSysTrap4n ( a b c d # -- n ) 
serSysTrap 4drop d0.L drop ; 

: serClearErr ( -- ) 
43016 serSysTrap ; 

: serOpen ( baud. -- err ) 
0 43009 serSysTrap 3drop d0.L drop ; 

: serClose ( -- err ) 
43010 serSysTrap d0.L drop ; 

\ OS 1.0 send routines 
: serSend10A ( &addr. len. -- err ) 
2swap 43017 serSysTrap4n ; 

: str>lstr ( &addr len -- &addr. len. ) 
>r >abs r> 0 ; 

: serSend10 ( &addr len -- err ) 
str>lstr serSend10A ; 

\ OS 2.0 send routines 
: serSendA ( &addr. len. -- #. err ) 
2swap 2>r serErr >abs 
2swap 2r> 
43031 serSysTrap 4drop 
@a d0.L rot ; 

: serSend ( &addr len -- #. err ) 
str>lstr serSendA ; 

: serSendWait ( -- err ) 
-1. 43018 serSysTrap2n ; 

\ Timeout for receive commands: 
2variable SerRecvTO 
-1. SerRecvTO 2! 

: set-timeout ( timeout. -- ) 
SerRecvTO 2! ; 

: get-timeout ( -- timeout. ) 
SerRecvTO 2@ ; 

\ OS 1.0 receive routines 
: serRecv10A ( &addr. len. -- err ) 
2swap 2>r get-timeout 
2swap 2r> 
43021 serSysTrap 6drop d0.L drop ; 

: serRecv10 ( &addr len -- err ) 
str>lstr serRecv10A ; 

\ OS 2.0 receive routines 
: serRecvA ( &addr. len. -- #. err ) 
2swap 2>r 2>r SerErr >abs 
get-timeout 2r> 2r> 
43032 serSysTrap 6drop @a d0.L rot ; 

: serRecv ( addr cnt -- #. err ) 
str>lstr serRecvA ; 

2variable templong 0. templong 2! 
: serRecvCheck ( -- bytes. err ) 
tempLong >abs 
43023 serSysTrap 2@a d0.L drop ; 

: serRecvFlush ( -- ) 
get-timeout 
43024 serSysTrap 2drop ; 

: serRecvWaitA ( bytes. -- err ) 
get-timeout 2swap 
43022 serSysTrap4n ; 

: serRecvWait ( bytes -- err ) 
0 serRecvWaitA ; 

\ warning: bug in OS 2.0 
: serSetRecvBuffA 
( &addr. len. -- err ) 
swap 2swap 43025 serSysTrap4n ; 

: serSetRecvBuff ( &addr len -- err ) 
str>lstr serSetRecvBuffA ; 

variable ctsOn variable dsrOn 
: serGetStatus ( -- cts dsr err ) 
dsrOn >abs ctsOn >abs 
43015 serSysTrap4n 
ctsOn c@ dsrOn c@ rot ; 

struct 
2 cells field serSet.baud 
2 cells field serSet.flags 
2 cells field serSet.ctsTO 
end-struct serSettings: 

: serGetSettings ( &settings -- err ) 
>abs 43013 serSysTrap2n ; 

: serSetSettings ( &settings -- err ) 
>abs 43014 serSysTrap2n ; 

: cts? ( -- flag ) (hex) fffff906. @a 
1 9 lshift and 0= 0= ;