Seq # *Modification Id* Act
----------------------------+
00001 M00S00001.tduout +++|*NOSEQ
00002 M00S00002.tduout +++|*WIDTH 95
00003 M00S00003.tduout +++|MODULE tduout;
00004 M00S00004.tduout +++|
00005 M00S00005.tduout +++|?? SET ( CHKALL := ON ), RIGHT := 110 ??
00006 M00S00006.tduout +++|
00007 M00S00007.tduout +++|{ Module : TDUOUT }
| Line S00001 Modification History |
M01 (Added by) | 281l803 |
Seq # *Modification Id* Act
----------------------------+
00008 M01S00001.281l803 +++|{ Copyright Control Data Systems Inc. 1992. }
00009 M00S00008.tduout +++|{ Written: 1/84 by R. Lindsey }
00010 M00S00009.tduout +++|{ Version: Cyber 170, version 1 }
00011 M00S00010.tduout +++|{ Purpose: This is the output portion of the TDU program. }
00012 M00S00011.tduout +++|
00013 M00S00012.tduout +++| ?? PUSH ( LIST := OFF ) ?? { uncomment this line to suppress list }
00014 M00S00013.tduout +++|{ ?? PUSH ( LIST := ON ) ?? { uncomment this line to list }
00015 M00S00014.tduout +++|
00016 M00S00015.tduout +++|?? NEWTITLE := 'Utilities' ??
00017 M00S00016.tduout +++|
00018 M00S00017.tduout +++|{ integer to string conversion, ascii to ascii-64 conversion }
00019 M00S00018.tduout +++|*CALLC ZUTPI2S
00020 M00S00019.tduout +++|*CALL ZUTVCTT
00021 M00S00020.tduout +++|
00022 M00S00021.tduout +++|?? OLDTITLE ??
00023 M00S00022.tduout +++|?? NEWTITLE := 'ZTDTTAB' ??
00024 M00S00023.tduout +++|?? SKIP := 4 ??
00025 M00S00024.tduout +++|
00026 M00S00025.tduout +++|{ **************************** }
00027 M00S00026.tduout +++|{ common deck ZTDTTAB follows: }
00028 M00S00027.tduout +++|*CALL ZTDTTAB
00029 M00S00028.tduout +++|
00030 M00S00029.tduout +++|?? OLDTITLE ??
00031 M00S00030.tduout +++|?? NEWTITLE := 'tdu XREF''s, etc.' ??
00032 M00S00031.tduout +++|?? EJECT ??
00033 M00S00032.tduout +++|
00034 M00S00033.tduout +++|{ ***************** }
00035 M00S00034.tduout +++|{ tdu file handler: }
00036 M00S00035.tduout +++|*CALL ZTDPFIL
00037 M00S00036.tduout +++|
00038 M00S00037.tduout +++|{ ********************** }
00039 M00S00038.tduout +++|{ error handling routine }
00040 M00S00039.tduout +++|*CALL ZTDPERR
00041 M00S00040.tduout +++|
00042 M00S00041.tduout +++|{ ****************************** }
00043 M00S00042.tduout +++|{ table-handling dump procedures }
00044 M00S00043.tduout +++|*CALLC ZTDPTBD
00045 M00S00044.tduout +++|
00046 M00S00045.tduout +++| ?? EJECT ??
00047 M00S00046.tduout +++| ?? POP ??
00048 M00S00047.tduout +++|
00049 M00S00048.tduout +++| CONST
00050 M00S00049.tduout +++| target_wordsize = 60, { word size of target machine (170) }
00051 M00S00050.tduout +++| target_char_size = 7; { bit size of each character }
00052 M00S00051.tduout +++|
00053 M00S00052.tduout +++| VAR
00054 M00S00053.tduout +++| tdu_version_num: [XREF] INTEGER, { from main program }
00055 M00S00054.tduout +++|
00056 M00S00055.tduout +++| word_number: INTEGER := -1, { pre-decremented word counter }
00057 M00S00056.tduout +++| bits_left_in_word: INTEGER := 0, { bits remaining in word, start empty }
00058 M00S00057.tduout +++|
00059 M00S00058.tduout +++| stringrep_len: INTEGER, { used by all STRINGREP calls }
00060 M00S00059.tduout +++|
00061 M00S00060.tduout +++| parm_record: parameter_record, { terminal non-I/O parameters }
00062 M00S00061.tduout +++| in_node: ^input_node, { input table item }
00063 M00S00062.tduout +++| status: ost$status,
00064 M00S00063.tduout +++|
00065 M00S00064.tduout +++| outrec: PACKED RECORD { output buffer }
00066 M00S00065.tduout +++| CASE line_type: (whole_line, opcode_line, comment_line) OF
00067 M00S00066.tduout +++| = whole_line = { for output--write the whole line }
00068 M00S00067.tduout +++| line_buffer: STRING(72),
00069 M00S00068.tduout +++| = opcode_line = { for 'regular' opcode/param lines }
00070 M00S00069.tduout +++| filler1: STRING(1), { CHAR won't work here }
00071 M00S00070.tduout +++| label: STRING(9), { column 2 }
00072 M00S00071.tduout +++| opcode: STRING(7), { column 11 }
00073 M00S00072.tduout +++| parameters: STRING(20), { column 18, need lots of room here }
00074 M00S00073.tduout +++| comment: STRING(35), { column 38, non-standard, oh well }
00075 M00S00074.tduout +++| = comment_line = { for full-line comments }
00076 M00S00075.tduout +++| comment_indicator: STRING(6), { col. 1 '*' + filler }
00077 M00S00076.tduout +++| comment_text: STRING(66), { column 7, not to line up w/opcode }
00078 M00S00077.tduout +++| CASEND,
00079 M00S00078.tduout +++| RECEND;
00080 M00S00079.tduout +++|
00081 M00S00080.tduout +++| { Subtable labels table }
00082 M00S00081.tduout +++|
00083 M00S00082.tduout +++| CONST
00084 M00S00083.tduout +++| subtable_count = 5, { number of subtables defined }
00085 M00S00084.tduout +++| subtable_input = 1,
00086 M00S00085.tduout +++| subtable_names = 2,
00087 M00S00086.tduout +++| subtable_init = 3,
00088 M00S00087.tduout +++| subtable_appstr = 4,
00089 M00S00088.tduout +++| subtable_end = 5;
00090 M00S00089.tduout +++|
00091 M00S00090.tduout +++| VAR
00092 M00S00091.tduout +++| subtable_index: INTEGER,
00093 M00S00092.tduout +++| subtable_list: [STATIC] PACKED ARRAY [1..subtable_count] OF PACKED RECORD
00094 M00S00093.tduout +++| label: STRING(8), { the label itself }
00095 M00S00094.tduout +++| label_len: 0 .. 8, { significant length of label }
00096 M00S00095.tduout +++| RECEND
00097 M00S00096.tduout +++| := [ ['INPUT', 5],
00098 M00S00097.tduout +++| ['NAMES', 5],
00099 M00S00098.tduout +++| ['INIT', 4],
00100 M00S00099.tduout +++| ['APPSTR', 6],
00101 M00S00100.tduout +++| ['ENDTABL', 7] ];
00102 M00S00101.tduout +++|
00103 M00S00102.tduout +++| ?? NEWTITLE := 'write_tables' ??
00104 M00S00103.tduout +++| ?? EJECT ??
00105 M00S00104.tduout +++|
00106 M00S00105.tduout +++| PROCEDURE [XDCL] write_tables; { this is called to write entire table }
00107 M00S00106.tduout +++|
00108 M00S00107.tduout +++| ?? NEWTITLE := 'write_line' ??
00109 M00S00108.tduout +++| ?? SKIP := 4 ??
00110 M00S00109.tduout +++|
00111 M00S00110.tduout +++| PROCEDURE write_line;
00112 M00S00111.tduout +++| put_file(output_file_sel, outrec.line_buffer);
00113 M00S00112.tduout +++| PROCEND write_line;
00114 M00S00113.tduout +++| ?? OLDTITLE ??
00115 M00S00114.tduout +++|
00116 M00S00115.tduout +++| ?? NEWTITLE := 'write_opcode_line' ??
00117 M00S00116.tduout +++| ?? SKIP := 4 ??
00118 M00S00117.tduout +++|
00119 M00S00118.tduout +++| PROCEDURE write_opcode_line;
00120 M00S00119.tduout +++| outrec.line_type := whole_line;
00121 M00S00120.tduout +++| write_line;
00122 M00S00121.tduout +++| outrec.line_type := opcode_line;
00123 M00S00122.tduout +++| outrec.label := ''; { never want to save a label }
00124 M00S00123.tduout +++| PROCEND write_opcode_line;
00125 M00S00124.tduout +++| ?? OLDTITLE ??
00126 M00S00125.tduout +++|
00127 M00S00126.tduout +++| ?? NEWTITLE := 'write_comment' ??
00128 M00S00127.tduout +++| ?? SKIP := 4 ??
00129 M00S00128.tduout +++|
00130 M00S00129.tduout +++| PROCEDURE write_comment;
00131 M00S00130.tduout +++| outrec.comment_indicator := '*';
00132 M00S00131.tduout +++| outrec.line_type := whole_line;
00133 M00S00132.tduout +++| write_line;
00134 M00S00133.tduout +++| outrec.line_buffer := ''; { always return a blank line }
00135 M00S00134.tduout +++| outrec.line_type := comment_line;
00136 M00S00135.tduout +++| PROCEND write_comment;
00137 M00S00136.tduout +++| ?? OLDTITLE ??
00138 M00S00137.tduout +++|
00139 M00S00138.tduout +++| ?? NEWTITLE := 'write_vfd' ??
00140 M00S00139.tduout +++| ?? EJECT ??
00141 M00S00140.tduout +++|
00142 M00S00141.tduout +++| PROCEDURE write_vfd(bit_length, field_value: INTEGER; commnt: STRING(*));
00143 M00S00142.tduout +++| VAR
00144 M00S00143.tduout +++| temp_string,
00145 M00S00144.tduout +++| bit_length_string,
00146 M00S00145.tduout +++| field_value_string: STRING(4),
00147 M00S00146.tduout +++| bit_l_s_length,
00148 M00S00147.tduout +++| field_v_s_length: ost$string_length; { subrange for string size }
00149 M00S00148.tduout +++|
00150 M00S00149.tduout +++| outrec.opcode := 'VFD';
00151 M00S00150.tduout +++| utp$convert_integer_to_string(bit_length_string, bit_l_s_length,
00152 M00S00151.tduout +++| bit_length, 10);
00153 M00S00152.tduout +++| utp$convert_integer_to_string(field_value_string, field_v_s_length,
00154 M00S00153.tduout +++| field_value, 10);
00155 M00S00154.tduout +++|{ IF field_value = (-0) THEN
00156 M00S00155.tduout +++|{ STRINGREP(temp_string, field_v_s_length,
00157 M00S00156.tduout +++|{ '-', field_value_string(1,field_v_s_length));
00158 M00S00157.tduout +++|{ field_value_string := temp_string
00159 M00S00158.tduout +++|{ IFEND;
00160 M00S00159.tduout +++| outrec.parameters := '';
00161 M00S00160.tduout +++| STRINGREP(outrec.parameters, stringrep_len,
00162 M00S00161.tduout +++| bit_length_string(1,bit_l_s_length),
00163 M00S00162.tduout +++| '/': 1,
00164 M00S00163.tduout +++| field_value_string(1,field_v_s_length));
00165 M00S00164.tduout +++| outrec.comment := commnt;
00166 M00S00165.tduout +++| write_opcode_line;
00167 M00S00166.tduout +++| outrec.comment := '';
00168 M00S00167.tduout +++| bits_left_in_word := bits_left_in_word - bit_length;
00169 M00S00168.tduout +++| PROCEND write_vfd;
00170 M00S00169.tduout +++| ?? OLDTITLE ??
00171 M00S00170.tduout +++|
00172 M00S00171.tduout +++| ?? NEWTITLE := 'start_word_output' ??
00173 M00S00172.tduout +++| ?? EJECT ??
00174 M00S00173.tduout +++|
00175 M00S00174.tduout +++| PROCEDURE start_word_output;
00176 M00S00175.tduout +++| VAR
00177 M00S00176.tduout +++| integer_string: STRING(6),
00178 M00S00177.tduout +++| i_s_length: ost$string_length; { subrange of integer, str-len }
00179 M00S00178.tduout +++|
00180 M00S00179.tduout +++| IF bits_left_in_word < target_wordsize THEN { only if not already word}
00181 M00S00180.tduout +++| word_number := word_number + 1;
00182 M00S00181.tduout +++| bits_left_in_word := target_wordsize;
00183 M00S00182.tduout +++| outrec.line_type := comment_line;
00184 M00S00183.tduout +++| outrec.comment_text := '';
00185 M00S00184.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00186 M00S00185.tduout +++| word_number, 8); { STRINGREP can't do octal (!) }
00187 M00S00186.tduout +++| STRINGREP(outrec.comment_text, stringrep_len, 'WORD ': 5,
00188 M00S00187.tduout +++| integer_string: i_s_length);
00189 M00S00188.tduout +++| write_comment;
00190 M00S00189.tduout +++| IFEND;
00191 M00S00190.tduout +++| PROCEND start_word_output;
00192 M00S00191.tduout +++| ?? OLDTITLE ??
00193 M00S00192.tduout +++|
00194 M00S00193.tduout +++| ?? NEWTITLE := 'write_ordinals' ??
00195 M00S00194.tduout +++| ?? EJECT ??
00196 M00S00195.tduout +++|
00197 M00S00196.tduout +++| PROCEDURE write_ordinals (dump_procedure: dump_procedure_type);
00198 M00S00197.tduout +++| VAR
00199 M00S00198.tduout +++| ordinal_ndx: INTEGER,
00200 M00S00199.tduout +++| length: INTEGER,
00201 M00S00200.tduout +++| chars: ^STRING(*),
00202 M00S00201.tduout +++| total_characters,
00203 M00S00202.tduout +++| total_ordinals: INTEGER,
00204 M00S00203.tduout +++| node_returned: BOOLEAN,
00205 M00S00204.tduout +++| bit_count,
00206 M00S00205.tduout +++| word_count,
00207 M00S00206.tduout +++| remainder,
00208 M00S00207.tduout +++| remainder_chars,
00209 M00S00208.tduout +++| filler_bits,
00210 M00S00209.tduout +++| char_offset: INTEGER,
00211 M00S00210.tduout +++| integer_string: STRING(6),
00212 M00S00211.tduout +++| i_s_length: ost$string_length, { subrange of integer, str-len }
00213 M00S00212.tduout +++| comment: STRING(30);
00214 M00S00213.tduout +++|
00215 M00S00214.tduout +++| dump_procedure^(0, length, chars, total_ordinals, total_characters,
00216 M00S00215.tduout +++| node_returned);
00217 M00S00216.tduout +++| bit_count := ( ( total_ordinals + 2 ) * 12 );
00218 M00S00217.tduout +++| word_count := bit_count DIV 60;
00219 M00S00218.tduout +++| remainder := 60 - ( bit_count MOD 60 );
00220 M00S00219.tduout +++| char_offset := ( word_count * 8 ) + 8 - ( remainder DIV 7 );
00221 M00S00220.tduout +++| ordinal_ndx := 0;
00222 M00S00221.tduout +++| REPEAT
00223 M00S00222.tduout +++| dump_procedure^(ordinal_ndx, length, chars,
00224 M00S00223.tduout +++| total_ordinals, total_characters, node_returned);
00225 M00S00224.tduout +++| IF node_returned THEN
00226 M00S00225.tduout +++| IF bits_left_in_word < 12 THEN
00227 M00S00226.tduout +++| start_word_output
00228 M00S00227.tduout +++| IFEND;
00229 M00S00228.tduout +++| outrec.line_type := opcode_line;
00230 M00S00229.tduout +++| comment := '';
00231 M00S00230.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00232 M00S00231.tduout +++| ordinal_ndx, 10); { ordinal in string format }
00233 M00S00232.tduout +++| STRINGREP(comment, stringrep_len,
00234 M00S00233.tduout +++| 'ORDINAL ': 8, integer_string: i_s_length);
00235 M00S00234.tduout +++| write_vfd(12, char_offset, comment);
00236 M00S00235.tduout +++| char_offset := char_offset + length;
00237 M00S00236.tduout +++| ordinal_ndx := ordinal_ndx + 1
00238 M00S00237.tduout +++| IFEND
00239 M00S00238.tduout +++| UNTIL NOT node_returned;
00240 M00S00239.tduout +++| IF bits_left_in_word < 12 THEN
00241 M00S00240.tduout +++| start_word_output
00242 M00S00241.tduout +++| IFEND;
00243 M00S00242.tduout +++| outrec.line_type := opcode_line;
00244 M00S00243.tduout +++| write_vfd(12, char_offset, 'END OF ORDINALS');
00245 M00S00244.tduout +++| IF bits_left_in_word > 0 THEN
00246 M00S00245.tduout +++| remainder_chars := remainder DIV 7;
00247 M00S00246.tduout +++| filler_bits := remainder - ( remainder_chars * 7 );
00248 M00S00247.tduout +++| write_vfd(filler_bits, 0, 'FILLER')
00249 M00S00248.tduout +++| IFEND
00250 M00S00249.tduout +++| PROCEND write_ordinals;
00251 M00S00250.tduout +++|
00252 M00S00251.tduout +++| ?? OLDTITLE ??
00253 M00S00252.tduout +++| ?? NEWTITLE := 'write_char_sequences' ??
00254 M00S00253.tduout +++| ?? EJECT ??
00255 M00S00254.tduout +++|
00256 M00S00255.tduout +++| PROCEDURE write_char_sequences (dump_procedure: dump_procedure_type);
00257 M00S00256.tduout +++| VAR
00258 M00S00257.tduout +++| ordinal_ndx: INTEGER,
00259 M00S00258.tduout +++| length: INTEGER,
00260 M00S00259.tduout +++| chars: ^STRING(*),
00261 M00S00260.tduout +++| total_characters,
00262 M00S00261.tduout +++| total_ordinals: INTEGER,
00263 M00S00262.tduout +++| node_returned: BOOLEAN,
00264 M00S00263.tduout +++| integer_string: STRING(6),
00265 M00S00264.tduout +++| i_s_length: ost$string_length, { subrange of integer, str-len }
00266 M00S00265.tduout +++| char_ndx: INTEGER,
00267 M00S00266.tduout +++| comment: STRING(30);
00268 M00S00267.tduout +++|
00269 M00S00268.tduout +++| ordinal_ndx := 0;
00270 M00S00269.tduout +++| REPEAT
00271 M00S00270.tduout +++| dump_procedure^(ordinal_ndx, length, chars,
00272 M00S00271.tduout +++| total_ordinals, total_characters, node_returned);
00273 M00S00272.tduout +++| IF node_returned THEN
00274 M00S00273.tduout +++| IF bits_left_in_word = target_wordsize THEN { first word only }
00275 M00S00274.tduout +++| write_vfd(4, 0, 'FILLER');
00276 M00S00275.tduout +++| IFEND;
00277 M00S00276.tduout +++| comment := '';
00278 M00S00277.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00279 M00S00278.tduout +++| ordinal_ndx, 10); { ordinal in string format }
00280 M00S00279.tduout +++| STRINGREP(comment, stringrep_len,
00281 M00S00280.tduout +++| 'ORDINAL ': 8, integer_string: i_s_length);
00282 M00S00281.tduout +++| outrec.line_type := opcode_line;
00283 M00S00282.tduout +++| FOR char_ndx := 1 TO length DO
00284 M00S00283.tduout +++| IF bits_left_in_word < target_char_size THEN
00285 M00S00284.tduout +++| start_word_output;
00286 M00S00285.tduout +++| outrec.line_type := opcode_line;
00287 M00S00286.tduout +++| write_vfd(4, 0, 'FILLER')
00288 M00S00287.tduout +++| IFEND;
00289 M00S00288.tduout +++| write_vfd(target_char_size,
00290 M00S00289.tduout +++| ORD(chars^(char_ndx)), comment);
00291 M00S00290.tduout +++| comment := ''
00292 M00S00291.tduout +++| FOREND;
00293 M00S00292.tduout +++| ordinal_ndx := ordinal_ndx + 1
00294 M00S00293.tduout +++| IFEND
00295 M00S00294.tduout +++| UNTIL NOT node_returned;
00296 M00S00295.tduout +++| IF ( bits_left_in_word > 0 ) AND
00297 M00S00296.tduout +++| ( bits_left_in_word < target_wordsize ) THEN
00298 M00S00297.tduout +++| outrec.line_type := opcode_line;
00299 M00S00298.tduout +++| write_vfd(bits_left_in_word, 0, 'FILLER')
00300 M00S00299.tduout +++| IFEND
00301 M00S00300.tduout +++| PROCEND write_char_sequences;
00302 M00S00301.tduout +++|
00303 M00S00302.tduout +++| ?? OLDTITLE ??
00304 M00S00303.tduout +++|
00305 M00S00304.tduout +++| ?? NEWTITLE := 'write_tab_protect_parms' ??
00306 M00S00305.tduout +++| ?? EJECT ??
00307 M00S00306.tduout +++|
00308 M00S00307.tduout +++| PROCEDURE write_tab_protect_parms;
00309 M00S00308.tduout +++| VAR
00310 M00S00309.tduout +++| resv_ndx: INTEGER,
00311 M00S00310.tduout +++| loop_ndx: INTEGER,
00312 M00S00311.tduout +++| parm_ndx: INTEGER;
00313 M00S00312.tduout +++| loop_ndx := (cursor_behavior_div + 1);
00314 M00S00313.tduout +++|
00315 M00S00314.tduout +++| FOR parm_ndx := loop_ndx TO cursor_behavior_max DO
| Line S00315 Modification History |
M01 (Removed by) | ns2348 |
Seq # *Modification Id* Act
----------------------------+
00316 M01S00315.ns2348 ---| write_vfd(4, ORD(parm_record.cursor_behavior[parm_ndx]),
00317 M01S00316.ns2348 ---| 'CURSOR BEHAVIOR');
| Line S00001 Modification History |
M01 (Added by) | ns2348 |
Seq # *Modification Id* Act
----------------------------+
00318 M01S00001.ns2348 +++| IF (ORD(parm_record.cursor_behavior[parm_ndx]) = -1) THEN
00319 M01S00002.ns2348 +++| write_vfd(4, 0, 'CURSOR BEHAVIOR');
00320 M01S00003.ns2348 +++| ELSE
00321 M01S00004.ns2348 +++| write_vfd(4, ORD(parm_record.cursor_behavior[parm_ndx]),
00322 M01S00005.ns2348 +++| 'CURSOR BEHAVIOR');
00323 M01S00006.ns2348 +++| IFEND;
00324 M00S00317.tduout +++| FOREND;
00325 M00S00318.tduout +++|
00326 M00S00319.tduout +++| resv_ndx := 4 * ((cursor_behavior_max - cursor_behavior_div)- 1);
00327 M00S00320.tduout +++| write_vfd(resv_ndx, 0, 'RESERVED');
00328 M00S00321.tduout +++|
00329 M00S00322.tduout +++| PROCEND write_tab_protect_parms;
00330 M00S00323.tduout +++|
00331 M00S00324.tduout +++| ?? OLDTITLE ??
00332 M00S00325.tduout +++|
00333 M00S00326.tduout +++| ?? NEWTITLE := 'write_header' ??
00334 M00S00327.tduout +++| ?? EJECT ??
00335 M00S00328.tduout +++|
00336 M00S00329.tduout +++| PROCEDURE write_header;
00337 M00S00330.tduout +++| VAR
00338 M00S00331.tduout +++| junk_name: STRING(7),
00339 M00S00332.tduout +++| junk_len: INTEGER;
00340 M00S00333.tduout +++|
00341 M00S00334.tduout +++| dump_parameters(parm_record);
00342 M00S00335.tduout +++| junk_name := ' '; { concatenate 'Z' to start of name }
00343 M00S00336.tduout +++| STRINGREP(junk_name, junk_len, 'Z', { to ensure a valid NOS name }
00344 M00S00337.tduout +++| parm_record.model_name(1,parm_record.model_name_len));
00345 M00S00338.tduout +++| parm_record.model_name := junk_name;
00346 M00S00339.tduout +++| parm_record.model_name_len := junk_len;
00347 M00S00340.tduout +++|
00348 M00S00341.tduout +++| outrec.line_type := opcode_line;
00349 M00S00342.tduout +++| outrec.label := '';
00350 M00S00343.tduout +++| outrec.comment := '';
00351 M00S00344.tduout +++| outrec.opcode := 'IDENT';
00352 M00S00345.tduout +++| outrec.parameters := parm_record.model_name;
00353 M00S00346.tduout +++| write_opcode_line;
00354 M00S00347.tduout +++| outrec.opcode := 'LCC';
00355 M00S00348.tduout +++| outrec.parameters := 'GROUP(VIRTERM)';
00356 M00S00349.tduout +++| write_opcode_line;
00357 M00S00350.tduout +++| outrec.parameters := '';
00358 M00S00351.tduout +++| STRINGREP(outrec.parameters,stringrep_len, 'CAPSULE(':8,
00359 M00S00352.tduout +++| parm_record.model_name(1,parm_record.model_name_len),
00360 M00S00353.tduout +++| ')':1 );
00361 M00S00354.tduout +++| write_opcode_line;
00362 M00S00355.tduout +++| outrec.opcode := 'ENTRY';
00363 M00S00356.tduout +++| outrec.parameters := parm_record.model_name;
00364 M00S00357.tduout +++| write_opcode_line;
00365 M00S00358.tduout +++| start_word_output;
00366 M00S00359.tduout +++| outrec.line_type := opcode_line;
00367 M00S00360.tduout +++| outrec.label := parm_record.model_name;
00368 M00S00361.tduout +++| outrec.opcode := 'BSS';
00369 M00S00362.tduout +++| outrec.parameters := '0';
00370 M00S00363.tduout +++| write_opcode_line;
00371 M00S00364.tduout +++| outrec.line_type := comment_line;
00372 M00S00365.tduout +++| outrec.comment_text := '';
00373 M00S00366.tduout +++| write_comment;
00374 M00S00367.tduout +++| outrec.comment_text := 'HEADER';
00375 M00S00368.tduout +++| write_comment;
00376 M00S00369.tduout +++| write_comment;
00377 M00S00370.tduout +++| outrec.line_type := opcode_line;
00378 M00S00371.tduout +++| outrec.opcode := 'VFD';
00379 M00S00372.tduout +++| outrec.parameters := '';
00380 M00S00373.tduout +++| STRINGREP(outrec.parameters, stringrep_len,
00381 M00S00374.tduout +++| '42/0L': 5,
00382 M00S00375.tduout +++| parm_record.model_name(2,6)); { without leading 'Z' }
00383 M00S00376.tduout +++| write_opcode_line;
00384 M00S00377.tduout +++| bits_left_in_word := bits_left_in_word - 42;
00385 M00S00378.tduout +++| write_vfd(18, tdu_version_num, 'VERSION NUMBER')
00386 M00S00379.tduout +++| PROCEND write_header;
00387 M00S00380.tduout +++| ?? OLDTITLE ??
00388 M00S00381.tduout +++|
00389 M00S00382.tduout +++| ?? NEWTITLE := 'write_sub_table_pointers' ??
00390 M00S00383.tduout +++| ?? EJECT ??
00391 M00S00384.tduout +++|
00392 M00S00385.tduout +++| PROCEDURE write_sub_table_pointers;
00393 M00S00386.tduout +++| outrec.line_type := comment_line;
00394 M00S00387.tduout +++| outrec.comment_text := '';
00395 M00S00388.tduout +++| write_comment;
00396 M00S00389.tduout +++| outrec.comment_text := 'SUB-TABLE POINTERS';
00397 M00S00390.tduout +++| write_comment;
00398 M00S00391.tduout +++| write_comment; { comment_text was automatically blanked}
00399 M00S00392.tduout +++| start_word_output;
00400 M00S00393.tduout +++| FOR subtable_index := 1 TO subtable_count DO
00401 M00S00394.tduout +++| IF bits_left_in_word < 12 THEN
00402 M00S00395.tduout +++| start_word_output;
00403 M00S00396.tduout +++| IFEND;
00404 M00S00397.tduout +++| outrec.line_type := opcode_line;
00405 M00S00398.tduout +++| outrec.opcode := 'VFD';
00406 M00S00399.tduout +++| outrec.parameters := '';
00407 M00S00400.tduout +++| STRINGREP(outrec.parameters, stringrep_len,
00408 M00S00401.tduout +++| '12/',
00409 M00S00402.tduout +++| subtable_list[subtable_index].label:
00410 M00S00403.tduout +++| subtable_list[subtable_index].label_len,
00411 M00S00404.tduout +++| '-',
00412 M00S00405.tduout +++| parm_record.model_name(1,parm_record.model_name_len));
00413 M00S00406.tduout +++| write_opcode_line;
00414 M00S00407.tduout +++| bits_left_in_word := bits_left_in_word - 12;
00415 M00S00408.tduout +++| FOREND;
00416 M00S00409.tduout +++| outrec.line_type := opcode_line;
00417 M00S00410.tduout +++| IF bits_left_in_word > 0 THEN { make explicit filler }
00418 M00S00411.tduout +++| write_vfd(bits_left_in_word, 0, 'RESERVED');
00419 M00S00412.tduout +++| IFEND;
00420 M00S00413.tduout +++| start_word_output;
00421 M00S00414.tduout +++| outrec.line_type := opcode_line;
00422 M00S00415.tduout +++| { write_vfd(target_wordsize, 0, 'RESERVED') }
00423 M00S00416.tduout +++| write_tab_protect_parms;
00424 M00S00417.tduout +++| PROCEND write_sub_table_pointers;
00425 M00S00418.tduout +++| ?? OLDTITLE ??
00426 M00S00419.tduout +++|
00427 M00S00420.tduout +++| ?? NEWTITLE := 'write_parameters' ??
00428 M00S00421.tduout +++| ?? EJECT ??
00429 M00S00422.tduout +++|
00430 M00S00423.tduout +++| PROCEDURE write_parameters;
00431 M00S00424.tduout +++| VAR
00432 M00S00425.tduout +++| parm_ndx: INTEGER;
00433 M00S00426.tduout +++|
00434 M00S00427.tduout +++| outrec.line_type := comment_line;
00435 M00S00428.tduout +++| outrec.comment_text := '';
00436 M00S00429.tduout +++| write_comment;
00437 M00S00430.tduout +++| outrec.comment_text := 'PARAMETERS';
00438 M00S00431.tduout +++| write_comment;
00439 M00S00432.tduout +++| write_comment;
00440 M00S00433.tduout +++| start_word_output;
00441 M00S00434.tduout +++| outrec.line_type := opcode_line;
00442 M00S00435.tduout +++| write_vfd(6, parm_record.cursor_encoding,
00443 M00S00436.tduout +++| 'CURSOR ADDRESSING TYPE');
00444 M00S00437.tduout +++| write_vfd(8, parm_record.cursor_bias, 'CURSOR ADDRESSING BIAS');
00445 M00S00438.tduout +++|
00446 M00S00439.tduout +++| { FOR parm_ndx := 0 TO cursor_behavior_max DO }
00447 M00S00440.tduout +++| FOR parm_ndx := 0 TO cursor_behavior_div DO
00448 M00S00441.tduout +++| write_vfd(4, ORD(parm_record.cursor_behavior[parm_ndx]),
00449 M00S00442.tduout +++| 'CURSOR BEHAVIOR');
00450 M00S00443.tduout +++| FOREND;
00451 M00S00444.tduout +++|
00452 M00S00445.tduout +++| write_vfd(1, ORD(parm_record.cursor_pos_column_flag),
00453 M00S00446.tduout +++| 'COLUMNS BEFORE ROWS FLAG');
00454 M00S00447.tduout +++| FOR parm_ndx := 0 TO 1 DO
00455 M00S00448.tduout +++| write_vfd(3, parm_record.cursor_pos_length[parm_ndx],
00456 M00S00449.tduout +++| 'NUMBER OF DIGITS IN CURSOR POSITION');
00457 M00S00450.tduout +++| FOREND;
00458 M00S00451.tduout +++| write_vfd(bits_left_in_word, 0, 'RESERVED');
00459 M00S00452.tduout +++|
00460 M00S00453.tduout +++| start_word_output;
00461 M00S00454.tduout +++| outrec.line_type := opcode_line;
00462 M00S00455.tduout +++| FOR parm_ndx := 0 TO parm_flag_max DO
00463 M00S00456.tduout +++| write_vfd(1, ORD(parm_record.flag[parm_ndx]), 'FLAG');
00464 M00S00457.tduout +++| FOREND;
00465 M00S00458.tduout +++| write_vfd(3, parm_record.function_key_mark, 'FUNCTION KEY MARK')
00466 M00S00459.tduout +++| PROCEND write_parameters;
00467 M00S00460.tduout +++| ?? OLDTITLE ??
00468 M00S00461.tduout +++|
00469 M00S00462.tduout +++| ?? NEWTITLE := 'write_size_table' ??
00470 M00S00463.tduout +++| ?? EJECT ??
00471 M00S00464.tduout +++|
00472 M00S00465.tduout +++| PROCEDURE write_size_table;
00473 M00S00466.tduout +++| VAR
00474 M00S00467.tduout +++| size_ndx: INTEGER;
00475 M00S00468.tduout +++|
00476 M00S00469.tduout +++| outrec.line_type := comment_line;
00477 M00S00470.tduout +++| outrec.comment_text := '';
00478 M00S00471.tduout +++| write_comment;
00479 M00S00472.tduout +++| outrec.comment_text := 'SCREEN SIZES';
00480 M00S00473.tduout +++| write_comment;
00481 M00S00474.tduout +++| write_comment;
00482 M00S00475.tduout +++| start_word_output;
00483 M00S00476.tduout +++| outrec.line_type := opcode_line;
00484 M00S00477.tduout +++| FOR size_ndx := 0 TO 3 DO
00485 M00S00478.tduout +++| write_vfd(8, parm_record.size[size_ndx].cols, 'X SIZE (COLUMNS)');
00486 M00S00479.tduout +++| write_vfd(7, parm_record.size[size_ndx].rows, 'Y SIZE (ROWS)')
00487 M00S00480.tduout +++| FOREND
00488 M00S00481.tduout +++| PROCEND write_size_table;
00489 M00S00482.tduout +++| ?? OLDTITLE ??
00490 M00S00483.tduout +++|
00491 M00S00484.tduout +++| ?? NEWTITLE := 'write_subtable_start' ??
00492 M00S00485.tduout +++| ?? EJECT ??
00493 M00S00486.tduout +++|
00494 M00S00487.tduout +++| PROCEDURE write_subtable_start;
00495 M00S00488.tduout +++| outrec.line_type := comment_line;
00496 M00S00489.tduout +++| outrec.comment_text := '';
00497 M00S00490.tduout +++| write_comment;
00498 M00S00491.tduout +++| outrec.comment_text := 'START OF SUB-TABLES';
00499 M00S00492.tduout +++| write_comment;
00500 M00S00493.tduout +++| write_comment
00501 M00S00494.tduout +++| PROCEND write_subtable_start;
00502 M00S00495.tduout +++| ?? OLDTITLE ??
00503 M00S00496.tduout +++|
00504 M00S00497.tduout +++| ?? NEWTITLE := 'write_output_table' ??
00505 M00S00498.tduout +++| ?? EJECT ??
00506 M00S00499.tduout +++|
00507 M00S00500.tduout +++| PROCEDURE write_output_table;
00508 M00S00501.tduout +++|
00509 M00S00502.tduout +++| outrec.line_type := comment_line;
00510 M00S00503.tduout +++| outrec.comment_text := '';
00511 M00S00504.tduout +++| write_comment;
00512 M00S00505.tduout +++| outrec.comment_text := 'OUTPUT SUB-TABLE';
00513 M00S00506.tduout +++| write_comment;
00514 M00S00507.tduout +++| outrec.comment_text := ' OFFSETS BY ORDINAL';
00515 M00S00508.tduout +++| write_comment;
00516 M00S00509.tduout +++| write_comment;
00517 M00S00510.tduout +++| start_word_output;
00518 M00S00511.tduout +++| outrec.line_type := opcode_line;
00519 M00S00512.tduout +++| write_ordinals(^dump_output_node);
00520 M00S00513.tduout +++|
00521 M00S00514.tduout +++| outrec.line_type := comment_line;
00522 M00S00515.tduout +++| outrec.comment_text := '';
00523 M00S00516.tduout +++| write_comment;
00524 M00S00517.tduout +++| outrec.comment_text := ' OUTPUT CHARACTER SEQUENCES';
00525 M00S00518.tduout +++| write_comment;
00526 M00S00519.tduout +++| write_comment;
00527 M00S00520.tduout +++| outrec.line_type := opcode_line;
00528 M00S00521.tduout +++| write_char_sequences(^dump_output_node)
00529 M00S00522.tduout +++| PROCEND write_output_table;
00530 M00S00523.tduout +++| ?? OLDTITLE ??
00531 M00S00524.tduout +++|
00532 M00S00525.tduout +++| ?? NEWTITLE := 'write_input_table' ??
00533 M00S00526.tduout +++| ?? EJECT ??
00534 M00S00527.tduout +++|
00535 M00S00528.tduout +++| PROCEDURE write_input_table;
00536 M00S00529.tduout +++| VAR
00537 M00S00530.tduout +++| table_size: INTEGER,
00538 M00S00531.tduout +++| node_returned: BOOLEAN;
00539 M00S00532.tduout +++|
00540 M00S00533.tduout +++| ?? NEWTITLE := 'write_input_item' ??
00541 M00S00534.tduout +++| ?? SKIP := 4 ??
00542 M00S00535.tduout +++|
00543 M00S00536.tduout +++| PROCEDURE write_input_item (in_node: ^input_node);
00544 M00S00537.tduout +++|
00545 M00S00538.tduout +++| ?? NEWTITLE := 'write_char' ??
00546 M00S00539.tduout +++| ?? SKIP := 4 ??
00547 M00S00540.tduout +++|
00548 M00S00541.tduout +++| PROCEDURE write_char(char_value: INTEGER; comment: STRING(*));
00549 M00S00542.tduout +++|
00550 M00S00543.tduout +++| outrec.line_type := opcode_line;
00551 M00S00544.tduout +++| IF bits_left_in_word = target_wordsize THEN { first word only }
00552 M00S00545.tduout +++| write_vfd(4, 0, 'FILLER');
00553 M00S00546.tduout +++| IFEND;
00554 M00S00547.tduout +++| IF bits_left_in_word < target_char_size THEN
00555 M00S00548.tduout +++| start_word_output;
00556 M00S00549.tduout +++| outrec.line_type := opcode_line;
00557 M00S00550.tduout +++| write_vfd(4, 0, 'FILLER');
00558 M00S00551.tduout +++| IFEND;
00559 M00S00552.tduout +++| write_vfd(target_char_size, char_value, comment);
00560 M00S00553.tduout +++| PROCEND write_char;
00561 M00S00554.tduout +++| ?? OLDTITLE ??
00562 M00S00555.tduout +++|
00563 M00S00556.tduout +++| ?? NEWTITLE := 'write_action' ??
00564 M00S00557.tduout +++| ?? SKIP := 4 ??
00565 M00S00558.tduout +++|
00566 M00S00559.tduout +++| PROCEDURE write_action (action: input_action);
00567 M00S00560.tduout +++| VAR
00568 M00S00561.tduout +++| comment: STRING(30),
00569 M00S00562.tduout +++| integer_string: STRING(6),
00570 M00S00563.tduout +++| i_s_length: ost$string_length; { subrange of integer }
00571 M00S00564.tduout +++|
00572 M00S00565.tduout +++| IF action.ordinal = no_ordinal THEN { offset to next item }
00573 M00S00566.tduout +++| comment := '';
00574 M00S00567.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00575 M00S00568.tduout +++| action.next_offset, 10); { offset in string format }
00576 M00S00569.tduout +++| STRINGREP(comment, stringrep_len,
00577 M00S00570.tduout +++| 'OFFSET ': 8, integer_string: i_s_length);
00578 M00S00571.tduout +++| write_char(action.next_offset DIV 128, comment); { high_order}
00579 M00S00572.tduout +++| write_char(action.next_offset MOD 128, ''); { low-order}
00580 M00S00573.tduout +++| ELSE { ordinal }
00581 M00S00574.tduout +++| comment := '';
00582 M00S00575.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00583 M00S00576.tduout +++| action.ordinal, 10); { ordinal in string format }
00584 M00S00577.tduout +++| STRINGREP(comment, stringrep_len,
00585 M00S00578.tduout +++| 'ORDINAL ': 8, integer_string: i_s_length);
00586 M00S00579.tduout +++| write_char((16383-action.ordinal) DIV 128, comment);
00587 M00S00580.tduout +++| write_char((16383-action.ordinal) MOD 128, ''); { low-order }
00588 M00S00581.tduout +++| IFEND;
00589 M00S00582.tduout +++| PROCEND write_action;
00590 M00S00583.tduout +++| ?? OLDTITLE ??
00591 M00S00584.tduout +++|
00592 M00S00585.tduout +++| ?? NEWTITLE := 'write_fail_node' ??
00593 M00S00586.tduout +++| ?? SKIP := 4 ??
00594 M00S00587.tduout +++|
00595 M00S00588.tduout +++| PROCEDURE write_fail_node (in_node: ^input_node);
00596 M00S00589.tduout +++| write_char(0, '***** FAIL *****');
00597 M00S00590.tduout +++| PROCEND write_fail_node;
00598 M00S00591.tduout +++| ?? OLDTITLE ??
00599 M00S00592.tduout +++|
00600 M00S00593.tduout +++| ?? NEWTITLE := 'write_list_node' ??
00601 M00S00594.tduout +++| ?? SKIP := 4 ??
00602 M00S00595.tduout +++|
00603 M00S00596.tduout +++| PROCEDURE write_list_node (in_node: ^input_node);
00604 M00S00597.tduout +++| VAR
00605 M00S00598.tduout +++| char_ndx: INTEGER;
00606 M00S00599.tduout +++|
00607 M00S00600.tduout +++| write_char(1, '***** LIST *****');
00608 M00S00601.tduout +++| write_char(in_node^.list_character_count, 'LIST COUNT');
00609 M00S00602.tduout +++| FOR char_ndx := 1 to in_node^.list_character_count DO
00610 M00S00603.tduout +++| write_char(ORD(in_node^.list_pointer^[char_ndx].character),
00611 M00S00604.tduout +++| '');
00612 M00S00605.tduout +++| write_action(in_node^.list_pointer^[char_ndx].action);
00613 M00S00606.tduout +++| FOREND;
00614 M00S00607.tduout +++| PROCEND write_list_node;
00615 M00S00608.tduout +++| ?? OLDTITLE ??
00616 M00S00609.tduout +++|
00617 M00S00610.tduout +++| ?? NEWTITLE := 'write_range_node' ??
00618 M00S00611.tduout +++| ?? SKIP := 4 ??
00619 M00S00612.tduout +++|
00620 M00S00613.tduout +++| PROCEDURE write_range_node (in_node: ^input_node);
00621 M00S00614.tduout +++| VAR
00622 M00S00615.tduout +++| char_ndx: INTEGER;
00623 M00S00616.tduout +++|
00624 M00S00617.tduout +++| write_char(2, '***** RANGE *****');
00625 M00S00618.tduout +++| write_char(ORD(in_node^.range_lower_bound), 'LOWER BOUND');
00626 M00S00619.tduout +++| write_char(ORD(in_node^.range_upper_bound), 'UPPER BOUND');
00627 M00S00620.tduout +++| FOR char_ndx := ORD(in_node^.range_lower_bound) TO
00628 M00S00621.tduout +++| ORD(in_node^.range_upper_bound) DO
00629 M00S00622.tduout +++| write_action(in_node^.range_pointer^[char_ndx]);
00630 M00S00623.tduout +++| FOREND;
00631 M00S00624.tduout +++| PROCEND write_range_node;
00632 M00S00625.tduout +++| ?? OLDTITLE ??
00633 M00S00626.tduout +++|
00634 M00S00627.tduout +++| ?? NEWTITLE := 'write_sar_node' ??
00635 M00S00628.tduout +++| ?? SKIP := 4 ??
00636 M00S00629.tduout +++|
00637 M00S00630.tduout +++| PROCEDURE write_sar_node (in_node: ^input_node);
00638 M00S00631.tduout +++|
00639 M00S00632.tduout +++| write_char(3, '***** SINGLE-ACTION RANGE *****');
00640 M00S00633.tduout +++| write_char(ORD(in_node^.sar_lower_bound), 'LOWER BOUND');
00641 M00S00634.tduout +++| write_char(ORD(in_node^.sar_upper_bound), 'UPPER BOUND');
00642 M00S00635.tduout +++| write_action(in_node^.sar_action);
00643 M00S00636.tduout +++| PROCEND write_sar_node;
00644 M00S00637.tduout +++| ?? OLDTITLE ??
00645 M00S00638.tduout +++|
00646 M00S00639.tduout +++| ?? EJECT ??
00647 M00S00640.tduout +++|
00648 M00S00641.tduout +++| CASE in_node^.opcode OF
00649 M00S00642.tduout +++| = fail =
00650 M00S00643.tduout +++| write_fail_node(in_node);
00651 M00S00644.tduout +++| = list =
00652 M00S00645.tduout +++| write_list_node(in_node);
00653 M00S00646.tduout +++| = range =
00654 M00S00647.tduout +++| write_range_node(in_node);
00655 M00S00648.tduout +++| = single_action_range =
00656 M00S00649.tduout +++| write_sar_node(in_node);
00657 M00S00650.tduout +++| CASEND;
00658 M00S00651.tduout +++| PROCEND write_input_item;
00659 M00S00652.tduout +++| ?? OLDTITLE ??
00660 M00S00653.tduout +++|
00661 M00S00654.tduout +++| ?? EJECT ??
00662 M00S00655.tduout +++|
00663 M00S00656.tduout +++| outrec.line_type := comment_line;
00664 M00S00657.tduout +++| outrec.comment_text := '';
00665 M00S00658.tduout +++| write_comment;
00666 M00S00659.tduout +++| outrec.comment_text := 'INPUT SUB-TABLE';
00667 M00S00660.tduout +++| write_comment;
00668 M00S00661.tduout +++| write_comment;
00669 M00S00662.tduout +++| start_word_output;
00670 M00S00663.tduout +++| outrec.line_type := opcode_line;
00671 M00S00664.tduout +++| outrec.label := subtable_list[subtable_input].label;
00672 M00S00665.tduout +++| outrec.opcode := 'BSS';
00673 M00S00666.tduout +++| outrec.parameters := '0';
00674 M00S00667.tduout +++| outrec.comment := '';
00675 M00S00668.tduout +++| write_opcode_line;
00676 M00S00669.tduout +++| reset_input_table(table_size);
00677 M00S00670.tduout +++| dump_input_node(^write_input_item); { pass my procedure to dumper }
00678 M00S00671.tduout +++| IF ( bits_left_in_word > 0 ) AND
00679 M00S00672.tduout +++| ( bits_left_in_word < target_wordsize ) THEN
00680 M00S00673.tduout +++| outrec.line_type := opcode_line;
00681 M00S00674.tduout +++| write_vfd(bits_left_in_word, 0, 'FILLER');
00682 M00S00675.tduout +++| IFEND;
00683 M00S00676.tduout +++| PROCEND write_input_table;
00684 M00S00677.tduout +++| ?? OLDTITLE ??
00685 M00S00678.tduout +++|
00686 M00S00679.tduout +++| ?? NEWTITLE := 'write_key_name_table' ??
00687 M00S00680.tduout +++| ?? EJECT ??
00688 M00S00681.tduout +++|
00689 M00S00682.tduout +++| PROCEDURE write_key_name_table;
00690 M00S00683.tduout +++|
00691 M00S00684.tduout +++| outrec.line_type := comment_line;
00692 M00S00685.tduout +++| outrec.comment_text := '';
00693 M00S00686.tduout +++| write_comment;
00694 M00S00687.tduout +++| outrec.comment_text := 'KEY-NAME SUB-TABLE';
00695 M00S00688.tduout +++| write_comment;
00696 M00S00689.tduout +++| outrec.comment_text := ' ORDINALS BY KEY';
00697 M00S00690.tduout +++| write_comment;
00698 M00S00691.tduout +++| write_comment;
00699 M00S00692.tduout +++| start_word_output;
00700 M00S00693.tduout +++| outrec.line_type := opcode_line;
00701 M00S00694.tduout +++| outrec.label := subtable_list[subtable_names].label;
00702 M00S00695.tduout +++| outrec.opcode := 'BSS';
00703 M00S00696.tduout +++| outrec.parameters := '0';
00704 M00S00697.tduout +++| outrec.comment := '';
00705 M00S00698.tduout +++| write_opcode_line;
00706 M00S00699.tduout +++| write_ordinals(^dump_key_name_node);
00707 M00S00700.tduout +++|
00708 M00S00701.tduout +++| outrec.line_type := comment_line;
00709 M00S00702.tduout +++| outrec.comment_text := '';
00710 M00S00703.tduout +++| write_comment;
00711 M00S00704.tduout +++| outrec.comment_text := ' KEY NAMES';
00712 M00S00705.tduout +++| write_comment;
00713 M00S00706.tduout +++| write_comment;
00714 M00S00707.tduout +++| outrec.line_type := opcode_line;
00715 M00S00708.tduout +++| write_char_sequences(^dump_key_name_node)
00716 M00S00709.tduout +++| PROCEND write_key_name_table;
00717 M00S00710.tduout +++| ?? OLDTITLE ??
00718 M00S00711.tduout +++|
00719 M00S00712.tduout +++| ?? NEWTITLE := 'write_initialization_table' ??
00720 M00S00713.tduout +++| ?? EJECT ??
00721 M00S00714.tduout +++|
00722 M00S00715.tduout +++| PROCEDURE write_initialization_table;
00723 M00S00716.tduout +++| outrec.line_type := comment_line;
00724 M00S00717.tduout +++| outrec.comment_text := '';
00725 M00S00718.tduout +++| write_comment;
00726 M00S00719.tduout +++| outrec.comment_text := 'INITIALIZATION SUB-TABLE';
00727 M00S00720.tduout +++| write_comment;
00728 M00S00721.tduout +++| outrec.comment_text := ' LINE/SCREEN ORDINALS';
00729 M00S00722.tduout +++| write_comment;
00730 M00S00723.tduout +++| write_comment;
00731 M00S00724.tduout +++| start_word_output;
00732 M00S00725.tduout +++| outrec.line_type := opcode_line;
00733 M00S00726.tduout +++| outrec.label := subtable_list[subtable_init].label;
00734 M00S00727.tduout +++| outrec.opcode := 'BSS';
00735 M00S00728.tduout +++| outrec.parameters := '0';
00736 M00S00729.tduout +++| outrec.comment := '';
00737 M00S00730.tduout +++| write_opcode_line;
00738 M00S00731.tduout +++| write_ordinals(^dump_reset_sequence);
00739 M00S00732.tduout +++|
00740 M00S00733.tduout +++| outrec.line_type := comment_line;
00741 M00S00734.tduout +++| outrec.comment_text := '';
00742 M00S00735.tduout +++| write_comment;
00743 M00S00736.tduout +++| outrec.comment_text := ' INITIALIZATION SEQUENCES';
00744 M00S00737.tduout +++| write_comment;
00745 M00S00738.tduout +++| write_comment;
00746 M00S00739.tduout +++| outrec.line_type := opcode_line;
00747 M00S00740.tduout +++| write_char_sequences(^dump_reset_sequence)
00748 M00S00741.tduout +++| PROCEND write_initialization_table;
00749 M00S00742.tduout +++| ?? OLDTITLE ??
00750 M00S00743.tduout +++|
00751 M00S00744.tduout +++| ?? NEWTITLE := 'write_appstr_table' ??
00752 M00S00745.tduout +++| ?? EJECT ??
00753 M00S00746.tduout +++|
00754 M00S00747.tduout +++| PROCEDURE write_appstr_table;
00755 M00S00748.tduout +++| VAR
00756 M00S00749.tduout +++| length: INTEGER,
00757 M00S00750.tduout +++| chars: ^STRING(*),
00758 M00S00751.tduout +++| total_sequences,
00759 M00S00752.tduout +++| total_characters: INTEGER,
00760 M00S00753.tduout +++| node_returned: BOOLEAN,
00761 M00S00754.tduout +++| name: STRING(7);
00762 M00S00755.tduout +++|
00763 M00S00756.tduout +++| ?? NEWTITLE := 'write_appstr_names' ??
00764 M00S00757.tduout +++| ?? SKIP := 4 ??
00765 M00S00758.tduout +++|
00766 M00S00759.tduout +++| PROCEDURE write_appstr_names;
00767 M00S00760.tduout +++| VAR
00768 M00S00761.tduout +++| char_ndx: INTEGER,
00769 M00S00762.tduout +++| comment: STRING(30);
00770 M00S00763.tduout +++|
00771 M00S00764.tduout +++| start_word_output;
00772 M00S00765.tduout +++| outrec.line_type := opcode_line;
00773 M00S00766.tduout +++| comment := name(1,7);
00774 M00S00767.tduout +++| FOR char_ndx := 1 TO 7 DO
00775 M00S00768.tduout +++| write_vfd(6,
00776 M00S00769.tduout +++| utv$convert_ascii_to_ascii64[name(char_ndx)], comment);
00777 M00S00770.tduout +++| comment := ''
00778 M00S00771.tduout +++| FOREND;
00779 M00S00772.tduout +++| write_vfd(18, length, '')
00780 M00S00773.tduout +++| PROCEND write_appstr_names;
00781 M00S00774.tduout +++| ?? OLDTITLE ??
00782 M00S00775.tduout +++|
00783 M00S00776.tduout +++| ?? NEWTITLE := 'write_appstr_sequences' ??
00784 M00S00777.tduout +++| ?? EJECT ??
00785 M00S00778.tduout +++|
00786 M00S00779.tduout +++| PROCEDURE write_appstr_sequences;
00787 M00S00780.tduout +++| VAR
00788 M00S00781.tduout +++| char_ndx: INTEGER,
00789 M00S00782.tduout +++| comment: STRING(30);
00790 M00S00783.tduout +++|
00791 M00S00784.tduout +++| outrec.line_type := opcode_line;
00792 M00S00785.tduout +++| FOR char_ndx := 1 TO length DO
00793 M00S00786.tduout +++| IF bits_left_in_word < target_char_size THEN
00794 M00S00787.tduout +++| start_word_output;
00795 M00S00788.tduout +++| outrec.line_type := opcode_line;
00796 M00S00789.tduout +++| write_vfd(4, 0, 'FILLER')
00797 M00S00790.tduout +++| IFEND;
00798 M00S00791.tduout +++| write_vfd(target_char_size,
00799 M00S00792.tduout +++| ORD(chars^(char_ndx)), '');
00800 M00S00793.tduout +++| FOREND;
00801 M00S00794.tduout +++| IF bits_left_in_word > 0 THEN
00802 M00S00795.tduout +++| outrec.line_type := opcode_line;
00803 M00S00796.tduout +++| write_vfd(bits_left_in_word, 0, 'FILLER')
00804 M00S00797.tduout +++| IFEND
00805 M00S00798.tduout +++| PROCEND write_appstr_sequences;
00806 M00S00799.tduout +++| ?? OLDTITLE ??
00807 M00S00800.tduout +++| ?? EJECT ??
00808 M00S00801.tduout +++|
00809 M00S00802.tduout +++| outrec.line_type := comment_line;
00810 M00S00803.tduout +++| outrec.comment_text := '';
00811 M00S00804.tduout +++| write_comment;
00812 M00S00805.tduout +++| outrec.comment_text := 'APPLICATION STRING SUB-TABLE';
00813 M00S00806.tduout +++| write_comment;
00814 M00S00807.tduout +++| write_comment;
00815 M00S00808.tduout +++| start_word_output;
00816 M00S00809.tduout +++| outrec.line_type := opcode_line;
00817 M00S00810.tduout +++| outrec.label := subtable_list[subtable_appstr].label;
00818 M00S00811.tduout +++| outrec.opcode := 'BSS';
00819 M00S00812.tduout +++| outrec.parameters := '0';
00820 M00S00813.tduout +++| outrec.comment := '';
00821 M00S00814.tduout +++| write_opcode_line;
00822 M00S00815.tduout +++|
00823 M00S00816.tduout +++| reset_appstr_table;
00824 M00S00817.tduout +++| REPEAT
00825 M00S00818.tduout +++| dump_appstr_node(name, length, chars,
00826 M00S00819.tduout +++| total_sequences, total_characters, node_returned);
00827 M00S00820.tduout +++| IF node_returned THEN
00828 M00S00821.tduout +++| write_appstr_names;
00829 M00S00822.tduout +++| write_appstr_sequences
00830 M00S00823.tduout +++| IFEND
00831 M00S00824.tduout +++| UNTIL NOT node_returned;
00832 M00S00825.tduout +++| start_word_output;
00833 M00S00826.tduout +++| outrec.line_type := opcode_line;
00834 M00S00827.tduout +++| write_vfd(target_wordsize, 0, 'END OF NAMES')
00835 M00S00828.tduout +++| PROCEND write_appstr_table;
00836 M00S00829.tduout +++| ?? OLDTITLE ??
00837 M00S00830.tduout +++|
00838 M00S00831.tduout +++| ?? NEWTITLE := 'write_trailer' ??
00839 M00S00832.tduout +++| ?? EJECT ??
00840 M00S00833.tduout +++|
00841 M00S00834.tduout +++| PROCEDURE write_trailer;
00842 M00S00835.tduout +++| outrec.line_type := comment_line;
00843 M00S00836.tduout +++| outrec.comment_text := '';
00844 M00S00837.tduout +++| write_comment;
00845 M00S00838.tduout +++| outrec.comment_text := 'END OF TABLE';
00846 M00S00839.tduout +++| write_comment;
00847 M00S00840.tduout +++| write_comment;
00848 M00S00841.tduout +++| outrec.line_type := opcode_line;
00849 M00S00842.tduout +++| outrec.label := subtable_list[subtable_end].label;
00850 M00S00843.tduout +++| outrec.opcode := 'END';
00851 M00S00844.tduout +++| outrec.parameters := '';
00852 M00S00845.tduout +++| write_opcode_line;
00853 M00S00846.tduout +++| PROCEND write_trailer;
00854 M00S00847.tduout +++| ?? OLDTITLE ??
00855 M00S00848.tduout +++| ?? EJECT ??
00856 M00S00849.tduout +++|
00857 M00S00850.tduout +++| open_file(output_file_sel, output_sel, ascii64_sel);
00858 M00S00851.tduout +++| outrec.line_type := whole_line;
00859 M00S00852.tduout +++| outrec.line_buffer := '';
00860 M00S00853.tduout +++|
00861 M00S00854.tduout +++| write_header;
00862 M00S00855.tduout +++| write_sub_table_pointers;
00863 M00S00856.tduout +++| write_parameters;
00864 M00S00857.tduout +++| write_size_table;
00865 M00S00858.tduout +++| write_subtable_start;
00866 M00S00859.tduout +++|
00867 M00S00860.tduout +++| write_output_table;
00868 M00S00861.tduout +++| write_input_table;
00869 M00S00862.tduout +++| write_key_name_table;
00870 M00S00863.tduout +++| write_appstr_table;
00871 M00S00864.tduout +++| write_initialization_table;
00872 M00S00865.tduout +++| write_trailer;
00873 M00S00866.tduout +++|
00874 M00S00867.tduout +++| close_file(output_file_sel)
00875 M00S00868.tduout +++| PROCEND write_tables;
00876 M00S00869.tduout +++| ?? OLDTITLE ??
00877 M00S00870.tduout +++|
00878 M00S00871.tduout +++|MODEND tduout;