File: slice_pass1.pl

package info (click to toggle)
slice 1.3.2-3
  • links: PTS
  • area: main
  • in suites: hamm, slink
  • size: 724 kB
  • ctags: 472
  • sloc: perl: 3,335; ansic: 3,054; sh: 437; makefile: 248; yacc: 105
file content (136 lines) | stat: -rw-r--r-- 4,506 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
##
##  slice_pass1.pl -- Pass 1
##  Copyright (c) 1997,1998 Ralf S. Engelschall. 
##

package main;

##
##
##  Pass 1: Determine delimiters
##
##

sub pass1 {
    my ($CFG) = @_;

    my ($found1, $prolog1, $name1, $epilog1);
    my ($found2, $prolog2, $name2, $epilog2);
    my (@CURRENT_SLICE_NAMES, %CURRENT_LEVEL_BRAIN, $CURRENT_LEVEL_SET);
    my ($INPUT, $pos, $namex, $L, $openseen);

    &verbose("\nPass 1: Determine delimiters\n\n");

    @CURRENT_SLICE_NAMES = ();                  
    %CURRENT_LEVEL_BRAIN = ();                  
    $CURRENT_LEVEL_SET   = new Bit::Vector(512);

    #   allocate the next free level starting from 1
    sub alloclevel {
        my ($i);

        for ($i = 0; $i <= $CURRENT_LEVEL_SET->Max(); $i++) {
            last if (not $CURRENT_LEVEL_SET->bit_test($i));
        }
        $CURRENT_LEVEL_SET->Bit_On($i);
        return $i + 1;
    }

    #   clear the given level  
    sub clearlevel {
        my ($i) = @_;

        $CURRENT_LEVEL_SET->Bit_Off($i - 1);
    }

    $INPUT = $CFG->{INPUT}->{SRC};
    $pos   = 0;
    $open  = 0;
    while (1) {
        # search for begin delimiter
        $found1 = (($prolog1, $name1, $epilog1) = 
                   ($INPUT =~ m|^(.*?)\[([A-Z][_A-Z0-9]*):(.*)$|s));
        # search for end delimiter
        $found2 = (($prolog2, $name2, $epilog2) = 
                   ($INPUT =~ m|^(.*?):([A-Z][_A-Z0-9]*)?\](.*)$|s));

        if (($found1 and not $found2) or ($found1 and $found2 and (length($prolog1) < length($prolog2)))) {
            #
            #   begin delimiter found
            #
            $pos += length($prolog1);           # adjust position
            $CFG->{INPUT}->{PLAIN} .= $prolog1; # move prolog
            $INPUT = $epilog1;                  # and go on with epilog

            $L = &alloclevel();                 # allocate next free level

            push(@CURRENT_SLICE_NAMES, $name1); # remember name  for end delimiter
            $CURRENT_LEVEL_BRAIN{"$name1"} = $L;# remember level for end delimiter
            if ($CFG->{SLICE}->{MINLEVELS}->{"$name1"} eq '' or 
                $CFG->{SLICE}->{MINLEVELS}->{"$name1"} > $L) {
                $CFG->{SLICE}->{MINLEVELS}->{"$name1"} = $L;
            }

            #  now begin entry with LEVEL:START
            $CFG->{SLICE}->{SET}->{ASC}->{"$name1"} .= 
                 ($CFG->{SLICE}->{SET}->{ASC}->{"$name1"} ? ',' : '') . "$L:$pos"; 

            #  adjust notice about highest level
            $CFG->{SLICE}->{MAXLEVEL} = ($CFG->{SLICE}->{MAXLEVEL} < $L ? 
                                         $L : $CFG->{SLICE}->{MAXLEVEL});

            &verbose("    slice `$name1': begin at $pos, level $L\n");

            $open++;
        }
        elsif (($open > 0) and ((not $found1 and $found2) or ($found1 and $found2 and (length($prolog2) < length($prolog1))))) {
            #
            #   end delimiter found
            #
            $pos += length($prolog2)-1;         # adjust position
            $CFG->{INPUT}->{PLAIN} .= $prolog2; # move prolog
            $INPUT = $epilog2;                  # and go on with epilog

            $namex = pop(@CURRENT_SLICE_NAMES);      # take remembered name
            $name2 = $namex if ($name2 eq '');       # fill name because of shortcut syntax
            $L     = $CURRENT_LEVEL_BRAIN{"$name2"}; # take remembered level

            &clearlevel($L);                         # de-allocate level

            # now end entry with :END
            $CFG->{SLICE}->{SET}->{ASC}->{"$name2"} .= ":$pos";

            &verbose("    slice `$name2': end at $pos\n");

            $pos++;
            $open--;
        }
        else { # not $found1 and not $found2 _OR_ bad input stuff
            #
            #   nothing more found
            #
            $CFG->{INPUT}->{PLAIN} .= $INPUT; # add all remaining input
            last;                             # stop loop
        }
    }

    #   check: were all opened slices really closed?
    if ($CURRENT_LEVEL_SET->Norm > 0) {
        my $i;
        my $err = '';
        for ($i = 0; $i <= $CURRENT_LEVEL_SET->Max(); $i++) {
            if ($CURRENT_LEVEL_SET->bit_test($i)) {
                my $name;
                foreach $name (keys(%CURRENT_LEVEL_BRAIN)) {
                    if ($CURRENT_LEVEL_BRAIN{$name} == ($i+1)) {
                        $err .= " `$name'";
                    }
                }
            }
        }
        &error("Some slices were not closed:$err\n");
    }
}

1;
##EOF##