[OpenSPARC-T2-SAM] / obp / obp / dev / serial / mode-decode.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: mode-decode.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
\ id: @(#)mode-decode.fth 1.4 00/03/15
\ purpose: 
\ copyright: Copyright 1995 Sun Microsystems, Inc.  All Rights Reserved
\
\ common serial line driver code to cope with serial configuration
\
hex
headerless

\ The normal routines that print
: (.tty-bad-baud) ( str,len -- 0 flag ) ." Bad baud rate: " type cr 0 true ;
: (.tty-bad-field) ( flag thing adr,len -- flag thing )
  type ."  '" emit ascii ' emit cr drop true 0
;

\ The silent routines that return status
: (tty-bad-field) ( flag thing adr,len -- flag thing ) 2drop 2drop true 0 ;
: (tty-bad-baud) ( str,len -- 0 flag ) 2drop 0 true ;

instance defer .tty-bad-baud
instance defer .tty-bad-field

: silent-parse ( -- )
   ['] (tty-bad-baud)   is .tty-bad-baud
   ['] (tty-bad-field)	is .tty-bad-field
;
: normal-parse ( -- )
   ['] (.tty-bad-baud)	is .tty-bad-baud
   ['] (.tty-bad-field)	is .tty-bad-field
;

: $dnumber ( adr,len -- number,false|true )
  base @ >r				( adr,len )
  d# 10 base ! $number			( number,false|true )
  r> base !				( number,false|true )
;

: get-baudrate ( adr,len -- reg-data error? )
  2dup $dnumber 0= if			( adr,len baud )
    dup min-baud max-baud		( adr,len baud baud min max )
    between if				( adr,len baud )
      nip nip false exit		( baud false )
    then				( adr,len baud )
    drop				( adr,len )
  then					( adr,len )
  .tty-bad-baud				( 0 error )
;

\
\ Convert Handshake into standard 'integer' form
\
: check-field ( adr,len nlen -- error? char )
  > swap c@				( flag char )
;

: get-handshake ( adr,len -- reg-data,0 | error? )
  1 check-field case			( false )
    ascii - of  hs.none  endof		\ none
    ascii h of  hs.hw    endof		\ hardware
    ascii s of  hs.sw    endof		\ software
    ( ?? ) " bad handshake" .tty-bad-field
  endcase swap				( code error? )
;

: get-stopbits ( adr,len -- reg-data,0 | error? )
  1 check-field case			( false )
    ascii 1 of  h# 01  endof		\ 1 stop bit
    ascii 2 of  h# 02  endof		\ 2 stop bits
    ( ?? ) " bad stopbits" .tty-bad-field
  endcase swap				( code error? )
;

: get-parity ( adr,len -- reg-data,0 | error? )
  1 check-field case			( false )
    ascii m of  p.mark   endof		\ mark
    ascii e of  p.even   endof		\ even
    ascii o of  p.odd    endof		\ odd
    ascii n of  p.none   endof		\ none
    ascii s of  p.space  endof		\ space
    ( ?? ) " bad parity" .tty-bad-field
  endcase swap				( code error? )
;

: get-databits ( adr,len -- reg-data,0 | error? )
  1 check-field case			( false )
    ascii 5 of  h# 05  endof
    ascii 6 of  h# 06  endof
    ascii 7 of  h# 07  endof
    ascii 8 of  h# 08  endof
    ( ?? ) " bad databits" .tty-bad-field
  endcase				( flag bits )
  1 over lshift 1- is mask-#data	( flag bits )
  swap					( bits flag )
;

: $= ( adr,len adr,len -- flag )
   rot tuck = if			( adr1 adr2 len )
      comp 0=				( flag )
   else					( adr1 adr2 len )
      3drop false			( false )
   then					( flag )
;

: 6reverse ( a b c d e f -- f e d c b a )
  swap 2swap swap 2rot swap
;

0 instance value /mode-remains
0 instance value mode-remains
0 instance value /mode$
0 instance value mode-str

: >mode$ ( str,len -- ) is /mode$ is mode-str ;

: mode$ ( -- str,len ) mode-str /mode$ ;

: mode-remains$ ( -- str,len ) mode-remains /mode-remains ;
  
: >mode-remains$ ( str,len -- ) is /mode-remains is mode-remains ;

: bail? ( data flag -- )
  if true throw else mode-remains$ >mode$ then
;

: get-field ( -- field,len )
  mode$ ascii , left-parse-string
  2swap >mode-remains$
;

instance defer (config-serial)

: mode-cleanup ( hs stp prty dbits baud rts-dtr mode -- )
  3drop 3drop drop			( )
;

\
\ scan the current line looking for ,
\ the format of the line is fixed so if I have too many or too few
\ we just bail. No device state is changed unless all the arguments
\ look reasonable and all the decode routines don't throw.
\
\ general format is: "baud,databits,parity,stopbits,handshake"
\
\ this is converted into a standard numeric format and if we are not
\ verifying we call config-serial
\ uses device specific routine
\   config-serial ( hs stp prty dbits baud -- )
\
\

: (parse-mode) ( adr len --  )
   >mode$				( )
   dtr-rts-on?				( rts? )
   get-field get-baudrate  bail?	( rts? baud )
   get-field get-databits  bail?	( rts? baud dbits )
   get-field get-parity    bail?	( rts? baud dbits prty )
   get-field get-stopbits  bail?	( rts? baud dbits prty stp )
   get-field get-handshake bail?	( rts? baud dbits prty stop hs ) 
   rs-mode-decode			( rts? baud dbits prty stop hs mode )
   >r 6reverse r> (config-serial)	( )
;

: (do-catch) ( adr,len acf -- str,len false|true )
   catch if			( adr,len )
     2drop mode$ false		( adr,len false )
   else				( )
     mode$ true			( str,len true )
   then
;

\ Now protect the stack
\ If scan? is set we still return pass/fail but with a
\ good scan we also return the remainder string
\ so the stack comments are a little misleading.
\
headers
: parse-mode ( str,len scan? -- ok? )
   dup if				( adr,len flag )
     ['] mode-cleanup			( adr,len flag set-acf )
     silent-parse			( adr,len flag set-acf )
   else					( adr,len flag )
     ['] config-serial			( adr,len flag set-acf )
     normal-parse			( adr,len flag set-acf )
   then					( adr,len flag set-acf )
   is (config-serial)			( adr,len flag )
   ['] (parse-mode) swap if		( adr,len acf )
     (do-catch)				( adr,len valid? )
   else
     (do-catch)				( adr,len valid? )
     nip nip				( valid? )
   then
;
headerless
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: mode-decode.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	\ id: @(#)mode-decode.fth 1.4 00/03/15
	43	\ purpose:
	44	\ copyright: Copyright 1995 Sun Microsystems, Inc. All Rights Reserved
	45	\
	46	\ common serial line driver code to cope with serial configuration
	47	\
	48	hex
	49	headerless
	50
	51	\ The normal routines that print
	52	: (.tty-bad-baud) ( str,len -- 0 flag ) ." Bad baud rate: " type cr 0 true ;
	53	: (.tty-bad-field) ( flag thing adr,len -- flag thing )
	54	type ." '" emit ascii ' emit cr drop true 0
	55	;
	56
	57	\ The silent routines that return status
	58	: (tty-bad-field) ( flag thing adr,len -- flag thing ) 2drop 2drop true 0 ;
	59	: (tty-bad-baud) ( str,len -- 0 flag ) 2drop 0 true ;
	60
	61	instance defer .tty-bad-baud
	62	instance defer .tty-bad-field
	63
	64	: silent-parse ( -- )
65	['] (tty-bad-baud) is .tty-bad-baud
66	['] (tty-bad-field) is .tty-bad-field
67	;
68	: normal-parse ( -- )
69	['] (.tty-bad-baud) is .tty-bad-baud
70	['] (.tty-bad-field) is .tty-bad-field
71	;
72
73	: $dnumber ( adr,len -- number,false\|true )
74	base @ >r ( adr,len )
75	d# 10 base ! $number ( number,false\|true )
76	r> base ! ( number,false\|true )
77	;
78
79	: get-baudrate ( adr,len -- reg-data error? )
80	2dup $dnumber 0= if ( adr,len baud )
81	dup min-baud max-baud ( adr,len baud baud min max )
82	between if ( adr,len baud )
83	nip nip false exit ( baud false )
84	then ( adr,len baud )
85	drop ( adr,len )
86	then ( adr,len )
87	.tty-bad-baud ( 0 error )
88	;
89
90	\
91	\ Convert Handshake into standard 'integer' form
92	\
93	: check-field ( adr,len nlen -- error? char )
94	> swap c@ ( flag char )
95	;
96
97	: get-handshake ( adr,len -- reg-data,0 \| error? )
98	1 check-field case ( false )
99	ascii - of hs.none endof \ none
100	ascii h of hs.hw endof \ hardware
101	ascii s of hs.sw endof \ software
102	( ?? ) " bad handshake" .tty-bad-field
103	endcase swap ( code error? )
104	;
105
106	: get-stopbits ( adr,len -- reg-data,0 \| error? )
107	1 check-field case ( false )
108	ascii 1 of h# 01 endof \ 1 stop bit
109	ascii 2 of h# 02 endof \ 2 stop bits
110	( ?? ) " bad stopbits" .tty-bad-field
111	endcase swap ( code error? )
112	;
113
114	: get-parity ( adr,len -- reg-data,0 \| error? )
115	1 check-field case ( false )
116	ascii m of p.mark endof \ mark
117	ascii e of p.even endof \ even
118	ascii o of p.odd endof \ odd
119	ascii n of p.none endof \ none
120	ascii s of p.space endof \ space
121	( ?? ) " bad parity" .tty-bad-field
122	endcase swap ( code error? )
123	;
124
125	: get-databits ( adr,len -- reg-data,0 \| error? )
126	1 check-field case ( false )
127	ascii 5 of h# 05 endof
128	ascii 6 of h# 06 endof
129	ascii 7 of h# 07 endof
130	ascii 8 of h# 08 endof
131	( ?? ) " bad databits" .tty-bad-field
132	endcase ( flag bits )
133	1 over lshift 1- is mask-#data ( flag bits )
134	swap ( bits flag )
135	;
136
137	: $= ( adr,len adr,len -- flag )
138	rot tuck = if ( adr1 adr2 len )
139	comp 0= ( flag )
140	else ( adr1 adr2 len )
141	3drop false ( false )
142	then ( flag )
143	;
144
145	: 6reverse ( a b c d e f -- f e d c b a )
146	swap 2swap swap 2rot swap
147	;
148
149	0 instance value /mode-remains
150	0 instance value mode-remains
151	0 instance value /mode$
152	0 instance value mode-str
153
154	: >mode$ ( str,len -- ) is /mode$ is mode-str ;
155
156	: mode$ ( -- str,len ) mode-str /mode$ ;
157
158	: mode-remains$ ( -- str,len ) mode-remains /mode-remains ;
159
160	: >mode-remains$ ( str,len -- ) is /mode-remains is mode-remains ;
161
162	: bail? ( data flag -- )
163	if true throw else mode-remains$ >mode$ then
164	;
165
166	: get-field ( -- field,len )
167	mode$ ascii , left-parse-string
168	2swap >mode-remains$
169	;
170
171	instance defer (config-serial)
172
173	: mode-cleanup ( hs stp prty dbits baud rts-dtr mode -- )
174	3drop 3drop drop ( )
175	;
176
177	\
178	\ scan the current line looking for ,
179	\ the format of the line is fixed so if I have too many or too few
180	\ we just bail. No device state is changed unless all the arguments
181	\ look reasonable and all the decode routines don't throw.
182	\
183	\ general format is: "baud,databits,parity,stopbits,handshake"
184	\
185	\ this is converted into a standard numeric format and if we are not
186	\ verifying we call config-serial
187	\ uses device specific routine
188	\ config-serial ( hs stp prty dbits baud -- )
189	\
190	\
191
192	: (parse-mode) ( adr len -- )
193	>mode$ ( )
194	dtr-rts-on? ( rts? )
195	get-field get-baudrate bail? ( rts? baud )
196	get-field get-databits bail? ( rts? baud dbits )
197	get-field get-parity bail? ( rts? baud dbits prty )
198	get-field get-stopbits bail? ( rts? baud dbits prty stp )
199	get-field get-handshake bail? ( rts? baud dbits prty stop hs )
200	rs-mode-decode ( rts? baud dbits prty stop hs mode )
201	>r 6reverse r> (config-serial) ( )
202	;
203
204	: (do-catch) ( adr,len acf -- str,len false\|true )
205	catch if ( adr,len )
206	2drop mode$ false ( adr,len false )
207	else ( )
208	mode$ true ( str,len true )
209	then
210	;
211
212	\ Now protect the stack
213	\ If scan? is set we still return pass/fail but with a
214	\ good scan we also return the remainder string
215	\ so the stack comments are a little misleading.
216	\
217	headers
218	: parse-mode ( str,len scan? -- ok? )
219	dup if ( adr,len flag )
220	['] mode-cleanup ( adr,len flag set-acf )
221	silent-parse ( adr,len flag set-acf )
222	else ( adr,len flag )
223	['] config-serial ( adr,len flag set-acf )
224	normal-parse ( adr,len flag set-acf )
225	then ( adr,len flag set-acf )
226	is (config-serial) ( adr,len flag )
227	['] (parse-mode) swap if ( adr,len acf )
228	(do-catch) ( adr,len valid? )
229	else
230	(do-catch) ( adr,len valid? )
231	nip nip ( valid? )
232	then
233	;
234	headerless