User Tools

Site Tools


cdc:nos2.source:opl.opl871:deck:tduex

Deck TDUEX

2 Modifications

Source

Seq #  *Modification Id* Act 
----------------------------+
00001  M01S00001.tduex   +++|*NOSEQ
00002  M01S00002.tduex   +++|*WIDTH 95
00003  M01S00003.tduex   +++|MODULE tduex;
00004  M01S00004.tduex   +++|
00005  M01S00005.tduex   +++|?? SET ( CHKALL := ON ), RIGHT := 110 ??
00006  M01S00006.tduex   +++|
00007  M01S00007.tduex   +++|{  Program:  TDUEX  }
00008  M01S00001.281l803 +++|{            Copyright Control Data Systems Inc.  1992.  }
00009  M01S00008.tduex   +++|{  Written:  1/84 by R. Lindsey  }
00010  M01S00009.tduex   +++|{  Version:  Cyber 170, version 1 }
00011  M01S00010.tduex   +++|{  Purpose:  Compile terminal definitions for the use of the terminal- }
00012  M01S00011.tduex   +++|{            independent handler VIRTERM.  This handler is used by FSE, }
00013  M01S00012.tduex   +++|{            SCREEN, and possibly other programs.  }
00014  M01S00013.tduex   +++|{            TDU takes its input ("source") in the form of SCL-like statements}
00015  M01S00014.tduex   +++|{            which define the characteristics of the particular terminal.  }
00016  M01S00015.tduex   +++|{            As output ("object") it produces a Virtual Terminal Table (VTT) }
00017  M01S00016.tduex   +++|{            which is in the form of COMPASS source code.  This source is }
00018  M01S00017.tduex   +++|{            in turn fed through COMPASS which produces a relocatable version,}
00019  M01S00018.tduex   +++|{            which is then linked to produce the absolute version that can be }
00020  M01S00019.tduex   +++|{            directly loaded by VIRTERM.  }
00021  M01S00020.tduex   +++|{  Modules:  The TDU program is composed of four separately compiled modules: }
00022  M01S00021.tduex   +++|{            o  TDUEX (this module) is the main program.  It calls procedures }
00023  M01S00022.tduex   +++|{               from the other modules.  This module also supplies file- and }
00024  M01S00023.tduex   +++|{               error-handling procedures used by all the other modules. }
00025  M01S00024.tduex   +++|{            o  TDUIN performs the input handling functions.  It reads the }
00026  M01S00025.tduex   +++|{               TDL source file, translates it into intermediate form, and }
00027  M01S00026.tduex   +++|{               writes that intermediate output to internal tables managed }
00028  M01S00027.tduex   +++|{               by TDUTAB. }
00029  M01S00028.tduex   +++|{            o  TDUTAB manages the intermediate data produced by TDUIN and }
00030  M01S00029.tduex   +++|{               consumed by TDUOUT.  It hides, as much as possible, all the }
00031  M01S00030.tduex   +++|{               details of the tables which contain this data.  This serves }
00032  M01S00031.tduex   +++|{               to isolate TDUIN and TDUOUT from changes made in each other. }
00033  M01S00032.tduex   +++|{            o  TDUOUT produces the output table from the intermediate data. }
00034  M01S00033.tduex   +++|{               It hides all details of target machine word and byte sizes, }
00035  M01S00034.tduex   +++|{               alignment, and object code format (e.g., the CYBER 170 }
00036  M01S00035.tduex   +++|{               version produces COMPASS source code). }
00037  M01S00036.tduex   +++|
00038  M01S00037.tduex   +++|{ ?? PUSH ( LIST := OFF ) ??          { un-comment this list for no comm list }
00039  M01S00038.tduex   +++|  ?? PUSH ( LIST := ON ) ??           { un-comment this line for commdeck list}
00040  M01S00039.tduex   +++|
00041  M01S00040.tduex   +++|?? NEWTITLE := 'File I/O' ??
00042  M01S00041.tduex   +++|
00043  M01S00042.tduex   +++|{ ***************************************** }
00044  M01S00043.tduex   +++|{ common deck pxiotyp, for file i/o follows }
00045  M01S00044.tduex   +++|*CALL PXIOTYP
00046  M01S00045.tduex   +++|
00047  M01S00046.tduex   +++|{ ********************************************* }
00048  M01S00047.tduex   +++|{ common deck lgz, for legible file i/o follows }
00049  M01S00048.tduex   +++|*CALLALL LGZ
00050  M01S00049.tduex   +++|
00051  M01S00050.tduex   +++|{ ************************************ }
00052  M01S00051.tduex   +++|{ common deck fz, for file i/o follows }
00053  M01S00052.tduex   +++|*CALLALL FZ
00054  M01S00053.tduex   +++|
00055  M01S00054.tduex   +++|?? OLDTITLE ??
00056  M01S00055.tduex   +++|?? POP ??
00057  M01S00056.tduex   +++|?? NEWTITLE := 'Error handling, initialization, and messages' ??
00058  M01S00057.tduex   +++|?? EJECT ??
00059  M01S00058.tduex   +++|
00060  M01S00059.tduex   +++|{ ************************************************************** }
00061  M01S00060.tduex   +++|{ constants and types for procedures which are XDCL'ed in TDUEX: }
00062  M01S00061.tduex   +++|*CALL ZTDCERR
00063  M01S00062.tduex   +++|*CALL ZTDTFIL
00064  M01S00063.tduex   +++|
00065  M01S00064.tduex   +++|{ ************************ }
00066  M01S00065.tduex   +++|{ parser error conditions: }
00067  M01S00066.tduex   +++|*CALL ZTDAMT0
00068  M01S00067.tduex   +++|*CALL ZTDCCON
00069  M01S00068.tduex   +++|*CALL ZTDCCLC
00070  M01S00069.tduex   +++|
00071  M01S00070.tduex   +++|{ **************************** }
00072  M01S00071.tduex   +++|{ initialization & termination }
00073  M01S00072.tduex   +++|*CALL ZUTPCSA
00074  M01S00073.tduex   +++|*CALL ZOSPINI
00075  M01S00074.tduex   +++|*CALL ZOSPEND
00076  M01S00075.tduex   +++|
00077  M01S00076.tduex   +++|{ ************************* }
00078  M01S00077.tduex   +++|{ status message formatting }
00079  M01S00078.tduex   +++|*CALL ZOSPFMG
00080  M01S00079.tduex   +++|
00081  M01S00080.tduex   +++|?? OLDTITLE ??
00082  M01S00081.tduex   +++|
00083  M01S00082.tduex   +++|  PROCEDURE [XREF] read_tdl_statements;
00084  M01S00083.tduex   +++|
00085  M01S00084.tduex   +++|  PROCEDURE [XREF] initialize_tables;
00086  M01S00085.tduex   +++|
00087  M01S00086.tduex   +++|  PROCEDURE [XREF] write_tables;
00088  M01S00087.tduex   +++|
00089  M01S00088.tduex   +++|  PROCEDURE [XREF] optimize_tables;
00090  M01S00089.tduex   +++|
00091  M01S00090.tduex   +++|  ?? EJECT ??
00092  M01S00091.tduex   +++|{ ?? POP ??
00093  M01S00092.tduex   +++|
00094  M01S00093.tduex   +++|  VAR
00095  M01S00094.tduex   +++|     tdu_version_num: [XDCL] INTEGER := 1; { version 1 }
00096  M01S00095.tduex   +++|
00097  M01S00096.tduex   +++|  VAR
00098  M01S00097.tduex   +++|     error_flag: BOOLEAN := FALSE,    { an error has occurred }
00099  M01S00098.tduex   +++|
00100  M01S00099.tduex   +++|     input_file,
00101  M01S00100.tduex   +++|     output_file,
00102  M01S00101.tduex   +++|     error_file: file,
00103  M01S00102.tduex   +++|     input_file_name,                 { from control statement }
00104  M01S00103.tduex   +++|     output_file_name,
00105  M01S00104.tduex   +++|     error_file_name: ost$name_descriptor,
00106  M01S00105.tduex   +++|
00107  M01S00106.tduex   +++|     status: ost$status,
00108  M01S00107.tduex   +++|
00109  M01S00108.tduex   +++|     command_name: ost$name_descriptor,
00110  M01S00109.tduex   +++|     control_statement_arguments: ARRAY [ 1 .. 3 ] OF STRING(7)
00111  M01S00110.tduex   +++|        := [ 'TDUIN', 'TDUOUT', 'OUTPUT' ];
00112  M01S00111.tduex   +++|
00113  M01S00112.tduex   +++|  ?? NEWTITLE := 'open_file' ??
00114  M01S00113.tduex   +++|  ?? EJECT ??
00115  M01S00114.tduex   +++|
00116  M01S00115.tduex   +++|  PROCEDURE [XDCL] open_file (file_id: file_selector;
00117  M01S00116.tduex   +++|        input_output: input_output_selector;
00118  M01S00117.tduex   +++|        code_set: code_set_selector);
00119  M01S00118.tduex   +++|     VAR
00120  M01S00119.tduex   +++|        f: file,
00121  M01S00120.tduex   +++|        f_name: ost$name_descriptor;
00122  M01S00121.tduex   +++|
00123  M01S00122.tduex   +++|     CASE file_id OF
00124  M01S00123.tduex   +++|        = input_file_sel =
00125  M01S00124.tduex   +++|           f := input_file;
00126  M01S00125.tduex   +++|           f_name := input_file_name;
00127  M01S00126.tduex   +++|        = output_file_sel =
00128  M01S00127.tduex   +++|           f := output_file;
00129  M01S00128.tduex   +++|           f_name := output_file_name;
00130  M01S00129.tduex   +++|        = error_file_sel =
00131  M01S00130.tduex   +++|           f := error_file;
00132  M01S00131.tduex   +++|           f_name := error_file_name;
00133  M01S00132.tduex   +++|     CASEND;
00134  M01S00133.tduex   +++|     CASE input_output OF
00135  M01S00134.tduex   +++|        = input_sel =
00136  M01S00135.tduex   +++|           lg#open(f, f_name.str(1,f_name.length), old#, input#, first#);
00137  M01S00136.tduex   +++|        = output_sel =
00138  M01S00137.tduex   +++|           lg#open(f, f_name.str(1,f_name.length), new#, output#, first#);
00139  M01S00138.tduex   +++|     CASEND;
00140  M01S00139.tduex   +++|     CASE code_set OF
00141  M01S00140.tduex   +++|        = ascii_sel =
00142  M01S00141.tduex   +++|           ;
00143  M01S00142.tduex   +++|        = ascii64_sel =
00144  M01S00143.tduex   +++|           lg#codeset(f, ascii64#);   { use 6-bit display code }
00145  M01S00144.tduex   +++|     CASEND;
00146  M01S00145.tduex   +++|     CASE file_id OF
00147  M01S00146.tduex   +++|        = input_file_sel =
00148  M01S00147.tduex   +++|           input_file := f;
00149  M01S00148.tduex   +++|        = output_file_sel =
00150  M01S00149.tduex   +++|           output_file := f;
00151  M01S00150.tduex   +++|        = error_file_sel =
00152  M01S00151.tduex   +++|           error_file := f;
00153  M01S00152.tduex   +++|     CASEND;
00154  M01S00153.tduex   +++|  PROCEND open_file;
00155  M01S00154.tduex   +++|  ?? OLDTITLE ??
00156  M01S00155.tduex   +++|
00157  M01S00156.tduex   +++|  ?? NEWTITLE := 'close_file' ??
00158  M01S00157.tduex   +++|  ?? SKIP := 4 ??
00159  M01S00158.tduex   +++|
00160  M01S00159.tduex   +++|  PROCEDURE [XDCL] close_file (file_id: file_selector);
00161  M01S00160.tduex   +++|     CASE file_id OF
00162  M01S00161.tduex   +++|        = input_file_sel =
00163  M01S00162.tduex   +++|           lg#close(input_file, first#);
00164  M01S00163.tduex   +++|        = output_file_sel =
00165  M01S00164.tduex   +++|           lg#close(output_file, first#);
00166  M01S00165.tduex   +++|        = error_file_sel =
00167  M01S00166.tduex   +++|           lg#close(error_file, first#);
00168  M01S00167.tduex   +++|     CASEND;
00169  M01S00168.tduex   +++|  PROCEND close_file;
00170  M01S00169.tduex   +++|  ?? OLDTITLE ??
00171  M01S00170.tduex   +++|
00172  M01S00171.tduex   +++|  ?? NEWTITLE := 'get_file' ??
00173  M01S00172.tduex   +++|  ?? EJECT ??
00174  M01S00173.tduex   +++|
00175  M01S00174.tduex   +++|  PROCEDURE [XDCL] get_file (file_id: file_selector;
00176  M01S00175.tduex   +++|        VAR text: STRING(*);
00177  M01S00176.tduex   +++|        VAR text_len: INTEGER;
00178  M01S00177.tduex   +++|        VAR eof_flag: BOOLEAN);
00179  M01S00178.tduex   +++|     VAR
00180  M01S00179.tduex   +++|        structure_mark: file_mark;
00181  M01S00180.tduex   +++|
00182  M01S00181.tduex   +++|     text := '';
00183  M01S00182.tduex   +++|     CASE file_id OF
00184  M01S00183.tduex   +++|        = input_file_sel =
00185  M01S00184.tduex   +++|           lg#get(input_file, text_len, text);
00186  M01S00185.tduex   +++|           f#mark(input_file, structure_mark);
00187  M01S00186.tduex   +++|        = output_file_sel =
00188  M01S00187.tduex   +++|           lg#get(output_file, text_len, text);
00189  M01S00188.tduex   +++|           f#mark(output_file, structure_mark);
00190  M01S00189.tduex   +++|        = error_file_sel =
00191  M01S00190.tduex   +++|           lg#get(error_file, text_len, text);
00192  M01S00191.tduex   +++|           f#mark(error_file, structure_mark);
00193  M01S00192.tduex   +++|     CASEND;
00194  M01S00193.tduex   +++|     IF ( structure_mark = eof# ) OR
00195  M01S00194.tduex   +++|        ( structure_mark = eoi# ) THEN
00196  M01S00195.tduex   +++|        eof_flag := TRUE
00197  M01S00196.tduex   +++|     ELSE
00198  M01S00197.tduex   +++|        eof_flag := FALSE
00199  M01S00198.tduex   +++|     IFEND
00200  M01S00199.tduex   +++|  PROCEND get_file;
00201  M01S00200.tduex   +++|  ?? OLDTITLE ??
00202  M01S00201.tduex   +++|
00203  M01S00202.tduex   +++|  ?? NEWTITLE := 'put_file' ??
00204  M01S00203.tduex   +++|  ?? SKIP := 4 ??
00205  M01S00204.tduex   +++|
00206  M01S00205.tduex   +++|  PROCEDURE [XDCL] put_file (file_id: file_selector;
00207  M01S00206.tduex   +++|        text: STRING(*));
00208  M01S00207.tduex   +++|     CASE file_id OF
00209  M01S00208.tduex   +++|        = input_file_sel =
00210  M01S00209.tduex   +++|           lg#put(input_file, text);
00211  M01S00210.tduex   +++|        = output_file_sel =
00212  M01S00211.tduex   +++|           lg#put(output_file, text);
00213  M01S00212.tduex   +++|        = error_file_sel =
00214  M01S00213.tduex   +++|           lg#put(error_file, text);
00215  M01S00214.tduex   +++|     CASEND
00216  M01S00215.tduex   +++|  PROCEND put_file;
00217  M01S00216.tduex   +++|  ?? OLDTITLE ??
00218  M01S00217.tduex   +++|
00219  M01S00218.tduex   +++|  ?? NEWTITLE := 'report_error' ??
00220  M01S00219.tduex   +++|  ?? EJECT ??
00221  M01S00220.tduex   +++|
00222  M01S00221.tduex   +++|  PROCEDURE [XDCL] report_error (text: STRING(*));
00223  M01S00222.tduex   +++|     VAR
00224  M01S00223.tduex   +++|        str_ndx,
00225  M01S00224.tduex   +++|        str_length: INTEGER;
00226  M01S00225.tduex   +++|
00227  M01S00226.tduex   +++|     IF NOT error_flag THEN
00228  M01S00227.tduex   +++|        open_file(error_file_sel, output_sel, ascii_sel);
00229  M01S00228.tduex   +++|        error_flag := TRUE
00230  M01S00229.tduex   +++|     IFEND;
00231  M01S00230.tduex   +++|     str_ndx := 1;
00232  M01S00231.tduex   +++|     WHILE str_ndx <= STRLENGTH(text) DO
00233  M01S00232.tduex   +++|        str_length := ( STRLENGTH(text) - str_ndx ) + 1;
00234  M01S00233.tduex   +++|        IF str_length > 80 THEN
00235  M01S00234.tduex   +++|           str_length := 80
00236  M01S00235.tduex   +++|        IFEND;
00237  M01S00236.tduex   +++|        put_file(error_file_sel, text(str_ndx, str_length));
00238  M01S00237.tduex   +++|        str_ndx := str_ndx + str_length
00239  M01S00238.tduex   +++|     WHILEND
00240  M01S00239.tduex   +++|  PROCEND report_error;
00241  M01S00240.tduex   +++|  ?? OLDTITLE ??
00242  M01S00241.tduex   +++|
00243  M01S00242.tduex   +++|  ?? NEWTITLE := 'error_status' ??
00244  M01S00243.tduex   +++|  ?? EJECT ??
00245  M01S00244.tduex   +++|
00246  M01S00245.tduex   +++|  PROCEDURE [XDCL] error_status (status: ost$status);
00247  M01S00246.tduex   +++|     VAR
00248  M01S00247.tduex   +++|        reentry,
00249  M01S00248.tduex   +++|        message_complete: BOOLEAN,
00250  M01S00249.tduex   +++|        length: 0 .. osc$max_string_length,
00251  M01S00250.tduex   +++|        msg: STRING(79);
00252  M01S00251.tduex   +++|
00253  M01S00252.tduex   +++|     report_error(' ');
00254  M01S00253.tduex   +++|     reentry := FALSE;
00255  M01S00254.tduex   +++|     REPEAT
00256  M01S00255.tduex   +++|        osp$format_message(reentry, message_complete, length,
00257  M01S00256.tduex   +++|           msg, status);
00258  M01S00257.tduex   +++|        report_error(msg(1,length));
00259  M01S00258.tduex   +++|        reentry := TRUE;
00260  M01S00259.tduex   +++|     UNTIL message_complete;
00261  M01S00260.tduex   +++|  PROCEND error_status;
00262  M01S00261.tduex   +++|  ?? OLDTITLE ??
00263  M01S00262.tduex   +++|
00264  M01S00263.tduex   +++|  ?? NEWTITLE := 'interpret_control_statement' ??
00265  M01S00264.tduex   +++|  ?? EJECT ??
00266  M01S00265.tduex   +++|
00267  M01S00266.tduex   +++|  PROCEDURE interpret_control_statement;
00268  M01S00267.tduex   +++|     VAR
00269  M01S00268.tduex   +++|        command_line_pointer: ^STRING(*),
00270  M01S00269.tduex   +++|        command_line_index: clt$string_index;
00271  M01S00270.tduex   +++|
00272  M01S00271.tduex   +++|     osp$initiate(command_name, command_line_pointer,
00273  M01S00272.tduex   +++|        command_line_index, status);
00274  M01S00273.tduex   +++|     utp$get_control_statement_args(control_statement_arguments);
00275  M01S00274.tduex   +++|     input_file_name.typ := clc$nos170_name;
00276  M01S00275.tduex   +++|     input_file_name.length := 7;
00277  M01S00276.tduex   +++|     input_file_name.str := control_statement_arguments[1];
00278  M01S00277.tduex   +++|     output_file_name.typ := clc$nos170_name;
00279  M01S00278.tduex   +++|     output_file_name.length := 7;
00280  M01S00279.tduex   +++|     output_file_name.str := control_statement_arguments[2];
00281  M01S00280.tduex   +++|     error_file_name.typ := clc$nos170_name;
00282  M01S00281.tduex   +++|     error_file_name.length := 7;
00283  M01S00282.tduex   +++|     error_file_name.str := control_statement_arguments[3]
00284  M01S00283.tduex   +++|  PROCEND interpret_control_statement;
00285  M01S00284.tduex   +++|  ?? OLDTITLE ??
00286  M01S00285.tduex   +++|  ?? EJECT ??
00287  M01S00286.tduex   +++|
00288  M01S00287.tduex   +++|  PROGRAM tduex;
Line S00288 Modification History
M01 (Added by) tduex
M02 (Updated by) tduex1
Seq #  *Modification Id* Act 
----------------------------+
00289  M02S00288.tduex1  ---|     utp$start_metrics_time;
00290  M01S00289.tduex   +++|     interpret_control_statement;
00291  M01S00290.tduex   +++|     initialize_tables;
00292  M01S00291.tduex   +++|     IF NOT error_flag THEN
00293  M01S00292.tduex   +++|        read_tdl_statements;
00294  M01S00293.tduex   +++|        IF NOT error_flag THEN
00295  M01S00294.tduex   +++|           optimize_tables;
00296  M01S00295.tduex   +++|           IF NOT error_flag THEN
00297  M01S00296.tduex   +++|              write_tables
00298  M01S00297.tduex   +++|           IFEND
00299  M01S00298.tduex   +++|        IFEND
00300  M01S00299.tduex   +++|     IFEND;
00301  M01S00300.tduex   +++|     IF error_flag THEN
00302  M01S00301.tduex   +++|        close_file(error_file_sel);
00303  M01S00302.tduex   +++|        { osp$set_status_abnormal(tdc_prod_code, tde_error_termination,
00304  M01S00303.tduex   +++|        {    '', status)
00305  M01S00304.tduex   +++|     IFEND;
Line S00305 Modification History
M01 (Added by) tduex
M02 (Updated by) tduex1
Seq #  *Modification Id* Act 
----------------------------+
00306  M02S00305.tduex1  ---|     utp$report_metrics_time('TDUEX');
00307  M01S00306.tduex   +++|     osp$terminate(command_name, status)
00308  M01S00307.tduex   +++|  PROCEND tduex;
00309  M01S00308.tduex   +++|
00310  M01S00309.tduex   +++|MODEND tduex;
cdc/nos2.source/opl.opl871/deck/tduex.txt · Last modified: by 127.0.0.1