\ serial 99.2.20 7:30 pm NAB \ based on Wade Johnson's work needs core-ext needs zstrings needs toolkit needs struct hex 300 decimal constant serErrorClass serErrorClass dup 1 or constant serErrBadParam dup 2 or constant serErrBadPort dup 3 or constant serErrNoMem dup 4 or constant serErrBadConnID dup 5 or constant serErrTimeOut dup 6 or constant serErrLineErr dup 7 or constant serErrAlreadyOpen dup 8 or constant serErrStillOpen dup 9 or constant serErrNotOpen 10 or constant serErrNotSupported 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 drop ; : serSysTrap4n ( a b c d # -- n ) serSysTrap 4drop d0 drop ; : serClearErr ( -- ) 43016 serSysTrap ; : serOpen ( baud. -- err ) 0 43009 serSysTrap 3drop d0 drop ; : serClose ( -- err ) 43010 serSysTrap d0 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 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 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 rot ; : serRecv ( addr cnt -- #. err ) str>lstr serRecvA ; 2variable templong 0. templong 2! : serRecvCheck ( -- bytes. err ) tempLong >abs 43023 serSysTrap 2@a d0 drop ; : serRecvFlush ( -- ) get-timeout 43024 serSysTrap 2drop ; : serRecvWaitA ( bytes. -- err ) get-timeout 2swap 43023 serSysTrap4n ; : serRecvWait ( bytes -- err ) 0 serRecvWaitA ; \ warning: bug in OS 2.0 : serSetRecvBuffA ( &addr. len. -- err ) 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= ;