ALDT (Arnulf's LaTeX Documentation Tool)

Check-in [eaea8012cb]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixes and new code
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:eaea8012cbdec66d4eefd68c189181abbda81d15
User & Date: arnulf 2012-08-26 19:29:09
Context
2012-08-26
20:19
fixes check-in: 5d7b8549ff user: arnulf tags: trunk
19:29
fixes and new code check-in: eaea8012cb user: arnulf tags: trunk
18:25
initial version check-in: 4954d337f3 user: arnulf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to EvalStatement.tcl.

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
...
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353

354
355

356
357
358
359

360
361
362
363
364


365
366
367
368
369
370
371
372
373


374
375

376
377
378
379
380
381

382
383
384
385
386
387
388
389

390
391
392
393

394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
  # ==================== substOneToken =====================================
::itcl::body EvalStatement::substOneToken {script idx result_ptr} {
    ApwtclObj obj_ptr = null;
    ScriptToken token = script.script_object.tokens.get(idx);
    ArrayList<Variable> result_var_ptr = new ArrayList<Variable>();
    Variable result_var;
    
if (eval_subst_debug > 0) {
print("substOneToken dump 1!");
script.dumpToken(idx);
print("substOneToken!"+token.token+"!"+getTokenString(token.token)+"!"+token.obj_ptr.mySelf()+"!"+token.obj_ptr.getString()+"!");
}

    switch (token.token) {
    case TOKEN_QUOTE_ESC:
................................................................................
      }
      break;
    case TOKEN_CMD:
      if (interp.frame_ptr.type == CALL_TYPE_MACROEXPAND) {
        had_macro_cmd = true;
        macro_cmd_level = eval_level;
      }
if (eval_subst_debug == 1) {
print(">>CMD!"+token.obj_ptr+"!");
eval_stmt_debug = 2;
}
      int my_ret = evalObj(token.obj_ptr);
if (eval_subst_debug == 1) {
print(">>CMD end!"+token.obj_ptr+"!");
eval_stmt_debug = -1;
}
      switch (my_ret) {
      case OK:
      case RETURN:
if (my_ret == RETURN) {
................................................................................
//print("ipol start!"+idx+"!"+word_tokens+"!");
    in_quotes = false;
    /* Compute every token forming the argument
     * in the intv2 objects vector. 
     */
    j = 0;
    for (i = 0; i < word_tokens; i++) {
if (eval_ipol_debug > 0) {
print("IPOL!"+i+"!"+idx+"!");
print("interpolateTokens dump 1!");
script.dumpToken(i+idx);
}
      if (script.script_object.tokens.get(i + idx).token == TOKEN_COMMENT) {
        continue;
      }
      result_ptr = new ArrayList<ApwtclObj>();
      retcode = substOneToken(script, idx + i, result_ptr);
      intv2.add(result_ptr.get(0));
if (eval_ipol_debug > 1) {
print("RES ipol!"+result_ptr.get(0)+"!"+intv2.toString()+"!"+retcode+"!");
print("interpolateTokens dump 2!");
script.dumpToken(i+idx);
}
      if (intv2.get(j) != null) {
        intv2.get(j).incrRefCount("I_EVAL_STATEMENT_2");
      }
................................................................................
        intv2.get(i).decrRefCount("D_EVAL_STATEMENT_3");
      }
    }
//    obj_ptr.bytes[total_len] = '\0';
    obj_ptr.len = total_len;
    /* Free the intv2 vector. */
    intv2 = null;
if (eval_ipol_debug > 1) {
print("interpolateTokens END!"+obj_ptr.toDebugString()+"!");
}
    in_quotes = my_in_quotes;
    return obj_ptr;
  }

  # ==================== evalObj =====================================
::itcl::body EvalStatement::evalObj {script_obj_ptr} {
if (eval_stmt_debug > 0) {
print("EVALOBJ!"+script_obj_ptr+"!");
}
    int i;
    Script script;
    ArrayList<ScriptToken> token;
    int retcode = OK;
    int line_no = 0;
    boolean had_comment = false;

    eval_level++;
if (eval_stmt_debug > 0) {
print("EVALOBJ 1a level!"+eval_level+"!"+script_obj_ptr.toDebugString()+"!");

if (eval_stmt_debug > 1) {
print("EVALOBJ 1b level!"+eval_level+"!"+script_obj_ptr.mySelf()+"!");

}
}
//print("EVALOBJ2");
    interp.error_flag = false;


    /* If the object is of type "list", with no string rep we can call
     * a specialized version of evalObj() */
    if (script_obj_ptr.isListObj() && script_obj_ptr.bytes == null) {
      retcode = evalObjList(script_obj_ptr, interp.empty_string_obj, 1);


      if (macro_cmd_level == eval_level) {
        had_macro_cmd = false;
      }
      eval_level--;
      return retcode;
    }
//print("EVALOBJ3");
    script_obj_ptr.incrRefCount("I_EVAL_STATEMENT_4");     /* Make sure it's shared. */
    script = interp.script_obj_type.getScript(script_obj_ptr);


//print("Evalobj3a!"+script+"!");
    if (script == null) {

      interp.setResultString("error in parsing script: \""+script_obj_ptr+"\"");
      if (macro_cmd_level == eval_level) {
        had_macro_cmd = false;
      }
      eval_level--;
      return ERROR;

    }
//print("EVALOBJ4");
    /* Reset the interpreter result. This is useful to
     * return the empty result in the case of empty program. */
    interp.setEmptyResult();

    /* Check for one of the following common scripts used by for, while
     *

     *   {}
     *   incr a
     */
    if (script.script_object.len == 0) {

      script_obj_ptr.decrRefCount("D_EVAL_STATEMENT_4");
      if (macro_cmd_level == eval_level) {
        had_macro_cmd = false;
      }
      eval_level--;
      return OK;
    }
//print("EVALOBJ5");
    ArrayList<Variable> var_ptr = new ArrayList<Variable>();
    if (script.script_object.len == 3
        && script.script_object.tokens.get(1).obj_ptr.obj_type == OBJ_TYPE_COMMAND
	    && script.script_object.tokens.get(1).obj_ptr.cmdValue_GetResolvedCmdNamePtr().cmd_ptr.is_proc == false
        && script.script_object.tokens.get(1).obj_ptr.cmdValue_GetResolvedCmdNamePtr().cmd_ptr.name.equals("incr")
        && script.script_object.tokens.get(2).obj_ptr.obj_type == OBJ_TYPE_VARIABLE) {

      ApwtclObj obj_ptr = interp.variable_obj_type.getVariable(script.script_object.tokens.get(2).obj_ptr, FUNCTION_FLAGS_NONE, var_ptr);







|







 







|




|







 







|










|







 







|








|
|

|
<
<
<
|
|

|
|
<
>
|
<
>


|
<
>

|
|
<
<
>
>
|
|

|
|

|
<
<
>
>
|
<
>
|
|
|

|
<
>

|
|
|
|

|
<
>
|
|
<
<
>
|
|
|

|
|

|
<







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
...
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
...
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344



345
346
347
348
349

350
351

352
353
354
355

356
357
358
359


360
361
362
363
364
365
366
367
368


369
370
371

372
373
374
375
376
377

378
379
380
381
382
383
384
385

386
387
388


389
390
391
392
393
394
395
396
397

398
399
400
401
402
403
404
  # ==================== substOneToken =====================================
::itcl::body EvalStatement::substOneToken {script idx result_ptr} {
    ApwtclObj obj_ptr = null;
    ScriptToken token = script.script_object.tokens.get(idx);
    ArrayList<Variable> result_var_ptr = new ArrayList<Variable>();
    Variable result_var;
    
if {$eval_subst_debug > 0} {
print("substOneToken dump 1!");
script.dumpToken(idx);
print("substOneToken!"+token.token+"!"+getTokenString(token.token)+"!"+token.obj_ptr.mySelf()+"!"+token.obj_ptr.getString()+"!");
}

    switch (token.token) {
    case TOKEN_QUOTE_ESC:
................................................................................
      }
      break;
    case TOKEN_CMD:
      if (interp.frame_ptr.type == CALL_TYPE_MACROEXPAND) {
        had_macro_cmd = true;
        macro_cmd_level = eval_level;
      }
if {$eval_subst_debug == 1} {
print(">>CMD!"+token.obj_ptr+"!");
eval_stmt_debug = 2;
}
      int my_ret = evalObj(token.obj_ptr);
if {$eval_subst_debug == 1} {
print(">>CMD end!"+token.obj_ptr+"!");
eval_stmt_debug = -1;
}
      switch (my_ret) {
      case OK:
      case RETURN:
if (my_ret == RETURN) {
................................................................................
//print("ipol start!"+idx+"!"+word_tokens+"!");
    in_quotes = false;
    /* Compute every token forming the argument
     * in the intv2 objects vector. 
     */
    j = 0;
    for (i = 0; i < word_tokens; i++) {
if {$eval_ipol_debug > 0} {
print("IPOL!"+i+"!"+idx+"!");
print("interpolateTokens dump 1!");
script.dumpToken(i+idx);
}
      if (script.script_object.tokens.get(i + idx).token == TOKEN_COMMENT) {
        continue;
      }
      result_ptr = new ArrayList<ApwtclObj>();
      retcode = substOneToken(script, idx + i, result_ptr);
      intv2.add(result_ptr.get(0));
if {$eval_ipol_debug > 1} {
print("RES ipol!"+result_ptr.get(0)+"!"+intv2.toString()+"!"+retcode+"!");
print("interpolateTokens dump 2!");
script.dumpToken(i+idx);
}
      if (intv2.get(j) != null) {
        intv2.get(j).incrRefCount("I_EVAL_STATEMENT_2");
      }
................................................................................
        intv2.get(i).decrRefCount("D_EVAL_STATEMENT_3");
      }
    }
//    obj_ptr.bytes[total_len] = '\0';
    obj_ptr.len = total_len;
    /* Free the intv2 vector. */
    intv2 = null;
if {$eval_ipol_debug > 1} {
print("interpolateTokens END!"+obj_ptr.toDebugString()+"!");
}
    in_quotes = my_in_quotes;
    return obj_ptr;
  }

  # ==================== evalObj =====================================
::itcl::body EvalStatement::evalObj {script_obj_ptr} {
if {$eval_stmt_debug > 0} {
puts "EVALOBJ!$script_obj_ptr!"
}
    set retcode [::Interp::string2ReturnCode OK]



    set line_no 0
    set had_comment false

    incr eval_level
if {$eval_stmt_debug > 0} {

puts "EVALOBJ 1a level!$eval_level![$script_obj_ptr toDebugString]!"
if {$eval_stmt_debug > 1} {

puts "EVALOBJ 1b level!$eval_level![$script_obj_ptr mySelf]!"
}
}
#puts "EVALOBJ2"

    set ::Interp::error_flag false

    # If the object is of type "list", with no string rep we can call
    # a specialized version of evalObj()


    if {[$script_obj_ptr isListObj] && [$script_obj_ptr getBytes] eq ""} {
      set retcode [evalObjList $script_obj_ptr $::Interp::empty_string_obj 1]
      if {$macro_cmd_level == $eval_level} {
        set had_macro_cmd false
      }
      incr eval_level -1
      return $retcode;
    }
#puts "EVALOBJ3"


    $script_obj_ptr incrRefCount "I_EVAL_STATEMENT_4";     # Make sure it's shared.
    set script [$::Interp::script_obj_type getScript $script_obj_ptr]
#puts "Evalobj3a!$script!"

    if {$script eq ""} {
      ::Interp setResultString "error in parsing script: \"$script_obj_ptr\""
      if {$macro_cmd_level == $eval_level} {
        set had_macro_cmd false
      }
      incr eval_level -1

      return [::Interp::string2ReturnCode ERROR]
    }
#puts "EVALOBJ4"
    # Reset the interpreter result. This is useful to
    # return the empty result in the case of empty program.
    ::Interp setEmptyResult

    # Check for one of the following common scripts used by for, while

    #
    #   {}
    #   incr a


    if {[[$script getScriptObject] getLen] == 0} {
      $script_obj_ptr decrRefCount "D_EVAL_STATEMENT_4"
      if {$macro_cmd_level == $eval_level} {
        set had_macro_cmd false
      }
      incr eval_level -1
      return true
    }
puts "EVALOBJ5"

    if (script.script_object.len == 3
        && script.script_object.tokens.get(1).obj_ptr.obj_type == OBJ_TYPE_COMMAND
	    && script.script_object.tokens.get(1).obj_ptr.cmdValue_GetResolvedCmdNamePtr().cmd_ptr.is_proc == false
        && script.script_object.tokens.get(1).obj_ptr.cmdValue_GetResolvedCmdNamePtr().cmd_ptr.name.equals("incr")
        && script.script_object.tokens.get(2).obj_ptr.obj_type == OBJ_TYPE_VARIABLE) {

      ApwtclObj obj_ptr = interp.variable_obj_type.getVariable(script.script_object.tokens.get(2).obj_ptr, FUNCTION_FLAGS_NONE, var_ptr);

Changes to IntObjType.tcl.

22
23
24
25
26
27
28

29
30
31
32
33
34
35
..
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
  constructor {} {}
  public method mySelf {}
  public method toString {}
  public method toDebugString {}
  public method setFromAny {obj_ptr flags}
  public method updateString {obj_ptr}
  public method newIntObj {val}

  public method getBool {obj_ptr bool_ptr}
}

  # ==================== constructor ==================================
::itcl::body IntObjType::constructor {} {
    incr oid
    set id $oid
................................................................................
  }

  # ==================== updateString =====================================
::itcl::body IntObjType::updateString {obj_ptr} {
    set str [list]
    set len [list]

    set ret_code = wideToString(obj_ptr.wideValue_GetValue(), str, len);
    if (obj_ptr.bytes == null) {
      obj_ptr.bytes = new StringBuffer();  
    }
    obj_ptr.bytes.append(str.get(0));
    obj_ptr.len = len.get(0);
    return ret_code;
  }

  # ==================== newIntObj ==================================
::itcl::body IntObjType::newIntObj {val} {
    set obj_ptr [$::Interp::default_obj newObj]
    $obj_ptr setObjType [::Interp::string2ObjType OBJ_TYPE_INT]
    $obj_ptr setLen 0
    $obj_ptr setBytes ""
    $obj_ptr wideValue_SetValue $val










    return obj_ptr;
  }

if {0} {
  /* ==================== wideToString ===================================== */
::itcl::body IntObjType::  public int wideToString(long wide_value, ArrayList<String> str_ptr, ArrayList<Integer> len_ptr) {
    String str = String.valueOf(wide_value);

    str_ptr.add(str);
    len_ptr.add(str.length());
    return OK;
  }

  /* ==================== stringToWide ================================== */
::itcl::body IntObjType::  public long stringToWide(String val, ArrayList<Long> result, int flags) {
	try {
      result.add(Long.parseLong(val));
	} catch(Exception e) {
	  return ERROR;
	}







>







 







|
|
|

|
|
|









>
>
>
>
>
>
>
>
>
>
|



<
<
<
<
<
<
<
<
<







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
..
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
  constructor {} {}
  public method mySelf {}
  public method toString {}
  public method toDebugString {}
  public method setFromAny {obj_ptr flags}
  public method updateString {obj_ptr}
  public method newIntObj {val}
  public method wideToString {wide_value str_var len_var}
  public method getBool {obj_ptr bool_ptr}
}

  # ==================== constructor ==================================
::itcl::body IntObjType::constructor {} {
    incr oid
    set id $oid
................................................................................
  }

  # ==================== updateString =====================================
::itcl::body IntObjType::updateString {obj_ptr} {
    set str [list]
    set len [list]

    set ret_code [wideToString [$obj_ptr wideValue_GetValue] str len]
    if {[$obj_ptr getBytes] == [list]} {
      $obj_ptr setBytes ""
    }
    $obj_ptr setBytes "[$obj_ptr getBytes]$str"
    $obj_ptr setLen $len
    return $ret_code
  }

  # ==================== newIntObj ==================================
::itcl::body IntObjType::newIntObj {val} {
    set obj_ptr [$::Interp::default_obj newObj]
    $obj_ptr setObjType [::Interp::string2ObjType OBJ_TYPE_INT]
    $obj_ptr setLen 0
    $obj_ptr setBytes ""
    $obj_ptr wideValue_SetValue $val
    return $obj_ptr;
  }

  # ==================== wideToString =====================================
::itcl::body IntObjType::wideToString {wide_value str_var len_var} {
    upvar $str_var str
    upvar $len_var len

    set str $wide_value
    set len [string length $str]
    return true
  }

if {0} {









  /* ==================== stringToWide ================================== */
::itcl::body IntObjType::  public long stringToWide(String val, ArrayList<Long> result, int flags) {
	try {
      result.add(Long.parseLong(val));
	} catch(Exception e) {
	  return ERROR;
	}

Changes to Interp.tcl.

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
..
58
59
60
61
62
63
64
65







66

































































































































#=====================================================

namespace eval :: {

::itcl::class Interp {
  public common obj_type2string
  public common string2obj_type



  public common string_obj_type [uplevel #0 ::Parser::StringObjType #auto]
  public common source_obj_type [uplevel #0 ::Parser::SourceObjType #auto]
  public common script_obj_type [uplevel #0 ::Parser::ScriptObjType #auto]
  public common script_line_obj_type [uplevel #0 ::Parser::ScriptLineObjType #auto]



  public common current_dir "."




  public proc Init {}
  public proc objType2String {val}
  public proc string2ObjType {val}












}

::itcl::body Interp::Init {} {
  set obj_type2string(0) "OBJ_TYPE_SCRIPT"
  set obj_type2string(1) "OBJ_TYPE_SCRIPT_LINE"
  set obj_type2string(2) "OBJ_TYPE_SOURCE"
  set obj_type2string(3) "OBJ_TYPE_STRING"




  set string2obj_type(OBJ_TYPE_SCRIPT) 0
  set string2obj_type(OBJ_TYPE_SCRIPT_LINE) 1
  set string2obj_type(OBJ_TYPE_SOURCE) 2

  set string2obj_type(OBJ_TYPE_STRING) 3

















}

::itcl::body Interp::objType2String {val} {
  if {[info exists obj_type2string($val)]} {
    return $obj_type2string($val)
  } else {
puts stderr "objType2String no such ObjType!$val!"
................................................................................
    return $string2obj_type($val)
  } else {
puts stderr "string2ObjType no such ObjType!$val!"
parray string2obj_type
    return ""
  }
}








}








































































































































>
>





>
>


>
>
>




>
>

>
>
>
>
>
>
>
>
>



|
|
|
|
>
>

>
|
|
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 








>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
..
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
#=====================================================

namespace eval :: {

::itcl::class Interp {
  public common obj_type2string
  public common string2obj_type
  public common return_code2string
  public common string2return_code

  public common string_obj_type [uplevel #0 ::Parser::StringObjType #auto]
  public common source_obj_type [uplevel #0 ::Parser::SourceObjType #auto]
  public common script_obj_type [uplevel #0 ::Parser::ScriptObjType #auto]
  public common script_line_obj_type [uplevel #0 ::Parser::ScriptLineObjType #auto]
  public common int_obj_type [uplevel #0 ::Parser::IntObjType #auto]
  public common eval_statement [uplevel #0 ::Parser::EvalStatement #auto]

  public common current_dir "."
  public common error_flag 
  public common empty_string_obj 
  public common default_obj 

  public proc Init {}
  public proc objType2String {val}
  public proc string2ObjType {val}
  public proc returnCode2String {val}
  public proc string2ReturnCode {val}

  public proc setEmptyResult {}
  public proc setResult {obj_ptr}
  public proc setResultString {str}
  public proc setResultBool {val}
  public proc setResultInt {val}
  public proc setResultFormatted {format arguments}
  public proc getResult {}
  public proc resetResult {}
  public proc panic {cond str}
}

::itcl::body Interp::Init {} {
  set obj_type2string(0) "OBJ_TYPE_STRING"
  set obj_type2string(1) "OBJ_TYPE_SCRIPT"
  set obj_type2string(2) "OBJ_TYPE_SCRIPT_LINE"
  set obj_type2string(3) "OBJ_TYPE_SOURCE"
  set obj_type2string(4) "OBJ_TYPE_LIST"
  set obj_type2string(5) "OBJ_TYPE_INT"

  set string2obj_type(OBJ_TYPE_STRING) 0
  set string2obj_type(OBJ_TYPE_SCRIPT) 1
  set string2obj_type(OBJ_TYPE_SCRIPT_LINE) 2
  set string2obj_type(OBJ_TYPE_SOURCE) 3
  set string2obj_type(OBJ_TYPE_LIST) 4
  set string2obj_type(OBJ_TYPE_INT) 5

  set return_code2string(0) "OK"
  set return_code2string(1) "ERROR"
  set return_code2string(2) "RETURN"
  set return_code2string(3) "BREAK"
  set return_code2string(4) "CONTINUE"
  set return_code2string(5) "EVAL"

  set string2return_code(OK) 0
  set string2return_code(ERROR) 1
  set string2return_code(RETURN) 2
  set string2return_code(BREAK) 3
  set string2return_code(CONTINUE) 4
  set string2return_code(EVAL) 5

  set empty_string_obj [$string_obj_type newEmptyStringObj "INTERP_1"]
  set default_obj $empty_string_obj
}

::itcl::body Interp::objType2String {val} {
  if {[info exists obj_type2string($val)]} {
    return $obj_type2string($val)
  } else {
puts stderr "objType2String no such ObjType!$val!"
................................................................................
    return $string2obj_type($val)
  } else {
puts stderr "string2ObjType no such ObjType!$val!"
parray string2obj_type
    return ""
  }
}

::itcl::body Interp::returnCode2String {val} {
  if {[info exists return_code2string($val)]} {
    return $return_code2string($val)
  } else {
puts stderr "returnCode2String no such ReturnCode!$val!"
parray return_code2string
    return ""
  }
}

::itcl::body Interp::string2ReturnCode {val} {
  if {[info exists string2return_code($val)]} {
    return $string2return_code($val)
  } else {
puts stderr "string2ReturnCode no such ReturnCode!$val!"
parray string2return_code
    return ""
  }
}

  # ==================== setEmptyResult ================================== 
::itcl::body Interp::setEmptyResult {} {
    setResult $empty_string_obj
  }

  # ==================== setResult ==================================
::itcl::body Interp::setResult {obj_ptr} {
    $obj_ptr incrRefCount "I_INTERP_12"
    $result decrRefCount "D_INTERP_3"
    set result $obj_ptr
  }

  # ==================== setResultString ================================== 
::itcl::body Interp::setResultString {str} {
    if {$result ne ""} {
      $result decrRefCount "D_INTERP_4"
    }
    set result [$string_obj_type newStringObj $str -1 "INTERP11"]
    $result incrRefCount "I_INTERP_13"
  }

  # ==================== setResultBool ==================================
::itcl::body Interp::setResultBool {val} {
    set my_val = 0;
    if {$val == true} {
      set my_val 1
    }
    if {$val == false} {
      set my_val 0
    }
    setResult [$int_obj_type newIntObj $my_val]
  }

  # ==================== setResultInt ==================================
::itcl::body Interp::setResultInt {val} {
    setResult [$int_obj_type newIntObj $val]
  }

  # ==================== setResultFormatted ===================================== 
  #
  # Very simple printf-like formatting, designed for error messages.
  #
  # The format may contain up to 5 '%s' or '%#s', corresponding to variable arguments.
  # The resulting string is created and set as the result.
  #
  # Each '%s' should correspond to a regular string parameter.
  # Each '%#s' should correspond to a (ApwtclObj *) parameter.
  # Any other printf specifier is not allowed (but %% is allowed for the % character).
  #
  # e.g. setResultFormatted("Bad option \"%#s\" in proc \"%#s\"", optionObjPtr, procNamePtr);
  #
  # Note: We take advantage of the fact that printf has the same behaviour for 
  # both %s and %#s

::itcl::body Interp::setResultFormatted {format arguments} {
    # Initial space needed
    int n = 0;
    StringBuffer buf = new StringBuffer("");
    int i;
    int start_idx = 0;
    int len = format.length();
    String str;

    for (i = 0; i < len; i++) {
      if (format.charAt(i) == '%') {
    	switch (format.charAt(i + 1)) {
        case 's':
          buf.append(format.substring(start_idx, i));
          str = (String)(arguments.get(n));
          buf.append(str);
          n++;
          i += 1;
          start_idx = i + 1;
          break;
        case '#':
          if (format.charAt(i + 2) == 's') {
            ApwtclObj obj_ptr;

            buf.append(format.substring(start_idx, i));
            obj_ptr = (ApwtclObj)arguments.get(n);
            buf.append(obj_ptr.getString());
            n++;
            i += 2;
            start_idx = i + 1;
            break;
          } else {
            i++;
          }
        default:
          i++;
        }
      }
    }
    buf.append(format.substring(start_idx, i));
    len = buf.length();
//print("setResultFormatted end!"+buf.toString()+"!");
    setResult(string_obj_type.newStringObjNoAlloc(buf.toString(), len, "INTERP_12"));
  }

  # ==================== getResult =====================================
::itcl::body Interp::getResult {} {
    return $result;
  }

  # ==================== resetResult ==================================
::itcl::body Interp::resetResult {} {
  }

  # ==================== panic ==================================
::itcl::body Interp::panic {cond str} {
    if {$cond} {
      puts "PANIC!$str!"
    }
  }


}

Changes to LatexObj.tcl.

52
53
54
55
56
57
58










59
60
61
62
63
64
65
..
71
72
73
74
75
76
77




78
79
80
81
82
83
84
...
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
...
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
...
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
...
622
623
624
625
626
627
628
629

630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689

690
691
692
693

694
695
696

697
698
699
700
701
702
703
704
705

706
707
708

709
710
711
712
713
714
715
716
717
718
719
720
721
722
723

724
725
726
727
728
729
730
...
744
745
746
747
748
749
750
751

752
753

754
755
756
757
758

759
760
761
762
763
764

765
766
767
768
769
770
771
772

773
774
775

776
777
778
779

780
781
782
783
784
785
786
...
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
...
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
....
1538
1539
1540
1541
1542
1543
1544



1545
1546
















  public method sourceValue_SetFileNameObj {file_name_obj}
  public method sourceValue_GetLineNumber {}
  public method sourceValue_SetLineNumber {line_number}
  public method strValue_GetCharLength {}
  public method strValue_SetCharLength {char_length}
  public method strValue_GetMaxLength {}
  public method strValue_SetMaxLength {max_length}










  public method isShared {}
  public method isListObj {}
  public method getIntRepPtr {}
  public method incrRefCount {where}
  public method decrRefCount {where}
  public method getString {}
  public method getStringLength {}
................................................................................
  public method getAllocated {}
  public method setFreed {val}
  public method getFreed {}
  public method setRefCount {val}
  public method getRefCount {}
  public method setObjType {val}
  public method getObjType {}




}

  # ==================== constructor ==================================
::itcl::body LatexObj::constructor {} {
    incr oid
    set id $oid

................................................................................
::itcl::body LatexObj::mySelf {} {
    set str "LatexObj!$id!"
    return $str
  }

  # ==================== toString =====================================
::itcl::body LatexObj::toString {} {
    return "[mySelf]!"
  }

  # ==================== toDebugString ===================================== 
::itcl::body LatexObj::toDebugString {} {
    set str "[mySelf]\n"
    append str "  ref_count: $ref_count\n"
    append str "  len: $len\n"
................................................................................
    append str "  bytes: $bytes\n"
    if {$obj_type > 0} {
      switch [::Interp::objType2String $obj_type] {
      OBJ_TYPE_LIST {
#        str.append("  list_elem: "+listValue_GetElem()+"\n");
        }
      OBJ_TYPE_INT {
    	append str "  value: [wideValue_GetValue]\n");
        }
      }
    }
    return $str
  }

if {0} {
................................................................................
#puts "sourceValue_SetLineNumber![mySelf]!"
    set value2 $line_number
    return $line_number
  }

  # ==================== strValue_GetCharLength ==================================
::itcl::body LatexObj::strValue_GetCharLength {} {
    if {$value2 == ""} {
puts "strValue_GetCharLength fix value2!"
      set value2 $len
    }
    return $value2
  }

  # ==================== strValue_SetCharLength ==================================
................................................................................
    set value2 $char_length
    return $char_length
  }

  # ==================== strValue_GetMaxLength ==================================
::itcl::body LatexObj::strValue_GetMaxLength {} {
#puts "strValue_GetMaxLength!$value1!"
    if {$value1 == ""} {
      return 0
    }
    return $value1
  }

  # ==================== strValue_SetMaxLength ==================================
::itcl::body LatexObj::strValue_SetMaxLength {max_length} {
................................................................................

  /* ==================== varValue_SetVarPtr ================================== */
  public Variable varValue_SetVarPtr(Variable var_ptr) {
//print("varValue_SetVarPtr!"+this.mySelf()+"!");
    value3 = (Object)var_ptr;
    return var_ptr;
  }


  /* ==================== wideValue_GetValue ================================== */
  public long wideValue_GetValue() {
    return (Long)value1;
  }

  /* ==================== wideValue_SetValue ================================== */
  public long wideValue_SetValue(long val) {
//print("wideValue_SetValue!"+this.mySelf()+"!");
    value1 = (Object)val;
    return val;
  }

  /* ==================== updateString ================================== */
  public int updateString() {
    return OK;
  }

  /* =========================== newObj ===================================== */
  public LatexObj newObj() {
    LatexObj my_obj_ptr;
    /* -- Check if there are objects in the free list -- */
    if (free_obj_list != null) {
      /* -- Unlink the object from the free list -- */
      my_obj_ptr = free_obj_list;
      free_obj_list = my_obj_ptr.next_obj_ptr;
    } else {
      /* -- No ready to use objects: allocate a new one -- */
      my_obj_ptr = new LatexObj(interp);
    }
    /* Object is returned with ref_count of 0. Every
     * kind of GC implemented should take care to don't try
     * to scan objects with ref_count == 0. */
    my_obj_ptr.ref_count = 0;
    /* All the other fields are left not initialized to save time.
     * The caller will probably want to set them to the right
     * value anyway. */

    /* -- Put the object into the live list -- */
    my_obj_ptr.prev_obj_ptr = null;
    my_obj_ptr.next_obj_ptr = live_obj_list;
    if (live_obj_list != null) {
      live_obj_list.prev_obj_ptr = my_obj_ptr;
    }
    live_obj_list = my_obj_ptr;
    my_obj_ptr.obj_type = 0;
    my_obj_ptr.bytes = null;
    return my_obj_ptr;
  }

  /* ==================== freeNewObj ===================================== */
  public void freeNewObj(String where) {
    freeObj(where);
    freed = where;
  }

  /* ==================== freeObj ===================================== */
  /* Free an Obj. Actually Objs are never freed, but
   * just moved to the free obj list, where they will be
   * reused by NewObj(). 
   */

  public void freeObj(String where) {
//print("freeObj!"+mySelf()+"!"+obj_type+"!"+getString()+"!");
    /* Check if the object was already freed, panic. */
    panic(ref_count != 0, "!!! "+mySelf()+" freed with bad ref_count "+ref_count+", type="+getObjTypeString(obj_type)+"!"+toDebugString()+"!");

    freeIntRep();
    /* Free the string representation */
    if (bytes != null) {

      bytes = null;
    }
    /* free the values */
    value1 = null;
    value2 = null;
    value3 = null;
    /* Unlink the object from the live objects list */
    if (prev_obj_ptr != null) {
      prev_obj_ptr.next_obj_ptr = next_obj_ptr;

    }
    if (next_obj_ptr != null) {
      next_obj_ptr.prev_obj_ptr = prev_obj_ptr;

    }
    if (live_obj_list == this) {
      live_obj_list = next_obj_ptr;
    }
    /* Link the object into the free objects list */
    prev_obj_ptr = null;
    next_obj_ptr = free_obj_list;
    if (free_obj_list != null) {
      free_obj_list.prev_obj_ptr = this;
    }
    free_obj_list = this;
    ref_count = -1;
    freed = where;
  }
				          

  /* ==================== dumpObjLists ===================================== */
  public void dumpObjLists() {
    LatexObj obj_ptr;

    print("live_list!"+live_obj_list+"!");
    obj_ptr = live_obj_list;
    while (obj_ptr != null) {
................................................................................
				          
  /* ==================== invalidateStringRep ===================================== */
  public void invalidateStringRep() {
    if (bytes != null) {
      bytes = null;
    }
  } 


  /* ==================== setIntRepPtr ===================================== */
  public void setIntRepPtr(Object ptr) {

    ptrValue_SetPtr(ptr);
  } 

  /* ==================== freeIntRep ===================================== */
  public void freeIntRep() {

    obj_type_base.callFreeIntRepProc(obj_type, this);
  } 

  /* ==================== setStringRep ===================================== */
  public void setStringRep(LatexObj obj_ptr, String str, int len) {
    obj_ptr.bytes.append(str);

    obj_ptr.len = len;
  } 

  /* ==================== initStringRep ===================================== */
  /* Set the initial string representation for an object. */
  public void initStringRep(LatexObj obj_ptr, String str, int len) {
    if (obj_ptr.bytes == null) {
      obj_ptr.bytes = new StringBuffer("");

    }
    if (str != null) {
	  obj_ptr.bytes.append(str);

    }
    obj_ptr.len = len;
  } 


  /* Xdigitval and Odigitval are helper functions for escapeBackslash() */
  /* ==================== xdigitval ===================================== */
  public int xdigitval(char ch) {
    if (ch >= '0' && ch <= '9') {
      return ch - '0';
    }
    if (ch >= 'a' && ch <= 'f') {
................................................................................
    dest_ptr.add(p.toString());
    return len;
  }
}

  # ==================== isShared ================================== */
::itcl::body LatexObj::isShared {} {
    return $ref_count > 1
  }

  # ==================== isListObj ================================== */
::itcl::body LatexObj::isListObj {} {
    return $obj_type == OBJ_TYPE_LIST
  }

  # ==================== getIntRepPtr ================================== */
::itcl::body LatexObj::getIntRepPtr {} {
     return [ptrValue_GetPtr]
  }

................................................................................
      # Invalid string repr. Generate it.
#if (obj_type == 0) {
#print("obj!"+toDebugString()+"!");
#}
#if (!obj_type_base.haveUpdateString(obj_type)) {
#print("obj!"+toDebugString()+"!");
#}
      panic ($obj_type == 0) "UpdateStringProc called against '<none>' type.[mySelf]!"
      panic (![$obj_type_base haveUpdateString $obj_type]) "UpdateString called against '[getObjTypeString $obj_type]' type.[mySelf]!"
      $obj_type_base callUpdateString $obj_type $this
    }
    
    if {$bytes eq [list]} {
      strValue_SetCharLength 0
      strValue_SetMaxLength 0
      return ""
    }
    return [string range $bytes 0 len]
  }

  # ==================== getStringLength =====================================
::itcl::body LatexObj::getStringLength {} {
    if {$bytes eq [list]} {
      # Invalid string repr. Generate it. 
      panic ($obj_type == 0) "UpdateStringProc called against '<none>' type.[mySelf]!");
      panic (![$obj_type_base haveUpdateString $obj_type]) "UpdateString called against '[getObjTypeString $obj_type]' type."
      $obj_type_base callUpdateString $obj_type $this
    }
    return $len
  }

if {0} {
  /* ==================== getStringFromArray ===================================== */
................................................................................
}

  # ==================== getObjType ==================================
::itcl::body LatexObj::getObjType {} {
    return $obj_type
}




}
























>
>
>
>
>
>
>
>
>
>







 







>
>
>
>







 







|







 







|







 







|







 







|







 







|
>
|
|
|


|
|
|
|
|


|
|
|


|
<
|
|
|
|
|
|

|
|

|
|
|
|
|
|
|

|
|
|
|
|

|
|
|
|


|
|
|
|


|
|
|
|
<
>
|
<
|
<
>
|
|
<
>
|

|
|
|
|
|
|
<
>

|
<
>

|
|

|
|
|
|
|

|
|
|


>







 







|
>
|
<
>
|


|
<
>
|


|
<
|
>
|


|
|
<
|
|
>

<
|
>

|


>







 







|




|







 







|
|








|






|
|







 







>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
..
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
...
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
...
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
...
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
...
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702

703
704

705

706
707
708

709
710
711
712
713
714
715
716
717

718
719
720

721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
...
758
759
760
761
762
763
764
765
766
767

768
769
770
771
772

773
774
775
776
777

778
779
780
781
782
783
784

785
786
787
788

789
790
791
792
793
794
795
796
797
798
799
800
801
802
...
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
...
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
....
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
  public method sourceValue_SetFileNameObj {file_name_obj}
  public method sourceValue_GetLineNumber {}
  public method sourceValue_SetLineNumber {line_number}
  public method strValue_GetCharLength {}
  public method strValue_SetCharLength {char_length}
  public method strValue_GetMaxLength {}
  public method strValue_SetMaxLength {max_length}
  public method wideValue_GetValue {}
  public method wideValue_SetValue {val}
  public method updateString {}
  public method newObj {}
  public method freeNewObj {where}
  public method freeObj {where}
  public method setIntRepPtr {ptr}
  public method freeIntRep {}
  public method setStringRep {obj_ptr str len}
  public method initStringRep {obj_ptr str len}
  public method isShared {}
  public method isListObj {}
  public method getIntRepPtr {}
  public method incrRefCount {where}
  public method decrRefCount {where}
  public method getString {}
  public method getStringLength {}
................................................................................
  public method getAllocated {}
  public method setFreed {val}
  public method getFreed {}
  public method setRefCount {val}
  public method getRefCount {}
  public method setObjType {val}
  public method getObjType {}
  public method setPrevObjPtr {val}
  public method PrevObjPtr {}
  public method setNextObjPtr {val}
  public method getNextObjPtr {}
}

  # ==================== constructor ==================================
::itcl::body LatexObj::constructor {} {
    incr oid
    set id $oid

................................................................................
::itcl::body LatexObj::mySelf {} {
    set str "LatexObj!$id!"
    return $str
  }

  # ==================== toString =====================================
::itcl::body LatexObj::toString {} {
    return [getString]
  }

  # ==================== toDebugString ===================================== 
::itcl::body LatexObj::toDebugString {} {
    set str "[mySelf]\n"
    append str "  ref_count: $ref_count\n"
    append str "  len: $len\n"
................................................................................
    append str "  bytes: $bytes\n"
    if {$obj_type > 0} {
      switch [::Interp::objType2String $obj_type] {
      OBJ_TYPE_LIST {
#        str.append("  list_elem: "+listValue_GetElem()+"\n");
        }
      OBJ_TYPE_INT {
    	append str "  value: [wideValue_GetValue]\n"
        }
      }
    }
    return $str
  }

if {0} {
................................................................................
#puts "sourceValue_SetLineNumber![mySelf]!"
    set value2 $line_number
    return $line_number
  }

  # ==================== strValue_GetCharLength ==================================
::itcl::body LatexObj::strValue_GetCharLength {} {
    if {$value2 eq ""} {
puts "strValue_GetCharLength fix value2!"
      set value2 $len
    }
    return $value2
  }

  # ==================== strValue_SetCharLength ==================================
................................................................................
    set value2 $char_length
    return $char_length
  }

  # ==================== strValue_GetMaxLength ==================================
::itcl::body LatexObj::strValue_GetMaxLength {} {
#puts "strValue_GetMaxLength!$value1!"
    if {$value1 eq ""} {
      return 0
    }
    return $value1
  }

  # ==================== strValue_SetMaxLength ==================================
::itcl::body LatexObj::strValue_SetMaxLength {max_length} {
................................................................................

  /* ==================== varValue_SetVarPtr ================================== */
  public Variable varValue_SetVarPtr(Variable var_ptr) {
//print("varValue_SetVarPtr!"+this.mySelf()+"!");
    value3 = (Object)var_ptr;
    return var_ptr;
  }
}

  # ==================== wideValue_GetValue ==================================
::itcl::body LatexObj::wideValue_GetValue {} {
    return $value1
  }

  # ==================== wideValue_SetValue ==================================
::itcl::body LatexObj::wideValue_SetValue {val} {
#puts "wideValue_SetValue![mySelf]!"
    set value1 $val
    return $val;
  }

  # ==================== updateString ==================================
::itcl::body LatexObj::updateString {} {
    return true
  }

  # =========================== newObj =====================================

::itcl::body LatexObj::newObj {} {
    # -- Check if there are objects in the free list --
    if {$free_obj_list != [list]} {
      # -- Unlink the object from the free list -- 
      set my_obj_ptr $free_obj_list
      set free_obj_list [$my_obj_ptr getNextObjPtr]
    } else {
      # -- No ready to use objects: allocate a new one -- 
      set my_obj_ptr [uplevel #0 :::Parser::LatexObj #auto]
    }
    # Object is returned with ref_count of 0. Every
    # kind of GC implemented should take care to don't try
    # to scan objects with ref_count == 0.
    $my_obj_ptr setRefCount 0
    # All the other fields are left not initialized to save time.
    # The caller will probably want to set them to the right
    # value anyway.

    # -- Put the object into the live list --
    $my_obj_ptr setPrevObjPtr [list]
    $my_obj_ptr setNextObjPtr $live_obj_list
    if {$live_obj_list != [list]} {
      $live_obj_list setPrevObjPtr $my_obj_ptr
    }
    set live_obj_list $my_obj_ptr
    $my_obj_ptr setObjType 0
    $my_obj_ptr setBytes ""
    return $my_obj_ptr
  }

  # ==================== freeNewObj =====================================
::itcl::body LatexObj::freeNewObj {where} {
    freeObj $where
    set freed $where
  }

  # ==================== freeObj =====================================
  # Free an Obj. Actually Objs are never freed, but
  # just moved to the free obj list, where they will be
  # reused by NewObj(). 

::itcl::body LatexObj::freeObj {where} {
#puts "freeObj![mySelf]!$obj_type![getString]!"

    # Check if the object was already freed, panic.

    ::Interp::panic [expr {$ref_count != 0}] "!!! [mySelf] freed with bad ref_count $ref_count, type=[::Interp::objType2String  $obj_type]![toDebugString]!"
    freeIntRep
    # Free the string representation

    if {$bytes ne [list]} {
      set bytes [list]
    }
    # free the values
    set value1 ""
    set value2 ""
    set value3 ""
    # Unlink the object from the live objects list
    if {$prev_obj_ptr != [list]}  {

      $prev_obj_ptr setNextObjPtr $next_obj_ptr
    }
    if {$next_obj_ptr != [list]} {

      $next_obj_ptr setPrevObjPtr $prev_obj_ptr
    }
    if {$live_obj_list == $this} {
      set live_obj_list $next_obj_ptr
    }
    # Link the object into the free objects list
    set prev_obj_ptr = [list]
    set next_obj_ptr $free_obj_list
    if {$free_obj_list != [list]} {
      $free_obj_list setPrevObjPtr $this
    }
    set free_obj_list $this
    set ref_count -1
    set freed $where
  }
				          
if {0} {
  /* ==================== dumpObjLists ===================================== */
  public void dumpObjLists() {
    LatexObj obj_ptr;

    print("live_list!"+live_obj_list+"!");
    obj_ptr = live_obj_list;
    while (obj_ptr != null) {
................................................................................
				          
  /* ==================== invalidateStringRep ===================================== */
  public void invalidateStringRep() {
    if (bytes != null) {
      bytes = null;
    }
  } 
}

  # ==================== setIntRepPtr =====================================

::itcl::body LatexObj::setIntRepPtr {ptr} {
    ptrValue_SetPtr $ptr
  } 

  # ==================== freeIntRep =====================================

::itcl::body LatexObj::freeIntRep {} {
    $obj_type_base callFreeIntRepProc $obj_type $this
  } 

  # ==================== setStringRep ===================================== 

::itcl::body LatexObj::setStringRep {obj_ptr str len} {
    $obj_ptr setBytes "[$obj_ptr getBytes]$str"
    $obj_ptr setLen $len
  } 

  # ==================== initStringRep ===================================== 
  # Set the initial string representation for an object.

::itcl::body LatexObj::initStringRep {obj_ptr str len} {
    if {[$obj_ptr getBytes] eq ""} {
      $obj_ptr setBytes ""
    }

    if ($str ne "") {
      $obj_ptr setBytes "[$obj_ptr getBytes]$str"
    }
    $obj_ptr setLen $len
  } 

if {0} {
  /* Xdigitval and Odigitval are helper functions for escapeBackslash() */
  /* ==================== xdigitval ===================================== */
  public int xdigitval(char ch) {
    if (ch >= '0' && ch <= '9') {
      return ch - '0';
    }
    if (ch >= 'a' && ch <= 'f') {
................................................................................
    dest_ptr.add(p.toString());
    return len;
  }
}

  # ==================== isShared ================================== */
::itcl::body LatexObj::isShared {} {
    return [expr {$ref_count > 1}]
  }

  # ==================== isListObj ================================== */
::itcl::body LatexObj::isListObj {} {
    return [expr {$obj_type == [::Interp::string2ObjType OBJ_TYPE_LIST]}]
  }

  # ==================== getIntRepPtr ================================== */
::itcl::body LatexObj::getIntRepPtr {} {
     return [ptrValue_GetPtr]
  }

................................................................................
      # Invalid string repr. Generate it.
#if (obj_type == 0) {
#print("obj!"+toDebugString()+"!");
#}
#if (!obj_type_base.haveUpdateString(obj_type)) {
#print("obj!"+toDebugString()+"!");
#}
      ::Interp::panic [expr {$obj_type == 0}] "UpdateStringProc called against '<none>' type.[mySelf]!"
      ::Interp::panic [expr {![$obj_type_base haveUpdateString $obj_type]}] "UpdateString called against '[::Interp::objType2String $obj_type]' type.[mySelf]!"
      $obj_type_base callUpdateString $obj_type $this
    }
    
    if {$bytes eq [list]} {
      strValue_SetCharLength 0
      strValue_SetMaxLength 0
      return ""
    }
    return [string range $bytes 0 [expr {$len - 1}]]
  }

  # ==================== getStringLength =====================================
::itcl::body LatexObj::getStringLength {} {
    if {$bytes eq [list]} {
      # Invalid string repr. Generate it. 
      ::Interp::panic [expr {$obj_type == 0}] "UpdateStringProc called against '<none>' type.[mySelf]!");
      ::Interp::panic [expr {![$obj_type_base haveUpdateString $obj_type]}] "UpdateString called against '[getObjTypeString $obj_type]' type."
      $obj_type_base callUpdateString $obj_type $this
    }
    return $len
  }

if {0} {
  /* ==================== getStringFromArray ===================================== */
................................................................................
}

  # ==================== getObjType ==================================
::itcl::body LatexObj::getObjType {} {
    return $obj_type
}

  # ==================== setPrevObjPtr ==================================
::itcl::body LatexObj::setPrevObjPtr {val} {
    set prev_obj_ptr $val
}

  # ==================== getPrevObjPtr ==================================
::itcl::body LatexObj::PrevObjPtr {} {
    return $prev_obj_ptr
}

  # ==================== setNextObjPtr ==================================
::itcl::body LatexObj::setNextObjPtr {val} {
    set next_obj_ptr $val
}

  # ==================== getNextObjPtr ==================================
::itcl::body LatexObj::getNextObjPtr {} {
    return $next_obj_ptr
}

}

Changes to ObjTypeBase.tcl.

25
26
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
42
43
44
45
46
47
48
..
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
..
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

  # ==================== constructor =====================================
::itcl::body ObjTypeBase::constructor {} {
  }

  # ==================== callFreeIntRepProc =====================================
::itcl::body ObjTypeBase::callFreeIntRepProc {obj_type obj_ptr} {
    switch $obj_type {
    OBJ_TYPE_STRING: 
      return true

    }
    return true
  }

  # ==================== haveUpdateString =====================================
::itcl::body ObjTypeBase::haveUpdateString {obj_type} {
    switch $obj_type {
    OBJ_TYPE_STRING {
      return true
      }
    OBJ_TYPE_INT {
      return true
      }
    OBJ_TYPE_LIST {
................................................................................
      }
    }
    return false
  }

  # ==================== callUpdateString ===================================== 
::itcl::body ObjTypeBase::callUpdateString {obj_type obj_ptr} {
    switch $obj_type {
    OBJ_TYPE_STRING {
      return true
      }
    OBJ_TYPE_INT {
      $int_obj_type updateString $obj_ptr
      return true
      }
    OBJ_TYPE_LIST {
      $list_obj_type updateString $obj_ptr
      return true
      }
    OBJ_TYPE_DICT {
      $dict_obj_type updateString $obj_ptr
      return true
      }
    }
puts "callUpdateString missing case for obj_type![getObjTypeString $obj_type]!");
    return true
  }

  # ==================== haveDupInternalRep ===================================== */
::itcl::body ObjTypeBase::haveDupInternalRep {obj_type} {
    switch $obj_type {
    OBJ_TYPE_STRING {
      return false
      }
    OBJ_TYPE_LIST {
      return true
      }
    OBJ_TYPE_DICT {
................................................................................
      }
    }
    return false
  }

  # ==================== callDupInternalRep =====================================
::itcl::body ObjTypeBase::callDupInternalRep {obj_type src_obj_ptr dup_obj_ptr} {
    switch $obj_type {
    OBJ_TYPE_STRING {
      return true
      }
    OBJ_TYPE_LIST {
      $list_obj_type dupInternalRep $src_obj_ptr $dup_obj_ptr
      return true
      }







|
|

>






|







 







|




|



|



|



|





|







 







|







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
..
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
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

  # ==================== constructor =====================================
::itcl::body ObjTypeBase::constructor {} {
  }

  # ==================== callFreeIntRepProc =====================================
::itcl::body ObjTypeBase::callFreeIntRepProc {obj_type obj_ptr} {
    switch [::Interp::objType2String $obj_type] {
    OBJ_TYPE_STRING {
      return true
      }
    }
    return true
  }

  # ==================== haveUpdateString =====================================
::itcl::body ObjTypeBase::haveUpdateString {obj_type} {
    switch [::Interp::objType2String $obj_type] {
    OBJ_TYPE_STRING {
      return true
      }
    OBJ_TYPE_INT {
      return true
      }
    OBJ_TYPE_LIST {
................................................................................
      }
    }
    return false
  }

  # ==================== callUpdateString ===================================== 
::itcl::body ObjTypeBase::callUpdateString {obj_type obj_ptr} {
    switch [::Interp::objType2String $obj_type] {
    OBJ_TYPE_STRING {
      return true
      }
    OBJ_TYPE_INT {
      $::Interp::int_obj_type updateString $obj_ptr
      return true
      }
    OBJ_TYPE_LIST {
      $::Interp::list_obj_type updateString $obj_ptr
      return true
      }
    OBJ_TYPE_DICT {
      $::Interp::dict_obj_type updateString $obj_ptr
      return true
      }
    }
puts "callUpdateString missing case for obj_type![::Interp::objType2String $obj_type]!"
    return true
  }

  # ==================== haveDupInternalRep ===================================== */
::itcl::body ObjTypeBase::haveDupInternalRep {obj_type} {
    switch [::Interp::objType2String $obj_type] {
    OBJ_TYPE_STRING {
      return false
      }
    OBJ_TYPE_LIST {
      return true
      }
    OBJ_TYPE_DICT {
................................................................................
      }
    }
    return false
  }

  # ==================== callDupInternalRep =====================================
::itcl::body ObjTypeBase::callDupInternalRep {obj_type src_obj_ptr dup_obj_ptr} {
    switch [::Interp::objType2String $obj_type] {
    OBJ_TYPE_STRING {
      return true
      }
    OBJ_TYPE_LIST {
      $list_obj_type dupInternalRep $src_obj_ptr $dup_obj_ptr
      return true
      }

Changes to Parse.tcl.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
..
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
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
...
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
...
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
...
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
...
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
# * (Tcl BSD license found at <http://www.tcl.tk/software/tcltk/license.html>)
# *
# * Copyright 2012 Arnulf P. Wiedemann
#=====================================================

namespace eval ::Parser {

::itcl::class Parser {
  public common oid 0
  private common LC "\{"
  private common RC "\}"
  private common LB "\["
  private common RB "\]"
  public variable debug
  public variable no_exp_parsing
................................................................................
  public method getParseInfo {}
  public method getParseResult {}
  public method getEof {}
  private method feedCharStart {}
  private method feedChar {}
}

::itcl::body Parser::constructor {args} {
   set debug 0
   set no_exp_parsing false
   set parse_info ""
   set parse_result ""
 }

::itcl::body Parser::parserInit {code len line_no} {
puts "parserInit!"
    set parse_info [::Parser::ParseInfo #auto $code $len $line_no]
    set parse_result [::Parser::ParseResult #auto]
    $parse_info setCur "\n"
    if {$len > 0} {
      feedCharStart
    } else {
      $parse_info setEof true
    }
    return true
}

::itcl::body Parser::isEof {} {
  return [$parse_info getEof]
}

# =============================== parseScript ==================================
::itcl::body Parser::parseScript {} {
puts "parseScript![$parse_info getCur]![$parse_info getLen]!"
  while {true} {              # the while is used to reiterate with continue if needed 
    if {[$parse_info getLen] <= 0} {
      if {[$parse_info getCur] == "\""} {
        if {[$parse_info getState] ne [::Parser::Token::string2ParserState "PARSER_STATE_QUOTE"]} {
          $parse_result setMissing "\""
          return false
................................................................................
      return $ret
      }
    }
  }
}

# ==================== parseWordSep ===================================== */
::itcl::body Parser::parseWordSep {} {
  $parse_info setStart [$parse_info getIndex]
  while {([expr {[$parse_info getCur] in [list " " "\t" "\r" "\\"]}]) && ([$parse_info getLen] > 0)} {
    if {[$parse_info getCur] eq "\\"} {
      if {[$parse_info getLen] > 0} {
        if {[string range [$parse_info getText] [expr {[$parse_info getIndex] + 1}] [expr {[$parse_info getIndex] + 1}]] eq "\n"} {
          feedChar
        } else {
................................................................................
    $parse_info setEnd [expr {[$parse_info getIndex] - 1}]
  }
  $parse_info setToken [::Parser::Token::string2Token "TOKEN_WORD_SEP"]
  return true
}

# ==================== parseTagName ===================================== */
::itcl::body Parser::parseTagName {} {
  $parse_info setStart [$parse_info getIndex]
  $parse_info setLine [$parse_info getLineNo]
  $parse_info setToken [::Parser::Token::string2Token "TOKEN_TAG_NAME"]
  feedChar
  while {[$parse_info getLen] > 0} {
    switch [$parse_info getCur] {
    "\{" -
................................................................................
      }
    }
  }
  return true
}

# ==================== parseEol ===================================== 
::itcl::body Parser::parseEol {} {
    $parse_info setStart [$parse_info getIndex]
    $parse_info setLine [$parse_info getLineNo]
#puts "parseEol![$parse_info getIndex]![$parse_info getLen]!"
    while {true} {
#puts "parseEol2![$parse_info getCur]!"
      if {[$parse_info getCur] == "\n"} {
        $parse_info setLineNo [expr {[$parse_info getLineNo] + 1}]
................................................................................
  # ==================== parseSubBrace =====================================
  #*
  #* Parses a braced expression starting at parse.index.
  #*
  #* Positions the parser at the end of the braced expression,
  #* sets parse.end and possibly parse.missing.

::itcl::body Parser::parseSubBrace {} {
    set level 1

#uts "parseSubBrace!"    
    # Skip the brace
    feedChar
    while {[$parse_info getLen] >= 0} {
#puts "parseSubBrace2![$parse_info getCur]![$parse_info getLen]!"
      switch [$parse_info getCur] {
      "\\" {
        if {[$parse_info getLen] > 1} {
................................................................................
  #* Positions the parser at the end of the quoted expression,
  #* sets parse.end and possibly parse.missing.
  #*
  #* Returns the type of the token of the string,
  #* either TOKEN_ESC (if it contains values which need to be [subst]ed)
  #* or TOKEN_QUOTE.

::itcl::body Parser::parseSubQuote {} {
    set token "TOKEN_QUOTE"
    set line [$parse_info getLine]

    # Skip the quote 
    if {[$parse_info getLen] > 0} {
      feedChar
    } else {
................................................................................
  #* ==================== parseSubBracket =====================================
  #**
  #* Parses a [string] expression starting at parse.index.
  #*
  #* Positions the parser at the end of the command expression,
  #* sets parse.end and possibly parse.missing.

::itcl::body Parser::parseSubBracket {} {
    set level 1
    set startOfWord true
    set line [$parse_info getLine]

    # Skip the bracket
    feedChar
    while {[$parse_info getLen] >= 0} {
................................................................................
    $parse_result setMissing "\["
    $parse_result setMissingLine $line;
    $parse_info setEnd [expr {[$parse_info getIndex] - 1}]
    return true
  }

  #* ==================== parseBrace ===================================== */
::itcl::body Parser::parseBrace {} {
    $parse_info setStart [expr {[$parse_info getIndex] + 1}]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_BRACE"]
    parseSubBrace
#puts "parseBrace![getText]!"
    return true
  }

  #* ==================== parseListBrace ===================================== */
::itcl::body Parser::parseListBrace {} {
    $parse_info setStart [expr {[$parse_info getIndex] + 1}]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_STR"]
    parseSubBrace
#puts "parseListBrace!"
    return true
  }

  #* ==================== parseBracket ===================================== */
::itcl::body Parser::parseBracket {} {
    $parse_info setStart [expr {[$parse_info getIndex] + 1}]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_BRACKET"]
    parseSubBracket
    return true
  }

  # ==================== parseString =====================================
::itcl::body Parser::parseString {} {
#puts "ParseString![$parse_info getCur]![$parse_info getLen]![$parse_info getState] != PARSER_STATE_QUOTE!"
    set is_special_char false ; # used for correct eof handling, if no statement and char is
                                # there i.e. contents of [list] parsing 
    switch [::Parser::Token::token2String [$parse_info getToken]] {
    "TOKEN_WORD_SEP" -
    "TOKEN_WORD_EOL" -
    "TOKEN_WORD_NONE" -
................................................................................
      if {[$parse_info getLen] > 0} {
        feedChar
      }
    }
  }

  # ==================== parseComment ===================================== 
::itcl::body Parser::parseComment {} {
    $parse_info setStart [$parse_info getIndex]
    $parse_info setEnd [$parse_info getStart]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_COMMENT"]
#puts "parseComment![$parse_info getLen]![string range [$parse_info getText] [$parse_info getIndex] [$parse_info getIndex]]!"
    while {$parse_info getLen] > 0} {
#puts "parseComment2!"+parse_info.len+"!"+parse_info.text.charAt(parse_info.index)+"!");
................................................................................
    }
    $parse_info setEnd [$parse_info getIndex]
    return true
  }


# ==================== getText ===================================== 
::itcl::body Parser::getText {} {
  return [string range [$parse_info getText] [$parse_info getStart] [$parse_info getEnd]]
}

# ==================== getToken ===================================== 
::itcl::body Parser::getToken {} {
  return [$parse_info getToken]
}

# ==================== getParseInfo ===================================== 
::itcl::body Parser::getParseInfo {} {
  return $parse_info
}

# ==================== getParseResult ===================================== 
::itcl::body Parser::getParseResult {} {
  return $parse_result
}

# ==================== getEof ===================================== 
::itcl::body Parser::getEof {} {
  return [$parse_info getEof]
}

# ==================== feedCharStart ===================================== 
::itcl::body Parser::feedCharStart {} {
  if {[$parse_info getLen] > 0} {
    feedChar
  } else {
    $parse_info setEof true
  }
  $parse_info setStart [$parse_info getIndex]
}

# ==================== feedChar ===================================== 
::itcl::body Parser::feedChar {} {
  $parse_info setIndex [expr {[$parse_info getIndex] + 1}]
  $parse_info setLen [expr {[$parse_info getLen] -1}]
  if {[$parse_info getLen] < 0} {
#      throw new PanicException("End of file reached");
    puts stderr "PANIC! End of file reached"
  }
  $parse_info setCur [string range [$parse_info getText] [$parse_info getIndex] [$parse_info getIndex]]
puts "FDCH![$parse_info getLen]![$parse_info getIndex]![$parse_info getCur]![$parse_info getText]!"
}

}







|







 







|






|

|
|









|




|







 







|







 







|







 







|







 







|


|







 







|







 







|







 







|









|









|








|







 







|







 







|




|




|




|




|




|









|











10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
..
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
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
...
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
...
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
...
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
...
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
# * (Tcl BSD license found at <http://www.tcl.tk/software/tcltk/license.html>)
# *
# * Copyright 2012 Arnulf P. Wiedemann
#=====================================================

namespace eval ::Parser {

::itcl::class Parse {
  public common oid 0
  private common LC "\{"
  private common RC "\}"
  private common LB "\["
  private common RB "\]"
  public variable debug
  public variable no_exp_parsing
................................................................................
  public method getParseInfo {}
  public method getParseResult {}
  public method getEof {}
  private method feedCharStart {}
  private method feedChar {}
}

::itcl::body Parse::constructor {args} {
   set debug 0
   set no_exp_parsing false
   set parse_info ""
   set parse_result ""
 }

::itcl::body Parse::parserInit {code len line_no} {
puts "parserInit!"
    set parse_info [uplevel #0 [list ::Parser::ParseInfo #auto $code $len $line_no]]
    set parse_result [uplevel #0 ::Parser::ParseResult #auto]
    $parse_info setCur "\n"
    if {$len > 0} {
      feedCharStart
    } else {
      $parse_info setEof true
    }
    return true
}

::itcl::body Parse::isEof {} {
  return [$parse_info getEof]
}

# =============================== parseScript ==================================
::itcl::body Parse::parseScript {} {
puts "parseScript![$parse_info getCur]![$parse_info getLen]!"
  while {true} {              # the while is used to reiterate with continue if needed 
    if {[$parse_info getLen] <= 0} {
      if {[$parse_info getCur] == "\""} {
        if {[$parse_info getState] ne [::Parser::Token::string2ParserState "PARSER_STATE_QUOTE"]} {
          $parse_result setMissing "\""
          return false
................................................................................
      return $ret
      }
    }
  }
}

# ==================== parseWordSep ===================================== */
::itcl::body Parse::parseWordSep {} {
  $parse_info setStart [$parse_info getIndex]
  while {([expr {[$parse_info getCur] in [list " " "\t" "\r" "\\"]}]) && ([$parse_info getLen] > 0)} {
    if {[$parse_info getCur] eq "\\"} {
      if {[$parse_info getLen] > 0} {
        if {[string range [$parse_info getText] [expr {[$parse_info getIndex] + 1}] [expr {[$parse_info getIndex] + 1}]] eq "\n"} {
          feedChar
        } else {
................................................................................
    $parse_info setEnd [expr {[$parse_info getIndex] - 1}]
  }
  $parse_info setToken [::Parser::Token::string2Token "TOKEN_WORD_SEP"]
  return true
}

# ==================== parseTagName ===================================== */
::itcl::body Parse::parseTagName {} {
  $parse_info setStart [$parse_info getIndex]
  $parse_info setLine [$parse_info getLineNo]
  $parse_info setToken [::Parser::Token::string2Token "TOKEN_TAG_NAME"]
  feedChar
  while {[$parse_info getLen] > 0} {
    switch [$parse_info getCur] {
    "\{" -
................................................................................
      }
    }
  }
  return true
}

# ==================== parseEol ===================================== 
::itcl::body Parse::parseEol {} {
    $parse_info setStart [$parse_info getIndex]
    $parse_info setLine [$parse_info getLineNo]
#puts "parseEol![$parse_info getIndex]![$parse_info getLen]!"
    while {true} {
#puts "parseEol2![$parse_info getCur]!"
      if {[$parse_info getCur] == "\n"} {
        $parse_info setLineNo [expr {[$parse_info getLineNo] + 1}]
................................................................................
  # ==================== parseSubBrace =====================================
  #*
  #* Parses a braced expression starting at parse.index.
  #*
  #* Positions the parser at the end of the braced expression,
  #* sets parse.end and possibly parse.missing.

::itcl::body Parse::parseSubBrace {} {
    set level 1

#puts "parseSubBrace!"    
    # Skip the brace
    feedChar
    while {[$parse_info getLen] >= 0} {
#puts "parseSubBrace2![$parse_info getCur]![$parse_info getLen]!"
      switch [$parse_info getCur] {
      "\\" {
        if {[$parse_info getLen] > 1} {
................................................................................
  #* Positions the parser at the end of the quoted expression,
  #* sets parse.end and possibly parse.missing.
  #*
  #* Returns the type of the token of the string,
  #* either TOKEN_ESC (if it contains values which need to be [subst]ed)
  #* or TOKEN_QUOTE.

::itcl::body Parse::parseSubQuote {} {
    set token "TOKEN_QUOTE"
    set line [$parse_info getLine]

    # Skip the quote 
    if {[$parse_info getLen] > 0} {
      feedChar
    } else {
................................................................................
  #* ==================== parseSubBracket =====================================
  #**
  #* Parses a [string] expression starting at parse.index.
  #*
  #* Positions the parser at the end of the command expression,
  #* sets parse.end and possibly parse.missing.

::itcl::body Parse::parseSubBracket {} {
    set level 1
    set startOfWord true
    set line [$parse_info getLine]

    # Skip the bracket
    feedChar
    while {[$parse_info getLen] >= 0} {
................................................................................
    $parse_result setMissing "\["
    $parse_result setMissingLine $line;
    $parse_info setEnd [expr {[$parse_info getIndex] - 1}]
    return true
  }

  #* ==================== parseBrace ===================================== */
::itcl::body Parse::parseBrace {} {
    $parse_info setStart [expr {[$parse_info getIndex] + 1}]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_BRACE"]
    parseSubBrace
#puts "parseBrace![getText]!"
    return true
  }

  #* ==================== parseListBrace ===================================== */
::itcl::body Parse::parseListBrace {} {
    $parse_info setStart [expr {[$parse_info getIndex] + 1}]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_STR"]
    parseSubBrace
#puts "parseListBrace!"
    return true
  }

  #* ==================== parseBracket ===================================== */
::itcl::body Parse::parseBracket {} {
    $parse_info setStart [expr {[$parse_info getIndex] + 1}]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_BRACKET"]
    parseSubBracket
    return true
  }

  # ==================== parseString =====================================
::itcl::body Parse::parseString {} {
#puts "ParseString![$parse_info getCur]![$parse_info getLen]![$parse_info getState] != PARSER_STATE_QUOTE!"
    set is_special_char false ; # used for correct eof handling, if no statement and char is
                                # there i.e. contents of [list] parsing 
    switch [::Parser::Token::token2String [$parse_info getToken]] {
    "TOKEN_WORD_SEP" -
    "TOKEN_WORD_EOL" -
    "TOKEN_WORD_NONE" -
................................................................................
      if {[$parse_info getLen] > 0} {
        feedChar
      }
    }
  }

  # ==================== parseComment ===================================== 
::itcl::body Parse::parseComment {} {
    $parse_info setStart [$parse_info getIndex]
    $parse_info setEnd [$parse_info getStart]
    $parse_info setLine [$parse_info getLineNo]
    $parse_info setToken [::Parser::Token::string2Token "TOKEN_COMMENT"]
#puts "parseComment![$parse_info getLen]![string range [$parse_info getText] [$parse_info getIndex] [$parse_info getIndex]]!"
    while {$parse_info getLen] > 0} {
#puts "parseComment2!"+parse_info.len+"!"+parse_info.text.charAt(parse_info.index)+"!");
................................................................................
    }
    $parse_info setEnd [$parse_info getIndex]
    return true
  }


# ==================== getText ===================================== 
::itcl::body Parse::getText {} {
  return [string range [$parse_info getText] [$parse_info getStart] [$parse_info getEnd]]
}

# ==================== getToken ===================================== 
::itcl::body Parse::getToken {} {
  return [$parse_info getToken]
}

# ==================== getParseInfo ===================================== 
::itcl::body Parse::getParseInfo {} {
  return $parse_info
}

# ==================== getParseResult ===================================== 
::itcl::body Parse::getParseResult {} {
  return $parse_result
}

# ==================== getEof ===================================== 
::itcl::body Parse::getEof {} {
  return [$parse_info getEof]
}

# ==================== feedCharStart ===================================== 
::itcl::body Parse::feedCharStart {} {
  if {[$parse_info getLen] > 0} {
    feedChar
  } else {
    $parse_info setEof true
  }
  $parse_info setStart [$parse_info getIndex]
}

# ==================== feedChar ===================================== 
::itcl::body Parse::feedChar {} {
  $parse_info setIndex [expr {[$parse_info getIndex] + 1}]
  $parse_info setLen [expr {[$parse_info getLen] -1}]
  if {[$parse_info getLen] < 0} {
#      throw new PanicException("End of file reached");
    puts stderr "PANIC! End of file reached"
  }
  $parse_info setCur [string range [$parse_info getText] [$parse_info getIndex] [$parse_info getIndex]]
puts "FDCH![$parse_info getLen]![$parse_info getIndex]![$parse_info getCur]![$parse_info getText]!"
}

}

Changes to ParseToken.tcl.

24
25
26
27
28
29
30










31
32
33
34
35
36
37
..
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















































  public variable  line
  public variable  text

  constructor {token start end len line text} {}
  public method mySelf {}
  public method toString {}
  public method toDebugString {}










}


  # ==================== ParseToken ================================== 
::itcl::body ParseToken::constructor {ftoken fstart fend flen fline ftext} {
    incr oid
    set id $oid
................................................................................
    set len $flen
    set line $fline
    set text $ftext
  }

  # ==================== mySelf ===================================== 
::itcl::body ParseToken::mySelf {} {
    return ("ParseToken: "+id);
  }

  # ==================== toString ===================================== 
::itcl::body ParseToken::toString {} {
    return "[mySelf]![::Parser::Token::token2String $token]![string range $text $start [expr {$start + len}]]!"
  }

  # ==================== toDebugString ===================================== 
::itcl::body ParseToken::toDebugString {} {
    set str "[mySelf]\n"
    append str "  token: [::Parser::Token::token2String $token]\n"
    append str "  start: $start\n"
    append str "  len:   $len\n"
    append str "  line:  $line\n"
    append str "  str:   [string range $text $start [expr {$start + len}]]\n"
    return $str
}




}























































>
>
>
>
>
>
>
>
>
>







 







|




|









|



>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
..
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
  public variable  line
  public variable  text

  constructor {token start end len line text} {}
  public method mySelf {}
  public method toString {}
  public method toDebugString {}
  public method setToken {val}
  public method getToken {}
  public method setStart {val}
  public method getStart {}
  public method setLen {val}
  public method getLen {}
  public method setLine {val}
  public method getLine {}
  public method setText {val}
  public method getText {}
}


  # ==================== ParseToken ================================== 
::itcl::body ParseToken::constructor {ftoken fstart fend flen fline ftext} {
    incr oid
    set id $oid
................................................................................
    set len $flen
    set line $fline
    set text $ftext
  }

  # ==================== mySelf ===================================== 
::itcl::body ParseToken::mySelf {} {
    return "ParseToken: $id"
  }

  # ==================== toString ===================================== 
::itcl::body ParseToken::toString {} {
    return "[mySelf]![::Parser::Token::token2String $token]![string range $text $start [expr {$start + $len - 1}]]!"
  }

  # ==================== toDebugString ===================================== 
::itcl::body ParseToken::toDebugString {} {
    set str "[mySelf]\n"
    append str "  token: [::Parser::Token::token2String $token]\n"
    append str "  start: $start\n"
    append str "  len:   $len\n"
    append str "  line:  $line\n"
    append str "  str:   [string range $text $start [expr {$start + $len - 1}]]\n"
    return $str
}

  # ==================== setToken ===================================== 
::itcl::body ParseToken::setToken {val} {
    set token $val
}

  # ==================== getToken ===================================== 
::itcl::body ParseToken::getToken {} {
    return $token
}

  # ==================== setStart ===================================== 
::itcl::body ParseToken::setStart {val} {
    set start $val
}

  # ==================== getStart ===================================== 
::itcl::body ParseToken::getStart {} {
    return $start
}

  # ==================== setLen ===================================== 
::itcl::body ParseToken::setLen {val} {
    set len $val
}

  # ==================== getLen ===================================== 
::itcl::body ParseToken::getLen {} {
    return $len
}

  # ==================== setLine ===================================== 
::itcl::body ParseToken::setLine {val} {
    set line $val
}

  # ==================== getLine ===================================== 
::itcl::body ParseToken::getLine {} {
    return $line
}

  # ==================== setText ===================================== 
::itcl::body ParseToken::setText {val} {
    set text $val
}

  # ==================== getText ===================================== 
::itcl::body ParseToken::getText {} {
    return $text
}

}

Changes to Script.tcl.

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
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
...
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
161
162
163
164
165
166
167

168
169
170
171
172
173
174
175
176
177
178
179
...
197
198
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213

214
215
216
217
218
219
220
221
222
223
224

225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256

257
258


259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
300
301
302
303
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
...
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
...
406
407
408
409
410
411
412




413
414
415
  public method countWordTokens {idx}
  public method substObjAddTokens {idx}
  public method dumpToken {idx}
  public method setText {val}
  public method getText {}
  public method setTextLen {val}
  public method getTextLen {}

}

  # ==================== constructor ==================================
::itcl::body Script::constructor {} {
    incr oid
    set id $oid

    set parse_token_list [list]
    set token_idx -1
    set text ""
    set text_len -1
    set script_object [::Parser::ScriptObject #auto]
}

  # ==================== mySelf ==================================
::itcl::body Script::mySelf {} {
    return "Script!$id!"
}

................................................................................
    append str "  token_idx: $token_idx\n"
    append str "  script_object: [$script_object toDebugString]\n");
    return $str
}

  # ==================== tokenIsSep ================================== 
::itcl::body Script::tokenIsSep {token} {
    return ($token >= [::Parser::Token::string2Token "TOKEN_WORD_SEP"] && $token <= [::Parser::Token::string2Token "TOKEN_EOF"])
}

  # ==================== scriptTokenListInit ================================== 
::itcl::body Script::scriptTokenListInit {} {
    set parse_token_list [list]
}

................................................................................
  # ==================== scriptTokenListFree ================================== 
::itcl::body Script::scriptTokenListFree {} {
    set parse_token_list [list]
}

  # ==================== scriptAddParseToken ================================== 
::itcl::body Script::scriptAddParseToken {start len token line text} {
#set str [string range $text $start [expr {$start + $len}]
#puts "Add!$start!$len![::Parser::Token::token2String $token]!$line!$str!"
    set parse_token [::Parser::ParseToken #auto $token $start [expr {$start + $len}] $len $line $text]

#puts "To![::Parser::Token::token2String $token]!$start!"
    lappend parse_token_list $parse_token
}

  # ==================== scriptObjAddTokens ================================== 
  #*
................................................................................
  #*
  #* Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
  #* as required.
  #*
  #* Also sets script.script_object.line to the line number of the first token

::itcl::body Script::scriptObjAddTokens {} {

    set line_args 0    ; # Number of tokens so far for the current command
    set line_first_idx ; # This is the first token for the current command
    set count -1
    set line_no -1
    set debug_script_tokens 0
    set parse_token [list]
    set token_list_idx -1
    set script_token [list]

    if {$debug_script_tokens > 0} {
      puts "======== Tokens ======"
      set i 0
................................................................................
      }
      incr i
    }
    set line_no [[lindex $parse_token_list 0] getLine]
    $script_object setLine $line_no
    $script_object setTokens [list]
    set i 0
    while {$i < count} {
      set script_token [ScriptToken #auto]
      $script_object addTokens $script_token

    }
    set token_idx 0
    # This is the first token for the current command
    set token_list_idx 0
    set line_first_idx token_idx
    incr token_idx
    while {$token_list_idx < [llength $parse_token_list]} {

      # Look ahead to find out how many tokens make up the next word
      set word_tokens 0

      set parse_token [$parse_token_list getToken $token_list_idx]
#print("11["+token_list_idx+"]@"+parse_token.line+" "+script.getTokenString(parse_token_info.token)+" '"+script.text.substring(parse_token_info.start, (parse_token_info.start + parse_token_info.len))+"'");
      # Skip any leading separators 
      while {$parse_token getToken == [::Parse::Token::string2Token "TOKEN_WORD_SEP"]} {
        incr token_list_idx
        set parse_token [$parse_token_list getToken $token_list_idx]
      }
      set word_tokens [countWordTokens $token_list_idx]

      if {$word_tokens == 0} {
        # None, so at end of line
        if {$line_args > 0} {
          set my_token_info [lindex [$script_object getTokens] $line_first_idx]
          $my_token_info setToken [::Parser::Token::string2Token "TOKEN_LINE"]
          $my_token_info setObjPtr [$script_line_obj_type newScriptLineObject $line_args $line_no]
          [$my_token_info getObjPtr] incrRefCount "I_SCRIPT_1"

          # Reset for new line 
          set line_args 0
          set line_first_idx $token_idx
          incr token_idx
        }
        incr token_list_idx
        continue
      } else {
        if {$word_tokens != 1} {
          # More than 1, so insert a WORD token 
          set script_token [$script_object getTokens getToken $token_idx]
          $script_token setToken [::Parser::Token::string2Token "TOKEN_WORD"]
          $script_token setObjPtr [int_obj_type newIntObj $word_tokens]
          [$script_token getObjPtr] incrRefCount("I_SCRIPT_2");
          incr token_idx
        }

        if {$line_args == 0} {
          # First real token on the line, so record the line number
          set line_no [[$parse_token_list getToken $token_list_idx] getLine]
        }
        incr line_args

        # Add each non-separator word token to the line

        while {[incr word_tokens -1] > 0} {
          set parse_token [$parse_token_list getToken $token_list_idx]


          incr token_list_idx
          set script_token [[$script_object getTokens] getToken $token_idx]
          $script_token setToken [$parse_token getToken]
          # put the token info into a new string obj in the bytes part
          $script_token setObjPtr [$script_obj_type makeScriptObj $parse_token $text]
          [$script_token getObjPtr] incrRefCount "I_SCRIPT_3"

          #* Every object is initially a string, but the
          #* internal type may be specialized during execution of the
          #* script.
          #* The bytes part still contains the token info!!
          $source_obj_type setSourceInfo [$script_token getObjPtr] [$script_object getFileNameObj] [$parse_token getLine]
          incr token_idx
        }
      }
    }
    if {line_args == 0} {
      incr token_idx -1
    }

    $script_object setLen $token_idx

    if {$debug_script_tokens > 0} {
      set fname [$script_object getFileNameObj]
      puts "======== Script ($fname) ======"
      set i 0
      while {$i < $token_idx} {
        set script_token [lindex [$script_object getTokens] $i];
        if {$debug_script_tokens > 1} {
          puts "\[$i\]@![$script_token toDebugString]!"
        }else {
          puts "\[$i\]@![$script_token.toString]"
        }
#        print("["+i+"]@"+getTokenString(token_info.token)+"!"+script.interp.string_obj_type.getString(token_info.obj_ptr)+"!");

      }
      puts "======== Script END ======"
    }
    panic "[$script_object getLen] > $count scriptObjAddTokens: script.len > count: [$script_object getLen]!$count"
}

  # ==================== getSubText ================================== 
::itcl::body Script::getSubText {start_idx len} {
    return [string range $text $start_idx [expr {$start_idx + len}]]
}

................................................................................
  #* Returns -ve if the first token is the expansion
  #* operator (in which case the count doesn't include
  #* that token).

::itcl::body Script::countWordTokens {idx} {
    set count 0

    set parse_token [$parse_token_list getToken $idx]
    # Now count non-separator words
    while {![tokenIsSep [$parse_token getToken]]} {
      incr idx
      set parse_token [$parse_token_list getToken $idx]
      incr count
    }
    return $count
}

  # ==================== substObjAddTokens ==================================
::itcl::body Script::substObjAddTokens {idx} {
................................................................................
    }
}

  # ==================== dumpToken ==================================
::itcl::body Script::dumpToken {idx} {
    set script_token [[$script_object getTokens] getToken $idx]

#    puts "TOK \[$idx\]@[::Parser::Token::token2String [$token_info getToken]]![$string_obj_type getString [$token_info getObjPtr]]!"
    puts "TOK \[$idx\]@![$script_token toString]!"
}

  # ==================== setText ==================================
::itcl::body Script::setText {val} {
    set text $val
}
................................................................................
::itcl::body Script::setTextLen {val} {
    set text_len $val
}

  # ==================== getTextLen ==================================
::itcl::body Script::getTextLen {} {
    return $text_len




}

}







>











|







 







|







 







|

|







 







>
|
|


|







 







|
|
|
>




|


>



|
|

|

|


>





|












|

|
|





|




>
|
<
>
>

|


|






|




|






|






|
|


>



|







 







|



|







 







|







 







>
>
>
>



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
...
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
...
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
...
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
...
414
415
416
417
418
419
420
421
422
423
424
425
426
427
  public method countWordTokens {idx}
  public method substObjAddTokens {idx}
  public method dumpToken {idx}
  public method setText {val}
  public method getText {}
  public method setTextLen {val}
  public method getTextLen {}
  public method getScriptObject {}
}

  # ==================== constructor ==================================
::itcl::body Script::constructor {} {
    incr oid
    set id $oid

    set parse_token_list [list]
    set token_idx -1
    set text ""
    set text_len -1
    set script_object [uplevel #0 ::Parser::ScriptObject #auto]
}

  # ==================== mySelf ==================================
::itcl::body Script::mySelf {} {
    return "Script!$id!"
}

................................................................................
    append str "  token_idx: $token_idx\n"
    append str "  script_object: [$script_object toDebugString]\n");
    return $str
}

  # ==================== tokenIsSep ================================== 
::itcl::body Script::tokenIsSep {token} {
    return [expr {$token >= [::Parser::Token::string2Token "TOKEN_WORD_SEP"] && $token <= [::Parser::Token::string2Token "TOKEN_EOF"]}]
}

  # ==================== scriptTokenListInit ================================== 
::itcl::body Script::scriptTokenListInit {} {
    set parse_token_list [list]
}

................................................................................
  # ==================== scriptTokenListFree ================================== 
::itcl::body Script::scriptTokenListFree {} {
    set parse_token_list [list]
}

  # ==================== scriptAddParseToken ================================== 
::itcl::body Script::scriptAddParseToken {start len token line text} {
#set str [string range $text $start [expr {$start + $len}]]
#puts "Add!$start!$len![::Parser::Token::token2String $token]!$line!$str!"
    set parse_token [uplevel #0 [list ::Parser::ParseToken #auto $token $start [expr {$start + $len}] $len $line $text]]

#puts "To![::Parser::Token::token2String $token]!$start!"
    lappend parse_token_list $parse_token
}

  # ==================== scriptObjAddTokens ================================== 
  #*
................................................................................
  #*
  #* Unnecessary tokens are discarded, and LINE and WORD tokens are inserted
  #* as required.
  #*
  #* Also sets script.script_object.line to the line number of the first token

::itcl::body Script::scriptObjAddTokens {} {
puts "scriptObjAddTokens!"
    set line_args 0      ; # Number of tokens so far for the current command
    set line_first_idx 0 ; # This is the first token for the current command
    set count -1
    set line_no -1
    set debug_script_tokens 1
    set parse_token [list]
    set token_list_idx -1
    set script_token [list]

    if {$debug_script_tokens > 0} {
      puts "======== Tokens ======"
      set i 0
................................................................................
      }
      incr i
    }
    set line_no [[lindex $parse_token_list 0] getLine]
    $script_object setLine $line_no
    $script_object setTokens [list]
    set i 0
    while {$i < $count} {
      set script_token [uplevel 0 ::Parser::ScriptToken #auto]
      $script_object addToken $script_token
      incr i
    }
    set token_idx 0
    # This is the first token for the current command
    set token_list_idx 0
    set line_first_idx $token_idx
    incr token_idx
    while {$token_list_idx < [llength $parse_token_list]} {
puts "token_list_idx!$token_list_idx![llength $parse_token_list]!"
      # Look ahead to find out how many tokens make up the next word
      set word_tokens 0

      set parse_token [lindex $parse_token_list $token_list_idx]
#puts "11\[$token_list_idx\]@[$parse_token getLine] [$script getTokenString [$parse_token_info getToken]] '[string range [$script getText] [$parse_token_info getStart] ([expr {[$parse_token_info getStart] + [$parse_token_info getLen]}])]'"
      # Skip any leading separators 
      while {[$parse_token getToken] == [::Parser::Token::string2Token "TOKEN_WORD_SEP"]} {
        incr token_list_idx
        set parse_token [lindex $parse_token_list $token_list_idx]
      }
      set word_tokens [countWordTokens $token_list_idx]
puts "word_tokens!$word_tokens!"
      if {$word_tokens == 0} {
        # None, so at end of line
        if {$line_args > 0} {
          set my_token_info [lindex [$script_object getTokens] $line_first_idx]
          $my_token_info setToken [::Parser::Token::string2Token "TOKEN_LINE"]
          $my_token_info setObjPtr [$::Interp::script_line_obj_type newScriptLineObject $line_args $line_no]
          [$my_token_info getObjPtr] incrRefCount "I_SCRIPT_1"

          # Reset for new line 
          set line_args 0
          set line_first_idx $token_idx
          incr token_idx
        }
        incr token_list_idx
        continue
      } else {
        if {$word_tokens != 1} {
          # More than 1, so insert a WORD token 
          set script_token [lindex [$script_object getTokens] $token_idx]
          $script_token setToken [::Parser::Token::string2Token "TOKEN_WORD"]
          $script_token setObjPtr [$::Interp::int_obj_type newIntObj $word_tokens]
          [$script_token getObjPtr] incrRefCount "I_SCRIPT_2"
          incr token_idx
        }

        if {$line_args == 0} {
          # First real token on the line, so record the line number
          set line_no [[lindex $parse_token_list $token_list_idx] getLine]
        }
        incr line_args

        # Add each non-separator word token to the line
        while {$word_tokens > 0} {
          incr word_tokens -1

puts "word_tokens!$word_tokens!"
          set parse_token [lindex $parse_token_list $token_list_idx]
          incr token_list_idx
          set script_token [lindex [$script_object getTokens] $token_idx]
          $script_token setToken [$parse_token getToken]
          # put the token info into a new string obj in the bytes part
          $script_token setObjPtr [$::Interp::script_obj_type makeScriptObj $parse_token $text]
          [$script_token getObjPtr] incrRefCount "I_SCRIPT_3"

          #* Every object is initially a string, but the
          #* internal type may be specialized during execution of the
          #* script.
          #* The bytes part still contains the token info!!
          $::Interp::source_obj_type setSourceInfo [$script_token getObjPtr] [$script_object getFileNameObj] [$parse_token getLine]
          incr token_idx
        }
      }
    }
    if {$line_args == 0} {
      incr token_idx -1
    }

    $script_object setLen $token_idx

    if {$debug_script_tokens > 0} {
      set fname [[$script_object getFileNameObj] getString]
      puts "======== Script ($fname) ======"
      set i 0
      while {$i < $token_idx} {
        set script_token [lindex [$script_object getTokens] $i];
        if {$debug_script_tokens > 1} {
          puts "\[$i\]@![$script_token toDebugString]!"
        } else {
          puts "\[$i\]@![$script_token toString]"
        }
#        print("["+i+"]@"+getTokenString(token_info.token)+"!"+script.interp.string_obj_type.getString(token_info.obj_ptr)+"!");
	incr i
      }
      puts "======== Script END ======"
    }
    ::Interp::panic [expr {[$script_object getLen] > $count}] "scriptObjAddTokens: script.len > count: [$script_object getLen]!$count"
}

  # ==================== getSubText ================================== 
::itcl::body Script::getSubText {start_idx len} {
    return [string range $text $start_idx [expr {$start_idx + len}]]
}

................................................................................
  #* Returns -ve if the first token is the expansion
  #* operator (in which case the count doesn't include
  #* that token).

::itcl::body Script::countWordTokens {idx} {
    set count 0

    set parse_token [lindex $parse_token_list $idx]
    # Now count non-separator words
    while {![tokenIsSep [$parse_token getToken]]} {
      incr idx
      set parse_token [lindex $parse_token_list $idx]
      incr count
    }
    return $count
}

  # ==================== substObjAddTokens ==================================
::itcl::body Script::substObjAddTokens {idx} {
................................................................................
    }
}

  # ==================== dumpToken ==================================
::itcl::body Script::dumpToken {idx} {
    set script_token [[$script_object getTokens] getToken $idx]

#    puts "TOK \[$idx\]@[::Parser::Token::token2String [$token_info getToken]]![$::Interp::string_obj_type getString [$token_info getObjPtr]]!"
    puts "TOK \[$idx\]@![$script_token toString]!"
}

  # ==================== setText ==================================
::itcl::body Script::setText {val} {
    set text $val
}
................................................................................
::itcl::body Script::setTextLen {val} {
    set text_len $val
}

  # ==================== getTextLen ==================================
::itcl::body Script::getTextLen {} {
    return $text_len
}
  # ==================== getScriptObject ==================================
::itcl::body Script::getScriptObject {} {
    return $script_object
}

}

Changes to ScriptLineObjType.tcl.

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

  # ==================== newScriptLineObject ==================================
::itcl::body ScriptLineObjType::newScriptLineObject {argc line} {
    set debug_script 1
    set obj_ptr [list]

    if {$debug_script > 0} {
      set str "line=$line, argc=argc"
      set obj_ptr [$string_obj_type newStringObj $str -1 "SCRIPT_LINE_OBJ_TYPE_1"]
    } else {
      set obj_ptr [$string_obj_type newEmptyStringObj "SCRIPT_LINE_OBJ_TYPE_2"]
    }
    $obj_ptr setObjType OBJ_TYPE_SCRIPT_LINE
    $obj_ptr scriptLineValue_SetArgc $argc
    $obj_ptr scriptLineValue_SetLine $line

    return $obj_ptr
  }

}








|
|

|










58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

  # ==================== newScriptLineObject ==================================
::itcl::body ScriptLineObjType::newScriptLineObject {argc line} {
    set debug_script 1
    set obj_ptr [list]

    if {$debug_script > 0} {
      set str "line=$line, argc=$argc"
      set obj_ptr [$::Interp::string_obj_type newStringObj $str -1 "SCRIPT_LINE_OBJ_TYPE_1"]
    } else {
      set obj_ptr [$::Interp::string_obj_type newEmptyStringObj "SCRIPT_LINE_OBJ_TYPE_2"]
    }
    $obj_ptr setObjType OBJ_TYPE_SCRIPT_LINE
    $obj_ptr scriptLineValue_SetArgc $argc
    $obj_ptr scriptLineValue_SetLine $line

    return $obj_ptr
  }

}

Changes to ScriptObjType.tcl.

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
..
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
...
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
...
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
::itcl::body ScriptObjType::toDebugString {} {
    set str "[mySelf]\n"
    return $str
  }

  # ==================== setFromAny ==================================
::itcl::body ScriptObjType::setFromAny {obj_ptr flags} {
    set script [::Parser::Script #auto]
    set line 1
    set parser [::parser::Parse #auto]

#puts "script sFA1!"
    $script setText [$string_obj_type getString $obj_ptr]
    $script setTextLen [$string_obj_type getStringLength $obj_ptr]

#puts "sFA1a![$script getText]!"
    # Try to get information about filename / line number
    if {[$obj_ptr getObjType] != 0 && [$obj_ptr getObjType] == OBJ_TYPE_SOURCE} {
      set line [$obj_ptr SourceValue_GetLineNumber]
    }

    # Initially parse the script into tokens (in tokenlist) 
    $script scriptTokenListInit

#puts "script sFA2!"
................................................................................
      # FIXME should check ret code here !!!
      if {$ret != true} {
      }
#puts "txt![$parser getText]!");
      $script scriptAddParseToken [[$parser getParseInfo] getStart] [expr {[[$parser getParseInfo] getEnd] - [[$parser getParseInfo] getStart] + 1}] [[$parser getParseInfo] getToken] [[$parser getParseInfo] getLine] [[$parser getParseInfo] getText]
    }
#puts "script sFA3!");
    if {[$parser getParseResult] getMissing] != " "} {
      $script scriptTokenListFree
      return false
    }

    # Add a final EOF token 
    $script scriptAddParseToken [$script getTextLen] 0 "TOKEN_EOF" 0 [$script getText]

#puts "script sFA4!"
    # Create the "real" script tokens from the initial token list
    [$script getScriptObject] setRefCount 1
    [$script getScriptObject] setLine $line
    if {[$obj_ptr getObjType] != 0 && [$obj_ptr getObjType] == "OBJ_TYPE_SOURCE"} {
      [$script getScriptObject] setFileNameObj [$obj_ptr sourceValue_GetFileNameObj]
    } else {
      [$script getScriptObject] setFileNameObj $empty_string_obj]
    }
    [[$script getScriptObject] getFileNameObj] incrRefCount "I_SCRIPT_OBJ_TYPE_1"
#puts "script sFA5!"
    $script scriptObjAddTokens
    # No longer need the token list
#puts "script sFA6!"
    $script scriptTokenListFree
    # Free the old internal rep and set the new one.
    $obj_ptr freeIntRep
if {$debug != 0} {
    puts "SetFromAny!obj_type![getObjTypeString [$obj_ptr getObjType]]!"
}
    $obj_ptr setObjType OBJ_TYPE_SCRIPT
    $obj_ptr scriptValue_SetScript $script
    return true
  }

  # ==================== freeInternalRep =====================================
::itcl::body ScriptObjType::freeInternalRep {obj_ptr} {
    puts "script freeInternalRep not yet implemented"
................................................................................
::itcl::body ScriptObjType::dupInternalRep {src_ptr dup_ptr} {
    puts "script dupInternalRep not yet implemented"
  }

  # ==================== makeScriptObj ==================================
::itcl::body ScriptObjType::makeScriptObj {parse_token text} {
    set obj_ptr ""
    set idx [string index [string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]] "\\"]
    if {$idx > 0} {
      set have_backslash true
    } else {
      set have_backslash true
    }

#puts "HAVEBSL!$have_backslash![string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]i]!"
    if {([$parse_token getToken] == [::Parser::Token::string2Token "TOKEN_ESC"] || [$parse_token getToken] == [::Parser::Token::string2Token "TOKEN_QUOTE_ESC"]) && $have_backslash} {
      # Convert the backlash escapes 
#puts ("HAVEBSL2!$have_backslash![string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]]!"
      set len [$parse_token getLen]
      set result_str [list]
      set str [string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]];
      set len [$default_obj escapeBackslash $result_str $str $len]
      set str [lindex $result_str 0]
      set obj_ptr [$string_obj_type newStringObjNoAlloc $str $len "SCRIPT_OBJ_TYPE_1"]
    } else {
      # REVISIT: Strictly, TOKEN_STR should replace <backslash><newline><whitespace>
      #         with a single space. This is currently not done.
     
      set obj_ptr [$string_obj_type newStringObj [string range $text [$parse_token getStart] [expr {[$parse_tokengetStart] + [$parse_token getLen]}]] [$parse_token getLen] "SCRIPT_OBJ_TYPE_2"]

    }
    return $obj_ptr;
  }

  # ==================== getScript ================================== 
::itcl::body ScriptObjType::getScript {obj_ptr} {
    set script_flags 0
    if {[$obj_ptr getObjType] == OBJ_TYPE_SCRIPT} {
      set script [$obj_ptr scriptValue_GetScript]
      set script_flags [[$script getScriptObject] getSubstFlags]
    }
    if {[$obj_ptr getObjType] == 0) || ([$obj_ptr getObjType] != OBJ_TYPE_SCRIPT) || ($script_flags != 0)} {
      if {[setFromAny $obj_ptr 0] != true} {
        return [list]
      }
    }
    return [$obj_ptr scriptValue_GetScript]
  }

................................................................................
      had_tokens = true;
    }


    /* Create the "real" subst/script tokens from the initial token list */
    script.script_object.ref_count = 1;
    script.script_object.subst_flags = flags;
    script.script_object.file_name_obj = interp.empty_string_obj;
    script.script_object.file_name_obj.incrRefCount("I_SCRIPT_OBJ_TYPE_2");
    script.substObjAddTokens(0);

    /* No longer need the token list */
    script.scriptTokenListFree();

    /* Free the old internal rep and set the new one. */
    obj_ptr.freeIntRep();
    obj_ptr.setIntRepPtr(script);
    obj_ptr.obj_type = OBJ_TYPE_SCRIPT;
    return OK;
  }

  # ==================== getSubst ==================================
::itcl::body ScriptObjType::getSubst {obj_ptr flags} {
    int script_flags = 0;
    if (obj_ptr.obj_type == OBJ_TYPE_SCRIPT) {
      Script script = obj_ptr.scriptValue_GetScript();
      script_flags = script.script_object.subst_flags;
    }
    if ((obj_ptr.obj_type != OBJ_TYPE_SCRIPT) || (script_flags != flags)) {
      substSetFromAny(obj_ptr, flags);
    }
    return (Script)obj_ptr.getIntRepPtr();
}

  # ==================== substObj ================================== */
  # Performs commands,variables,blackslashes substitution,







|

|


|
|



|







 







|





|





|


|












|







 







|













|
|
|




|








|



|







 







|




|


|
|
|






|



|







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
..
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
...
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
...
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
::itcl::body ScriptObjType::toDebugString {} {
    set str "[mySelf]\n"
    return $str
  }

  # ==================== setFromAny ==================================
::itcl::body ScriptObjType::setFromAny {obj_ptr flags} {
    set script [uplevel #0 ::Parser::Script #auto]
    set line 1
    set parser [uplevel #0 ::Parser::Parse #auto]

#puts "script sFA1!"
    $script setText [$::Interp::string_obj_type getString $obj_ptr]
    $script setTextLen [$::Interp::string_obj_type getStringLength $obj_ptr]

#puts "sFA1a![$script getText]!"
    # Try to get information about filename / line number
    if {[$obj_ptr getObjType] != 0 && [$obj_ptr getObjType] == [::Interp::string2ObjType OBJ_TYPE_SOURCE]} {
      set line [$obj_ptr SourceValue_GetLineNumber]
    }

    # Initially parse the script into tokens (in tokenlist) 
    $script scriptTokenListInit

#puts "script sFA2!"
................................................................................
      # FIXME should check ret code here !!!
      if {$ret != true} {
      }
#puts "txt![$parser getText]!");
      $script scriptAddParseToken [[$parser getParseInfo] getStart] [expr {[[$parser getParseInfo] getEnd] - [[$parser getParseInfo] getStart] + 1}] [[$parser getParseInfo] getToken] [[$parser getParseInfo] getLine] [[$parser getParseInfo] getText]
    }
#puts "script sFA3!");
    if {[[$parser getParseResult] getMissing] != " "} {
      $script scriptTokenListFree
      return false
    }

    # Add a final EOF token 
    $script scriptAddParseToken [$script getTextLen] 0 [::Parser::Token::string2Token TOKEN_EOF] 0 [$script getText]

#puts "script sFA4!"
    # Create the "real" script tokens from the initial token list
    [$script getScriptObject] setRefCount 1
    [$script getScriptObject] setLine $line
    if {[$obj_ptr getObjType] != 0 && [$obj_ptr getObjType] == [::Interp::string2ObjType OBJ_TYPE_SOURCE]} {
      [$script getScriptObject] setFileNameObj [$obj_ptr sourceValue_GetFileNameObj]
    } else {
      [$script getScriptObject] setFileNameObj $::Interp::empty_string_obj
    }
    [[$script getScriptObject] getFileNameObj] incrRefCount "I_SCRIPT_OBJ_TYPE_1"
#puts "script sFA5!"
    $script scriptObjAddTokens
    # No longer need the token list
#puts "script sFA6!"
    $script scriptTokenListFree
    # Free the old internal rep and set the new one.
    $obj_ptr freeIntRep
if {$debug != 0} {
    puts "SetFromAny!obj_type![getObjTypeString [$obj_ptr getObjType]]!"
}
    $obj_ptr setObjType [::Interp::string2ObjType OBJ_TYPE_SCRIPT]
    $obj_ptr scriptValue_SetScript $script
    return true
  }

  # ==================== freeInternalRep =====================================
::itcl::body ScriptObjType::freeInternalRep {obj_ptr} {
    puts "script freeInternalRep not yet implemented"
................................................................................
::itcl::body ScriptObjType::dupInternalRep {src_ptr dup_ptr} {
    puts "script dupInternalRep not yet implemented"
  }

  # ==================== makeScriptObj ==================================
::itcl::body ScriptObjType::makeScriptObj {parse_token text} {
    set obj_ptr ""
    set idx [string first [string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]] "\\"]
    if {$idx > 0} {
      set have_backslash true
    } else {
      set have_backslash true
    }

#puts "HAVEBSL!$have_backslash![string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]i]!"
    if {([$parse_token getToken] == [::Parser::Token::string2Token "TOKEN_ESC"] || [$parse_token getToken] == [::Parser::Token::string2Token "TOKEN_QUOTE_ESC"]) && $have_backslash} {
      # Convert the backlash escapes 
#puts ("HAVEBSL2!$have_backslash![string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]]!"
      set len [$parse_token getLen]
      set result_str [list]
      set str [string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]];
#      set len [$::Interp::default_obj escapeBackslash $result_str $str $len]
#      set str [lindex $result_str 0]
      set obj_ptr [$::Interp::string_obj_type newStringObjNoAlloc $str $len "SCRIPT_OBJ_TYPE_1"]
    } else {
      # REVISIT: Strictly, TOKEN_STR should replace <backslash><newline><whitespace>
      #         with a single space. This is currently not done.
     
      set obj_ptr [$::Interp::string_obj_type newStringObj [string range $text [$parse_token getStart] [expr {[$parse_token getStart] + [$parse_token getLen]}]] [$parse_token getLen] "SCRIPT_OBJ_TYPE_2"]

    }
    return $obj_ptr;
  }

  # ==================== getScript ================================== 
::itcl::body ScriptObjType::getScript {obj_ptr} {
    set script_flags 0
    if {[$obj_ptr getObjType] == [::Interp::string2ObjType OBJ_TYPE_SCRIPT]} {
      set script [$obj_ptr scriptValue_GetScript]
      set script_flags [[$script getScriptObject] getSubstFlags]
    }
    if {([$obj_ptr getObjType] == 0) || ([$obj_ptr getObjType] != [::interp::string2ObjType OBJ_TYPE_SCRIPT]) || ($script_flags != 0)} {
      if {[setFromAny $obj_ptr 0] != true} {
        return [list]
      }
    }
    return [$obj_ptr scriptValue_GetScript]
  }

................................................................................
      had_tokens = true;
    }


    /* Create the "real" subst/script tokens from the initial token list */
    script.script_object.ref_count = 1;
    script.script_object.subst_flags = flags;
    script.script_object.file_name_obj = $::Interp::empty_string_obj;
    script.script_object.file_name_obj.incrRefCount("I_SCRIPT_OBJ_TYPE_2");
    script.substObjAddTokens(0);

    /* No longer need the token list */
    script.scriptTokenListFree()

    /* Free the old internal rep and set the new one. */
    obj_ptr.freeIntRep()
    obj_ptr.setIntRepPtr(script)
    obj_ptr.obj_type = [::interp::string2ObjType OBJ_TYPE_SCRIPT]
    return OK;
  }

  # ==================== getSubst ==================================
::itcl::body ScriptObjType::getSubst {obj_ptr flags} {
    int script_flags = 0;
    if {[$obj_ptr getObjType] == [::Interp::string2ObjType OBJ_TYPE_SCRIPT]} {
      Script script = obj_ptr.scriptValue_GetScript();
      script_flags = script.script_object.subst_flags;
    }
    if (([$obj_ptr getObjType] != [::Interp::string2ObjType OBJ_TYPE_SCRIPT]) || (script_flags != flags)) {
      substSetFromAny(obj_ptr, flags);
    }
    return (Script)obj_ptr.getIntRepPtr();
}

  # ==================== substObj ================================== */
  # Performs commands,variables,blackslashes substitution,

Changes to ScriptObject.tcl.

27
28
29
30
31
32
33













34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
63
64
65
66
67
68
69
70



71
72






























































  public variable file_name_obj
  public variable line        ; # Line number of the first line

  constructor {} {}
  public method mySelf {}
  public method toString {}
  public method toDebugString {}













}

  # ==================== ScriptObject ================================== 
::itcl::body ScriptObject::constructor {} {
    incr oid
    set id $oid

    set len = -1;
    set tokens [list];
    set subst_flags 0
    set ref_count 0
    set file_name_obj [list]
    set line -1
}

  # ==================== mySelf ==================================
................................................................................
    set i 0
    foreach token $tokens {
      append str "  i: $i [[lindex $tokens $i] toDebugString]\n"
      incr i
    }
    return $str
  }




}






































































>
>
>
>
>
>
>
>
>
>
>
>
>







|
|







 








>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
..
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
  public variable file_name_obj
  public variable line        ; # Line number of the first line

  constructor {} {}
  public method mySelf {}
  public method toString {}
  public method toDebugString {}
  public method setRefCount {val}
  public method getRefCount {}
  public method setLine {val}
  public method getLine {}
  public method setFileNameObj {val}
  public method getFileNameObj {}
  public method setLen {val}
  public method getLen {}
  public method setSubstFlags {val}
  public method getSubstFlags {}
  public method setTokens {val}
  public method getTokens {}
  public method addToken {val}
}

  # ==================== ScriptObject ================================== 
::itcl::body ScriptObject::constructor {} {
    incr oid
    set id $oid

    set len -1
    set tokens [list]
    set subst_flags 0
    set ref_count 0
    set file_name_obj [list]
    set line -1
}

  # ==================== mySelf ==================================
................................................................................
    set i 0
    foreach token $tokens {
      append str "  i: $i [[lindex $tokens $i] toDebugString]\n"
      incr i
    }
    return $str
  }

  # ==================== setRefCount ==================================
::itcl::body ScriptObject::setRefCount {val} {
    set ref_count $val
}

  # ==================== getRefCount ==================================
::itcl::body ScriptObject::getRefCount {} {
    return $ref_count
}

  # ==================== setLine ==================================
::itcl::body ScriptObject::setLine {val} {
    set line $val
}

  # ==================== getLine ==================================
::itcl::body ScriptObject::getLine {} {
    return $line
}

  # ==================== setFileNameObj ==================================
::itcl::body ScriptObject::setFileNameObj {val} {
    set file_name_obj $val
}

  # ==================== getFileNameObj ==================================
::itcl::body ScriptObject::getFileNameObj {} {
    return $file_name_obj
}

  # ==================== setLen ==================================
::itcl::body ScriptObject::setLen {val} {
    set len $val
}

  # ==================== getLen ==================================
::itcl::body ScriptObject::getLen {} {
    return $len
}

  # ==================== setSubstFlags ==================================
::itcl::body ScriptObject::setSubstFlags {val} {
    set subst_flags $val
}

  # ==================== getSubstFlags ==================================
::itcl::body ScriptObject::getSubstFlags {} {
    return $subst_flags
}

  # ==================== setTokens ==================================
::itcl::body ScriptObject::setTokens {val} {
    set tokens $val
}

  # ==================== getTokens ==================================
::itcl::body ScriptObject::getTokens {} {
    return $tokens
}

  # ==================== addToken ==================================
::itcl::body ScriptObject::addToken {val} {
    lappend tokens $val
}

}

Changes to ScriptToken.tcl.

21
22
23
24
25
26
27




28
29
30
31
32
33
34
..
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
  public variable token
  public variable obj_ptr

  constructor {} {}
  public method mySelf {}
  public method toDebugString {}
  public method toString {}




}

  # ==================== ScriptToken ================================== 
::itcl::body ScriptToken::constructor {} {
    incr oid
    set id $oid

................................................................................

  # ==================== mySelf ===================================== 
::itcl::body ScriptToken::mySelf {} {
    return "ScriptToken: $id"
}

  # ==================== toString ===================================== 
::itcl::body ScriptToken::toDebugString {} {
    return "[mySelf]![::Parser::Token::token2String $token]![$obj_ptr getString]!"
}

  # ==================== toDebugString ===================================== 
::itcl::body ScriptToken::toDebugString {} {
    set str "[mySelf]\n"
    append str "  token: [::Parser::Token::token2String $token]\n"
................................................................................
    if {$obj_ptr != [list]} {
      append str "  obj_ptr: [$obj_ptr toDebugString]"
    } else {
      append str "  obj_ptr: <null>\n"
    }
    return $str
}





















}








>
>
>
>







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
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
  public variable token
  public variable obj_ptr

  constructor {} {}
  public method mySelf {}
  public method toDebugString {}
  public method toString {}
  public method setToken {val}
  public method getToken {}
  public method setObjPtr {val}
  public method getObjPtr {}
}

  # ==================== ScriptToken ================================== 
::itcl::body ScriptToken::constructor {} {
    incr oid
    set id $oid

................................................................................

  # ==================== mySelf ===================================== 
::itcl::body ScriptToken::mySelf {} {
    return "ScriptToken: $id"
}

  # ==================== toString ===================================== 
::itcl::body ScriptToken::toString {} {
    return "[mySelf]![::Parser::Token::token2String $token]![$obj_ptr getString]!"
}

  # ==================== toDebugString ===================================== 
::itcl::body ScriptToken::toDebugString {} {
    set str "[mySelf]\n"
    append str "  token: [::Parser::Token::token2String $token]\n"
................................................................................
    if {$obj_ptr != [list]} {
      append str "  obj_ptr: [$obj_ptr toDebugString]"
    } else {
      append str "  obj_ptr: <null>\n"
    }
    return $str
}

  # ==================== setToken ===================================== 
::itcl::body ScriptToken::setToken {val} {
    set token $val
}

  # ==================== getToken ===================================== 
::itcl::body ScriptToken::getToken {} {
    return $token
}

  # ==================== setObjPtr ===================================== 
::itcl::body ScriptToken::setObjPtr {val} {
    set obj_ptr $val
}

  # ==================== getObjPtr ===================================== 
::itcl::body ScriptToken::getObjPtr {} {
    return $obj_ptr
}

}

Changes to SourceObjType.tcl.

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
    $dup_ptr sourceValue_SetFileNameObj [$src_ptr sourceValue_GetFileNameObj]
    $dup_ptr sourceValue_SetLineNumber [$src_ptr sourceValue_GetLineNumber]
    [$dup_ptr sourceValue_GetFileNameObj] incrRefCount "I_SOURCE_OBJ_TYPE_1"
  }

  # ==================== setSourceInfo ==================================
::itcl::body SourceObjType::setSourceInfo {obj_ptr file_name_ptr line_number} {
    $obj_ptr panic [$obj_ptr isShared] "setSourceInfo called with shared object"
    $obj_ptr panic ([$obj_ptr getObjType] < 0) "setSourceInfo called with obj_type < 0"
    $file_name_ptr incrRefCount "I_SOURCE_OBJ_TYPE_2"
    $obj_ptr sourceValue_SetFileNameObj $file_name_ptr
    $obj_ptr sourceValue_SetLineNumber $line_number
    $obj_ptr setObjType OBJ_TYPE_SOURCE
  }

}








|
|








68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
    $dup_ptr sourceValue_SetFileNameObj [$src_ptr sourceValue_GetFileNameObj]
    $dup_ptr sourceValue_SetLineNumber [$src_ptr sourceValue_GetLineNumber]
    [$dup_ptr sourceValue_GetFileNameObj] incrRefCount "I_SOURCE_OBJ_TYPE_1"
  }

  # ==================== setSourceInfo ==================================
::itcl::body SourceObjType::setSourceInfo {obj_ptr file_name_ptr line_number} {
    ::Interp::panic [$obj_ptr isShared] "setSourceInfo called with shared object"
    ::Interp::panic [expr {[$obj_ptr getObjType] < 0}] "setSourceInfo called with obj_type < 0"
    $file_name_ptr incrRefCount "I_SOURCE_OBJ_TYPE_2"
    $obj_ptr sourceValue_SetFileNameObj $file_name_ptr
    $obj_ptr sourceValue_SetLineNumber $line_number
    $obj_ptr setObjType OBJ_TYPE_SOURCE
  }

}

Changes to StringObjType.tcl.

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
    if {$len == -1} {
      set len [string length $str]
    }
    $obj_ptr strValue_SetCharLength $len
    $obj_ptr strValue_SetMaxLength $len
    if {$len == 0} {
      $obj_ptr setLen 0
      $obj_ptr setBbytes ""
    } else {
      $obj_ptr setBytes ""
      $obj_ptr setBytes "[$obj_ptr getBytes][string range $str 0 $len]"
      $obj_ptr setLen $len
    }

    # No obj_type field for the vanilla string object. 







|







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
    if {$len == -1} {
      set len [string length $str]
    }
    $obj_ptr strValue_SetCharLength $len
    $obj_ptr strValue_SetMaxLength $len
    if {$len == 0} {
      $obj_ptr setLen 0
      $obj_ptr setBytes ""
    } else {
      $obj_ptr setBytes ""
      $obj_ptr setBytes "[$obj_ptr getBytes][string range $str 0 $len]"
      $obj_ptr setLen $len
    }

    # No obj_type field for the vanilla string object. 

Changes to latex_parse.tcl.

21
22
23
24
25
26
27

28
29
30
31

32
33
34
35
36
37
38
...
342
343
344
345
346
347
348
349
350
351
352




353
354
355
356
357
358
359
...
368
369
370
371
372
373
374

375
376
377
378
379
380
381
source ./Parse.tcl
source ./ParseToken.tcl
source ./ScriptToken.tcl
source ./ScriptObject.tcl
source ./ScriptLineObjType.tcl
source ./SourceObjType.tcl
source ./StringObjType.tcl

source ./LatexObj.tcl
source ./ObjTypeBase.tcl
source ./Script.tcl
source ./ScriptObjType.tcl

source ./Interp.tcl
source ./latex_parse_fcn.tcl
source ./latex_cmds.tcl

global gState
global gCmds
global gPackages
................................................................................
}

buildCmdList $latex_cmds_info

::Parser::Token::Init
::Interp::Init
::LaTeX::CommandInfo::Init
set parser [::Parser::Parser #auto]
set str "\\begin\[pf1\]{document}\n abc \n\\end{document}"
set script [$::Interp::string_obj_type newStringObj "::set dir $::Interp::current_dir\n$str" -1 "BASE_2"]
puts "SCRIPT![$script toDebugString]!"




$parser parserInit $str [string length $str] 1
while {true} {
  if {[$parser isEof]} {
    break
  }
  if {! [$parser parseScript]} {
    puts stderr "Error in parsing!"
................................................................................
puts "is correct tag_name![::Parser::Token::token2String $token]!$commandName!"
    } else {
       puts stderr "bad command name!$commandName!"
    }
  } else {
puts "token![::Parser::Token::token2String $token]!"
  }

}


if {0} {
set gState(inCommand) false
set gCurr(numLines) 0
set gCurr(command) [list]







>




>







 







<



>
>
>
>







 







>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
...
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358
359
360
361
362
363
364
...
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
source ./Parse.tcl
source ./ParseToken.tcl
source ./ScriptToken.tcl
source ./ScriptObject.tcl
source ./ScriptLineObjType.tcl
source ./SourceObjType.tcl
source ./StringObjType.tcl
source ./IntObjType.tcl
source ./LatexObj.tcl
source ./ObjTypeBase.tcl
source ./Script.tcl
source ./ScriptObjType.tcl
source ./EvalStatement.tcl
source ./Interp.tcl
source ./latex_parse_fcn.tcl
source ./latex_cmds.tcl

global gState
global gCmds
global gPackages
................................................................................
}

buildCmdList $latex_cmds_info

::Parser::Token::Init
::Interp::Init
::LaTeX::CommandInfo::Init

set str "\\begin\[pf1\]{document}\n abc \n\\end{document}"
set script [$::Interp::string_obj_type newStringObj "::set dir $::Interp::current_dir\n$str" -1 "BASE_2"]
puts "SCRIPT![$script toDebugString]!"
$::Interp::eval_statement evalObj $script

if {0} {
set parser [::Parser::Parse #auto]
$parser parserInit $str [string length $str] 1
while {true} {
  if {[$parser isEof]} {
    break
  }
  if {! [$parser parseScript]} {
    puts stderr "Error in parsing!"
................................................................................
puts "is correct tag_name![::Parser::Token::token2String $token]!$commandName!"
    } else {
       puts stderr "bad command name!$commandName!"
    }
  } else {
puts "token![::Parser::Token::token2String $token]!"
  }
}
}


if {0} {
set gState(inCommand) false
set gCurr(numLines) 0
set gCurr(command) [list]