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 2

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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