cdc:nos2.source:opl.opl871:deck:tduout
Deck TDUOUT
2 Modifications
Source
Seq # *Modification Id* Act
----------------------------+
00001 M01S00001.tduout +++|*NOSEQ
00002 M01S00002.tduout +++|*WIDTH 95
00003 M01S00003.tduout +++|MODULE tduout;
00004 M01S00004.tduout +++|
00005 M01S00005.tduout +++|?? SET ( CHKALL := ON ), RIGHT := 110 ??
00006 M01S00006.tduout +++|
00007 M01S00007.tduout +++|{ Module : TDUOUT }
00008 M01S00001.281l803 +++|{ Copyright Control Data Systems Inc. 1992. }
00009 M01S00008.tduout +++|{ Written: 1/84 by R. Lindsey }
00010 M01S00009.tduout +++|{ Version: Cyber 170, version 1 }
00011 M01S00010.tduout +++|{ Purpose: This is the output portion of the TDU program. }
00012 M01S00011.tduout +++|
00013 M01S00012.tduout +++| ?? PUSH ( LIST := OFF ) ?? { uncomment this line to suppress list }
00014 M01S00013.tduout +++|{ ?? PUSH ( LIST := ON ) ?? { uncomment this line to list }
00015 M01S00014.tduout +++|
00016 M01S00015.tduout +++|?? NEWTITLE := 'Utilities' ??
00017 M01S00016.tduout +++|
00018 M01S00017.tduout +++|{ integer to string conversion, ascii to ascii-64 conversion }
00019 M01S00018.tduout +++|*CALLC ZUTPI2S
00020 M01S00019.tduout +++|*CALL ZUTVCTT
00021 M01S00020.tduout +++|
00022 M01S00021.tduout +++|?? OLDTITLE ??
00023 M01S00022.tduout +++|?? NEWTITLE := 'ZTDTTAB' ??
00024 M01S00023.tduout +++|?? SKIP := 4 ??
00025 M01S00024.tduout +++|
00026 M01S00025.tduout +++|{ **************************** }
00027 M01S00026.tduout +++|{ common deck ZTDTTAB follows: }
00028 M01S00027.tduout +++|*CALL ZTDTTAB
00029 M01S00028.tduout +++|
00030 M01S00029.tduout +++|?? OLDTITLE ??
00031 M01S00030.tduout +++|?? NEWTITLE := 'tdu XREF''s, etc.' ??
00032 M01S00031.tduout +++|?? EJECT ??
00033 M01S00032.tduout +++|
00034 M01S00033.tduout +++|{ ***************** }
00035 M01S00034.tduout +++|{ tdu file handler: }
00036 M01S00035.tduout +++|*CALL ZTDPFIL
00037 M01S00036.tduout +++|
00038 M01S00037.tduout +++|{ ********************** }
00039 M01S00038.tduout +++|{ error handling routine }
00040 M01S00039.tduout +++|*CALL ZTDPERR
00041 M01S00040.tduout +++|
00042 M01S00041.tduout +++|{ ****************************** }
00043 M01S00042.tduout +++|{ table-handling dump procedures }
00044 M01S00043.tduout +++|*CALLC ZTDPTBD
00045 M01S00044.tduout +++|
00046 M01S00045.tduout +++| ?? EJECT ??
00047 M01S00046.tduout +++| ?? POP ??
00048 M01S00047.tduout +++|
00049 M01S00048.tduout +++| CONST
00050 M01S00049.tduout +++| target_wordsize = 60, { word size of target machine (170) }
00051 M01S00050.tduout +++| target_char_size = 7; { bit size of each character }
00052 M01S00051.tduout +++|
00053 M01S00052.tduout +++| VAR
00054 M01S00053.tduout +++| tdu_version_num: [XREF] INTEGER, { from main program }
00055 M01S00054.tduout +++|
00056 M01S00055.tduout +++| word_number: INTEGER := -1, { pre-decremented word counter }
00057 M01S00056.tduout +++| bits_left_in_word: INTEGER := 0, { bits remaining in word, start empty }
00058 M01S00057.tduout +++|
00059 M01S00058.tduout +++| stringrep_len: INTEGER, { used by all STRINGREP calls }
00060 M01S00059.tduout +++|
00061 M01S00060.tduout +++| parm_record: parameter_record, { terminal non-I/O parameters }
00062 M01S00061.tduout +++| in_node: ^input_node, { input table item }
00063 M01S00062.tduout +++| status: ost$status,
00064 M01S00063.tduout +++|
00065 M01S00064.tduout +++| outrec: PACKED RECORD { output buffer }
00066 M01S00065.tduout +++| CASE line_type: (whole_line, opcode_line, comment_line) OF
00067 M01S00066.tduout +++| = whole_line = { for output--write the whole line }
00068 M01S00067.tduout +++| line_buffer: STRING(72),
00069 M01S00068.tduout +++| = opcode_line = { for 'regular' opcode/param lines }
00070 M01S00069.tduout +++| filler1: STRING(1), { CHAR won't work here }
00071 M01S00070.tduout +++| label: STRING(9), { column 2 }
00072 M01S00071.tduout +++| opcode: STRING(7), { column 11 }
00073 M01S00072.tduout +++| parameters: STRING(20), { column 18, need lots of room here }
00074 M01S00073.tduout +++| comment: STRING(35), { column 38, non-standard, oh well }
00075 M01S00074.tduout +++| = comment_line = { for full-line comments }
00076 M01S00075.tduout +++| comment_indicator: STRING(6), { col. 1 '*' + filler }
00077 M01S00076.tduout +++| comment_text: STRING(66), { column 7, not to line up w/opcode }
00078 M01S00077.tduout +++| CASEND,
00079 M01S00078.tduout +++| RECEND;
00080 M01S00079.tduout +++|
00081 M01S00080.tduout +++| { Subtable labels table }
00082 M01S00081.tduout +++|
00083 M01S00082.tduout +++| CONST
00084 M01S00083.tduout +++| subtable_count = 5, { number of subtables defined }
00085 M01S00084.tduout +++| subtable_input = 1,
00086 M01S00085.tduout +++| subtable_names = 2,
00087 M01S00086.tduout +++| subtable_init = 3,
00088 M01S00087.tduout +++| subtable_appstr = 4,
00089 M01S00088.tduout +++| subtable_end = 5;
00090 M01S00089.tduout +++|
00091 M01S00090.tduout +++| VAR
00092 M01S00091.tduout +++| subtable_index: INTEGER,
00093 M01S00092.tduout +++| subtable_list: [STATIC] PACKED ARRAY [1..subtable_count] OF PACKED RECORD
00094 M01S00093.tduout +++| label: STRING(8), { the label itself }
00095 M01S00094.tduout +++| label_len: 0 .. 8, { significant length of label }
00096 M01S00095.tduout +++| RECEND
00097 M01S00096.tduout +++| := [ ['INPUT', 5],
00098 M01S00097.tduout +++| ['NAMES', 5],
00099 M01S00098.tduout +++| ['INIT', 4],
00100 M01S00099.tduout +++| ['APPSTR', 6],
00101 M01S00100.tduout +++| ['ENDTABL', 7] ];
00102 M01S00101.tduout +++|
00103 M01S00102.tduout +++| ?? NEWTITLE := 'write_tables' ??
00104 M01S00103.tduout +++| ?? EJECT ??
00105 M01S00104.tduout +++|
00106 M01S00105.tduout +++| PROCEDURE [XDCL] write_tables; { this is called to write entire table }
00107 M01S00106.tduout +++|
00108 M01S00107.tduout +++| ?? NEWTITLE := 'write_line' ??
00109 M01S00108.tduout +++| ?? SKIP := 4 ??
00110 M01S00109.tduout +++|
00111 M01S00110.tduout +++| PROCEDURE write_line;
00112 M01S00111.tduout +++| put_file(output_file_sel, outrec.line_buffer);
00113 M01S00112.tduout +++| PROCEND write_line;
00114 M01S00113.tduout +++| ?? OLDTITLE ??
00115 M01S00114.tduout +++|
00116 M01S00115.tduout +++| ?? NEWTITLE := 'write_opcode_line' ??
00117 M01S00116.tduout +++| ?? SKIP := 4 ??
00118 M01S00117.tduout +++|
00119 M01S00118.tduout +++| PROCEDURE write_opcode_line;
00120 M01S00119.tduout +++| outrec.line_type := whole_line;
00121 M01S00120.tduout +++| write_line;
00122 M01S00121.tduout +++| outrec.line_type := opcode_line;
00123 M01S00122.tduout +++| outrec.label := ''; { never want to save a label }
00124 M01S00123.tduout +++| PROCEND write_opcode_line;
00125 M01S00124.tduout +++| ?? OLDTITLE ??
00126 M01S00125.tduout +++|
00127 M01S00126.tduout +++| ?? NEWTITLE := 'write_comment' ??
00128 M01S00127.tduout +++| ?? SKIP := 4 ??
00129 M01S00128.tduout +++|
00130 M01S00129.tduout +++| PROCEDURE write_comment;
00131 M01S00130.tduout +++| outrec.comment_indicator := '*';
00132 M01S00131.tduout +++| outrec.line_type := whole_line;
00133 M01S00132.tduout +++| write_line;
00134 M01S00133.tduout +++| outrec.line_buffer := ''; { always return a blank line }
00135 M01S00134.tduout +++| outrec.line_type := comment_line;
00136 M01S00135.tduout +++| PROCEND write_comment;
00137 M01S00136.tduout +++| ?? OLDTITLE ??
00138 M01S00137.tduout +++|
00139 M01S00138.tduout +++| ?? NEWTITLE := 'write_vfd' ??
00140 M01S00139.tduout +++| ?? EJECT ??
00141 M01S00140.tduout +++|
00142 M01S00141.tduout +++| PROCEDURE write_vfd(bit_length, field_value: INTEGER; commnt: STRING(*));
00143 M01S00142.tduout +++| VAR
00144 M01S00143.tduout +++| temp_string,
00145 M01S00144.tduout +++| bit_length_string,
00146 M01S00145.tduout +++| field_value_string: STRING(4),
00147 M01S00146.tduout +++| bit_l_s_length,
00148 M01S00147.tduout +++| field_v_s_length: ost$string_length; { subrange for string size }
00149 M01S00148.tduout +++|
00150 M01S00149.tduout +++| outrec.opcode := 'VFD';
00151 M01S00150.tduout +++| utp$convert_integer_to_string(bit_length_string, bit_l_s_length,
00152 M01S00151.tduout +++| bit_length, 10);
00153 M01S00152.tduout +++| utp$convert_integer_to_string(field_value_string, field_v_s_length,
00154 M01S00153.tduout +++| field_value, 10);
00155 M01S00154.tduout +++|{ IF field_value = (-0) THEN
00156 M01S00155.tduout +++|{ STRINGREP(temp_string, field_v_s_length,
00157 M01S00156.tduout +++|{ '-', field_value_string(1,field_v_s_length));
00158 M01S00157.tduout +++|{ field_value_string := temp_string
00159 M01S00158.tduout +++|{ IFEND;
00160 M01S00159.tduout +++| outrec.parameters := '';
00161 M01S00160.tduout +++| STRINGREP(outrec.parameters, stringrep_len,
00162 M01S00161.tduout +++| bit_length_string(1,bit_l_s_length),
00163 M01S00162.tduout +++| '/': 1,
00164 M01S00163.tduout +++| field_value_string(1,field_v_s_length));
00165 M01S00164.tduout +++| outrec.comment := commnt;
00166 M01S00165.tduout +++| write_opcode_line;
00167 M01S00166.tduout +++| outrec.comment := '';
00168 M01S00167.tduout +++| bits_left_in_word := bits_left_in_word - bit_length;
00169 M01S00168.tduout +++| PROCEND write_vfd;
00170 M01S00169.tduout +++| ?? OLDTITLE ??
00171 M01S00170.tduout +++|
00172 M01S00171.tduout +++| ?? NEWTITLE := 'start_word_output' ??
00173 M01S00172.tduout +++| ?? EJECT ??
00174 M01S00173.tduout +++|
00175 M01S00174.tduout +++| PROCEDURE start_word_output;
00176 M01S00175.tduout +++| VAR
00177 M01S00176.tduout +++| integer_string: STRING(6),
00178 M01S00177.tduout +++| i_s_length: ost$string_length; { subrange of integer, str-len }
00179 M01S00178.tduout +++|
00180 M01S00179.tduout +++| IF bits_left_in_word < target_wordsize THEN { only if not already word}
00181 M01S00180.tduout +++| word_number := word_number + 1;
00182 M01S00181.tduout +++| bits_left_in_word := target_wordsize;
00183 M01S00182.tduout +++| outrec.line_type := comment_line;
00184 M01S00183.tduout +++| outrec.comment_text := '';
00185 M01S00184.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00186 M01S00185.tduout +++| word_number, 8); { STRINGREP can't do octal (!) }
00187 M01S00186.tduout +++| STRINGREP(outrec.comment_text, stringrep_len, 'WORD ': 5,
00188 M01S00187.tduout +++| integer_string: i_s_length);
00189 M01S00188.tduout +++| write_comment;
00190 M01S00189.tduout +++| IFEND;
00191 M01S00190.tduout +++| PROCEND start_word_output;
00192 M01S00191.tduout +++| ?? OLDTITLE ??
00193 M01S00192.tduout +++|
00194 M01S00193.tduout +++| ?? NEWTITLE := 'write_ordinals' ??
00195 M01S00194.tduout +++| ?? EJECT ??
00196 M01S00195.tduout +++|
00197 M01S00196.tduout +++| PROCEDURE write_ordinals (dump_procedure: dump_procedure_type);
00198 M01S00197.tduout +++| VAR
00199 M01S00198.tduout +++| ordinal_ndx: INTEGER,
00200 M01S00199.tduout +++| length: INTEGER,
00201 M01S00200.tduout +++| chars: ^STRING(*),
00202 M01S00201.tduout +++| total_characters,
00203 M01S00202.tduout +++| total_ordinals: INTEGER,
00204 M01S00203.tduout +++| node_returned: BOOLEAN,
00205 M01S00204.tduout +++| bit_count,
00206 M01S00205.tduout +++| word_count,
00207 M01S00206.tduout +++| remainder,
00208 M01S00207.tduout +++| remainder_chars,
00209 M01S00208.tduout +++| filler_bits,
00210 M01S00209.tduout +++| char_offset: INTEGER,
00211 M01S00210.tduout +++| integer_string: STRING(6),
00212 M01S00211.tduout +++| i_s_length: ost$string_length, { subrange of integer, str-len }
00213 M01S00212.tduout +++| comment: STRING(30);
00214 M01S00213.tduout +++|
00215 M01S00214.tduout +++| dump_procedure^(0, length, chars, total_ordinals, total_characters,
00216 M01S00215.tduout +++| node_returned);
00217 M01S00216.tduout +++| bit_count := ( ( total_ordinals + 2 ) * 12 );
00218 M01S00217.tduout +++| word_count := bit_count DIV 60;
00219 M01S00218.tduout +++| remainder := 60 - ( bit_count MOD 60 );
00220 M01S00219.tduout +++| char_offset := ( word_count * 8 ) + 8 - ( remainder DIV 7 );
00221 M01S00220.tduout +++| ordinal_ndx := 0;
00222 M01S00221.tduout +++| REPEAT
00223 M01S00222.tduout +++| dump_procedure^(ordinal_ndx, length, chars,
00224 M01S00223.tduout +++| total_ordinals, total_characters, node_returned);
00225 M01S00224.tduout +++| IF node_returned THEN
00226 M01S00225.tduout +++| IF bits_left_in_word < 12 THEN
00227 M01S00226.tduout +++| start_word_output
00228 M01S00227.tduout +++| IFEND;
00229 M01S00228.tduout +++| outrec.line_type := opcode_line;
00230 M01S00229.tduout +++| comment := '';
00231 M01S00230.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00232 M01S00231.tduout +++| ordinal_ndx, 10); { ordinal in string format }
00233 M01S00232.tduout +++| STRINGREP(comment, stringrep_len,
00234 M01S00233.tduout +++| 'ORDINAL ': 8, integer_string: i_s_length);
00235 M01S00234.tduout +++| write_vfd(12, char_offset, comment);
00236 M01S00235.tduout +++| char_offset := char_offset + length;
00237 M01S00236.tduout +++| ordinal_ndx := ordinal_ndx + 1
00238 M01S00237.tduout +++| IFEND
00239 M01S00238.tduout +++| UNTIL NOT node_returned;
00240 M01S00239.tduout +++| IF bits_left_in_word < 12 THEN
00241 M01S00240.tduout +++| start_word_output
00242 M01S00241.tduout +++| IFEND;
00243 M01S00242.tduout +++| outrec.line_type := opcode_line;
00244 M01S00243.tduout +++| write_vfd(12, char_offset, 'END OF ORDINALS');
00245 M01S00244.tduout +++| IF bits_left_in_word > 0 THEN
00246 M01S00245.tduout +++| remainder_chars := remainder DIV 7;
00247 M01S00246.tduout +++| filler_bits := remainder - ( remainder_chars * 7 );
00248 M01S00247.tduout +++| write_vfd(filler_bits, 0, 'FILLER')
00249 M01S00248.tduout +++| IFEND
00250 M01S00249.tduout +++| PROCEND write_ordinals;
00251 M01S00250.tduout +++|
00252 M01S00251.tduout +++| ?? OLDTITLE ??
00253 M01S00252.tduout +++| ?? NEWTITLE := 'write_char_sequences' ??
00254 M01S00253.tduout +++| ?? EJECT ??
00255 M01S00254.tduout +++|
00256 M01S00255.tduout +++| PROCEDURE write_char_sequences (dump_procedure: dump_procedure_type);
00257 M01S00256.tduout +++| VAR
00258 M01S00257.tduout +++| ordinal_ndx: INTEGER,
00259 M01S00258.tduout +++| length: INTEGER,
00260 M01S00259.tduout +++| chars: ^STRING(*),
00261 M01S00260.tduout +++| total_characters,
00262 M01S00261.tduout +++| total_ordinals: INTEGER,
00263 M01S00262.tduout +++| node_returned: BOOLEAN,
00264 M01S00263.tduout +++| integer_string: STRING(6),
00265 M01S00264.tduout +++| i_s_length: ost$string_length, { subrange of integer, str-len }
00266 M01S00265.tduout +++| char_ndx: INTEGER,
00267 M01S00266.tduout +++| comment: STRING(30);
00268 M01S00267.tduout +++|
00269 M01S00268.tduout +++| ordinal_ndx := 0;
00270 M01S00269.tduout +++| REPEAT
00271 M01S00270.tduout +++| dump_procedure^(ordinal_ndx, length, chars,
00272 M01S00271.tduout +++| total_ordinals, total_characters, node_returned);
00273 M01S00272.tduout +++| IF node_returned THEN
00274 M01S00273.tduout +++| IF bits_left_in_word = target_wordsize THEN { first word only }
00275 M01S00274.tduout +++| write_vfd(4, 0, 'FILLER');
00276 M01S00275.tduout +++| IFEND;
00277 M01S00276.tduout +++| comment := '';
00278 M01S00277.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00279 M01S00278.tduout +++| ordinal_ndx, 10); { ordinal in string format }
00280 M01S00279.tduout +++| STRINGREP(comment, stringrep_len,
00281 M01S00280.tduout +++| 'ORDINAL ': 8, integer_string: i_s_length);
00282 M01S00281.tduout +++| outrec.line_type := opcode_line;
00283 M01S00282.tduout +++| FOR char_ndx := 1 TO length DO
00284 M01S00283.tduout +++| IF bits_left_in_word < target_char_size THEN
00285 M01S00284.tduout +++| start_word_output;
00286 M01S00285.tduout +++| outrec.line_type := opcode_line;
00287 M01S00286.tduout +++| write_vfd(4, 0, 'FILLER')
00288 M01S00287.tduout +++| IFEND;
00289 M01S00288.tduout +++| write_vfd(target_char_size,
00290 M01S00289.tduout +++| ORD(chars^(char_ndx)), comment);
00291 M01S00290.tduout +++| comment := ''
00292 M01S00291.tduout +++| FOREND;
00293 M01S00292.tduout +++| ordinal_ndx := ordinal_ndx + 1
00294 M01S00293.tduout +++| IFEND
00295 M01S00294.tduout +++| UNTIL NOT node_returned;
00296 M01S00295.tduout +++| IF ( bits_left_in_word > 0 ) AND
00297 M01S00296.tduout +++| ( bits_left_in_word < target_wordsize ) THEN
00298 M01S00297.tduout +++| outrec.line_type := opcode_line;
00299 M01S00298.tduout +++| write_vfd(bits_left_in_word, 0, 'FILLER')
00300 M01S00299.tduout +++| IFEND
00301 M01S00300.tduout +++| PROCEND write_char_sequences;
00302 M01S00301.tduout +++|
00303 M01S00302.tduout +++| ?? OLDTITLE ??
00304 M01S00303.tduout +++|
00305 M01S00304.tduout +++| ?? NEWTITLE := 'write_tab_protect_parms' ??
00306 M01S00305.tduout +++| ?? EJECT ??
00307 M01S00306.tduout +++|
00308 M01S00307.tduout +++| PROCEDURE write_tab_protect_parms;
00309 M01S00308.tduout +++| VAR
00310 M01S00309.tduout +++| resv_ndx: INTEGER,
00311 M01S00310.tduout +++| loop_ndx: INTEGER,
00312 M01S00311.tduout +++| parm_ndx: INTEGER;
00313 M01S00312.tduout +++| loop_ndx := (cursor_behavior_div + 1);
00314 M01S00313.tduout +++|
00315 M01S00314.tduout +++| FOR parm_ndx := loop_ndx TO cursor_behavior_max DO
| Line S00315 Modification History | |
|---|---|
M01 (Added by) | tduout |
M02 (Updated by) | ns2348 |
Seq # *Modification Id* Act ----------------------------+ 00316 M02S00315.ns2348 ---| write_vfd(4, ORD(parm_record.cursor_behavior[parm_ndx]),
| Line S00316 Modification History | |
|---|---|
M01 (Added by) | tduout |
M02 (Updated by) | ns2348 |
Seq # *Modification Id* Act
----------------------------+
00317 M02S00316.ns2348 ---| 'CURSOR BEHAVIOR');
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 M01S00317.tduout +++| FOREND;
00325 M01S00318.tduout +++|
00326 M01S00319.tduout +++| resv_ndx := 4 * ((cursor_behavior_max - cursor_behavior_div)- 1);
00327 M01S00320.tduout +++| write_vfd(resv_ndx, 0, 'RESERVED');
00328 M01S00321.tduout +++|
00329 M01S00322.tduout +++| PROCEND write_tab_protect_parms;
00330 M01S00323.tduout +++|
00331 M01S00324.tduout +++| ?? OLDTITLE ??
00332 M01S00325.tduout +++|
00333 M01S00326.tduout +++| ?? NEWTITLE := 'write_header' ??
00334 M01S00327.tduout +++| ?? EJECT ??
00335 M01S00328.tduout +++|
00336 M01S00329.tduout +++| PROCEDURE write_header;
00337 M01S00330.tduout +++| VAR
00338 M01S00331.tduout +++| junk_name: STRING(7),
00339 M01S00332.tduout +++| junk_len: INTEGER;
00340 M01S00333.tduout +++|
00341 M01S00334.tduout +++| dump_parameters(parm_record);
00342 M01S00335.tduout +++| junk_name := ' '; { concatenate 'Z' to start of name }
00343 M01S00336.tduout +++| STRINGREP(junk_name, junk_len, 'Z', { to ensure a valid NOS name }
00344 M01S00337.tduout +++| parm_record.model_name(1,parm_record.model_name_len));
00345 M01S00338.tduout +++| parm_record.model_name := junk_name;
00346 M01S00339.tduout +++| parm_record.model_name_len := junk_len;
00347 M01S00340.tduout +++|
00348 M01S00341.tduout +++| outrec.line_type := opcode_line;
00349 M01S00342.tduout +++| outrec.label := '';
00350 M01S00343.tduout +++| outrec.comment := '';
00351 M01S00344.tduout +++| outrec.opcode := 'IDENT';
00352 M01S00345.tduout +++| outrec.parameters := parm_record.model_name;
00353 M01S00346.tduout +++| write_opcode_line;
00354 M01S00347.tduout +++| outrec.opcode := 'LCC';
00355 M01S00348.tduout +++| outrec.parameters := 'GROUP(VIRTERM)';
00356 M01S00349.tduout +++| write_opcode_line;
00357 M01S00350.tduout +++| outrec.parameters := '';
00358 M01S00351.tduout +++| STRINGREP(outrec.parameters,stringrep_len, 'CAPSULE(':8,
00359 M01S00352.tduout +++| parm_record.model_name(1,parm_record.model_name_len),
00360 M01S00353.tduout +++| ')':1 );
00361 M01S00354.tduout +++| write_opcode_line;
00362 M01S00355.tduout +++| outrec.opcode := 'ENTRY';
00363 M01S00356.tduout +++| outrec.parameters := parm_record.model_name;
00364 M01S00357.tduout +++| write_opcode_line;
00365 M01S00358.tduout +++| start_word_output;
00366 M01S00359.tduout +++| outrec.line_type := opcode_line;
00367 M01S00360.tduout +++| outrec.label := parm_record.model_name;
00368 M01S00361.tduout +++| outrec.opcode := 'BSS';
00369 M01S00362.tduout +++| outrec.parameters := '0';
00370 M01S00363.tduout +++| write_opcode_line;
00371 M01S00364.tduout +++| outrec.line_type := comment_line;
00372 M01S00365.tduout +++| outrec.comment_text := '';
00373 M01S00366.tduout +++| write_comment;
00374 M01S00367.tduout +++| outrec.comment_text := 'HEADER';
00375 M01S00368.tduout +++| write_comment;
00376 M01S00369.tduout +++| write_comment;
00377 M01S00370.tduout +++| outrec.line_type := opcode_line;
00378 M01S00371.tduout +++| outrec.opcode := 'VFD';
00379 M01S00372.tduout +++| outrec.parameters := '';
00380 M01S00373.tduout +++| STRINGREP(outrec.parameters, stringrep_len,
00381 M01S00374.tduout +++| '42/0L': 5,
00382 M01S00375.tduout +++| parm_record.model_name(2,6)); { without leading 'Z' }
00383 M01S00376.tduout +++| write_opcode_line;
00384 M01S00377.tduout +++| bits_left_in_word := bits_left_in_word - 42;
00385 M01S00378.tduout +++| write_vfd(18, tdu_version_num, 'VERSION NUMBER')
00386 M01S00379.tduout +++| PROCEND write_header;
00387 M01S00380.tduout +++| ?? OLDTITLE ??
00388 M01S00381.tduout +++|
00389 M01S00382.tduout +++| ?? NEWTITLE := 'write_sub_table_pointers' ??
00390 M01S00383.tduout +++| ?? EJECT ??
00391 M01S00384.tduout +++|
00392 M01S00385.tduout +++| PROCEDURE write_sub_table_pointers;
00393 M01S00386.tduout +++| outrec.line_type := comment_line;
00394 M01S00387.tduout +++| outrec.comment_text := '';
00395 M01S00388.tduout +++| write_comment;
00396 M01S00389.tduout +++| outrec.comment_text := 'SUB-TABLE POINTERS';
00397 M01S00390.tduout +++| write_comment;
00398 M01S00391.tduout +++| write_comment; { comment_text was automatically blanked}
00399 M01S00392.tduout +++| start_word_output;
00400 M01S00393.tduout +++| FOR subtable_index := 1 TO subtable_count DO
00401 M01S00394.tduout +++| IF bits_left_in_word < 12 THEN
00402 M01S00395.tduout +++| start_word_output;
00403 M01S00396.tduout +++| IFEND;
00404 M01S00397.tduout +++| outrec.line_type := opcode_line;
00405 M01S00398.tduout +++| outrec.opcode := 'VFD';
00406 M01S00399.tduout +++| outrec.parameters := '';
00407 M01S00400.tduout +++| STRINGREP(outrec.parameters, stringrep_len,
00408 M01S00401.tduout +++| '12/',
00409 M01S00402.tduout +++| subtable_list[subtable_index].label:
00410 M01S00403.tduout +++| subtable_list[subtable_index].label_len,
00411 M01S00404.tduout +++| '-',
00412 M01S00405.tduout +++| parm_record.model_name(1,parm_record.model_name_len));
00413 M01S00406.tduout +++| write_opcode_line;
00414 M01S00407.tduout +++| bits_left_in_word := bits_left_in_word - 12;
00415 M01S00408.tduout +++| FOREND;
00416 M01S00409.tduout +++| outrec.line_type := opcode_line;
00417 M01S00410.tduout +++| IF bits_left_in_word > 0 THEN { make explicit filler }
00418 M01S00411.tduout +++| write_vfd(bits_left_in_word, 0, 'RESERVED');
00419 M01S00412.tduout +++| IFEND;
00420 M01S00413.tduout +++| start_word_output;
00421 M01S00414.tduout +++| outrec.line_type := opcode_line;
00422 M01S00415.tduout +++| { write_vfd(target_wordsize, 0, 'RESERVED') }
00423 M01S00416.tduout +++| write_tab_protect_parms;
00424 M01S00417.tduout +++| PROCEND write_sub_table_pointers;
00425 M01S00418.tduout +++| ?? OLDTITLE ??
00426 M01S00419.tduout +++|
00427 M01S00420.tduout +++| ?? NEWTITLE := 'write_parameters' ??
00428 M01S00421.tduout +++| ?? EJECT ??
00429 M01S00422.tduout +++|
00430 M01S00423.tduout +++| PROCEDURE write_parameters;
00431 M01S00424.tduout +++| VAR
00432 M01S00425.tduout +++| parm_ndx: INTEGER;
00433 M01S00426.tduout +++|
00434 M01S00427.tduout +++| outrec.line_type := comment_line;
00435 M01S00428.tduout +++| outrec.comment_text := '';
00436 M01S00429.tduout +++| write_comment;
00437 M01S00430.tduout +++| outrec.comment_text := 'PARAMETERS';
00438 M01S00431.tduout +++| write_comment;
00439 M01S00432.tduout +++| write_comment;
00440 M01S00433.tduout +++| start_word_output;
00441 M01S00434.tduout +++| outrec.line_type := opcode_line;
00442 M01S00435.tduout +++| write_vfd(6, parm_record.cursor_encoding,
00443 M01S00436.tduout +++| 'CURSOR ADDRESSING TYPE');
00444 M01S00437.tduout +++| write_vfd(8, parm_record.cursor_bias, 'CURSOR ADDRESSING BIAS');
00445 M01S00438.tduout +++|
00446 M01S00439.tduout +++| { FOR parm_ndx := 0 TO cursor_behavior_max DO }
00447 M01S00440.tduout +++| FOR parm_ndx := 0 TO cursor_behavior_div DO
00448 M01S00441.tduout +++| write_vfd(4, ORD(parm_record.cursor_behavior[parm_ndx]),
00449 M01S00442.tduout +++| 'CURSOR BEHAVIOR');
00450 M01S00443.tduout +++| FOREND;
00451 M01S00444.tduout +++|
00452 M01S00445.tduout +++| write_vfd(1, ORD(parm_record.cursor_pos_column_flag),
00453 M01S00446.tduout +++| 'COLUMNS BEFORE ROWS FLAG');
00454 M01S00447.tduout +++| FOR parm_ndx := 0 TO 1 DO
00455 M01S00448.tduout +++| write_vfd(3, parm_record.cursor_pos_length[parm_ndx],
00456 M01S00449.tduout +++| 'NUMBER OF DIGITS IN CURSOR POSITION');
00457 M01S00450.tduout +++| FOREND;
00458 M01S00451.tduout +++| write_vfd(bits_left_in_word, 0, 'RESERVED');
00459 M01S00452.tduout +++|
00460 M01S00453.tduout +++| start_word_output;
00461 M01S00454.tduout +++| outrec.line_type := opcode_line;
00462 M01S00455.tduout +++| FOR parm_ndx := 0 TO parm_flag_max DO
00463 M01S00456.tduout +++| write_vfd(1, ORD(parm_record.flag[parm_ndx]), 'FLAG');
00464 M01S00457.tduout +++| FOREND;
00465 M01S00458.tduout +++| write_vfd(3, parm_record.function_key_mark, 'FUNCTION KEY MARK')
00466 M01S00459.tduout +++| PROCEND write_parameters;
00467 M01S00460.tduout +++| ?? OLDTITLE ??
00468 M01S00461.tduout +++|
00469 M01S00462.tduout +++| ?? NEWTITLE := 'write_size_table' ??
00470 M01S00463.tduout +++| ?? EJECT ??
00471 M01S00464.tduout +++|
00472 M01S00465.tduout +++| PROCEDURE write_size_table;
00473 M01S00466.tduout +++| VAR
00474 M01S00467.tduout +++| size_ndx: INTEGER;
00475 M01S00468.tduout +++|
00476 M01S00469.tduout +++| outrec.line_type := comment_line;
00477 M01S00470.tduout +++| outrec.comment_text := '';
00478 M01S00471.tduout +++| write_comment;
00479 M01S00472.tduout +++| outrec.comment_text := 'SCREEN SIZES';
00480 M01S00473.tduout +++| write_comment;
00481 M01S00474.tduout +++| write_comment;
00482 M01S00475.tduout +++| start_word_output;
00483 M01S00476.tduout +++| outrec.line_type := opcode_line;
00484 M01S00477.tduout +++| FOR size_ndx := 0 TO 3 DO
00485 M01S00478.tduout +++| write_vfd(8, parm_record.size[size_ndx].cols, 'X SIZE (COLUMNS)');
00486 M01S00479.tduout +++| write_vfd(7, parm_record.size[size_ndx].rows, 'Y SIZE (ROWS)')
00487 M01S00480.tduout +++| FOREND
00488 M01S00481.tduout +++| PROCEND write_size_table;
00489 M01S00482.tduout +++| ?? OLDTITLE ??
00490 M01S00483.tduout +++|
00491 M01S00484.tduout +++| ?? NEWTITLE := 'write_subtable_start' ??
00492 M01S00485.tduout +++| ?? EJECT ??
00493 M01S00486.tduout +++|
00494 M01S00487.tduout +++| PROCEDURE write_subtable_start;
00495 M01S00488.tduout +++| outrec.line_type := comment_line;
00496 M01S00489.tduout +++| outrec.comment_text := '';
00497 M01S00490.tduout +++| write_comment;
00498 M01S00491.tduout +++| outrec.comment_text := 'START OF SUB-TABLES';
00499 M01S00492.tduout +++| write_comment;
00500 M01S00493.tduout +++| write_comment
00501 M01S00494.tduout +++| PROCEND write_subtable_start;
00502 M01S00495.tduout +++| ?? OLDTITLE ??
00503 M01S00496.tduout +++|
00504 M01S00497.tduout +++| ?? NEWTITLE := 'write_output_table' ??
00505 M01S00498.tduout +++| ?? EJECT ??
00506 M01S00499.tduout +++|
00507 M01S00500.tduout +++| PROCEDURE write_output_table;
00508 M01S00501.tduout +++|
00509 M01S00502.tduout +++| outrec.line_type := comment_line;
00510 M01S00503.tduout +++| outrec.comment_text := '';
00511 M01S00504.tduout +++| write_comment;
00512 M01S00505.tduout +++| outrec.comment_text := 'OUTPUT SUB-TABLE';
00513 M01S00506.tduout +++| write_comment;
00514 M01S00507.tduout +++| outrec.comment_text := ' OFFSETS BY ORDINAL';
00515 M01S00508.tduout +++| write_comment;
00516 M01S00509.tduout +++| write_comment;
00517 M01S00510.tduout +++| start_word_output;
00518 M01S00511.tduout +++| outrec.line_type := opcode_line;
00519 M01S00512.tduout +++| write_ordinals(^dump_output_node);
00520 M01S00513.tduout +++|
00521 M01S00514.tduout +++| outrec.line_type := comment_line;
00522 M01S00515.tduout +++| outrec.comment_text := '';
00523 M01S00516.tduout +++| write_comment;
00524 M01S00517.tduout +++| outrec.comment_text := ' OUTPUT CHARACTER SEQUENCES';
00525 M01S00518.tduout +++| write_comment;
00526 M01S00519.tduout +++| write_comment;
00527 M01S00520.tduout +++| outrec.line_type := opcode_line;
00528 M01S00521.tduout +++| write_char_sequences(^dump_output_node)
00529 M01S00522.tduout +++| PROCEND write_output_table;
00530 M01S00523.tduout +++| ?? OLDTITLE ??
00531 M01S00524.tduout +++|
00532 M01S00525.tduout +++| ?? NEWTITLE := 'write_input_table' ??
00533 M01S00526.tduout +++| ?? EJECT ??
00534 M01S00527.tduout +++|
00535 M01S00528.tduout +++| PROCEDURE write_input_table;
00536 M01S00529.tduout +++| VAR
00537 M01S00530.tduout +++| table_size: INTEGER,
00538 M01S00531.tduout +++| node_returned: BOOLEAN;
00539 M01S00532.tduout +++|
00540 M01S00533.tduout +++| ?? NEWTITLE := 'write_input_item' ??
00541 M01S00534.tduout +++| ?? SKIP := 4 ??
00542 M01S00535.tduout +++|
00543 M01S00536.tduout +++| PROCEDURE write_input_item (in_node: ^input_node);
00544 M01S00537.tduout +++|
00545 M01S00538.tduout +++| ?? NEWTITLE := 'write_char' ??
00546 M01S00539.tduout +++| ?? SKIP := 4 ??
00547 M01S00540.tduout +++|
00548 M01S00541.tduout +++| PROCEDURE write_char(char_value: INTEGER; comment: STRING(*));
00549 M01S00542.tduout +++|
00550 M01S00543.tduout +++| outrec.line_type := opcode_line;
00551 M01S00544.tduout +++| IF bits_left_in_word = target_wordsize THEN { first word only }
00552 M01S00545.tduout +++| write_vfd(4, 0, 'FILLER');
00553 M01S00546.tduout +++| IFEND;
00554 M01S00547.tduout +++| IF bits_left_in_word < target_char_size THEN
00555 M01S00548.tduout +++| start_word_output;
00556 M01S00549.tduout +++| outrec.line_type := opcode_line;
00557 M01S00550.tduout +++| write_vfd(4, 0, 'FILLER');
00558 M01S00551.tduout +++| IFEND;
00559 M01S00552.tduout +++| write_vfd(target_char_size, char_value, comment);
00560 M01S00553.tduout +++| PROCEND write_char;
00561 M01S00554.tduout +++| ?? OLDTITLE ??
00562 M01S00555.tduout +++|
00563 M01S00556.tduout +++| ?? NEWTITLE := 'write_action' ??
00564 M01S00557.tduout +++| ?? SKIP := 4 ??
00565 M01S00558.tduout +++|
00566 M01S00559.tduout +++| PROCEDURE write_action (action: input_action);
00567 M01S00560.tduout +++| VAR
00568 M01S00561.tduout +++| comment: STRING(30),
00569 M01S00562.tduout +++| integer_string: STRING(6),
00570 M01S00563.tduout +++| i_s_length: ost$string_length; { subrange of integer }
00571 M01S00564.tduout +++|
00572 M01S00565.tduout +++| IF action.ordinal = no_ordinal THEN { offset to next item }
00573 M01S00566.tduout +++| comment := '';
00574 M01S00567.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00575 M01S00568.tduout +++| action.next_offset, 10); { offset in string format }
00576 M01S00569.tduout +++| STRINGREP(comment, stringrep_len,
00577 M01S00570.tduout +++| 'OFFSET ': 8, integer_string: i_s_length);
00578 M01S00571.tduout +++| write_char(action.next_offset DIV 128, comment); { high_order}
00579 M01S00572.tduout +++| write_char(action.next_offset MOD 128, ''); { low-order}
00580 M01S00573.tduout +++| ELSE { ordinal }
00581 M01S00574.tduout +++| comment := '';
00582 M01S00575.tduout +++| utp$convert_integer_to_string(integer_string, i_s_length,
00583 M01S00576.tduout +++| action.ordinal, 10); { ordinal in string format }
00584 M01S00577.tduout +++| STRINGREP(comment, stringrep_len,
00585 M01S00578.tduout +++| 'ORDINAL ': 8, integer_string: i_s_length);
00586 M01S00579.tduout +++| write_char((16383-action.ordinal) DIV 128, comment);
00587 M01S00580.tduout +++| write_char((16383-action.ordinal) MOD 128, ''); { low-order }
00588 M01S00581.tduout +++| IFEND;
00589 M01S00582.tduout +++| PROCEND write_action;
00590 M01S00583.tduout +++| ?? OLDTITLE ??
00591 M01S00584.tduout +++|
00592 M01S00585.tduout +++| ?? NEWTITLE := 'write_fail_node' ??
00593 M01S00586.tduout +++| ?? SKIP := 4 ??
00594 M01S00587.tduout +++|
00595 M01S00588.tduout +++| PROCEDURE write_fail_node (in_node: ^input_node);
00596 M01S00589.tduout +++| write_char(0, '***** FAIL *****');
00597 M01S00590.tduout +++| PROCEND write_fail_node;
00598 M01S00591.tduout +++| ?? OLDTITLE ??
00599 M01S00592.tduout +++|
00600 M01S00593.tduout +++| ?? NEWTITLE := 'write_list_node' ??
00601 M01S00594.tduout +++| ?? SKIP := 4 ??
00602 M01S00595.tduout +++|
00603 M01S00596.tduout +++| PROCEDURE write_list_node (in_node: ^input_node);
00604 M01S00597.tduout +++| VAR
00605 M01S00598.tduout +++| char_ndx: INTEGER;
00606 M01S00599.tduout +++|
00607 M01S00600.tduout +++| write_char(1, '***** LIST *****');
00608 M01S00601.tduout +++| write_char(in_node^.list_character_count, 'LIST COUNT');
00609 M01S00602.tduout +++| FOR char_ndx := 1 to in_node^.list_character_count DO
00610 M01S00603.tduout +++| write_char(ORD(in_node^.list_pointer^[char_ndx].character),
00611 M01S00604.tduout +++| '');
00612 M01S00605.tduout +++| write_action(in_node^.list_pointer^[char_ndx].action);
00613 M01S00606.tduout +++| FOREND;
00614 M01S00607.tduout +++| PROCEND write_list_node;
00615 M01S00608.tduout +++| ?? OLDTITLE ??
00616 M01S00609.tduout +++|
00617 M01S00610.tduout +++| ?? NEWTITLE := 'write_range_node' ??
00618 M01S00611.tduout +++| ?? SKIP := 4 ??
00619 M01S00612.tduout +++|
00620 M01S00613.tduout +++| PROCEDURE write_range_node (in_node: ^input_node);
00621 M01S00614.tduout +++| VAR
00622 M01S00615.tduout +++| char_ndx: INTEGER;
00623 M01S00616.tduout +++|
00624 M01S00617.tduout +++| write_char(2, '***** RANGE *****');
00625 M01S00618.tduout +++| write_char(ORD(in_node^.range_lower_bound), 'LOWER BOUND');
00626 M01S00619.tduout +++| write_char(ORD(in_node^.range_upper_bound), 'UPPER BOUND');
00627 M01S00620.tduout +++| FOR char_ndx := ORD(in_node^.range_lower_bound) TO
00628 M01S00621.tduout +++| ORD(in_node^.range_upper_bound) DO
00629 M01S00622.tduout +++| write_action(in_node^.range_pointer^[char_ndx]);
00630 M01S00623.tduout +++| FOREND;
00631 M01S00624.tduout +++| PROCEND write_range_node;
00632 M01S00625.tduout +++| ?? OLDTITLE ??
00633 M01S00626.tduout +++|
00634 M01S00627.tduout +++| ?? NEWTITLE := 'write_sar_node' ??
00635 M01S00628.tduout +++| ?? SKIP := 4 ??
00636 M01S00629.tduout +++|
00637 M01S00630.tduout +++| PROCEDURE write_sar_node (in_node: ^input_node);
00638 M01S00631.tduout +++|
00639 M01S00632.tduout +++| write_char(3, '***** SINGLE-ACTION RANGE *****');
00640 M01S00633.tduout +++| write_char(ORD(in_node^.sar_lower_bound), 'LOWER BOUND');
00641 M01S00634.tduout +++| write_char(ORD(in_node^.sar_upper_bound), 'UPPER BOUND');
00642 M01S00635.tduout +++| write_action(in_node^.sar_action);
00643 M01S00636.tduout +++| PROCEND write_sar_node;
00644 M01S00637.tduout +++| ?? OLDTITLE ??
00645 M01S00638.tduout +++|
00646 M01S00639.tduout +++| ?? EJECT ??
00647 M01S00640.tduout +++|
00648 M01S00641.tduout +++| CASE in_node^.opcode OF
00649 M01S00642.tduout +++| = fail =
00650 M01S00643.tduout +++| write_fail_node(in_node);
00651 M01S00644.tduout +++| = list =
00652 M01S00645.tduout +++| write_list_node(in_node);
00653 M01S00646.tduout +++| = range =
00654 M01S00647.tduout +++| write_range_node(in_node);
00655 M01S00648.tduout +++| = single_action_range =
00656 M01S00649.tduout +++| write_sar_node(in_node);
00657 M01S00650.tduout +++| CASEND;
00658 M01S00651.tduout +++| PROCEND write_input_item;
00659 M01S00652.tduout +++| ?? OLDTITLE ??
00660 M01S00653.tduout +++|
00661 M01S00654.tduout +++| ?? EJECT ??
00662 M01S00655.tduout +++|
00663 M01S00656.tduout +++| outrec.line_type := comment_line;
00664 M01S00657.tduout +++| outrec.comment_text := '';
00665 M01S00658.tduout +++| write_comment;
00666 M01S00659.tduout +++| outrec.comment_text := 'INPUT SUB-TABLE';
00667 M01S00660.tduout +++| write_comment;
00668 M01S00661.tduout +++| write_comment;
00669 M01S00662.tduout +++| start_word_output;
00670 M01S00663.tduout +++| outrec.line_type := opcode_line;
00671 M01S00664.tduout +++| outrec.label := subtable_list[subtable_input].label;
00672 M01S00665.tduout +++| outrec.opcode := 'BSS';
00673 M01S00666.tduout +++| outrec.parameters := '0';
00674 M01S00667.tduout +++| outrec.comment := '';
00675 M01S00668.tduout +++| write_opcode_line;
00676 M01S00669.tduout +++| reset_input_table(table_size);
00677 M01S00670.tduout +++| dump_input_node(^write_input_item); { pass my procedure to dumper }
00678 M01S00671.tduout +++| IF ( bits_left_in_word > 0 ) AND
00679 M01S00672.tduout +++| ( bits_left_in_word < target_wordsize ) THEN
00680 M01S00673.tduout +++| outrec.line_type := opcode_line;
00681 M01S00674.tduout +++| write_vfd(bits_left_in_word, 0, 'FILLER');
00682 M01S00675.tduout +++| IFEND;
00683 M01S00676.tduout +++| PROCEND write_input_table;
00684 M01S00677.tduout +++| ?? OLDTITLE ??
00685 M01S00678.tduout +++|
00686 M01S00679.tduout +++| ?? NEWTITLE := 'write_key_name_table' ??
00687 M01S00680.tduout +++| ?? EJECT ??
00688 M01S00681.tduout +++|
00689 M01S00682.tduout +++| PROCEDURE write_key_name_table;
00690 M01S00683.tduout +++|
00691 M01S00684.tduout +++| outrec.line_type := comment_line;
00692 M01S00685.tduout +++| outrec.comment_text := '';
00693 M01S00686.tduout +++| write_comment;
00694 M01S00687.tduout +++| outrec.comment_text := 'KEY-NAME SUB-TABLE';
00695 M01S00688.tduout +++| write_comment;
00696 M01S00689.tduout +++| outrec.comment_text := ' ORDINALS BY KEY';
00697 M01S00690.tduout +++| write_comment;
00698 M01S00691.tduout +++| write_comment;
00699 M01S00692.tduout +++| start_word_output;
00700 M01S00693.tduout +++| outrec.line_type := opcode_line;
00701 M01S00694.tduout +++| outrec.label := subtable_list[subtable_names].label;
00702 M01S00695.tduout +++| outrec.opcode := 'BSS';
00703 M01S00696.tduout +++| outrec.parameters := '0';
00704 M01S00697.tduout +++| outrec.comment := '';
00705 M01S00698.tduout +++| write_opcode_line;
00706 M01S00699.tduout +++| write_ordinals(^dump_key_name_node);
00707 M01S00700.tduout +++|
00708 M01S00701.tduout +++| outrec.line_type := comment_line;
00709 M01S00702.tduout +++| outrec.comment_text := '';
00710 M01S00703.tduout +++| write_comment;
00711 M01S00704.tduout +++| outrec.comment_text := ' KEY NAMES';
00712 M01S00705.tduout +++| write_comment;
00713 M01S00706.tduout +++| write_comment;
00714 M01S00707.tduout +++| outrec.line_type := opcode_line;
00715 M01S00708.tduout +++| write_char_sequences(^dump_key_name_node)
00716 M01S00709.tduout +++| PROCEND write_key_name_table;
00717 M01S00710.tduout +++| ?? OLDTITLE ??
00718 M01S00711.tduout +++|
00719 M01S00712.tduout +++| ?? NEWTITLE := 'write_initialization_table' ??
00720 M01S00713.tduout +++| ?? EJECT ??
00721 M01S00714.tduout +++|
00722 M01S00715.tduout +++| PROCEDURE write_initialization_table;
00723 M01S00716.tduout +++| outrec.line_type := comment_line;
00724 M01S00717.tduout +++| outrec.comment_text := '';
00725 M01S00718.tduout +++| write_comment;
00726 M01S00719.tduout +++| outrec.comment_text := 'INITIALIZATION SUB-TABLE';
00727 M01S00720.tduout +++| write_comment;
00728 M01S00721.tduout +++| outrec.comment_text := ' LINE/SCREEN ORDINALS';
00729 M01S00722.tduout +++| write_comment;
00730 M01S00723.tduout +++| write_comment;
00731 M01S00724.tduout +++| start_word_output;
00732 M01S00725.tduout +++| outrec.line_type := opcode_line;
00733 M01S00726.tduout +++| outrec.label := subtable_list[subtable_init].label;
00734 M01S00727.tduout +++| outrec.opcode := 'BSS';
00735 M01S00728.tduout +++| outrec.parameters := '0';
00736 M01S00729.tduout +++| outrec.comment := '';
00737 M01S00730.tduout +++| write_opcode_line;
00738 M01S00731.tduout +++| write_ordinals(^dump_reset_sequence);
00739 M01S00732.tduout +++|
00740 M01S00733.tduout +++| outrec.line_type := comment_line;
00741 M01S00734.tduout +++| outrec.comment_text := '';
00742 M01S00735.tduout +++| write_comment;
00743 M01S00736.tduout +++| outrec.comment_text := ' INITIALIZATION SEQUENCES';
00744 M01S00737.tduout +++| write_comment;
00745 M01S00738.tduout +++| write_comment;
00746 M01S00739.tduout +++| outrec.line_type := opcode_line;
00747 M01S00740.tduout +++| write_char_sequences(^dump_reset_sequence)
00748 M01S00741.tduout +++| PROCEND write_initialization_table;
00749 M01S00742.tduout +++| ?? OLDTITLE ??
00750 M01S00743.tduout +++|
00751 M01S00744.tduout +++| ?? NEWTITLE := 'write_appstr_table' ??
00752 M01S00745.tduout +++| ?? EJECT ??
00753 M01S00746.tduout +++|
00754 M01S00747.tduout +++| PROCEDURE write_appstr_table;
00755 M01S00748.tduout +++| VAR
00756 M01S00749.tduout +++| length: INTEGER,
00757 M01S00750.tduout +++| chars: ^STRING(*),
00758 M01S00751.tduout +++| total_sequences,
00759 M01S00752.tduout +++| total_characters: INTEGER,
00760 M01S00753.tduout +++| node_returned: BOOLEAN,
00761 M01S00754.tduout +++| name: STRING(7);
00762 M01S00755.tduout +++|
00763 M01S00756.tduout +++| ?? NEWTITLE := 'write_appstr_names' ??
00764 M01S00757.tduout +++| ?? SKIP := 4 ??
00765 M01S00758.tduout +++|
00766 M01S00759.tduout +++| PROCEDURE write_appstr_names;
00767 M01S00760.tduout +++| VAR
00768 M01S00761.tduout +++| char_ndx: INTEGER,
00769 M01S00762.tduout +++| comment: STRING(30);
00770 M01S00763.tduout +++|
00771 M01S00764.tduout +++| start_word_output;
00772 M01S00765.tduout +++| outrec.line_type := opcode_line;
00773 M01S00766.tduout +++| comment := name(1,7);
00774 M01S00767.tduout +++| FOR char_ndx := 1 TO 7 DO
00775 M01S00768.tduout +++| write_vfd(6,
00776 M01S00769.tduout +++| utv$convert_ascii_to_ascii64[name(char_ndx)], comment);
00777 M01S00770.tduout +++| comment := ''
00778 M01S00771.tduout +++| FOREND;
00779 M01S00772.tduout +++| write_vfd(18, length, '')
00780 M01S00773.tduout +++| PROCEND write_appstr_names;
00781 M01S00774.tduout +++| ?? OLDTITLE ??
00782 M01S00775.tduout +++|
00783 M01S00776.tduout +++| ?? NEWTITLE := 'write_appstr_sequences' ??
00784 M01S00777.tduout +++| ?? EJECT ??
00785 M01S00778.tduout +++|
00786 M01S00779.tduout +++| PROCEDURE write_appstr_sequences;
00787 M01S00780.tduout +++| VAR
00788 M01S00781.tduout +++| char_ndx: INTEGER,
00789 M01S00782.tduout +++| comment: STRING(30);
00790 M01S00783.tduout +++|
00791 M01S00784.tduout +++| outrec.line_type := opcode_line;
00792 M01S00785.tduout +++| FOR char_ndx := 1 TO length DO
00793 M01S00786.tduout +++| IF bits_left_in_word < target_char_size THEN
00794 M01S00787.tduout +++| start_word_output;
00795 M01S00788.tduout +++| outrec.line_type := opcode_line;
00796 M01S00789.tduout +++| write_vfd(4, 0, 'FILLER')
00797 M01S00790.tduout +++| IFEND;
00798 M01S00791.tduout +++| write_vfd(target_char_size,
00799 M01S00792.tduout +++| ORD(chars^(char_ndx)), '');
00800 M01S00793.tduout +++| FOREND;
00801 M01S00794.tduout +++| IF bits_left_in_word > 0 THEN
00802 M01S00795.tduout +++| outrec.line_type := opcode_line;
00803 M01S00796.tduout +++| write_vfd(bits_left_in_word, 0, 'FILLER')
00804 M01S00797.tduout +++| IFEND
00805 M01S00798.tduout +++| PROCEND write_appstr_sequences;
00806 M01S00799.tduout +++| ?? OLDTITLE ??
00807 M01S00800.tduout +++| ?? EJECT ??
00808 M01S00801.tduout +++|
00809 M01S00802.tduout +++| outrec.line_type := comment_line;
00810 M01S00803.tduout +++| outrec.comment_text := '';
00811 M01S00804.tduout +++| write_comment;
00812 M01S00805.tduout +++| outrec.comment_text := 'APPLICATION STRING SUB-TABLE';
00813 M01S00806.tduout +++| write_comment;
00814 M01S00807.tduout +++| write_comment;
00815 M01S00808.tduout +++| start_word_output;
00816 M01S00809.tduout +++| outrec.line_type := opcode_line;
00817 M01S00810.tduout +++| outrec.label := subtable_list[subtable_appstr].label;
00818 M01S00811.tduout +++| outrec.opcode := 'BSS';
00819 M01S00812.tduout +++| outrec.parameters := '0';
00820 M01S00813.tduout +++| outrec.comment := '';
00821 M01S00814.tduout +++| write_opcode_line;
00822 M01S00815.tduout +++|
00823 M01S00816.tduout +++| reset_appstr_table;
00824 M01S00817.tduout +++| REPEAT
00825 M01S00818.tduout +++| dump_appstr_node(name, length, chars,
00826 M01S00819.tduout +++| total_sequences, total_characters, node_returned);
00827 M01S00820.tduout +++| IF node_returned THEN
00828 M01S00821.tduout +++| write_appstr_names;
00829 M01S00822.tduout +++| write_appstr_sequences
00830 M01S00823.tduout +++| IFEND
00831 M01S00824.tduout +++| UNTIL NOT node_returned;
00832 M01S00825.tduout +++| start_word_output;
00833 M01S00826.tduout +++| outrec.line_type := opcode_line;
00834 M01S00827.tduout +++| write_vfd(target_wordsize, 0, 'END OF NAMES')
00835 M01S00828.tduout +++| PROCEND write_appstr_table;
00836 M01S00829.tduout +++| ?? OLDTITLE ??
00837 M01S00830.tduout +++|
00838 M01S00831.tduout +++| ?? NEWTITLE := 'write_trailer' ??
00839 M01S00832.tduout +++| ?? EJECT ??
00840 M01S00833.tduout +++|
00841 M01S00834.tduout +++| PROCEDURE write_trailer;
00842 M01S00835.tduout +++| outrec.line_type := comment_line;
00843 M01S00836.tduout +++| outrec.comment_text := '';
00844 M01S00837.tduout +++| write_comment;
00845 M01S00838.tduout +++| outrec.comment_text := 'END OF TABLE';
00846 M01S00839.tduout +++| write_comment;
00847 M01S00840.tduout +++| write_comment;
00848 M01S00841.tduout +++| outrec.line_type := opcode_line;
00849 M01S00842.tduout +++| outrec.label := subtable_list[subtable_end].label;
00850 M01S00843.tduout +++| outrec.opcode := 'END';
00851 M01S00844.tduout +++| outrec.parameters := '';
00852 M01S00845.tduout +++| write_opcode_line;
00853 M01S00846.tduout +++| PROCEND write_trailer;
00854 M01S00847.tduout +++| ?? OLDTITLE ??
00855 M01S00848.tduout +++| ?? EJECT ??
00856 M01S00849.tduout +++|
00857 M01S00850.tduout +++| open_file(output_file_sel, output_sel, ascii64_sel);
00858 M01S00851.tduout +++| outrec.line_type := whole_line;
00859 M01S00852.tduout +++| outrec.line_buffer := '';
00860 M01S00853.tduout +++|
00861 M01S00854.tduout +++| write_header;
00862 M01S00855.tduout +++| write_sub_table_pointers;
00863 M01S00856.tduout +++| write_parameters;
00864 M01S00857.tduout +++| write_size_table;
00865 M01S00858.tduout +++| write_subtable_start;
00866 M01S00859.tduout +++|
00867 M01S00860.tduout +++| write_output_table;
00868 M01S00861.tduout +++| write_input_table;
00869 M01S00862.tduout +++| write_key_name_table;
00870 M01S00863.tduout +++| write_appstr_table;
00871 M01S00864.tduout +++| write_initialization_table;
00872 M01S00865.tduout +++| write_trailer;
00873 M01S00866.tduout +++|
00874 M01S00867.tduout +++| close_file(output_file_sel)
00875 M01S00868.tduout +++| PROCEND write_tables;
00876 M01S00869.tduout +++| ?? OLDTITLE ??
00877 M01S00870.tduout +++|
00878 M01S00871.tduout +++|MODEND tduout;
cdc/nos2.source/opl.opl871/deck/tduout.txt · Last modified: by 127.0.0.1