1. Flxcc wrapper generator

Start python section to spkgs/flxcc.py[1 /1 ]
     1: #line 5 "./lpsrc/flx_flxcc.pak"
     2: FLXCC_EXES = [ 'src/flxcc', ]
     3: caml_exes = FLXCC_EXES
     4: caml_require_libs = ['nums','unix','misclib','cillib','flxcclib','flxlib']
     5: pkg_requires = ['cil']
     6: caml_include_paths = ['src', 'src/cil']
     7: iscr_source = ["lpsrc/flx_flxcc.pak"]
     8: weaver_directory = 'doc/flxcc/'
     9: 
End python section to spkgs/flxcc.py[1]
Start ocaml section to src/flxcc.ml[1 /1 ]
     1: # 15 "./lpsrc/flx_flxcc.pak"
     2: open List
     3: open Flx_util
     4: open Flx_types
     5: open Flx_version
     6: open Flx_mtypes1
     7: open Flx_cil_cabs
     8: open Flx_cil_cil
     9: open Flxcc_util
    10: ;;
    11: 
    12: let force_open_in place f =
    13:   try
    14:     open_in f
    15:   with
    16:   |  _ -> failwith ("[" ^ place ^ "] Can't open " ^ f ^ " for input")
    17: 
    18: let force_open_out place f =
    19:   try
    20:     open_out f
    21:   with
    22:   |  _ -> failwith ("[" ^ place ^ "] Can't open " ^ f ^ " for output")
    23: 
    24: type stab_t = {
    25:   stab_cfile: string;
    26:   stab_flxfile: string;
    27:   stab_flxinclude: string;
    28:   stab_module: string;
    29: 
    30:   aliases: (string,string) Hashtbl.t;
    31:   struct_aliases: (string,string) Hashtbl.t;
    32:   abstract_types: (string,string) Hashtbl.t;
    33:   incomplete_types: (string,string) Hashtbl.t;
    34:   mutable xtyps: (string,string) Hashtbl.t;
    35:   mutable udt: (string,unit) Hashtbl.t;
    36:   mutable ict: (string,string) Hashtbl.t;
    37:   used_types: (string,unit) Hashtbl.t;
    38:   variables : (string,string) Hashtbl.t;
    39:   functions: (string * typsig list * string,string * string) Hashtbl.t;
    40:   fields: (string,string * string) Hashtbl.t;
    41:   cstructs : (string,(string * string) list) Hashtbl.t;
    42:   procedures: (string * typsig list * string,string * string) Hashtbl.t;
    43:   callback_types: (string,typ * int) Hashtbl.t;
    44:   callback_clients: (string,typ * string * int * int) Hashtbl.t;
    45:   enums: (string,string) Hashtbl.t;
    46:   registry: (typsig, string * string) Hashtbl.t;
    47:   mutable includes: StringSet.t;
    48:   counter: int ref
    49: }
    50: ;;
    51: 
    52: let isprefix p s =
    53:   let pn = String.length p in
    54:   String.length s >= pn &&
    55:   String.sub s 0 pn = p
    56: ;;
    57: 
    58: exception Next
    59: ;;
    60: type control_t = {
    61:   mutable control_filename: string;
    62:   mutable flxg_command: string;
    63:   mutable prein_filename: string;
    64:   mutable preout_filename: string;
    65:   mutable log_filename: string;
    66:   mutable language: Flx_cil_cabs.lang_t;
    67:   mutable preprocessor: string;
    68:   mutable raw_includes: StringSet.t;
    69:   mutable raw_include_dirs : StringSet.t;
    70:   mutable include_path: string list;
    71:   mutable noincludes: string list;
    72:   mutable merge_files: (string * string) list;
    73:   mutable rev_merge_files: (string,string list) Hashtbl.t;
    74:   mutable outdir: string;
    75:   mutable repl_prefix: (string * string) list;
    76:   stabs : (string,stab_t) Hashtbl.t;
    77:   all_types : (string,string) Hashtbl.t;
    78:   incomplete_types_cache: (string,string * string list) Hashtbl.t;
    79:   mutable files: StringSet.t;
    80:   replacements : (string,string) Hashtbl.t;
    81:   nontype_replacements : (string,string) Hashtbl.t;
    82:   rejects: (string,unit) Hashtbl.t;
    83:   mutable root_includes: string list;
    84:   mutable root_rec_includes: string list;
    85:   mutable root_excludes : string list;
    86: }
    87: ;;
    88: 
    89: let control = {
    90:   control_filename = Sys.argv.(1);
    91:   flxg_command = "";
    92:   prein_filename = Sys.argv.(1) ^ ".h";
    93:   preout_filename = Sys.argv.(1) ^ ".i";
    94:   log_filename = Sys.argv.(1) ^ ".log";
    95:   language = `C;
    96:   preprocessor ="cpp ";
    97:   noincludes = [];
    98:   raw_includes = StringSet.empty;
    99:   raw_include_dirs = StringSet.empty;
   100:   include_path = [];
   101:   merge_files = [];
   102:   rev_merge_files = Hashtbl.create 97;
   103:   outdir = "flxcc_out";
   104:   repl_prefix = [];
   105:   stabs  = Hashtbl.create 97;
   106:   all_types = Hashtbl.create 97;
   107:   incomplete_types_cache = Hashtbl.create 97;
   108:   files = StringSet.empty;
   109:   replacements = Hashtbl.create 97;
   110:   nontype_replacements = Hashtbl.create 97;
   111:   rejects = Hashtbl.create 97;
   112:   root_rec_includes = [];
   113:   root_includes = [];
   114:   root_excludes = [];
   115: }
   116: ;;
   117: 
   118: (* map the name of a #include file which is
   119:   intended to be a physical part of another
   120:   into that filename.
   121: 
   122:   The mapping is used to prevent
   123:   a Felix include file or module being
   124:   created for definitions in this file,
   125:   but it should *only* be used when a file
   126:   is uniquely included by another
   127: 
   128:   When we're scanning for includes,
   129:   we need all the physical (unmapped)
   130:   filenames as inputs to find the transitive
   131:   closure. Once that is done, the transitive
   132:   closure itself must be mapped to avoid
   133:   references to non-existent Felix modules.
   134: *)
   135: 
   136: let rec glob dir recurse level =
   137:   if not (mem dir control.root_excludes) then
   138:   let spaces = String.make level ' ' in
   139:   try
   140:     let f = Unix.opendir dir in
   141:     control.raw_include_dirs <- StringSet.add dir control.raw_include_dirs;
   142:     begin
   143:       try
   144:         while true do let m = Unix.readdir f in
   145:           let path = Filename.concat dir m in
   146:           let st =
   147:             try Unix.lstat path
   148:             with _ -> failwith ("Can't lstat " ^ path)
   149:           in
   150:           match st.Unix.st_kind with
   151:           | Unix.S_REG ->
   152:             if not (mem path control.root_excludes)
   153:             then begin
   154:               control.raw_includes <- StringSet.add path control.raw_includes;
   155:               control.files <- StringSet.add path control.files
   156:             end
   157: 
   158:           | Unix.S_DIR ->
   159:             if recurse then
   160:             if not (isprefix "." m) then
   161:             begin
   162:               glob path recurse (level + 1)
   163:             end
   164: 
   165:           | _ -> ()
   166:         done
   167:       with End_of_file -> Unix.closedir f
   168:     end
   169:   with Unix.Unix_error _ ->
   170:     failwith ("Can't find directory " ^ dir)
   171: ;;
   172: 
   173: let pattern = ref "*.h"
   174: ;;
   175: 
   176: let rec parse_control_file filename =
   177:   let f = force_open_in "parse_control_file" filename
   178:   in
   179:   let rec aux () =
   180:     try
   181:       let line = input_line f in
   182:       let n = String.length line in
   183:       let i = ref 0 in
   184:       try
   185:           (* skip white *)
   186:           while !i < n && line.[!i]=' ' do incr i done;
   187:           if !i = n then raise Next;
   188: 
   189:           (* detect C++ style comment *)
   190:           if isprefix "//" (String.sub line !i (n - !i))
   191:           then raise Next
   192:           ;
   193:           let j = !i in
   194:           while !i < n && line.[!i]<>' ' do incr i done;
   195:           let keyword = String.sub line j (!i-j) in
   196: 
   197:           match keyword with
   198:           | "#include" ->
   199:             while !i < n && line.[!i]=' ' do incr i done;
   200:             if !i = n then failwith "outdir statement requires filename";
   201:             let j = !i in
   202:             while !i < n && line.[!i]<>' ' do incr i done;
   203:             let fn = String.sub line j (!i-j) in
   204:             parse_control_file fn;
   205:             raise Next
   206: 
   207:           | "outdir" ->
   208:             while !i < n && line.[!i]=' ' do incr i done;
   209:             if !i = n then failwith "outdir statement requires filename";
   210:             let j = !i in
   211:             while !i < n && line.[!i]<>' ' do incr i done;
   212:             control.outdir <- String.sub line j (!i-j);
   213:             raise Next
   214: 
   215:           | "prein" ->
   216:             while !i < n && line.[!i]=' ' do incr i done;
   217:             if !i = n then failwith "prein statement requires filename";
   218:             let j = !i in
   219:             while !i < n && line.[!i]<>' ' do incr i done;
   220:             control.prein_filename <- String.sub line j (!i-j);
   221:             raise Next
   222: 
   223:           | "preout" ->
   224:             while !i < n && line.[!i]=' ' do incr i done;
   225:             if !i = n then failwith "preout statement requires filename";
   226:             let j = !i in
   227:             while !i < n && line.[!i]<>' ' do incr i done;
   228:             control.preout_filename <- String.sub line j (!i-j);
   229:             raise Next
   230: 
   231:           | "language" ->
   232:             while !i < n && line.[!i]=' ' do incr i done;
   233:             if !i = n then failwith "preout statement requires filename";
   234:             let j = !i in
   235:             while !i < n && line.[!i]<>' ' do incr i done;
   236:             let x = String.sub line j (!i-j) in
   237:             control.language <-
   238:               (
   239:                 match x with
   240:                 | "C" | "c" -> `C
   241:                 | "C++" | "c++" | "cxx" -> `Cxx
   242:                 | _ -> failwith ("Unknown language " ^ x ^", must be C or C++")
   243:               )
   244:             ;
   245:             raise Next
   246: 
   247:           | "flx_compiler" ->
   248:             while !i < n && line.[!i]=' ' do incr i done;
   249:             let j = !i in
   250:             while !i < n do incr i done;
   251:             control.flxg_command <- String.sub line j (!i-j);
   252:             raise Next
   253: 
   254:           | "preprocessor" ->
   255:             while !i < n && line.[!i]=' ' do incr i done;
   256:             if !i = n then failwith "preprocessor statement requires arguments";
   257:             let j = !i in
   258:             while !i < n do incr i done;
   259:             control.preprocessor <- String.sub line j (!i-j);
   260:             raise Next
   261: 
   262:           | "noheader" ->
   263:             while !i < n && line.[!i]=' ' do incr i done;
   264:             if !i = n then failwith "noinclude statement requires filename";
   265:             let j = !i in
   266:             while !i < n && line.[!i]<>' ' do incr i done;
   267:             let fn = String.sub line j (!i-j) in
   268:             control.noincludes <- fn :: control.noincludes;
   269:             raise Next
   270: 
   271:           | "incdir" ->
   272:             while !i < n && line.[!i]=' ' do incr i done;
   273:             if !i = n then failwith "incdir statement requires filename";
   274:             let j = !i in
   275:             while !i < n && line.[!i]<>' ' do incr i done;
   276:             let fn = String.sub line j (!i-j) in
   277:             control.root_includes <- fn :: control.root_includes;
   278:             raise Next
   279: 
   280:           | "incfile" ->
   281:             while !i < n && line.[!i]=' ' do incr i done;
   282:             if !i = n then failwith "incfile statement requires filename";
   283:             let j = !i in
   284:             while !i < n && line.[!i]<>' ' do incr i done;
   285:             let fn = String.sub line j (!i-j) in
   286:             control.raw_includes <- StringSet.add fn control.raw_includes;
   287:             raise Next
   288: 
   289:           | "recincdir" ->
   290:             while !i < n && line.[!i]=' ' do incr i done;
   291:             if !i = n then failwith "incdir statement requires filename";
   292:             let j = !i in
   293:             while !i < n && line.[!i]<>' ' do incr i done;
   294:             let fn = String.sub line j (!i-j) in
   295:             control.root_rec_includes <- fn :: control.root_rec_includes;
   296:             raise Next
   297: 
   298:           | "path" ->
   299:             while !i < n && line.[!i]=' ' do incr i done;
   300:             if !i = n then failwith "path statement requires filename";
   301:             let j = !i in
   302:             while !i < n && line.[!i]<>' ' do incr i done;
   303:             let fn = String.sub line j (!i-j) in
   304:             control.include_path <- control.include_path @ [fn];
   305:             raise Next
   306: 
   307:           | "exclude" ->
   308:             while !i < n && line.[!i]=' ' do incr i done;
   309:             if !i = n then failwith "exclude statement requires filename";
   310:             let j = !i in
   311:             while !i < n && line.[!i]<>' ' do incr i done;
   312:             let fn = String.sub line j (!i-j) in
   313:             control.root_excludes<- fn :: control.root_excludes;
   314:             raise Next
   315: 
   316:           | "prefix" ->
   317:             while !i < n && line.[!i]=' ' do incr i done;
   318:             if !i = n then failwith "prefix statement requires filename";
   319:             let j = !i in
   320:             while !i < n && line.[!i]<>' ' do incr i done;
   321:             let fn1 = String.sub line j (!i-j) in
   322: 
   323:             while !i < n && line.[!i]=' ' do incr i done;
   324:             let fn2 =
   325:               if !i = n then ""
   326:               else begin
   327:                 let j = !i in
   328:                 while !i < n && line.[!i]<>' ' do incr i done;
   329:                 String.sub line j (!i-j)
   330:               end
   331:             in
   332:             control.repl_prefix <- (fn1, fn2) :: control.repl_prefix;
   333:             raise Next
   334: 
   335:           | "merge" ->
   336:             while !i < n && line.[!i]=' ' do incr i done;
   337:             if !i = n then failwith "merge statement requires filename";
   338:             let j = !i in
   339:             while !i < n && line.[!i]<>' ' do incr i done;
   340:             let fn1 = String.sub line j (!i-j) in
   341: 
   342:             while !i < n && line.[!i]=' ' do incr i done;
   343:             if !i = n then failwith "merge statement requires 2 filenames";
   344:             let j = !i in
   345:             while !i < n && line.[!i]<>' ' do incr i done;
   346:             let fn2 = String.sub line j (!i-j) in
   347:             control.merge_files <- (fn1,fn2) :: control.merge_files;
   348:             let x =
   349:               try Hashtbl.find control.rev_merge_files fn2
   350:               with Not_found -> []
   351:             in Hashtbl.replace control.rev_merge_files fn2 (fn1::x)
   352:             ;
   353:             raise Next
   354: 
   355:           | "rename" ->
   356:             while !i < n && line.[!i]=' ' do incr i done;
   357:             if !i = n then failwith "rename statement requires name";
   358:             let j = !i in
   359:             while !i < n && line.[!i]<>' ' do incr i done;
   360:             let fn1 = String.sub line j (!i-j) in
   361: 
   362:             while !i < n && line.[!i]=' ' do incr i done;
   363:             if !i = n then failwith "rename statement requires 2 names";
   364:             let j = !i in
   365:             while !i < n && line.[!i]<>' ' do incr i done;
   366:             let fn2 = String.sub line j (!i-j) in
   367:             Hashtbl.add control.replacements fn1 fn2;
   368:             raise Next
   369: 
   370:           | "rename_nontype" ->
   371:             while !i < n && line.[!i]=' ' do incr i done;
   372:             if !i = n then failwith "rename_nontype statement requires name";
   373:             let j = !i in
   374:             while !i < n && line.[!i]<>' ' do incr i done;
   375:             let fn1 = String.sub line j (!i-j) in
   376: 
   377:             while !i < n && line.[!i]=' ' do incr i done;
   378:             if !i = n then failwith "rename_nontype statement requires 2 names";
   379:             let j = !i in
   380:             while !i < n && line.[!i]<>' ' do incr i done;
   381:             let fn2 = String.sub line j (!i-j) in
   382:             Hashtbl.add control.nontype_replacements fn1 fn2;
   383:             raise Next
   384: 
   385:           | "ignore" ->
   386:             while !i < n && line.[!i]=' ' do incr i done;
   387:             if !i = n then failwith "ignore statement requires name";
   388:             let j = !i in
   389:             while !i < n && line.[!i]<>' ' do incr i done;
   390:             let fn = String.sub line j (!i-j) in
   391:             Hashtbl.add control.rejects fn ();
   392:             raise Next
   393: 
   394:           | _ -> failwith ("Unknown keyword " ^keyword^ " in control file")
   395: 
   396:       with Next -> aux()
   397:     with End_of_file -> ()
   398:   in
   399:     aux ();
   400:     close_in f
   401: ;;
   402: parse_control_file control.control_filename
   403: ;;
   404: 
   405: iter
   406: (fun s -> glob s false 0)
   407: control.root_includes
   408: ;;
   409: 
   410: iter
   411: (fun s -> glob s true 0)
   412: control.root_rec_includes
   413: ;;
   414: 
   415: let autocreate x =
   416:   try open_out x
   417:   with | _ ->
   418:   let rec mkpath x  =
   419:     let d = Filename.dirname x in
   420:     if d <> "" then begin
   421:       try Unix.mkdir d 0o777
   422:       with _ ->
   423:         mkpath d;
   424:         try Unix.mkdir d 0o777
   425:         with _ -> failwith ("[autocreate] Can't create (p=0777) directory " ^ d)
   426:     end
   427:   in
   428:   mkpath x;
   429:   force_open_out "autocreate" x
   430: 
   431: ;;
   432: 
   433: let f = autocreate control.prein_filename in
   434: StringSet.iter
   435: (fun s ->
   436:   output_string f ("#include \"" ^ s ^ "\"\n")
   437: )
   438: control.raw_includes
   439: ;
   440: close_out f
   441: ;;
   442: 
   443: let precmd =
   444:   let path = ref "" in
   445:   (*
   446:   StringSet.iter
   447:   (fun s -> path := !path ^ "-I" ^ s ^ " ")
   448:   control.raw_include_dirs
   449:   ;
   450:   *)
   451:   path :=
   452:   (
   453:     String.concat " "
   454:     (
   455:       map
   456:       (fun s-> "-I"^s^" ")
   457:       control.include_path
   458:     )
   459:   ) ^ " " ^ !path
   460:   ;
   461: 
   462:   control.preprocessor ^ " " ^
   463:   !path ^ " " ^
   464:   control.prein_filename ^
   465:   " >" ^control.preout_filename
   466: ;;
   467: 
   468: print_endline "PREPROCESSOR COMMAND:";
   469: print_endline precmd
   470: ;;
   471: 
   472: Unix.system precmd
   473: ;;
   474: 
   475: let format_time tm =
   476:   si (tm.Unix.tm_year + 1900) ^ "/" ^
   477:   si (tm.Unix.tm_mon + 1) ^ "/" ^
   478:   si tm.Unix.tm_mday ^ " " ^
   479:   si tm.Unix.tm_hour ^ ":" ^
   480:   si tm.Unix.tm_min ^ ":" ^
   481:   si tm.Unix.tm_sec
   482: ;;
   483: 
   484: let compile_start = Unix.time ()
   485: let compile_start_gm = Unix.gmtime compile_start
   486: let compile_start_local = Unix.localtime compile_start
   487: let compile_start_gm_string = format_time compile_start_gm ^ " UTC"
   488: let compile_start_local_string = format_time compile_start_local ^ " (local)"
   489: ;;
   490: 
   491: Flx_cil_cil.initCIL()
   492: ;;
   493: 
   494: let lexbuf = Flx_cil_clexer.init control.preout_filename control.language;;
   495: let cabs = Flx_cil_cparser.file Flx_cil_clexer.initial lexbuf
   496: ;;
   497: Flx_cil_clexer.finish()
   498: ;;
   499: 
   500: (*
   501: Flx_cil_cprint.print_defs cabs;;
   502: *)
   503: 
   504: let ns (s,_,_,_) = s
   505: ;;
   506: let is_def = function | Some _ -> "complete" | None -> "incomplete"
   507: ;;
   508: let type_of_se = function
   509: | SpecType ts ->
   510:   begin match ts with
   511:   | Tnamed s -> print_endline ("type " ^ s)
   512:   | Tstruct (s,fglo,_) ->
   513:     print_endline ("struct " ^ s ^ " " ^ is_def fglo)
   514:   | Tunion (s,fglo,_) ->
   515:     print_endline ("union " ^ s ^ " " ^ is_def fglo)
   516:   | Tenum (s,fglo,_) ->
   517:     print_endline ("enum " ^ s ^ " " ^ is_def fglo)
   518:   | _ -> ()
   519:   end
   520: | _ -> ()
   521: 
   522: let types_in sp = List.iter type_of_se sp
   523: ;;
   524: 
   525: let cil = Flx_cil_cabs2cil.convFile (control.preout_filename, cabs)
   526: ;;
   527: 
   528: 
   529: (*
   530: dumpFile defaultCilPrinter stdout cil ;;
   531: *)
   532: 
   533: let {fileName=f; globals=gs} = cil
   534: ;;
   535: 
   536: (* files not corresponding to a module *)
   537: let excludes : string list ref = ref
   538: [
   539: ]
   540: ;;
   541: 
   542: let rpltname s =
   543:   try Hashtbl.find control.replacements s
   544:   with Not_found -> s
   545: 
   546: let rplname s =
   547:   try Hashtbl.find control.nontype_replacements s
   548:   with Not_found ->
   549:   try Hashtbl.find control.replacements s
   550:   with Not_found -> s
   551: 
   552: let strexp n = "0" (* cheat *)
   553: ;;
   554: 
   555: let remove_pnames t = match t with
   556: | TPtr (TFun (t,Some ps,b,a),a') ->
   557:   let ps = map (fun (_,t,a)->"",t,a) ps in
   558:   TPtr (TFun (t,Some ps,b,a),a')
   559: | _ -> t
   560: 
   561: (* strip multiple spaces and newlines out *)
   562: let reformatc s =
   563:   let s' = ref "" in
   564:   let n = String.length s in
   565:   for i=0 to n - 1 do
   566:     let
   567:       ch = s.[i] and
   568:       ch2 = if i < n-2 then s.[i+1] else '\000'
   569:     in
   570:     if
   571:       ch = ' ' &&
   572:         (ch2=' ' ||ch2=',' || ch2=';' || ch2=')' || ch2='\n')
   573:     then ()
   574:     else if ch='\n' then s' := !s' ^ " "
   575:     else s' := !s' ^ String.make 1 ch
   576:   done;
   577:   let n = ref (String.length !s' - 1) in
   578:   while !n >= 0 && !s'.[!n]=' ' do decr n done;
   579:   String.sub !s' 0 (!n+1)
   580: 
   581: let choose_alias stab s =
   582:   let ss = ref [] in
   583:   begin try
   584:     let s' = Hashtbl.find stab.aliases s in
   585:     ss := s' :: !ss
   586:   with Not_found -> ()
   587:   end
   588:   ;
   589: 
   590:   begin try
   591:     let s' = Hashtbl.find stab.struct_aliases s in
   592:     ss := s' :: !ss
   593:   with Not_found -> ()
   594:   end
   595:   ;
   596: 
   597:   (* just pick the shortest name *)
   598:   let s = s :: !ss in
   599:   let s = map (fun x -> String.length x,x) s in
   600:   let s = sort compare s in
   601:   let _,p = hd s in
   602:   p
   603: 
   604: let prefered_alias stab s = choose_alias stab s
   605: 
   606: 
   607: let rec sot stab t = match t with
   608: | TVoid a -> "void_t"
   609: | TInt (ik,a) -> soi ik
   610: | TFloat (fk,a) -> sof fk
   611: | TPtr (TVoid a',a) -> (cvqual a')^"address"
   612: | TPtr (TFun _,a) ->
   613:   let t' = typeSig t in
   614:   begin try
   615:     fst (Hashtbl.find stab.registry t')
   616:   with
   617:     Not_found ->
   618:     let name = stab.stab_module ^"_cft_" ^ si !(stab.counter) in
   619:     incr stab.counter;
   620:     let sr = locUnknown in
   621:     let t = remove_pnames t in
   622:     let si = {tname=name;ttype=t;treferenced=true } in
   623:     let gt =  GType (si,sr) in
   624:     let d = defaultCilPrinter#pGlobal () gt in
   625:     let s = Flx_cil_pretty.sprint 65 d in
   626:     let s = reformatc s in
   627:     Hashtbl.add stab.registry t' (name,s);
   628:     name
   629:   end
   630: 
   631: | TPtr (t',a) -> cvqual (attrof t') ^ "ptr[" ^ sot stab t'^ "]"
   632: | TArray (t',Some n,a)->
   633:   cvqual (attrof t') ^ "ptr[" ^ sot stab t'^ "]"
   634: 
   635: | TArray (t',None,a)->
   636:   cvqual (attrof t') ^ "ptr[" ^ sot stab t' ^ "]"
   637: 
   638: | TFun (t',Some ps,false,a) ->
   639:   let ret = sot stab t'
   640:   and args =
   641:     if length ps = 0 then "1"
   642:     else String.concat " * " (List.map (soa stab) ps)
   643:   in args ^ " -> " ^ ret
   644: 
   645: | TFun (t',None,false,a) ->
   646:   let ret = sot stab t'
   647:   and args = "1"
   648:   in args ^ " -> " ^ ret
   649: 
   650: | TFun (t',_,_,a) -> "CANT HANDLE THIS FUN"
   651: 
   652: | TNamed (ti,a) ->
   653:   let name = ptname ti in
   654:   let name = prefered_alias stab name in
   655:   Hashtbl.add stab.used_types name ();
   656:   rpltname name
   657: 
   658: | TComp (ci,a) ->
   659:   let name = pci ci in
   660:   let name = prefered_alias stab name in
   661:   Hashtbl.add stab.used_types name ();
   662:   rpltname name
   663: 
   664: | TEnum (ei,a) -> "int"
   665: | TBuiltin_va_list a -> "__builtin_va_list"
   666: 
   667: and ptdef registry ti:string = match ti with
   668: {ttype=tt} -> sot registry tt
   669: 
   670: and soa stab (name,t,a) = sot stab t
   671: 
   672: and sov registry vi = match vi with
   673: {vname=vname; vtype=vtype} ->
   674: "const " ^ vname ^ ": " ^ sot registry vtype
   675: 
   676: let pe x = print_endline x
   677: ;;
   678: 
   679: (* name with replacement *)
   680: let flx_name x = match flx_name' x with
   681: | Some x -> Some (rplname x)
   682: | None -> None
   683: 
   684: (* type name with replacement *)
   685: let flx_tname x = match flx_name' x with
   686: | Some x -> rpltname x
   687: | None -> "error!!"
   688: 
   689: let can_gen_ctype cstruct cfields =  cstruct &&
   690:   fold_left
   691:   (fun t {fname=fname; ftype=ftype} ->
   692:     t && not (isanont ftype) && ispublic fname &&
   693:     is_cstruct_field ftype
   694:   )
   695:   true cfields
   696: 
   697: let chop_extension f =
   698:   let b = Filename.basename f in
   699:   let d = Filename.dirname f in
   700:   let b = try Filename.chop_extension b with _ -> b in
   701:   if d = "." then b else Filename.concat d b
   702: 
   703: let replace_prefix x ls =
   704:   let x = ref x in
   705:   iter
   706:   (fun (a,b) ->
   707:     if isprefix a !x then
   708:     let n = String.length a in
   709:     let m = String.length !x in
   710:     x := b ^ String.sub !x n (m-n)
   711:   )
   712:   ls
   713:   ;
   714:   !x
   715: let map_filename f =
   716:   let f = replace_prefix f control.merge_files in
   717:   f
   718: 
   719: let flxinclude_of_cfile cfilename =
   720:   let x = map_filename cfilename in
   721:   let x = replace_prefix x control.repl_prefix in
   722:   let x = chop_extension x ^ "_lib" in
   723:   let x = if isprefix "/" x then String.sub x 1 (String.length x - 1) else x in
   724:   let x = if isprefix "." x then String.sub x 1 (String.length x - 1) else x in
   725:   x
   726: 
   727: let flxfile_of_cfile cfilename =
   728:   let base = flxinclude_of_cfile cfilename in
   729:   Filename.concat (control.outdir)  (base ^ ".flx")
   730: 
   731: let srepl s c1 c2 =
   732:   for i = 0 to String.length s - 1 do
   733:     if s.[i]=c1 then s.[i] <- c2
   734:   done
   735: ;;
   736: 
   737: let module_of_cfilename s =
   738:   let module_of_filename fname =
   739:     let x = String.copy fname in
   740:     let fixup x =
   741:       srepl x '.' '_';
   742:       srepl x ' ' '_';
   743:       srepl x '/' '_';
   744:       srepl x '-' '_';
   745:       srepl x '+' '_';
   746:       srepl x ':' '_';
   747:     in
   748:     let mname =
   749:       try
   750:         let x = (chop_extension x) in
   751:         let x =
   752:           let m = String.length x in
   753:           if m>0 && x.[0] = '/' then String.sub x 1 (m-1) else x
   754:         in
   755:         fixup x;
   756:         x ^ "_h"
   757:       with Invalid_argument _ ->
   758:         print_endline ("Weird (C++??) filename " ^ fname ^ " without extension");
   759:         fixup x;
   760:         x
   761:     in rplname mname (* apply user renaming to modules too *)
   762:   in
   763:   let s = map_filename s in
   764:   let s = replace_prefix s control.repl_prefix in
   765:   module_of_filename s
   766: 
   767: ;;
   768: 
   769: let mk_stab cfile =
   770: {
   771:   stab_cfile = cfile;
   772:   stab_flxfile = flxfile_of_cfile cfile;
   773:   stab_flxinclude = flxinclude_of_cfile cfile;
   774:   stab_module = module_of_cfilename cfile;
   775: 
   776:   aliases= Hashtbl.create 97;
   777:   struct_aliases= Hashtbl.create 97;
   778:   abstract_types= Hashtbl.create 97;
   779:   incomplete_types= Hashtbl.create 97;
   780:   used_types= Hashtbl.create 97;
   781:   variables= Hashtbl.create 97;
   782:   functions= Hashtbl.create 97;
   783:   fields= Hashtbl.create 97;
   784:   cstructs = Hashtbl.create 97;
   785:   procedures= Hashtbl.create 97;
   786:   callback_types = Hashtbl.create 97;
   787:   callback_clients = Hashtbl.create 97;
   788:   enums= Hashtbl.create 97;
   789:   registry= Hashtbl.create 97;
   790:   includes = StringSet.empty;
   791:   xtyps = Hashtbl.create 97;
   792:   ict = Hashtbl.create 97;
   793:   udt = Hashtbl.create 97;
   794:   counter = ref 1
   795: }
   796: ;;
   797: 
   798: let getstab s =
   799:   let lfn = map_filename s in
   800:   try Hashtbl.find control.stabs lfn
   801:   with Not_found ->
   802:     let x = mk_stab s in
   803:     Hashtbl.add control.stabs lfn x;
   804:     x
   805: 
   806: let getreg {file=s} = getstab s
   807: 
   808: let oplist = [
   809:   "+","add";
   810:   "-","sub";
   811:   "*","mul";
   812:   "/","div";
   813:   "%","mod";
   814: 
   815:   "<","lt";
   816:   ">","gt";
   817:   "<=","le";
   818:   ">=","ge";
   819:   "==","eq";
   820:   "!=","ne";
   821: 
   822:   "=","_set";
   823: 
   824:   "||","lor";
   825:   "&&","land";
   826:   "!","lnot";
   827: 
   828:   "^","bxor";
   829:   "|","bor";
   830:   "&","band";
   831:   "~","compl";
   832: 
   833:   "+=","pluseq";
   834:   "-=","minuseq";
   835:   "*=","muleq";
   836:   "/=","diveq";
   837:   "%=","modeq";
   838:   "^=","careteq";
   839:   "|=","vbareq";
   840:   "&=","ampereq";
   841:   "~=","tildeeq";
   842:   "<<=","leftshifteq";
   843:   ">>=","rightshifteq";
   844: 
   845:   "++","incr";
   846:   "--","decr";
   847:   "[]","subscript";
   848: ]
   849: ;;
   850: let operators = Hashtbl.create 97
   851: ;;
   852: List.iter
   853: (fun (k,v)-> Hashtbl.add operators ("operator"^k) v)
   854: oplist
   855: ;;
   856: 
   857: let fixsym k =
   858:   try  (* hackery .. won't work with qualified names *)
   859:     Hashtbl.find operators k
   860:   with Not_found ->
   861:     let k = String.copy k in
   862:     srepl k ':' '_';
   863:     k
   864: 
   865: let rpl {file=s} which =
   866:   let stab = getstab s in
   867:   match which with
   868:   | `aliases (k,v) ->
   869:     let k = fixsym k in
   870:     Hashtbl.replace stab.aliases k v;
   871:     Hashtbl.replace control.all_types k s
   872: 
   873:   | `struct_aliases(k,v)  ->
   874:     let k = fixsym k in
   875:     Hashtbl.replace stab.struct_aliases k v;
   876:     Hashtbl.replace control.all_types k s
   877: 
   878:   | `abstract_types (k,v)  ->
   879:     let k = fixsym k in
   880:     Hashtbl.replace stab.abstract_types k v;
   881:     Hashtbl.replace control.all_types k s
   882: 
   883:   | `incomplete_types (k,v)  ->
   884:     let k = fixsym k in
   885:     Hashtbl.replace stab.incomplete_types k v
   886: 
   887:   | `variables(k,v)  ->
   888:     let k = fixsym k in
   889:     Hashtbl.replace stab.variables k v
   890: 
   891:   | `functions((k,ts,cv),v)  ->
   892:     let k = fixsym k in
   893:     Hashtbl.replace stab.functions (k,ts,cv) v
   894: 
   895:   | `fields(k,v)  ->
   896:     let k = fixsym k in
   897:     Hashtbl.replace stab.fields k v
   898: 
   899:   | `cstruct (k,v)  ->
   900:     let k = fixsym k in
   901:     Hashtbl.replace control.all_types k k;
   902:     Hashtbl.replace stab.cstructs k v
   903: 
   904:   | `procedures((k,ts,cv),v)  ->
   905:     let k = fixsym k in
   906:     Hashtbl.replace stab.procedures (k,ts,cv) v
   907: 
   908:   | `enums(k,v)  ->
   909:     let k = fixsym k in
   910:     Hashtbl.replace stab.enums k v
   911: 
   912:   | `callback_type (s,(t,i))  ->
   913:     Hashtbl.replace stab.callback_types s (t,i)
   914: 
   915:   | `callback_client (s,(t,cbt,i,j))  ->
   916:     Hashtbl.replace stab.callback_clients s (t,cbt,i,j)
   917: 
   918: ;;
   919: 
   920: let add_file fname =
   921:   control.files <- StringSet.add fname control.files
   922: ;;
   923: 
   924: let add_loc {file=fname} =
   925:   add_file fname
   926: ;;
   927: 
   928: (* find all the void* in an argument list *)
   929: let find_voidps ps =
   930:   let voids = ref [] in
   931:   let i = ref 0 in
   932:   List.iter
   933:   (fun (_,t,_) ->
   934:     (match unrollType t with
   935:     | TPtr (TVoid _,[]) -> voids := !i :: !voids
   936:     | _ -> ()
   937:     );
   938:     incr i
   939:   )
   940:   ps
   941:   ;
   942:   !voids
   943: 
   944: (* check if a function pointer is a callback, by
   945: seeing if it contains exactly one void * argument
   946: *)
   947: let is_callbackp t =
   948:   match t with
   949:   | TPtr (TFun (_,Some ps,false,_),_) ->
   950:     List.length (find_voidps ps) = 1
   951:   | _ -> false
   952: 
   953: (* Find all the arguments which are callbacks *)
   954: let find_callbackps ps =
   955:   let callbacks = ref [] in
   956:   let i = ref 0 in
   957:   List.iter
   958:   (fun (_,t,_) ->
   959:     if is_callbackp t
   960:     then callbacks := !i :: !callbacks
   961:     ;
   962:     incr i
   963:   )
   964:   ps
   965:   ;
   966:   !callbacks
   967: 
   968: (* get the indices in an argument list of the callback
   969: and client data pointer, and the index of the client
   970: data pointer in the callback type as well, return None
   971: if they can't be uniquely identified
   972: *)
   973: 
   974: let get_callback_data ps =
   975:   let callbacks = find_callbackps ps in
   976:   let voids = find_voidps ps in
   977:   match callbacks, voids with
   978:   | [cbc_i], [cbc_adri] ->
   979:     begin match List.nth ps cbc_i with
   980:     | _,TPtr (TFun (_,Some ps,false,_),_),_ ->
   981:       begin match find_voidps ps with
   982:       | [cbi] -> Some (cbc_i,cbc_adri,cbi)
   983:       | _ -> assert false
   984:       end
   985:     | _ -> assert false
   986:     end
   987:   | _ -> None
   988: 
   989: let check_callback t = match t with
   990:   | TFun (_,Some ps,false,_) ->
   991:     begin match get_callback_data ps with
   992:     | Some (cbc_i, cbc_adri,cbi) ->
   993:       let _,cbt,_ = List.nth ps cbc_i in
   994:       Some (cbc_i, cbc_adri,cbi, cbt)
   995:     | None -> None
   996:     end
   997:   | TFun _ -> None
   998:   | _ -> failwith "Check for callbacks in non-function"
   999: 
  1000: let handle_callback_maybe ft registry key key' fname loc =
  1001:   match check_callback ft with
  1002:   | None -> ()
  1003:   | Some (cbc_i, cbc_adri, cbi, cbt) ->
  1004:     (*
  1005:     print_endline
  1006:     (
  1007:       "Found callback client " ^ fname ^
  1008:       "\n  callback index = " ^ string_of_int cbc_i ^
  1009:       "\n  client data index = " ^ string_of_int cbc_adri ^
  1010:       "\n  callback type = " ^ sot registry cbt ^
  1011:       "\n  callback type client data index = " ^ string_of_int cbi
  1012:     )
  1013:     ;
  1014:     *)
  1015:     let s = sot registry cbt in
  1016:     rpl loc (`callback_type (s,(cbt,cbi)));
  1017:     rpl loc (`callback_client (fname,(ft,s,cbc_i,cbc_adri)))
  1018: 
  1019: let ptr key a =
  1020:   cvqual a ^ "ptr[" ^ key ^ "]"
  1021: 
  1022: let handle_global_fun ft registry key key' fname loc =
  1023:   handle_callback_maybe ft registry key key' fname loc;
  1024:   match ft with
  1025:   | TFun (TVoid _,Some ps,false,a) ->
  1026:     let tsig = map (fun (_,t,a) -> typeSig t) ps in
  1027:     let args =
  1028:       if length ps = 0 then "1"
  1029:       else String.concat " * " (List.map (soa registry) ps)
  1030:     in
  1031:     let cv = cvqual a in
  1032:     let ct = if key = key' then "" else key'^"($a);" in
  1033:     rpl loc (`procedures ((key,tsig,cv), (args,ct)))
  1034: 
  1035:   | TFun (TVoid _,None,false,a) ->
  1036:     let args = "1" in
  1037:     let cv = cvqual a in
  1038:     rpl loc (`procedures ((key,[],cv), (args,key'^"();")))
  1039: 
  1040:   | TFun (TVoid _,Some _,true,a) ->
  1041:     let cv = cvqual a in
  1042:     let ct = if key = key' then "" else key'^"($a);" in
  1043:     rpl loc (`procedures ((key^"[t]",[],cv), ("t",ct)))
  1044: 
  1045:   | TFun (ret,Some ps,false,a) ->
  1046:     let ftb =
  1047:       let ret = sot (getreg loc) ret
  1048:       and args = List.map (soa registry) ps
  1049:       and ct = if key = key' then "" else key'^"($a)"
  1050:       in
  1051:       (
  1052:         (
  1053:           if length ps = 0
  1054:           then "1"
  1055:           else String.concat " * " args
  1056:         )
  1057:         ^
  1058:         " -> " ^ ret,ct
  1059:       )
  1060:     in
  1061:       let tsig = map (fun (_,t,a) -> typeSig t) ps in
  1062:       let cv = cvqual a in
  1063:       rpl loc (`functions ((key,tsig,cv), ftb))
  1064: 
  1065:   | TFun (ret,None,false,a) ->
  1066:     let ret = sot (getreg loc) ret in
  1067:     let ftb =  "1 -> " ^ ret,key'^"()" in
  1068:     let cv = cvqual a in
  1069:     rpl loc (`functions ((key,[],cv), ftb))
  1070: 
  1071:   | TFun (ret,Some _,true,a) ->
  1072:     let ftb =
  1073:       let ret = sot (getreg loc) ret in
  1074:       "t -> " ^ ret,key'^"($a)"
  1075:     in
  1076:       let cv = cvqual a in
  1077:       rpl loc (`functions ((key^"[t]",[],cv), ftb))
  1078: 
  1079:   | _ -> assert false
  1080: 
  1081: let handle_method ft registry key fname loc =
  1082:   match ft with
  1083:   (* procedures *)
  1084:   | (TVoid _,Some ps,false,a) ->
  1085:     let key = ptr (fixsym key) a in
  1086:     let args =
  1087:       if length ps = 0 then key
  1088:       else String.concat " * " (key :: (List.map (soa registry) ps))
  1089:     in
  1090:       let tsig = map (fun (_,t,a) -> typeSig t) ps in
  1091:       let cv = cvqual a in
  1092:       rpl loc (`procedures ((fname,tsig,cv), (args,"$1->"^fname^"($b);")))
  1093: 
  1094:   (* no type arg = void *)
  1095:   | (TVoid _,None,false,a) ->
  1096:     let key = ptr key a in
  1097:     let args = key in
  1098:     let cv = cvqual a in
  1099:     rpl loc (`procedures ((fname,[],cv), (args,"$1->"^fname^"();")))
  1100: 
  1101:   (* variadic *)
  1102:   | (TVoid _,Some t,true,a) ->
  1103:     let key = ptr key a in
  1104:     let cv = cvqual a in
  1105:     rpl loc (`procedures ((fname^"[t]",[],cv), ("t","$1->"^fname^"($b);")))
  1106: 
  1107:   (* functions *)
  1108:   | (ret,Some ps,false,a) ->
  1109:     let key = ptr key a in
  1110:     let ftb =
  1111:       let ret = sot (getreg loc) ret
  1112:       and args = List.map (soa registry) ps
  1113:       in
  1114:       (
  1115:         (
  1116:           if length ps = 0
  1117:           then key
  1118:           else String.concat " * " (key :: args)
  1119:         )
  1120:         ^
  1121:         " -> " ^ ret,"$1->"^fname^"($a)"
  1122:       )
  1123:     in
  1124:       let tsig = map (fun (_,t,a) -> typeSig t) ps in
  1125:       let cv = cvqual a in
  1126:       rpl loc (`functions ((fname,tsig,cv), ftb))
  1127: 
  1128:   (* no type arg = void *)
  1129:   | (ret,None,false,a) ->
  1130:     let key = ptr key a in
  1131:     let ret = sot (getreg loc) ret in
  1132:     let ftb =  key ^ " -> " ^ ret,"$1->"^fname^"()" in
  1133:     let cv = cvqual a in
  1134:     rpl loc (`functions ((fname,[],cv), ftb))
  1135: 
  1136:   (* variadic *)
  1137:   | (ret,Some _,true,a) ->
  1138:     let key = ptr key a in
  1139:     let ftb =
  1140:       let ret = sot (getreg loc) ret in
  1141:       "t -> " ^ ret,"$1->"^fname^"($b)"
  1142:     in
  1143:       let cv = cvqual a in
  1144:       rpl loc (`functions ((fname^"[t]",[],cv), ftb))
  1145: 
  1146:   (* can't be both variadic and have no arguments *)
  1147:   | (_,None,true,_) -> assert false
  1148: 
  1149: let handle_field registry key fname ftype loc =
  1150:   match ftype with
  1151:   | TFun (a,b,c,d) -> handle_method (a,b,c,d) registry key fname loc
  1152: 
  1153:   | _ ->
  1154:     let t = key ^ " -> " ^ sot registry ftype in
  1155:     rpl loc (`fields (("get_"^fname), (t,"$1->"^fname)))
  1156: 
  1157: let gen_cstruct registry loc key cname cfields =
  1158:   let flds = ref [] in
  1159:   iter
  1160:   (fun {fname=fname; ftype=ftype} ->
  1161:     let t = sot registry ftype in
  1162:     flds := (rplname fname,t) :: !flds
  1163:   )
  1164:   cfields
  1165:   ;
  1166:   let flds = rev !flds in
  1167:   rpl loc (`cstruct (cname, flds));
  1168:   if key <> cname then
  1169:     rpl loc (`aliases (key, cname))
  1170: 
  1171: let handle_global g =  let loc = get_globalLoc g in
  1172:   add_loc loc;
  1173:   let type_name = flx_tname g in
  1174:   match isanon g,flx_name g,flx_name' g with
  1175:   | _,None,_
  1176:   | true,_,_ ->
  1177:     begin match g with
  1178: 
  1179:     (* enum { .. }; *)
  1180:     | GEnumTag (ei,_) ->
  1181:       begin match ei with { eitems=eitems } ->
  1182:         iter
  1183:         (fun (s,_,_) ->
  1184:           if ispublic s then rpl loc (`enums (rplname s,s))
  1185:         )
  1186:         eitems
  1187:       end
  1188:     | _ -> ()
  1189:     end
  1190: 
  1191:   | _,Some _,None -> assert false
  1192:   | false,Some key,Some key' ->
  1193:   if not (Hashtbl.mem control.rejects key) then
  1194:   match g with
  1195:   | GType (ti,loc) ->
  1196:     let registry = getreg loc in
  1197:     begin
  1198:       match ti with {ttype=ttype} ->
  1199:       match  ttype with
  1200:       | TComp (ci,_) ->
  1201:         let anon= achk (ciname ci) in
  1202:         (*
  1203:         begin match ci with { cname=cname; cfields=cfields } ->
  1204:         iter
  1205:         (fun {fname=fname; ftype=ftype} ->
  1206:           if not (isanont ftype) && ispublic fname then
  1207:           handle_field registry key fname ftype loc
  1208:         )
  1209:         cfields
  1210:         end
  1211:         ;
  1212:         *)
  1213:         if anon then
  1214:           rpl loc (`abstract_types (type_name, key'))
  1215:         else
  1216:           let v = ptdef registry ti in
  1217:           rpl loc (`struct_aliases (type_name, v))
  1218: 
  1219:       | TEnum (ei,_) ->
  1220:         begin match ei with { eitems=eitems } ->
  1221:         iter
  1222:         (fun (s,_,_) -> if ispublic s then rpl loc (`enums (rplname s,s)))
  1223:         eitems
  1224:         end
  1225:         ;
  1226:         if achk (einame ei) then
  1227:           rpl loc (`abstract_types (type_name, key'))
  1228:         else
  1229:           rpl loc (`aliases (type_name, (ptdef registry ti)))
  1230: 
  1231:       | TFun (_,_,true,_) ->
  1232:         (* HACK: varargs function typedef *)
  1233:         rpl loc (`abstract_types (type_name, key'))
  1234: 
  1235:       | t ->
  1236:         if isanont t then
  1237:           rpl loc (`abstract_types (type_name, key'))
  1238:         else
  1239:           let v = ptdef registry ti in
  1240:           rpl loc (`aliases (type_name, v))
  1241:     end
  1242: 
  1243:   | GCompTag (ci,loc) ->
  1244:     let registry = getreg loc in
  1245:     begin match ci with {
  1246:       cname=cname;
  1247:       cfields=cfields;
  1248:       cstruct=cstruct
  1249:     } ->
  1250:       if can_gen_ctype cstruct cfields then
  1251:         gen_cstruct registry loc type_name cname cfields
  1252:       else begin
  1253:         rpl loc (`abstract_types (type_name, (pcci ci)));
  1254:         iter
  1255:         (fun {fname=fname; ftype=ftype} ->
  1256:           if not (isanont ftype) && ispublic fname then
  1257:           handle_field registry type_name fname ftype loc
  1258:         )
  1259:         cfields
  1260:       end
  1261:     end
  1262: 
  1263: 
  1264:   | GCompTagDecl (ci,loc) ->
  1265:     rpl loc (`incomplete_types (type_name, (pcci ci)))
  1266: 
  1267:   | GEnumTag (ei,loc) ->
  1268:     rpl loc (`aliases (type_name, "int"));
  1269:     begin match ei with { eitems=eitems } ->
  1270:     iter
  1271:     (fun (s,_,_) -> if ispublic s then rpl loc (`enums (rplname s,s)))
  1272:     eitems
  1273:     end
  1274: 
  1275:   | GEnumTagDecl (ci,loc) -> rpl loc (`aliases (type_name, "int"))
  1276: 
  1277:   | GVar (vi,_,loc)
  1278:   | GFun ({svar=vi},loc)
  1279:   | GVarDecl (vi,loc) ->
  1280:     let registry = getreg loc in
  1281:     let vname, vtype=
  1282:       match vi with {vname=vname; vtype=vtype}->vname,vtype
  1283:     in
  1284:     if ispublic vname then
  1285:     begin match vtype with
  1286:     | TFun _ -> handle_global_fun vtype registry key key' vname loc
  1287:     | _ ->
  1288:       rpl loc (`variables (key, (sot (getreg loc) vtype)))
  1289:     end
  1290: 
  1291:   | GAsm _ -> print_endline "GASM"
  1292:   | GPragma _ -> print_endline "PRAGMA"
  1293:   | GText _ -> print_endline "TEXT"
  1294: ;;
  1295: 
  1296: List.iter handle_global gs
  1297: ;;
  1298: 
  1299: let is_nonempty h =
  1300:   try
  1301:     Hashtbl.iter (fun _ -> raise Not_found) h;
  1302:     false
  1303:    with Not_found -> true
  1304: ;;
  1305: 
  1306: exception Found of string
  1307: 
  1308: let pathname_of f =
  1309:   try
  1310:     iter
  1311:     (fun s ->
  1312:       let x = Filename.concat s f in
  1313:       if Sys.file_exists x then raise (Found x)
  1314:     )
  1315:     control.include_path;
  1316:     raise Not_found
  1317:   with Found s -> s
  1318: ;;
  1319: 
  1320: let rec find_includes' includes fname =
  1321:   if not (StringSet.mem fname !includes) then
  1322:     let f = force_open_in "find_includes'" fname in
  1323:     includes := StringSet.add fname !includes;
  1324:     begin try
  1325:       let rec aux () =
  1326:         let line = input_line f in
  1327:         let n = String.length line in
  1328:         let i = ref 0 in
  1329: 
  1330:         try
  1331:           (* skip white *)
  1332:           while !i < n && line.[!i]=' ' do incr i done;
  1333:           if !i = n then raise Next;
  1334: 
  1335:           (* check # *)
  1336:           if line.[!i]<>'#' then raise Next;
  1337:           incr i;
  1338: 
  1339:           (* skip white *)
  1340:           while !i < n && line.[!i]=' ' do incr i done;
  1341:           if !i = n then raise Next;
  1342: 
  1343:           (* check include *)
  1344:           if !i+String.length "include" > n then raise Next;
  1345:           let li = String.length "include" in
  1346:           if (String.sub line !i li)  <> "include" then raise Next;
  1347:           i := !i + li;
  1348: 
  1349:           (* skip white *)
  1350:           while !i < n && line.[!i]=' ' do incr i done;
  1351: 
  1352:           (* check < or '"' *)
  1353:           if line.[!i]<>'"' && line.[!i]<>'<' then raise Next;
  1354:           incr i;
  1355: 
  1356:           (* skip to > or '"' *)
  1357:           let j = !i in
  1358:           while !i < n && line.[!i]<>'>' && line.[!i]<>'"' do incr i done;
  1359: 
  1360:           (* extract filename *)
  1361:           let filename = String.sub line j (!i-j) in
  1362: 
  1363: 
  1364:           (* lookup full path name *)
  1365:           let filename =
  1366:             if not (Filename.is_relative filename) then filename else
  1367:             try pathname_of filename
  1368:             with Not_found ->
  1369:               (*
  1370:               print_endline
  1371:               (
  1372:                 "[include_file'] Can't resolve " ^ filename ^
  1373:                 " included from " ^ fname
  1374:               );
  1375:               *)
  1376:               raise Next
  1377:           in
  1378:           add_file filename;
  1379: 
  1380:           (* if not already known, put transitive closure in set *)
  1381:           if StringSet.mem filename !includes then raise Next;
  1382:           includes := StringSet.add filename !includes;
  1383:           find_includes' includes filename;
  1384: 
  1385:           (* next line *)
  1386:           raise Next
  1387:         with Next -> aux ()
  1388:       in
  1389:         aux()
  1390:     with End_of_file -> close_in f
  1391:     end
  1392: ;;
  1393: 
  1394: let find_includes fname =
  1395:   let includes = ref StringSet.empty in
  1396:   find_includes' includes fname;
  1397:   let extras =
  1398:     try Hashtbl.find control.rev_merge_files fname
  1399:     with Not_found -> []
  1400:   in
  1401:   iter (find_includes' includes) extras
  1402:   ;
  1403:   stringset_map map_filename !includes
  1404: ;;
  1405: 
  1406: let global_includes = ref StringSet.empty
  1407: ;;
  1408: 
  1409: Hashtbl.iter
  1410: begin
  1411:   fun fname stab ->
  1412:   let includes = ref (find_includes stab.stab_cfile) in
  1413:   let ict = Hashtbl.create 97 in
  1414:   let xtyps = Hashtbl.create 97 in
  1415:   Hashtbl.iter
  1416:   (fun k v ->
  1417:     if not (Hashtbl.mem stab.abstract_types k) then
  1418:     try
  1419:       let file = Hashtbl.find control.all_types k in
  1420:       includes := StringSet.add file !includes;
  1421:       Hashtbl.add xtyps k file;
  1422: 
  1423:     with Not_found ->
  1424:       Hashtbl.add ict k v;
  1425:       let v',ms =
  1426:         try Hashtbl.find control.incomplete_types_cache k
  1427:         with Not_found -> v,[]
  1428:       in
  1429:       if v'<>v then
  1430:       failwith ("Inconsistent type " ^k^"->"^ v ^ " <> " ^ v')
  1431:       ;
  1432:       Hashtbl.replace control.incomplete_types_cache k (v,stab.stab_module::ms)
  1433:     else
  1434:       ()
  1435:   )
  1436:   stab.incomplete_types
  1437:   ;
  1438: 
  1439:   let udt = Hashtbl.create 97 in
  1440:   Hashtbl.iter
  1441:   (fun k v ->
  1442:     let k = rplname k in
  1443:     if not (Hashtbl.mem control.rejects k) then
  1444:     try
  1445:       let file = Hashtbl.find control.all_types k in
  1446:       includes := StringSet.add file !includes;
  1447:     with Not_found ->
  1448:       if not (Hashtbl.mem control.incomplete_types_cache k) then
  1449:       Hashtbl.add udt k v
  1450:   )
  1451:   stab.used_types
  1452:   ;
  1453:   stab.includes <- !includes;
  1454:   global_includes := StringSet.union !global_includes !includes;
  1455:   stab.udt <- udt;
  1456:   stab.ict <- ict;
  1457:   stab.xtyps <- xtyps
  1458: end
  1459: control.stabs
  1460: ;;
  1461: 
  1462: (* closure for stabs .. *)
  1463: StringSet.iter
  1464: (fun s -> ignore(getstab s))
  1465: !global_includes
  1466: ;;
  1467: 
  1468: StringSet.iter
  1469: (fun s ->
  1470:    let filename =
  1471:      if not (Filename.is_relative s) then s else
  1472:      try pathname_of s
  1473:      with Not_found ->
  1474:        print_endline ( "Can't resolve primary file " ^ s);
  1475:        print_endline ("in path: ");
  1476:        iter
  1477:        (fun s -> print_endline s)
  1478:        control.include_path
  1479:        ;
  1480:        print_endline "Try adding path statement to control file";
  1481:        failwith ("Filename resolution error")
  1482:    in
  1483:      ignore(getstab filename)
  1484: )
  1485: control.raw_includes
  1486: ;;
  1487: 
  1488: let rec find_macros fname =
  1489:   let macros = ref [] in
  1490:   begin
  1491:     try
  1492:       let f = open_in fname in
  1493:       begin
  1494:         try
  1495:           let rec aux () =
  1496:             let line = input_line f in
  1497:             let n = String.length line in
  1498:             let i = ref 0 in
  1499: 
  1500:             try
  1501:               (* skip white *)
  1502:               while !i < n && line.[!i]=' ' do incr i done;
  1503:               if !i = n then raise Next;
  1504: 
  1505:               (* check # *)
  1506:               if line.[!i]<>'#' then raise Next;
  1507:               incr i;
  1508: 
  1509:               (* skip white *)
  1510:               while !i < n && line.[!i]=' ' do incr i done;
  1511:               if !i = n then raise Next;
  1512: 
  1513:               (* check include *)
  1514:               let li = String.length "define" in
  1515:               if !i+li > n then raise Next;
  1516:               if (String.sub line !i li)  <> "define" then raise Next;
  1517:               i := !i + li;
  1518: 
  1519:               (* skip white *)
  1520:               while !i < n && line.[!i]=' ' do incr i done;
  1521:               let m = String.sub line !i (n - !i) in
  1522:               macros := m :: !macros;
  1523: 
  1524:               (* next line *)
  1525:               raise Next
  1526:             with Next -> aux ()
  1527:           in
  1528:             aux()
  1529:         with End_of_file -> close_in f
  1530:       end
  1531:     with _ -> ()
  1532:   end
  1533:   ;
  1534:   !macros
  1535: ;;
  1536: exception Equal
  1537: exception Not_equal
  1538: ;;
  1539: let fnames = ref [];;
  1540: Hashtbl.iter
  1541: (fun f _ -> fnames := f :: !fnames)
  1542: control.stabs
  1543: ;;
  1544: let fnames = List.sort compare !fnames
  1545: ;;
  1546: iter begin
  1547:   fun fname ->
  1548:   let stab = Hashtbl.find control.stabs fname in
  1549:   let outname = stab.stab_flxfile in
  1550:   let mode, outf =
  1551:     if Sys.file_exists outname then
  1552:       `tmp, force_open_out "generate_file" "tmp.tmp"
  1553:     else
  1554:       `orig,autocreate outname
  1555:   in
  1556:   let pe s = output_string outf (s ^ "\n") in
  1557: 
  1558:   pe ("//Module        : " ^ stab.stab_module);
  1559:   pe ("//Timestamp     : " ^ compile_start_gm_string);
  1560:   pe ("//Timestamp     : " ^ compile_start_local_string);
  1561:   pe ("//Raw Header    : " ^ fname);
  1562:   pe ("//Preprocessor  : " ^ control.preprocessor);
  1563:   pe ("//Input file: " ^ control.preout_filename);
  1564:   pe ("//Flxcc Control : " ^ control.control_filename);
  1565:   pe ("//Felix Version : " ^ !version_data.version_string);
  1566:   pe ("include 'std';");
  1567:   pe "";
  1568:   let macros = find_macros fname in
  1569:   iter
  1570:   (fun s-> pe ("//#define " ^ s))
  1571:   macros
  1572:   ;
  1573:   if not (mem fname control.noincludes) then
  1574:     pe ("header '#include \"" ^ fname^"\"';")
  1575:   else
  1576:     pe ("//NOT INCLUDED: \"" ^ fname^"\"")
  1577:   ;
  1578: 
  1579: 
  1580:   begin
  1581:     try
  1582:       Hashtbl.iter
  1583:       (fun k v->
  1584:         match Hashtbl.find control.incomplete_types_cache k with
  1585:         | (_,[_]) -> ()
  1586:         | _ ->
  1587:           pe ("include \"_incomplete_types_cache\";");
  1588:           raise Not_found
  1589:       )
  1590:       stab.ict
  1591:     with Not_found -> ()
  1592:   end
  1593:   ;
  1594: 
  1595: 
  1596:   let include_depends =
  1597:     let x = stringset_map map_filename stab.includes in
  1598:     let x = stringset_map flxinclude_of_cfile x in
  1599:     StringSet.remove stab.stab_flxinclude x
  1600:   in
  1601:   let module_depends =
  1602:     let x = stringset_map map_filename stab.includes in
  1603:     let x = stringset_map (fun s -> module_of_cfilename s) x in
  1604:     StringSet.remove stab.stab_module x
  1605:   in
  1606: 
  1607:   if StringSet.cardinal include_depends > 0 then
  1608:   begin
  1609:     pe "";
  1610:     pe "//INCLUDES";
  1611:     StringSet.iter
  1612:     (fun incname ->
  1613:       pe ("include \"" ^ incname^ "\";")
  1614:     )
  1615:     include_depends
  1616:   end
  1617:   ;
  1618: 
  1619:   pe "";
  1620:   pe ("module " ^ stab.stab_module ^ "\n{");
  1621:   begin
  1622:     let pe s = output_string outf ("  " ^ s ^ "\n") in
  1623:     pe "open C_hack;";
  1624:     if StringSet.cardinal module_depends > 0 then
  1625:     begin
  1626:       StringSet.iter
  1627:       (fun modulename' ->
  1628:         pe ("open " ^ modulename' ^";")
  1629:       )
  1630:       module_depends
  1631:     end
  1632:     ;
  1633: 
  1634:     if is_nonempty stab.abstract_types then
  1635:     begin
  1636:       pe "";
  1637:       pe "//ABSTRACT TYPES";
  1638:       Hashtbl.iter
  1639:       (fun k v->
  1640:         pe ("type " ^ k ^ " = '" ^ v ^ "';")
  1641:       )
  1642:       stab.abstract_types
  1643:     end
  1644:     ;
  1645: 
  1646:     if is_nonempty stab.cstructs then
  1647:     begin
  1648:       pe "";
  1649:       pe "//CSTRUCTS ";
  1650:       Hashtbl.iter
  1651:       (fun k flds ->
  1652:         pe ("cstruct " ^ k ^ " {");
  1653:         iter (fun (fld,typ) ->
  1654:           pe ("  " ^ fld ^": " ^ typ^ ";")
  1655:         )
  1656:         flds
  1657:         ;
  1658:         pe ("}")
  1659:       )
  1660:       stab.cstructs
  1661:     end
  1662:     ;
  1663: 
  1664:     if is_nonempty stab.registry then
  1665:     begin
  1666:       pe "";
  1667:       pe "//C FUNCTION POINTER TYPES";
  1668:       Hashtbl.iter
  1669:       (fun _ (name,tdef)->
  1670:         pe ("header '''" ^ tdef ^ "''';");
  1671:         pe ("type " ^ name ^ " = '" ^ name ^ "';")
  1672:       )
  1673:       stab.registry
  1674:     end
  1675:     ;
  1676: 
  1677:     if is_nonempty stab.xtyps then
  1678:     begin
  1679:       pe "";
  1680:       pe "//EXTERNALLY COMPLETED TYPES";
  1681:       Hashtbl.iter
  1682:       (fun k v->
  1683:         let m = module_of_cfilename v in
  1684:         pe ("//type " ^ k ^ " defined in "^m^"='" ^ v ^ "';")
  1685:       )
  1686:       stab.xtyps
  1687:     end
  1688:     ;
  1689: 
  1690:     if is_nonempty stab.ict then
  1691:     begin
  1692:       pe "";
  1693:       pe "//PURE INCOMPLETE TYPES";
  1694:       Hashtbl.iter
  1695:       (fun k v->
  1696:         match Hashtbl.find control.incomplete_types_cache k with
  1697:         | (_,[_]) ->
  1698:           pe ("type " ^ k ^ " = '" ^ v ^ "'; //local")
  1699:         | (_,ls) ->
  1700:           pe ("typedef " ^ k ^ " = _incomplete_types::" ^ k ^ ";//shared");
  1701:           iter (fun s->pe ("//shared by: " ^ s)) ls
  1702:       )
  1703:       stab.ict
  1704:     end
  1705:     ;
  1706: 
  1707:     if is_nonempty stab.udt then
  1708:     begin
  1709:       pe "";
  1710:       pe "//TYPES WE CAN'T FIND";
  1711:       Hashtbl.iter
  1712:       (fun k _ ->
  1713:         pe ("//type " ^ k ^ " ??")
  1714:       )
  1715:       stab.udt
  1716:     end
  1717:     ;
  1718: 
  1719:     if is_nonempty stab.struct_aliases then
  1720:     begin
  1721:       pe "";
  1722:       pe "//STRUCT or UNION TAG ALIASES";
  1723:       Hashtbl.iter
  1724:       (fun k v->
  1725:         (* va_list is already defined in the standard library *)
  1726:         if k <> "va_list" then
  1727:         (* hack to fiddle typedef X {} X *)
  1728:         if not (Hashtbl.mem stab.cstructs k) then
  1729:         pe ("typedef " ^ k ^ " = " ^ v ^ ";")
  1730:       )
  1731:       stab.struct_aliases
  1732:     end
  1733:     ;
  1734: 
  1735:     if is_nonempty stab.aliases then
  1736:     begin
  1737:       pe "";
  1738:       pe "//TYPE ALIASES";
  1739:       Hashtbl.iter
  1740:       (fun k v->
  1741:         (* va_list is already defined in the standard library *)
  1742:         if k <> "va_list" then
  1743:         pe ("typedef " ^ k ^ " = " ^ v ^ ";")
  1744:       )
  1745:       stab.aliases
  1746:     end
  1747:     ;
  1748: 
  1749:     if is_nonempty stab.variables then
  1750:     begin
  1751:       pe "";
  1752:       pe "//VARIABLES";
  1753:       Hashtbl.iter
  1754:       (fun k v->
  1755:         pe ("const " ^ k ^ ": " ^v^ " = '" ^ k ^ "';")
  1756:       )
  1757:       stab.variables
  1758:     end
  1759:     ;
  1760: 
  1761:     if is_nonempty stab.enums then
  1762:     begin
  1763:       pe "";
  1764:       pe "//ENUMERATION CONSTANTS";
  1765:       Hashtbl.iter
  1766:       (fun k v ->
  1767:         pe ("const " ^ k ^ ": int = '" ^ v ^ "';")
  1768:       )
  1769:       stab.enums
  1770:     end
  1771:     ;
  1772: 
  1773:     if is_nonempty stab.procedures then
  1774:     begin
  1775:       pe "";
  1776:       pe "//PROCEDURES";
  1777:       let ps = ref [] in
  1778:       Hashtbl.iter
  1779:       (fun (k,_,_) v -> ps := (k,v):: !ps)
  1780:       stab.procedures
  1781:       ;
  1782:       let ps = sort compare !ps in
  1783:       iter
  1784:       (fun (k, (v,b)) ->
  1785:         if b = "" then
  1786:          pe ("proc " ^ k ^ ": " ^v^ ";")
  1787:         else
  1788:          pe ("proc " ^ k ^ ": " ^v^ " = '"^b^"';")
  1789:       )
  1790:       ps
  1791:     end
  1792:     ;
  1793: 
  1794:     if is_nonempty stab.functions then
  1795:     begin
  1796:       pe "";
  1797:       pe "//FUNCTIONS";
  1798:       let ps = ref [] in
  1799:       Hashtbl.iter
  1800:       (fun (k,_,_) v -> ps := (k,v):: !ps)
  1801:       stab.functions
  1802:       ;
  1803:       let ps = sort compare !ps in
  1804:       iter
  1805:       (fun (k, (v,b))->
  1806:         if b = "" then
  1807:           pe ("fun " ^ k ^ ": " ^v^ ";")
  1808:         else
  1809:           pe ("fun " ^ k ^ ": " ^v^ " = '" ^ b ^ "';")
  1810:       )
  1811:       ps
  1812:     end
  1813:     ;
  1814: 
  1815:     if is_nonempty stab.callback_types then
  1816:     begin
  1817:       let sot t = sot stab t in
  1818:       let soa a = soa stab a in
  1819:       pe "";
  1820:       pe "//CALLBACK TYPE WRAPPERS";
  1821:       Hashtbl.iter
  1822:       (fun tname (t, cbi)->
  1823:         pe ("//callback type " ^ tname ^ ", client data at " ^ string_of_int cbi);
  1824:         let ccbt = "_ccbt_" ^ tname in
  1825:         let fcbt = "_fcbt_" ^ tname in
  1826:         let fcbat = "_fcbat_" ^ tname in
  1827:         let fcbw = "_fcbw_" ^ tname in
  1828:         match t with
  1829:         | TPtr (TFun (ret,Some ps, false,a),_) ->
  1830:           (* fix arg names *)
  1831:           let i = ref 0 in
  1832:           let ps =
  1833:             map
  1834:             (fun (_,t,a) ->
  1835:               incr i;
  1836:               let pn = "a"^ string_of_int !i in
  1837:               pn,t,a
  1838:             )
  1839:             ps
  1840:           in
  1841:           let t' = TFun (ret,Some ps, false,a) in
  1842:           (* get the non-client data arguments *)
  1843:           let ps' = ref [] in
  1844:           let i = ref 0 in
  1845:           iter
  1846:           (fun x -> if cbi = !i then () else ps' := x :: !ps'; incr i)
  1847:           ps
  1848:           ;
  1849:           let ps' = rev !ps' in
  1850:           (* make a typedef for the felix callback type
  1851:           mainly as documentation [since the client will
  1852:           declare a function of this type, the actual
  1853:           typedef isn't that useful]
  1854:           *)
  1855: 
  1856:           begin match ret with
  1857:           | TVoid _ ->
  1858:             let args =
  1859:              if length ps' = 0 then "1"
  1860:             else String.concat " * " (List.map soa ps')
  1861:             in
  1862:             pe ("typedef " ^ fcbat ^ " = " ^ args ^ "; ");
  1863:             pe ("export type (" ^ fcbat ^ ") as \""^fcbat^"\";");
  1864:             pe ("typedef " ^ fcbt ^ " = " ^ args ^ " -> void; ");
  1865:             pe ("export type (" ^ fcbt ^ ") as \""^fcbt^"\";");
  1866:             let sr = {line=0;file="";byte=0} in
  1867:             let vi =
  1868:               {
  1869:                 vname=fcbw; vtype=t'; vattr=[]; vglob=true;
  1870:                 vinline=false; vdecl=sr; vid=0; vaddrof=false;
  1871:                 vreferenced=true; vstorage=NoStorage
  1872:               }
  1873:             in
  1874:             let g =  GVarDecl (vi,sr) in
  1875:             let d = defaultCilPrinter#pGlobal () g in
  1876:             let s = Flx_cil_pretty.sprint 65 d in
  1877:             let s = reformatc s in
  1878:             pe ("header '''" ^ s ^ "''';\n");
  1879:             pe ("const "^fcbw^": " ^ tname ^ " = \"" ^ fcbw ^ "\";");
  1880: 
  1881:             (* hack: elide trailing semicolon *)
  1882:             let s = String.sub s 0 (String.length s - 1) in
  1883:             pe ("body '''\n  " ^ s ^ "{");
  1884:             let oargs = ref [] in
  1885:             iter
  1886:             (fun i -> if i <> cbi then
  1887:               oargs := ("a" ^ string_of_int (i+1)) :: !oargs
  1888:             )
  1889:             (nlist (length ps))
  1890:             ;
  1891:             pe (
  1892:               "  con_t *p  = (("^fcbt^")a" ^ string_of_int (cbi+1) ^
  1893:               ")->call(" ^
  1894:               if List.length !oargs > 1 then
  1895:                 "0, " ^fcbat^"(" ^ String.concat ", " (rev !oargs)^"));"
  1896:               else
  1897:                 String.concat ", " ("0" :: rev !oargs)^");"
  1898:             );
  1899:             pe ("  while(p) p=p->resume();");
  1900:             pe ("}''';\n");
  1901: 
  1902:           | _ ->
  1903:             let args =
  1904:              if length ps' = 0 then "1"
  1905:             else String.concat " * " (List.map soa ps')
  1906:             in
  1907:             let args =
  1908:              if length ps' = 0 then "1"
  1909:             else String.concat " * " (List.map soa ps')
  1910:             in
  1911:             pe ("typedef " ^ fcbat ^ " = "^ args ^ ";");
  1912:             pe ("export type (" ^ fcbat ^ ") as \""^fcbat^"\";");
  1913:             pe ("typedef " ^ fcbt ^ " = "^ args ^ " -> "^sot ret^"; ");
  1914:             pe ("export type (" ^ fcbt ^ ") as \""^fcbt^"\";");
  1915:             let sr = {line=0;file="";byte=0} in
  1916:             let vi =
  1917:               {
  1918:                 vname=fcbw; vtype=t'; vattr=[]; vglob=true;
  1919:                 vinline=false; vdecl=sr; vid=0; vaddrof=false;
  1920:                 vreferenced=true; vstorage=NoStorage
  1921:               }
  1922:             in
  1923:             let g =  GVarDecl (vi,sr) in
  1924:             let d = defaultCilPrinter#pGlobal () g in
  1925:             let s = Flx_cil_pretty.sprint 65 d in
  1926:             let s = reformatc s in
  1927:             pe ("header '''" ^ s ^ "''';\n");
  1928:             pe ("const "^fcbw^": " ^ tname ^ " = \"" ^ fcbw ^ "\";");
  1929: 
  1930:             (* hack: elide trailing semicolon *)
  1931:             let s = String.sub s 0 (String.length s - 1) in
  1932:             pe ("body '''\n  " ^ s ^ "{");
  1933:             let oargs = ref [] in
  1934:             iter
  1935:             (fun i -> if i <> cbi then
  1936:               oargs := ("a" ^ string_of_int (i+1)) :: !oargs
  1937:             )
  1938:             (nlist (length ps))
  1939:             ;
  1940:             pe (
  1941:               "  return (("^fcbt^")a" ^ string_of_int (cbi+1) ^
  1942:               ")->apply(" ^
  1943:               if List.length !oargs > 1 then
  1944:                 fcbat^"(" ^
  1945:                 String.concat ", " (rev !oargs)^"));"
  1946:               else
  1947:                 String.concat ", " (rev !oargs)^");"
  1948:             );
  1949:             pe ("}''';\n");
  1950: 
  1951:           end
  1952:           ;
  1953:         | _ -> assert false
  1954:       )
  1955:       stab.callback_types
  1956:     end
  1957:     ;
  1958: 
  1959:     if is_nonempty stab.callback_clients then
  1960:     begin
  1961:       let sot t = sot stab t in
  1962:       let soa a = soa stab a in
  1963:       pe "";
  1964:       pe "//CALLBACK CLIENT WRAPPERS";
  1965:       Hashtbl.iter
  1966:       (fun fname (t, cbt, cbi,adri)->
  1967:         pe ("//callback client " ^ fname ^ ", client data at " ^ string_of_int cbi ^ ", callback at " ^ string_of_int adri);
  1968:         match t with
  1969:         | TFun (ret,Some ps, false,a) ->
  1970:           (* fix arg names *)
  1971:           let i = ref 0 in
  1972:           let args = ref [] in
  1973:           iter
  1974:           (fun (_,t,a) ->
  1975:             if !i <> adri then begin
  1976:               let pn = "a"^ string_of_int (!i+1) in
  1977:               let t =
  1978:                 if !i = cbi then "_fcbt_" ^ sot t
  1979:                 else sot t
  1980:               in
  1981:               args := (pn,t) :: !args
  1982:             end
  1983:             ;
  1984:             incr i
  1985:           )
  1986:           ps
  1987:           ;
  1988:           let args = rev !args in
  1989:           let params =
  1990:             catmap ", "
  1991:             (fun (n,t) -> n ^ ": " ^ t)
  1992:             args
  1993:           in
  1994:           let call_args = ref [] in
  1995:           let i = ref 0 in
  1996:           for j = 0 to length ps - 1 do
  1997:             call_args :=
  1998:               begin
  1999:                 if j = adri then
  2000:                   ("C_hack::cast[address]a"^ string_of_int (cbi+1))
  2001:                 else if j = cbi then
  2002:                   ("_fcbw_" ^ cbt)
  2003:                 else begin
  2004:                   while !i=cbi || !i=adri do incr i done;
  2005:                   let a = "a"^ string_of_int (!i+1) in
  2006:                   incr i;
  2007:                   a
  2008:                 end
  2009:               end
  2010:             ::
  2011:             !call_args
  2012:           done
  2013:           ;
  2014:           begin match ret with
  2015:           | TVoid _ ->
  2016:             pe ("proc wrapper_" ^ fname ^ "(" ^ params ^ ") {");
  2017:             pe ("  " ^fname^"(" ^ String.concat ", " (rev !call_args) ^ ");");
  2018:             pe ("}")
  2019: 
  2020:           | ret ->
  2021:             let ret = sot ret in
  2022:             pe ("fun wrapper_" ^ fname ^ "(" ^ params ^ "): "^ret^"= {");
  2023:             pe ("  return " ^fname^"(" ^ String.concat ", " (rev !call_args) ^ ");");
  2024:             pe ("}")
  2025: 
  2026:           end
  2027: 
  2028:         | _ -> assert false
  2029:       )
  2030:       stab.callback_clients
  2031:     end
  2032:     ;
  2033: 
  2034:     if is_nonempty stab.fields then
  2035:     begin
  2036:       pe "";
  2037:       pe "//STRUCT and UNION FIELDS";
  2038:       Hashtbl.iter
  2039:       (fun k (v,b)->
  2040:         pe ("fun " ^ k ^ ": " ^v^ " = '" ^ b ^ "';")
  2041:       )
  2042:       stab.fields
  2043:     end
  2044:   end
  2045:   ;
  2046:   pe "}";
  2047:   close_out outf
  2048:   ;
  2049:   match mode with
  2050:   | `orig -> print_endline ("New file " ^ outname); ()
  2051:   | `tmp ->
  2052:     let f1 = force_open_in "new_file" "tmp.tmp" in
  2053:     let f2 = force_open_in "changed_file" outname in
  2054:     for i = 1 to 6 do (* skip timestamps when comparing *)
  2055:       ignore(input_line f1);
  2056:       ignore(input_line f2)
  2057:     done
  2058:     ;
  2059:     try
  2060:       while true do
  2061:         let in1 = try Some (input_line f1) with End_of_file -> None in
  2062:         let in2 = try Some (input_line f2) with End_of_file -> None in
  2063:         match in1,in2 with
  2064:         | None, None -> raise Equal
  2065:         | Some i, Some j when i = j -> ()
  2066:         | _ -> raise Not_equal
  2067:       done
  2068:     with
  2069:       | Not_equal ->
  2070:         begin
  2071:           print_endline ("Changed file .. " ^ outname);
  2072:           close_in f1; close_in f2;
  2073:           let f1 = force_open_in "changed_file" "tmp.tmp" in
  2074:           let f2 = force_open_out "change_file" outname in
  2075:           try while true do output_string f2 ((input_line f1) ^ "\n")
  2076:           done with End_of_file ->
  2077:           close_in f1; close_out f2
  2078:         end
  2079: 
  2080:       | Equal ->
  2081:         print_endline ("Unchanged file .. " ^ outname);
  2082:         close_in f2;
  2083:         close_in f1
  2084: end
  2085: fnames
  2086: ;;
  2087: 
  2088: if is_nonempty control.incomplete_types_cache then
  2089:   let outname =
  2090:     Filename.concat (control.outdir)
  2091:     ("_incomplete_types_cache.flx")
  2092:   in
  2093:   let outf = autocreate outname in
  2094:   let print_endline s = output_string outf (s ^ "\n") in
  2095:   print_endline "//incomplete type cache";
  2096:   print_endline "module _incomplete_types {";
  2097:   Hashtbl.iter
  2098:   (fun k (v,m) ->
  2099:     match m with
  2100:     | [_] -> ()
  2101:     | _ ->
  2102:       print_endline ("incomplete type " ^ k ^ " = '" ^v^ "';");
  2103:       List.iter
  2104:       (fun s -> print_endline ("  // used by " ^ s)
  2105:       )
  2106:       m
  2107:   )
  2108:   control.incomplete_types_cache
  2109:   ;
  2110:   print_endline "}";
  2111:   close_out outf
  2112: ;;
  2113: 
  2114: let flx f =
  2115:   if control.flxg_command <> "" then begin
  2116:     let cmd = control.flxg_command ^ " -I"^control.outdir^" -c " ^f in
  2117:     print_endline cmd;
  2118:     Unix.system(cmd)
  2119:   end
  2120:   else Unix.WEXITED 0 (* cheat *)
  2121: ;;
  2122: 
  2123: let fnames = ref []
  2124: ;;
  2125: 
  2126: let rec dflx dir =
  2127:   try
  2128:     let f = Unix.opendir dir in
  2129:     begin
  2130:       try
  2131:         while true do let m = Unix.readdir f in
  2132:           let path = Filename.concat dir m in
  2133:           let st =
  2134:             try Unix.lstat path
  2135:             with _ -> failwith ("Can't lstat " ^ path)
  2136:           in
  2137:           match st.Unix.st_kind with
  2138:           | Unix.S_REG ->
  2139:             if Filename.check_suffix path ".flx" then
  2140:             let fn = Filename.chop_suffix path ".flx" in
  2141:             fnames := fn :: !fnames
  2142: 
  2143:           | Unix.S_DIR ->
  2144:             if not (isprefix "." m) then dflx path
  2145:           | _ -> ()
  2146:         done
  2147:       with End_of_file -> Unix.closedir f
  2148:     end
  2149:   with Unix.Unix_error _ ->
  2150:     failwith ("Can't find directory " ^ dir)
  2151: ;;
  2152: 
  2153: dflx control.outdir
  2154: ;;
  2155: 
  2156: let fnames = List.sort compare !fnames
  2157: ;;
  2158: let faulty = ref [];;
  2159: let good = ref [];;
  2160: 
  2161: iter
  2162: begin fun fn ->
  2163:   let result = flx fn in
  2164:   match result with
  2165:   | Unix.WEXITED 0 -> good := fn :: !good
  2166:   | Unix.WEXITED i ->
  2167:     faulty := fn :: !faulty;
  2168:     print_endline ("***** Failed, error " ^ string_of_int i)
  2169:   | Unix.WSIGNALED i
  2170:   | Unix.WSTOPPED i ->
  2171:     failwith ("SIGNAL " ^ string_of_int i)
  2172: end
  2173: fnames
  2174: ;;
  2175: 
  2176: let f = open_out control.log_filename in
  2177:   iter
  2178:   (fun fn ->
  2179:     output_string f ("FAILED   : " ^ fn ^ "\n")
  2180:   )
  2181:   (rev !faulty)
  2182:   ;
  2183:   iter
  2184:   (fun fn ->
  2185:     output_string f ("SUCCEEDED: " ^ fn ^ "\n")
  2186:   )
  2187:   (rev !good)
  2188:   ;
  2189:   close_out f
  2190: ;;
  2191: 
End ocaml section to src/flxcc.ml[1]
Start data section to config/felix.flxcc[1 /1 ]
     1: // Felix: language and core library wrapper control
     2: //
     3: // rename Felix keywords
     4: rename all all_
     5: rename assert assert_
     6: rename axiom axiom_
     7: rename body body_
     8: rename call call_
     9: rename case case_
    10: rename caseno caseno_
    11: rename cclass cclass_
    12: rename cfun cfun_
    13: rename class class_
    14: rename comment comment_
    15: rename compound compound_
    16: rename const const_
    17: rename cparse cparse_
    18: rename cproc cproc_
    19: rename cstruct cstruct_
    20: rename ctor ctor_
    21: rename ctypes ctypes_
    22: rename def def_
    23: rename do do_
    24: rename done done_
    25: rename elif elif_
    26: rename else else_
    27: rename endcase endcase_
    28: rename endif endif_
    29: rename endmatch endmatch_
    30: rename enum enum_
    31: rename expect expect_
    32: rename export export_
    33: rename for for_
    34: rename forget forget_
    35: rename fork fork_
    36: rename functor functor_
    37: rename fun fun_
    38: rename gen gen_
    39: rename goto goto_
    40: rename halt halt_
    41: rename header header_
    42: rename ident ident_
    43: rename include include_
    44: rename incomplete incomplete_
    45: rename inf inf_
    46: rename in in_
    47: rename instance instance_
    48: rename is is_
    49: rename inherit inherit_
    50: rename inline inline_
    51: rename jump jump_
    52: rename lemma lemma_
    53: rename let let_
    54: rename loop loop_
    55: rename lval lval_
    56: rename macro macro_
    57: rename module module_
    58: rename namespace namespace_
    59: rename NaN NaN_
    60: rename new new_
    61: rename noinline noinline_
    62: rename nonterm nonterm_
    63: rename noreturn noreturn_
    64: rename not not_
    65: rename obj obj_
    66: rename open open_
    67: rename package package_
    68: rename pod pod_
    69: rename private private_
    70: rename proc proc_
    71: rename property property_
    72: rename reduce reduce_
    73: rename ref ref_
    74: rename rename rename_
    75: rename requires requires_
    76: rename return return_
    77: rename struct struct_
    78: rename then then_
    79: rename todo todo_
    80: rename to to_
    81: rename typedef typedef_
    82: rename type type_
    83: rename typeclass typeclass_
    84: rename union union_
    85: rename use use_
    86: rename val val_
    87: rename var var_
    88: rename virtual virtual_
    89: rename where where_
    90: rename when when_
    91: rename with with_
    92: rename yield yield_
    93: rename _gc_pointer _gc_pointer_
    94: rename _gc_type _gc_type_
    95: rename _svc _svc_
    96: rename _deref _deref_
    97: rename and and_
    98: rename as as_
    99: rename callback callback_
   100: rename code code_
   101: rename if if_
   102: rename isin isin_
   103: rename match match_
   104: rename noexpand noexpand_
   105: rename of of_
   106: rename or or_
   107: rename parse parse_
   108: rename regexp regexp_
   109: rename reglex reglex_
   110: rename regmatch regmatch_
   111: rename the the_
   112: rename typematch typematch_
   113: rename typecase typecase_
   114: rename whence whence_
   115: rename unless unless_
   116: rename _ __
   117: //
   118: // We need to rename any C++ keywords too
   119: rename namespace namespace_
   120: rename namespace namespace_
   121: //
   122: // remap C types to Felix standard library types
   123: rename size_t size
   124: rename wchar_t wchar
   125: 
   126: // ignore definitions of Felix standard library types
   127: ignore vlong
   128: ignore int
   129: ignore float
   130: ignore char
   131: ignore uvlong
   132: ignore tiny
   133: ignore byte
   134: ignore size
   135: ignore intptr
   136: ignore uchar
   137: ignore uintptr
   138: ignore wchar
   139: ignore long
   140: ignore int8
   141: ignore uint16
   142: ignore complex
   143: ignore limaginary
   144: ignore dcomplex
   145: ignore ptrdiff
   146: ignore uint32
   147: ignore uintmax
   148: ignore lcomplex
   149: ignore int32
   150: ignore int16
   151: ignore ulong
   152: ignore uint8
   153: ignore uint64
   154: ignore uint
   155: ignore offset
   156: ignore imaginary
   157: ignore dimaginary
   158: ignore cvaddress
   159: ignore utiny
   160: ignore short
   161: ignore double
   162: ignore ushort
   163: ignore intmax
   164: ignore int64
   165: ignore caddress
   166: ignore vaddress
   167: ignore ldouble
   168: ignore address
   169: ignore wchar
   170: 
End data section to config/felix.flxcc[1]
Start data section to tmp/gnu_c_search_path.flxcc.default[1 /1 ]
     1: path /usr/local/include
     2: path /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     3: path /usr/include
     4: 
End data section to tmp/gnu_c_search_path.flxcc.default[1]
Start data section to tmp/gnu_cxx_search_path.flxcc.default[1 /1 ]
     1: path /usr/include/c++/4.0.0
     2: path /usr/include/c++/4.0.0/backward
     3: path /usr/include/c++/3.2.2
     4: path /usr/include/c++/3.2.2/backward
     5: path /usr/local/include
     6: path /usr/include/c++/4.0.0/i386-redhat-linux
     7: path /usr/include/c++/3.2.2/i386-redhat-linux
     8: path /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: path /usr/include
    10: 
End data section to tmp/gnu_cxx_search_path.flxcc.default[1]
Start data section to tmp/gnu_headers.flxcc.default[1 /1 ]
     1: // This file contains annotations to control
     2: // use of GNU system header files, and some other
     3: // essential system resources
     4: 
     5: // Some files say:
     6: //
     7: // extern struct X X(..
     8: //
     9: // which defines a function of the same name as
    10: // a struct tag -- this is OK in C, problematic
    11: // in C++, and definitely out for Felix
    12: //
    13: // Such functions are renamed by appending a trailin underscore
    14: // without changing the name of the type
    15: //
    16: // NOTE: this is a serious pain because Felix cstructs
    17: // automatically get constructors of the same name
    18: // so the client using such a name may get an overload
    19: // error (or even worse, a program that has the wrong semantics)
    20: 
    21: rename_nontype sigaltstack sigaltstack_
    22: rename_nontype sigstack sigstack_
    23: rename_nontype sigvec sigvec_
    24: rename_nontype mallinfo mallinfo_
    25: rename_nontype vtimes vtimes_
    26: rename_nontype statfs statfs_
    27: rename_nontype timezone timezone_
    28: 
    29: #include config/gnu_linux_macosx_headers.flxcc
End data section to tmp/gnu_headers.flxcc.default[1]
Start data section to tmp/gnu_macosx_headers.flxcc.default[1 /1 ]
     1: 
End data section to tmp/gnu_macosx_headers.flxcc.default[1]
Start data section to tmp/gnu_linux_headers.flxcc.default[1 /1 ]
     1: // Some files are designed as implementation details
     2: // and not intended to be used directly
     3: // We therefore prevent C level #includes like
     4: //
     5: // header '#include <file>';
     6: //
     7: // from being generated
     8: //
     9: // This related to the merge specifications below,
    10: // but the two facilities are independent
    11: 
    12: noheader /usr/include/bits/byteswap.h
    13: noheader /usr/include/bits/cmathcalls.h
    14: noheader /usr/include/bits/confname.h
    15: noheader /usr/include/bits/dirent.h
    16: noheader /usr/include/bits/dlfcn.h
    17: noheader /usr/include/bits/elfclass.h
    18: noheader /usr/include/bits/endian.h
    19: noheader /usr/include/bits/environments.h
    20: noheader /usr/include/bits/fcntl.h
    21: noheader /usr/include/bits/fenv.h
    22: noheader /usr/include/bits/huge_val.h
    23: noheader /usr/include/bits/in.h
    24: noheader /usr/include/bits/ioctls.h
    25: noheader /usr/include/bits/ioctl-types.h
    26: noheader /usr/include/bits/ipc.h
    27: noheader /usr/include/bits/ipctypes.h
    28: noheader /usr/include/bits/locale.h
    29: noheader /usr/include/bits/mathcalls.h
    30: noheader /usr/include/bits/mathdef.h
    31: noheader /usr/include/bits/mathinline.h
    32: noheader /usr/include/bits/mman.h
    33: noheader /usr/include/bits/msq.h
    34: noheader /usr/include/bits/nan.h
    35: noheader /usr/include/bits/netdb.h
    36: noheader /usr/include/bits/poll.h
    37: noheader /usr/include/bits/posix1_lim.h
    38: noheader /usr/include/bits/posix2_lim.h
    39: noheader /usr/include/bits/pthreadtypes.h
    40: noheader /usr/include/bits/resource.h
    41: noheader /usr/include/bits/sched.h
    42: noheader /usr/include/bits/select.h
    43: noheader /usr/include/bits/sem.h
    44: noheader /usr/include/bits/setjmp.h
    45: noheader /usr/include/bits/shm.h
    46: //noheader /usr/include/bits/sigset.h
    47: //noheader /usr/include/bits/sigaction.h
    48: //noheader /usr/include/bits/sigcontext.h
    49: //noheader /usr/include/bits/siginfo.h
    50: //noheader /usr/include/bits/sigstack.h
    51: //noheader /usr/include/bits/sigthread.h
    52: noheader /usr/include/bits/sockaddr.h
    53: noheader /usr/include/bits/socket.h
    54: noheader /usr/include/bits/statfs.h
    55: noheader /usr/include/bits/stat.h
    56: noheader /usr/include/bits/statvfs.h
    57: noheader /usr/include/bits/stdio.h
    58: noheader /usr/include/bits/stdio_lim.h
    59: noheader /usr/include/bits/string2.h
    60: noheader /usr/include/bits/string.h
    61: noheader /usr/include/bits/stropts.h
    62: noheader /usr/include/bits/syscall.h
    63: noheader /usr/include/bits/sys_errlist.h
    64: noheader /usr/include/bits/termios.h
    65: noheader /usr/include/bits/time.h
    66: noheader /usr/include/bits/types.h
    67: noheader /usr/include/bits/typesizes.h
    68: noheader /usr/include/bits/uio.h
    69: noheader /usr/include/bits/ustat.h
    70: noheader /usr/include/bits/utmp.h
    71: noheader /usr/include/bits/utmpx.h
    72: noheader /usr/include/bits/utsname.h
    73: noheader /usr/include/bits/waitflags.h
    74: noheader /usr/include/bits/waitstatus.h
    75: noheader /usr/include/bits/xopen_lim.h
    76: noheader /usr/include/bits/xtitypes.h
    77: 
    78: // Some files have aliases created by
    79: // symlinks and others include details
    80: // that should really be treated as if they're
    81: // physically included in the file, rather than
    82: // a separate module -- see above comments on
    83: // the related noheader command
    84: //
    85: // We use merge specification to say that any
    86: // text found in the first file is treated as
    87: // if it were physically part of the second one
    88: 
    89: merge /usr/include/bits/sigset.h /usr/include/signal.h
    90: merge /usr/include/bits/sigaction.h /usr/include/signal.h
    91: merge /usr/include/bits/sigcontext.h /usr/include/signal.h
    92: merge /usr/include/bits/siginfo.h /usr/include/signal.h
    93: merge /usr/include/bits/sigstack.h /usr/include/signal.h
    94: merge /usr/include/bits/sigthread.h /usr/include/pthread.h
    95: merge /usr/include/bits/sched.h /usr/include/sched.h
    96: merge /usr/include/bits/pthreadtypes.h /usr/include/sys/types.h
    97: merge /usr/include/bits/confname.h /usr/include/unistd.h
    98: merge /usr/include/bits/time.h /usr/include/time.h
    99: 
   100: merge /usr/include/bits/byteswap.h /usr/include/byteswap.h
   101: merge /usr/include/bits/cmathcalls.h /usr/include/complex.h
   102: merge /usr/include/bits/dirent.h /usr/include/dirent.h
   103: merge /usr/include/bits/dlfcn.h /usr/include/dlfcn.h
   104: merge /usr/include/bits/elfclass.h /usr/include/link.h
   105: merge /usr/include/bits/endian.h /usr/include/endian.h
   106: merge /usr/include/bits/errno.h /usr/include/errno.h
   107: merge /usr/include/bits/environments.h /usr/include/unistd.h
   108: merge /usr/include/bits/fcntl.h /usr/include/fcntl.h
   109: merge /usr/include/bits/fenv.h /usr/include/fenv.h
   110: merge /usr/include/bits/huge_val.h /usr/include/math.h
   111: merge /usr/include/bits/in.h /usr/include/netinet/in.h
   112: merge /usr/include/bits/ioctls.h /usr/include/sys/ioctl.h
   113: merge /usr/include/bits/ioctl-types.h /usr/include/sys/ioctl.h
   114: merge /usr/include/bits/ipc.h /usr/include/sys/ipc.h
   115: merge /usr/include/bits/ipctypes.h /usr/include/sys/ipc.h
   116: merge /usr/include/bits/locale.h /usr/include/locale.h
   117: merge /usr/include/bits/mathcalls.h /usr/include/math.h
   118: merge /usr/include/bits/mathdef.h /usr/include/math.h
   119: merge /usr/include/bits/mathinline.h /usr/include/math.h
   120: merge /usr/include/bits/mman.h /usr/include/sys/mman.h
   121: merge /usr/include/bits/msq.h /usr/include/sys/msg.h
   122: merge /usr/include/bits/nan.h /usr/include/math.h
   123: merge /usr/include/bits/netdb.h /usr/include/netdb.h
   124: merge /usr/include/bits/poll.h /usr/include/sys/poll.h
   125: merge /usr/include/bits/posix1_lim.h /usr/include/limits.h
   126: merge /usr/include/bits/posix2_lim.h /usr/include/limits.h
   127: merge /usr/include/bits/resource.h /usr/include/sys/resource.h
   128: merge /usr/include/bits/select.h /usr/include/sys/select.h
   129: merge /usr/include/bits/sem.h /usr/include/sys/sem.h
   130: merge /usr/include/bits/setjmp.h /usr/include/setjmp.h
   131: merge /usr/include/bits/shm.h /usr/include/sys/shm.h
   132: merge /usr/include/bits/sockaddr.h /usr/include/sys/socket.h
   133: merge /usr/include/bits/socket.h /usr/include/sys/socket.h
   134: merge /usr/include/bits/statfs.h /usr/include/sys/statfs.h
   135: merge /usr/include/bits/stat.h /usr/include/sys/stat.h
   136: merge /usr/include/bits/statvfs.h /usr/include/sys/statvfs.h
   137: merge /usr/include/bits/stdio.h /usr/include/stdio.h
   138: merge /usr/include/bits/stdio_lim.h /usr/include/stdio.h
   139: merge /usr/include/bits/string2.h /usr/include/string.h
   140: merge /usr/include/bits/string.h /usr/include/string.h
   141: merge /usr/include/bits/stropts.h /usr/include/stropts.h
   142: merge /usr/include/bits/syscall.h /usr/include/sys/syscall.h
   143: merge /usr/include/bits/sys_errlist.h /usr/include/stdio.h
   144: merge /usr/include/bits/termios.h /usr/include/termios.h
   145: merge /usr/include/bits/types.h /usr/include/sys/types.h
   146: merge /usr/include/bits/typesizes.h /usr/include/sys/types.h
   147: merge /usr/include/bits/uio.h /usr/include/sys/uio.h
   148: merge /usr/include/bits/ustat.h /usr/include/sys/ustat.h
   149: merge /usr/include/bits/utmp.h /usr/include/utmp.h
   150: merge /usr/include/bits/utmpx.h /usr/include/utmpx.h
   151: merge /usr/include/bits/utsname.h /usr/include/sys/utsname.h
   152: merge /usr/include/bits/waitflags.h /usr/include/sys/wait.h
   153: merge /usr/include/bits/waitstatus.h /usr/include/sys/wait.h
   154: merge /usr/include/bits/xopen_lim.h /usr/include/limits.h
   155: merge /usr/include/bits/xtitypes.h /usr/include/stropts.h
   156: 
End data section to tmp/gnu_linux_headers.flxcc.default[1]
Start data section to tmp/c89.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_c_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir c89
     7: prefix /usr/include
     8: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: preprocessor gcc -E -std=c89
    10: language C
    11: 
    12: //-pthread -D_REENTRANT -DNEED_GNOMESUPPORT_H -DGTKHTML_HAVE_GCONF -DORBIT2=1
    13: 
    14: incfile assert.h
    15: incfile ctype.h
    16: incfile errno.h
    17: incfile fenv.h
    18: incfile float.h
    19: //incfile iso646.h: c99 only
    20: incfile limits.h
    21: incfile locale.h
    22: incfile math.h
    23: incfile setjmp.h
    24: incfile signal.h
    25: incfile stdarg.h
    26: incfile stddef.h
    27: incfile stdio.h
    28: incfile stdlib.h
    29: incfile string.h
    30: incfile time.h
    31: incfile wchar.h
    32: incfile wctype.h
    33: 
    34: rename String String_
    35: 
End data section to tmp/c89.flxcc.default[1]
Start data section to tmp/gnu89.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_c_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir gnu89
     7: prefix /usr/include
     8: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: preprocessor gcc -E -std=gnu89
    10: language C
    11: //-pthread -D_REENTRANT -DNEED_GNOMESUPPORT_H -DGTKHTML_HAVE_GCONF -DORBIT2=1
    12: flx_compiler bin/flxg -Ilib
    13: 
    14: incfile assert.h
    15: incfile ctype.h
    16: incfile errno.h
    17: incfile fenv.h
    18: incfile float.h
    19: //incfile inttypes.h: c99 only
    20: //incfile iso646.h: c99 only
    21: incfile limits.h
    22: incfile locale.h
    23: incfile math.h
    24: incfile setjmp.h
    25: incfile signal.h
    26: incfile stdarg.h
    27: //incfile stdbool.h: c99 only
    28: incfile stddef.h
    29: //incfile stdint.h: c99 only
    30: incfile stdio.h
    31: incfile stdlib.h
    32: incfile string.h
    33: //incfile tgmath.h: c99 only
    34: incfile time.h
    35: incfile wchar.h
    36: incfile wctype.h
    37: 
    38: rename String String_
    39: 
End data section to tmp/gnu89.flxcc.default[1]
Start data section to tmp/c99.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_c_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir c99
     7: prefix /usr/include
     8: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: preprocessor gcc -E -std=c99
    10: language C
    11: 
    12: incfile assert.h
    13: incfile ctype.h
    14: incfile complex.h
    15: incfile errno.h
    16: incfile fenv.h
    17: incfile float.h
    18: incfile inttypes.h
    19: //incfile iso646.h: just macros
    20: incfile limits.h
    21: incfile locale.h
    22: incfile math.h
    23: incfile setjmp.h
    24: incfile signal.h
    25: incfile stdarg.h
    26: incfile stdbool.h
    27: incfile stddef.h
    28: incfile stdint.h
    29: incfile stdio.h
    30: incfile stdlib.h
    31: incfile string.h
    32: incfile tgmath.h
    33: incfile time.h
    34: incfile wchar.h
    35: incfile wctype.h
    36: 
    37: rename String String_
    38: 
End data section to tmp/c99.flxcc.default[1]
Start data section to tmp/gnu99.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_c_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir gnu99
     7: prefix /usr/include
     8: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: preprocessor gcc -E -std=gnu99
    10: language C
    11: //-pthread -D_REENTRANT -DNEED_GNOMESUPPORT_H -DGTKHTML_HAVE_GCONF -DORBIT2=1
    12: 
    13: incfile assert.h
    14: incfile ctype.h
    15: incfile complex.h
    16: incfile errno.h
    17: incfile fenv.h
    18: incfile float.h
    19: incfile inttypes.h
    20: //incfile iso646.h: just macros
    21: incfile limits.h
    22: incfile locale.h
    23: incfile math.h
    24: incfile setjmp.h
    25: incfile signal.h
    26: incfile stdarg.h
    27: incfile stdbool.h
    28: incfile stddef.h
    29: incfile stdint.h
    30: incfile stdio.h
    31: incfile stdlib.h
    32: incfile string.h
    33: incfile tgmath.h
    34: incfile time.h
    35: incfile wchar.h
    36: incfile wctype.h
    37: 
    38: rename String String_
    39: 
End data section to tmp/gnu99.flxcc.default[1]
Start data section to tmp/cxx.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_cxx_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir cxx
     7: prefix /usr/include
     8: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: preprocessor g++ -E -I/usr/include/g++-3
    10: language C++
    11: 
    12: //-pthread -D_REENTRANT -DNEED_GNOMESUPPORT_H -DGTKHTML_HAVE_GCONF -DORBIT2=1
    13: 
    14: incfile cctype
    15: incfile cerrno
    16: //incfile cfenv: cfenv.h is c99, we expect this to come to C++
    17: incfile cfloat
    18: incfile climits
    19: incfile clocale
    20: incfile cmath
    21: incfile csetjmp
    22: incfile csignal
    23: incfile cstdarg
    24: incfile cstddef
    25: //incfile cstdint
    26: incfile cstdio
    27: incfile cstdlib
    28: incfile cstring
    29: incfile ctime
    30: incfile cwchar
    31: incfile cwctype
    32: 
    33: rename String String_
    34: 
End data section to tmp/cxx.flxcc.default[1]
Start data section to tmp/cxx_sys.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_cxx_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir cxx_sys
     7: prefix /usr/include
     8: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: preprocessor g++ -E -I/usr/include/g++-3
    10: language C++
    11: 
    12: //-pthread -D_REENTRANT -DNEED_GNOMESUPPORT_H -DGTKHTML_HAVE_GCONF -DORBIT2=1
    13: 
    14: incfile cctype
    15: incfile cerrno
    16: //incfile cfenv: cfenv.h is c99, we expect this to come to C++
    17: incfile cfloat
    18: incfile climits
    19: incfile clocale
    20: incfile cmath
    21: incfile csetjmp
    22: incfile csignal
    23: incfile cstdarg
    24: incfile cstddef
    25: //incfile cstdint
    26: incfile cstdio
    27: incfile cstdlib
    28: incfile cstring
    29: incfile ctime
    30: incfile cwchar
    31: incfile cwctype
    32: incdir /usr/include/sys
    33: 
    34: rename String String_
    35: 
End data section to tmp/cxx_sys.flxcc.default[1]
Start data section to tmp/gnucxx.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_cxx_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir gnucxx
     7: prefix /usr/include
     8: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
     9: preprocessor g++ -E -I/usr/include/g++-3
    10: language C++
    11: 
    12: //-pthread -D_REENTRANT -DNEED_GNOMESUPPORT_H -DGTKHTML_HAVE_GCONF -DORBIT2=1
    13: 
    14: incfile cctype
    15: incfile cerrno
    16: incfile cfloat
    17: incfile climits
    18: incfile clocale
    19: incfile cmath
    20: incfile csetjmp
    21: incfile csignal
    22: incfile cstdarg
    23: incfile cstddef
    24: //incfile cstdint
    25: incfile cstdio
    26: incfile cstdlib
    27: incfile cstring
    28: incfile ctime
    29: incfile cwchar
    30: incfile cwctype
    31: 
    32: rename String String_
    33: 
End data section to tmp/gnucxx.flxcc.default[1]
Start data section to tmp/usr_include.flxcc.default[1 /1 ]
     1: #include config/felix.flxcc
     2: #include config/gnu_headers.flxcc
     3: #include config/gnu_cxx_search_path.flxcc
     4: flx_compiler bin/flxg -Ilib
     5: 
     6: outdir flxcc_out
     7: prefix /usr/include
     8: prefix /usr/local/include
     9: prefix /usr/lib/gcc-lib/i386-redhat-linux/3.2.2/include
    10: prefix /usr/lib/glib/include/ glib
    11: preprocessor g++ -E
    12: language C
    13: 
    14: //-pthread -D_REENTRANT -DNEED_GNOMESUPPORT_H -DGTKHTML_HAVE_GCONF -DORBIT2=1
    15: 
    16: path /usr/include/atk-1.0
    17: path /usr/include/bonobo-activation-2.0
    18: path /usr/include/eel-2
    19: path /usr/include/gail-1.0
    20: path /usr/include/gal-1.0
    21: path /usr/include/gconf/2
    22: path /usr/include/gtk-2.0
    23: path /usr/lib/gtk-2.0/include
    24: path /usr/include/X11
    25: path /usr/include/glib-2.0
    26: path /usr/lib/glib-2.0/include
    27: path /usr/lib/glib/include
    28: path /usr/include/gnome-vfs-2.0
    29: path /usr/lib/gnome-vfs-2.0/include
    30: path /usr/include/gnome-vfs-module-2.0
    31: path /usr/include/gtkhtml-1.1
    32: path /usr/include/gdk-pixbuf-1.0
    33: path /usr/include/gnome-1.0
    34: path /usr/include/freetype2
    35: path /usr/lib/gnome-libs/include
    36: path /usr/include/gnome-xml
    37: path /usr/include/libglade-1.0
    38: path /usr/include/libart-2.0
    39: path /usr/include/libbonobo-2.0
    40: path /usr/include/libbonoboui-2.0
    41: path /usr/include/libglade-2.0
    42: path /usr/include/libgnome-2.0
    43: path /usr/include/libgnomecanvas-2.0
    44: path /usr/include/libgnomeui-2.0
    45: path /usr/include/libgsf-1
    46: path /usr/include/libIDL-2.0
    47: path /usr/include/metacity-1
    48: path /usr/include/panel-2.0
    49: path /usr/include/libpng12
    50: path /usr/include/librsvg-2
    51: path /usr/include/libxml2
    52: path /usr/include/linc-1.0
    53: path /usr/kerberos/include
    54: path /usr/include/orbit-2.0
    55: path /usr/include/orbit-2.0/orbit-idl
    56: path /usr/include/pango-1.0
    57: 
    58: incdir /usr/include
    59: incdir /usr/include/sys
    60: incdir /usr/include/gtk-2.0/gdk
    61: incdir /usr/include/gtk-2.0/gdk-pixbuf
    62: incdir /usr/include/gtkhtml-1.1
    63: recincdir /usr/include/libIDL-2.0
    64: incfile /usr/include/gtk-2.0/gtk/gtk.h
    65: recincdir /usr/local/include/python2.3
    66: 
    67: exclude /usr/include/af_vfs.h
    68: exclude /usr/include/disptmpl.h
    69: exclude /usr/include/bits
    70: exclude /usr/include/asm
    71: exclude /usr/include/linux
    72: exclude /usr/include/glib-1.2
    73: exclude /usr/include/orbit-1.0
    74: exclude /usr/include/c++
    75: exclude /usr/include/g++-3
    76: exclude /usr/include/libglade-1.0
    77: exclude /usr/include/gtk-1.2
    78: exclude /usr/include/glib-2.0/gobject
    79: exclude /usr/include/FlexLexer.h
    80: exclude /usr/include/swig.h
    81: exclude /usr/include/Imlib.h
    82: exclude /usr/include/Imlib_private.h
    83: exclude /usr/include/Imlib_types.h
    84: exclude /usr/include/rle_config.h
    85: exclude /usr/include/md5.h
    86: exclude /usr/include/pcap-namedb.h
    87: exclude /usr/include/regexp.h
    88: exclude /usr/include/hmac-md5.h
    89: exclude /usr/include/jmorecfg.h
    90: exclude /usr/include/jconfig.h
    91: exclude /usr/local/include/python2.3/pymactoolbox.h
    92: exclude /usr/include/libmng.h
    93: exclude /usr/include/mp.h
    94: exclude /usr/include/pammap.h
    95: 
    96: rename String String_
    97: 
    98: rename_nontype _ns_flagdata _ns_flagdata_
    99: rename_nontype usb_device usb_device_
   100: rename_nontype tcpd_context tcpd_context_
   101: 
   102: merge /usr/X11R6/include/X11 /usr/include/X11
   103: 
   104: 
End data section to tmp/usr_include.flxcc.default[1]