1{- 
2  BitFieldDriver: Mackerel backend for device drivers using bitfields
3
4  This driver is deprecated: please use the ShiftDriver (and
5  associated different language bindings) instead.  Functionality of
6  this driver across different compiler revisions and/or processor
7  architectures is not guaranteed (or, indeed, likely).
8   
9  Part of Mackerel: a strawman device definition DSL for Barrelfish
10   
11  Copyright (c) 2007-2010, ETH Zurich.
12  All rights reserved.
13  
14  This file is distributed under the terms in the attached LICENSE file.
15  If you do not find this file, copies can be found by writing to:
16  ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich. Attn: Systems Group.
17-}  
18
19module BitFieldDriver where
20
21import System.IO
22import System.Exit
23import Data.List
24import Text.Printf
25import MackerelParser
26import Checks
27
28import Attr
29import Space
30import qualified CSyntax as C
31import qualified TypeName as TN
32import qualified TypeTable as TT
33import qualified RegisterTable as RT
34import qualified Fields
35import qualified Dev
36import qualified Data.Maybe
37
38--
39-- Take a list of scope names and translate to a C identifier. 
40-- 
41
42qual_trec :: TT.Rec -> [ String ] -> String
43qual_trec t l = qual_name (TT.tt_name t) l 
44
45qual_name :: TN.Name -> [ String ] -> String
46qual_name (TN.Name dn tn) l = concat $ intersperse "_" ([dn, tn] ++ l) 
47
48--
49-- Language mapping: C type and name definitions
50--
51dev_t = "__DN(t)"
52dev_init = "__DN(initialize)"
53dev_pr = "__DP(pr)"
54dev_reg_ptr n = n ++ " *"
55dev_ptr = dev_t ++ " *"
56dev_tp d = d ++ "_t"
57
58reg_nm n         = "__DP(" ++ n ++ ")"      -- Name of a register 
59reg_wr n         = (reg_nm (n ++ "_wr"))    -- Fn to write a register
60field_wr n f     = (reg_nm (n ++ "_" ++ f ++ "_wrf"))    -- Fn to write a register
61reg_wr_raw n     = (reg_nm (n ++ "_wr_raw"))
62reg_init n       = (reg_nm (n ++ "_init"))
63reg_rd n         = (reg_nm (n ++ "_rd"))    -- Fn to read a register
64reg_rd_raw n     = (reg_nm (n ++ "_rd_raw"))    -- Fn to read a raw register
65reg_rds n        = (reg_nm (n ++ "_rd_shadow")) -- Read a register's shadow
66reg_pv tn        = qual_name tn ["prtval"]    -- Fn to print a regtype type
67reg_pr n         = (reg_nm (n ++ "_pr"))    -- Fn to print a register contents
68reg_pri n         = (reg_nm (n ++ "_pri"))    -- Fn to print an array element
69reg_chk n        = (reg_nm (n ++ "_chk"))   -- Fn to check data type to be written on that register
70reg_fd n         = (reg_nm (n ++ "_fd"))   -- field read access
71reg_addr n       = (reg_nm (n ++ "_addr"))
72reg_len n       = (reg_nm (n ++ "_length"))
73
74reg_t tn = qual_name tn ["t"]           -- Name of a register type
75reg_un  tn = qual_name tn ["un"]         -- Name of a union type
76
77enum_nm :: String -> String
78enum_nm n = "__DP(" ++ n ++ ")"
79enum_t tn = qual_name tn ["t"]
80enum_pr tn = qual_name tn ["prt"]
81enum_chk tn = qual_name tn ["chk"]
82
83shadow nm = nm ++ "_shadow"
84
85--
86-- Rendering of Mackerel-specific constructs
87-- 
88
89-------------------------------------------------------------------------
90-- Top-level header file rendering code
91-------------------------------------------------------------------------
92
93r_preamble dev = 
94    "/*\n * DEVICE DEFINITION: " ++ (Dev.desc dev) ++ "\n\
95    \ * \n\
96    \ * Copyright (c) 2007, ETH Zurich.\n\
97    \ * All rights reserved.\n\
98    \ * \n\
99    \ * This file is distributed under the terms in the attached LICENSE\n\
100    \ * file. If you do not find this file, copies can be found by\n\
101    \ * writing to:\n\
102    \ * ETH Zurich D-INFK, Haldeneggsteig 4, CH-8092 Zurich.\n\
103    \ *  Attn: Systems Group.\n\
104    \ * \n\
105    \ * THIS FILE IS AUTOMATICALLY GENERATED: DO NOT EDIT!\n\
106    \ */\n\n"
107
108-- Top-level create-a-header-file
109compile infile outfile dev =
110    let dd = device_def dev ""
111    in (r_preamble dev) ++ (C.header_file (Dev.name dev) dd)
112
113-- translation function mapped to every argument, for generic conversion
114-- (eg. types or names) before rendering those arguments in C code
115
116convert_arg (Arg "addr" x) = Arg "mackerel_addr_t" x
117convert_arg (Arg "pci" x) = Arg "mackerel_pci_t" x
118convert_arg (Arg "io" x) = Arg "mackerel_io_t" x
119
120-- Body of the generated file
121device_def dev header = 
122    unlines ( std_header_files ++
123              (device_prefix_defs (Dev.name dev)) ++   -- Macros
124              (concat [ constants_decl d | d@(TT.ConstType {}) <- (Dev.types dev)]) ++
125              (concat [ regtype_decl d | d@(TT.RegFormat {}) <- (Dev.types dev) ]) ++
126              (concat [ datatype_decl d | d@(TT.DataFormat {}) <- (Dev.types dev) ]) ++
127              (device_struct_def dev) ++
128              (device_init_def dev) ++
129              (space_includes dev header) ++
130              (concat [ register_decl d | d <- (Dev.registers dev) ] ) ++
131              (device_print dev) ++
132              (device_prefix_undefs (Dev.name dev))   -- Undefine macros
133              )
134
135-- Undefine macros used by the header file
136device_prefix_undefs :: String -> [String]
137device_prefix_undefs name = 
138    [ (C.undef ("__" ++ n)) | n <- [ "DN", "DP", "DP1", "DP2", "STR", "XTR" ] ] 
139
140-- Define macros used by the header file
141device_prefix_defs :: String -> [String]
142device_prefix_defs name = 
143    (device_prefix_undefs name)
144    ++
145    [ printf "#define __DN(x) %s ## _ ## x" name,
146      printf "#ifdef %s_PREFIX" name,
147      printf "#define __DP(x) __DP1(x,%s_PREFIX)" name,
148      "#define __DP1(x1,x2) __DP2(x1,x2)",
149      "#define __DP2(x1,x2) x2 ## x1",
150      "#else",
151      printf "#define __DP(x) %s##_ ##x" name,
152      "#endif",
153      "#define __STR(x) #x",
154      "#define __XTR(x) __STR(x)"
155    ]
156
157-- Header files info
158std_header_files = [ "#include <mackerel/mackerel.h>", "#include <inttypes.h>" ]
159             
160-- Device representation structure generator              
161device_struct_def :: Dev.Rec -> [String]
162device_struct_def d =
163    [ C.multi_comment "Device representation structure",
164      C.typedef dev_t (unlines strct) ]
165    where
166      args = map convert_arg (Dev.args d)
167      strct = C.struct dev_t ( [ C.comment "Device arguments" ]
168                               ++
169                               [ (C.struct_field n v) | Arg n v <- args ]
170                               ++
171                               [ C.comment "Shadow registers" ]
172                               ++
173                               [ device_struct_shadow s | s <- (Dev.shdws d)]
174                               )
175    
176device_struct_shadow (RT.Shadow n t) 
177    | TN.is_builtin_type t = C.struct_field (builtin_to_c t) (shadow n)
178    | otherwise = C.struct_field (reg_un t) (shadow n)
179
180device_init_shadow (RT.Shadow n t)
181    | TN.is_builtin_type t = printf "_dev->%s = %s;" (shadow n) "0x0"
182    | otherwise = printf "_dev->%s.raw = %s;" (shadow n) "0x0" 
183
184-- Device init function 
185device_init_def :: Dev.Rec -> [String]
186device_init_def d = 
187    let tn = dev_tp (Dev.name d)
188        args = map convert_arg (Dev.args d)
189    in
190      [ C.multi_comment "Device Initialization function\n",
191        C.inline "void" dev_init 
192             ([(dev_ptr,"_dev")] ++ [ (n,v) | (Arg n v) <- args ] )
193             ([ "/* Setting up device arguments*/" ] 
194              ++   
195              [ printf "_dev->%s = %s;" v v | (Arg n v)<- args ] 
196              ++
197              [ "/* Setting up shadow registers*/" ] 
198              ++
199              [ device_init_shadow s | s <- (Dev.shdws d)]
200             )
201      ]
202
203device_print :: Dev.Rec -> [String]
204device_print d = 
205    [ C.inline "int" dev_pr
206                   ( [ ("char *","s"), ("size_t","sz"), (dev_t, "* _dev") ] )
207                   ( ["int r=0;",
208                      "int _avail, _rc;" ] ++
209                     (C.snputsq "-------------------------\\n") ++
210                     (C.snputsq (printf "Dump of device %s (%s):\\n" (Dev.name d) (percent_escape (Dev.desc d)))) ++ 
211                     (concat [ device_print_eachreg r | r <- (Dev.registers d)]) ++
212                     (C.snputsq (printf "End of dump of device %s\\n" (Dev.name d))) ++
213                     (C.snputsq "-------------------------\\n") ++
214                     [ "return r;" ]
215                   ) ]
216
217device_print_eachreg reg = 
218    C.snlike (reg_pr (RT.name reg)) "_dev"
219
220space_includes d header
221    | header /= "" =
222        [ C.comment "Space access include file overridden by cmd line:",
223          C.include_local header ]
224    | all Space.is_builtin (Dev.spaces d) = 
225        [ C.comment "No user-defined spaces" ]
226    | otherwise = 
227        [ C.comment "Include access functions for user-defined spaces",
228          C.include_local $ printf "%s_spaces" (Dev.name d) ]
229
230-------------------------------------------------------------------------
231-- Render 'constants' declarations
232-------------------------------------------------------------------------
233
234constants_decl :: TT.Rec -> [String]
235constants_decl c = [ (constants_comment c),
236                  (constants_typedef c),
237                  (constants_print_fn c),
238                  (constants_check_fn c) ]
239      
240constants_comment c = 
241    C.multi_comment (printf "Constant definition: %s (%s)" (TT.type_name c) (TT.tt_desc c))
242    
243constants_typedef c = 
244    C.enum (enum_t (TT.tt_name c)) [ (enum_nm(TT.cname v), 
245                                   (C.expression (TT.cval v)) )
246                                  | v <- (TT.tt_vals c) ]
247
248constants_print_fn c = 
249    let etype = enum_t (TT.tt_name c)
250    in
251      C.inline "int" 
252           (enum_pr (TT.tt_name c))
253           [ ("char *","s"), ("size_t","sz"), (etype,"e") ]  
254            (constants_print_body etype (TT.tt_vals c))
255
256
257constants_print_body etype vals = 
258    C.switch "e" 
259         [ ( (enum_nm (TT.cname v)), 
260             printf "return snprintf(s, sz, \"%%s\", \"%s\");" (TT.cdesc v) )
261               | v <- vals ]
262         (printf "return snprintf(s, sz, \"Unknown \" __XTR(%s) \" value 0x%%\" PRIxPTR, (uintptr_t)e);" etype )
263
264constants_check_fn c =
265    let etype = enum_t (TT.tt_name c)
266    in
267      C.inline "int" 
268           (enum_chk (TT.tt_name c))
269            [(etype,"e") ] 
270            (constants_check_body etype (TT.tt_vals c))
271    
272constants_check_body etype vals =  
273    C.switch "e"
274     [ ((enum_nm (TT.cname v)), "return 1;") | v <- vals ]
275     "return 0;" 
276
277-------------------------------------------------------------------------
278-- Render 'register type definitions
279-------------------------------------------------------------------------
280
281builtin_to_c :: TN.Name -> String
282builtin_to_c tn = (TN.typeName tn) ++ "_t"
283
284round_field_size w 
285    | w <= 8 =                  "uint8_t" 
286    | ( w > 8 && w <= 16 ) =    "uint16_t" 
287    | ( w > 16 && w <= 32 ) =   "uint32_t" 
288    | (w > 32 && w <= 64) =     "uint64_t"      
289
290regtype_decl (TT.RegFormat tname size td desc _) =
291    let rtype = reg_t tname
292        rname = reg_nm $ TN.typeName tname
293        rtype_ptr = dev_reg_ptr rtype 
294        sz = round_field_size size
295    in
296      [ (C.multi_comment ("Register type: " ++ desc )),
297        (regtype_dump rtype td),
298        (regtype_struct rtype td),
299        (regtype_assert rtype td sz),
300        (regtype_union  tname td sz),
301        (regtype_print_fn tname rtype td rname)
302      ] 
303
304
305regtype_dump rtype td =
306    C.multi_comment ( "Dump of fields for register type: " ++ rtype ++ "\n" ++ 
307                      unlines([ field_dump f | f <- td ] ))
308
309-- The type (bitfield) definition of the register type
310regtype_struct rtype td = 
311    C.packed_typedef rtype (unlines ( C.bitfields rtype (fields td) ))
312
313regtype_assert rtype td sz =
314    C.assertsize rtype sz
315
316-- A union comprising the bitfield and a similarly-sized integer type
317regtype_union tn td sz = 
318    let un = (reg_un tn)
319    in
320      C.typedef un (unlines ( C.union un [C.union_field (reg_t tn) "val",
321                                          C.union_field sz "raw"
322                                        ] ))
323
324fields td = 
325    [ C.bitfield (Fields.name f) (Fields.size f) (field_type f) | f <- td ]
326
327field_type f 
328    | Fields.tpe f == Nothing = round_field_size $ Fields.size f
329    | otherwise = reg_t $ Data.Maybe.fromJust $ Fields.tpe f
330
331-- Print out a value of the register type
332regtype_print_fn :: TN.Name -> String -> [Fields.Rec] -> String -> String
333regtype_print_fn tn rtype td rname = 
334    C.inline "int" (reg_pv tn) 
335         ( [ ("char *","s"), ("size_t","sz"), (rtype, "v") ] )
336         ( ["int r=0;",
337            "int _avail, _rc;" ] ++
338           concat [ field_print f  | f <- td, not $ Fields.is_anon f ] ++
339           ["return r;" ]
340         )
341
342field_print :: Fields.Rec -> [String]
343field_print f = 
344    case Fields.tpe f of
345      Nothing -> 
346          C.snprintf (printf "\" %s=0x%s (%s)\\n\", (%s)(v.%s)"  
347                             (Fields.name  f)
348                       (field_fmt_str $ Fields.size f)
349                       (percent_escape $ Fields.desc f)
350                       (round_field_size $ Fields.size f) 
351                       (Fields.name f) )
352      Just t -> 
353          (C.snputsq (printf " %s=" (Fields.name f))) 
354          ++
355          (C.snlike (enum_pr t) ("v." ++ (Fields.name f)))
356          ++
357          (C.snputsq (printf " (%s)\\n" (Fields.desc f)))
358    
359field_fmt_str size 
360    | size <= 8 = "%\"PRIx8\""
361    | size <= 16 = "%0\"PRIx16\""
362    | size <= 32 = "%0\"PRIx32\""
363    | otherwise = "%0\"PRIx64\""
364
365percent_escape :: String -> String
366percent_escape s = concat [ if c == '%' then "%%" else [c] | c <- s ]
367
368-------------------------------------------------------------------------
369-- Render data type definitions
370-------------------------------------------------------------------------
371
372datatype_decl (TT.RegFormat tname size td desc _) =
373    let rtype = reg_t tname
374        rname = reg_nm $ TN.typeName tname
375        rtype_ptr = dev_reg_ptr rtype 
376        sz = round_field_size size
377    in
378      [ (C.multi_comment ("Data type: " ++ desc )),
379        (regtype_struct rtype td),
380        (regtype_print_fn tname rtype td rname)
381      ] 
382      
383datatype_decl _ = []
384
385-------------------------------------------------------------------------
386-- Render register definitions
387-------------------------------------------------------------------------
388
389register_decl :: RT.Rec -> [String]
390register_decl r =
391    case (RT.tpe r) of 
392      (TT.RegFormat tname sz _ tdesc _) -> 
393          [ C.multi_comment (printf "Register %s (%s); type %s (%s)" 
394                                        (RT.name r)
395                                        (RT.desc r)
396                                        (TN.toString $ RT.typename r)
397                                        (TT.tt_desc (RT.tpe r))),
398            -- (show (RT.extents r)),
399            (register_dump r),
400            (register_length r),
401            (register_read_raw r),
402            (register_read r),
403            (register_write_raw r),
404            (register_write r),
405            (register_write_fields r),
406            (register_print_fn r)
407          ] 
408      (TT.Primitive tname sz _) ->
409          [ (C.multi_comment (printf "Register %s (%s); type %s" 
410                                     (RT.name r)
411                                     (RT.desc r)
412                                     (TN.toString $ RT.typename r))),
413            -- (show (RT.extents r)),
414            (register_length r),
415            (register_read_raw r),
416            (register_read_builtin r),
417            (register_write_raw r),
418            (register_write_builtin r),
419            (register_write_fields r),
420            (register_print_fn r)
421          ] 
422      (TT.ConstType {}) -> 
423        []
424      (TT.DataFormat {}) -> 
425        []
426
427    
428
429-- Refer to a shadow copy of the register
430reg_shadow_ref r = "_dev->" ++
431                   (shadow (RT.name r)) ++
432                   (if RT.is_array r then "[_i]" else "")
433          
434-- Get the arguments right for array- and non-array registers
435register_args pre r post = 
436    pre ++ 
437            [ (dev_ptr, "_dev") ] ++
438            ( if RT.is_array r then [("int","_i")] else [] ) ++ post
439
440-- Now, code to read and write raw values.  These are inlined into the
441-- various "real" routines below
442loc_read :: RT.Rec -> String
443loc_read r = 
444    case RT.spc r of
445      (Builtin n _ t) -> 
446          (printf "mackerel_read_%s_%s(_dev->%s,%s)" 
447                  n (show (RT.size r)) (RT.base r)
448                        (loc_array_off t (RT.offset r) (RT.arr r) (RT.size r)))
449      (Defined n a _ _ t p) -> 
450          (printf "__DP(%s_read_%s)(_dev, %s)" 
451                      n (show (RT.size r)) 
452                      (loc_array_off t (RT.offset r) (RT.arr r) (RT.size r)))
453
454loc_array_off :: Space.SpaceType -> Integer -> ArrayLoc -> Integer -> String
455loc_array_off _ off (ArrayListLoc []) _ = 
456    printf "(0x%0x)" off
457loc_array_off (Space.BYTEWISE s) off (ArrayStepLoc num 0) sz = 
458    printf "(0x%0x) + (_i *(%s/8))" off (show (sz `div` s))
459loc_array_off Space.VALUEWISE off (ArrayStepLoc num 0) _ = 
460    printf "(0x%0x) + (_i)" off
461loc_array_off _ off (ArrayStepLoc num step) _ = 
462    printf "(0x%0x) + (_i * %d)" off step
463loc_array_off t off (ArrayListLoc locations) sz = 
464    (show locations)
465
466
467loc_write :: RT.Rec -> String -> String
468loc_write r val = 
469    case RT.spc r of
470      (Builtin n _ t) -> 
471          (printf "mackerel_write_%s_%s(_dev->%s,%s,%s)" 
472                  n 
473                  (show (RT.size r)) 
474                  (RT.base r)
475                  (loc_array_off t (RT.offset r) (RT.arr r) (RT.size r))
476                  val
477          )
478      (Defined n a _ _ t p) -> 
479          (printf "__DP(%s_write_%s)(_dev, %s,%s)" 
480                  n 
481                  (show (RT.size r)) 
482                  (loc_array_off t (RT.offset r) (RT.arr r) (RT.size r))
483                  val
484          )
485
486register_length r 
487    | RT.is_array r = C.constint (reg_len (RT.name r)) (RT.num_elements r)
488    | otherwise = ""
489
490register_dump r =
491    C.multi_comment ( "Dump of fields for register: " ++ (RT.name r) ++ "\n" ++
492                      unlines([ field_dump f | f <- (RT.fl r)] ))
493
494field_dump :: Fields.Rec -> String
495field_dump f =
496    (printf "  %s (size %d, offset %d):\t %s\t  %s") 
497    (Fields.name f)
498    (Fields.size f)
499    (Fields.offset f)
500    (show $ Fields.attr f)
501    (Fields.desc f )
502
503register_read_raw r
504    | RT.is_readable r = 
505        C.inline (round_field_size (RT.size r)) (reg_rd_raw (RT.name r) )
506             (register_args [] r [])
507             [ "return " ++ (loc_read r) ++ ";" ]
508    | otherwise = 
509        C.comment( "Register " ++ (RT.name r) ++ " is not readable" )
510
511register_read r
512    | RT.is_readable r =
513        C.inline (reg_t (RT.typename r)) (reg_rd (RT.name r)) 
514             (register_args [] r [])
515             ( [ (reg_un (RT.typename r)) ++ "  u;",
516                 "u.raw = " ++ (loc_read r) ++ ";",
517                 "return u.val;" ] )
518    | otherwise = 
519        C.inline (reg_t (RT.typename r)) (reg_rds (RT.name r)) 
520             (register_args [] r [])
521             ( [ "return " ++ (reg_shadow_ref r) ++ ".val;" ] )
522
523register_read_builtin r
524    | RT.is_readable r =
525        C.inline (builtin_to_c (RT.typename r)) (reg_rd (RT.name r)) 
526             (register_args [] r [])
527             ( [ "return " ++ (loc_read r) ++ ";" ] )
528    | otherwise = 
529        C.inline (builtin_to_c (RT.typename r)) (reg_rds (RT.name r))
530             (register_args [] r [])
531             ( [ "return " ++ (reg_shadow_ref r) ++ ";" ] )
532
533register_write_raw r
534    | RT.is_writeable r = 
535        C.inline "void" (reg_wr_raw (RT.name r)) 
536             (register_args [] r [ ((round_field_size (RT.size r)), "val") ])
537             [ (loc_write r "val") ++ ";" ]
538    | otherwise = 
539        C.comment( "Register " ++ (RT.name r) ++ " is not writeable" )
540
541register_write r
542    | RT.is_writeable r = 
543        C.inline "void" (reg_wr (RT.name r)) 
544             (register_args [] r [ ((reg_t (RT.typename r)), "val") ])
545             ( [ (reg_un (RT.typename r)) ++ "  u;" ] 
546               ++ 
547               (reg_write_init_value r)
548               ++
549               (reg_write_mbz_value r)
550               ++
551               (reg_write_mb1_value r)
552               ++
553               [ (loc_write r "u.raw") ++ ";" ]
554               ++
555               ( if RT.needs_shadow r 
556                 then [ (reg_shadow_ref r) ++ ".val = u.val;" ]
557                 else [] )
558             )
559    | otherwise = 
560        []
561
562register_write_fields r = 
563    unlines [ field_write_fn r f | f <- (RT.fl r), Fields.is_writeable f ]
564
565-- This is actually WRONG.  We should actually initialize the value to
566-- be written properly.  
567-- 1) If there are write-only fields (other than f) load u.raw from shadow. 
568-- 2) If there are rw fields (other than f) load u.raw from register.
569-- 2a) If there are both, copy fields from one to the other. 
570-- 3) Initialize the other fields (mbz, mb1, f)
571-- 4) Do the write. 
572field_write_fn r f = 
573    C.inline "void" (field_wr (RT.name r) (Fields.name f))
574         (register_args [] r [ (field_type f, "val") ])
575             ( [ (reg_un (RT.typename r)) ++ "  u;" ] 
576               ++ 
577               (if (any (\x -> ((Fields.name x) /= (Fields.name f) && field_must_be_preread x)) (RT.fl r) )
578               then [ "u.raw = " ++ (loc_read r) ++ ";" ]
579               else [])
580               ++
581               [ copy_shadow_field x r | x <- RT.fl r, 
582                                            (Fields.name x) /= (Fields.name f),
583                                            Fields.is_writeonly x 
584               ]
585               ++
586               (reg_write_mbz_value r)
587               ++
588               (reg_write_mb1_value r)
589               ++
590               [ "u.val." ++ (Fields.name f) ++ " = val;" ]
591               ++
592
593               [ (loc_write r "u.raw") ++ ";" ]
594               ++
595               ( if RT.needs_shadow r 
596                 then [ (reg_shadow_ref r) ++ ".val = u.val;" ]
597                 else [] )
598             )
599copy_shadow_field :: Fields.Rec -> RT.Rec -> String
600copy_shadow_field f r = printf "u.val.%s = %s.val.%s;" 
601                        (Fields.name f) 
602                        (reg_shadow_ref r) 
603                        (Fields.name f)
604
605field_must_be_preread :: Fields.Rec -> Bool
606field_must_be_preread f 
607    | Fields.attr f == RSVD = True
608    | otherwise = (Fields.is_readable f) && (Fields.is_writeable f)
609
610register_write_builtin r
611    | RT.is_writeable r = 
612        C.inline "void" (reg_wr (RT.name r))
613             (register_args [] r [ ((builtin_to_c (RT.typename r)), "val") ])
614              ( [ (loc_write r "val") ++ ";" ] 
615                ++
616                (if RT.needs_shadow r 
617                 then [ (reg_shadow_ref r) ++ " = val;" ]
618                 else []
619                )
620              )
621    | otherwise = 
622        []
623
624reg_write_init_value r
625    | RT.needs_read_before_write r = 
626        (if RT.is_readable r
627         then "u.raw = " ++ (loc_read r) ++ ";"
628         else "u.raw = " ++ (reg_shadow_ref r) ++ ".raw;" )
629      :[ printf "u.val.%s \t= val.%s;" (Fields.name f) (Fields.name f)
630             | f <- (RT.fl r), not (Fields.is_rsvd f) ]
631    | otherwise =
632        [ "u.val = val;" ]
633
634reg_write_mbz_value r = 
635    [ (printf "u.val.%s \t= 0;") (Fields.name f) 
636          | f <- RT.fl r, (Fields.attr f) == MBZ ]
637
638reg_write_mb1_value r = 
639    [ (printf "u.val.%s \t= -1;") (Fields.name f) 
640          | f <- RT.fl r, (Fields.attr f) == MB1 ]
641
642-- Print out a value of the register type
643register_print_fn :: RT.Rec -> String
644register_print_fn r 
645    | RT.is_array r = 
646        (register_print_array_element r) ++ (register_print_array r)
647    | otherwise = 
648        (register_print_single r) 
649
650register_print_array_element r = 
651    C.inline "int" (reg_pri (RT.name r))
652         ( register_args [ ("char *","s"), ("size_t","sz") ] r [] )
653         ( ["int r=0;",
654            "int _avail, _rc;" ] ++
655           (register_print_init r) ++
656           (C.snprintf (printf "\"Register %s[%%d] (%s):\", _i" (RT.name r) (percent_escape (RT.desc r)))) ++ 
657           (register_print_value r) ++
658           ["return r;" ]
659         )
660
661register_print_array r =
662    C.inline "int" (reg_pr (RT.name r))
663         [ ("char *","s"), ("size_t","sz"), (dev_ptr, "_dev") ]
664         ( ["int r=0;",
665            "int _avail, _rc;" ] ++
666           (C.forloop "int _i=0" 
667                 (printf "_i < 0x%0x" (RT.num_elements r))
668                 "_i++" 
669                 (C.snlike (reg_pri (RT.name r)) "_dev, _i" ) ) ++
670           ["return r;"]
671         )
672
673register_print_single r = 
674    C.inline "int" (reg_pr (RT.name r))
675         ( register_args [ ("char *","s"), ("size_t","sz") ] r [] )
676         ( ["int r=0;",
677            "int _avail, _rc;" ] ++
678           (register_print_init r) ++
679           (C.snputsq (printf "Register %s (%s):" (RT.name r) (percent_escape (RT.desc r)))) ++ 
680           (register_print_value r) ++
681           ["return r;" ]
682         )
683
684register_print_value r
685    | TT.is_primitive (RT.tpe r) = 
686        register_print_primitive r
687    | otherwise =
688        ( C.snputsq "\\n" )
689        ++ concat [ regfield_print r f | f <- (RT.fl r) ]
690
691register_print_primitive r 
692    | RT.needs_shadow r = 
693        C.snprintf (printf "\"\\t0x%s (SHADOW copy)\\n\", %s" 
694                               (field_fmt_str (RT.size r))
695                               (reg_shadow_ref r) )
696    | otherwise = 
697        C.snprintf (printf "\"\\t0x%s\\n\", %s" 
698                               (field_fmt_str (RT.size r))
699                               (loc_read r))
700
701register_print_init r 
702    | not (RT.is_readable r) = 
703        [ C.comment "register is not readable" ]
704    | TT.is_primitive (RT.tpe r) =
705        [ C.comment "register is primitive type" ]
706    | otherwise = 
707        [ (reg_un (RT.typename r)) ++ "  u;",
708          "u.raw = " ++ (loc_read r) ++ ";" ]
709
710regfield_print :: RT.Rec -> Fields.Rec -> [ String ]
711regfield_print reg f
712    | Fields.is_anon f = 
713        [ C.comment "skipping anonymous field" ]
714    | otherwise = 
715        C.block ( [ (printf "%s pv = (%s)%s.val.%s;" 
716                                (round_field_size (Fields.size f))
717                                (round_field_size (Fields.size f))
718                                (if Fields.is_writeonly f
719                                 then
720                                     (reg_shadow_ref reg)
721                                 else
722                                     "u"
723                                )
724                                (Fields.name f))
725                  ] ++
726                  ( C.snprintf (printf "\" %s =\\t0x%s (%s%s\", pv" 
727                                           (Fields.name f)
728                                           (field_fmt_str (Fields.size f))
729                                           (if Fields.is_writeonly f
730                                            then "SHADOW of "
731                                            else "")
732                                           (percent_escape (Fields.desc f)))
733                  ) 
734                  ++ 
735                  (case (Fields.tpe f) of 
736                     Nothing -> (C.snputsq ")\\n" )
737                     Just t -> ( (C.snputsq ": ") 
738                                 ++
739                                 (C.snlike  (enum_pr t) "pv") 
740                                 ++
741                                 (C.snputsq ")\\n"))
742                  )
743                )
744
745