← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to utils/h2pas/scan.pas

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/h2pas/scan.pas
3
3
 
4
4
(* global definitions: *)
5
5
{
6
 
    $Id: scan.pas,v 1.5 2004/02/09 18:52:42 michael Exp $
 
6
    $Id: scan.pas,v 1.8 2005/02/14 17:13:39 peter Exp $
7
7
    Copyright (c) 1998-2000 by Florian Klaempfl
8
8
 
9
9
    This program is free software; you can redistribute it and/or modify
32
32
   lexlib,yacclib;
33
33
 
34
34
    const
35
 
       version = '0.99.15';
 
35
       version = '0.99.16';
36
36
 
37
37
    type
38
38
       Char=system.char;
115
115
          { p1 expr for value }
116
116
          );
117
117
 
 
118
const
 
119
   ttypstr: array[ttyp] of string =
 
120
   (
 
121
          't_id',
 
122
          't_arraydef',
 
123
          't_pointerdef',
 
124
          't_addrdef',
 
125
          't_void',
 
126
          't_dec',
 
127
          't_declist',
 
128
          't_memberdec',
 
129
          't_structdef',
 
130
          't_memberdeclist',
 
131
          't_procdef',
 
132
          't_uniondef',
 
133
          't_enumdef',
 
134
          't_enumlist',
 
135
          't_preop',
 
136
          't_bop',
 
137
          't_arrayop',
 
138
          't_callop',
 
139
          't_arg',
 
140
          't_arglist',
 
141
          't_funexprlist',
 
142
          't_exprlist',
 
143
          't_ifexpr',
 
144
          't_funcname',
 
145
          't_typespec',
 
146
          't_size_specifier',
 
147
          't_default_value'
 
148
   );
 
149
 
 
150
type
 
151
 
118
152
       presobject = ^tresobject;
119
153
       tresobject = object
120
154
          typ : ttyp;
149
183
       c : char;
150
184
       aktspace : string;
151
185
       block_type : tblocktype;
 
186
       commentstr: string;
152
187
 
153
188
    const
154
189
       in_define : boolean = false;
164
199
 
165
200
    function strpnew(const s : string) : pchar;
166
201
 
 
202
    procedure writetree(p: presobject);
 
203
 
 
204
 
167
205
  implementation
168
206
 
169
207
    uses
173
211
       newline = #10;
174
212
 
175
213
 
 
214
    procedure writeentry(p: presobject; var currentlevel: integer);
 
215
    begin
 
216
                     if assigned(p^.p1) then
 
217
                        begin
 
218
                          WriteLn(' Entry p1[',ttypstr[p^.p1^.typ],']',p^.p1^.str);
 
219
                        end;
 
220
                     if assigned(p^.p2) then
 
221
                        begin
 
222
                          WriteLn(' Entry p2[',ttypstr[p^.p2^.typ],']',p^.p2^.str);
 
223
                        end;
 
224
                     if assigned(p^.p3) then
 
225
                        begin
 
226
                          WriteLn(' Entry p3[',ttypstr[p^.p3^.typ],']',p^.p3^.str);
 
227
                        end;
 
228
    end;
 
229
 
 
230
    procedure writetree(p: presobject);
 
231
    var
 
232
     i : integer;
 
233
     localp: presobject;
 
234
     localp1: presobject;
 
235
     currentlevel : integer;
 
236
    begin
 
237
      localp:=p;
 
238
      currentlevel:=0;
 
239
      while assigned(localp) do
 
240
         begin
 
241
          WriteLn('Entry[',ttypstr[localp^.typ],']',localp^.str);
 
242
          case localp^.typ of
 
243
          { Some arguments sharing the same type }
 
244
          t_arglist:
 
245
            begin
 
246
               localp1:=localp;
 
247
               while assigned(localp1) do
 
248
                  begin
 
249
                     writeentry(localp1,currentlevel);
 
250
                     localp1:=localp1^.p1;
 
251
                  end;
 
252
            end;
 
253
          end;
 
254
 
 
255
          localp:=localp^.next;
 
256
         end;
 
257
    end;
 
258
 
 
259
 
 
260
 
176
261
    procedure internalerror(i : integer);
177
262
      begin
178
263
         writeln('Internal error ',i,' in line ',yylineno);
393
478
                                   if c='/' then
394
479
                                    begin
395
480
                                      if not stripcomment then
396
 
                                       writeln(outfile,' }');
 
481
                                       write(outfile,' }');
 
482
                                      c:=get_char;
 
483
                                      if (c=newline) then
 
484
                                      begin
 
485
                                        writeln(outfile);
 
486
                                        unget_char(c);
 
487
                                      end;
397
488
                                      flush(outfile);
398
489
                                      exit;
399
490
                                    end
400
491
                                   else
401
492
                                    begin
402
493
                                      if not stripcomment then
403
 
                                       write(outfile,' ');
 
494
                                       write(outfile,'*');
404
495
                                      unget_char(c)
405
496
                                    end;
406
497
                                  end;
412
503
                                       write(outfile,aktspace);
413
504
                                     end;
414
505
                                  end;
 
506
                                { Don't write this thing out, to
 
507
                                  avoid nested comments.
 
508
                                }
 
509
                              '{','}' :
 
510
                                  begin
 
511
                                  end;
415
512
                                #0 :
416
513
                                  commenteof;
417
514
                                else
423
520
                        end;
424
521
  2:
425
522
                        begin
 
523
                          commentstr:='';
 
524
                          if (in_define) and not (stripcomment) then
 
525
                          begin
 
526
                             commentstr:='{';
 
527
                          end
 
528
                          else
426
529
                          If not stripcomment then
427
530
                            write(outfile,aktspace,'{');
 
531
 
428
532
                          repeat
429
533
                            c:=get_char;
430
534
                            case c of
432
536
                                begin
433
537
                                  unget_char(c);
434
538
                                  if not stripcomment then
435
 
                                   writeln(outfile,' }');
 
539
                                    begin
 
540
                                      if in_define then
 
541
                                        begin
 
542
                                          commentstr:=commentstr+' }';
 
543
                                        end
 
544
                                      else
 
545
                                        begin
 
546
                                          write(outfile,' }');
 
547
                                          writeln(outfile);
 
548
                                        end;
 
549
                                    end;
436
550
                                  flush(outfile);
437
551
                                  exit;
438
552
                                end;
 
553
                              { Don't write this comment out,
 
554
                                to avoid nested comment problems
 
555
                              }
 
556
                              '{','}' :
 
557
                                  begin
 
558
                                  end;
439
559
                              #0 :
440
560
                                commenteof;
441
561
                              else
442
562
                                if not stripcomment then
443
 
                                 write(outfile,c);
 
563
                                  begin
 
564
                                    if in_define then
 
565
                                     begin
 
566
                                       commentstr:=commentstr+c;
 
567
                                     end
 
568
                                    else
 
569
                                      write(outfile,c);
 
570
                                  end;
444
571
                            end;
445
572
                          until false;
446
573
                          flush(outfile);
466
593
                           return(NUMBER);
467
594
                        end;
468
595
  8:
469
 
                          
 
596
 
470
597
                        begin
471
598
                           (* handle pre- and postfixes *)
472
599
                           if copy(yytext,1,2)='0x' then
479
606
                           return(NUMBER);
480
607
                        end;
481
608
  9:
482
 
                             
 
609
 
483
610
                        begin
484
611
                          return(NUMBER);
485
612
                        end;
603
730
  49:
604
731
                        return(VOID);
605
732
  50:
606
 
                                                      
 
733
 
607
734
                        begin
608
735
                          if not stripinfo then
609
736
                            writeln(outfile,'{ C++ extern C conditionnal removed }');
610
737
                        end;
611
738
  51:
612
 
                                         
 
739
 
613
740
                        begin
614
741
                          if not stripinfo then
615
742
                            writeln(outfile,'{ C++ end of extern C conditionnal removed }');
698
825
                        end;
699
826
  61:
700
827
                        begin
 
828
                           commentstr:='';
701
829
                           in_define:=true;
702
830
                           in_space_define:=1;
703
831
                           return(DEFINE);
764
892
                        begin
765
893
                           if in_define then
766
894
                            begin
767
 
                              in_space_define:=0;  
 
895
                              in_space_define:=0;
768
896
                              if cont_line then
769
897
                              begin
770
898
                                cont_line:=false;
778
906
                       end;
779
907
  87:
780
908
                       begin
781
 
                           if in_define then 
 
909
                           if in_define then
782
910
                           begin
783
911
                             cont_line:=true;
784
912
                           end