OpenCores
URL https://opencores.org/ocsvn/usb_fpga_1_11/usb_fpga_1_11/trunk

Subversion Repositories usb_fpga_1_11

[/] [usb_fpga_1_11/] [trunk/] [bmp/] [src/] [bmp.pas] - Blame information for rev 9

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 2 ZTEX
{*!
2
   bmp -- babel macro processor
3 9 ZTEX
   Copyright (C) 2009-2014 ZTEX GmbH.
4 2 ZTEX
   http://www.ztex.de
5
 
6
   This program is free software; you can redistribute it and/or modify
7
   it under the terms of the GNU General Public License version 3 as
8
   published by the Free Software Foundation.
9
 
10
   This program is distributed in the hope that it will be useful, but
11
   WITHOUT ANY WARRANTY; without even the implied warranty of
12
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13
   General Public License for more details.
14
 
15
   You should have received a copy of the GNU General Public License
16
   along with this program; if not, see http://www.gnu.org/licenses/.
17
!*}
18
 
19
{ todo:
20
Ausgabe als Eingabe (mehrfache Bearbeitung)
21
}
22
 
23
{ codes
24
    bc_pm : string
25
    bc_ob : char
26
    bc_cb : char
27
    bc_pa : char
28
 
29
meta macros:
30
  define
31
    define(sym)         define symb
32
    define(m1)(r1)      define macro m1 with replacement r1
33
    define(m2)(p2)(r2)  define macro m2 with parmaters p2 and replacement r1
34
 
35
  udefine
36
  uadefine
37
 
38
  include
39
 
40
  ifdef/ifndef
41
  elifdef/elfndef
42
  ifeq/ifneq            macros are expanded in the compared strings, but no meta macros, except of \\noexapnd which disbales the expansion
43
  elifeq/elifneq
44
  else
45
  endif
46
 
47
  nolf
48
 
49
  error
50
  warning
51
 
52
  disablaeout
53
  enableout
54
 
55
  ignorecase
56
  exactcase
57
 
58
  noexpand
59 5 ZTEX
 
60
  disablelineinfo       disables line info for next define
61
 
62 2 ZTEX
}
63
 
64
{$mode objfpc}
65
 
66
{$define USE_SHORTSTRINGS}  // shortstrings are two times faster
67
{ $define ENABLE_DEBUGOUT}
68
 
69
uses dos,strings,textbuf,bmpsys,sysutils;
70
 
71
{ ******************************************************************** }
72
{ ****** constants *************************************************** }
73
{ ******************************************************************** }
74
{$ifdef USE_SHORTSTRINGS}
75
type bmpstring = shortstring;
76
{$else}
77
type bmpstring = ansistring;
78
{$endif}
79
 
80
const rbufmax     = 65535;  { must be 2^n-1 ! }
81
      maxmacros   = 16383;  { max amount of macros }
82
      maxifs      = 4095;   { max input files }
83
      maxbs       = 255;    { brace stack }
84
      maxoutfiles = 256;    { max input files }
85
      maxparams   = 35;     { max amount of macro parameters }
86
 
87
      bc_pm : bmpstring = '//';    { default for pascal mode }
88
      bc_ob : char = '[';          { default }
89
      bc_cb : char = ']';          { default }
90
      bc_pa : char = '#';          { default for pascal mode }
91
      bc_lf = #10;
92
      bp_icase : boolean = false;  { ignore case }
93
 
94
{$ifdef WINDOWS}
95
      dirsep = '\';                { directory seperator }
96
{$else}
97
      dirsep = '/';                { directory seperator }
98
{$endif}
99
 
100
      enable_hints : boolean = true;    { enable hints }
101
      printdefs    : boolean = false;   { print definitions }
102
{$ifdef ENABLE_DEBUGOUT}
103
      debugoutput  : boolean = false;   { debug mode }
104
{$endif}
105
      paramids : array[0..maxparams] of char = ('0','1','2','3','4','5','6','7','8','9',   { parameters (in that order!) }
106
                                                'a','b','c','d','e','f','g','h','i','j',
107
                                                'k','l','m','n','o','p','q','r','s','t',
108
                                                'u','v','w','x','y','z');
109
 
110
{ ****** modes ******************************************************* }
111
const bm_plain   = 0;
112
      bm_neplain = 1;         { no expand plain }
113
 
114
      bm_comm = 10;           { comment }
115
 
116
      bm_em = 100;            { (macro) expanding mode }
117
      bm_em_p0 = 101;         { zero paramter (#0) }
118
      bm_em_pz = bm_em_p0+maxparams;     { last paramter }
119
 
120
      bm_pm = 1000;           { programming mode }
121
 
122
      bm_def = 1100;          { define mode }
123
      bm_def_sob2 = 1101;     { searching 2nd opening bracket }
124
      bm_def_sob3 = 1102;     { searching 3rd opening bracket }
125
      bm_def_scb1 = 1103;     { searching 1st closing bracket }
126
      bm_def_scb2 = 1104;     { searching 2nd closing bracket }
127
      bm_def_scb3 = 1105;     { searching 3rd closing bracket }
128
      bm_def_scbu = 1120;     { searching udefine closing bracket }
129
      bm_def_scba = 1130;     { searching uadefine closing bracket }
130
 
131
      bm_if        = 1200;     { if mode }
132
      bm_if_scb    = 1201;     { searching closing bracket }
133
      bm_ifn_scb   = 1202;     { searching closing bracket }
134
      bm_if_not    = 1203;     { marks the ignored part, searching for else }
135
 
136
      bm_ifeq_sob      = 1210;
137
      bm_ifneq_sob     = 1211;
138
      bm_ifeq_scb1     = 1212;
139
      bm_ifeq_scb2     = 1213;
140
      bm_ifneq_scb1    = 1214;
141
      bm_ifneq_scb2    = 1215;
142
      bm_ifeq_scb1_ne  = 1216;
143
      bm_ifeq_scb2_ne  = 1217;
144
      bm_ifneq_scb1_ne = 1218;
145
      bm_ifneq_scb2_ne = 1219;
146
      bm_ifb           = 1220;
147
 
148
      bm_inc = 1300;          { include mode }
149
      bm_inc_scb = 1301;      { searching closing bracket }
150
 
151
      bm_noexpand = 1400;     { noexpand mode }
152
      bm_noexpand_scb = 1401; { searching closing bracket }
153
 
154
      bm_err = 1500;          { error }
155
      bm_err_scb = 1501;      { searching closing bracket }
156
 
157
      bm_warn = 1510;         { warning }
158
      bm_warn_scb = 1511;     { searching closing bracket }
159
 
160
 
161
      bm_outfile_a = 10000;   { outfile number }
162
      bm_outfile_z = bm_outfile_a+maxoutfiles;
163
 
164
      bm_invalid = -1;        { invalid character }
165
 
166
 
167
{ ******************************************************************** }
168
{ ****** helper functions ******************************************** }
169
{ ******************************************************************** }
170
function upcase(ch:char):char;  { no Umlaute }
171
begin
172
if (ch>='a') and (ch<='z')
173
  then result:=chr(ord(ch)-32)
174
  else result:=ch;
175
end;
176
 
177
function upstr(const s:bmpstring):bmpstring;
178
var i  : longint;
179
begin
180
setlength(upstr, length(s));
181
for i:=1 to length(s) do
182
  begin
183
  if (s[i]>='a') and (s[i]<='z')
184
     then upstr[i]:=chr(ord(s[i])-32)
185
     else upstr[i]:=s[i];
186
  end;
187
end;
188
 
189
procedure upstr2(var s:shortstring);
190
var i : longint;
191
begin
192
for i:=1 to length(s) do
193
  if (s[i]>='a') and (s[i]<='z') then byte(s[i])-=32;
194
end;
195
 
196
 
197
{ ******************************************************************** }
198
{ ****** rbufstr ***************************************************** }
199
{ ******************************************************************** }
200
type RBufStr = record              { string within ring,  }
201
       rbuf      : pchar;          { buffer }
202
       pt        : longint;        { where the ring starts }
203
       length    : longint;        { length of the string }
204
       end;
205
 
206
function rbuf(const rb:rbufstr):bmpstring;
207
var i,j,k : longint;
208
begin
209
k:=rb.length;
210
{$ifdef USE_SHORTSTRINGS}
211
if k>255 then k:=255;
212
{$endif}
213
j:=rb.pt;
214
setlength(result,k);
215
for i:=1 to k do
216
 begin
217
 result[i]:=rb.rbuf[j and rbufmax];
218
 j+=1;
219
 end;
220
end;
221
 
222
function cmp_rbuf(const rb:rbufstr; const s:bmpstring):boolean;
223
var i,j : longint;
224
begin
225
result:=false;
226
if rb.length<>length(s) then exit;
227
j:=rb.pt;
228
for i:=1 to rb.length do
229
  begin
230
  if rb.rbuf[j  and rbufmax]<>s[i] then exit;
231
  j+=1;
232
  end;
233
result:=true;
234
end;
235
 
236
function cmpcase_rbuf(const rb:rbufstr; const s:bmpstring):boolean;
237
var i,j : longint;
238
begin
239
result:=false;
240
if rb.length<>length(s) then exit;
241
j:=rb.pt;
242
for i:=1 to rb.length do
243
  begin
244
  if lowercase(rb.rbuf[j and rbufmax])<>lowercase(s[i]) then exit;
245
  j+=1;
246
  end;
247
result:=true;
248
end;
249
 
250
 
251
{ ******************************************************************** }
252
{ ****** TBabelMacro ************************************************* }
253
{ ******************************************************************** }
254
type PBabelMacro=^TBabelMacro;
255
     TBabelMacro=record
256
       name       : bmpstring;              { macro name }
257
       mmatch_s   : array[0..1] of dword;   { quick match string (normal, upercase) }
258
       mmatch_m   : dword;                  { quick match mask }
259
       pn         : longint;                { number of parameters }
260
       rsize      : longint;                { replacement size }
261
       r          : ^char;                  { replacement }
262
       li         : ^dword;                 { lnie info }
263
       quick      : boolean;                { quick comparison }
264
       enabled    : boolean;                { set to false to avoid recursions }
265
       paramsep   : array[0..maxparams] of ansistring;    { parameter seperators }
266
       end;
267
 
268
{ ****** freemacro *************************************************** }
269
procedure freemacro(var mac:PBabelMacro);
270
var i : longint;
271
begin
272
if (mac^.r<>nil) and (mac^.rsize>0) then freemem(mac^.r, mac^.rsize);
273
if (mac^.li<>nil) and (mac^.rsize>0) then freemem(mac^.li, mac^.rsize*4);
274
{$ifndef USE_SHORTSTRINGS}
275
mac^.name:='';
276
{$endif}
277
for i:=1 to maxparams do
278
  mac^.paramsep[i]:='';
279
freemem(mac,sizeof(TBabelMacro));
280
mac:=nil;
281
end;
282
 
283
{ ******************************************************************** }
284
{ ****** CMacroBuf *************************************************** }
285
{ ******************************************************************** }
286
const macrobuf_size = 1024;
287
type CMacroBuf = class(CTextBuf)
288
       constructor create(var tb:CTextBuf; m:PBabelMacro; clone:boolean);
289
       constructor insert(var mb:CMacroBuf);
290
       destructor destroy; override;
291
      private
292
       mac : PBabelMacro;
293
       end;
294
 
295
{ ****** create ****************************************************** }
296
constructor CMacroBuf.create(var tb:CTextBuf; m:PBabelMacro; clone:boolean);
297
begin
298
if clone
299
    then inherited create(tb, m^.r, m^.li, m^.rsize)
300
    else inherited create(tb, macrobuf_size);
301
m^.enabled:=false;
302
mac:=m;
303
end;
304
 
305
constructor CMacroBuf.insert(var mb:CMacroBuf);
306 6 ZTEX
var db : CTextBuf;
307 2 ZTEX
begin
308 6 ZTEX
inherited create(db, macrobuf_size);
309
last:=mb.last;
310
mb.last:=self;
311
mac:=mb.mac;
312
mb.mac:=nil;
313
mb:=self;
314 2 ZTEX
end;
315
 
316
{ ****** destroy ***************************************************** }
317
destructor CMacroBuf.destroy;
318
begin
319
if mac<>nil then mac^.enabled:=true;
320
end;
321
 
322
 
323
{ ******************************************************************** }
324
{ ****** CMainBmp **************************************************** }
325
{ ******************************************************************** }
326
type CMainBmp=class
327
       buf        : CTextBuf;
328
       macros     : array[0..maxmacros] of PBabelMacro;
329
 
330
       constructor create;
331
       destructor destroy; override;
332
       procedure run(const mf:ansistring; var fo:text);
333
       procedure initsymb(const s:bmpstring);
334
 
335
      private
336
 
337
       rbuf           : array[0..rbufmax] of char;
338
       bufm           : array[0..rbufmax] of smallint;
339
       li             : array[0..rbufmax] of dword;
340
       rbp,lastmacro  : longint;  { buffer pointer }
341
       lineInfo       : dword;
342
 
343
       procedure error_int(const t:ansistring);
344
       procedure error(const s:ansistring);
345
       procedure faterror(const s:ansistring);
346
       procedure warning(const s:ansistring);
347
       procedure hint(const s:ansistring);
348
 
349
       function copylaststr(l,mode:longint):rbufstr;         { last l continuous chars with mode m }
350
       function copylaststr(l:longint):rbufstr;              { last l chars }
351
       function copylaststr_br(l,mode:longint):bmpstring;    { last l chars with mode m, breaks allowed }
352
 
353
       function matchstr(const s:bmpstring;mode:longint):boolean;
354
       function matchstr(const s:bmpstring):boolean;
355
       function matchstr(ic:boolean;const s:bmpstring;mode:longint):boolean;
356
       function matchstr(ic:boolean;const s:bmpstring):boolean;
357
       function matchstr_br(const s:bmpstring;mode:longint):boolean;
358
       function matchstr_br(ic:boolean;const s:bmpstring;mode:longint):boolean;
359
 
360
       function lastmodestr(mode:longint):bmpstring;
361
       function lastmodestr1(mode:longint):bmpstring;
362
       procedure lastmodestr(mode:longint;var size:longint; var ptc:pchar; var ptli:pdword);
363
       procedure lastmodestr1(mode:longint;var size:longint; var ptc:pchar; var ptli:pdword);
364
       procedure lastmodestr(mode:longint;var fst,l:longint);
365
 
366
       procedure setmode(num,om,nm:longint);  { om: old mode; nm: new mode}
367
 
368
       procedure printmacros(const m : array of pbabelmacro; mm:longint);
369
       procedure printmacros;
370
{$ifdef ENABLE_DEBUGOUT }
371
       procedure debugwrite;
372
{$endif}
373
       end;
374
 
375
type TS4 = packed record
376
       case integer of
377
 
378
         1 : ( len : byte;
379
               i   : dword; );
380
         end;
381
 
382
 
383
{ ****** create ****************************************************** }
384
constructor CMainBmp.create;
385
var i   : longint;
386
begin
387
for i:=0 to maxmacros do
388
  macros[i]:=nil;
389
lastmacro:=-1;
390
{$ifdef UNIX}
391
initsymb('UNIX');
392
{$endif}
393
{$ifdef WINDOWS}
394
initsymb('WINDOWS');
395
{$endif}
396
{$ifdef LINUX}
397
initsymb('LINUX');
398
{$endif}
399
end;
400
 
401
{ ****** destroy **************************************************** }
402
destructor CMainBmp.destroy;
403
var i  : longint;
404
begin
405
for i:=0 to lastmacro do
406
  if macros[i]<>nil then freemacro(macros[i]);
407
end;
408
 
409
{ ****** run ******************************************************** }
410
procedure CMainBmp.run(const mf:ansistring; var fo:text);
411
var i,mode,j,k,l,ifc     : longint;
412
    bl,bl_ne             : longint;
413
    outfile,bm_expand    : longint;
414
    prevli,ampos         : dword;
415
    sx,endnoexpand       : bmpstring;
416
    s4                   : array[0..3] of char;
417
    i4                   : dword absolute s4;
418
    tmpbuf               : CTextBuf;
419
    tmpmbuf              : CMacroBuf;
420
    amacro               : PBabelMacro;
421
    writebuf             : shortstring;
422
 
423
    pm_s,pm_m            : dword;
424
    pm_q                 : boolean;
425
    t4                   : TS4;
426
 
427
    ifs                  : array[0..maxifs] of byte;
428
    ifli                 : array[0..maxifs] of dword;
429
    bli                  : array[0..maxbs] of dword;
430
 
431 5 ZTEX
    disablelineinfo      : boolean;
432
 
433 2 ZTEX
label endparse;
434
 
435
begin
436
amacro:=nil;
437
t4.s:=copy('    '+bc_pm, length(bc_pm)+1,4);
438
pm_s:=t4.i;
439
pm_m:=$ffffffff shl ((4-min(length(bc_pm),4))*8);
440
pm_q:=length(bc_pm)<=4;
441
 
442
writebuf:='';
443
CFileBuf.create(buf,mf,'');
444
 
445
bl:=0;
446
fillchar(bufm, sizeof(bufm), 0);
447
fillchar(rbuf, sizeof(rbuf), #32);
448
fillchar(li, sizeof(li), 0);
449
bufm[0]:=bm_outfile_a;
450
bufm[rbufmax]:=bm_outfile_a+1;
451
 
452
rbp:=0;
453
mode:=bm_plain;
454
ifc:=-1;
455
outfile:=1;
456
bm_expand:=bm_plain;
457 5 ZTEX
disablelineinfo:=false;
458 2 ZTEX
 
459
prevli:=dword(-1);
460
ampos:=0;
461
while (buf<>nil) and (bmp_exit<>bmp_exit_usererror) do
462
  begin
463
  if buf.d>buf.lastbuf
464
    then begin
465
         buf.endbuf;
466
         if buf.killme then
467
           begin
468
           tmpbuf:=buf.last;
469
           buf.destroy;
470
           buf:=tmpbuf;
471
           end;
472
         end
473
    else if buf.buf[buf.d]=#13 then buf.d+=1
474
    else begin
475
{$ifdef ENABLE_DEBUGOUT}
476
         if debugoutput then debugwrite;
477
{$endif}
478
         i:=bufm[rbp];
479
         if (i<10) and (i>=0) and (outfile>0) then
480
              begin
481
              j:=ord(writebuf[0])+1;     { avoid the range checking }
482
              writebuf[0]:=char(j);
483
              writebuf[j]:=rbuf[rbp];
484
              if rbuf[rbp]=#10 then
485
                 begin
486
                 if (li[rbp]<>prevli+4096) and (lineInfoPattern<>'') then lineInfoStr(fo,li[rbp]);
487
                 prevli:=li[rbp];
488
                 byte(writebuf[0])-=1;
489
                 writeln(fo,writebuf);
490
                 writebuf:='';
491
                 end;
492
              if (j>=255) then
493
                 begin
494
                 write(fo,writebuf);
495
                 writebuf:='';
496
                 end;
497
              end
498
            else if (i>=bm_outfile_a) and (i<=bm_outfile_z) then outfile:=i-bm_outfile_a;
499
 
500
         rbuf[rbp]:=buf.buf[buf.d];
501
         lineInfo:=buf.li[buf.d];
502
         li[rbp]:=lineInfo;
503
         bufm[rbp]:=mode;
504
         buf.d+=1;
505
 
506
{brackets}
507
         if rbuf[rbp]=bc_ob then
508
           begin
509
           if (bl>=0) and (bl<maxbs) then bli[bl]:=lineInfo;
510
           bl+=1;
511
           end;
512
         if rbuf[rbp]=bc_cb then bl-=1;
513
{if's}
514
         if mode<>bm_plain then
515
           begin
516
           if (mode=bm_pm) and matchstr(bc_pm+'ifdef'+bc_ob,bm_pm) then
517
              begin
518
              setmode(length(bc_pm+'ifdef'+bc_ob),bm_pm,bm_if);
519
              mode:=bm_if_scb;
520
              bli[0]:=lineInfo;
521
              bl:=1;
522
              end;
523
           if (mode=bm_pm) and matchstr(bc_pm+'ifndef'+bc_ob,bm_pm) then
524
              begin
525
              setmode(length(bc_pm+'ifndef'+bc_ob),bm_pm,bm_if);
526
              mode:=bm_ifn_scb;
527
              bli[0]:=lineInfo;
528
              bl:=1;
529
              end;
530
           if (mode=bm_pm) and matchstr(bc_pm+'ifeq'+bc_ob,bm_pm) then
531
              begin
532
              setmode(length(bc_pm+'ifeq'+bc_ob),bm_pm,bm_if);
533
              mode:=bm_ifeq_scb1;
534
              bm_expand:=bm_ifeq_scb1;
535
              bli[0]:=lineInfo;
536
              bl:=1;
537
              end;
538
           if (mode=bm_pm) and matchstr(bc_pm+'ifneq'+bc_ob,bm_pm) then
539
              begin
540
              setmode(length(bc_pm+'ifeq'+bc_ob),bm_pm,bm_if);
541
              mode:=bm_ifneq_scb1;
542
              bm_expand:=bm_ifneq_scb1;
543
              bli[0]:=lineInfo;
544
              bl:=1;
545
              end;
546
 
547
           if (mode=bm_if_not) and matchstr(bc_pm+'ifdef'+bc_ob,bm_if_not) then
548
              begin
549
              setmode(length(bc_pm+'ifdef'+bc_ob),bm_if_not,bm_if);
550
              ifc+=1;
551
              if ifc>maxifs then faterror('if memory exceeded');
552
              ifli[ifc]:=lineInfo;
553
              ifs[ifc]:=2;
554
              end;
555
           if (mode=bm_if_not) and matchstr(bc_pm+'ifndef'+bc_ob,bm_if_not) then
556
              begin
557
              setmode(length(bc_pm+'ifndef'+bc_ob),bm_if_not,bm_if);
558
              ifc+=1;
559
              if ifc>maxifs then faterror('if memory exceeded');
560
              ifli[ifc]:=lineInfo;
561
              ifs[ifc]:=2;
562
              end;
563
           if (mode=bm_if_not) and matchstr(bc_pm+'ifeq'+bc_ob,bm_if_not) then
564
              begin
565
              setmode(length(bc_pm+'ifeq'+bc_ob),bm_if_not,bm_if);
566
              ifc+=1;
567
              if ifc>maxifs then faterror('if memory exceeded');
568
              ifli[ifc]:=lineInfo;
569
              ifs[ifc]:=2;
570
              end;
571
           if (mode=bm_if_not) and matchstr(bc_pm+'ifneq'+bc_ob,bm_if_not) then
572
              begin
573
              setmode(length(bc_pm+'ifneq'+bc_ob),bm_if_not,bm_if);
574
              ifc+=1;
575
              if ifc>maxifs then faterror('if memory exceeded');
576
              ifli[ifc]:=lineInfo;
577
              ifs[ifc]:=2;
578
              end;
579
 
580
           if ((mode=bm_ifeq_scb1) or (mode=bm_ifeq_scb1_ne) or (mode=bm_ifneq_scb1) or (mode=bm_ifneq_scb1_ne)) and (bl=0) then
581
              begin
582
              bufm[rbp]:=bm_ifb;
583
              if (mode=bm_ifeq_scb1) or (mode=bm_ifeq_scb1_ne)
584
                 then mode:=bm_ifeq_sob
585
                 else mode:=bm_ifneq_sob;
586
              ampos:=lineInfo;
587
              bm_expand:=bm_plain;
588
              end;
589
 
590
           if ((mode=bm_ifeq_sob) or (mode=bm_ifneq_sob)) and (rbuf[rbp]=bc_ob) then
591
              begin
592
              bli[0]:=lineInfo;
593
              bl:=1;
594
              if mode=bm_ifeq_sob
595
                 then mode:=bm_ifeq_scb2
596
                 else mode:=bm_ifneq_scb2;
597
              bm_expand:=mode;
598
              end;
599
 
600
           if ((mode=bm_if_scb) or (mode=bm_ifn_scb)) and (bl=0) then
601
              begin
602
              sx:=lastmodestr1(mode);
603
              if length(sx)<1
604
                 then begin
605
                      warning('empty symbol name');
606
                      mode:=bm_pm;
607
                      end
608
                 else begin
609
                      ifc+=1;
610
                      if ifc>maxifs then faterror('if memory exceeded');
611
                      ifli[ifc]:=lineInfo;
612
                      if mode=bm_if_scb
613
                         then ifs[ifc]:=0
614
                         else ifs[ifc]:=1;
615
                      i:=lastmacro;
616
                      while i>=0 do
617
                        begin
618
                        if (macros[i]^.name=sx) then
619
                          begin
620
                          if mode=bm_if_scb
621
                             then ifs[ifc]:=1
622
                             else ifs[ifc]:=0;
623
                          i:=0;
624
                          end;
625
                        i-=1;
626
                        end;
627
                      if ifs[ifc]=0
628
                        then mode:=bm_if_not
629
                        else mode:=bm_pm;
630
                      end;
631
                 end;
632
           if ((mode=bm_ifeq_scb2) or (mode=bm_ifeq_scb2_ne) or (mode=bm_ifneq_scb2) or (mode=bm_ifneq_scb2_ne)) and (bl=0) then
633
              begin
634
              i:=0;
635
              j:=0;
636
              repeat
637
                repeat
638
                  i+=1;
639
                  k:=bufm[(rbp-i) and rbufmax];
640
//                writeln(stderr,'  i=',i,'  k=',k,' rbuf=',rbuf[(rbp-i) and rbufmax]);
641
                  until (i>=rbufmax) or (k=bm_if) or (k=bm_ifeq_scb2) or (k=bm_ifeq_scb2_ne) or (k=bm_ifneq_scb2) or (k=bm_ifneq_scb2_ne);
642
                repeat
643
                  j+=1;
644
                  l:=bufm[(rbp-j) and rbufmax];
645
//                writeln(stderr,'  j=',j,'  l=',l,' rbuf=',rbuf[(rbp-j) and rbufmax]);
646
                  until (j>=rbufmax) or (l=bm_if) or (l=bm_ifeq_scb1) or (l=bm_ifeq_scb1_ne) or (l=bm_ifneq_scb1) or (l=bm_ifneq_scb1_ne);
647
//              writeln(stderr,rbp,',',i,',',j,'-->',rbuf[(rbp-i) and rbufmax],'<-->',rbuf[(rbp-j) and rbufmax],'<--');
648
                until (j>=rbufmax) or (l=bm_if) or (k=bm_if) or (rbuf[(rbp-i) and rbufmax]<>rbuf[(rbp-j) and rbufmax]);
649
//            writeln(stderr);  
650
              ifc+=1;
651
              if ifc>maxifs then faterror('if memory exceeded');
652
              ifli[ifc]:=lineInfo;
653
 
654
              if (i=j) = ((mode=bm_ifeq_scb2) or (mode=bm_ifeq_scb2_ne))
655
                then ifs[ifc]:=1
656
                else ifs[ifc]:=0;
657
 
658
              if ifs[ifc]=0
659
                 then mode:=bm_if_not
660
                 else mode:=bm_pm;
661
              bm_expand:=bm_plain;
662
              end;
663
 
664
           if (mode=bm_pm) and matchstr(bc_pm+'else',bm_pm) then
665
              begin
666
              if ifc<0 then error('else without ifdef');
667
              if ifs[ifc]<>1 then error('internal error 5');
668
              ifs[ifc]:=0;
669
              mode:=bm_if_not;
670
              end;
671
           if (mode=bm_pm) and ( matchstr(bc_pm+'elifdef'+bc_ob,bm_pm)
672
                               or matchstr(bc_pm+'elifndef'+bc_ob,bm_pm)
673
                               or matchstr(bc_pm+'elifeq'+bc_ob,bm_pm)
674
                               or matchstr(bc_pm+'elifneq'+bc_ob,bm_pm) ) then
675
              begin
676
              if ifc<0 then error('else without ifdef');
677
              if ifs[ifc]<>1 then error('internal error 5');
678
              ifs[ifc]:=2;
679
              mode:=bm_if_not;
680
              end;
681
 
682
           if (mode=bm_if_not) and matchstr(bc_pm+'else',bm_if_not) then
683
              begin
684
              setmode(length(bc_pm+'else'+bc_ob),bm_if_not,bm_if);
685
              if ifc<0
686
                then error('else without ifdef')
687
                else if ifs[ifc]=0
688
                        then begin
689
                             ifs[ifc]:=1;
690
                             mode:=bm_pm;
691
                             end
692
                        else begin
693
                             if ifs[ifc]<>2 then error('internal error 6')
694
                             end;
695
              end;
696
           if (mode=bm_if_not) and matchstr(bc_pm+'elifdef'+bc_ob,bm_if_not) then
697
              begin
698
              setmode(length(bc_pm+'elifdef'+bc_ob),bm_if_not,bm_if);
699
              if ifc<0
700
                 then error('elifdef without ifdef')
701
                 else if ifs[ifc]=0
702
                         then begin
703
                              ifc-=1;
704
                              mode:=bm_if_scb;
705
                              bli[0]:=lineInfo;
706
                              bl:=1;
707
                              end
708
                         else begin
709
                              if ifs[ifc]<>2 then error('internal error 6a')
710
                              end;
711
              end;
712
           if (mode=bm_if_not) and matchstr(bc_pm+'elifndef'+bc_ob,bm_if_not) then
713
              begin
714
              setmode(length(bc_pm+'elifndef'+bc_ob),bm_if_not,bm_if);
715
              if ifc<0
716
                 then error('elifndef without ifdef')
717
                 else if ifs[ifc]=0
718
                        then begin
719
                             ifc-=1;
720
                             mode:=bm_ifn_scb;
721
                             bli[0]:=lineInfo;
722
                             bl:=1;
723
                             end
724
                        else begin
725
                             if ifs[ifc]<>2 then error('internal error 6b')
726
                             end;
727
              end;
728
           if (mode=bm_if_not) and matchstr(bc_pm+'elifeq'+bc_ob,bm_if_not) then
729
              begin
730
              setmode(length(bc_pm+'elifeq'+bc_ob),bm_if_not,bm_if);
731
              if ifc<0
732
                 then error('elifeq without ifdef')
733
                 else if ifs[ifc]=0
734
                        then begin
735
                             ifc-=1;
736
                             mode:=bm_ifeq_scb1;
737
                             bm_expand:=bm_ifeq_scb1;
738
                             bli[0]:=lineInfo;
739
                             bl:=1;
740
                             end
741
                        else begin
742
                             if ifs[ifc]<>2 then error('internal error 6c')
743
                             end;
744
              end;
745
           if (mode=bm_if_not) and matchstr(bc_pm+'elifneq'+bc_ob,bm_if_not) then
746
              begin
747
              setmode(length(bc_pm+'elifneq'+bc_ob),bm_if_not,bm_if);
748
              if ifc<0
749
                 then error('elifneq without ifdef')
750
                 else if ifs[ifc]=0
751
                        then begin
752
                             ifc-=1;
753
                             mode:=bm_ifneq_scb1;
754
                             bm_expand:=bm_ifneq_scb1;
755
                             bli[0]:=lineInfo;
756
                             bl:=1;
757
                             end
758
                        else begin
759
                             if ifs[ifc]<>2 then error('internal error 6d')
760
                             end;
761
              end;
762
 
763
           if ((mode=bm_if_not) or (mode=bm_pm)) and (matchstr(bc_pm+'endif',bm_if_not) or matchstr(bc_pm+'endif',bm_pm)) then
764
              begin
765
              if ifc<0
766
                 then error('endif without if')
767
                 else ifc-=1;
768
              if (ifc=-1) or (ifs[ifc]=1)
769
                 then mode:=bm_pm
770
                 else mode:=bm_if_not;
771
              end;
772
           if mode=bm_if_not then goto endparse;
773
{define mode}
774
           if mode=bm_def_sob2 then
775
              begin
776
              if rbuf[rbp]=bc_ob
777
                 then begin
778
                      mode:=bm_def_scb2;
779
                      bli[0]:=lineInfo;
780
                      bl:=1;
781
                      end
782
                 else begin
783
                      mode:=bm_pm;
784
                      setmode(1,-1,bm_pm);
785
                      end;
786
              end;
787
           if mode=bm_def_sob3 then
788
              begin
789
              if rbuf[rbp]=bc_ob
790
                 then begin
791
                      mode:=bm_def_scb3;
792
                      bli[0]:=lineInfo;
793
                      bl:=1;
794
                      end
795
                 else begin
796
                      lastmodestr1(bm_def_scb2, macros[lastmacro]^.rsize, macros[lastmacro]^.r, macros[lastmacro]^.li);
797
                      mode:=bm_pm;
798
                      setmode(1,-1,bm_pm);
799
                      end;
800
              end;
801
           if (mode=bm_def_scb1) and (bl=0) then
802
              begin
803
              mode:=bm_def_sob2;
804
              sx:=lastmodestr1(bm_def_scb1);
805
              if length(sx)<1
806
                 then begin
807
                      warning('empty macro name');
808
                      mode:=bm_pm;
809
                      end
810
                 else initsymb(sx);
811
              end;
812
           if (mode=bm_def_scb2) and (bl=0) then
813
              begin
814
              mode:=bm_def_sob3;
815
              end;
816
           if (mode=bm_def_scb3) and (bl=0) then
817
              begin
818
              mode:=bm_pm;
819
              lastmodestr(bm_def_scb2,i,j);
820
              j-=1;
821
              k:=1;
822
              while k<=j do
823
                begin
824
                if rbuf[i]=bc_pa
825
                   then begin
826
                        if macros[lastmacro]^.pn>=maxparams then error('only '+int2str(maxparams)+' paramters allowed');
827
                        if k=j then error(paramids[macros[lastmacro]^.pn+1]+' expected after `'+bc_pa+''', found '+bc_cb)
828
                               else begin
829
                                    inc(k);
830
                                    i:=(i+1) and rbufmax;
831
                                    if rbuf[i]=paramids[macros[lastmacro]^.pn+1]
832
                                       then inc(macros[lastmacro]^.pn)
833
                                       else error(paramids[macros[lastmacro]^.pn+1]+' expected after `'+bc_pa+''', found '+rbuf[i]);
834
                                    end;
835
                        end
836
                   else macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]+=rbuf[i];
837
                i:=(i+1) and rbufmax;
838
                k+=1;
839
                end;
840
              if (macros[lastmacro]^.pn>0) then
841
                begin
842
                if macros[lastmacro]^.paramsep[0]='' then macros[lastmacro]^.paramsep[0]:=bc_ob;
843
                if macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]='' then macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]:=bc_cb;
844
                end;
845
              for i:=1 to macros[lastmacro]^.pn-1 do
846
                if macros[lastmacro]^.paramsep[i]='' then macros[lastmacro]^.paramsep[i]:=bc_cb+bc_ob;
847
              lastmodestr1(bm_def_scb3, macros[lastmacro]^.rsize, macros[lastmacro]^.r, macros[lastmacro]^.li);
848 5 ZTEX
              if disablelineinfo then
849
                for i:=0 to macros[lastmacro]^.rsize-1 do
850
                  macros[lastmacro]^.li[i]:=macros[lastmacro]^.li[i] or 2048;
851
              disablelineinfo:=false;
852 2 ZTEX
              end;
853
           if (mode=bm_def_scbu) and (bl=0) then
854
              begin
855
              sx:=lastmodestr1(bm_def_scbu);
856
              j:=0;
857
              if length(sx)<1
858
                 then warning('empty symbol name')
859
                 else begin
860
                      i:=lastmacro;
861
                      while i>=0 do
862
                        begin
863
                        if macros[i]^.name=sx then
864
                          begin
865
                          freemacro(macros[i]);
866
                          for j:=i to lastmacro-1 do
867
                            macros[j]:=macros[j+1];
868
                          macros[lastmacro]:=nil;
869
                          dec(lastmacro);
870
                          j:=-10;
871
                          i:=0;
872
                          end;
873
                        i-=1;
874
                        end;
875
                      if j<>-10 then warning('`'+sx+''' not defined');
876
                      end;
877
              mode:=bm_pm;
878
              end;
879
           if (mode=bm_def_scba) and (bl=0) then
880
              begin
881
              sx:=lastmodestr1(bm_def_scba);
882
              j:=0;
883
              if length(sx)<1
884
                 then warning('empty symbol name')
885
                 else begin
886
                      i:=0;k:=0;
887
                      while i<=lastmacro do
888
                       if macros[i]^.name=sx
889
                          then begin
890
                               freemacro(macros[i]);
891
                               for j:=i to lastmacro-1 do
892
                                 macros[j]:=macros[j+1];
893
                               macros[lastmacro]:=nil;
894
                               dec(lastmacro);
895
                               k:=-10;
896
                               end
897
                          else inc(i);
898
                      if k<>-10 then warning('`'+sx+''' not defined');
899
                      end;
900
              mode:=bm_pm;
901
              end;
902
{include mode}
903
           if (mode=bm_inc_scb) and (bl=0) then
904
              begin
905
              sx:=lastmodestr1(bm_inc_scb);
906
              if length(sx)<1
907
                 then warning('empty include file name')
908
                 else CFileBuf.create(buf,sx, lineInfoStr(lineInfo)+': ');
909
              mode:=bm_plain;
910
              end;
911
{noexpand mode}
912
           if ((mode=bm_pm) or (mode=bm_ifeq_scb1) or (mode=bm_ifeq_scb2) or (mode=bm_ifneq_scb1) or (mode=bm_ifneq_scb2)) and matchstr(bc_pm+'noexpand'+bc_ob,mode) then
913
              begin
914
              setmode(length(bc_pm+'noexpand'+bc_ob),mode,bm_noexpand);
915
              mode:=bm_noexpand_scb;
916
              bli[0]:=lineInfo;
917
              bl_ne:=bl;
918
              bl:=1;
919
              end;
920
           if (mode=bm_noexpand_scb) and (bl=0) then
921
              begin
922
              endnoexpand:=lastmodestr1(bm_noexpand_scb);
923
              case bm_expand of
924
                bm_ifeq_scb1  : mode:=bm_ifeq_scb1_ne;
925
                bm_ifeq_scb2  : mode:=bm_ifeq_scb2_ne;
926
                bm_ifneq_scb1 : mode:=bm_ifneq_scb1_ne;
927
                bm_ifneq_scb2 : mode:=bm_ifneq_scb2_ne;
928
                else mode:=bm_neplain;
929
                end;
930
              ampos:=lineInfo;
931
              bl:=bl_ne-1;
932
              end;
933
           if ((mode=bm_neplain) or (mode=bm_ifeq_scb1_ne) or (mode=bm_ifeq_scb2_ne) or (mode=bm_ifneq_scb1_ne) or (mode=bm_ifneq_scb2_ne)) and (endnoexpand<>'') and matchstr(endnoexpand,mode) then
934
              begin
935
              setmode(length(endnoexpand),mode,bm_noexpand);
936
              case bm_expand of
937
                bm_ifeq_scb1, bm_ifeq_scb2, bm_ifneq_scb1, bm_ifneq_scb2 : mode:=bm_expand;
938
                else mode:=bm_plain;
939
                end;
940
              end;
941
{error mode}
942
           if (mode=bm_err_scb) and (bl=0) then
943
              begin
944
              error(lastmodestr1(bm_err_scb));
945
              mode:=bm_plain;
946
              bmp_exit:=bmp_exit_usererror;
947
              end;
948
{warning mode}
949
           if (mode=bm_warn_scb) and (bl=0) then
950
              begin
951
              warning(lastmodestr1(bm_warn_scb));
952
              mode:=bm_plain;
953
              end;
954
{programming mode}
955
           if mode=bm_pm then
956
              begin
957
              if matchstr(bc_pm+bc_pm,bm_pm) then
958
                 begin
959
                 setmode(length(bc_pm),bm_pm,bm_plain);
960
                 mode:=bm_plain;
961
                 end;
962
              if matchstr(bc_lf,bm_pm) then mode:=bm_plain;
963
              if matchstr(bc_pm+'define'+bc_ob,bm_pm) then
964
                 begin
965
                 setmode(length(bc_pm+'define'+bc_ob),bm_pm,bm_def);
966
                 mode:=bm_def_scb1;
967
                 bli[0]:=lineInfo;
968
                 bl:=1;
969
                 end;
970
              if matchstr(bc_pm+'udefine'+bc_ob,bm_pm) then
971
                 begin
972
                 setmode(length(bc_pm+'udefine'+bc_ob),bm_pm,bm_def);
973
                 mode:=bm_def_scbu;
974
                 bli[0]:=lineInfo;
975
                 bl:=1;
976
                 end;
977
              if matchstr(bc_pm+'uadefine'+bc_ob,bm_pm) then
978
                 begin
979
                 setmode(length(bc_pm+'uadefine'+bc_ob),bm_pm,bm_def);
980
                 mode:=bm_def_scba;
981
                 bli[0]:=lineInfo;
982
                 bl:=1;
983
                 end;
984
              if matchstr(bc_pm+'nolf',bm_pm) then
985
                 begin
986
                 i:=rbp; j:=0; k:=0;
987
                 while (j<=rbufmax+1-length(bc_lf)) and (k=0) do
988
                   begin
989
                   rbp:=(rbp-1) and rbufmax;
990
                   if matchstr(bc_lf,bm_plain) then
991
                      begin
992
                      setmode(length(bc_lf),-1,bm_comm);
993
                      k:=1;
994
                      end;
995
                  j+=1;
996
                  end;
997
                 rbp:=i;
998
                 end;
999
              if matchstr(bc_pm+'include'+bc_ob,bm_pm) then
1000
                 begin
1001
                 setmode(length(bc_pm+'include'+bc_ob),bm_pm,bm_inc);
1002
                 mode:=bm_inc_scb;
1003
                 bli[0]:=lineInfo;
1004
                 bl:=1;
1005
                 end;
1006
              if matchstr(bc_pm+'error'+bc_ob,bm_pm) then
1007
                 begin
1008
                 setmode(length(bc_pm+'error'+bc_ob),bm_pm,bm_err);
1009
                 mode:=bm_err_scb;
1010
                 bli[0]:=lineInfo;
1011
                 bl:=1;
1012
                 end;
1013
              if matchstr(bc_pm+'warning'+bc_ob,bm_pm) then
1014
                 begin
1015
                 setmode(length(bc_pm+'warning'+bc_ob),bm_pm,bm_warn);
1016
                 mode:=bm_warn_scb;
1017
                 bli[0]:=lineInfo;
1018
                 bl:=1;
1019
                 end;
1020
              if matchstr(bc_pm+'disableout',bm_pm) then bufm[rbp]:=bm_outfile_a;
1021
              if matchstr(bc_pm+'enableout',bm_pm) then bufm[rbp]:=bm_outfile_a+1;
1022
              if matchstr(bc_pm+'ignorecase',bm_pm) then bp_icase:=true;
1023
              if matchstr(bc_pm+'exactcase',bm_pm) then bp_icase:=false;
1024 5 ZTEX
              if matchstr(bc_pm+'disablelineinfo',bm_pm) then disablelineinfo:=true;
1025 2 ZTEX
              end;
1026
 
1027
{expanding mode}
1028
           if ((mode>=bm_em_p0) and (mode<=bm_em_pz)) and (matchstr(bp_icase, amacro^.paramsep[mode-bm_em_p0], mode)) then
1029
              begin
1030
              setmode(length(amacro^.paramsep[mode-bm_em_p0])-1,mode,bm_em);
1031
              if (mode=bm_em_pz) or (mode-bm_em_p0=amacro^.pn)
1032
                 then begin
1033
                      mode:=bm_expand;
1034
                      if amacro^.rsize<0 then error('internal error 2');
1035
                      if amacro^.rsize>0 then
1036
                         begin
1037
                         tmpmbuf:=CMacroBuf.create(buf, amacro, false);
1038
                         i:=0;
1039
                         while i<amacro^.rsize do
1040
                           begin
1041
                           if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf);
1042
                           if (amacro^.r[i]=bc_pa) and (i+1<amacro^.rsize)
1043
                              then begin
1044
                                   inc(i);
1045
                                   if amacro^.r[i]=bc_pa
1046
                                      then begin
1047
                                           while amacro^.r[i]=bc_pa do
1048
                                            begin
1049
                                            if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf);
1050
                                            inc(tmpmbuf.lastbuf);
1051
                                            tmpmbuf.buf[tmpmbuf.lastbuf]:=bc_pa;
1052
                                            tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i];
1053
                                            inc(i);
1054
                                            end;
1055
                                           end
1056
                                      else begin
1057
                                           l:=-1;
1058
                                           repeat
1059
                                             inc(l);
1060
                                             until (l>amacro^.pn) or (paramids[l]=amacro^.r[i]);
1061
                                           if l<=amacro^.pn
1062
                                               then begin
1063
                                                    lastmodestr(bm_em_p0+l,j,k);
1064
                                                    dec(k);
1065
                                                    while (k>0) do
1066
                                                      begin
1067
                                                      if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf);
1068
                                                      inc(tmpmbuf.lastbuf);
1069
                                                      tmpmbuf.buf[tmpmbuf.lastbuf]:=rbuf[j];
1070
                                                      tmpmbuf.li[tmpmbuf.lastbuf]:=li[j];
1071
                                                      j:=(j+1) and rbufmax;
1072
                                                      dec(k);
1073
                                                      end;
1074
                                                    inc(i);
1075
                                                    end
1076
                                               else begin
1077
                                                    inc(tmpmbuf.lastbuf);
1078
                                                    tmpmbuf.buf[tmpmbuf.lastbuf]:=bc_pa;
1079
                                                    tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i];
1080
                                                    end;
1081
                                            end;
1082
                                   end
1083
                              else begin
1084
                                   inc(tmpmbuf.lastbuf);
1085
                                   tmpmbuf.buf[tmpmbuf.lastbuf]:=amacro^.r[i];
1086
                                   tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i];
1087
                                   inc(i);
1088
                                   end;
1089
                           end;
1090
                         end;
1091
                      end
1092
                 else inc(mode);
1093
              end;
1094
           end;
1095
{plain mode}
1096
         if mode=bm_expand then
1097
            begin
1098
            i:=3; j:=0; k:=rbp;          { equal to copylaststr_br(4,bm_expand); }
1099
            i4:=0;
1100
            while (i>=0) and (j<=rbufmax) do
1101
              begin
1102
              if bufm[k]=bm_expand then
1103
                 begin
1104
                 s4[i]:=rbuf[k];
1105
                 i-=1;
1106
                 end;
1107
               k:=(k-1) and rbufmax;
1108
               j+=1;
1109
               end;
1110
 
1111
            if (mode=bm_plain) and ((i4 xor pm_s) and pm_m=0) and (pm_q or matchstr(bc_pm,bm_plain)) and (matchstr(bc_lf+bc_pm) or (buf.d+buf.d0=length(bc_pm)))
1112
              then begin
1113
                   mode:=bm_pm;
1114
                   setmode(length(bc_pm),bm_plain,mode);
1115
                   end
1116
              else begin
1117
                   if bp_icase
1118
                      then begin
1119
                           if (s4[0]>='a') and (s4[0]<='z') then byte(s4[0])-=32;
1120
                           if (s4[1]>='a') and (s4[1]<='z') then byte(s4[1])-=32;
1121
                           if (s4[2]>='a') and (s4[2]<='z') then byte(s4[2])-=32;
1122
                           if (s4[3]>='a') and (s4[3]<='z') then byte(s4[3])-=32;
1123
                           j:=1;
1124
                           end
1125
                      else j:=0;
1126
 
1127
                   i:=lastmacro;
1128
                   while i>=0 do
1129
                     begin
1130
                     amacro:=macros[i];
1131
                     if (amacro^.rsize>=0) and (amacro^.enabled) and ((i4 xor amacro^.mmatch_s[j]) and amacro^.mmatch_m=0) and (amacro^.quick or matchstr_br(bp_icase,amacro^.name,bm_expand)) then
1132
                        begin
1133
                        setmode(length(amacro^.name),bm_expand,bm_em);
1134
                        ampos:=lineInfo;
1135
                        if amacro^.paramsep[0]=''
1136
                           then begin
1137
                                if amacro^.rsize>0 then CMacroBuf.create(buf, amacro, true);
1138
                                end
1139
                           else mode:=bm_em_p0;
1140
                        i:=0;
1141
                        end;
1142
                     i-=1;
1143
                     end;
1144
                   end;
1145
            end;
1146
endparse:
1147
         rbp:=(rbp+1) and rbufmax;
1148
         end;
1149
 end;
1150
 
1151
if bmp_exit=0 then case mode of
1152
  bm_plain, bm_pm, bm_def_sob2, bm_def_sob3, bm_if_not
1153
     : if ifc>=0 then
1154
         begin
1155
         if ifc>0 then sx:='if''s without endif''s at '+lineInfoStr(ifli[0])
1156
                  else sx:='if without endif at '+lineInfoStr(ifli[0]);
1157
         for i:=1 to ifc do
1158
           sx+=', '+lineInfoStr(ifli[i]);
1159
         error(sx);
1160
         end;
1161
  bm_neplain, bm_ifeq_scb1_ne, bm_ifeq_scb2_ne, bm_ifneq_scb1_ne, bm_ifneq_scb2_ne
1162
     : error('Unexpected end of file, `'+endnoexpand+''' expected for '+bc_pm+'noexpand at '+lineInfoStr(ampos));
1163
  bm_em_p0..bm_em_pz
1164
     : error('Unexpected end of file, `'+amacro^.paramsep[mode-bm_em_p0]+''' expected for '+amacro^.name+' at '+lineInfoStr(ampos));
1165
  bm_def_scb1, bm_def_scb2, bm_def_scb3, bm_def_scbu, bm_def_scba,
1166
  bm_if_scb, bm_ifn_scb, bm_ifeq_scb1, bm_ifeq_scb2, bm_ifneq_scb1, bm_ifneq_scb2,
1167
  bm_inc_scb, bm_err, bm_err_scb, bm_warn
1168
     : begin
1169
       if bl>1 then begin
1170
                    if bl>2 then sx:=',  there are unclosed `'+bc_ob+'''s at '+lineInfoStr(bli[1])
1171
                            else sx:=',  there is a unclosed `'+bc_ob+''' at '+lineInfoStr(bli[1]);
1172
                    for i:=2 to bl-1 do
1173
                      sx+=', '+lineInfoStr(bli[i]);
1174
                    end
1175
               else sx:='  (maybe there are unclosed `'+bc_ob+'''s)';
1176
       error('Unexpected end of file, `'+bc_cb+''' expected for `'+bc_ob+''' at '+lineInfoStr(bli[0])+sx);
1177
       end;
1178
  bm_ifeq_sob
1179
     : error('Unexpected end of file, `'+bc_ob+''' expected for '+bc_pm+'ifeq at '+lineInfoStr(ampos));
1180
  bm_ifneq_sob
1181
     : error('Unexpected end of file, `'+bc_ob+''' expected for '+bc_pm+'ifneq at '+lineInfoStr(ampos));
1182
  else error('Unexpected end of file ('+int2str(mode)+')');
1183
  end;
1184
 
1185
for k:=0 to rbufmax do
1186
  begin
1187
{$ifdef ENABLE_DEBUGOUT }
1188
  if debugoutput then debugwrite;
1189
{$endif}
1190
  i:=bufm[rbp];
1191
  if (i<10) and (i>=0) and (outfile>0) then
1192
      begin
1193
      j:=ord(writebuf[0])+1;     { avoid the range checking }
1194
      writebuf[0]:=char(j);
1195
      writebuf[j]:=rbuf[rbp];
1196
      if rbuf[rbp]=#10 then
1197
         begin
1198
         if (li[rbp]<>prevli+4096) and (lineInfoPattern<>'') then lineInfoStr(fo,li[rbp]);
1199
         prevli:=li[rbp];
1200
         byte(writebuf[0])-=1;
1201
         writeln(fo,writebuf);
1202
         writebuf:='';
1203
         end;
1204
      if j>=255 then
1205
        begin
1206
        write(fo,writebuf);
1207
        writebuf:='';
1208
        end;
1209
      end
1210
    else if (i>=bm_outfile_a) and (i<=bm_outfile_z) then outfile:=i-bm_outfile_a;
1211
  rbp:=(rbp+1) and rbufmax;
1212
  end;
1213
write(fo,writebuf);
1214
if printdefs then printmacros;
1215
end;
1216
 
1217
{ ******** initsymb ************************************************** }
1218
procedure CMainBmp.initsymb(const s:bmpstring);
1219
var s4 : TS4;
1220
begin
1221
lastmacro+=1;
1222
if lastmacro>maxmacros then faterror('Macro memory exceeded');
1223
 
1224
getmem(macros[lastmacro],sizeof(TBabelMacro));
1225
fillchar( macros[lastmacro]^, sizeof(TBabelMacro), 0 );
1226
 
1227
s4.s:=copy('    '+s,length(s)+1,4);
1228
macros[lastmacro]^.mmatch_s[0]:=s4.i;
1229
upstr2(s4.s);
1230
macros[lastmacro]^.mmatch_s[1]:=s4.i;
1231
macros[lastmacro]^.mmatch_m:=$ffffffff shl ((4-min(length(s),4))*8);
1232
macros[lastmacro]^.quick:=length(s)<=4;
1233
macros[lastmacro]^.enabled:=true;
1234
 
1235
macros[lastmacro]^.rsize:=-1;
1236
macros[lastmacro]^.pn:=0;
1237
macros[lastmacro]^.name:=s;
1238
end;
1239
 
1240
{ ****** error_int ************************************************** }
1241
procedure CMainBmp.error_int(const t:ansistring);
1242
var i,j,k : longint;
1243
    tmp   : CTextBuf;
1244
    s     : shortstring;
1245
begin
1246
tmp:=buf;
1247
i:=0;
1248
while tmp<>nil do
1249
  begin
1250
  tmp:=CTextBuf(tmp.last);
1251
  i+=1;
1252
  end;
1253
s:='';
1254
for j:=1 to i do
1255
  begin
1256
  tmp:=buf;
1257
  for k:=1 to i-j do
1258
    tmp:=tmp.last;
1259
  k:=tmp.d;
1260
  if k>0 then k-=1;
1261
  writeln(stderr, s, lineInfoStr(tmp.li[k]), ':');
1262
  s+='  ';
1263
  end;
1264
writeln(stderr,s,t);
1265
end;
1266
 
1267
{ ****** hint ******************************************************* }
1268
procedure CMainBmp.hint(const s:ansistring);
1269
begin
1270
if enable_hints then writeln(stderr,'Hint: '+lineInfoStr(lineInfo)+': '+s);
1271
end;
1272
 
1273
{ ****** warning **************************************************** }
1274
procedure CMainBmp.warning(const s:ansistring);
1275
begin
1276
error_int('Warning: '+s);
1277
end;
1278
 
1279
{ ****** error ****************************************************** }
1280
procedure CMainBmp.error(const s:ansistring);
1281
begin
1282
error_int('Error: '+s);
1283
bmp_exit:=bmp_exit_error;
1284
end;
1285
 
1286
{ ****** faterror *************************************************** }
1287
procedure CMainBmp.faterror(const s:ansistring);
1288
begin
1289
error_int('Fatal error: '+s);
1290
halt(bmp_exit_faterror);
1291
end;
1292
 
1293
{ ****** copylaststr ************************************************ }
1294
function CMainBmp.copylaststr(l,mode:longint):rbufstr;
1295
var i,k : longint;
1296
begin
1297
l:=l and rbufmax;
1298
i:=0; k:=rbp;
1299
while (i<l) and ((bufm[k]=mode) or (mode<0)) do
1300
  begin
1301
  i+=1;
1302
  k:=(k-1) and rbufmax;
1303
  end;
1304
result.rbuf:=@rbuf;
1305
result.pt:=k+1;
1306
result.length:=i;
1307
end;
1308
 
1309
function CMainBmp.copylaststr(l:longint):rbufstr;
1310
begin
1311
result:=copylaststr(l,-1);
1312
end;
1313
 
1314
function CMainBmp.copylaststr_br(l,mode:longint):bmpstring;
1315
var i,j,k : longint;
1316
begin
1317
{$ifdef USE_SHORTSTRINGS}
1318
if l>255 then l:=255;
1319
{$endif}
1320
i:=0; j:=0; k:=rbp;
1321
setlength(result,l);
1322
while (i<l) and (j<=rbufmax) do
1323
  begin
1324
  if (bufm[k]=mode) or (mode<0) then
1325
    begin
1326
    result[l-i]:=rbuf[k];
1327
    i+=1;
1328
    end;
1329
  k:=(k-1) and rbufmax;
1330
  j+=1;
1331
  end;
1332
if i<l then result:=copy(result, length(result)-i+1, i);
1333
end;
1334
 
1335
{ ****** matchstr **************************************************** }
1336
function CMainBmp.matchstr(const s:bmpstring; mode:longint):boolean;
1337
begin
1338
matchstr:=cmp_rbuf(copylaststr(length(s),mode), s);
1339
end;
1340
 
1341
function CMainBmp.matchstr(const s:bmpstring):boolean;
1342
begin
1343
matchstr:=cmp_rbuf(copylaststr(length(s),-1),s);
1344
end;
1345
 
1346
function CMainBmp.matchstr(ic:boolean; const s:bmpstring; mode:longint):boolean;
1347
begin
1348
if ic then matchstr:=cmpcase_rbuf(copylaststr(length(s),mode),s)
1349
      else matchstr:=cmp_rbuf(copylaststr(length(s),mode),s);
1350
end;
1351
 
1352
function CMainBmp.matchstr(ic:boolean;const s:bmpstring):boolean;
1353
begin
1354
if ic then matchstr:=cmpcase_rbuf(copylaststr(length(s),-1),s)
1355
      else matchstr:=cmp_rbuf(copylaststr(length(s),-1),s);
1356
end;
1357
 
1358
function CMainBmp.matchstr_br(const s:bmpstring; mode:longint):boolean;
1359
begin
1360
matchstr_br:=copylaststr_br(length(s),mode)=s;
1361
end;
1362
 
1363
function CMainBmp.matchstr_br(ic:boolean; const s:bmpstring; mode:longint):boolean;
1364
begin
1365
if ic then matchstr_br:=upstr(copylaststr_br(length(s),mode))=upstr(s)
1366
      else matchstr_br:=copylaststr_br(length(s),mode)=s
1367
end;
1368
 
1369
{ ****** lastmodestr ************************************************* }
1370
procedure CMainBmp.lastmodestr(mode:longint; var fst,l:longint);
1371
var i,j,k  : longint;
1372
begin
1373
i:=rbp; j:=0; k:=0;
1374
while (bufm[i]<>mode) and (j<=rbufmax) do
1375
  begin
1376
  i:=(i-1) and rbufmax;
1377
  j+=1;
1378
  end;
1379
while (bufm[i]=mode) and (j<=rbufmax) do
1380
  begin
1381
  i:=(i-1) and rbufmax;
1382
  j+=1;
1383
  k+=1;
1384
  end;
1385
i:=(i+1) and rbufmax;
1386
fst:=i;
1387
l:=k;
1388
end;
1389
 
1390
procedure CMainBmp.lastmodestr(mode:longint; var size:longint; var ptc:pchar; var ptli:pdword);
1391
var i,j,k  : longint;
1392
begin
1393
lastmodestr(mode,i,j);
1394
if j>0 then begin
1395
            size:=j;
1396
            getmem(ptc,j);
1397
            getmem(ptli,j*4);
1398
            for k:=0 to j-1 do
1399
              begin
1400
              ptc[k]:=rbuf[i];
1401
              ptli[k]:=li[i];
1402
              i:=(i+1) and rbufmax;
1403
              end;
1404
            end
1405
       else begin
1406
            size:=0;
1407
            ptc:=nil;
1408
            ptli:=nil;
1409
            end;
1410
end;
1411
 
1412
function CMainBmp.lastmodestr(mode:longint):bmpstring;
1413
var i,j,k  : longint;
1414
begin
1415
lastmodestr(mode,i,j);
1416
{$ifdef USE_SHORTSTRINGS}
1417
if j>255 then j:=255;
1418
{$endif}
1419
setlength(lastmodestr,j);
1420
for k:=1 to j do
1421
  begin
1422
  lastmodestr[k]:=rbuf[i];
1423
  i:=(i+1) and rbufmax;
1424
  end;
1425
end;
1426
 
1427
procedure CMainBmp.lastmodestr1(mode:longint; var size:longint; var ptc:pchar; var ptli:pdword);
1428
var i,j,k  : longint;
1429
begin
1430
lastmodestr(mode,i,j);
1431
j-=1;
1432
if j>0 then begin
1433
            size:=j;
1434
            getmem(ptc,j);
1435
            getmem(ptli,j*4);
1436
            for k:=0 to j-1 do
1437
              begin
1438
              ptc[k]:=rbuf[i];
1439
              ptli[k]:=li[i];
1440
              i:=(i+1) and rbufmax;
1441
              end;
1442
            end
1443
       else begin
1444
            size:=0;
1445
            ptc:=nil;
1446
            ptli:=nil;
1447
            end;
1448
end;
1449
 
1450
function CMainBmp.lastmodestr1(mode:longint):bmpstring;
1451
var i,j,k  : longint;
1452
begin
1453
lastmodestr(mode,i,j);
1454
j-=1;
1455
{$ifdef USE_SHORTSTRINGS}
1456
if j>255 then j:=255;
1457
{$endif}
1458
setlength(lastmodestr1,j);
1459
for k:=1 to j do
1460
  begin
1461
  lastmodestr1[k]:=rbuf[i];
1462
  i:=(i+1) and rbufmax;
1463
  end;
1464
end;
1465
 
1466
 
1467
{ ****** setmode ***************************************************** }
1468
procedure CMainBmp.setmode(num,om,nm:longint);
1469
var i,j,k  : longint;
1470
begin
1471
k:=rbp;
1472
i:=0; j:=0;
1473
while (i<num) and (j<=rbufmax) do
1474
  begin
1475
  if (bufm[k]=om) or (om<0) then
1476
    begin
1477
    i+=1;
1478
    bufm[k]:=nm;
1479
    end;
1480
  j+=1;
1481
  k:=(k-1) and rbufmax;
1482
  end;
1483
end;
1484
 
1485
{ ******** printmacros *********************************************** }
1486
procedure CMainBmp.printmacros(const m:array of pbabelmacro; mm:longint);
1487
var i,j : longint;
1488
begin
1489
for j:=0 to mm do
1490
  begin
1491
  writeln(stderr,'   ----- definition ',j+1,' -----');
1492
  writeln(stderr,m[j]^.name);
1493
  if m[j]^.paramsep[0]<>'' then write(stderr,m[j]^.paramsep[0]);
1494
  for i:=1 to m[j]^.pn do
1495
    write(stderr,bc_pa,i,m[j]^.paramsep[i]);
1496
  if (m[j]^.pn>0) or (m[j]^.paramsep[0]<>'') then writeln(stderr);
1497
  for i:=0 to m[j]^.rsize-1 do
1498
    write(stderr,m[j]^.r[i]);
1499
  if m[j]^.rsize>0 then writeln(stderr);
1500
  if m[j]^.rsize=0 then writeln(stderr,'<empty>');
1501
  writeln(stderr);
1502
  writeln(stderr);
1503
  end;
1504
end;
1505
 
1506
procedure CMainBmp.printmacros;
1507
begin
1508
printmacros(macros, lastmacro);
1509
end;
1510
 
1511
{$ifdef ENABLE_DEBUGOUT }
1512
{ ******** debugwrite ************************************************ }
1513
procedure CMainBmp.debugwrite;
1514
var i  : longint;
1515
    lf : boolean;
1516
begin
1517
if rbuf[rbp]=#10
1518
  then begin
1519
       writeln;
1520
       lf:=true;
1521
       end
1522
  else lf:=false;
1523
if (bufm[rbp]<>bm_invalid) and (rbuf[rbp]<>#13) and (rbuf[rbp]<>#10) then write(rbuf[rbp]);
1524
i:=(rbp+1) and rbufmax;
1525
if bufm[rbp]<>bufm[i]
1526
  then begin
1527
       if not lf then writeln;
1528
       write(bufm[i]);
1529
       case bufm[i] of
1530
         0..9       : write('     ');
1531
         10..99     : write('    ');
1532
         200..999   : write('   ');
1533
         1000..9999 : write('  ');
1534
         else         write(' ');
1535
         end;
1536
       end
1537
  else if lf then write('      ');
1538
end;
1539
{$endif}
1540
 
1541
{ ********************************************************************* }
1542
{ ****** main ********************************************************* }
1543
{ ********************************************************************* }
1544
 
1545
{ ****** paramerr ***************************************************** }
1546
procedure paramerr(msg:ansistring);
1547
begin
1548
writeln(stderr,'Usage: '+paramstr(0)+' [<Options>] [<filename1> [<filename2> ...]]');
1549
writeln(stderr,'Options: ');
1550
writeln(stderr,'        -o <fileneme>    Output file');
1551
writeln(stderr,'        -p               Pascal mode (default), equal to -mm "//" -mo "[" -mc "]" -mp "#"');
1552
writeln(stderr,'        -c               C mode, equal to -mm "#" -mo "[" -mc "]" -mp "$" -l ''#line %2 "%1"''');
1553
writeln(stderr,'        -i               Ignore upper/lower case');
1554
writeln(stderr,'        -l               Line info (default for C mode: ''#line %2 "%1"'')');
1555
writeln(stderr,'        -I  <directory>  Include path');
1556
writeln(stderr,'        -D  <symbol>     Define symbol <symbol>');
1557
writeln(stderr,'        -mm <string>     Meta macro start string');
1558
writeln(stderr,'        -mo <char>       Open bracket');
1559
writeln(stderr,'        -mc <char>       Close bracket');
1560
writeln(stderr,'        -mp <char>       Parameter character');
1561
//writeln(stderr,'      -nh              Disable hints');
1562
{$ifdef ENABLE_DEBUGOUT}
1563
writeln(stderr,'        -do              Enable debug output');
1564
{$endif}
1565
writeln(stderr,'        -dd              Print definitions');
1566
writeln(stderr,'        -h               Help');
1567
if msg<>''
1568
  then begin
1569
       writeln(stderr,msg);
1570
       halt(bmp_exit_paramerror);
1571
       end
1572
  else halt(0);
1573
end;
1574
 
1575
{ ****** main ********************************************************* }
1576
const maxInfilec = 1024;
1577
 
1578
var main          : CMainBmp;
1579
    infile        : array[0..maxInfilec-1] of ansistring;
1580
    i,j,infilec   : longint;
1581
    s,t           : ansistring;
1582
    fo            : text;
1583
 
1584
    fofn             : ansistring;
1585
    bc_pm_d,bc_ob_d  : boolean;
1586
    bc_cb_d,bc_pa_d  : boolean;
1587
    pasmode,lidef    : boolean;
1588
 
1589
begin
1590
spath[0]:='';
1591
spathc:=1;
1592
 
1593
main:=CMainBmp.create;
1594
 
1595
fofn:='';
1596
bc_pm_d:=false;
1597
bc_ob_d:=false;
1598
bc_cb_d:=false;
1599
bc_pa_d:=false;
1600
pasmode:=true;
1601
lidef:=false;
1602
 
1603
infilec:=0;
1604
i:=1;
1605
while i<=paramcount do
1606
  begin
1607
  s:=paramstr(i);
1608
  if (length(s)>1) and (s[1]='-')
1609
    then begin
1610
         if s='-o' then
1611
             begin
1612
             if i>=paramcount then paramerr('File name expected after -o');
1613
             i+=1;
1614
             fofn:=paramstr(i);
1615
             end
1616
           else if s='-p' then pasmode:=true
1617
           else if s='-c' then pasmode:=false
1618
           else if s='-i' then bp_icase:=true
1619
           else if s='-l' then
1620
             begin
1621
             if i>=paramcount then paramerr('String expected after -l');
1622
             i+=1;
1623
             lineInfoPattern:=paramstr(i);
1624
{$ifdef WINDOWS}
1625
             for j:=1 to length(lineInfoPattern) do
1626
               if lineInfoPattern[j]='\' then lineInfoPattern[j]:='"';
1627
{$endif}
1628
             lidef:=true;
1629
             end
1630
           else if s='-I' then
1631
             begin
1632
             if i>=paramcount then paramerr('Path expected after -I');
1633
             i+=1;
1634
             t:=paramstr(i);
1635
{$ifdef WINDOWS}
1636
             for j:=1 to length(t) do
1637
               if t[j]='/' then t[j]:='\';
1638
{$endif}
1639
             if t<>'' then
1640
               begin
1641
               if t[length(t)]<>dirsep then t+=dirsep;
1642
               if spathc>=maxspathc
1643
                 then bmp_error('Maximum amount of search paths reached')
1644
                 else begin
1645
                      spath[spathc]:=t;
1646
                      spathc+=1;
1647
                      end;
1648
               end;
1649
             end
1650
           else if s='-D' then
1651
             begin
1652
             if i>=paramcount then paramerr('Symbol expected after -D');
1653
             i+=1;
1654
             main.initsymb(paramstr(i));
1655
             end
1656
           else if s='-mm' then
1657
             begin
1658
             if i>=paramcount then paramerr('String expected after -mm');
1659
             i+=1;
1660
             bc_pm_d:=true;
1661
             bc_pm:=paramstr(i);
1662
             end
1663
           else if s='-mo' then
1664
             begin
1665
             if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mo');
1666
             i+=1;
1667
             bc_ob_d:=true;
1668
             bc_ob:=paramstr(i)[1];
1669
             end
1670
           else if s='-mc' then
1671
             begin
1672
             if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mc');
1673
             i+=1;
1674
             bc_cb_d:=true;
1675
             bc_cb:=paramstr(i)[1];
1676
             end
1677
           else if s='-mp' then
1678
             begin
1679
             if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mp');
1680
             i+=1;
1681
             bc_pa_d:=true;
1682
             bc_pa:=paramstr(i)[1];
1683
             end
1684
           else if s='-eh' then enable_hints:=false
1685
{$ifdef ENABLE_DEBUGOUT}
1686
           else if s='-do' then debugoutput:=true
1687
{$endif}
1688
           else if s='-dd' then printdefs:=true
1689
           else if s='-h' then paramerr('')
1690
           else paramerr('Invalid option: '+s);
1691
         end
1692
    else begin
1693
         if infilec>=maxinfilec
1694
            then bmp_error('Maximum amount of input files reached')
1695
            else begin
1696
{$ifdef WINDOWS}
1697
                 for j:=1 to length(s) do
1698
                   if s[j]='/' then s[j]:='\';
1699
{$endif}
1700
                 if s='-'
1701
                   then infile[infilec]:=''
1702
                   else infile[infilec]:=s;
1703
                 infilec+=1;
1704
                 end;
1705
         end;
1706
  i+=1;
1707
  end;
1708
 
1709
if pasmode
1710
  then begin
1711
       if not bc_pm_d then bc_pm:='//';
1712
       if not bc_ob_d then bc_ob:='[';
1713
       if not bc_cb_d then bc_cb:=']';
1714
       if not bc_pa_d then bc_pa:='#';
1715
       end
1716
  else begin
1717
       if not bc_pm_d then bc_pm:='#';
1718
       if not bc_ob_d then bc_ob:='[';
1719
       if not bc_cb_d then bc_cb:=']';
1720
       if not bc_pa_d then bc_pa:='$';
1721
       if not lidef then lineInfoPattern:='#line %2 "%1"';
1722
       end;
1723
 
1724
if infilec=0 then
1725
  begin
1726
  infile[0]:='';
1727
  infilec:=1;
1728
  end;
1729
 
1730
if fofn<>''
1731
  then begin
1732
       try
1733
         assign(fo,fofn);
1734
         rewrite(fo);
1735
         for i:=0 to infilec-1 do
1736
           main.run(infile[i],fo);
1737
         close(fo);
1738
       except
1739
         bmp_faterror('Error writing to file '+fofn);
1740
         end;
1741
       end
1742
  else for i:=0 to infilec-1 do
1743
         main.run(infile[i],output);
1744
 
1745
main.destroy;
1746
halt(bmp_exit);
1747
end.

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.