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

Subversion Repositories usb_fpga_1_2

[/] [usb_fpga_1_2/] [trunk/] [bmp/] [src/] [bmp.pas] - Blame information for rev 3

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) 2008-2009 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 dos}
394
initsymb('dos');
395
{$endif}
396
{$ifdef linux}
397
initsymb('linux');
398
{$endif}
399
{$ifdef unix}
400
initsymb('unix');
401
{$endif}
402
{$ifdef go32v1}
403
initsymb('go32v1');
404
{$endif}
405
{$ifdef go32v2}
406
initsymb('go32v2');
407
{$endif}
408
{$ifdef os2}
409
initsymb('os2');
410
{$endif}
411
{$ifdef win32}
412
initsymb('win32');
413
{$endif}
414
{$ifdef macos}
415
initsymb('macos');
416
{$endif}
417
{$ifdef amiga}
418
initsymb('amiga');
419
{$endif}
420
{$ifdef atari}
421
initsymb('atari');
422
{$endif}
423
end;
424
 
425
{ ****** destroy **************************************************** }
426
destructor CMainBmp.destroy;
427
var i  : longint;
428
begin
429
for i:=0 to lastmacro do
430
  if macros[i]<>nil then freemacro(macros[i]);
431
end;
432
 
433
{ ****** run ******************************************************** }
434
procedure CMainBmp.run(const mf:ansistring; var fo:text);
435
var i,mode,j,k,l,bl,ifc  : longint;
436
    outfile,bm_expand    : longint;
437
    prevli,ampos         : dword;
438
    sx,endnoexpand       : bmpstring;
439
    s4                   : array[0..3] of char;
440
    i4                   : dword absolute s4;
441
    tmpbuf               : CTextBuf;
442
    tmpmbuf              : CMacroBuf;
443
    amacro               : PBabelMacro;
444
    writebuf             : shortstring;
445
 
446
    pm_s,pm_m            : dword;
447
    pm_q                 : boolean;
448
    t4                   : TS4;
449
 
450
    ifs                  : array[0..maxifs] of byte;
451
    ifli                 : array[0..maxifs] of dword;
452
    bli                  : array[0..maxbs] of dword;
453
 
454
label endparse;
455
 
456
begin
457
amacro:=nil;
458
t4.s:=copy('    '+bc_pm, length(bc_pm)+1,4);
459
pm_s:=t4.i;
460
pm_m:=$ffffffff shl ((4-min(length(bc_pm),4))*8);
461
pm_q:=length(bc_pm)<=4;
462
 
463
writebuf:='';
464
CFileBuf.create(buf,mf,'');
465
 
466
bl:=0;
467
fillchar(bufm, sizeof(bufm), 0);
468
fillchar(rbuf, sizeof(rbuf), #32);
469
fillchar(li, sizeof(li), 0);
470
bufm[0]:=bm_outfile_a;
471
bufm[rbufmax]:=bm_outfile_a+1;
472
 
473
rbp:=0;
474
mode:=bm_plain;
475
ifc:=-1;
476
outfile:=1;
477
bm_expand:=bm_plain;
478
 
479
prevli:=dword(-1);
480
ampos:=0;
481
while (buf<>nil) and (bmp_exit<>bmp_exit_usererror) do
482
  begin
483
  if buf.d>buf.lastbuf
484
    then begin
485
         buf.endbuf;
486
         if buf.killme then
487
           begin
488
           tmpbuf:=buf.last;
489
           buf.destroy;
490
           buf:=tmpbuf;
491
           end;
492
         end
493
    else if buf.buf[buf.d]=#13 then buf.d+=1
494
    else begin
495
{$ifdef ENABLE_DEBUGOUT}
496
         if debugoutput then debugwrite;
497
{$endif}
498
         i:=bufm[rbp];
499
         if (i<10) and (i>=0) and (outfile>0) then
500
              begin
501
              j:=ord(writebuf[0])+1;     { avoid the range checking }
502
              writebuf[0]:=char(j);
503
              writebuf[j]:=rbuf[rbp];
504
              if rbuf[rbp]=#10 then
505
                 begin
506
                 if (li[rbp]<>prevli+4096) and (lineInfoPattern<>'') then lineInfoStr(fo,li[rbp]);
507
                 prevli:=li[rbp];
508
                 byte(writebuf[0])-=1;
509
                 writeln(fo,writebuf);
510
                 writebuf:='';
511
                 end;
512
              if (j>=255) then
513
                 begin
514
                 write(fo,writebuf);
515
                 writebuf:='';
516
                 end;
517
              end
518
            else if (i>=bm_outfile_a) and (i<=bm_outfile_z) then outfile:=i-bm_outfile_a;
519
 
520
         rbuf[rbp]:=buf.buf[buf.d];
521
         lineInfo:=buf.li[buf.d];
522
         li[rbp]:=lineInfo;
523
         bufm[rbp]:=mode;
524
         buf.d+=1;
525
 
526
{brackets}
527
         if rbuf[rbp]=bc_ob then
528
           begin
529
           if (bl>=0) and (bl<maxbs) then bli[bl]:=lineInfo;
530
           bl+=1;
531
           end;
532
         if rbuf[rbp]=bc_cb then bl-=1;
533
{if's}
534
         if mode<>bm_plain then
535
           begin
536
           if (mode=bm_pm) and matchstr(bc_pm+'ifdef'+bc_ob,bm_pm) then
537
              begin
538
              setmode(length(bc_pm+'ifdef'+bc_ob),bm_pm,bm_if);
539
              mode:=bm_if_scb;
540
              bli[0]:=lineInfo;
541
              bl:=1;
542
              end;
543
           if (mode=bm_pm) and matchstr(bc_pm+'ifndef'+bc_ob,bm_pm) then
544
              begin
545
              setmode(length(bc_pm+'ifndef'+bc_ob),bm_pm,bm_if);
546
              mode:=bm_ifn_scb;
547
              bli[0]:=lineInfo;
548
              bl:=1;
549
              end;
550
           if (mode=bm_pm) and matchstr(bc_pm+'ifeq'+bc_ob,bm_pm) then
551
              begin
552
              setmode(length(bc_pm+'ifeq'+bc_ob),bm_pm,bm_if);
553
              mode:=bm_ifeq_scb1;
554
              bm_expand:=bm_ifeq_scb1;
555
              bli[0]:=lineInfo;
556
              bl:=1;
557
              end;
558
           if (mode=bm_pm) and matchstr(bc_pm+'ifneq'+bc_ob,bm_pm) then
559
              begin
560
              setmode(length(bc_pm+'ifeq'+bc_ob),bm_pm,bm_if);
561
              mode:=bm_ifneq_scb1;
562
              bm_expand:=bm_ifneq_scb1;
563
              bli[0]:=lineInfo;
564
              bl:=1;
565
              end;
566
 
567
           if (mode=bm_if_not) and matchstr(bc_pm+'ifdef'+bc_ob,bm_if_not) then
568
              begin
569
              setmode(length(bc_pm+'ifdef'+bc_ob),bm_if_not,bm_if);
570
              ifc+=1;
571
              if ifc>maxifs then faterror('if memory exceeded');
572
              ifli[ifc]:=lineInfo;
573
              ifs[ifc]:=2;
574
              end;
575
           if (mode=bm_if_not) and matchstr(bc_pm+'ifndef'+bc_ob,bm_if_not) then
576
              begin
577
              setmode(length(bc_pm+'ifndef'+bc_ob),bm_if_not,bm_if);
578
              ifc+=1;
579
              if ifc>maxifs then faterror('if memory exceeded');
580
              ifli[ifc]:=lineInfo;
581
              ifs[ifc]:=2;
582
              end;
583
           if (mode=bm_if_not) and matchstr(bc_pm+'ifeq'+bc_ob,bm_if_not) then
584
              begin
585
              setmode(length(bc_pm+'ifeq'+bc_ob),bm_if_not,bm_if);
586
              ifc+=1;
587
              if ifc>maxifs then faterror('if memory exceeded');
588
              ifli[ifc]:=lineInfo;
589
              ifs[ifc]:=2;
590
              end;
591
           if (mode=bm_if_not) and matchstr(bc_pm+'ifneq'+bc_ob,bm_if_not) then
592
              begin
593
              setmode(length(bc_pm+'ifneq'+bc_ob),bm_if_not,bm_if);
594
              ifc+=1;
595
              if ifc>maxifs then faterror('if memory exceeded');
596
              ifli[ifc]:=lineInfo;
597
              ifs[ifc]:=2;
598
              end;
599
 
600
           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
601
              begin
602
              bufm[rbp]:=bm_ifb;
603
              if (mode=bm_ifeq_scb1) or (mode=bm_ifeq_scb1_ne)
604
                 then mode:=bm_ifeq_sob
605
                 else mode:=bm_ifneq_sob;
606
              ampos:=lineInfo;
607
              bm_expand:=bm_plain;
608
              end;
609
 
610
           if ((mode=bm_ifeq_sob) or (mode=bm_ifneq_sob)) and (rbuf[rbp]=bc_ob) then
611
              begin
612
              bli[0]:=lineInfo;
613
              bl:=1;
614
              if mode=bm_ifeq_sob
615
                 then mode:=bm_ifeq_scb2
616
                 else mode:=bm_ifneq_scb2;
617
              bm_expand:=mode;
618
              end;
619
 
620
           if ((mode=bm_if_scb) or (mode=bm_ifn_scb)) and (bl=0) then
621
              begin
622
              sx:=lastmodestr1(mode);
623
              if length(sx)<1
624
                 then begin
625
                      warning('empty symbol name');
626
                      mode:=bm_pm;
627
                      end
628
                 else begin
629
                      ifc+=1;
630
                      if ifc>maxifs then faterror('if memory exceeded');
631
                      ifli[ifc]:=lineInfo;
632
                      if mode=bm_if_scb
633
                         then ifs[ifc]:=0
634
                         else ifs[ifc]:=1;
635
                      i:=lastmacro;
636
                      while i>=0 do
637
                        begin
638
                        if (macros[i]^.name=sx) then
639
                          begin
640
                          if mode=bm_if_scb
641
                             then ifs[ifc]:=1
642
                             else ifs[ifc]:=0;
643
                          i:=0;
644
                          end;
645
                        i-=1;
646
                        end;
647
                      if ifs[ifc]=0
648
                        then mode:=bm_if_not
649
                        else mode:=bm_pm;
650
                      end;
651
                 end;
652
           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
653
              begin
654
              i:=0;
655
              j:=0;
656
              repeat
657
                repeat
658
                  i+=1;
659
                  k:=bufm[(rbp-i) and rbufmax];
660
//                writeln(stderr,'  i=',i,'  k=',k);
661
                  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);
662
                repeat
663
                  j+=1;
664
                  l:=bufm[(rbp-j) and rbufmax];
665
//                writeln(stderr,'  j=',j,'  l=',l);
666
                  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);
667
//              writeln(stderr,rbp,',',i,',',j,'-->',rbuf[(rbp-i) and rbufmax],'<-->',rbuf[(rbp-j) and rbufmax],'<--');
668
                until (j>=rbufmax) or (l=bm_if) or (k=bm_if) or (rbuf[(rbp-i) and rbufmax]<>rbuf[(rbp-j) and rbufmax]);
669
//            writeln(stderr);  
670
              ifc+=1;
671
              if ifc>maxifs then faterror('if memory exceeded');
672
              ifli[ifc]:=lineInfo;
673
 
674
              if (i=j) = ((mode=bm_ifeq_scb2) or (mode=bm_ifeq_scb2_ne))
675
                then ifs[ifc]:=1
676
                else ifs[ifc]:=0;
677
 
678
              if ifs[ifc]=0
679
                 then mode:=bm_if_not
680
                 else mode:=bm_pm;
681
              bm_expand:=bm_plain;
682
              end;
683
 
684
           if (mode=bm_pm) and matchstr(bc_pm+'else',bm_pm) then
685
              begin
686
              if ifc<0 then error('else without ifdef');
687
              if ifs[ifc]<>1 then error('internal error 5');
688
              ifs[ifc]:=0;
689
              mode:=bm_if_not;
690
              end;
691
           if (mode=bm_pm) and ( matchstr(bc_pm+'elifdef'+bc_ob,bm_pm)
692
                               or matchstr(bc_pm+'elifndef'+bc_ob,bm_pm)
693
                               or matchstr(bc_pm+'elifeq'+bc_ob,bm_pm)
694
                               or matchstr(bc_pm+'elifneq'+bc_ob,bm_pm) ) then
695
              begin
696
              if ifc<0 then error('else without ifdef');
697
              if ifs[ifc]<>1 then error('internal error 5');
698
              ifs[ifc]:=2;
699
              mode:=bm_if_not;
700
              end;
701
 
702
           if (mode=bm_if_not) and matchstr(bc_pm+'else',bm_if_not) then
703
              begin
704
              setmode(length(bc_pm+'else'+bc_ob),bm_if_not,bm_if);
705
              if ifc<0
706
                then error('else without ifdef')
707
                else if ifs[ifc]=0
708
                        then begin
709
                             ifs[ifc]:=1;
710
                             mode:=bm_pm;
711
                             end
712
                        else begin
713
                             if ifs[ifc]<>2 then error('internal error 6')
714
                             end;
715
              end;
716
           if (mode=bm_if_not) and matchstr(bc_pm+'elifdef'+bc_ob,bm_if_not) then
717
              begin
718
              setmode(length(bc_pm+'elifdef'+bc_ob),bm_if_not,bm_if);
719
              if ifc<0
720
                 then error('elifdef without ifdef')
721
                 else if ifs[ifc]=0
722
                         then begin
723
                              ifc-=1;
724
                              mode:=bm_if_scb;
725
                              bli[0]:=lineInfo;
726
                              bl:=1;
727
                              end
728
                         else begin
729
                              if ifs[ifc]<>2 then error('internal error 6a')
730
                              end;
731
              end;
732
           if (mode=bm_if_not) and matchstr(bc_pm+'elifndef'+bc_ob,bm_if_not) then
733
              begin
734
              setmode(length(bc_pm+'elifndef'+bc_ob),bm_if_not,bm_if);
735
              if ifc<0
736
                 then error('elifndef without ifdef')
737
                 else if ifs[ifc]=0
738
                        then begin
739
                             ifc-=1;
740
                             mode:=bm_ifn_scb;
741
                             bli[0]:=lineInfo;
742
                             bl:=1;
743
                             end
744
                        else begin
745
                             if ifs[ifc]<>2 then error('internal error 6b')
746
                             end;
747
              end;
748
           if (mode=bm_if_not) and matchstr(bc_pm+'elifeq'+bc_ob,bm_if_not) then
749
              begin
750
              setmode(length(bc_pm+'elifeq'+bc_ob),bm_if_not,bm_if);
751
              if ifc<0
752
                 then error('elifeq without ifdef')
753
                 else if ifs[ifc]=0
754
                        then begin
755
                             ifc-=1;
756
                             mode:=bm_ifeq_scb1;
757
                             bm_expand:=bm_ifeq_scb1;
758
                             bli[0]:=lineInfo;
759
                             bl:=1;
760
                             end
761
                        else begin
762
                             if ifs[ifc]<>2 then error('internal error 6c')
763
                             end;
764
              end;
765
           if (mode=bm_if_not) and matchstr(bc_pm+'elifneq'+bc_ob,bm_if_not) then
766
              begin
767
              setmode(length(bc_pm+'elifneq'+bc_ob),bm_if_not,bm_if);
768
              if ifc<0
769
                 then error('elifneq without ifdef')
770
                 else if ifs[ifc]=0
771
                        then begin
772
                             ifc-=1;
773
                             mode:=bm_ifneq_scb1;
774
                             bm_expand:=bm_ifneq_scb1;
775
                             bli[0]:=lineInfo;
776
                             bl:=1;
777
                             end
778
                        else begin
779
                             if ifs[ifc]<>2 then error('internal error 6d')
780
                             end;
781
              end;
782
 
783
           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
784
              begin
785
              if ifc<0
786
                 then error('endif without if')
787
                 else ifc-=1;
788
              if (ifc=-1) or (ifs[ifc]=1)
789
                 then mode:=bm_pm
790
                 else mode:=bm_if_not;
791
              end;
792
           if mode=bm_if_not then goto endparse;
793
{define mode}
794
           if mode=bm_def_sob2 then
795
              begin
796
              if rbuf[rbp]=bc_ob
797
                 then begin
798
                      mode:=bm_def_scb2;
799
                      bli[0]:=lineInfo;
800
                      bl:=1;
801
                      end
802
                 else begin
803
                      mode:=bm_pm;
804
                      setmode(1,-1,bm_pm);
805
                      end;
806
              end;
807
           if mode=bm_def_sob3 then
808
              begin
809
              if rbuf[rbp]=bc_ob
810
                 then begin
811
                      mode:=bm_def_scb3;
812
                      bli[0]:=lineInfo;
813
                      bl:=1;
814
                      end
815
                 else begin
816
                      lastmodestr1(bm_def_scb2, macros[lastmacro]^.rsize, macros[lastmacro]^.r, macros[lastmacro]^.li);
817
                      mode:=bm_pm;
818
                      setmode(1,-1,bm_pm);
819
                      end;
820
              end;
821
           if (mode=bm_def_scb1) and (bl=0) then
822
              begin
823
              mode:=bm_def_sob2;
824
              sx:=lastmodestr1(bm_def_scb1);
825
              if length(sx)<1
826
                 then begin
827
                      warning('empty macro name');
828
                      mode:=bm_pm;
829
                      end
830
                 else initsymb(sx);
831
              end;
832
           if (mode=bm_def_scb2) and (bl=0) then
833
              begin
834
              mode:=bm_def_sob3;
835
              end;
836
           if (mode=bm_def_scb3) and (bl=0) then
837
              begin
838
              mode:=bm_pm;
839
              lastmodestr(bm_def_scb2,i,j);
840
              j-=1;
841
              k:=1;
842
              while k<=j do
843
                begin
844
                if rbuf[i]=bc_pa
845
                   then begin
846
                        if macros[lastmacro]^.pn>=maxparams then error('only '+int2str(maxparams)+' paramters allowed');
847
                        if k=j then error(paramids[macros[lastmacro]^.pn+1]+' expected after `'+bc_pa+''', found '+bc_cb)
848
                               else begin
849
                                    inc(k);
850
                                    i:=(i+1) and rbufmax;
851
                                    if rbuf[i]=paramids[macros[lastmacro]^.pn+1]
852
                                       then inc(macros[lastmacro]^.pn)
853
                                       else error(paramids[macros[lastmacro]^.pn+1]+' expected after `'+bc_pa+''', found '+rbuf[i]);
854
                                    end;
855
                        end
856
                   else macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]+=rbuf[i];
857
                i:=(i+1) and rbufmax;
858
                k+=1;
859
                end;
860
              if (macros[lastmacro]^.pn>0) then
861
                begin
862
                if macros[lastmacro]^.paramsep[0]='' then macros[lastmacro]^.paramsep[0]:=bc_ob;
863
                if macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]='' then macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]:=bc_cb;
864
                end;
865
              for i:=1 to macros[lastmacro]^.pn-1 do
866
                if macros[lastmacro]^.paramsep[i]='' then macros[lastmacro]^.paramsep[i]:=bc_cb+bc_ob;
867
              lastmodestr1(bm_def_scb3, macros[lastmacro]^.rsize, macros[lastmacro]^.r, macros[lastmacro]^.li);
868
              end;
869
           if (mode=bm_def_scbu) and (bl=0) then
870
              begin
871
              sx:=lastmodestr1(bm_def_scbu);
872
              j:=0;
873
              if length(sx)<1
874
                 then warning('empty symbol name')
875
                 else begin
876
                      i:=lastmacro;
877
                      while i>=0 do
878
                        begin
879
                        if macros[i]^.name=sx then
880
                          begin
881
                          freemacro(macros[i]);
882
                          for j:=i to lastmacro-1 do
883
                            macros[j]:=macros[j+1];
884
                          macros[lastmacro]:=nil;
885
                          dec(lastmacro);
886
                          j:=-10;
887
                          i:=0;
888
                          end;
889
                        i-=1;
890
                        end;
891
                      if j<>-10 then warning('`'+sx+''' not defined');
892
                      end;
893
              mode:=bm_pm;
894
              end;
895
           if (mode=bm_def_scba) and (bl=0) then
896
              begin
897
              sx:=lastmodestr1(bm_def_scba);
898
              j:=0;
899
              if length(sx)<1
900
                 then warning('empty symbol name')
901
                 else begin
902
                      i:=0;k:=0;
903
                      while i<=lastmacro do
904
                       if macros[i]^.name=sx
905
                          then begin
906
                               freemacro(macros[i]);
907
                               for j:=i to lastmacro-1 do
908
                                 macros[j]:=macros[j+1];
909
                               macros[lastmacro]:=nil;
910
                               dec(lastmacro);
911
                               k:=-10;
912
                               end
913
                          else inc(i);
914
                      if k<>-10 then warning('`'+sx+''' not defined');
915
                      end;
916
              mode:=bm_pm;
917
              end;
918
{include mode}
919
           if (mode=bm_inc_scb) and (bl=0) then
920
              begin
921
              sx:=lastmodestr1(bm_inc_scb);
922
              if length(sx)<1
923
                 then warning('empty include file name')
924
                 else CFileBuf.create(buf,sx, lineInfoStr(lineInfo)+': ');
925
              mode:=bm_plain;
926
              end;
927
{noexpand mode}
928
           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,bm_pm) then
929
              begin
930
              setmode(length(bc_pm+'noexpand'+bc_ob),bm_pm,bm_noexpand);
931
              mode:=bm_noexpand_scb;
932
              bli[0]:=lineInfo;
933
              bl:=1;
934
              end;
935
           if (mode=bm_noexpand_scb) and (bl=0) then
936
              begin
937
              endnoexpand:=lastmodestr1(bm_noexpand_scb);
938
              case bm_expand of
939
                bm_ifeq_scb1  : mode:=bm_ifeq_scb1_ne;
940
                bm_ifeq_scb2  : mode:=bm_ifeq_scb2_ne;
941
                bm_ifneq_scb1 : mode:=bm_ifneq_scb1_ne;
942
                bm_ifneq_scb2 : mode:=bm_ifneq_scb2_ne;
943
                else mode:=bm_neplain;
944
                end;
945
              ampos:=lineInfo;
946
              end;
947
           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,bm_neplain) then
948
              begin
949
              setmode(length(endnoexpand),bm_neplain,bm_noexpand);
950
              case bm_expand of
951
                bm_ifeq_scb1_ne  : mode:=bm_ifeq_scb1;
952
                bm_ifeq_scb2_ne  : mode:=bm_ifeq_scb2;
953
                bm_ifneq_scb1_ne : mode:=bm_ifneq_scb1;
954
                bm_ifneq_scb2_ne : mode:=bm_ifneq_scb2;
955
                else mode:=bm_plain;
956
                end;
957
              end;
958
{error mode}
959
           if (mode=bm_err_scb) and (bl=0) then
960
              begin
961
              error(lastmodestr1(bm_err_scb));
962
              mode:=bm_plain;
963
              bmp_exit:=bmp_exit_usererror;
964
              end;
965
{warning mode}
966
           if (mode=bm_warn_scb) and (bl=0) then
967
              begin
968
              warning(lastmodestr1(bm_warn_scb));
969
              mode:=bm_plain;
970
              end;
971
{programming mode}
972
           if mode=bm_pm then
973
              begin
974
              if matchstr(bc_pm+bc_pm,bm_pm) then
975
                 begin
976
                 setmode(length(bc_pm),bm_pm,bm_plain);
977
                 mode:=bm_plain;
978
                 end;
979
              if matchstr(bc_lf,bm_pm) then mode:=bm_plain;
980
              if matchstr(bc_pm+'define'+bc_ob,bm_pm) then
981
                 begin
982
                 setmode(length(bc_pm+'define'+bc_ob),bm_pm,bm_def);
983
                 mode:=bm_def_scb1;
984
                 bli[0]:=lineInfo;
985
                 bl:=1;
986
                 end;
987
              if matchstr(bc_pm+'udefine'+bc_ob,bm_pm) then
988
                 begin
989
                 setmode(length(bc_pm+'udefine'+bc_ob),bm_pm,bm_def);
990
                 mode:=bm_def_scbu;
991
                 bli[0]:=lineInfo;
992
                 bl:=1;
993
                 end;
994
              if matchstr(bc_pm+'uadefine'+bc_ob,bm_pm) then
995
                 begin
996
                 setmode(length(bc_pm+'uadefine'+bc_ob),bm_pm,bm_def);
997
                 mode:=bm_def_scba;
998
                 bli[0]:=lineInfo;
999
                 bl:=1;
1000
                 end;
1001
              if matchstr(bc_pm+'nolf',bm_pm) then
1002
                 begin
1003
                 i:=rbp; j:=0; k:=0;
1004
                 while (j<=rbufmax+1-length(bc_lf)) and (k=0) do
1005
                   begin
1006
                   rbp:=(rbp-1) and rbufmax;
1007
                   if matchstr(bc_lf,bm_plain) then
1008
                      begin
1009
                      setmode(length(bc_lf),-1,bm_comm);
1010
                      k:=1;
1011
                      end;
1012
                  j+=1;
1013
                  end;
1014
                 rbp:=i;
1015
                 end;
1016
              if matchstr(bc_pm+'include'+bc_ob,bm_pm) then
1017
                 begin
1018
                 setmode(length(bc_pm+'include'+bc_ob),bm_pm,bm_inc);
1019
                 mode:=bm_inc_scb;
1020
                 bli[0]:=lineInfo;
1021
                 bl:=1;
1022
                 end;
1023
              if matchstr(bc_pm+'error'+bc_ob,bm_pm) then
1024
                 begin
1025
                 setmode(length(bc_pm+'error'+bc_ob),bm_pm,bm_err);
1026
                 mode:=bm_err_scb;
1027
                 bli[0]:=lineInfo;
1028
                 bl:=1;
1029
                 end;
1030
              if matchstr(bc_pm+'warning'+bc_ob,bm_pm) then
1031
                 begin
1032
                 setmode(length(bc_pm+'warning'+bc_ob),bm_pm,bm_warn);
1033
                 mode:=bm_warn_scb;
1034
                 bli[0]:=lineInfo;
1035
                 bl:=1;
1036
                 end;
1037
              if matchstr(bc_pm+'disableout',bm_pm) then bufm[rbp]:=bm_outfile_a;
1038
              if matchstr(bc_pm+'enableout',bm_pm) then bufm[rbp]:=bm_outfile_a+1;
1039
              if matchstr(bc_pm+'ignorecase',bm_pm) then bp_icase:=true;
1040
              if matchstr(bc_pm+'exactcase',bm_pm) then bp_icase:=false;
1041
              end;
1042
 
1043
{expanding mode}
1044
           if ((mode>=bm_em_p0) and (mode<=bm_em_pz)) and (matchstr(bp_icase, amacro^.paramsep[mode-bm_em_p0], mode)) then
1045
              begin
1046
              setmode(length(amacro^.paramsep[mode-bm_em_p0])-1,mode,bm_em);
1047
              if (mode=bm_em_pz) or (mode-bm_em_p0=amacro^.pn)
1048
                 then begin
1049
                      mode:=bm_expand;
1050
                      if amacro^.rsize<0 then error('internal error 2');
1051
                      if amacro^.rsize>0 then
1052
                         begin
1053
                         tmpmbuf:=CMacroBuf.create(buf, amacro, false);
1054
                         i:=0;
1055
                         while i<amacro^.rsize do
1056
                           begin
1057
                           if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf);
1058
                           if (amacro^.r[i]=bc_pa) and (i+1<amacro^.rsize)
1059
                              then begin
1060
                                   inc(i);
1061
                                   if amacro^.r[i]=bc_pa
1062
                                      then begin
1063
                                           while amacro^.r[i]=bc_pa do
1064
                                            begin
1065
                                            if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf);
1066
                                            inc(tmpmbuf.lastbuf);
1067
                                            tmpmbuf.buf[tmpmbuf.lastbuf]:=bc_pa;
1068
                                            tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i];
1069
                                            inc(i);
1070
                                            end;
1071
                                           end
1072
                                      else begin
1073
                                           l:=-1;
1074
                                           repeat
1075
                                             inc(l);
1076
                                             until (l>amacro^.pn) or (paramids[l]=amacro^.r[i]);
1077
                                           if l<=amacro^.pn
1078
                                               then begin
1079
                                                    lastmodestr(bm_em_p0+l,j,k);
1080
                                                    dec(k);
1081
                                                    while (k>0) do
1082
                                                      begin
1083
                                                      if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf);
1084
                                                      inc(tmpmbuf.lastbuf);
1085
                                                      tmpmbuf.buf[tmpmbuf.lastbuf]:=rbuf[j];
1086
                                                      tmpmbuf.li[tmpmbuf.lastbuf]:=li[j];
1087
                                                      j:=(j+1) and rbufmax;
1088
                                                      dec(k);
1089
                                                      end;
1090
                                                    inc(i);
1091
                                                    end
1092
                                               else begin
1093
                                                    inc(tmpmbuf.lastbuf);
1094
                                                    tmpmbuf.buf[tmpmbuf.lastbuf]:=bc_pa;
1095
                                                    tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i];
1096
                                                    end;
1097
                                            end;
1098
                                   end
1099
                              else begin
1100
                                   inc(tmpmbuf.lastbuf);
1101
                                   tmpmbuf.buf[tmpmbuf.lastbuf]:=amacro^.r[i];
1102
                                   tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i];
1103
                                   inc(i);
1104
                                   end;
1105
                           end;
1106
                         end;
1107
                      end
1108
                 else inc(mode);
1109
              end;
1110
           end;
1111
{plain mode}
1112
         if mode=bm_expand then
1113
            begin
1114
            i:=3; j:=0; k:=rbp;          { equal to copylaststr_br(4,bm_expand); }
1115
            i4:=0;
1116
            while (i>=0) and (j<=rbufmax) do
1117
              begin
1118
              if bufm[k]=bm_expand then
1119
                 begin
1120
                 s4[i]:=rbuf[k];
1121
                 i-=1;
1122
                 end;
1123
               k:=(k-1) and rbufmax;
1124
               j+=1;
1125
               end;
1126
 
1127 3 ZTEX
            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)))
1128 2 ZTEX
              then begin
1129
                   mode:=bm_pm;
1130
                   setmode(length(bc_pm),bm_plain,mode);
1131
                   end
1132
              else begin
1133
                   if bp_icase
1134
                      then begin
1135
                           if (s4[0]>='a') and (s4[0]<='z') then byte(s4[0])-=32;
1136
                           if (s4[1]>='a') and (s4[1]<='z') then byte(s4[1])-=32;
1137
                           if (s4[2]>='a') and (s4[2]<='z') then byte(s4[2])-=32;
1138
                           if (s4[3]>='a') and (s4[3]<='z') then byte(s4[3])-=32;
1139
                           j:=1;
1140
                           end
1141
                      else j:=0;
1142
 
1143
                   i:=lastmacro;
1144
                   while i>=0 do
1145
                     begin
1146
                     amacro:=macros[i];
1147
                     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
1148
                        begin
1149
                        setmode(length(amacro^.name),bm_expand,bm_em);
1150
                        ampos:=lineInfo;
1151
                        if amacro^.paramsep[0]=''
1152
                           then begin
1153
                                if amacro^.rsize>0 then CMacroBuf.create(buf, amacro, true);
1154
                                end
1155
                           else mode:=bm_em_p0;
1156
                        i:=0;
1157
                        end;
1158
                     i-=1;
1159
                     end;
1160
                   end;
1161
            end;
1162
endparse:
1163
         rbp:=(rbp+1) and rbufmax;
1164
         end;
1165
 end;
1166
 
1167
if bmp_exit=0 then case mode of
1168
  bm_plain, bm_pm, bm_def_sob2, bm_def_sob3, bm_if_not
1169
     : if ifc>=0 then
1170
         begin
1171
         if ifc>0 then sx:='if''s without endif''s at '+lineInfoStr(ifli[0])
1172
                  else sx:='if without endif at '+lineInfoStr(ifli[0]);
1173
         for i:=1 to ifc do
1174
           sx+=', '+lineInfoStr(ifli[i]);
1175
         error(sx);
1176
         end;
1177
  bm_neplain, bm_ifeq_scb1_ne, bm_ifeq_scb2_ne, bm_ifneq_scb1_ne, bm_ifneq_scb2_ne
1178
     : error('Unexpected end of file, `'+endnoexpand+''' expected for '+bc_pm+'noexpand at '+lineInfoStr(ampos));
1179
  bm_em_p0..bm_em_pz
1180
     : error('Unexpected end of file, `'+amacro^.paramsep[mode-bm_em_p0]+''' expected for '+amacro^.name+' at '+lineInfoStr(ampos));
1181
  bm_def_scb1, bm_def_scb2, bm_def_scb3, bm_def_scbu, bm_def_scba,
1182
  bm_if_scb, bm_ifn_scb, bm_ifeq_scb1, bm_ifeq_scb2, bm_ifneq_scb1, bm_ifneq_scb2,
1183
  bm_inc_scb, bm_err, bm_err_scb, bm_warn
1184
     : begin
1185
       if bl>1 then begin
1186
                    if bl>2 then sx:=',  there are unclosed `'+bc_ob+'''s at '+lineInfoStr(bli[1])
1187
                            else sx:=',  there is a unclosed `'+bc_ob+''' at '+lineInfoStr(bli[1]);
1188
                    for i:=2 to bl-1 do
1189
                      sx+=', '+lineInfoStr(bli[i]);
1190
                    end
1191
               else sx:='  (maybe there are unclosed `'+bc_ob+'''s)';
1192
       error('Unexpected end of file, `'+bc_cb+''' expected for `'+bc_ob+''' at '+lineInfoStr(bli[0])+sx);
1193
       end;
1194
  bm_ifeq_sob
1195
     : error('Unexpected end of file, `'+bc_ob+''' expected for '+bc_pm+'ifeq at '+lineInfoStr(ampos));
1196
  bm_ifneq_sob
1197
     : error('Unexpected end of file, `'+bc_ob+''' expected for '+bc_pm+'ifneq at '+lineInfoStr(ampos));
1198
  else error('Unexpected end of file ('+int2str(mode)+')');
1199
  end;
1200
 
1201
for k:=0 to rbufmax do
1202
  begin
1203
{$ifdef ENABLE_DEBUGOUT }
1204
  if debugoutput then debugwrite;
1205
{$endif}
1206
  i:=bufm[rbp];
1207
  if (i<10) and (i>=0) and (outfile>0) then
1208
      begin
1209
      j:=ord(writebuf[0])+1;     { avoid the range checking }
1210
      writebuf[0]:=char(j);
1211
      writebuf[j]:=rbuf[rbp];
1212
      if rbuf[rbp]=#10 then
1213
         begin
1214
         if (li[rbp]<>prevli+4096) and (lineInfoPattern<>'') then lineInfoStr(fo,li[rbp]);
1215
         prevli:=li[rbp];
1216
         byte(writebuf[0])-=1;
1217
         writeln(fo,writebuf);
1218
         writebuf:='';
1219
         end;
1220
      if j>=255 then
1221
        begin
1222
        write(fo,writebuf);
1223
        writebuf:='';
1224
        end;
1225
      end
1226
    else if (i>=bm_outfile_a) and (i<=bm_outfile_z) then outfile:=i-bm_outfile_a;
1227
  rbp:=(rbp+1) and rbufmax;
1228
  end;
1229
write(fo,writebuf);
1230
if printdefs then printmacros;
1231
end;
1232
 
1233
{ ******** initsymb ************************************************** }
1234
procedure CMainBmp.initsymb(const s:bmpstring);
1235
var s4 : TS4;
1236
begin
1237
lastmacro+=1;
1238
if lastmacro>maxmacros then faterror('Macro memory exceeded');
1239
 
1240
getmem(macros[lastmacro],sizeof(TBabelMacro));
1241
fillchar( macros[lastmacro]^, sizeof(TBabelMacro), 0 );
1242
 
1243
s4.s:=copy('    '+s,length(s)+1,4);
1244
macros[lastmacro]^.mmatch_s[0]:=s4.i;
1245
upstr2(s4.s);
1246
macros[lastmacro]^.mmatch_s[1]:=s4.i;
1247
macros[lastmacro]^.mmatch_m:=$ffffffff shl ((4-min(length(s),4))*8);
1248
macros[lastmacro]^.quick:=length(s)<=4;
1249
macros[lastmacro]^.enabled:=true;
1250
 
1251
macros[lastmacro]^.rsize:=-1;
1252
macros[lastmacro]^.pn:=0;
1253
macros[lastmacro]^.name:=s;
1254
end;
1255
 
1256
{ ****** error_int ************************************************** }
1257
procedure CMainBmp.error_int(const t:ansistring);
1258
var i,j,k : longint;
1259
    tmp   : CTextBuf;
1260
    s     : shortstring;
1261
begin
1262
tmp:=buf;
1263
i:=0;
1264
while tmp<>nil do
1265
  begin
1266
  tmp:=CTextBuf(tmp.last);
1267
  i+=1;
1268
  end;
1269
s:='';
1270
for j:=1 to i do
1271
  begin
1272
  tmp:=buf;
1273
  for k:=1 to i-j do
1274
    tmp:=tmp.last;
1275
  k:=tmp.d;
1276
  if k>0 then k-=1;
1277
  writeln(stderr, s, lineInfoStr(tmp.li[k]), ':');
1278
  s+='  ';
1279
  end;
1280
writeln(stderr,s,t);
1281
end;
1282
 
1283
{ ****** hint ******************************************************* }
1284
procedure CMainBmp.hint(const s:ansistring);
1285
begin
1286
if enable_hints then writeln(stderr,'Hint: '+lineInfoStr(lineInfo)+': '+s);
1287
end;
1288
 
1289
{ ****** warning **************************************************** }
1290
procedure CMainBmp.warning(const s:ansistring);
1291
begin
1292
error_int('Warning: '+s);
1293
end;
1294
 
1295
{ ****** error ****************************************************** }
1296
procedure CMainBmp.error(const s:ansistring);
1297
begin
1298
error_int('Error: '+s);
1299
bmp_exit:=bmp_exit_error;
1300
end;
1301
 
1302
{ ****** faterror *************************************************** }
1303
procedure CMainBmp.faterror(const s:ansistring);
1304
begin
1305
error_int('Fatal error: '+s);
1306
halt(bmp_exit_faterror);
1307
end;
1308
 
1309
{ ****** copylaststr ************************************************ }
1310
function CMainBmp.copylaststr(l,mode:longint):rbufstr;
1311
var i,k : longint;
1312
begin
1313
l:=l and rbufmax;
1314
i:=0; k:=rbp;
1315
while (i<l) and ((bufm[k]=mode) or (mode<0)) do
1316
  begin
1317
  i+=1;
1318
  k:=(k-1) and rbufmax;
1319
  end;
1320
result.rbuf:=@rbuf;
1321
result.pt:=k+1;
1322
result.length:=i;
1323
end;
1324
 
1325
function CMainBmp.copylaststr(l:longint):rbufstr;
1326
begin
1327
result:=copylaststr(l,-1);
1328
end;
1329
 
1330
function CMainBmp.copylaststr_br(l,mode:longint):bmpstring;
1331
var i,j,k : longint;
1332
begin
1333
{$ifdef USE_SHORTSTRINGS}
1334
if l>255 then l:=255;
1335
{$endif}
1336
i:=0; j:=0; k:=rbp;
1337
setlength(result,l);
1338
while (i<l) and (j<=rbufmax) do
1339
  begin
1340
  if (bufm[k]=mode) or (mode<0) then
1341
    begin
1342
    result[l-i]:=rbuf[k];
1343
    i+=1;
1344
    end;
1345
  k:=(k-1) and rbufmax;
1346
  j+=1;
1347
  end;
1348
if i<l then result:=copy(result, length(result)-i+1, i);
1349
end;
1350
 
1351
{ ****** matchstr **************************************************** }
1352
function CMainBmp.matchstr(const s:bmpstring; mode:longint):boolean;
1353
begin
1354
matchstr:=cmp_rbuf(copylaststr(length(s),mode), s);
1355
end;
1356
 
1357
function CMainBmp.matchstr(const s:bmpstring):boolean;
1358
begin
1359
matchstr:=cmp_rbuf(copylaststr(length(s),-1),s);
1360
end;
1361
 
1362
function CMainBmp.matchstr(ic:boolean; const s:bmpstring; mode:longint):boolean;
1363
begin
1364
if ic then matchstr:=cmpcase_rbuf(copylaststr(length(s),mode),s)
1365
      else matchstr:=cmp_rbuf(copylaststr(length(s),mode),s);
1366
end;
1367
 
1368
function CMainBmp.matchstr(ic:boolean;const s:bmpstring):boolean;
1369
begin
1370
if ic then matchstr:=cmpcase_rbuf(copylaststr(length(s),-1),s)
1371
      else matchstr:=cmp_rbuf(copylaststr(length(s),-1),s);
1372
end;
1373
 
1374
function CMainBmp.matchstr_br(const s:bmpstring; mode:longint):boolean;
1375
begin
1376
matchstr_br:=copylaststr_br(length(s),mode)=s;
1377
end;
1378
 
1379
function CMainBmp.matchstr_br(ic:boolean; const s:bmpstring; mode:longint):boolean;
1380
begin
1381
if ic then matchstr_br:=upstr(copylaststr_br(length(s),mode))=upstr(s)
1382
      else matchstr_br:=copylaststr_br(length(s),mode)=s
1383
end;
1384
 
1385
{ ****** lastmodestr ************************************************* }
1386
procedure CMainBmp.lastmodestr(mode:longint; var fst,l:longint);
1387
var i,j,k  : longint;
1388
begin
1389
i:=rbp; j:=0; k:=0;
1390
while (bufm[i]<>mode) and (j<=rbufmax) do
1391
  begin
1392
  i:=(i-1) and rbufmax;
1393
  j+=1;
1394
  end;
1395
while (bufm[i]=mode) and (j<=rbufmax) do
1396
  begin
1397
  i:=(i-1) and rbufmax;
1398
  j+=1;
1399
  k+=1;
1400
  end;
1401
i:=(i+1) and rbufmax;
1402
fst:=i;
1403
l:=k;
1404
end;
1405
 
1406
procedure CMainBmp.lastmodestr(mode:longint; var size:longint; var ptc:pchar; var ptli:pdword);
1407
var i,j,k  : longint;
1408
begin
1409
lastmodestr(mode,i,j);
1410
if j>0 then begin
1411
            size:=j;
1412
            getmem(ptc,j);
1413
            getmem(ptli,j*4);
1414
            for k:=0 to j-1 do
1415
              begin
1416
              ptc[k]:=rbuf[i];
1417
              ptli[k]:=li[i];
1418
              i:=(i+1) and rbufmax;
1419
              end;
1420
            end
1421
       else begin
1422
            size:=0;
1423
            ptc:=nil;
1424
            ptli:=nil;
1425
            end;
1426
end;
1427
 
1428
function CMainBmp.lastmodestr(mode:longint):bmpstring;
1429
var i,j,k  : longint;
1430
begin
1431
lastmodestr(mode,i,j);
1432
{$ifdef USE_SHORTSTRINGS}
1433
if j>255 then j:=255;
1434
{$endif}
1435
setlength(lastmodestr,j);
1436
for k:=1 to j do
1437
  begin
1438
  lastmodestr[k]:=rbuf[i];
1439
  i:=(i+1) and rbufmax;
1440
  end;
1441
end;
1442
 
1443
procedure CMainBmp.lastmodestr1(mode:longint; var size:longint; var ptc:pchar; var ptli:pdword);
1444
var i,j,k  : longint;
1445
begin
1446
lastmodestr(mode,i,j);
1447
j-=1;
1448
if j>0 then begin
1449
            size:=j;
1450
            getmem(ptc,j);
1451
            getmem(ptli,j*4);
1452
            for k:=0 to j-1 do
1453
              begin
1454
              ptc[k]:=rbuf[i];
1455
              ptli[k]:=li[i];
1456
              i:=(i+1) and rbufmax;
1457
              end;
1458
            end
1459
       else begin
1460
            size:=0;
1461
            ptc:=nil;
1462
            ptli:=nil;
1463
            end;
1464
end;
1465
 
1466
function CMainBmp.lastmodestr1(mode:longint):bmpstring;
1467
var i,j,k  : longint;
1468
begin
1469
lastmodestr(mode,i,j);
1470
j-=1;
1471
{$ifdef USE_SHORTSTRINGS}
1472
if j>255 then j:=255;
1473
{$endif}
1474
setlength(lastmodestr1,j);
1475
for k:=1 to j do
1476
  begin
1477
  lastmodestr1[k]:=rbuf[i];
1478
  i:=(i+1) and rbufmax;
1479
  end;
1480
end;
1481
 
1482
 
1483
{ ****** setmode ***************************************************** }
1484
procedure CMainBmp.setmode(num,om,nm:longint);
1485
var i,j,k  : longint;
1486
begin
1487
k:=rbp;
1488
i:=0; j:=0;
1489
while (i<num) and (j<=rbufmax) do
1490
  begin
1491
  if (bufm[k]=om) or (om<0) then
1492
    begin
1493
    i+=1;
1494
    bufm[k]:=nm;
1495
    end;
1496
  j+=1;
1497
  k:=(k-1) and rbufmax;
1498
  end;
1499
end;
1500
 
1501
{ ******** printmacros *********************************************** }
1502
procedure CMainBmp.printmacros(const m:array of pbabelmacro; mm:longint);
1503
var i,j : longint;
1504
begin
1505
for j:=0 to mm do
1506
  begin
1507
  writeln(stderr,'   ----- definition ',j+1,' -----');
1508
  writeln(stderr,m[j]^.name);
1509
  if m[j]^.paramsep[0]<>'' then write(stderr,m[j]^.paramsep[0]);
1510
  for i:=1 to m[j]^.pn do
1511
    write(stderr,bc_pa,i,m[j]^.paramsep[i]);
1512
  if (m[j]^.pn>0) or (m[j]^.paramsep[0]<>'') then writeln(stderr);
1513
  for i:=0 to m[j]^.rsize-1 do
1514
    write(stderr,m[j]^.r[i]);
1515
  if m[j]^.rsize>0 then writeln(stderr);
1516
  if m[j]^.rsize=0 then writeln(stderr,'<empty>');
1517
  writeln(stderr);
1518
  writeln(stderr);
1519
  end;
1520
end;
1521
 
1522
procedure CMainBmp.printmacros;
1523
begin
1524
printmacros(macros, lastmacro);
1525
end;
1526
 
1527
{$ifdef ENABLE_DEBUGOUT }
1528
{ ******** debugwrite ************************************************ }
1529
procedure CMainBmp.debugwrite;
1530
var i  : longint;
1531
    lf : boolean;
1532
begin
1533
if rbuf[rbp]=#10
1534
  then begin
1535
       writeln;
1536
       lf:=true;
1537
       end
1538
  else lf:=false;
1539
if (bufm[rbp]<>bm_invalid) and (rbuf[rbp]<>#13) and (rbuf[rbp]<>#10) then write(rbuf[rbp]);
1540
i:=(rbp+1) and rbufmax;
1541
if bufm[rbp]<>bufm[i]
1542
  then begin
1543
       if not lf then writeln;
1544
       write(bufm[i]);
1545
       case bufm[i] of
1546
         0..9       : write('     ');
1547
         10..99     : write('    ');
1548
         200..999   : write('   ');
1549
         1000..9999 : write('  ');
1550
         else         write(' ');
1551
         end;
1552
       end
1553
  else if lf then write('      ');
1554
end;
1555
{$endif}
1556
 
1557
{ ********************************************************************* }
1558
{ ****** main ********************************************************* }
1559
{ ********************************************************************* }
1560
 
1561
{ ****** paramerr ***************************************************** }
1562
procedure paramerr(msg:ansistring);
1563
begin
1564
writeln(stderr,'Usage: '+paramstr(0)+' [<Options>] [<filename1> [<filename1> ...]]');
1565
writeln(stderr,'Options: ');
1566
writeln(stderr,'        -o <fileneme>    Output file');
1567
writeln(stderr,'        -p               Pascal mode (default), equal to -mm "//" -mo "[" -mc "]" -mp "#"');
1568
writeln(stderr,'        -c               C mode, equal to -mm "#" -mo "[" -mc "]" -mp "$" -l "\"#line %2 "%1\""');
1569
writeln(stderr,'        -i               Ignore case');
1570
writeln(stderr,'        -l               Line info (default for C mode: "#line %2 \"%1\"")');
1571
writeln(stderr,'        -I  <directory>  Include path');
1572
writeln(stderr,'        -D  <symbol>     Define symbol <symbol>');
1573
writeln(stderr,'        -mm <string>     Meta macro start string');
1574
writeln(stderr,'        -mo <char>       Open bracket');
1575
writeln(stderr,'        -mc <char>       Close bracket');
1576
writeln(stderr,'        -mp <char>       Parameter sign');
1577
//writeln(stderr,'      -nh              Disable hints');
1578
{$ifdef ENABLE_DEBUGOUT}
1579
writeln(stderr,'        -do              Enable debug output');
1580
{$endif}
1581
writeln(stderr,'        -dd              Print definitions');
1582
writeln(stderr,'        -h               Help');
1583
if msg<>''
1584
  then begin
1585
       writeln(stderr,msg);
1586
       halt(bmp_exit_paramerror);
1587
       end
1588
  else halt(0);
1589
end;
1590
 
1591
{ ****** main ********************************************************* }
1592
const maxInfilec = 1024;
1593
 
1594
var main          : CMainBmp;
1595
    infile        : array[0..maxInfilec-1] of ansistring;
1596
    i,j,infilec   : longint;
1597
    s,t           : ansistring;
1598
    fo            : text;
1599
 
1600
    fofn             : ansistring;
1601
    bc_pm_d,bc_ob_d  : boolean;
1602
    bc_cb_d,bc_pa_d  : boolean;
1603
    pasmode,lidef    : boolean;
1604
 
1605
begin
1606
spath[0]:='';
1607
spathc:=1;
1608
 
1609
main:=CMainBmp.create;
1610
 
1611
fofn:='';
1612
bc_pm_d:=false;
1613
bc_ob_d:=false;
1614
bc_cb_d:=false;
1615
bc_pa_d:=false;
1616
pasmode:=true;
1617
lidef:=false;
1618
 
1619
infilec:=0;
1620
i:=1;
1621
while i<=paramcount do
1622
  begin
1623
  s:=paramstr(i);
1624
  if (length(s)>1) and (s[1]='-')
1625
    then begin
1626
         if s='-o' then
1627
             begin
1628
             if i>=paramcount then paramerr('File name expected after -o');
1629
             i+=1;
1630
             fofn:=paramstr(i);
1631
             end
1632
           else if s='-p' then pasmode:=true
1633
           else if s='-c' then pasmode:=false
1634
           else if s='-i' then bp_icase:=true
1635
           else if s='-l' then
1636
             begin
1637
             if i>=paramcount then paramerr('String expected after -l');
1638
             i+=1;
1639
             lineInfoPattern:=paramstr(i);
1640
{$ifdef WINDOWS}
1641
             for j:=1 to length(lineInfoPattern) do
1642
               if lineInfoPattern[j]='\' then lineInfoPattern[j]:='"';
1643
{$endif}
1644
             lidef:=true;
1645
             end
1646
           else if s='-I' then
1647
             begin
1648
             if i>=paramcount then paramerr('Path expected after -I');
1649
             i+=1;
1650
             t:=paramstr(i);
1651
{$ifdef WINDOWS}
1652
             for j:=1 to length(t) do
1653
               if t[j]='/' then t[j]:='\';
1654
{$endif}
1655
             if t<>'' then
1656
               begin
1657
               if t[length(t)]<>dirsep then t+=dirsep;
1658
               if spathc>=maxspathc
1659
                 then bmp_error('Maximum amount of search paths reached')
1660
                 else begin
1661
                      spath[spathc]:=t;
1662
                      spathc+=1;
1663
                      end;
1664
               end;
1665
             end
1666
           else if s='-D' then
1667
             begin
1668
             if i>=paramcount then paramerr('Symbol expected after -D');
1669
             i+=1;
1670
             main.initsymb(paramstr(i));
1671
             end
1672
           else if s='-mm' then
1673
             begin
1674
             if i>=paramcount then paramerr('String expected after -mm');
1675
             i+=1;
1676
             bc_pm_d:=true;
1677
             bc_pm:=paramstr(i);
1678
             end
1679
           else if s='-mo' then
1680
             begin
1681
             if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mo');
1682
             i+=1;
1683
             bc_ob_d:=true;
1684
             bc_ob:=paramstr(i)[1];
1685
             end
1686
           else if s='-mc' then
1687
             begin
1688
             if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mc');
1689
             i+=1;
1690
             bc_cb_d:=true;
1691
             bc_cb:=paramstr(i)[1];
1692
             end
1693
           else if s='-mp' then
1694
             begin
1695
             if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mp');
1696
             i+=1;
1697
             bc_pa_d:=true;
1698
             bc_pa:=paramstr(i)[1];
1699
             end
1700
           else if s='-eh' then enable_hints:=false
1701
{$ifdef ENABLE_DEBUGOUT}
1702
           else if s='-do' then debugoutput:=true
1703
{$endif}
1704
           else if s='-dd' then printdefs:=true
1705
           else if s='-h' then paramerr('')
1706
           else paramerr('Invalid option: '+s);
1707
         end
1708
    else begin
1709
         if infilec>=maxinfilec
1710
            then bmp_error('Maximum amount of input files reached')
1711
            else begin
1712
{$ifdef WINDOWS}
1713
                 for j:=1 to length(s) do
1714
                   if s[j]='/' then s[j]:='\';
1715
{$endif}
1716
                 if s='-'
1717
                   then infile[infilec]:=''
1718
                   else infile[infilec]:=s;
1719
                 infilec+=1;
1720
                 end;
1721
         end;
1722
  i+=1;
1723
  end;
1724
 
1725
if pasmode
1726
  then begin
1727
       if not bc_pm_d then bc_pm:='//';
1728
       if not bc_ob_d then bc_ob:='[';
1729
       if not bc_cb_d then bc_cb:=']';
1730
       if not bc_pa_d then bc_pa:='#';
1731
       end
1732
  else begin
1733
       if not bc_pm_d then bc_pm:='#';
1734
       if not bc_ob_d then bc_ob:='[';
1735
       if not bc_cb_d then bc_cb:=']';
1736
       if not bc_pa_d then bc_pa:='$';
1737
       if not lidef then lineInfoPattern:='#line %2 "%1"';
1738
       end;
1739
 
1740
if infilec=0 then
1741
  begin
1742
  infile[0]:='';
1743
  infilec:=1;
1744
  end;
1745
 
1746
if fofn<>''
1747
  then begin
1748
       try
1749
         assign(fo,fofn);
1750
         rewrite(fo);
1751
         for i:=0 to infilec-1 do
1752
           main.run(infile[i],fo);
1753
         close(fo);
1754
       except
1755
         bmp_faterror('Error writing to file '+fofn);
1756
         end;
1757
       end
1758
  else for i:=0 to infilec-1 do
1759
         main.run(infile[i],output);
1760
 
1761
main.destroy;
1762
halt(bmp_exit);
1763
end.

powered by: WebSVN 2.1.0

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