Changeset 19

User picture

Author: Leszek Godlewski

(2010/01/19 04:32) Over 2 years ago

islip:
* compiler, interpreter, variable: added ability to print to stderr (INVISIBLE keyword)
* bytecode, compiler, interpreter: added incrementation operation
* variable: fixed a bug that would cause all float to string casts to result with a "0"
* compiler: fixed a bug with nested loop breaks not recognized as proper language keywords
* compiler: removed identifiers from constants
* compiler: fixed a bug that would cause erratic conditional jumps in some else-if statements
* compiler: fixed a crash caused by an unitialized ipcont object
* compiler: fixed constant loading logic
* compiler: added the KTHX instruction to terminate program prematurely (own extension, not in spec)

Affected files

Updated islip/compiler.pas Download diff

1819
74
            procedure chop_tail;
74
            procedure chop_tail;
75
    end;
75
    end;
76
76



77
    // list element for ipcont



78
    pislip_cmp_ip   = ^islip_cmp_ip;



79
    islip_cmp_ip    = record



80
        i           : pislip_cmp_inst;



81
        next        : pislip_cmp_ip;



82
    end;



83



84
    pislip_cmp_ipcont   = ^islip_cmp_ipcont;



85
    // helper class to manage a linked list of instruction pointers to simplify



86
    // jumping out of success blocks to after the non-linear code block



87
    islip_cmp_ipcont = class



88
        public



89
            constructor create;



90



91
            // fills the arguments of all elements with ofs



92
            procedure fill(ofs : int);



93



94
            // adds a pointer to an instruction to list



95
            procedure add(i : pislip_cmp_inst);



96
        private



97
            m_head  : pislip_cmp_ip;



98
            m_tail  : pislip_cmp_ip;



99
    end;



100



77
    islip_compiler          = class
101
    islip_compiler          = class



78
        public
102
        public



79
            constructor create(var input : cfile);
103
            constructor create(var input : cfile);


...
...
89
            m_done      : boolean;
113
            m_done      : boolean;



90
114



91
            // evaluates the upcoming statement
115
            // evaluates the upcoming statement



92
            function eval_statement : boolean;
116
            function eval_statement(gtfo : pislip_cmp_ipcont) : boolean;



93
            // evaluates the upcoming expression
117
            // evaluates the upcoming expression



94
            function eval_expr : boolean;
118
            function eval_expr : boolean;



95
            // parses a number or boolean literal
119
            // parses a number or boolean literal


...
...
120
        FS_LOOP         // we're reading a loop block
144
        FS_LOOP         // we're reading a loop block



121
    );
145
    );



122
146



123
    // list element for ipcont



124
    pislip_cmp_ip   = ^islip_cmp_ip;



125
    islip_cmp_ip    = record



126
        i           : pislip_cmp_inst;



127
        next        : pislip_cmp_ip;



128
    end;



129



130
    // helper class to manage a linked list of instruction pointers to simplify



131
    // jumping out of success blocks to after the non-linear code block



132
    islip_cmp_ipcont = class



133
        public



134
            constructor create;



135
            



136
            // fills the arguments of all elements with ofs



137
            procedure fill(ofs : int);



138



139
            // adds a pointer to an instruction to list



140
            procedure add(i : pislip_cmp_inst);



141
        private



142
            m_head  : pislip_cmp_ip;



143
            m_tail  : pislip_cmp_ip;



144
    end;



145



146
// ====================================================
147
// ====================================================



147
// compiler implementation
148
// compiler implementation



148
// ====================================================
149
// ====================================================


...
...
172
begin
173
begin



173
    literal := false;
174
    literal := false;



174
    // we can detect number literals by the first character
175
    // we can detect number literals by the first character



175
    if not (token[1] in ['0'..'9']) or (token[1] = '-') then begin
176
    if not ((token[1] in ['0'..'9']) or (token[1] = '-')) then begin



176
        // it can only be either a boolean literal or a syntax error now
177
        // it can only be either a boolean literal or a syntax error now



177
        if token = 'WIN' then begin
178
        if token = 'WIN' then begin



178
{$IFDEF DEBUG}
179
{$IFDEF DEBUG}


...
...
180
{$ENDIF}
181
{$ENDIF}



181
            new(pv);
182
            new(pv);



182
            pv^ := islip_var.create(true);
183
            pv^ := islip_var.create(true);



183
            m_code.append(OP_PUSH, m_vars.append(pv, token));
184
            m_code.append(OP_PUSH, m_vars.append(pv, ''));



184
            literal := true;
185
            literal := true;



185
        end else if token = 'FAIL' then begin
186
        end else if token = 'FAIL' then begin



186
{$IFDEF DEBUG}
187
{$IFDEF DEBUG}


...
...
188
{$ENDIF}
189
{$ENDIF}



189
            new(pv);
190
            new(pv);



190
            pv^ := islip_var.create(false);
191
            pv^ := islip_var.create(false);



191
            m_code.append(OP_PUSH, m_vars.append(pv, token));
192
            m_code.append(OP_PUSH, m_vars.append(pv, ''));



192
            literal := true;
193
            literal := true;



193
        end;
194
        end;



194
        exit;
195
        exit;


...
...
237
        pv^ := islip_var.create(i);
238
        pv^ := islip_var.create(i);



238
    end;    
239
    end;    



239
    // generate the instructions
240
    // generate the instructions



240
    m_code.append(OP_PUSH, m_vars.append(pv, token));
241
    m_code.append(OP_PUSH, m_vars.append(pv, ''));



241
    literal := true;
242
    literal := true;



242
end;
243
end;



243
244


...
...
482
        new(v);
483
        new(v);



483
        v^ := islip_var.create(token);
484
        v^ := islip_var.create(token);



484
        // generate the instructions
485
        // generate the instructions



485
        m_code.append(OP_PUSH, m_vars.append(v, token));
486
        m_code.append(OP_PUSH, m_vars.append(v, ''));



486
    // either a variable identifier, or a number or boolean literal
487
    // either a variable identifier, or a number or boolean literal



487
    end else if not literal(token) then begin
488
    end else if not literal(token) then begin



488
        // check for illegal characters
489
        // check for illegal characters


...
...
513
// recursive statement evaluator
514
// recursive statement evaluator



514
// ====================================================
515
// ====================================================



515
516



516
function islip_compiler.eval_statement : boolean;
517
function islip_compiler.eval_statement(gtfo : pislip_cmp_ipcont) : boolean;



517
var
518
var



518
    token, id   : string;
519
    token, id   : string;



519
    toktype     : islip_parser_token_type;
520
    toktype     : islip_parser_token_type;


...
...
581
        end;
582
        end;



582
        if token <> 'RLY?' then begin
583
        if token <> 'RLY?' then begin



583
            m_parser.get_pos(sr, sc);
584
            m_parser.get_pos(sr, sc);



584
            writeln ('ERROR: "RLY?" expected, but got "', token, '" at ',
585
            writeln('ERROR: "RLY?" expected, but got "', token, '" at ',



585
                 'line ', sr, ', column ', sc);
586
                 'line ', sr, ', column ', sc);



586
            exit;
587
            exit;



587
        end;
588
        end;


...
...
595
                continue
596
                continue



596
            else if token <> 'YA' then begin
597
            else if token <> 'YA' then begin



597
                m_parser.get_pos(sr, sc);
598
                m_parser.get_pos(sr, sc);



598
                writeln ('ERROR: "YA" expected, but got "', token, '" at ',
599
                writeln('ERROR: "YA" expected, but got "', token, '" at ',



599
                    'line ', sr, ', column ', sc);
600
                    'line ', sr, ', column ', sc);



600
                exit;
601
                exit;



601
            end else
602
            end else


...
...
608
        end;
609
        end;



609
        if token <> 'RLY' then begin
610
        if token <> 'RLY' then begin



610
            m_parser.get_pos(sr, sc);
611
            m_parser.get_pos(sr, sc);



611
            writeln ('ERROR: "RLY" expected, but got "', token, '" at ',
612
            writeln('ERROR: "RLY" expected, but got "', token, '" at ',



612
                'line ', sr, ', column ', sc);
613
                'line ', sr, ', column ', sc);



613
            exit;
614
            exit;



614
        end;
615
        end;


...
...
623
        flowstate := FS_IF;
624
        flowstate := FS_IF;



624
        while m_parser.get_token(token, toktype) do begin
625
        while m_parser.get_token(token, toktype) do begin



625
            // check for the end of the block
626
            // check for the end of the block



626
            if token = 'OIC' then
627
            if token = 'OIC' then begin



628
                if flowstate <> FS_ELSE then                    



629
                    i^.arg := m_code.m_count + 1;



627
                flowstate := FS_LINEAR;
630
                flowstate := FS_LINEAR;



631
            end;



628
            // this is intentional - there SHOULD NOT be an "else" here!
632
            // this is intentional - there SHOULD NOT be an "else" here!



629
            if flowstate = FS_LINEAR then begin
633
            if flowstate = FS_LINEAR then begin



630
                // optimize code and update jump offset
634
                // optimize code and update jump offset



631
                optimize(i);
635
                optimize(i);



632
                i^.arg := m_code.m_count + 2;



633
                break;  // end of conditional block altogether
636
                break;  // end of conditional block altogether



634
            end else if flowstate in [FS_IF, FS_ELSEIF] then begin
637
            end else if flowstate in [FS_IF, FS_ELSEIF] then begin



635
                // elseif
638
                // elseif


...
...
681
            end;
684
            end;



682
            // otherwise just parse the statement
685
            // otherwise just parse the statement



683
            m_parser.unget_token;
686
            m_parser.unget_token;



684
            if not eval_statement() then
687
            if not eval_statement(gtfo) then



685
                exit;   // the recursive instance will have raised an error
688
                exit;   // the recursive instance will have raised an error



686
        end;
689
        end;



687
        if flowstate <> FS_LINEAR then begin
690
        if flowstate <> FS_LINEAR then begin


...
...
735
                    if toktype = TT_STRING then begin
738
                    if toktype = TT_STRING then begin



736
                        new(pv);
739
                        new(pv);



737
                        pv^ := islip_var.create(token);
740
                        pv^ := islip_var.create(token);



738
                        m_code.append(OP_PUSH, m_vars.append(pv, token));
741
                        m_code.append(OP_PUSH, m_vars.append(pv, ''));



739
                    end else if not literal(token) then begin
742
                    end else if not literal(token) then begin



740
                        m_parser.get_pos(sr, sc);
743
                        m_parser.get_pos(sr, sc);



741
                        writeln ('ERROR: Literal expected, but got "', token,
744
                        writeln ('ERROR: Literal expected, but got "', token,


...
...
770
            end;
773
            end;



771
            // just parse the statement
774
            // just parse the statement



772
            m_parser.unget_token;
775
            m_parser.unget_token;



773
            if not eval_statement() then
776
            if not eval_statement(nil) then



774
                exit;   // the recursive instance will have raised an error
777
                exit;   // the recursive instance will have raised an error



775
        end;
778
        end;



776
        if flowstate <> FS_LINEAR then begin
779
        if flowstate <> FS_LINEAR then begin


...
...
819
            writeln('ERROR: Unexpected end of file');
822
            writeln('ERROR: Unexpected end of file');



820
            exit;
823
            exit;



821
        end;
824
        end;



825
        ipcont := islip_cmp_ipcont.create;;



822
        if (token = 'UPPIN') or (token = 'NERFIN') then begin
826
        if (token = 'UPPIN') or (token = 'NERFIN') then begin



823
            // reuse the variable to mark the operation
827
            // reuse the variable to mark the operation



824
            if token[1] = 'U' then
828
            if token[1] = 'U' then


...
...
887
            sc := 0;
891
            sc := 0;



888
            m_parser.unget_token;
892
            m_parser.unget_token;



889
        end;
893
        end;



890
        while m_parser.get_token(token, toktype) do begin
894
        while true do begin



891
            // look for the loop closing statement
895
            // look for the loop closing statement



892
            // fetch next token
896
            // fetch next token



893
            if not m_parser.get_token(token, toktype) then begin
897
            if not m_parser.get_token(token, toktype) then begin


...
...
940
                        m_parser.unget_token;
944
                        m_parser.unget_token;



941
                    end;
945
                    end;



942
                end;
946
                end;



943
                    m_parser.unget_token;
947
                m_parser.unget_token;



944
            end else if token = 'GTFO' then begin



945
                // add a jump out of the loop



946
                ipcont.add(m_code.append(OP_JMP, ARG_NULL));



947
                continue;



948
            end;
948
            end;



949
            // just parse the statement
949
            // just parse the statement



950
            m_parser.unget_token;
950
            m_parser.unget_token;



951
            if not eval_statement() then
951
            if not eval_statement(@ipcont) then



952
                exit;   // the recursive instance will have raised an error
952
                exit;   // the recursive instance will have raised an error



953
        end;
953
        end;



954
        if flowstate <> FS_LINEAR then begin
954
        if flowstate <> FS_LINEAR then begin


...
...
992
                '" at line ', sr, ', column ', sc);
992
                '" at line ', sr, ', column ', sc);



993
            exit;
993
            exit;



994
        end;
994
        end;



995
        // save off the instruction count
995
        // fetch next token



996
        sc := m_code.m_count;
996
        if not m_parser.get_token(token, toktype) then begin



997
        // evaluate the expression
997
            writeln('ERROR: Unexpected end of file');



998
        if not eval_expr() then begin



999
            m_parser.get_pos(sr, sc);



1000
            writeln('ERROR: Unable to evaluate expression at ',



1001
                'line ', sr, ', column ', sc);



1002
            exit;
998
            exit;



1003
        end;
999
        end;



1004
        // if the variable already exists, it's been initialized
1000
        // check if this is a literal



1005
        // somewhere else already, so just pop the top of the stack
1001
        if toktype = TT_STRING then begin



1006
        // into it
1002
            new(pv);



1007
        if v <> nil then
1003
            pv^ := islip_var.create(token);



1008
            // FIXME: put index into islip_cmp_var
1004
            m_vars.append(pv, id);



1009
            m_code.append(OP_POP, m_vars.get_var_index(v^.id))
1005
            // if the variable already exists, it's been initialized



1010
        else begin
1006
            // somewhere else already, so just pop the nev value into it;



1011
            // if the expression generates only 1 instruction, it
1007
            // otherwise it's a constant and doesn't even need to be put onto



1012
            // must be a constant, so let's reduce instructions
1008
            // the stack



1013
            if m_code.m_count - sc = 1 then begin
1009
            if v <> nil then begin



1010
                // the last one in the list will be the one we need



1011
                m_code.append(OP_PUSH, m_vars.m_index);



1012
                // FIXME: put index into islip_cmp_var



1013
                m_code.append(OP_POP, m_vars.get_var_index(v^.id));



1014
            end;



1015
        end else if literal(token) then begin



1016
            // if the variable already exists, it's been initialized



1017
            // somewhere else already, so just pop the top of the stack



1018
            // into it



1019
            if v = nil then begin



1020
                // remove the last OP_PUSH and set variable identifier



1014
                m_code.chop_tail;
1021
                m_code.chop_tail;



1015
                m_vars.m_tail^.id := id;
1022
                m_vars.m_tail^.id := id;



1016
            // else we need to calculate the result, so allocate
1023
            end else



1017
            // a new data slot
1024
                // FIXME: put index into islip_cmp_var



1018
            end else begin
1025
                m_code.append(OP_POP, m_vars.get_var_index(v^.id));



1026
        end else begin



1027
            m_parser.unget_token;



1028
            // evaluate the expression



1029
            if not eval_expr() then begin



1030
                m_parser.get_pos(sr, sc);



1031
                writeln('ERROR: Unable to evaluate expression at ',



1032
                    'line ', sr, ', column ', sc);



1033
                exit;



1034
            end;



1035
            // if the variable already exists, it's been initialized



1036
            // somewhere else already, so just pop the top of the stack



1037
            // into it



1038
            if v <> nil then



1039
                // FIXME: put index into islip_cmp_var



1040
                m_code.append(OP_POP, m_vars.get_var_index(v^.id))



1041
            else begin



1019
                new(pv);
1042
                new(pv);



1020
                pv^ := islip_var.create;
1043
                pv^ := islip_var.create;



1021
                m_code.append(OP_POP, m_vars.append(pv, id));
1044
                m_code.append(OP_POP, m_vars.append(pv, id));


...
...
1075
            exit;
1098
            exit;



1076
        end;
1099
        end;



1077
        m_code.append(OP_POP, sr);
1100
        m_code.append(OP_POP, sr);



1078
    end else if token = 'VISIBLE' then begin
1101
    end else if (token = 'VISIBLE') or (token = 'INVISIBLE') then begin



1079
        // put the value on the stack and print it
1102
        // put the value on the stack and print it



1080
        if not eval_expr() then begin
1103
        if not eval_expr() then begin



1081
            m_parser.get_pos(sr, sc);
1104
            m_parser.get_pos(sr, sc);


...
...
1083
                'line ', sr, ', column ', sc);
1106
                'line ', sr, ', column ', sc);



1084
            exit;
1107
            exit;



1085
        end;
1108
        end;



1086
        m_code.append(OP_PRINT, ARG_NULL);
1109
        // differentiate between stdio and stderr



1110
        if token[1] = 'I' then



1111
            m_code.append(OP_PRINT, 1)



1112
        else



1113
            m_code.append(OP_PRINT, ARG_NULL);



1087
    end else if token = 'GIMMEH' then begin
1114
    end else if token = 'GIMMEH' then begin



1088
        if not m_parser.get_token(token, toktype) then begin
1115
        if not m_parser.get_token(token, toktype) then begin



1089
            writeln('ERROR: Unexpected end of file');
1116
            writeln('ERROR: Unexpected end of file');


...
...
1105
        end;
1132
        end;



1106
        m_code.append(OP_READ, ARG_NULL);
1133
        m_code.append(OP_READ, ARG_NULL);



1107
        m_code.append(OP_POP, sr);
1134
        m_code.append(OP_POP, sr);



1108
    end else begin
1135
    // HACK HACK HACK!!! a not-so-ellegant way of catching loop breaks



1136
    end else if (gtfo <> nil) and (token = 'GTFO') then



1137
        gtfo^.add(m_code.append(OP_JMP, ARG_NULL))



1138
    // exit from program



1139
    // NOTE: a custom extension, not included in the spec



1140
    else if token = 'KTHX' then



1141
        m_code.append(OP_STOP, ARG_NULL)



1142
    else begin



1109
        m_parser.unget_token;
1143
        m_parser.unget_token;



1110
        // try to evaluate the "IT" implied variable, which is
1144
        // try to evaluate the "IT" implied variable, which is



1111
        // always on slot #1
1145
        // always on slot #1


...
...
1184
                    end;
1218
                    end;



1185
                    // unget token for reevaluation
1219
                    // unget token for reevaluation



1186
                    m_parser.unget_token;
1220
                    m_parser.unget_token;



1187
                    if not eval_statement then begin
1221
                    if not eval_statement(nil) then begin



1188
                        //writeln('ERROR: Unable to parse script');
1222
                        //writeln('ERROR: Unable to parse script');



1189
                        compile := false;
1223
                        compile := false;



1190
                        exit;
1224
                        exit;


...
...
1344
        p := p^.next;
1378
        p := p^.next;



1345
        inc(i);
1379
        inc(i);



1346
    end;
1380
    end;



1381
    get_var := nil;



1347
end;
1382
end;



1348
1383



1349
// ====================================================
1384
// ====================================================





          

  Updated
islip/interpreter.pas  Download diff




      
      
1819
131
            OP_PRINT:
131
            OP_PRINT:



132
                begin
132
                begin



133
                    m_stack.pop(@v);
133
                    m_stack.pop(@v);



134
                    v.echo;
134
                    if m_code^[i].arg = 1 then begin



135
                    writeln;
135
                        v.echo(true);



136
                        writeln(stderr);



137
                    end else begin



138
                        v.echo(false);



139
                        writeln;



140
                    end;



136
                end;
141
                end;



137
            OP_READ:
142
            OP_READ:



138
                begin
143
                begin


...
...
160
                        continue;
165
                        continue;



161
                    end;
166
                    end;



162
                end;
167
                end;



168
            OP_INCR:



169
                begin



170
                    pv := m_stack.peek;



171
                    v.destroy;



172
                    if m_code^[i].arg = 0 then



173
                        v := islip_var.create(-1)



174
                    else



175
                        v := islip_var.create(1);



176
                    pv^.math(@v, OP_ADD);



177
                    v.reset_value;



178
                end;



163
            else begin
179
            else begin



164
                writeln('ERROR: Invalid instruction 0x',
180
                writeln('ERROR: Invalid instruction 0x',



165
                    IntToHex(m_code^[i].inst, 2), ', possibly corrupt bytecode ',
181
                    IntToHex(m_code^[i].inst, 2), ', possibly corrupt bytecode ',





          

  Updated
islip/islip.pas  Download diff




      
      
1819
115
        write('  0x', IntToHex(i, 8), ' = ');
115
        write('  0x', IntToHex(i, 8), ' = ');



116
        if g_data[i].get_type = VT_STRING then
116
        if g_data[i].get_type = VT_STRING then



117
            write('"');
117
            write('"');



118
        g_data[i].echo;
118
        g_data[i].echo(false);



119
        if g_data[i].get_type = VT_STRING then
119
        if g_data[i].get_type = VT_STRING then



120
            write('"');
120
            write('"');



121
        writeln;
121
        writeln;





          

  Updated
islip/parser.pas  Download diff




      
      
1819
138
    if m_token = 'BTW' then begin
138
    if m_token = 'BTW' then begin



139
        // skip characters until we read a newline and
139
        // skip characters until we read a newline and



140
        // start a new token
140
        // start a new token



141
        while m_reader.get_char(c) do begin
141
        while m_reader.get_char(c) do



142
            if c in [chr(10), chr(13)] then begin
142
            if c in [chr(10), chr(13)] then begin



143
                m_token := '';
143
                m_token := '';



144
                break;
144
                break;



145
            end;
145
            end;



146
        end;



147
    end else if m_token = 'OBTW' then begin
146
    end else if m_token = 'OBTW' then begin



148
        // skip characters until we read a "TLDR"
147
        // skip characters until we read a "TLDR"



149
        while m_reader.get_char(c) do begin
148
        while m_reader.get_char(c) do begin





          

  Updated
islip/typedefs.pas  Download diff




      
      
1819
17
    // these don't have anything to do with C, but they're here for convenience
17
    // these don't have anything to do with C, but they're here for convenience



18
    cfile   = file of char;
18
    cfile   = file of char;



19
    pcfile  = ^cfile;
19
    pcfile  = ^cfile;



20
    pbool   = ^boolean;



20
21



21
implementation
22
implementation



22
23





          

  Updated
islip/variable.pas  Download diff




      
      
1819
31
            // copies the variable from other
31
            // copies the variable from other



32
            procedure copy(other : pislip_var);
32
            procedure copy(other : pislip_var);



33
33



34
            // prints the variable to stdout
34
            // prints the variable to stdout or stderr



35
            procedure echo;
35
            procedure echo(to_stderr : boolean);



36
            // returns variable type
36
            // returns variable type



37
            function get_type : islip_type;
37
            function get_type : islip_type;



38
            // does a cast to target type
38
            // does a cast to target type


...
...
49
            function logic(other : pislip_var; op : byte) : boolean;
49
            function logic(other : pislip_var; op : byte) : boolean;



50
            // string concatenation; results in a cast to string
50
            // string concatenation; results in a cast to string



51
            procedure concat(other : pislip_var);
51
            procedure concat(other : pislip_var);



52
            // frees the value pointed to by m_valptr



53
            procedure reset_value;



52
        private
54
        private



53
            m_type      : islip_type;
55
            m_type      : islip_type;



54
            m_valptr    : pointer;
56
            m_valptr    : pointer;



55



56
            // frees the value pointed to by m_valptr



57
            procedure reset_value;



58
    end;
57
    end;



59
58



60
implementation
59
implementation


...
...
229
    end;
228
    end;



230
end;
229
end;



231
230



232
procedure islip_var.echo;
231
procedure islip_var.echo(to_stderr : boolean);



233
var
232
var



234
    pi  : ^int;
233
    pi  : ^int;



235
    pf  : ^float;
234
    pf  : ^float;


...
...
240
        VT_INT:
239
        VT_INT:



241
            begin
240
            begin



242
                pi := m_valptr;
241
                pi := m_valptr;



243
                write(pi^);
242
                if to_stderr then



243
                    write(stderr, pi^)



244
                else



245
                    write(pi^);



244
            end;
246
            end;



245
        VT_FLOAT:
247
        VT_FLOAT:



246
            begin
248
            begin



247
                pf := m_valptr;
249
                pf := m_valptr;



248
                write(pf^:0:2);
250
                if to_stderr then



251
                    write(stderr, pf^:0:2)



252
                else



253
                    write(pf^:0:2);



249
            end;
254
            end;



250
        VT_STRING:
255
        VT_STRING:



251
            begin
256
            begin



252
                ps := m_valptr;
257
                ps := m_valptr;



253
                write(ps^);
258
                if to_stderr then



259
                    write(stderr, ps^)



260
                else



261
                    write(ps^);



254
            end;
262
            end;



255
        VT_BOOL:
263
        VT_BOOL:



256
            begin
264
            begin



257
                pb := m_valptr;
265
                pb := m_valptr;



258
                if pb^ then
266
                if to_stderr then begin



259
                    write('WIN')
267
                    if pb^ then



260
                else
268
                        write(stderr, 'WIN')



261
                    write('FAIL');
269
                    else



270
                        write(stderr, 'FAIL');



271
                end else begin



272
                    if pb^ then



273
                        write('WIN')



274
                    else



275
                        write('FAIL');



276
                end;



262
            end;
277
            end;



263
    end;
278
    end;



264
end;
279
end;


...
...
353
                    VT_STRING:
368
                    VT_STRING:



354
                        begin
369
                        begin



355
                            new(ps);
370
                            new(ps);



356
                            ps^ := FloatToStr(pi^);
371
                            ps^ := FloatToStr(pf^);



357
                            m_valptr := ps;
372
                            m_valptr := ps;



358
                        end;
373
                        end;



359
                end;
374
                end;