/ascii
ASCII.
/scopy,compile
MODULE tduex;
  
?? SET ( CHKALL := ON ), RIGHT := 110 ??
  
{  Program:  TDUEX  }
{            Copyright Control Data Systems Inc.  1992.  } 
{  Written:  1/84 by R. Lindsey  } 
{  Version:  Cyber 170, version 1 } 
{  Purpose:  Compile terminal definitions for the use of the terminal- }
{            independent handler VIRTERM.  This handler is used by FSE, } 
{            SCREEN, and possibly other programs.  }
{            TDU takes its input ("source") in the form of SCL-like statements} 
{            which define the characteristics of the particular terminal.  }
{            As output ("object") it produces a Virtual Terminal Table (VTT) } 
{            which is in the form of COMPASS source code.  This source is }
{            in turn fed through COMPASS which produces a relocatable version,} 
{            which is then linked to produce the absolute version that can be }
{            directly loaded by VIRTERM.  } 
{  Modules:  The TDU program is composed of four separately compiled modules: } 
{            o  TDUEX (this module) is the main program.  It calls procedures }
{               from the other modules.  This module also supplies file- and } 
{               error-handling procedures used by all the other modules. } 
{            o  TDUIN performs the input handling functions.  It reads the } 
{               TDL source file, translates it into intermediate form, and } 
{               writes that intermediate output to internal tables managed } 
{               by TDUTAB. }
{            o  TDUTAB manages the intermediate data produced by TDUIN and }
{               consumed by TDUOUT.  It hides, as much as possible, all the } 
{               details of the tables which contain this data.  This serves }
{               to isolate TDUIN and TDUOUT from changes made in each other. }
{            o  TDUOUT produces the output table from the intermediate data. }
{               It hides all details of target machine word and byte sizes, }
{               alignment, and object code format (e.g., the CYBER 170 } 
{               version produces COMPASS source code). } 
  
{ ?? PUSH ( LIST := OFF ) ??          { un-comment this list for no comm list } 
  ?? PUSH ( LIST := ON ) ??           { un-comment this line for commdeck list}
  
?? NEWTITLE := 'File I/O' ??
  
{ ***************************************** } 
{ common deck pxiotyp, for file i/o follows }
  
{ PXIOTYP    Contains CYBIL type declarations. } 
  
  TYPE
    file = ^cell,
    file_status = (new#, old#), 
    file_mode = (input#, output#, concurrent#),
    file_encoding = (ascii64#, ascii612#, ascii#), 
    file_mark = (data#, eor#, eof#, eoi#), 
    file_position = (first#, asis#, last#, null#); 
  
  CONST 
    return# = last#;
  
  TYPE
    file_disposition = first# .. return#; 
  
  { i.e. (first#, asis#, return#) }
  
{ ********************************************* } 
{ common deck lgz, for legible file i/o follows } 
  
{ LGZCLOS    Closes legible file. } 
  
  PROCEDURE [XREF] lg#close (legible_file: file; 
    disposition: file_disposition);
  
{ LGZCODE    Sets external character set for legible file. } 
  
  PROCEDURE [XREF] lg#codeset (legible_file: file; 
    codeset: file_encoding);
  
{ LGZCOLN    Returns col. no. in line of legible file last transferred. }
  
  PROCEDURE [XREF] lg#colno (legible_file: file; 
    VAR column_number: integer);
  
{ LGZFIRS    Positions legible file at its Beginning Of Information. } 
  
  PROCEDURE [XREF] lg#first (legible_file: file);
  
{ LGZGET    Reads next complete line from legible file. }
  
  PROCEDURE [XREF] lg#get (legible_file: file; 
    VAR number_of_characters_read: integer; 
    VAR line: string ( * )); 
  
{ LGZGETP    Reads next partial line from legible file. } 
  
  PROCEDURE [XREF] lg#getpart (legible_file: file; 
    VAR last_part_of_line: boolean; 
    VAR number_of_characters_read: integer; 
    VAR partial_line: string ( * ));
  
{ LGZLAST    Positions legible file at its End Of Information. } 
  
  PROCEDURE [XREF] lg#last (legible_file: file);
  
{ LGZOLDC    Returns designator for ext. char. set of legible file. } 
  
  PROCEDURE [XREF] lg#oldcodeset (legible_file: file; 
    VAR codeset: file_encoding);
  
{ LGZOPEN    Opens legible file as local file. }
  
  PROCEDURE [XREF] lg#open (VAR legible_file: file; 
    file_name: string ( * ); 
    status: file_status; 
    mode: file_mode; 
    position: file_position);
  
{ LGZPUT    Writes source string as complete line to legible file. }
  
  PROCEDURE [XREF] lg#put (legible_file: file; 
    line: string ( * )); 
  
{ LGZPUTP    Writes source string as partial line to legible file. } 
  
  PROCEDURE [XREF] lg#putpart (legible_file: file; 
    last_part_of_line: boolean; 
    partial_line: string ( * ));
  
{ LGZTAB    Positions column of next partial write to legible file. }
  
  PROCEDURE [XREF] lg#tab (legible_file: file; 
    column_number: integer);
  
{ LGZWEOF    Writes an End Of File mark on legible file. }
  
  PROCEDURE [XREF] lg#weof (legible_file: file);
  
{ LGZWEOL    Writes an End Of Line to legible file. } 
  
  PROCEDURE [XREF] lg#weol (legible_file: file);
  
{ LGZWEOR    Writes an End Of Record mark on legible file. }
  
  PROCEDURE [XREF] lg#weor (legible_file: file);
  
{ ************************************ }
{ common deck fz, for file i/o follows }
  
{ FZMARK    Returns the file structure mark last encountered on file. }
  
  PROCEDURE [XREF] f#mark (any_file: file; 
    VAR mark: file_mark);
  
{ FZSABF    Sets up file for automatic buffer flushing. }
  
  PROCEDURE [XREF] f#sabf (any_file: file);
  
{ FZTERMI    Returns boolean if file is connected to a terminal. } 
  
  PROCEDURE [XREF] f#terminal (any_file: file; 
    VAR file_is_a_terminal: boolean);
  
{ FZWORDS    Returns length of last transfer to/from file. }
  
  PROCEDURE [XREF] f#words (any_file: file; 
    VAR last_transfer_length: integer); 
  
?? OLDTITLE ??
?? POP ?? 
?? NEWTITLE := 'Error handling, initialization, and messages' ??
?? EJECT ?? 
  
{ ************************************************************** }
{ constants and types for procedures which are XDCL'ed in TDUEX: } 
  
  
  
{ ZCLTSTR    Defines string length and string index for SCL. } 
  
    TYPE
      clt$string_length = integer,
  
      clt$string_index = integer;
  
{ ZOSTSTR    Defines the bounds of strings. } 
  
  CONST 
    osc$max_string_length = osc$max_string_size;
  
  TYPE
    ost$string_length = 0 .. osc$max_string_length;
  
{ OSDSTR    type definitions for string } 
  
  CONST 
    osc$max_string_size = 256;
  
  TYPE
    ost$string_size = 0 .. osc$max_string_size;
  
  TYPE
    ost$string_index = 1 .. osc$max_string_size + 1;
  
  TYPE
    ost$string = record
      size: ost$string_size,
      value: string (osc$max_string_size),
    recend; 
  
  
{ OSDSTAT   Definition of request status record } 
  
  CONST 
    osc$max_condition = 999999,
    osc$status_parameter_delimiter = '"';
  
  TYPE
    ost$status_condition = 0 .. osc$max_condition, 
    ost$status = record
      case normal: boolean of 
      =FALSE= 
        identifier: string (2),
        condition: ost$status_condition,
        text: ost$string, 
      casend, 
    recend; 
  
  
{ ZOSPSSA    Sets status value to indicate abnormal cond. detected. } 
  
  PROCEDURE [XREF] osp$set_status_abnormal ALIAS 'zospssa' 
    ( identifier: string (2);
      condition: ost$status_condition;
      text: string ( * );
      VAR status: ost$status);
  
  
{ ZOSPASP    Appends parameter text to a status variable. } 
  
  PROCEDURE [XREF] osp$append_status_parameter ALIAS 'zospasp' (delimiter: 
    char; 
    text: string ( * );
    VAR status: ost$status);
  
{ ZTDCERR  tdu error-handling constants and types }
  
  CONST 
     tdc_prod_code = 'TD'; 
  
  TYPE
     error_type = (no_error, no_room_error, duplicate_input_error,
        duplicate_error, superset_error, subset_error, not_found_error); 
  
{ ZTDTFIL  TDU file handler data types }
  
  TYPE
     file_selector = ( input_file_sel, output_file_sel, error_file_sel ),
     input_output_selector = ( input_sel, output_sel ), 
     code_set_selector = ( ascii_sel, ascii64_sel ); 
  
{ ************************ }
{ parser error conditions: }
  
{ ZOSTSTA   States reflecting status severity }
  
  TYPE
    ost$status_states = (osc$normal_status, osc$informative_status, 
      osc$warning_status, osc$error_status, osc$fatal_status);
  
 ?? fmt ( format := off ) ?? 
  
   VAR
  
     osv$template_18000 : [static] string (29) :=
       '+ TDU TERMINATED WITH ERRORS.', 
  
     osv$template_18001 : [static] string (43) :=
       '+ CHARACTER VALUE MUST RANGE FROM 0 TO 127.', 
  
     osv$template_18002 : [static] string (15) :=
       '+ INCORRECT +T.', 
  
     osv$template_18003 : [static] string (60) :=
       '+ INCORRECT TYPE--ONLY STRING, INTEGER, OR VARIABLE ALLOWED.',
  
     osv$template_18004 : [static] string (32) :=
       '+ INCORRECT COMMUNICATIONS TYPE.',
  
     osv$template_18005 : [static] string (28) :=
       '+ INCORRECT CURSOR_ENCODING.',
  
     osv$template_18006 : [static] string (48) :=
       '+ CURSOR_BIAS OUT OF RANGE, MUST BE -127 TO 127.',
  
     osv$template_18007 : [static] string (38) :=
       '+ CONTINUATIONS EXCEED 256 CHARACTERS.',
  
     osv$template_18008 : [static] string (39) :=
       '+ EXPECTING VERB OR VARIABLE, FOUND +T.', 
  
     osv$template_18009 : [static] string (19) :=
       '+ EMPTY INPUT FILE.', 
  
     osv$template_18010 : [static] string (26) :=
       '+ NO ROOM IN TABLE FOR +T.',
  
     osv$template_18011 : [static] string (24) :=
       '+ VERB +T APPEARS TWICE.',
  
     osv$template_18012 : [static] string (57) :=
       '+ INPUT SEQUENCE FOR +T IS A SUPERSET OF A PREVIOUS ITEM.', 
  
     osv$template_18013 : [static] string (55) :=
       '+ INPUT SEQUENCE FOR +T IS A SUBSET OF A PREVIOUS ITEM.', 
  
     osv$template_18014 : [static] string (36) :=
       '+ VARIABLE +T HAS NOT BEEN DECLARED.',
  
     osv$template_18015 : [static] string (37) :=
       '+ TABLE OVERFLOW DURING OPTIMIZATION.', 
  
     osv$template_18016 : [static] string (55) :=
       '+ INCORRECT VERB OR MISSING "=" IN VARIABLE ASSIGNMENT.', 
  
     osv$template_18017 : [static] string (46) :=
       '+ DUPLICATE PARAMETERS, BOTH "IN" AND "INOUT".',
  
     osv$template_18018 : [static] string (47) :=
       '+ DUPLICATE PARAMETERS, BOTH "OUT" AND "INOUT".', 
  
     osv$template_18019 : [static] string (45) :=
       '+ TOO MANY SCREEN SIZES SPECIFIED, MAXIMUM 4.', 
  
     osv$template_18020 : [static] string (41) :=
       '+ NUMBER OF ROWS MUST RANGE FROM 0 TO 64.', 
  
     osv$template_18021 : [static] string (45) :=
       '+ NUMBER OF COLUMNS MUST RANGE FROM 0 TO 255.', 
  
     osv$template_18022 : [static] string (48) :=
       '+ INCORRECT "MOVE_PAST.." OR "CHAR_PAST.." TYPE.',
  
     osv$template_18023 : [static] string (19) :=
       '+ NAME IS REQUIRED.', 
  
     osv$template_18024 : [static] string (33) :=
       '+ NAME MUST BE 1 TO 6 CHARACTERS.', 
  
     osv$template_18025 : [static] string (30) :=
       '+ "OUT" REQUIRED FOR SET_SIZE.',
  
     osv$template_18026 : [static] string (64) :=
       '+ INCORRECT NAME--MAY ONLY BE ALPHABETIC AND NUMERIC CHARACTERS.',
  
     osv$template_18027 : [static] string (67) :=
       '+ CURSOR_POS_COLUMN_LENGTH OR CURSOR_POS_ROW_LENGTH MUST BE 0 TO 7' CAT 
       '.', 
  
     osv$template_18028 : [static] string (58) :=
       '+ INPUT SEQUENCE FOR +T IS A DUPLICATE OF A PREVIOUS ITEM.',
  
     osv$template_18029 : [static] string (69) :=
       '+ INCORRECT APPLICATION STRING NAME +T--MAY ONLY USE CDC 63-CHAR S' CAT 
       'ET.', 
  
     osv$template_18030 : [static] string (52) :=
       '+ APPLICATION STRING NAME MUST BE 1 TO 7 CHARACTERS.',
  
     osv$template_18031 : [static] string (69) :=
       '+ FUNCTION_KEY_LEAVES_MARK MUST INDICATE 0 TO 7 CHARACTERS OF BLOT' CAT 
       'CH.'; 
  
   CONST
     osc$ZTDVMT0_count = 32;
 ?? fmt ( format := on ) ?? 
 ?? fmt ( format := off ) ?? 
  
   VAR
  
     osv$template_11000 : [static] string (29) :=
       '+ DOUBLY DEFINED PARAMETER +T', 
  
     osv$template_11001 : [static] string (14) :=
       '+ EXPECTING +T',
  
     osv$template_11002 : [static] string (12) :=
       '+ INVALID +T',
  
     osv$template_11003 : [static] string (21) :=
       '+ INTEGER OVERFLOW +T', 
  
     osv$template_11004 : [static] string (22) :=
       '+ INTEGER TOO LARGE +T',
  
     osv$template_11005 : [static] string (24) :=
       '+ NOT YET IMPLEMENTED +T',
  
     osv$template_11006 : [static] string (28) :=
       '+ VALUE RANGE NOT ALLOWED +T',
  
     osv$template_11007 : [static] string (31) :=
       '+ REQUIRED PARAMETER MISSING +T', 
  
     osv$template_11008 : [static] string (12) :=
       '+ TOO FEW +T',
  
     osv$template_11009 : [static] string (13) :=
       '+ TOO MANY +T', 
  
     osv$template_11010 : [static] string (15) :=
       '+ UNBALANCED +T', 
  
     osv$template_11011 : [static] string (20) :=
       '+ UNKNOWN KEYWORD +T',
  
     osv$template_11012 : [static] string (15) :=
       '+ UNEXPECTED +T', 
  
     osv$template_11013 : [static] string (23) :=
       '+ VALUE OUT OF RANGE +T', 
  
     osv$template_11014 : [static] string (20) :=
       '+ STRING OVERFLOW +T',
  
     osv$template_11015 : [static] string (24) :=
       '+ UNNESTED RELATIONAL +T',
  
     osv$template_11016 : [static] string (19) :=
       '+ TABLE OVERFLOW +T'; 
  
   CONST
     osc$zclvmt0_count = 17;
 ?? fmt ( format := on ) ?? 
  
   VAR
  
     osv$template_99999: [static] string (2) := '+T';
  
   CONST
     osc$template_array_length = 1 +
       osc$ZTDVMT0_count +
       osc$ZCLVMT0_count ;
  
   VAR
     osv$template_table : [XDCL, READ] record
       size : 1 .. osc$max_condition, 
       template_array : array[1 .. osc$template_array_length] of record
         condition_code : 0 .. osc$max_condition,
         state: ost$status_states, 
         template_ptr : ^string(*),
       recend,
     recend := 
     [osc$template_array_length, [
 ?? fmt ( format := off ) ?? 
       [18000, osc$error_status, ^osv$template_18000],
       [18001, osc$error_status, ^osv$template_18001],
       [18002, osc$error_status, ^osv$template_18002],
       [18003, osc$error_status, ^osv$template_18003],
       [18004, osc$error_status, ^osv$template_18004],
       [18005, osc$error_status, ^osv$template_18005],
       [18006, osc$error_status, ^osv$template_18006],
       [18007, osc$error_status, ^osv$template_18007],
       [18008, osc$error_status, ^osv$template_18008],
       [18009, osc$error_status, ^osv$template_18009],
       [18010, osc$error_status, ^osv$template_18010],
       [18011, osc$error_status, ^osv$template_18011],
       [18012, osc$error_status, ^osv$template_18012],
       [18013, osc$error_status, ^osv$template_18013],
       [18014, osc$error_status, ^osv$template_18014],
       [18015, osc$error_status, ^osv$template_18015],
       [18016, osc$error_status, ^osv$template_18016],
       [18017, osc$error_status, ^osv$template_18017],
       [18018, osc$error_status, ^osv$template_18018],
       [18019, osc$error_status, ^osv$template_18019],
       [18020, osc$error_status, ^osv$template_18020],
       [18021, osc$error_status, ^osv$template_18021],
       [18022, osc$error_status, ^osv$template_18022],
       [18023, osc$error_status, ^osv$template_18023],
       [18024, osc$error_status, ^osv$template_18024],
       [18025, osc$error_status, ^osv$template_18025],
       [18026, osc$error_status, ^osv$template_18026],
       [18027, osc$error_status, ^osv$template_18027],
       [18028, osc$error_status, ^osv$template_18028],
       [18029, osc$error_status, ^osv$template_18029],
       [18030, osc$error_status, ^osv$template_18030],
       [18031, osc$error_status, ^osv$template_18031],
 ?? fmt ( format := on ) ?? 
 ?? fmt ( format := off ) ?? 
       [11000, osc$error_status, ^osv$template_11000],
       [11001, osc$error_status, ^osv$template_11001],
       [11002, osc$error_status, ^osv$template_11002],
       [11003, osc$error_status, ^osv$template_11003],
       [11004, osc$error_status, ^osv$template_11004],
       [11005, osc$error_status, ^osv$template_11005],
       [11006, osc$error_status, ^osv$template_11006],
       [11007, osc$fatal_status, ^osv$template_11007],
       [11008, osc$error_status, ^osv$template_11008],
       [11009, osc$error_status, ^osv$template_11009],
       [11010, osc$error_status, ^osv$template_11010],
       [11011, osc$error_status, ^osv$template_11011],
       [11012, osc$error_status, ^osv$template_11012],
       [11013, osc$error_status, ^osv$template_11013],
       [11014, osc$error_status, ^osv$template_11014],
       [11015, osc$error_status, ^osv$template_11015],
       [11016, osc$fatal_status, ^osv$template_11016],
 ?? fmt ( format := on ) ?? 
       [99999, osc$warning_status, ^osv$template_99999]]];
  
{ ZTDCCON  TDU condition codes }
  
CONST 
   tdc$status_id = 'td', 
   tdc$status_condition = 18000;
  
CONST 
   tde_error_termination = tdc$status_condition + 0, 
   {E TDU TERMINATED WITH ERRORS.}
   tde_invalid_character = tdc$status_condition + 1, 
   {E CHARACTER VALUE MUST RANGE FROM 0 TO 127.}
   tde_invalid = tdc$status_condition + 2,
   {E INCORRECT +T.}
   tde_invalid_type = tdc$status_condition + 3, 
   {E INCORRECT TYPE--ONLY STRING, INTEGER, OR VARIABLE ALLOWED.} 
   tde_invalid_comm = tdc$status_condition + 4, 
   {E INCORRECT COMMUNICATIONS TYPE.} 
   tde_invalid_cursor = tdc$status_condition + 5, 
   {E INCORRECT CURSOR_ENCODING.} 
   tde_bias_out_of_range = tdc$status_condition + 6, 
   {E CURSOR_BIAS OUT OF RANGE, MUST BE -127 TO 127.} 
   tde_continuation_overflow = tdc$status_condition + 7, 
   {E CONTINUATIONS EXCEED 256 CHARACTERS.} 
   tde_expecting_verb_variable = tdc$status_condition + 8,
   {E EXPECTING VERB OR VARIABLE, FOUND +T.}
   tde_empty_file = tdc$status_condition + 9, 
   {E EMPTY INPUT FILE.}
   tde_no_room = tdc$status_condition + 10,
   {E NO ROOM IN TABLE FOR +T.} 
   tde_duplicate_verb = tdc$status_condition + 11,
   {E VERB +T APPEARS TWICE.} 
   tde_superset = tdc$status_condition + 12, 
   {E INPUT SEQUENCE FOR +T IS A SUPERSET OF A PREVIOUS ITEM.}
   tde_subset = tdc$status_condition + 13, 
   {E INPUT SEQUENCE FOR +T IS A SUBSET OF A PREVIOUS ITEM.}
   tde_not_found = tdc$status_condition + 14,
   {E VARIABLE +T HAS NOT BEEN DECLARED.} 
   tde_optimize_table_full = tdc$status_condition + 15, 
   {E TABLE OVERFLOW DURING OPTIMIZATION.}
   tde_invalid_verb_variable = tdc$status_condition + 16, 
   {E INCORRECT VERB OR MISSING "=" IN VARIABLE ASSIGNMENT.}
   tde_duplicate_in_inout = tdc$status_condition + 17, 
   {E DUPLICATE PARAMETERS, BOTH "IN" AND "INOUT".} 
   tde_duplicate_out_inout = tdc$status_condition + 18, 
   {E DUPLICATE PARAMETERS, BOTH "OUT" AND "INOUT".}
   tde_screen_size_overflow = tdc$status_condition + 19, 
   {E TOO MANY SCREEN SIZES SPECIFIED, MAXIMUM 4.}
   tde_screen_row_overflow = tdc$status_condition + 20, 
   {E NUMBER OF ROWS MUST RANGE FROM 0 TO 64.}
   tde_screen_col_overflow = tdc$status_condition + 21, 
   {E NUMBER OF COLUMNS MUST RANGE FROM 0 TO 255.}
   tde_invalid_cursor_behavior = tdc$status_condition + 22, 
   {E INCORRECT "MOVE_PAST.." OR "CHAR_PAST.." TYPE.} 
   tde_name_required = tdc$status_condition + 23,
   {E NAME IS REQUIRED.}
   tde_name_too_long = tdc$status_condition + 24, 
   {E NAME MUST BE 1 TO 6 CHARACTERS.}
   tde_screen_out_required = tdc$status_condition + 25, 
   {E "OUT" REQUIRED FOR SET_SIZE.} 
   tde_invalid_name = tdc$status_condition + 26,
   {E INCORRECT NAME--MAY ONLY BE ALPHABETIC AND NUMERIC CHARACTERS.} 
   tde_cursor_len_out_of_range = tdc$status_condition + 27, 
   {E CURSOR_POS_COLUMN_LENGTH OR CURSOR_POS_ROW_LENGTH MUST BE 0 TO 7.}
   tde_duplicate_input = tdc$status_condition + 28,
   {E INPUT SEQUENCE FOR +T IS A DUPLICATE OF A PREVIOUS ITEM.} 
   tde_invalid_appstr_name = tdc$status_condition + 29, 
   {E INCORRECT APPLICATION STRING NAME +T--MAY ONLY USE CDC 63-CHAR SET.}
   tde_appstr_name_too_long = tdc$status_condition + 30,
   {E APPLICATION STRING NAME MUST BE 1 TO 7 CHARACTERS.} 
   tde_function_key_mark_range = tdc$status_condition + 31;
   {E FUNCTION_KEY_LEAVES_MARK MUST INDICATE 0 TO 7 CHARACTERS OF BLOTCH.}
  
{ ZTDCCLC  CL condition codes } 
  
  
{ ZCLCDDP    SCL condition code. } 
  
  CONST 
    clc$doubly_defined_parameter = 11000 + 0;
  
  
{ ZCLCEXP    SCL condition code. } 
  
  CONST 
    clc$expecting = 11000 + 1;
  
  
{ ZCLCINV    SCL condition code. } 
  
  CONST 
    clc$invalid = 11000 + 2;
  
  
{ ZCLCIOV    SCL condition code. } 
  
  CONST 
    clc$integer_overflow = 11000 + 3; 
  
  
{ ZCLCITL    SCL condition code. } 
  
  CONST 
    clc$integer_too_large = 11000 + 4;
  
  CONST 
    clc$max_function_arguements = 6;
  
{ ZCLCNEC    SCL condition code counter. }
  
  CONST 
    clc$next_available_error_code = 11000 + 16;
  
  
{ ZCLCNYI    SCL condition code. } 
  
  CONST 
    clc$not_yet_implemented = 11000 + 5;
  
  
{ ZCLCRNA    SCL condition code. } 
  
  CONST 
    clc$value_range_not_allowed = 11000 + 6; 
  
  
{ ZCLCRPM    SCL condition code. } 
  
  CONST 
    clc$required_parameter_missing = 11000 + 7;
  
  
{ ZCLCSOV    SCL condition code. } 
  
  CONST 
    clc$string_overflow = 11000 + 14;
  
  
{ ZCLCTFX    SCL condition code. } 
  
  CONST 
    clc$too_few = 11000 + 8; 
  
  
{ ZCLCTMX    SCL condition code. } 
  
  CONST 
    clc$too_many = 11000 + 9; 
  
  
{ ZCLCTOV    SCL condition code. } 
  
  CONST 
    clc$table_overflow = 11000 + 16;
  
  
{ ZCLCUNB    SCL condition code. } 
  
  CONST 
    clc$unbalanced = 11000 + 10; 
  
  
{ ZCLCUNK    SCL condition code. } 
  
  CONST 
    clc$unknown_keyword = 11000 + 11;
  
  
{ ZCLCUNR    SCL condition code. } 
  
  CONST 
    clc$unnested_relational = 11000 + 15;
  
  
{ ZCLCUNX    SCL condition code. } 
  
  CONST 
    clc$unexpected = 11000 + 12; 
  
  
{ ZCLCVOR    SCL condition code. } 
  
  CONST 
    clc$value_out_of_range = 11000 + 13;
  
  
{ **************************** }
{ initialization & termination } 
  
{ ZUTPCSA    Makes continued statements cracked by NOS available to }
{             the calling CYBIL program.                            }
  
  PROCEDURE [XREF] utp$get_control_statement_args ALIAS 'zutpcsa' (VAR 
    args: array [ * ] OF string (7)); 
  
  
  CONST 
    osc$max_name_size = 31, 
    osc$null_name = '                               '; 
  
  TYPE
    ost$name_size = 1 .. osc$max_name_size;
  
  TYPE
    ost$name = string (osc$max_name_size); 
  
{ ZOSTNAM    Defines names. }
  
  CONST 
    osc$max_name_length = osc$max_name_size,
    osc$max_nos170_name_length = 7;
  
  TYPE
    ost$name_types = (clc$nos170_name, clc$short_name, clc$long_name), 
    ost$name_length = 1 .. osc$max_name_length,
    ost$nos170_name = string (osc$max_nos170_name_length), 
    ost$name_descriptor = record 
      typ: ost$name_types,
      length: ost$name_length,
      str: ost$name, 
    recend; 
  
 PROCEDURE [XREF] utp$start_metrics_time ALIAS 'zutpsmt'; 
 PROCEDURE [XREF] utp$report_metrics_time ALIAS 'zutprmt' (toolname: string 
    (*)); 
  
{ ZOSPINI    Initiates environment for a CYBIL program. } 
  
  PROCEDURE [XREF] osp$initiate ALIAS 'zospini' (VAR command_name:
    ost$name_descriptor; 
    VAR command_line_pointer: ^string ( * );
    VAR command_line_index: clt$string_index;
    VAR status: ost$status);
  
{ ZOSPEND    Terminates a CYBIL program. } 
  
  PROCEDURE [XREF] osp$terminate ALIAS 'zospend' (VAR command_name: {READ} 
    ost$name_descriptor; 
    VAR status: {READ} ost$status); 
  
{ ************************* } 
{ status message formatting }
  
{ ZOSPFMG    Creates formattes message in user program area. } 
  
  PROCEDURE [XREF] osp$format_message ALIAS 'zospfmg' (reentry: boolean;
    VAR message_complete: boolean; 
    VAR length: 0 .. osc$max_string_length;
    VAR buf: string ( * );
    status: {READ} ost$status); 
  
  
?? OLDTITLE ??
  
  PROCEDURE [XREF] read_tdl_statements;
  
  PROCEDURE [XREF] initialize_tables; 
  
  PROCEDURE [XREF] write_tables; 
  
  PROCEDURE [XREF] optimize_tables; 
  
  ?? EJECT ?? 
{ ?? POP ??
  
  VAR 
     tdu_version_num: [XDCL] INTEGER := 1; { version 1 }
  
  VAR 
     error_flag: BOOLEAN := FALSE,    { an error has occurred }
  
     input_file, 
     output_file, 
     error_file: file,
     input_file_name,                 { from control statement } 
     output_file_name,
     error_file_name: ost$name_descriptor, 
  
     status: ost$status,
  
     command_name: ost$name_descriptor,
     control_statement_arguments: ARRAY [ 1 .. 3 ] OF STRING(7) 
        := [ 'TDUIN', 'TDUOUT', 'OUTPUT' ];
  
  ?? NEWTITLE := 'open_file' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] open_file (file_id: file_selector;
        input_output: input_output_selector; 
        code_set: code_set_selector);
     VAR
        f: file,
        f_name: ost$name_descriptor; 
  
     CASE file_id OF
        = input_file_sel =
           f := input_file;
           f_name := input_file_name;
        = output_file_sel =
           f := output_file;
           f_name := output_file_name;
        = error_file_sel =
           f := error_file;
           f_name := error_file_name;
     CASEND;
     CASE input_output OF
        = input_sel = 
           lg#open(f, f_name.str(1,f_name.length), old#, input#, first#);
        = output_sel = 
           lg#open(f, f_name.str(1,f_name.length), new#, output#, first#);
     CASEND;
     CASE code_set OF
        = ascii_sel = 
           ;
        = ascii64_sel = 
           lg#codeset(f, ascii64#);   { use 6-bit display code }
     CASEND;
     CASE file_id OF
        = input_file_sel =
           input_file := f;
        = output_file_sel =
           output_file := f;
        = error_file_sel =
           error_file := f;
     CASEND;
  PROCEND open_file;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'close_file' ??
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] close_file (file_id: file_selector); 
     CASE file_id OF
        = input_file_sel =
           lg#close(input_file, first#); 
        = output_file_sel =
           lg#close(output_file, first#); 
        = error_file_sel =
           lg#close(error_file, first#); 
     CASEND;
  PROCEND close_file;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'get_file' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] get_file (file_id: file_selector;
        VAR text: STRING(*); 
        VAR text_len: INTEGER;
        VAR eof_flag: BOOLEAN); 
     VAR
        structure_mark: file_mark;
  
     text := ''; 
     CASE file_id OF
        = input_file_sel =
           lg#get(input_file, text_len, text); 
           f#mark(input_file, structure_mark); 
        = output_file_sel =
           lg#get(output_file, text_len, text); 
           f#mark(output_file, structure_mark); 
        = error_file_sel =
           lg#get(error_file, text_len, text); 
           f#mark(error_file, structure_mark); 
     CASEND;
     IF ( structure_mark = eof# ) OR
        ( structure_mark = eoi# ) THEN
        eof_flag := TRUE
     ELSE 
        eof_flag := FALSE 
     IFEND
  PROCEND get_file;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'put_file' ??
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] put_file (file_id: file_selector;
        text: STRING(*));
     CASE file_id OF
        = input_file_sel =
           lg#put(input_file, text);
        = output_file_sel =
           lg#put(output_file, text);
        = error_file_sel =
           lg#put(error_file, text);
     CASEND 
  PROCEND put_file;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'report_error' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] report_error (text: STRING(*));
     VAR
        str_ndx,
        str_length: INTEGER;
  
     IF NOT error_flag THEN
        open_file(error_file_sel, output_sel, ascii_sel);
        error_flag := TRUE
     IFEND; 
     str_ndx := 1; 
     WHILE str_ndx <= STRLENGTH(text) DO
        str_length := ( STRLENGTH(text) - str_ndx ) + 1;
        IF str_length > 80 THEN
           str_length := 80 
        IFEND;
        put_file(error_file_sel, text(str_ndx, str_length));
        str_ndx := str_ndx + str_length 
     WHILEND
  PROCEND report_error;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'error_status' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] error_status (status: ost$status);
     VAR
        reentry, 
        message_complete: BOOLEAN,
        length: 0 .. osc$max_string_length,
        msg: STRING(79);
  
     report_error(' ');
     reentry := FALSE;
     REPEAT 
        osp$format_message(reentry, message_complete, length, 
           msg, status); 
        report_error(msg(1,length));
        reentry := TRUE;
     UNTIL message_complete; 
  PROCEND error_status;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'interpret_control_statement' ?? 
  ?? EJECT ?? 
  
  PROCEDURE interpret_control_statement; 
     VAR
        command_line_pointer: ^STRING(*), 
        command_line_index: clt$string_index;
  
     osp$initiate(command_name, command_line_pointer, 
        command_line_index, status);
     utp$get_control_statement_args(control_statement_arguments);
     input_file_name.typ := clc$nos170_name; 
     input_file_name.length := 7; 
     input_file_name.str := control_statement_arguments[1]; 
     output_file_name.typ := clc$nos170_name; 
     output_file_name.length := 7; 
     output_file_name.str := control_statement_arguments[2]; 
     error_file_name.typ := clc$nos170_name; 
     error_file_name.length := 7; 
     error_file_name.str := control_statement_arguments[3]
  PROCEND interpret_control_statement; 
  ?? OLDTITLE ??
  ?? EJECT ?? 
  
  PROGRAM tduex; 
     interpret_control_statement;
     initialize_tables; 
     IF NOT error_flag THEN
        read_tdl_statements; 
        IF NOT error_flag THEN 
           optimize_tables; 
           IF NOT error_flag THEN
              write_tables 
           IFEND
        IFEND 
     IFEND; 
     IF error_flag THEN
        close_file(error_file_sel);
        { osp$set_status_abnormal(tdc_prod_code, tde_error_termination,
        {    '', status) 
     IFEND; 
     osp$terminate(command_name, status) 
  PROCEND tduex; 
  
MODEND tduex;
MODULE tduin;
  
?? SET ( CHKALL := ON ), RIGHT := 110 ??
  
{  Module :  TDUIN  } 
{            Copyright Control Data Systems Inc.  1992.  } 
{  Written:  1/84 by R. Lindsey  } 
{  Version:  Cyber 170, version 1 } 
{  Purpose:  This module provides the input reading and parsing functions } 
{            of the TDL language on behalf of the TDU program. } 
  
{ ?? PUSH ( LIST := OFF ) ??          {use this line to suppress commdeck list}
  ?? PUSH ( LIST := ON )  ??          {use this line to list common decks }
  
?? NEWTITLE := 'SCL parsing declarations' ??
?? SKIP := 4 ??
  
{ ****************************** }
{ SCL types and routines follow: } 
  
{ ZTDPCLP  CLP common decks }
  
  
{ ZCLTVLT    Defines SCL value types. } 
  
  TYPE
    clt$value_types = (clc$unknown_value, clc$string_value, 
      clc$boolean_value, clc$integer_value, clc$name_value, 
      clc$status_value, clc$variable_reference);
  
  CONST 
    clc$any_value = clc$unknown_value;
  
{ ZCLTEXP    Defines SCL expression types. } 
  
  TYPE
    clt$expression_types = (clc$expression, clc$variable_ref_expression),
    clt$expression_result_types = clc$any_value .. clc$status_value; 
  
  
  
  CONST 
    osc$max_name_size = 31, 
    osc$null_name = '                               '; 
  
  TYPE
    ost$name_size = 1 .. osc$max_name_size;
  
  TYPE
    ost$name = string (osc$max_name_size); 
  
{ ZOSTNAM    Defines names. }
  
  CONST 
    osc$max_name_length = osc$max_name_size,
    osc$max_nos170_name_length = 7;
  
  TYPE
    ost$name_types = (clc$nos170_name, clc$short_name, clc$long_name), 
    ost$name_length = 1 .. osc$max_name_length,
    ost$nos170_name = string (osc$max_nos170_name_length), 
    ost$name_descriptor = record 
      typ: ost$name_types,
      length: ost$name_length,
      str: ost$name, 
    recend; 
  
  
{ OSDSTR    type definitions for string } 
  
  CONST 
    osc$max_string_size = 256;
  
  TYPE
    ost$string_size = 0 .. osc$max_string_size;
  
  TYPE
    ost$string_index = 1 .. osc$max_string_size + 1;
  
  TYPE
    ost$string = record
      size: ost$string_size,
      value: string (osc$max_string_size),
    recend; 
  
  
{ ZCLTSTR    Defines string length and string index for SCL. } 
  
    TYPE
      clt$string_length = integer,
  
      clt$string_index = integer;
  
{ ZOSTSTR    Defines the bounds of strings. } 
  
  CONST 
    osc$max_string_length = osc$max_string_size;
  
  TYPE
    ost$string_length = 0 .. osc$max_string_length;
  
{ ZCLTINT    Defines SCL integer types. } 
  
  TYPE
    clt$integer_types = (clc$invalid_integer, clc$48_bit_signed_integer, 
      clc$59_bit_signed_integer, clc$64_bit_unsigned_integer),
    clt$integer = record
      case typ: clt$integer_types of 
      = clc$invalid_integer =
        , 
      = clc$48_bit_signed_integer, clc$59_bit_signed_integer =
        int: integer,
      = clc$64_bit_unsigned_integer =
        long_int: packed array[1 .. 16] of 0 .. 15,
      casend, 
    recend; 
  
  
{ ZCLTVAR    Defines SCL data types. } 
  
  CONST 
    clc$max_variable_dimension = 65535;
  
  TYPE
    clt$variable = record
      name: ost$name, 
      next_variable: ^clt$variable,
      typ: clc$any_value .. clc$status_value,
      dimension: 1 .. clc$max_variable_dimension,
      str_length: 1 .. osc$max_string_length, 
      value: array[ * ] of cell, 
    recend, 
    clt$variable_reference = record 
      name: ost$name, 
      subscript: 0 .. clc$max_variable_dimension,
      field: ost$name, 
      variable: ^clt$variable, 
    recend; 
  
  
  
{ OSDSTAT   Definition of request status record } 
  
  CONST 
    osc$max_condition = 999999,
    osc$status_parameter_delimiter = '"';
  
  TYPE
    ost$status_condition = 0 .. osc$max_condition, 
    ost$status = record
      case normal: boolean of 
      =FALSE= 
        identifier: string (2),
        condition: ost$status_condition,
        text: ost$string, 
      casend, 
    recend; 
  
  
{ ZCLTVAL    Defines SCL values. }
  
  TYPE
    clt$value = record
      case typ: clt$value_types of 
      = clc$unknown_value, clc$string_value =
        str_length: ost$string_length, 
        str: string (osc$max_string_length),
      = clc$boolean_value =
        bool: boolean,
      = clc$integer_value =
        int: clt$integer, 
        radix: 2 .. 16, 
      = clc$name_value =
        name: ost$name_descriptor,
      = clc$status_value =
        status: ost$status, 
      = clc$variable_reference =
        variable_reference: clt$variable_reference, 
      casend, 
    recend; 
  
  
{ ZCLTPDT    Defines SCL parameter descriptor table. }
  
  CONST 
    clc$max_keywords = 255, 
    clc$max_parameters = 255, 
    clc$max_value_sets = 255,
    clc$max_values_per_set = 255; 
  
  TYPE
    clt$parameter_types = (clc$keyword_parameter, 
      clc$foreign_text_parameter, clc$value_list_parameter),
    clt$parameter_descriptor = packed record
      parameter_name: ost$name,
      parameter_number: 1 .. clc$max_parameters,
      parameter_required: boolean, 
      case parameter_type: clt$parameter_types of
      = clc$keyword_parameter =
        , 
      = clc$foreign_text_parameter = 
        value_optional: boolean, 
        foreign_text_scanner: ^procedure (VAR source_string: {READ} 
          string ( * ); 
          VAR source_index: clt$string_index; 
          VAR status: ost$status),
      = clc$value_list_parameter = 
        min_value_sets: 0 .. clc$max_value_sets,
        max_value_sets: 1 .. clc$max_value_sets,
        min_values_per_set: 1 .. clc$max_values_per_set,
        max_values_per_set: 1 .. clc$max_values_per_set,
        value_ranges_allowed: boolean,
        expression_scanner: ^procedure (VAR source_string: {READ} string 
          ( * );
          VAR source_index: clt$string_index; 
          expression_type: clt$expression_types; 
          result_type: clt$expression_result_types;
          VAR result: clt$value; 
          VAR status: ost$status),
        expression_type: clt$expression_types, 
        case value_type: clt$expression_result_types of 
        = clc$name_value =
          name_type: ost$name_types, 
        = clc$any_value .. clc$integer_value, clc$status_value =
          , 
        casend, 
      casend, 
    recend, 
    clt$parameter_descriptor_table = array [ * ] of 
      clt$parameter_descriptor; 
  
{ ZCLTLOH    Declare ordinal types 'low' and 'high'. }
  
  TYPE
    clt$low_or_high = (clc$low, clc$high); 
  
  
{ ZCLTPVT    Defines SCL parameter value table. }
  
  CONST 
    clc$max_pvt_entries = 255;
  
  TYPE
    clt$parameter_value_table_entry = record 
      case used: (not_used, default, used) of
      = not_used = 
        , 
      = default, used =
        pdt_index: 1 .. clc$max_keywords,
        parameter_number: 1 .. clc$max_parameters,
        keyword_used: boolean, 
        case value_set_number: 0 .. clc$max_value_sets of 
        = 0 = 
          , 
        = 1 .. clc$max_value_sets =
          value_number: 1 .. clc$max_values_per_set,
          low_or_high: clt$low_or_high, 
          value: clt$value, 
        casend, 
      casend, 
    recend, 
    clt$parameter_value_table = record
      pdt: ^clt$parameter_descriptor_table, 
      entry: array[ * ] of clt$parameter_value_table_entry, 
    recend; 
  
  
{ ZCLPSPL    Parameter list scanner for commands. } 
  
  PROCEDURE [XREF] clp$scan_parameter_list ALIAS 'zclpspl' (VAR
    source_string: 
  {READ} string ( * );
    VAR source_index: clt$string_index; 
    pdt: ^clt$parameter_descriptor_table; 
    VAR pvt: ^clt$parameter_value_table; 
    VAR status: ost$status);
  
{ ZCLPEXP    Scans line and evaluates expression it contains. } 
  
  PROCEDURE [XREF] clp$scan_expression ALIAS 'zclpexp' (VAR source_string: 
  {READ} string ( * );
    VAR source_index: clt$string_index; 
    expression_type: clt$expression_types; 
    result_type: clt$expression_result_types;
    VAR result: clt$value; 
    VAR status: ost$status);
  
{ ZCLTLEX    Defines SCL lexical types. } 
  
?? fmt ( format := off ) ??
  
  TYPE
    clt$lexical_types = (
      clc$unknown_token, 
      clc$eos_token,        { end of string } 
      clc$dot_token,        { . }
      clc$semicolon_token,  { ; }
      clc$colon_token,      { : } 
      clc$lparen_token,     { ( } 
      clc$lbracket_token,   { [ } 
      clc$lbrace_token,     { { }
      clc$rparen_token,     { ) } 
      clc$rbracket_token,   { ] } 
      clc$rbrace_token,     { } 
      clc$uparrow_token,    { ^ } 
      clc$larrow_token,     { <- }
      clc$rarrow_token,     { -> }
      clc$comma_token,      { , }
      clc$ellipsis_token,   { .. 2 or more 'dots' } 
      clc$exp_token,        { ** } 
      clc$add_token,        { + }
      clc$sub_token,        { - }
      clc$mult_token,       { * } 
      clc$div_token,        { / }
      clc$mod_token,        { // } 
      clc$cat_token,        { ++ } 
      clc$gt_token,         { > } 
      clc$ge_token,         { >= }
      clc$lt_token,         { < } 
      clc$le_token,         { <= }
      clc$eq_token,         { = } 
      clc$ne_token,         { <> }
      clc$not_token,        { NOT }
      clc$and_token,        { AND }
      clc$or_token,         { OR }
      clc$xor_token,        { XOR }
      clc$assign_token,     { = } 
      clc$string_token, 
      clc$boolean_token, 
      clc$integer_token, 
      clc$name_token ); 
  
?? fmt ( format := on ) ??
  
  
{ ZCLTTOK    Defines SCL token types. } 
  
  TYPE
    clt$token = record
      case typ: clt$lexical_types of 
      = clc$unknown_token .. clc$string_token =
        str_length: ost$string_length, 
        str: string (osc$max_string_length),
      = clc$boolean_token =
        bool: boolean,
      = clc$integer_token =
        int: clt$integer, 
        radix: 2 .. 16, 
      = clc$name_token =
        name: ost$name_descriptor,
      casend, 
    recend; 
  
  
{ ZCLPTOK    Scans the next lexical unit (token) on a line. } 
  
  PROCEDURE [XREF] clp$scan_token ALIAS 'zclptok' (context:
    (clc$not_in_expression, clc$in_expression);
    VAR source_string: {READ} string ( * );
    VAR source_index: clt$string_index; 
    VAR token: clt$token; 
    VAR status: ost$status);
  
{ ZCLPGPV    Returns designated value for designated parameter. }
  
  PROCEDURE [XREF] clp$get_value ALIAS 'zclpgpv' (pvt:
    ^clt$parameter_value_table;
    parameter_name: string ( * ); 
    value_set_number: 1 .. clc$max_value_sets;
    value_number: 1 .. clc$max_values_per_set;
    low_or_high: clt$low_or_high; 
    VAR value: clt$value; 
    VAR status: ost$status);
  
{ ZCLPGSC    Returns no. of value sets specified for parameter. } 
  
  PROCEDURE [XREF] clp$get_set_count ALIAS 'zclpgsc' (pvt: 
    ^clt$parameter_value_table;
    parameter_name: string ( * ); 
    VAR value_set_count: 0 .. clc$max_value_sets;
    VAR status: ost$status);
  
{ ZCLPTPS    Determines if parameter was specified in a parameter list. } 
  
  PROCEDURE [XREF] clp$test_parameter ALIAS 'zclptps' (pvt:
    ^clt$parameter_value_table;
    parameter_name: string ( * ); 
    VAR parameter_specified: boolean; 
    VAR status: ost$status);
  
{ ZCLPFVT    Frees space occupied by a parameter value table. }
  
  PROCEDURE [XREF] clp$free_parameter_value_table ALIAS 'zclpfvt' (VAR pvt:
    ^clt$parameter_value_table); 
  
{ ZCLPV2S    Converts a clt$value to a string. } 
  
  PROCEDURE [XREF] clp$convert_value_to_string ALIAS 'zclpv2s' (VAR
    source_value: {READ} clt$value; 
    VAR result_string: string ( * ); 
    VAR result_length: ost$string_length; 
    VAR status: ost$status);
  
{ ZCLPV2I    Converts a clt$value to an integer. } 
  
  PROCEDURE [XREF] clp$convert_value_to_integer ALIAS 'zclpv2i' (VAR
    source_value: {READ} clt$value; 
    VAR result_integer: clt$integer;
    VAR status: ost$status);
  
{ ZCLPV2B    Converts a clt$value to a boolean. } 
  
  PROCEDURE [XREF] clp$convert_value_to_boolean ALIAS 'zclpv2b' (VAR
    source_value: {READ} clt$value; 
    VAR result_boolean: boolean; 
    VAR status: ost$status);
  
{ ZUTVCTT    Translation table used in conversion to/from ascii. }
  
  VAR 
    utv$convert_ascii_to_ascii612 ALIAS 'cvas612': [XREF, READ] array 
      [char] of packed record 
      case long: boolean of 
      = FALSE = 
        f1: set of 1 .. 53,
        ch: 0 .. 3f(16),
      = TRUE =
        f2: set of 1 .. 47,
        escape_ch: 0 .. 3f(16), 
        follower_ch: 0 .. 3f(16), 
      casend, 
    recend, 
    utv$convert_ascii612_to_ascii ALIAS 'cv612as': [XREF, READ] array [0
      .. 3f(16)] of packed record
      case escape: boolean of 
      = FALSE = 
        f1: set of 1 .. 51,
        ch: char,
      = TRUE =
        f2: set of 1 .. 41,
        conv: ^array [0 .. 3f(16)] of char, 
      casend, 
    recend, 
    utv$convert_ascii_to_ascii64 ALIAS 'cvasc64': [XREF, READ] array 
      [char] of 0 .. 3f(16), 
    utv$convert_ascii64_to_ascii ALIAS 'cv64asc': [XREF, READ] array [0
      .. 3f(16)] of char;
  
{ ***************** } 
{ error conditions: } 
  
{ ZTDCCON  TDU condition codes }
  
CONST 
   tdc$status_id = 'td', 
   tdc$status_condition = 18000;
  
CONST 
   tde_error_termination = tdc$status_condition + 0, 
   {E TDU TERMINATED WITH ERRORS.}
   tde_invalid_character = tdc$status_condition + 1, 
   {E CHARACTER VALUE MUST RANGE FROM 0 TO 127.}
   tde_invalid = tdc$status_condition + 2,
   {E INCORRECT +T.}
   tde_invalid_type = tdc$status_condition + 3, 
   {E INCORRECT TYPE--ONLY STRING, INTEGER, OR VARIABLE ALLOWED.} 
   tde_invalid_comm = tdc$status_condition + 4, 
   {E INCORRECT COMMUNICATIONS TYPE.} 
   tde_invalid_cursor = tdc$status_condition + 5, 
   {E INCORRECT CURSOR_ENCODING.} 
   tde_bias_out_of_range = tdc$status_condition + 6, 
   {E CURSOR_BIAS OUT OF RANGE, MUST BE -127 TO 127.} 
   tde_continuation_overflow = tdc$status_condition + 7, 
   {E CONTINUATIONS EXCEED 256 CHARACTERS.} 
   tde_expecting_verb_variable = tdc$status_condition + 8,
   {E EXPECTING VERB OR VARIABLE, FOUND +T.}
   tde_empty_file = tdc$status_condition + 9, 
   {E EMPTY INPUT FILE.}
   tde_no_room = tdc$status_condition + 10,
   {E NO ROOM IN TABLE FOR +T.} 
   tde_duplicate_verb = tdc$status_condition + 11,
   {E VERB +T APPEARS TWICE.} 
   tde_superset = tdc$status_condition + 12, 
   {E INPUT SEQUENCE FOR +T IS A SUPERSET OF A PREVIOUS ITEM.}
   tde_subset = tdc$status_condition + 13, 
   {E INPUT SEQUENCE FOR +T IS A SUBSET OF A PREVIOUS ITEM.}
   tde_not_found = tdc$status_condition + 14,
   {E VARIABLE +T HAS NOT BEEN DECLARED.} 
   tde_optimize_table_full = tdc$status_condition + 15, 
   {E TABLE OVERFLOW DURING OPTIMIZATION.}
   tde_invalid_verb_variable = tdc$status_condition + 16, 
   {E INCORRECT VERB OR MISSING "=" IN VARIABLE ASSIGNMENT.}
   tde_duplicate_in_inout = tdc$status_condition + 17, 
   {E DUPLICATE PARAMETERS, BOTH "IN" AND "INOUT".} 
   tde_duplicate_out_inout = tdc$status_condition + 18, 
   {E DUPLICATE PARAMETERS, BOTH "OUT" AND "INOUT".}
   tde_screen_size_overflow = tdc$status_condition + 19, 
   {E TOO MANY SCREEN SIZES SPECIFIED, MAXIMUM 4.}
   tde_screen_row_overflow = tdc$status_condition + 20, 
   {E NUMBER OF ROWS MUST RANGE FROM 0 TO 64.}
   tde_screen_col_overflow = tdc$status_condition + 21, 
   {E NUMBER OF COLUMNS MUST RANGE FROM 0 TO 255.}
   tde_invalid_cursor_behavior = tdc$status_condition + 22, 
   {E INCORRECT "MOVE_PAST.." OR "CHAR_PAST.." TYPE.} 
   tde_name_required = tdc$status_condition + 23,
   {E NAME IS REQUIRED.}
   tde_name_too_long = tdc$status_condition + 24, 
   {E NAME MUST BE 1 TO 6 CHARACTERS.}
   tde_screen_out_required = tdc$status_condition + 25, 
   {E "OUT" REQUIRED FOR SET_SIZE.} 
   tde_invalid_name = tdc$status_condition + 26,
   {E INCORRECT NAME--MAY ONLY BE ALPHABETIC AND NUMERIC CHARACTERS.} 
   tde_cursor_len_out_of_range = tdc$status_condition + 27, 
   {E CURSOR_POS_COLUMN_LENGTH OR CURSOR_POS_ROW_LENGTH MUST BE 0 TO 7.}
   tde_duplicate_input = tdc$status_condition + 28,
   {E INPUT SEQUENCE FOR +T IS A DUPLICATE OF A PREVIOUS ITEM.} 
   tde_invalid_appstr_name = tdc$status_condition + 29, 
   {E INCORRECT APPLICATION STRING NAME +T--MAY ONLY USE CDC 63-CHAR SET.}
   tde_appstr_name_too_long = tdc$status_condition + 30,
   {E APPLICATION STRING NAME MUST BE 1 TO 7 CHARACTERS.} 
   tde_function_key_mark_range = tdc$status_condition + 31;
   {E FUNCTION_KEY_LEAVES_MARK MUST INDICATE 0 TO 7 CHARACTERS OF BLOTCH.}
  
{ ZTDCCLC  CL condition codes } 
  
  
{ ZCLCDDP    SCL condition code. } 
  
  CONST 
    clc$doubly_defined_parameter = 11000 + 0;
  
  
{ ZCLCEXP    SCL condition code. } 
  
  CONST 
    clc$expecting = 11000 + 1;
  
  
{ ZCLCINV    SCL condition code. } 
  
  CONST 
    clc$invalid = 11000 + 2;
  
  
{ ZCLCIOV    SCL condition code. } 
  
  CONST 
    clc$integer_overflow = 11000 + 3; 
  
  
{ ZCLCITL    SCL condition code. } 
  
  CONST 
    clc$integer_too_large = 11000 + 4;
  
  CONST 
    clc$max_function_arguements = 6;
  
{ ZCLCNEC    SCL condition code counter. }
  
  CONST 
    clc$next_available_error_code = 11000 + 16;
  
  
{ ZCLCNYI    SCL condition code. } 
  
  CONST 
    clc$not_yet_implemented = 11000 + 5;
  
  
{ ZCLCRNA    SCL condition code. } 
  
  CONST 
    clc$value_range_not_allowed = 11000 + 6; 
  
  
{ ZCLCRPM    SCL condition code. } 
  
  CONST 
    clc$required_parameter_missing = 11000 + 7;
  
  
{ ZCLCSOV    SCL condition code. } 
  
  CONST 
    clc$string_overflow = 11000 + 14;
  
  
{ ZCLCTFX    SCL condition code. } 
  
  CONST 
    clc$too_few = 11000 + 8; 
  
  
{ ZCLCTMX    SCL condition code. } 
  
  CONST 
    clc$too_many = 11000 + 9; 
  
  
{ ZCLCTOV    SCL condition code. } 
  
  CONST 
    clc$table_overflow = 11000 + 16;
  
  
{ ZCLCUNB    SCL condition code. } 
  
  CONST 
    clc$unbalanced = 11000 + 10; 
  
  
{ ZCLCUNK    SCL condition code. } 
  
  CONST 
    clc$unknown_keyword = 11000 + 11;
  
  
{ ZCLCUNR    SCL condition code. } 
  
  CONST 
    clc$unnested_relational = 11000 + 15;
  
  
{ ZCLCUNX    SCL condition code. } 
  
  CONST 
    clc$unexpected = 11000 + 12; 
  
  
{ ZCLCVOR    SCL condition code. } 
  
  CONST 
    clc$value_out_of_range = 11000 + 13;
  
  
?? OLDTITLE ??
?? NEWTITLE := 'PDT''s for TDL' ?? 
?? EJECT ?? 
  
{ ********************* } 
{ PDT's for TDL follow: }
  
{ ZTDVPDT  SCL parameters for Terminal Definition Language (TDL) }
  
  ?? fmt ( format := off ) ??
  
  VAR 
    parm_pdt : [STATIC] ARRAY [1 .. 12] OF
          clt$parameter_descriptor := [
      {----- PARAMETER NAME -----}       ['VALUE                          ',
      {parameter number}                  1, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['V                              ',
      {parameter number}                  1, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['TYPE                           ',
      {parameter number}                  1, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['T                              ',
      {parameter number}                  1, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['BIAS                           ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$integer_value], 
      {----- PARAMETER NAME -----}       ['B                              ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$integer_value], 
      {----- PARAMETER NAME -----}       ['ROWS                           ',
      {parameter number}                  3, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$integer_value], 
      {----- PARAMETER NAME -----}       ['R                              ',
      {parameter number}                  3, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$integer_value], 
      {----- PARAMETER NAME -----}       ['COLUMNS                        ',
      {parameter number}                  4, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$integer_value], 
      {----- PARAMETER NAME -----}       ['C                              ',
      {parameter number}                  4, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$integer_value], 
      {----- PARAMETER NAME -----}       ['OUT                            ',
      {parameter number}                  5, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['O                              ',
      {parameter number}                  5, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value]];
  
  ?? fmt ( format := on ) ??
  
  ?? fmt ( format := off ) ??
  
  VAR 
    init_pdt : [STATIC] ARRAY [1 .. 2] OF 
          clt$parameter_descriptor := [
      {----- PARAMETER NAME -----}       ['OUT                            ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['O                              ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value]];
  
  ?? fmt ( format := on ) ??
  
  ?? fmt ( format := off ) ??
  
  VAR 
    in_pdt : [STATIC] ARRAY [1 .. 4] OF 
          clt$parameter_descriptor := [
      {----- PARAMETER NAME -----}       ['IN                             ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['I                              ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['LABEL                          ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$string_value], 
      {----- PARAMETER NAME -----}       ['L                              ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$string_value]];
  
  ?? fmt ( format := on ) ??
  
  ?? fmt ( format := off ) ??
  
  VAR 
    inout_pdt : [STATIC] ARRAY [1 .. 8] OF 
          clt$parameter_descriptor := [
      {----- PARAMETER NAME -----}       ['INOUT                          ',
      {parameter number}                  1, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['IO                             ',
      {parameter number}                  1, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['IN                             ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['I                              ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['OUT                            ',
      {parameter number}                  3, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['O                              ',
      {parameter number}                  3, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['LABEL                          ',
      {parameter number}                  4, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$string_value], 
      {----- PARAMETER NAME -----}       ['L                              ',
      {parameter number}                  4, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$string_value]];
  
  ?? fmt ( format := on ) ??
  
  ?? fmt ( format := off ) ??
  
  VAR 
    out_pdt : [STATIC] ARRAY [1 .. 2] OF 
          clt$parameter_descriptor := [
      {----- PARAMETER NAME -----}       ['OUT                            ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['O                              ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value]];
  
  ?? fmt ( format := on ) ??
  
  ?? fmt ( format := off ) ??
  
  VAR 
    appstr_pdt : [STATIC] ARRAY [1 .. 4] OF 
          clt$parameter_descriptor := [
      {----- PARAMETER NAME -----}       ['OUT                            ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['O                              ',
      {parameter number}                  1, 
      {parameter is required}             TRUE,
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      clc$max_value_sets,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$any_value], 
      {----- PARAMETER NAME -----}       ['NAME                           ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$string_value], 
      {----- PARAMETER NAME -----}       ['N                              ',
      {parameter number}                  2, 
      {parameter is required}             FALSE, 
      {parameter type is}                 clc$value_list_parameter, 
      {minimum number of value sets}      1,
      {maximum number of value sets}      1,
      {minimum number of values per set}  1, 
      {maximum number of values per set}  1, 
      {value range is allowed}            FALSE, 
      {expression scanner is}             NIL {SCL's},
      {expression type is}                clc$expression,
      {value type is}                     clc$string_value]];
  
  ?? fmt ( format := on ) ??
  
?? OLDTITLE ??
?? NEWTITLE := 'ZTDTTAB' ??
?? EJECT ?? 
  
{ **************************** }
{ common deck ZTDTTAB follows: }
  
{ ZTDTTAB  contains type declarations used by the TDU table handler et. al. }
  
  CONST 
     communications_type_max = 3,     { actual ordinal values } 
     invalid_cursor = 0,              { 'ordinal' value }
     asynch_comm = 1,                 { 'ordinal' value } 
     binary_cursor = 1,               { 'ordinal' value } 
     cursor_encoding_max = 6,         { 'invalid' is always #0 }
     parm_flag_max = 56,              { upper bound of parm flag array }
     screen_size_max = 3,             { up to 4 screen sizes }
     size_row_max = 64,               { number of rows on a screen } 
     size_col_max = 255,              { number of columns on a screen } 
     binary_col_max = 128,            { binary_cursor maximum screen columns }
     cursor_behavior_max_ord = 6,     { cursor behavior maximum ordinal } 
     cursor_behavior_max = 14,        { upper bound for wrap/scroll etc. } 
     cursor_behavior_div = 6,         { upper bound for wrap/scroll etc. } 
     no_ordinal = 0,                  { enumerated-style ordinal value }
     overstrike_ordinal = 37;         { VIRTERM-compatible } 
  
  TYPE
     ordinal_type = 0 .. 255,         { input and output VIRTERM ordinals }
  
     communications_type = 0 .. communications_type_max, 
        { invalid, asynch, synch, sna }
  
     cursor_encoding_type = 0 .. cursor_encoding_max,
        { these ordinals indicate what method of cursor positioning is used  }
        { invalid_cursor, binary, cdc721, ansi, ibm3270, ibm3151, user }
  
     parameter_record = RECORD        { contains non-input/output parameters } 
        model_name: STRING (7),       { terminal-type code as known by users }
        model_name_len: 0 .. 7,       { length of model name string used  } 
        communications: communications_type,   { asynch, synch, SNA, etc. }
        cursor_encoding: cursor_encoding_type, { cursor-positioning info  } 
        cursor_bias: -127 .. 127,     { cursor addressing offset          } 
        flag: ARRAY [ 0 .. parm_flag_max ] OF BOOLEAN, { various flags    } 
        size: ARRAY [ 0 .. screen_size_max ] OF RECORD { screen sizes }
           cols: 0 .. size_col_max,
           rows: 0 .. size_row_max,
        RECEND, 
        cursor_behavior: ARRAY [ 0 .. cursor_behavior_max ] 
                           OF -1 .. cursor_behavior_max_ord , 
        cursor_pos_column_flag: BOOLEAN, { TRUE if column pos goes first }
        cursor_pos_length: ARRAY [ 0 .. 1 ] OF 0 .. 7, { # digits per x/y }
        function_key_mark: 0 .. 7,    { # chars of blotch left by function key} 
     RECEND,
  
     string_node = PACKED RECORD      { an ordinal-designated char sequence }
        length: 0 .. 32767,           { length of char_sequence }
        chars: ^STRING(*),            { the sequence itself } 
     RECEND,
  
     dump_procedure_type =            { dumps string nodes from tables } 
        ^PROCEDURE ( ordinal: ordinal_type; 
                     VAR length: INTEGER;
                     VAR chars: ^STRING(*);
                     VAR total_ordinals: INTEGER; { last ordinal in table } 
                     VAR total_characters: INTEGER; 
                     VAR node_returned: BOOLEAN),
  
     opcode_type = (fail, list, range, single_action_range), { input opcodes }
  
     input_action = PACKED RECORD     { ordinal/pointer pair } 
        ordinal: ordinal_type,        { 0 = no ordinal, look at next_node } 
        next_offset: 0 .. 4095,       { output-table-style pointer }
        next_level: ALIGNED ^input_node, { points to another node }
     RECEND,
  
     list_node = PACKED ARRAY [1 .. *] OF { 1 element for each char in list } 
        PACKED RECORD                 { each node of an input-parse list }
           character: CHAR,           { character to match }
           action: input_action,      { ordinal/pointer pair }
        RECEND, 
  
     range_node = PACKED ARRAY [ * ] OF { 1 action for each char in range }
        input_action,                 { ordinal/pointer pair } 
  
     input_node = BOUND RECORD        { linked list of input-parsing rules }
        next_node: ^input_node,       { 'real' table will use consecutive mem }
        offset: 0 .. 4095,            { target table offset of this node }
        node_visited: BOOLEAN,        { node has been visited in this pass }
        CASE opcode: opcode_type OF   { fail, list, range, single-action range}
           = fail =                   { fail }
              ,                       { no parameters } 
           = list =                   { list }
              list_character_count: 1 .. 1023,  {  count of chars in list  } 
              list_pointer: ^ list_node, { list of char/action pairs }
           = range =                  { range } 
              range_lower_bound: CHAR,{ first character of range } 
              range_upper_bound: CHAR,{ last character in range } 
              range_pointer: ^ range_node, { list of actions, 1/char in range} 
           = single_action_range =    { single-action range } 
              sar_lower_bound: CHAR,  { first char of range } 
              sar_upper_bound: CHAR,  { last char in range } 
              sar_action: input_action,{ ordinal/pointer pair }
        CASEND, 
     RECEND,
  
     appstr_node = RECORD             { linked list of application strings }
        next_node: ^appstr_node,      { 'real' table will use consecutive mem } 
        name: STRING(31),             { non-unique key for this applictn stng } 
        value: string_node,           { length and contents of the string } 
     RECEND;
  
?? OLDTITLE ??
?? NEWTITLE := 'ZTDVERB' ??
?? EJECT ?? 
  
{ **************************** }
{ common deck ZTDVERB follows: }
  
{ ************************* } 
{ tdu verb-table constants: } 
  
{ ZTDCVRB  TDL Verb-table constants }
  
  { ********************************************************* } 
  { These constants define the length of various parts of the }
  {       ZTDVERB table.                                      }
  { ********************************************************* } 
  CONST 
     { The following 'ord' or 'ordinal' constants do NOT change when }
     { you add or remove verbs from the end of the verb table. } 
  
     parm_name_ord = 1,               { verb-table ordinal } 
     parm_communications_ord = 2,
     parm_cursor_encoding_ord = 3, 
     parm_flags_ord = 4,
     parm_size_ord = 5,
     parm_cursor_behavior_ord = 6, 
     parm_cursor_pos_column_flag_ord = 7, 
     parm_cursor_pos_length_ord = 8,
     parm_function_key_mark_ord = 9,
  
     { The following constants DO change when you add or remove ordinals }
     { as defined to VIRTERM. }
  
     output_last_ordinal = 153,       { count of ordinals defined to VIRTERM } 
     key_name_last_ordinal = 126, 
     init_last_ordinal = 1,
     size_output_ord = 130,           { first ordinal for screen sizes } 
  
     { The following constants DO change when you add or remove verbs }
     { from earlier positions in the verb table. }
  
     parm_name_verb = 1,              { verb-table index, used for error msgs } 
     parm_cursor_encoding_verb = 3, 
     parm_set_size_verb = 60,
     parm_cursor_behavior_verb = 61,
     max_verb_count = 327;            { total of all verbs in the entire table}
  
{ ZTDVERB  TDL verb table }
  
  TYPE
     verb_type = (v_parm, v_init, v_in, v_out, v_inout, v_appstr);
  VAR 
     verb_table: PACKED ARRAY [ 1 .. max_verb_count ] OF PACKED RECORD
        name: ost$name, 
        typ: verb_type, 
        in_ordinal: ordinal_type,
        out_ordinal: ordinal_type 
     RECEND 
  { ************************************************************} 
  { NOTE: Did you remember to change the constants which define }
  {       the length of this table, etc.?  They are in ZTDCVRB. }
  { ************************************************************} 
        := [   { Parameter verbs }
            [ 'MODEL_NAME',               v_parm,   parm_name_ord,   0 ], 
            [ 'COMMUNICATIONS',           v_parm, parm_communications_ord, 0 ], 
            [ 'CURSOR_POS_ENCODING',      v_parm, parm_cursor_encoding_ord, 0 ],
            [ 'HOME_AT_TOP',              v_parm,   parm_flags_ord,   0 ], 
            [ 'HAS_PROTECT',              v_parm,   parm_flags_ord,   1 ], 
            [ 'MULTIPLE_SIZES',           v_parm,   parm_flags_ord,   2 ], 
            [ 'HAS_HIDDEN',               v_parm,   parm_flags_ord,   4 ], 
            [ 'TABS_TO_HOME',             v_parm,   parm_flags_ord,   5 ], 
            [ 'TABS_TO_UNPROTECTED',      v_parm,   parm_flags_ord,   6 ], 
            [ 'TABS_TO_TAB_STOPS',        v_parm,   parm_flags_ord,   7 ], 
            [ 'CLEARS_WHEN_CHANGE_SIZE',  v_parm,   parm_flags_ord,   8 ], 
            [ 'AUTOMATIC_TABBING',        v_parm,   parm_flags_ord,   9 ], 
            [ 'TYPE_AHEAD',               v_parm,   parm_flags_ord,  10 ], 
            [ 'BLOCK_MODE',               v_parm,   parm_flags_ord,  11 ], 
            [ 'PROTABS_DONT_WRAP_FWD_LINE', v_parm, parm_flags_ord,  12 ], 
            [ 'PROTABS_DONT_WRAP_FWD_PAGE', v_parm, parm_flags_ord,  13 ], 
            [ 'PROTABS_DONT_WRAP_BKW_LINE', v_parm, parm_flags_ord,  14 ], 
            [ 'PROTABS_DONT_WRAP_BKW_PAGE', v_parm, parm_flags_ord,  15 ], 
            [ 'UNPROTABS_DONT_WRAP_FWD_LINE', v_parm, parm_flags_ord,16 ], 
            [ 'UNPROTABS_DONT_WRAP_FWD_PAGE', v_parm, parm_flags_ord,17 ], 
            [ 'UNPROTABS_DONT_WRAP_BKW_LINE', v_parm, parm_flags_ord,18 ], 
            [ 'UNPROTABS_DONT_WRAP_BKW_PAGE', v_parm, parm_flags_ord,19 ], 
            [ 'ATTRIBUTE_TAKES_CHARACTER', v_parm,  parm_flags_ord,  20 ], 
            [ 'ATTRIBUTE_NEEDS_RESET',     v_parm,  parm_flags_ord,  21 ], 
            [ 'SEND_DISPLAY_FOR_REWRITE', v_parm,   parm_flags_ord,  22 ], 
            [ 'SEND_DISPLAY_FOR_HELP',    v_parm,   parm_flags_ord,  23 ], 
            [ 'ATTRIBUTES_NOT_MASKABLE',  v_parm,   parm_flags_ord,  24 ], 
            [ 'ATTRIBUTES_NOT_CHARACTER', v_parm,   parm_flags_ord,  25 ], 
            [ 'DISABLE_OUTPUT_END',       v_parm,   parm_flags_ord,  26 ], 
            [ 'PROTECT_ALL_CLEARS',       v_parm,   parm_flags_ord,  27 ], 
            [ 'CLEARS_ACROSS_FIELDS',     v_parm,   parm_flags_ord,  28 ], 
            [ 'RESERVED_FLAG_6',          v_parm,   parm_flags_ord,  29 ], 
            [ 'RESERVED_FLAG_7',          v_parm,   parm_flags_ord,  30 ], 
            [ 'RESERVED_FLAG_8',          v_parm,   parm_flags_ord,  31 ], 
            [ 'RESERVED_FLAG_9',          v_parm,   parm_flags_ord,  32 ], 
            [ 'RESERVED_FLAG_10',         v_parm,   parm_flags_ord,  33 ], 
            [ 'RESERVED_FLAG_11',         v_parm,   parm_flags_ord,  34 ], 
            [ 'RESERVED_FLAG_12',         v_parm,   parm_flags_ord,  35 ], 
            [ 'RESERVED_FLAG_13',         v_parm,   parm_flags_ord,  36 ], 
            [ 'INSTALL_FLAG_1',           v_parm,   parm_flags_ord,  37 ], 
            [ 'INSTALL_FLAG_2',           v_parm,   parm_flags_ord,  38 ], 
            [ 'INSTALL_FLAG_3',           v_parm,   parm_flags_ord,  39 ], 
            [ 'INSTALL_FLAG_4',           v_parm,   parm_flags_ord,  40 ], 
            [ 'INSTALL_FLAG_5',           v_parm,   parm_flags_ord,  41 ], 
            [ 'INSTALL_FLAG_6',           v_parm,   parm_flags_ord,  42 ], 
            [ 'INSTALL_FLAG_7',           v_parm,   parm_flags_ord,  43 ], 
            [ 'INSTALL_FLAG_8',           v_parm,   parm_flags_ord,  44 ], 
            [ 'INSTALL_FLAG_9',           v_parm,   parm_flags_ord,  45 ], 
            [ 'INSTALL_FLAG_10',          v_parm,   parm_flags_ord,  46 ], 
            [ 'INSTALL_FLAG_11',          v_parm,   parm_flags_ord,  47 ], 
            [ 'INSTALL_FLAG_12',          v_parm,   parm_flags_ord,  48 ], 
            [ 'INSTALL_FLAG_13',          v_parm,   parm_flags_ord,  49 ], 
            [ 'INSTALL_FLAG_14',          v_parm,   parm_flags_ord,  50 ], 
            [ 'INSTALL_FLAG_15',          v_parm,   parm_flags_ord,  51 ], 
            [ 'INSTALL_FLAG_16',          v_parm,   parm_flags_ord,  52 ], 
            [ 'INSTALL_FLAG_17',          v_parm,   parm_flags_ord,  53 ], 
            [ 'INSTALL_FLAG_18',          v_parm,   parm_flags_ord,  54 ], 
            [ 'INSTALL_FLAG_19',          v_parm,   parm_flags_ord,  55 ], 
            [ 'INSTALL_FLAG_20',          v_parm,   parm_flags_ord,  56 ], 
               { Screen size sub-table } 
            [ 'SET_SIZE',                 v_parm,   parm_size_ord,   0 ], 
               { Cursor behavior sub-table } 
            [ 'MOVE_PAST_LEFT',          v_parm, parm_cursor_behavior_ord, 0 ], 
            [ 'MOVE_PAST_RIGHT',         v_parm, parm_cursor_behavior_ord, 1 ], 
            [ 'MOVE_PAST_TOP',           v_parm, parm_cursor_behavior_ord, 2 ], 
            [ 'MOVE_PAST_BOTTOM',        v_parm, parm_cursor_behavior_ord, 3 ], 
            [ 'CHAR_PAST_LEFT',          v_parm, parm_cursor_behavior_ord, 4 ], 
            [ 'CHAR_PAST_RIGHT',         v_parm, parm_cursor_behavior_ord, 5 ], 
            [ 'CHAR_PAST_LAST_POSITION', v_parm, parm_cursor_behavior_ord, 6 ], 
            [ 'PROTECTED_PAST_RIGHT',    v_parm, parm_cursor_behavior_ord, 7 ], 
            [ 'PROTECTED_PAST_LEFT',     v_parm, parm_cursor_behavior_ord, 8 ], 
            [ 'PROTECTED_PAST_UP',       v_parm, parm_cursor_behavior_ord, 9 ], 
            [ 'PROTECTED_PAST_DOWN',     v_parm, parm_cursor_behavior_ord,10 ], 
            [ 'FIELD_PAST_RIGHT',        v_parm, parm_cursor_behavior_ord,11 ], 
            [ 'FIELD_PAST_LEFT',         v_parm, parm_cursor_behavior_ord,12 ], 
            [ 'FIELD_PAST_LAST',         v_parm, parm_cursor_behavior_ord,13 ], 
            [ 'FIELD_BEFORE_FIRST',      v_parm, parm_cursor_behavior_ord,14 ], 
               { Additional cursor-positioning parameters } 
    [ 'CURSOR_POS_COLUMN_FIRST',  v_parm, parm_cursor_pos_column_flag_ord, 0 ],
    [ 'CURSOR_POS_COLUMN_LENGTH', v_parm, parm_cursor_pos_length_ord, 0 ], 
    [ 'CURSOR_POS_ROW_LENGTH',    v_parm, parm_cursor_pos_length_ord, 1 ], 
               { Number of chars of blotch left by function key usage } 
    [ 'FUNCTION_KEY_LEAVES_MARK', v_parm, parm_function_key_mark_ord, 0 ], 
               { Initialization verbs } 
            [ 'LINE_INIT',                  v_init,   0,   0 ],
            [ 'SCREEN_INIT',                v_init,   0,   1 ],
               { Application String verbs } 
            [ 'APPLICATION_STRING',         v_appstr, 0,   0 ],
  
               { Both Input and Output } 
  
               { Basic set } 
            [ 'INSERT_CHAR',                v_inout,  1,   1 ], 
            [ 'DELETE_CHAR',                v_inout,  2,   2 ], 
            [ 'INSERT_LINE_STAY',           v_inout,  3,   3 ], 
            [ 'INSERT_LINE_BOL',            v_inout,  4,   4 ], 
            [ 'DELETE_LINE_STAY',           v_inout,  5,   5 ], 
            [ 'DELETE_LINE_BOL',            v_inout,  6,   6 ], 
            [ 'ERASE_PAGE_STAY',            v_inout,  7,   7 ], 
            [ 'ERASE_PAGE_HOME',            v_inout,  8,   8 ], 
            [ 'ERASE_UNPROTECTED',          v_inout,  9,   9 ], 
            [ 'ERASE_END_OF_PAGE',          v_inout, 10,  10 ], 
            [ 'ERASE_LINE_STAY',            v_inout, 11,  11 ], 
            [ 'ERASE_LINE_BOL',             v_inout, 12,  12 ], 
            [ 'ERASE_END_OF_LINE',          v_inout, 13,  13 ], 
            [ 'ERASE_FIELD_STAY',           v_inout, 14,  14 ], 
            [ 'ERASE_FIELD_BOF',            v_inout, 15,  15 ], 
            [ 'ERASE_END_OF_FIELD',         v_inout, 16,  16 ], 
            [ 'ERASE_CHAR',                 v_inout, 17,  17 ], 
            [ 'CURSOR_HOME',                v_inout, 18,  18 ], 
            [ 'CURSOR_UP',                  v_inout, 19,  19 ], 
            [ 'CURSOR_DOWN',                v_inout, 20,  20 ], 
            [ 'CURSOR_LEFT',                v_inout, 21,  21 ], 
            [ 'CURSOR_RIGHT',               v_inout, 22,  22 ], 
            [ 'TAB_FORWARD',                v_inout, 23,  23 ], 
            [ 'TAB_BACKWARD',               v_inout, 24,  24 ], 
            [ 'RETURN',                     v_inout, 25,  25 ], 
            [ 'RESET',                      v_inout, 26,  26 ], 
            [ 'INSERT_MODE_BEGIN',          v_inout, 27,  27 ], 
            [ 'INSERT_MODE_END',            v_inout, 28,  28 ], 
            [ 'INSERT_MODE_TOGGLE',         v_inout, 29,  29 ], 
            [ 'TAB_CLEAR',                  v_inout, 30,  30 ], 
            [ 'TAB_CLEAR_ALL',              v_inout, 31,  31 ], 
            [ 'TAB_SET',                    v_inout, 32,  32 ], 
            [ 'CURSOR_POS_BEGIN',           v_inout, 33,  33 ], 
            [ 'CURSOR_POS_SECOND',          v_inout, 34,  34 ], 
            [ 'CURSOR_POS_THIRD',           v_inout, 35,  35 ], 
  
               { Input Only }
  
               { Miscellaneous }
            [ 'END_OF_INFORMATION',         v_in,    36,   0 ],
            [ ' ',  { overstrike }          v_in,    37,   0 ],
               { Function keys } 
            [ 'F1',                         v_in,    38,   0 ],
            [ 'F2',                         v_in,    39,   0 ],
            [ 'F3',                         v_in,    40,   0 ],
            [ 'F4',                         v_in,    41,   0 ],
            [ 'F5',                         v_in,    42,   0 ],
            [ 'F6',                         v_in,    43,   0 ],
            [ 'F7',                         v_in,    44,   0 ],
            [ 'F8',                         v_in,    45,   0 ],
            [ 'F9',                         v_in,    46,   0 ],
            [ 'F10',                        v_in,    47,   0 ],
            [ 'F11',                        v_in,    48,   0 ],
            [ 'F12',                        v_in,    49,   0 ],
            [ 'F13',                        v_in,    50,   0 ],
            [ 'F14',                        v_in,    51,   0 ],
            [ 'F15',                        v_in,    52,   0 ],
            [ 'F16',                        v_in,    53,   0 ],
            [ 'F1_S',                       v_in,    54,   0 ],
            [ 'F2_S',                       v_in,    55,   0 ],
            [ 'F3_S',                       v_in,    56,   0 ],
            [ 'F4_S',                       v_in,    57,   0 ],
            [ 'F5_S',                       v_in,    58,   0 ],
            [ 'F6_S',                       v_in,    59,   0 ],
            [ 'F7_S',                       v_in,    60,   0 ],
            [ 'F8_S',                       v_in,    61,   0 ],
            [ 'F9_S',                       v_in,    62,   0 ],
            [ 'F10_S',                      v_in,    63,   0 ],
            [ 'F11_S',                      v_in,    64,   0 ],
            [ 'F12_S',                      v_in,    65,   0 ],
            [ 'F13_S',                      v_in,    66,   0 ],
            [ 'F14_S',                      v_in,    67,   0 ],
            [ 'F15_S',                      v_in,    68,   0 ],
            [ 'F16_S',                      v_in,    69,   0 ],
               { CDC standard function keys } 
            [ 'NEXT',                       v_in,    70,   0 ],
            [ 'BACK',                       v_in,    71,   0 ],
            [ 'HELP',                       v_in,    72,   0 ],
            [ 'STOP',                       v_in,    73,   0 ],
            [ 'DOWN',                       v_in,    74,   0 ],
            [ 'UP',                         v_in,    75,   0 ],
            [ 'FWD',                        v_in,    76,   0 ],
            [ 'BKW',                        v_in,    77,   0 ],
            [ 'EDIT',                       v_in,    78,   0 ],
            [ 'DATA',                       v_in,    79,   0 ],
            [ 'NEXT_S',                     v_in,    80,   0 ],
            [ 'BACK_S',                     v_in,    81,   0 ],
            [ 'HELP_S',                     v_in,    82,   0 ],
            [ 'STOP_S',                     v_in,    83,   0 ],
            [ 'DOWN_S',                     v_in,    84,   0 ],
            [ 'UP_S',                       v_in,    85,   0 ],
            [ 'FWD_S',                      v_in,    86,   0 ],
            [ 'BKW_S',                      v_in,    87,   0 ],
            [ 'EDIT_S',                     v_in,    88,   0 ],
            [ 'DATA_S',                     v_in,    89,   0 ],
               { More input verbs }
            [ 'BACKSPACE',                  v_in,    90,   0 ],
            [ 'F17',                        v_in,    91,   0 ],
            [ 'F18',                        v_in,    92,   0 ],
            [ 'F19',                        v_in,    93,   0 ],
            [ 'F20',                        v_in,    94,   0 ],
            [ 'F21',                        v_in,    95,   0 ],
            [ 'F22',                        v_in,    96,   0 ],
            [ 'F23',                        v_in,    97,   0 ],
            [ 'F24',                        v_in,    98,   0 ],
            [ 'F17_S',                      v_in,    99,   0 ],
            [ 'F18_S',                      v_in,   100,   0 ],
            [ 'F19_S',                      v_in,   101,   0 ],
            [ 'F20_S',                      v_in,   102,   0 ],
            [ 'F21_S',                      v_in,   103,   0 ],
            [ 'F22_S',                      v_in,   104,   0 ],
            [ 'F23_S',                      v_in,   105,   0 ],
            [ 'F24_S',                      v_in,   106,   0 ],
            [ 'INSTALL_INPUT_1',            v_in,   107,   0 ],
            [ 'INSTALL_INPUT_2',            v_in,   108,   0 ],
            [ 'INSTALL_INPUT_3',            v_in,   109,   0 ],
            [ 'INSTALL_INPUT_4',            v_in,   110,   0 ],
            [ 'INSTALL_INPUT_5',            v_in,   111,   0 ],
            [ 'INSTALL_INPUT_6',            v_in,   112,   0 ],
            [ 'INSTALL_INPUT_7',            v_in,   113,   0 ],
            [ 'INSTALL_INPUT_8',            v_in,   114,   0 ],
            [ 'INSTALL_INPUT_9',            v_in,   115,   0 ],
            [ 'INSTALL_INPUT_10',           v_in,   116,   0 ],
            [ 'INSTALL_INPUT_11',           v_in,   117,   0 ],
            [ 'INSTALL_INPUT_12',           v_in,   118,   0 ],
            [ 'INSTALL_INPUT_13',           v_in,   119,   0 ],
            [ 'INSTALL_INPUT_14',           v_in,   120,   0 ],
            [ 'INSTALL_INPUT_15',           v_in,   121,   0 ],
            [ 'INSTALL_INPUT_16',           v_in,   122,   0 ],
            [ 'INSTALL_INPUT_17',           v_in,   123,   0 ],
            [ 'INSTALL_INPUT_18',           v_in,   124,   0 ],
            [ 'INSTALL_INPUT_19',           v_in,   125,   0 ],
            [ 'INSTALL_INPUT_20',           v_in,   126,   0 ],
  
               { Output Only }
  
               { Miscellaneous output verbs }
            [ 'BELL_NAK',                   v_out,    0,  36 ], 
            [ 'BELL_ACK',                   v_out,    0,  37 ], 
            [ 'SET_SCREEN_MODE',            v_out,    0,  38 ], 
            [ 'SET_LINE_MODE',              v_out,    0,  39 ], 
            [ 'OUTPUT_BEGIN',               v_out,    0,  40 ], 
            [ 'OUTPUT_END',                 v_out,    0,  41 ], 
            [ 'DISPLAY_BEGIN',              v_out,    0,  42 ], 
            [ 'DISPLAY_END',                v_out,    0,  43 ], 
            [ 'PRINT_BEGIN',                v_out,    0,  44 ], 
            [ 'PRINT_END',                  v_out,    0,  45 ], 
            [ 'PRINT_PAGE',                 v_out,    0,  46 ], 
            [ 'FIELD_SCROLL_SET',           v_out,    0,  47 ], 
            [ 'FIELD_SCROLL_DOWN',          v_out,    0,  48 ], 
            [ 'FIELD_SCROLL_UP',            v_out,    0,  49 ], 
            [ 'PROTECT_ALL',                v_out,    0,  50 ], 
               { Physical attributes } 
            [ 'BLINK_BEGIN',                v_out,    0,  51 ], 
            [ 'BLINK_END',                  v_out,    0,  52 ], 
            [ 'ALT_BEGIN',                  v_out,    0,  53 ], 
            [ 'ALT_END',                    v_out,    0,  54 ], 
            [ 'HIDDEN_BEGIN',               v_out,    0,  55 ], 
            [ 'HIDDEN_END',                 v_out,    0,  56 ], 
            [ 'INVERSE_BEGIN',              v_out,    0,  57 ], 
            [ 'INVERSE_END',                v_out,    0,  58 ], 
            [ 'PROTECT_BEGIN',              v_out,    0,  59 ], 
            [ 'PROTECT_END',                v_out,    0,  60 ], 
            [ 'UNDERLINE_BEGIN',            v_out,    0,  61 ], 
            [ 'UNDERLINE_END',              v_out,    0,  62 ], 
               { Logical attributes } 
            [ 'INPUT_TEXT_BEGIN',           v_out,    0,  63 ], 
            [ 'INPUT_TEXT_END',             v_out,    0,  64 ], 
            [ 'OUTPUT_TEXT_BEGIN',          v_out,    0,  65 ], 
            [ 'OUTPUT_TEXT_END',            v_out,    0,  66 ], 
            [ 'ITALIC_BEGIN',               v_out,    0,  67 ], 
            [ 'ITALIC_END',                 v_out,    0,  68 ], 
            [ 'TITLE_BEGIN',                v_out,    0,  69 ], 
            [ 'TITLE_END',                  v_out,    0,  70 ], 
            [ 'MESSAGE_BEGIN',              v_out,    0,  71 ], 
            [ 'MESSAGE_END',                v_out,    0,  72 ], 
            [ 'ERROR_BEGIN',                v_out,    0,  73 ], 
            [ 'ERROR_END',                  v_out,    0,  74 ], 
               { Line-drawing character sets } 
            [ 'LD_FINE_BEGIN',              v_out,    0,  75 ], 
            [ 'LD_FINE_END',                v_out,    0,  76 ], 
            [ 'LD_FINE_HORIZONTAL',         v_out,    0,  77 ], 
            [ 'LD_FINE_VERTICAL',           v_out,    0,  78 ], 
            [ 'LD_FINE_UPPER_LEFT',         v_out,    0,  79 ], 
            [ 'LD_FINE_UPPER_RIGHT',        v_out,    0,  80 ], 
            [ 'LD_FINE_LOWER_LEFT',         v_out,    0,  81 ], 
            [ 'LD_FINE_LOWER_RIGHT',        v_out,    0,  82 ], 
            [ 'LD_FINE_UP_T',               v_out,    0,  83 ], 
            [ 'LD_FINE_DOWN_T',             v_out,    0,  84 ], 
            [ 'LD_FINE_LEFT_T',             v_out,    0,  85 ], 
            [ 'LD_FINE_RIGHT_T',            v_out,    0,  86 ], 
            [ 'LD_FINE_CROSS',              v_out,    0,  87 ], 
            [ 'LD_MEDIUM_BEGIN',            v_out,    0,  88 ], 
            [ 'LD_MEDIUM_END',              v_out,    0,  89 ], 
            [ 'LD_MEDIUM_HORIZONTAL',       v_out,    0,  90 ], 
            [ 'LD_MEDIUM_VERTICAL',         v_out,    0,  91 ], 
            [ 'LD_MEDIUM_UPPER_LEFT',       v_out,    0,  92 ], 
            [ 'LD_MEDIUM_UPPER_RIGHT',      v_out,    0,  93 ], 
            [ 'LD_MEDIUM_LOWER_LEFT',       v_out,    0,  94 ], 
            [ 'LD_MEDIUM_LOWER_RIGHT',      v_out,    0,  95 ], 
            [ 'LD_MEDIUM_UP_T',             v_out,    0,  96 ], 
            [ 'LD_MEDIUM_DOWN_T',           v_out,    0,  97 ], 
            [ 'LD_MEDIUM_LEFT_T',           v_out,    0,  98 ], 
            [ 'LD_MEDIUM_RIGHT_T',          v_out,    0,  99 ], 
            [ 'LD_MEDIUM_CROSS',            v_out,    0, 100 ], 
            [ 'LD_BOLD_BEGIN',              v_out,    0, 101 ], 
            [ 'LD_BOLD_END',                v_out,    0, 102 ], 
            [ 'LD_BOLD_HORIZONTAL',         v_out,    0, 103 ], 
            [ 'LD_BOLD_VERTICAL',           v_out,    0, 104 ], 
            [ 'LD_BOLD_UPPER_LEFT',         v_out,    0, 105 ], 
            [ 'LD_BOLD_UPPER_RIGHT',        v_out,    0, 106 ], 
            [ 'LD_BOLD_LOWER_LEFT',         v_out,    0, 107 ], 
            [ 'LD_BOLD_LOWER_RIGHT',        v_out,    0, 108 ], 
            [ 'LD_BOLD_UP_T',               v_out,    0, 109 ], 
            [ 'LD_BOLD_DOWN_T',             v_out,    0, 110 ], 
            [ 'LD_BOLD_LEFT_T',             v_out,    0, 111 ], 
            [ 'LD_BOLD_RIGHT_T',            v_out,    0, 112 ], 
            [ 'LD_BOLD_CROSS',              v_out,    0, 113 ], 
               { Colors }
            [ 'INPUT_TWO_BEGIN',            v_out,    0, 114 ], 
            [ 'INPUT_TWO_END',              v_out,    0, 115 ], 
            [ 'OUTPUT_TWO_BEGIN',           v_out,    0, 116 ], 
            [ 'OUTPUT_TWO_END',             v_out,    0, 117 ], 
            [ 'ITALIC_TWO_BEGIN',           v_out,    0, 118 ], 
            [ 'ITALIC_TWO_END',             v_out,    0, 119 ], 
            [ 'TITLE_TWO_BEGIN',            v_out,    0, 120 ], 
            [ 'TITLE_TWO_END',              v_out,    0, 121 ], 
            [ 'MESSAGE_TWO_BEGIN',          v_out,    0, 122 ], 
            [ 'MESSAGE_TWO_END',            v_out,    0, 123 ], 
            [ 'ERROR_TWO_BEGIN',            v_out,    0, 124 ], 
            [ 'ERROR_TWO_END',              v_out,    0, 125 ], 
            [ 'DISPLAY_TWO_BEGIN',          v_out,    0, 126 ], 
            [ 'DISPLAY_TWO_END',            v_out,    0, 127 ], 
            [ 'DISPLAY_THREE_BEGIN',        v_out,    0, 128 ], 
            [ 'DISPLAY_THREE_END',          v_out,    0, 129 ], 
               { Screen size } 
            [ ' ',  { SET_SIZE }            v_out,    0, 130 ], 
            [ ' ',  { save space for 4 }    v_out,    0, 131 ], 
            [ ' ',  { change_size ordinals} v_out,    0, 132 ], 
            [ ' ',  { right here }          v_out,    0, 133 ],
            [ 'INSTALL_OUTPUT_1',          v_out,    0, 134 ],
            [ 'INSTALL_OUTPUT_2',          v_out,    0, 135 ],
            [ 'INSTALL_OUTPUT_3',          v_out,    0, 136 ],
            [ 'INSTALL_OUTPUT_4',          v_out,    0, 137 ],
            [ 'INSTALL_OUTPUT_5',          v_out,    0, 138 ],
            [ 'INSTALL_OUTPUT_6',          v_out,    0, 139 ],
            [ 'INSTALL_OUTPUT_7',          v_out,    0, 140 ],
            [ 'INSTALL_OUTPUT_8',          v_out,    0, 141 ],
            [ 'INSTALL_OUTPUT_9',          v_out,    0, 142 ],
            [ 'INSTALL_OUTPUT_10',         v_out,    0, 143 ],
            [ 'INSTALL_OUTPUT_11',         v_out,    0, 144 ],
            [ 'INSTALL_OUTPUT_12',         v_out,    0, 145 ],
            [ 'INSTALL_OUTPUT_13',         v_out,    0, 146 ],
            [ 'INSTALL_OUTPUT_14',         v_out,    0, 147 ],
            [ 'INSTALL_OUTPUT_15',         v_out,    0, 148 ],
            [ 'INSTALL_OUTPUT_16',         v_out,    0, 149 ],
            [ 'INSTALL_OUTPUT_17',         v_out,    0, 150 ],
            [ 'INSTALL_OUTPUT_18',         v_out,    0, 151 ],
            [ 'INSTALL_OUTPUT_19',         v_out,    0, 152 ],
            [ 'INSTALL_OUTPUT_20',         v_out,    0, 153 ],
               { Last one, unused } 
            [ '  ',                         v_inout,  0,   0 ]
           ]; 
  { ************************************************************} 
  { NOTE: Did you remember to change the constants which define }
  {       the length of this table, etc.?  They are in ZTDCVRB. }
  { ************************************************************} 
  
  CONST 
     predefined_variable_count = 49; 
  VAR 
     predefined_variables: PACKED ARRAY [ 1 .. predefined_variable_count ] OF
        PACKED RECORD 
        name: ost$name, 
        length: ost$name_size,
        ascii: 0 .. 255 
     RECEND := [ 
            [ 'NUL',         3,   0 ],
            [ 'SOH',         3,   1 ],
            [ 'STX',         3,   2 ],
            [ 'ETX',         3,   3 ],
            [ 'EOT',         3,   4 ],
            [ 'ENQ',         3,   5 ],
            [ 'ACK',         3,   6 ],
            [ 'BEL',         3,   7 ],
            [ 'BS',          2,   8 ],
            [ 'HT',          2,   9 ],
            [ 'LF',          2,  10 ],
            [ 'VT',          2,  11 ],
            [ 'FF',          2,  12 ],
            [ 'CR',          2,  13 ],
            [ 'SO',          2,  14 ],
  
            [ 'SI',          2,  15 ],
            [ 'DLE',         3,  16 ],
            [ 'DC1',         3,  17 ],
            [ 'DC2',         3,  18 ],
            [ 'DC3',         3,  19 ],
            [ 'DC4',         3,  20 ],
            [ 'NAK',         3,  21 ],
            [ 'SYN',         3,  22 ],
            [ 'ETB',         3,  23 ],
            [ 'CAN',         3,  24 ],
            [ 'EM',          2,  25 ],
            [ 'SUB',         3,  26 ],
            [ 'ESC',         3,  27 ],
            [ 'FS',          2,  28 ],
            [ 'GS',          2,  29 ],
            [ 'RS',          2,  30 ],
            [ 'US',          2,  31 ],
            [ 'DEL',         3, 127 ],
              { Communications-type ordinal values }
            [ 'ASYNCH',      6,   1 ],
            [ 'SYNCH',       5,   2 ],
            [ 'SNA',         3,   3 ],
              { Cursor-encoding ordinal values }
            [ 'BINARY_CURSOR', 13,   1 ], 
            [ 'CDC721_CURSOR', 13,   2 ], 
            [ 'ANSI_CURSOR',   11,   3 ], 
            [ 'IBM3270_CURSOR', 14,  4 ], 
            [ 'IBM3151_CURSOR', 14,  5 ], 
            [ 'USER_CURSOR',   11,   6 ], 
              { Cursor-behavior ordinal values }
            [ 'STOP_NEXT',      9,   0 ], 
            [ 'SCROLL_NEXT',   11,   1 ], 
            [ 'HOME_NEXT',      9,   2 ], 
            [ 'WRAP_ADJACENT_NEXT',18, 3 ], 
            [ 'WRAP_SAME_NEXT',14,   4 ], 
            [ 'AUTO_TAB_NEXT',13,    5 ], 
            [ 'AUTO_TAB_PREVIOUS',17, 6 ] 
               ]; 
  
?? OLDTITLE ??
?? NEWTITLE := 'tdu XREF''s' ??
?? EJECT ?? 
  
{ ***************** } 
{ tdu file handler: }
  
  
{ ZTDTFIL  TDU file handler data types }
  
  TYPE
     file_selector = ( input_file_sel, output_file_sel, error_file_sel ),
     input_output_selector = ( input_sel, output_sel ), 
     code_set_selector = ( ascii_sel, ascii64_sel ); 
  
{ ZTDPFIL  TDU file handler procedures } 
  
  PROCEDURE [XREF] open_file (file_id: file_selector;
        input_output: input_output_selector; 
        code_set: code_set_selector);
  
  PROCEDURE [XREF] close_file (file_id: file_selector); 
  
  PROCEDURE [XREF] get_file (file_id: file_selector;
        VAR text: STRING(*); 
        VAR text_len: INTEGER;
        VAR eof_flag: BOOLEAN); 
  
  PROCEDURE [XREF] put_file (file_id: file_selector;
        text: STRING(*));
  
{ ************************** }
{ tdu error handler follows: } 
  
  
  
{ ZOSPSSA    Sets status value to indicate abnormal cond. detected. } 
  
  PROCEDURE [XREF] osp$set_status_abnormal ALIAS 'zospssa' 
    ( identifier: string (2);
      condition: ost$status_condition;
      text: string ( * );
      VAR status: ost$status);
  
  
{ ZOSPASP    Appends parameter text to a status variable. } 
  
  PROCEDURE [XREF] osp$append_status_parameter ALIAS 'zospasp' (delimiter: 
    char; 
    text: string ( * );
    VAR status: ost$status);
  
{ ZTDCERR  tdu error-handling constants and types }
  
  CONST 
     tdc_prod_code = 'TD'; 
  
  TYPE
     error_type = (no_error, no_room_error, duplicate_input_error,
        duplicate_error, superset_error, subset_error, not_found_error); 
  
{ ZTDPERR  write error messages to listing file }
  
  PROCEDURE [XREF] report_error (text: STRING(*));
  
  PROCEDURE [XREF] error_status (status: ost$status);
  
{ ****************************** }
{ table-handling store procedures } 
  
{ ZTDPTBS  table-handling procedures to store items }
  
  PROCEDURE [XREF] store_parameters (parm: parameter_record);
  
  PROCEDURE [XREF] store_output_node (ordinal: ordinal_type;
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
  
  PROCEDURE [XREF] store_input_node (ordinal: ordinal_type;
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
  
  PROCEDURE [XREF] store_reset_sequence (ordinal: ordinal_type;
        char_seq_length: INTEGER; 
        char_seq: STRING(*);
        VAR error_return: error_type); 
  
  PROCEDURE [XREF] store_key_name_node (ordinal: ordinal_type; 
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
  
  PROCEDURE [XREF] store_appstr_node (name: STRING(*);
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
  
?? OLDTITLE ??
?? NEWTITLE := 'tduin variables' ??
?? EJECT ?? 
?? POP ?? 
  
  VAR 
     line_length: INTEGER, 
     line_buffer: STRING(osc$max_string_size), 
     line_number: INTEGER := 0, 
  
     source_string: STRING(osc$max_string_size), { for parser to scan } 
     source_length: clt$string_index, { valid length of source_string } 
     source_index: clt$string_index,  { current scan position in source }
     old_index: clt$string_index,     { saved scan position } 
     pdt: ^clt$parameter_descriptor_table, { the pdt for the current verb }
     pvt: ^clt$parameter_value_table,  { returned pvt from the parse }
     status: ost$status,
  
     empty_file: BOOLEAN, 
     error_return: error_type, 
     parm_rec: parameter_record, 
  
     size_ndx: INTEGER,
     junk_string: STRING(80),
     junk_len: INTEGER; 
  
  TYPE
     tdl_variable = PACKED RECORD     { my specialized version of clt$variable} 
        name: ost$name, 
        next_variable: ^tdl_variable,
        str_length: 0 .. osc$max_string_size, 
        value: ^STRING(*), 
     RECEND;
  
  VAR 
     variable_list: ^tdl_variable; 
  
  ?? OLDTITLE ??
  ?? NEWTITLE := 'read_tdl_statements' ?? 
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] read_tdl_statements;
  
  ?? NEWTITLE := 'source_error' ??
  ?? SKIP := 4 ??
  
  PROCEDURE source_error (status: ost$status); 
     VAR
        length: 0 .. osc$max_string_size,
        msg: STRING(osc$max_string_size + 7); 
  
     error_status(status); 
     msg := ''; 
     STRINGREP(msg, length, line_number: 5, ': ',
        source_string(1,source_length));
     report_error(msg(1,length)); 
     msg := ''; 
     IF ( 7 + source_index ) > length THEN 
        msg(length) := '^' 
     ELSE 
        msg(7 + source_index) := '^'
     IFEND; 
     report_error(msg(1,length)); 
  PROCEND source_error;
  ?? OLDTITLE ??
  
     ?? NEWTITLE := 'add_variable_to_symbol_table' ??
     ?? EJECT ??
  
     PROCEDURE add_variable_to_symbol_table (name: ost$name_descriptor; 
           VAR variable: ^tdl_variable; VAR error_return: error_type);
  
        ALLOCATE variable;
        IF variable = NIL THEN
           error_return := no_room_error;
           osp$set_status_abnormal(tdc_prod_code, clc$table_overflow,
              name.str(1,name.length), status);
           osp$append_status_parameter( 
              ' ', osc$status_parameter_delimiter, status);
           source_error(status)
        ELSE
           error_return := no_error; 
           variable^.name := name.str(1,name.length);
           variable^.next_variable := variable_list;
           variable^.str_length := 0;
           variable^.value := NIL; 
           variable_list := variable 
        IFEND 
     PROCEND add_variable_to_symbol_table;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'assign_value_to_variable' ?? 
     ?? SKIP := 4 ?? 
  
     PROCEDURE assign_value_to_variable (value_string: STRING(*);
           value_length: 0 .. osc$max_string_size;
           VAR variable: ^tdl_variable; VAR error_return: error_type);
  
        IF variable^.value <> NIL THEN
           FREE variable^.value 
        IFEND;
        IF value_length > 0 THEN 
           ALLOCATE variable^.value : [ value_length ]
        ELSE
           ALLOCATE variable^.value : [ 1 ]
        IFEND;
        IF variable^.value = NIL THEN 
           osp$set_status_abnormal(tdc_prod_code, clc$table_overflow,
              variable^.name, status); 
           osp$append_status_parameter( 
              ' ', osc$status_parameter_delimiter, status);
           source_error(status); 
           error_return := no_room_error;
        ELSE
           error_return := no_error; 
           variable^.str_length := value_length;
           variable^.value^ := value_string(1,value_length) 
        IFEND 
     PROCEND assign_value_to_variable; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'initialize_parsing_tables' ??
     ?? EJECT ??
  
     PROCEDURE initialize_parsing_tables;
        VAR 
           var_ndx: INTEGER, 
           char_value: STRING(1), 
           name: ost$name_descriptor, 
           variable: ^tdl_variable,
           error_return: error_type; 
  
        variable_list := NIL;
        FOR var_ndx := 1 TO predefined_variable_count DO
           name.length := predefined_variables[var_ndx].length; 
           name.str := predefined_variables[var_ndx].name; 
           add_variable_to_symbol_table(name, variable, error_return); 
           IF error_return = no_error THEN
              char_value(1) := CHR(predefined_variables[var_ndx].ascii);
              assign_value_to_variable(char_value, 1, variable, error_return)
           IFEND
        FOREND
     PROCEND initialize_parsing_tables;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'open_input_file' ??
     ?? SKIP := 4 ?? 
  
     PROCEDURE open_input_file;
        open_file(input_file_sel, input_sel, ascii_sel);
        line_number := 0 
     PROCEND open_input_file;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'read_line' ?? 
     ?? SKIP := 4 ?? 
  
     PROCEDURE read_line (VAR eof_flag: BOOLEAN); 
           get_file(input_file_sel, line_buffer, line_length, eof_flag);
           line_number := line_number + 1
     PROCEND read_line; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'analyze_lines' ?? 
     ?? EJECT ??
  
     PROCEDURE analyze_lines; 
        VAR 
           eof_flag, 
           found: BOOLEAN,
           parm_ndx: INTEGER, 
           verb_typ: verb_type, 
           in_ordinal: ordinal_type, 
           out_ordinal: ordinal_type, 
           token: clt$token;
  
        ?? NEWTITLE := 'test_parm_given' ?? 
        ?? EJECT ?? 
  
        PROCEDURE test_parm_given (parm_name: STRING(*); VAR given: BOOLEAN); 
           clp$test_parameter(pvt, parm_name, given, status); 
           IF NOT given THEN 
              osp$set_status_abnormal(tdc_prod_code, 
                 clc$required_parameter_missing, parm_name, status); 
              osp$append_status_parameter(
                 ' ', osc$status_parameter_delimiter, status); 
              source_error(status) 
           IFEND
        PROCEND test_parm_given; 
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'parm_to_name' ?? 
        ?? SKIP := 4 ??
  
        PROCEDURE parm_to_name (parm_name: STRING(*); VAR result: STRING(*);
              VAR result_length: ost$string_size);
           VAR
              given: BOOLEAN, 
              value: clt$value; 
  
           test_parm_given(parm_name, given); 
           IF NOT given THEN 
              result_length := 0 
           ELSE 
              clp$get_value(pvt, parm_name, 1, 1, clc$low, value, status); 
              clp$convert_value_to_string(value, result, result_length, 
                 status); 
              IF NOT status.normal THEN 
                 source_error(status)
              IFEND 
           IFEND
        PROCEND parm_to_name; 
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'parm_to_integer' ?? 
        ?? SKIP := 4 ??
  
        PROCEDURE parm_to_integer (parm_name: STRING(*); VAR result: INTEGER); 
           VAR
              given: BOOLEAN, 
              temp_integer: clt$integer,
              value: clt$value; 
  
           test_parm_given(parm_name, given); 
           IF NOT given THEN 
              result := 0
           ELSE 
              clp$get_value(pvt, parm_name, 1, 1, clc$low, value, status); 
              clp$convert_value_to_integer(value, temp_integer, status);
              IF status.normal THEN 
                 result := temp_integer.int
              ELSE
                 source_error(status)
              IFEND 
           IFEND
        PROCEND parm_to_integer; 
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'parm_to_boolean' ?? 
        ?? SKIP := 4 ??
  
        PROCEDURE parm_to_boolean (parm_name: STRING(*); VAR result: BOOLEAN); 
           VAR
              given: BOOLEAN, 
              value: clt$value; 
  
           test_parm_given(parm_name, given); 
           IF NOT given THEN 
              result := FALSE
           ELSE 
              clp$get_value(pvt, parm_name, 1, 1, clc$low, value, status); 
              clp$convert_value_to_boolean(value, result, status); 
              IF NOT status.normal THEN 
                 source_error(status)
              IFEND 
           IFEND
        PROCEND parm_to_boolean; 
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'parm_to_string' ?? 
        ?? SKIP := 4 ??
  
        PROCEDURE parm_to_string (parm_name: STRING(*);
              VAR result: STRING(*); 
              VAR result_length: ost$string_size);
           { special case: this routine takes a multi-valued parameter, with } 
           {   string, integer, or variable values, and concatenates them } 
           {   into a single result string } 
  
           VAR
              given: BOOLEAN, 
              variable: ^tdl_variable, 
              set_count,
              set_ndx: 0 .. clc$max_value_sets, 
              value: clt$value; 
  
           result_length := 0; 
           test_parm_given(parm_name, given); 
           IF given THEN 
              clp$get_set_count(pvt, parm_name, set_count, status);
              IF NOT status.normal THEN 
                 source_error(status)
              ELSE
                 FOR set_ndx := 1 TO set_count DO
                    clp$get_value(pvt, parm_name, set_ndx, 1, clc$low,
                       value, status); 
                    IF NOT status.normal THEN 
                       source_error(status)
                    ELSE
                       CASE value.typ OF
                          = clc$string_value =
                             IF ( result_length + value.str_length ) >
                                   osc$max_string_size THEN 
                                osp$set_status_abnormal(tdc_prod_code, 
                                   clc$string_overflow, '', status); 
                                source_error(status) 
                             IFEND; 
                             STRINGREP(result, result_length, 
                                result(1,result_length),
                                value.str(1,value.str_length)); 
                          = clc$integer_value =
                             IF result_length >= osc$max_string_size THEN 
                                osp$set_status_abnormal(tdc_prod_code, 
                                   clc$string_overflow, '', status); 
                                source_error(status) 
                             IFEND; 
                             STRINGREP(result, result_length, 
                                result(1,result_length),
                                CHR(value.int.int)); 
                          = clc$name_value =
                             find_variable(value.name, found, variable);
                             IF found THEN 
                                IF ( result_length +
                                        variable^.str_length ) >
                                      osc$max_string_size THEN
                                   osp$set_status_abnormal( 
                                      tdc_prod_code, 
                                      clc$string_overflow, '', status);
                                   source_error(status)
                                IFEND;
                                STRINGREP(result, result_length,
                                   result(1,result_length), 
                                   variable^.value^(1,variable^.str_length)) 
                             ELSE 
                                error_table(not_found_error, 
                                   value.name.str(1,value.name.length))
                             IFEND; 
                          = clc$unknown_value =
                             result := ' ';
                             result_length := 0; 
                          = clc$boolean_value, clc$status_value, 
                            clc$variable_reference =
                             osp$set_status_abnormal(tdc_prod_code,
                                tde_invalid_type, '', status);
                             source_error(status); 
                       CASEND 
                    IFEND 
                 FOREND 
              IFEND 
           IFEND
        PROCEND parm_to_string; 
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'error_table' ??
        ?? EJECT ?? 
  
        PROCEDURE error_table (error_return: error_type; text: STRING(*));
  
           CASE error_return OF
              = no_room_error =
                 osp$set_status_abnormal(tdc_prod_code, tde_no_room,
                    text, status);
                 osp$append_status_parameter( 
                    ' ', osc$status_parameter_delimiter, status);
              = duplicate_error = 
                 osp$set_status_abnormal(tdc_prod_code, tde_duplicate_verb,
                    text, status);
                 osp$append_status_parameter( 
                    ' ', osc$status_parameter_delimiter, status);
              = duplicate_input_error =
                 osp$set_status_abnormal(tdc_prod_code, tde_duplicate_input,
                    text, status);
                 osp$append_status_parameter( 
                    ' ', osc$status_parameter_delimiter, status);
              = superset_error = 
                 osp$set_status_abnormal(tdc_prod_code, tde_superset, 
                    text, status);
                 osp$append_status_parameter( 
                    ' ', osc$status_parameter_delimiter, status);
              = subset_error = 
                 osp$set_status_abnormal(tdc_prod_code, tde_subset, 
                    text, status);
                 osp$append_status_parameter( 
                    ' ', osc$status_parameter_delimiter, status);
              = not_found_error =
                 osp$set_status_abnormal(tdc_prod_code, tde_not_found,
                    text, status);
                 osp$append_status_parameter( 
                    ' ', osc$status_parameter_delimiter, status);
           CASEND;
           source_error(status)
        PROCEND error_table;
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'find_variable' ??
        ?? EJECT ?? 
  
        PROCEDURE find_variable (name: ost$name_descriptor; 
              VAR found: BOOLEAN; VAR variable: ^tdl_variable);
  
           found := FALSE;
           variable := variable_list;
           WHILE ( found = FALSE ) AND 
                 ( variable <> NIL ) DO 
              IF ( variable^.name = name.str(1,name.length) ) AND 
                 ( variable^.value <> NIL ) THEN
                 found := TRUE
              ELSE
                 variable := variable^.next_variable
              IFEND 
           WHILEND
        PROCEND find_variable;
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'search_verb_table' ?? 
        ?? EJECT ?? 
  
        PROCEDURE search_verb_table (str: ost$name; VAR typ: verb_type; 
              VAR in_ordinal: ordinal_type; VAR out_ordinal: ordinal_type; 
              VAR found: BOOLEAN);
           VAR
              verb_ndx: 1 .. max_verb_count + 1;
  
           found := FALSE;
           verb_ndx := 1; 
           WHILE ( verb_ndx <= max_verb_count ) AND ( NOT found ) DO
              IF verb_table[verb_ndx].name = str THEN
                 found := TRUE; 
                 typ := verb_table[verb_ndx].typ;
                 in_ordinal := verb_table[verb_ndx].in_ordinal;
                 out_ordinal := verb_table[verb_ndx].out_ordinal 
              ELSE
                 verb_ndx := verb_ndx + 1
              IFEND 
           WHILEND
        PROCEND search_verb_table; 
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'process_verb' ??
        ?? EJECT ?? 
  
        PROCEDURE process_verb (typ: verb_type;
              in_ordinal: ordinal_type; out_ordinal: ordinal_type; 
              name: ost$name_descriptor); 
  
           ?? NEWTITLE := 'write_parm' ?? 
           ?? SKIP := 4 ?? 
  
           PROCEDURE write_parm (ordinal: ordinal_type; 
                 flag_ordinal: ordinal_type);
              VAR 
                 result: INTEGER,
                 variable: ^tdl_variable,
                 value: clt$value,
                 bad_name, 
                 found: BOOLEAN,
                 name_ndx, 
                 temp_string_len: ost$string_size, 
                 temp_string: STRING(osc$max_string_size); 
  
              CASE ordinal OF
                 = parm_name_ord =    { model name and length }
                    parm_to_name('VALUE', temp_string, temp_string_len); 
                    IF temp_string_len = 0 THEN
                       osp$set_status_abnormal(tdc_prod_code,
                          tde_name_required, '', status);
                       source_error(status)
                    ELSEIF temp_string_len > 6 THEN
                       osp$set_status_abnormal(tdc_prod_code,
                          tde_name_too_long, '', status); 
                       source_error(status)
                    ELSE
                       bad_name := FALSE; 
                       FOR size_ndx := 1 TO temp_string_len DO 
                          IF NOT (
                             ( ( temp_string(size_ndx) >= '0' ) AND
                               ( temp_string(size_ndx) <= '9' ) ) OR 
                             ( ( temp_string(size_ndx) >= 'A' ) AND
                               ( temp_string(size_ndx) <= 'Z' ) ) OR 
                             ( ( temp_string(size_ndx) >= 'a' ) AND 
                               ( temp_string(size_ndx) <= 'z' ) ) ) THEN
                             bad_name := TRUE 
                          IFEND 
                       FOREND;
                       IF bad_name THEN
                          osp$set_status_abnormal(tdc_prod_code, 
                             tde_invalid_name, '', status); 
                          source_error(status) 
                       ELSE 
                          parm_rec.model_name := 
                             temp_string(1,temp_string_len); 
                          parm_rec.model_name_len := temp_string_len 
                       IFEND
                    IFEND;
                 = parm_communications_ord = 
                    clp$get_value(pvt, 'TYPE', 1, 1, clc$low, value, status);
                    IF NOT status.normal THEN 
                       source_error(status)
                    ELSE
                       IF value.typ <> clc$name_value THEN
                          osp$set_status_abnormal(tdc_prod_code, 
                             tde_invalid_comm, '', status); 
                          source_error(status) 
                       ELSE 
                          find_variable(value.name, found, variable); 
                          IF found THEN
                             IF ( ORD(variable^.value^(1)) < 0 ) OR
                                ( ORD(variable^.value^(1)) > 
                                   communications_type_max ) THEN
                                osp$set_status_abnormal(tdc_prod_code, 
                                   tde_invalid_comm, '', status); 
                                source_error(status) 
                             ELSE 
                                parm_rec.communications :=
                                   ORD(variable^.value^(1))
                             IFEND
                          ELSE
                             osp$set_status_abnormal(tdc_prod_code,
                                tde_invalid_comm, '', status);
                             source_error(status)
                          IFEND 
                       IFEND
                    IFEND;
                 = parm_cursor_encoding_ord =
                    clp$get_value(pvt, 'TYPE', 1, 1, clc$low, value, status);
                    IF NOT status.normal THEN 
                       source_error(status)
                    ELSE
                       IF value.typ <> clc$name_value THEN
                          osp$set_status_abnormal(tdc_prod_code, 
                             tde_invalid_cursor, '', status); 
                          source_error(status) 
                       ELSE 
                          find_variable(value.name, found, variable); 
                          IF found THEN
                             IF ( ORD(variable^.value^(1)) < 0 ) OR
                                ( ORD(variable^.value^(1)) > 
                                   cursor_encoding_max ) THEN
                                osp$set_status_abnormal(tdc_prod_code, 
                                   tde_invalid_cursor, '', status); 
                                source_error(status) 
                             ELSE 
                                parm_rec.cursor_encoding := 
                                   ORD(variable^.value^(1))
                             IFEND
                          ELSE
                             osp$set_status_abnormal(tdc_prod_code,
                                tde_invalid_cursor, '', status);
                             source_error(status)
                          IFEND 
                       IFEND
                    IFEND;
                    parm_to_integer('BIAS', result); 
                    IF ( result < LOWERVALUE(parm_rec.cursor_bias) ) OR
                       ( result > UPPERVALUE(parm_rec.cursor_bias) ) THEN
                       osp$set_status_abnormal(tdc_prod_code,
                          tde_bias_out_of_range, '', status);
                       source_error(status)
                    ELSE
                       parm_rec.cursor_bias := result 
                    IFEND;
                 = parm_flags_ord =   { boolean flags } 
                    parm_to_boolean('VALUE', parm_rec.flag[flag_ordinal]); 
                 = parm_size_ord =    { screen sizes }
                    size_ndx := 0;
                    WHILE ( size_ndx <= screen_size_max ) AND 
                          ( ( parm_rec.size[size_ndx].cols <> 0 ) OR
                            ( parm_rec.size[size_ndx].rows <> 0 ) ) DO
                       size_ndx := size_ndx + 1
                    WHILEND;
                    IF size_ndx > screen_size_max THEN
                       osp$set_status_abnormal(tdc_prod_code,
                          tde_screen_size_overflow, '', status); 
                       source_error(status)
                    ELSE
                       parm_to_integer('ROWS', junk_len); 
                       IF ( junk_len < 0 ) OR ( junk_len > size_row_max ) THEN
                          osp$set_status_abnormal(tdc_prod_code, 
                             tde_screen_row_overflow, '', status);
                          source_error(status) 
                       ELSE 
                          parm_rec.size[size_ndx].rows := junk_len
                       IFEND; 
                       parm_to_integer('COLUMNS', junk_len);
                       IF ( junk_len < 0 ) OR ( junk_len > size_col_max ) THEN
                          osp$set_status_abnormal(tdc_prod_code, 
                             tde_screen_col_overflow, '', status);
                          source_error(status) 
                       ELSE 
                          parm_rec.size[size_ndx].cols := junk_len
                       IFEND; 
                       test_parm_given('OUT', found); { write_out isn't picky }
                       IF found THEN 
                          write_out(size_output_ord + size_ndx) 
                       IFEND
                    IFEND;
                 = parm_cursor_behavior_ord =
                    clp$get_value(pvt, 'TYPE', 1, 1, clc$low, value, status);
                    IF NOT status.normal THEN 
                       source_error(status)
                    ELSE
                       IF value.typ <> clc$name_value THEN
                          osp$set_status_abnormal(tdc_prod_code, 
                             tde_invalid_cursor_behavior, '', status);
                          source_error(status) 
                       ELSE 
                          find_variable(value.name, found, variable); 
                          IF found THEN
                             IF ( ORD(variable^.value^(1)) < 0 ) OR
                                ( ORD(variable^.value^(1)) > 
                                   cursor_behavior_max ) THEN
                                osp$set_status_abnormal(tdc_prod_code, 
                                   tde_invalid_cursor_behavior, '', status);
                                source_error(status) 
                             ELSE 
                                parm_rec.cursor_behavior[flag_ordinal] :=
                                   ORD(variable^.value^(1))
                             IFEND
                          ELSE
                             osp$set_status_abnormal(tdc_prod_code,
                                tde_invalid_cursor_behavior, '', status); 
                             source_error(status)
                          IFEND 
                       IFEND
                    IFEND;
                 = parm_cursor_pos_column_flag_ord = { column/row first } 
                    parm_to_boolean('VALUE', parm_rec.cursor_pos_column_flag); 
                 = parm_cursor_pos_length_ord = { # chars per each x/y value } 
                    parm_to_integer('VALUE', result);
                    IF ( result < 0 ) OR
                       ( result > UPPERVALUE( 
                          parm_rec.cursor_pos_length[flag_ordinal]) ) THEN 
                       osp$set_status_abnormal(tdc_prod_code,
                          tde_cursor_len_out_of_range, '', status); 
                       source_error(status)
                    ELSE
                       parm_rec.cursor_pos_length[flag_ordinal] := result 
                    IFEND;
                 = parm_function_key_mark_ord = { # chars of blotch leftover } 
                    parm_to_integer('VALUE', result);
                    IF ( result < 0 ) OR
                       ( result > UPPERVALUE( 
                          parm_rec.function_key_mark) ) THEN
                       osp$set_status_abnormal(tdc_prod_code,
                          tde_function_key_mark_range, '', status);
                       source_error(status)
                    ELSE
                       parm_rec.function_key_mark := result
                    IFEND;
              CASEND
           PROCEND write_parm; 
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_in' ?? 
           ?? EJECT ??
  
           PROCEDURE write_in (ordinal: ordinal_type);
              VAR 
                 in_given, 
                 inout_given, 
                 label_given: BOOLEAN, 
                 label_len: ost$string_size,
                 label_name: ost$name, 
                 string_len: ost$string_size,
                 input_string: STRING(osc$max_string_size); 
  
              clp$test_parameter(pvt, 'LABEL', label_given, status); 
              IF label_given THEN 
                 parm_to_name('LABEL', label_name, label_len); 
                 store_key_name_node(ordinal, label_len, label_name,
                    error_return); 
                 IF error_return <> no_error THEN 
                    error_table(error_return, label_name) 
                 IFEND
              IFEND;
              clp$test_parameter(pvt, 'IN', in_given, status);
              clp$test_parameter(pvt, 'INOUT', inout_given, status); 
              IF in_given AND inout_given THEN 
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_duplicate_in_inout, '', status); 
                 source_error(status)
              IFEND;
              IF in_given THEN 
                 parm_to_string('IN', input_string, string_len) 
              ELSEIF inout_given THEN 
                 parm_to_string('INOUT', input_string, string_len)
              ELSE
                 RETURN               { no major objection if unspecified }
              IFEND;
              store_input_node(ordinal, string_len, input_string,
                 error_return);
              IF error_return <> no_error THEN
                 error_table(error_return, name.str(1,name.length)) 
              IFEND 
           PROCEND write_in; 
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_out' ?? 
           ?? EJECT ??
  
           PROCEDURE write_out (ordinal: ordinal_type);
              VAR 
                 out_given, 
                 inout_given: BOOLEAN, 
                 string_len: ost$string_size,
                 output_string: STRING(osc$max_string_size); 
  
              clp$test_parameter(pvt, 'OUT', out_given, status); 
              clp$test_parameter(pvt, 'INOUT', inout_given, status); 
              IF out_given AND inout_given THEN 
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_duplicate_out_inout, '', status); 
                 source_error(status)
              IFEND;
              IF out_given THEN 
                 parm_to_string('OUT', output_string, string_len)
              ELSEIF inout_given THEN 
                 parm_to_string('INOUT', output_string, string_len)
              ELSE
                 RETURN               { no major objection if unspecified }
              IFEND;
              store_output_node(ordinal, string_len, output_string,
                 error_return);
              IF error_return <> no_error THEN
                 error_table(error_return, name.str(1,name.length)) 
              IFEND 
           PROCEND write_out; 
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_init' ?? 
           ?? EJECT ??
  
           PROCEDURE write_init (ordinal: ordinal_type);
              VAR 
                 out_given: BOOLEAN, 
                 string_len: ost$string_size,
                 output_string: STRING(osc$max_string_size); 
  
              clp$test_parameter(pvt, 'OUT', out_given, status); 
              IF out_given THEN 
                 parm_to_string('OUT', output_string, string_len); 
                 store_reset_sequence(ordinal, string_len, output_string, 
                    error_return); 
                 IF error_return <> no_error THEN 
                    error_table(error_return, name.str(1,name.length))
                 IFEND
              IFEND 
           PROCEND write_init; 
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_appstr' ?? 
           ?? EJECT ??
  
           PROCEDURE write_appstr; 
              VAR 
                 char_ndx: INTEGER, 
                 string_len: ost$string_size,
                 output_string: STRING(osc$max_string_size), 
                 name_len: ost$string_size,
                 name: ost$name;
  
              parm_to_name('NAME', name, name_len);
              IF (name_len < 1) OR (name_len > 7) THEN
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_appstr_name_too_long, '', status);
                 source_error(status)
              IFEND;
              FOR char_ndx := 1 to name_len DO { test for validity in C-63 }
                 IF utv$convert_ascii_to_ascii64[name(char_ndx)] = 0 THEN
                    osp$set_status_abnormal(tdc_prod_code, 
                       tde_invalid_appstr_name, name(1,name_len), status); 
                    osp$append_status_parameter(
                       ' ', osc$status_parameter_delimiter, status); 
                    source_error(status) 
                 IFEND
              FOREND; 
              parm_to_string('OUT', output_string, string_len);
              store_appstr_node(name(1,name_len), string_len, output_string, 
                 error_return);
              IF error_return <> no_error THEN
                 error_table(error_return, name(1,name_len))
              IFEND 
           PROCEND write_appstr; 
           ?? OLDTITLE ?? 
           ?? EJECT ??
  
           CASE typ OF 
              = v_parm = 
                 clp$scan_parameter_list(source_string, source_index,
                    ^parm_pdt, pvt, status); 
                 IF status.normal THEN
                    write_parm(in_ordinal, out_ordinal) 
                 ELSE 
                    source_error(status) 
                 IFEND; 
              = v_in = 
                 clp$scan_parameter_list(source_string, source_index,
                    ^in_pdt, pvt, status); 
                 IF status.normal THEN
                    write_in(in_ordinal)
                 ELSE 
                    source_error(status) 
                 IFEND; 
              = v_out = 
                 clp$scan_parameter_list(source_string, source_index,
                    ^out_pdt, pvt, status); 
                 IF status.normal THEN
                    write_out(out_ordinal)
                 ELSE 
                    source_error(status) 
                 IFEND; 
              = v_inout = 
                 clp$scan_parameter_list(source_string, source_index,
                    ^inout_pdt, pvt, status); 
                 IF status.normal THEN
                    write_in(in_ordinal); 
                    write_out(out_ordinal)
                 ELSE 
                    source_error(status) 
                 IFEND; 
              = v_init = 
                 clp$scan_parameter_list(source_string, source_index,
                    ^init_pdt, pvt, status); 
                 IF status.normal THEN
                    write_init(out_ordinal)
                 ELSE 
                    source_error(status) 
                 IFEND; 
              = v_appstr = 
                 clp$scan_parameter_list(source_string, source_index,
                    ^appstr_pdt, pvt, status); 
                 IF status.normal THEN
                    write_appstr 
                 ELSE 
                    source_error(status) 
                 IFEND; 
           CASEND;
           clp$free_parameter_value_table(pvt) 
        PROCEND process_verb;
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'process_variable' ??
        ?? EJECT ?? 
  
        PROCEDURE process_variable (name: ost$name_descriptor);
           VAR
              found: BOOLEAN, 
              error_return: error_type,
              variable: ^tdl_variable; 
  
           ?? NEWTITLE := 'parse_variable_assignment' ??
           ?? SKIP := 4 ?? 
  
           PROCEDURE parse_variable_assignment (VAR variable: ^tdl_variable;
                 VAR error_return: error_type);
              VAR 
                 variable_reference: ^tdl_variable, 
                 token: clt$token,
                 found: BOOLEAN,
                 new_str_length,
                 value_length: INTEGER, 
                 new_str, 
                 value_string: STRING(osc$max_string_size); 
  
              old_index := source_index;
              clp$scan_token(clc$not_in_expression, source_string,
                 source_index, token, status);
              IF NOT status.normal THEN 
                 source_index := old_index; { point to offending token } 
                 source_error(status); 
                 error_return := not_found_error;
                 RETURN 
              IFEND;
              IF token.typ <> clc$assign_token THEN 
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_invalid_verb_variable, '', status); 
                 source_index := old_index; { point to offending token } 
                 source_error(status); 
                 error_return := not_found_error;
                 RETURN 
              IFEND;
              value_length := 0;
              REPEAT
                 new_str_length := 0;
                 old_index := source_index; 
                 clp$scan_token(clc$not_in_expression, source_string, 
                    source_index, token, status); 
                 IF NOT status.normal THEN
                    source_index := old_index; { point to offending token }
                    source_error(status);
                    error_return := not_found_error; 
                    RETURN
                 IFEND; 
                 IF token.typ = clc$name_token THEN 
                    find_variable(token.name, found, variable_reference);
                    IF NOT found THEN
                       error_return := not_found_error;
                       error_table(error_return, 
                          token.name.str(1,token.name.length));
                       RETURN 
                    IFEND;
                    new_str := variable_reference^.value^; 
                    new_str_length := variable_reference^.str_length
                 ELSEIF token.typ = clc$string_token THEN 
                    new_str := token.str;
                    new_str_length := token.str_length 
                 ELSEIF token.typ = clc$integer_token THEN 
                    IF ( token.int.int < 0 ) OR
                       ( token.int.int > 127 ) THEN
                       osp$set_status_abnormal(tdc_prod_code,
                          tde_invalid_character, '', status);
                       source_error(status)
                    ELSE
                       new_str(1) := CHR(token.int.int);
                       new_str_length := 1 
                    IFEND 
                 ELSEIF ( token.typ <> clc$cat_token ) AND 
                        ( token.typ <> clc$lparen_token ) AND 
                        ( token.typ <> clc$rparen_token ) AND 
                        ( token.typ <> clc$eos_token ) THEN
                    osp$set_status_abnormal(tdc_prod_code, clc$invalid,
                       token.str(1,token.str_length), status);
                    osp$append_status_parameter(
                       ' ', osc$status_parameter_delimiter, status); 
                    source_index := old_index; { point to offending token }
                    source_error(status);
                    error_return := not_found_error; 
                    RETURN
                 IFEND; 
                 IF ( value_length + new_str_length ) >
                       osc$max_string_size THEN 
                    osp$set_status_abnormal(tdc_prod_code, 
                       clc$string_overflow, '', status); 
                    source_index := old_index; { point to offending token }
                    source_error(status);
                    error_return := no_room_error; 
                    RETURN
                 IFEND; 
                 IF new_str_length > 0 THEN 
                    STRINGREP(value_string, value_length, 
                       value_string(1,value_length),
                       new_str(1,new_str_length)) 
                 IFEND
              UNTIL source_index > source_length;
              assign_value_to_variable(value_string, value_length, 
                 variable, error_return) 
           PROCEND parse_variable_assignment;
           ?? OLDTITLE ?? 
           ?? EJECT ??
  
           find_variable(name, found, variable); 
           IF found THEN 
              parse_variable_assignment(variable, error_return) 
           ELSE 
              add_variable_to_symbol_table(name, variable, error_return);
              IF error_return = no_error THEN 
                 parse_variable_assignment(variable, error_return)
              IFEND 
           IFEND
        PROCEND process_variable;
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'check_and_process_statement' ??
        ?? EJECT ?? 
  
        PROCEDURE check_and_process_statement;
              IF token.typ <> clc$name_token THEN 
                 CASE token.typ OF
                    = clc$unknown_token .. clc$string_token =
                       junk_string := token.str(1,token.str_length); 
                       junk_len := token.str_length;
                    = clc$boolean_token =
                       junk_string := '';
                       STRINGREP(junk_string, junk_len, token.bool);
                    = clc$integer_token =
                       junk_string := 'INTEGER'; 
                       junk_len := 7; 
                 CASEND;
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_expecting_verb_variable, junk_string(1,junk_len),
                    status);
                 osp$append_status_parameter( 
                    ' ', osc$status_parameter_delimiter, status);
                 source_error(status)
              ELSE
                 search_verb_table(token.name.str(1,token.name.length), 
                    verb_typ, in_ordinal, out_ordinal, found); 
                 IF found THEN 
                    process_verb(verb_typ, in_ordinal, out_ordinal,
                       token.name);
                 ELSE 
                    process_variable(token.name)
                 IFEND
              IFEND 
        PROCEND check_and_process_statement;
  
        ?? EJECT ?? 
  
        empty_file := TRUE; 
        parm_rec.model_name := ' ';
        parm_rec.model_name_len := 0; 
        parm_rec.communications := asynch_comm; 
        parm_rec.cursor_encoding := invalid_cursor;
        parm_rec.cursor_bias := 0;
        FOR parm_ndx := 0 TO parm_flag_max DO
           parm_rec.flag[parm_ndx] := FALSE
        FOREND; 
        FOR parm_ndx := 0 TO screen_size_max DO
           parm_rec.size[parm_ndx].cols := 0;
           parm_rec.size[parm_ndx].rows := 0 
        FOREND; 
        FOR parm_ndx := 0 TO cursor_behavior_max DO
           parm_rec.cursor_behavior[parm_ndx] := -1
        FOREND; 
        parm_rec.cursor_pos_column_flag := FALSE;
        FOR parm_ndx := 0 TO 1 DO 
           parm_rec.cursor_pos_length[parm_ndx] := 0
        FOREND; 
  
        read_line(eof_flag); 
        WHILE NOT eof_flag DO
           source_string := line_buffer; 
           source_length := line_length; 
           source_index := 1; 
           WHILE source_index <= source_length DO { pre-scan for continuations} 
              REPEAT
                 old_index := source_index; 
                 clp$scan_token(clc$not_in_expression, source_string, 
                    source_index, token, status); 
                 IF NOT status.normal THEN
                    source_index := old_index; { point to offending token }
                    source_error(status);
                    source_index := source_length + 1 { stop scanning now }
                 IFEND
              UNTIL ( source_index > source_length ) OR
                    ( token.typ = clc$ellipsis_token ); 
              IF status.normal AND
                 ( token.typ = clc$ellipsis_token ) THEN
                 read_line(eof_flag);
                 IF ( old_index + line_length ) > osc$max_string_size THEN
                    osp$set_status_abnormal(tdc_prod_code, 
                       tde_continuation_overflow, '', status); 
                    source_error(status) 
                 ELSE 
                    STRINGREP(source_string, source_length, 
                       source_string(1,old_index-1),
                       line_buffer(1,line_length)); 
                    source_index := old_index 
                 IFEND
              IFEND 
           WHILEND; 
           source_index := 1; 
           clp$scan_token(clc$not_in_expression, source_string, 
              source_index, token, status); 
           IF status.normal AND       { error reported during pre-scan }
              ( source_index <= source_length ) THEN 
              empty_file := FALSE;    { found something } 
              check_and_process_statement 
           IFEND; 
           read_line(eof_flag);
        WHILEND;
  
        store_parameters(parm_rec)
     PROCEND analyze_lines; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'global_edits' ?? 
     ?? EJECT ??
  
     PROCEDURE global_edits; 
        VAR 
           behavior_ndx: 0 .. cursor_behavior_max; 
  
        IF empty_file THEN 
           osp$set_status_abnormal(tdc_prod_code, tde_empty_file,
              '', status);
           error_status(status)
        ELSE
           IF parm_rec.model_name_len = 0 THEN 
              osp$set_status_abnormal(tdc_prod_code, 
                 clc$required_parameter_missing, 
                 verb_table[parm_name_verb].name, status); 
              osp$append_status_parameter(
                 ' ', osc$status_parameter_delimiter, status); 
              error_status(status) 
           IFEND; 
           IF parm_rec.cursor_encoding = invalid_cursor THEN
              osp$set_status_abnormal(tdc_prod_code, 
                 clc$required_parameter_missing, 
                 verb_table[parm_cursor_encoding_verb].name, status);
              osp$append_status_parameter(
                 ' ', osc$status_parameter_delimiter, status); 
              error_status(status) 
           IFEND; 
           IF parm_rec.cursor_encoding = binary_cursor THEN
              junk_len := 0; 
              size_ndx := 0; 
              WHILE ( size_ndx <= screen_size_max ) AND 
                    ( parm_rec.size[size_ndx].cols <> 0 ) AND 
                    ( parm_rec.size[size_ndx].rows <> 0 ) DO
                 IF junk_len < parm_rec.size[size_ndx].cols THEN 
                    junk_len := parm_rec.size[size_ndx].cols 
                 IFEND; 
                 size_ndx := size_ndx + 1 
              WHILEND;
              IF junk_len + parm_rec.cursor_bias > binary_col_max THEN
                 osp$set_status_abnormal(tdc_prod_code,
                    clc$value_out_of_range, 
                    verb_table[parm_set_size_verb].name, status); 
                 osp$append_status_parameter( ' ',
                    osc$status_parameter_delimiter, status); 
                 error_status(status)
              IFEND 
           IFEND; 
           FOR behavior_ndx := 0 TO cursor_behavior_max DO 
              IF parm_rec.cursor_behavior[behavior_ndx] < 0 THEN
                 IF behavior_ndx < cursor_behavior_div THEN 
                   osp$set_status_abnormal(tdc_prod_code,
                      clc$required_parameter_missing,
                      verb_table[parm_cursor_behavior_verb + behavior_ndx].name,
                      status);
                   osp$append_status_parameter( 
                      ' ', osc$status_parameter_delimiter, status);
                   error_status(status)
                 IFEND
              IFEND 
  
           FOREND 
        IFEND 
     PROCEND global_edits; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'close_input_file' ??
     ?? EJECT ??
  
     PROCEDURE close_input_file;
        close_file(input_file_sel);
     PROCEND close_input_file;
     ?? OLDTITLE ?? 
     ?? EJECT ??
  
     initialize_parsing_tables;
     open_input_file;
     analyze_lines; 
     global_edits; 
     close_input_file;
  
  PROCEND read_tdl_statements; 
  ?? OLDTITLE ??
  
MODEND tduin;
MODULE tduout;
  
?? SET ( CHKALL := ON ), RIGHT := 110 ??
  
{  Module :  TDUOUT } 
{            Copyright Control Data Systems Inc.  1992.  } 
{  Written:  1/84 by R. Lindsey  } 
{  Version:  Cyber 170, version 1 } 
{  Purpose:  This is the output portion of the TDU program.  }
  
  ?? PUSH ( LIST := OFF ) ??          { uncomment this line to suppress list }
{ ?? PUSH ( LIST := ON ) ??           { uncomment this line to list }
  
?? NEWTITLE := 'Utilities' ??
  
{ integer to string conversion, ascii to ascii-64 conversion } 
  
{ OSDSTR    type definitions for string } 
  
  CONST 
    osc$max_string_size = 256;
  
  TYPE
    ost$string_size = 0 .. osc$max_string_size;
  
  TYPE
    ost$string_index = 1 .. osc$max_string_size + 1;
  
  TYPE
    ost$string = record
      size: ost$string_size,
      value: string (osc$max_string_size),
    recend; 
  
  
{ ZCLTSTR    Defines string length and string index for SCL. } 
  
    TYPE
      clt$string_length = integer,
  
      clt$string_index = integer;
  
{ ZOSTSTR    Defines the bounds of strings. } 
  
  CONST 
    osc$max_string_length = osc$max_string_size;
  
  TYPE
    ost$string_length = 0 .. osc$max_string_length;
  
{ ZUTPI2S    Converts integer to string rep. in specified radix. } 
  
  PROCEDURE [XREF] utp$convert_integer_to_string ALIAS 'zutpi2s' (VAR
    result_string: string ( * ); 
    VAR result_length: ost$string_length; 
    source_integer: integer; 
    radix: 2 .. 16);
  
{ ZUTVCTT    Translation table used in conversion to/from ascii. }
  
  VAR 
    utv$convert_ascii_to_ascii612 ALIAS 'cvas612': [XREF, READ] array 
      [char] of packed record 
      case long: boolean of 
      = FALSE = 
        f1: set of 1 .. 53,
        ch: 0 .. 3f(16),
      = TRUE =
        f2: set of 1 .. 47,
        escape_ch: 0 .. 3f(16), 
        follower_ch: 0 .. 3f(16), 
      casend, 
    recend, 
    utv$convert_ascii612_to_ascii ALIAS 'cv612as': [XREF, READ] array [0
      .. 3f(16)] of packed record
      case escape: boolean of 
      = FALSE = 
        f1: set of 1 .. 51,
        ch: char,
      = TRUE =
        f2: set of 1 .. 41,
        conv: ^array [0 .. 3f(16)] of char, 
      casend, 
    recend, 
    utv$convert_ascii_to_ascii64 ALIAS 'cvasc64': [XREF, READ] array 
      [char] of 0 .. 3f(16), 
    utv$convert_ascii64_to_ascii ALIAS 'cv64asc': [XREF, READ] array [0
      .. 3f(16)] of char;
  
?? OLDTITLE ??
?? NEWTITLE := 'ZTDTTAB' ??
?? SKIP := 4 ??
  
{ **************************** }
{ common deck ZTDTTAB follows: }
  
{ ZTDTTAB  contains type declarations used by the TDU table handler et. al. }
  
  CONST 
     communications_type_max = 3,     { actual ordinal values } 
     invalid_cursor = 0,              { 'ordinal' value }
     asynch_comm = 1,                 { 'ordinal' value } 
     binary_cursor = 1,               { 'ordinal' value } 
     cursor_encoding_max = 6,         { 'invalid' is always #0 }
     parm_flag_max = 56,              { upper bound of parm flag array }
     screen_size_max = 3,             { up to 4 screen sizes }
     size_row_max = 64,               { number of rows on a screen } 
     size_col_max = 255,              { number of columns on a screen } 
     binary_col_max = 128,            { binary_cursor maximum screen columns }
     cursor_behavior_max_ord = 6,     { cursor behavior maximum ordinal } 
     cursor_behavior_max = 14,        { upper bound for wrap/scroll etc. } 
     cursor_behavior_div = 6,         { upper bound for wrap/scroll etc. } 
     no_ordinal = 0,                  { enumerated-style ordinal value }
     overstrike_ordinal = 37;         { VIRTERM-compatible } 
  
  TYPE
     ordinal_type = 0 .. 255,         { input and output VIRTERM ordinals }
  
     communications_type = 0 .. communications_type_max, 
        { invalid, asynch, synch, sna }
  
     cursor_encoding_type = 0 .. cursor_encoding_max,
        { these ordinals indicate what method of cursor positioning is used  }
        { invalid_cursor, binary, cdc721, ansi, ibm3270, ibm3151, user }
  
     parameter_record = RECORD        { contains non-input/output parameters } 
        model_name: STRING (7),       { terminal-type code as known by users }
        model_name_len: 0 .. 7,       { length of model name string used  } 
        communications: communications_type,   { asynch, synch, SNA, etc. }
        cursor_encoding: cursor_encoding_type, { cursor-positioning info  } 
        cursor_bias: -127 .. 127,     { cursor addressing offset          } 
        flag: ARRAY [ 0 .. parm_flag_max ] OF BOOLEAN, { various flags    } 
        size: ARRAY [ 0 .. screen_size_max ] OF RECORD { screen sizes }
           cols: 0 .. size_col_max,
           rows: 0 .. size_row_max,
        RECEND, 
        cursor_behavior: ARRAY [ 0 .. cursor_behavior_max ] 
                           OF -1 .. cursor_behavior_max_ord , 
        cursor_pos_column_flag: BOOLEAN, { TRUE if column pos goes first }
        cursor_pos_length: ARRAY [ 0 .. 1 ] OF 0 .. 7, { # digits per x/y }
        function_key_mark: 0 .. 7,    { # chars of blotch left by function key} 
     RECEND,
  
     string_node = PACKED RECORD      { an ordinal-designated char sequence }
        length: 0 .. 32767,           { length of char_sequence }
        chars: ^STRING(*),            { the sequence itself } 
     RECEND,
  
     dump_procedure_type =            { dumps string nodes from tables } 
        ^PROCEDURE ( ordinal: ordinal_type; 
                     VAR length: INTEGER;
                     VAR chars: ^STRING(*);
                     VAR total_ordinals: INTEGER; { last ordinal in table } 
                     VAR total_characters: INTEGER; 
                     VAR node_returned: BOOLEAN),
  
     opcode_type = (fail, list, range, single_action_range), { input opcodes }
  
     input_action = PACKED RECORD     { ordinal/pointer pair } 
        ordinal: ordinal_type,        { 0 = no ordinal, look at next_node } 
        next_offset: 0 .. 4095,       { output-table-style pointer }
        next_level: ALIGNED ^input_node, { points to another node }
     RECEND,
  
     list_node = PACKED ARRAY [1 .. *] OF { 1 element for each char in list } 
        PACKED RECORD                 { each node of an input-parse list }
           character: CHAR,           { character to match }
           action: input_action,      { ordinal/pointer pair }
        RECEND, 
  
     range_node = PACKED ARRAY [ * ] OF { 1 action for each char in range }
        input_action,                 { ordinal/pointer pair } 
  
     input_node = BOUND RECORD        { linked list of input-parsing rules }
        next_node: ^input_node,       { 'real' table will use consecutive mem }
        offset: 0 .. 4095,            { target table offset of this node }
        node_visited: BOOLEAN,        { node has been visited in this pass }
        CASE opcode: opcode_type OF   { fail, list, range, single-action range}
           = fail =                   { fail }
              ,                       { no parameters } 
           = list =                   { list }
              list_character_count: 1 .. 1023,  {  count of chars in list  } 
              list_pointer: ^ list_node, { list of char/action pairs }
           = range =                  { range } 
              range_lower_bound: CHAR,{ first character of range } 
              range_upper_bound: CHAR,{ last character in range } 
              range_pointer: ^ range_node, { list of actions, 1/char in range} 
           = single_action_range =    { single-action range } 
              sar_lower_bound: CHAR,  { first char of range } 
              sar_upper_bound: CHAR,  { last char in range } 
              sar_action: input_action,{ ordinal/pointer pair }
        CASEND, 
     RECEND,
  
     appstr_node = RECORD             { linked list of application strings }
        next_node: ^appstr_node,      { 'real' table will use consecutive mem } 
        name: STRING(31),             { non-unique key for this applictn stng } 
        value: string_node,           { length and contents of the string } 
     RECEND;
  
?? OLDTITLE ??
?? NEWTITLE := 'tdu XREF''s, etc.' ?? 
?? EJECT ?? 
  
{ ***************** } 
{ tdu file handler: }
  
  
{ ZTDTFIL  TDU file handler data types }
  
  TYPE
     file_selector = ( input_file_sel, output_file_sel, error_file_sel ),
     input_output_selector = ( input_sel, output_sel ), 
     code_set_selector = ( ascii_sel, ascii64_sel ); 
  
{ ZTDPFIL  TDU file handler procedures } 
  
  PROCEDURE [XREF] open_file (file_id: file_selector;
        input_output: input_output_selector; 
        code_set: code_set_selector);
  
  PROCEDURE [XREF] close_file (file_id: file_selector); 
  
  PROCEDURE [XREF] get_file (file_id: file_selector;
        VAR text: STRING(*); 
        VAR text_len: INTEGER;
        VAR eof_flag: BOOLEAN); 
  
  PROCEDURE [XREF] put_file (file_id: file_selector;
        text: STRING(*));
  
{ ********************** }
{ error handling routine }
  
  
  
  
{ OSDSTAT   Definition of request status record } 
  
  CONST 
    osc$max_condition = 999999,
    osc$status_parameter_delimiter = '"';
  
  TYPE
    ost$status_condition = 0 .. osc$max_condition, 
    ost$status = record
      case normal: boolean of 
      =FALSE= 
        identifier: string (2),
        condition: ost$status_condition,
        text: ost$string, 
      casend, 
    recend; 
  
  
{ ZOSPSSA    Sets status value to indicate abnormal cond. detected. } 
  
  PROCEDURE [XREF] osp$set_status_abnormal ALIAS 'zospssa' 
    ( identifier: string (2);
      condition: ost$status_condition;
      text: string ( * );
      VAR status: ost$status);
  
  
{ ZOSPASP    Appends parameter text to a status variable. } 
  
  PROCEDURE [XREF] osp$append_status_parameter ALIAS 'zospasp' (delimiter: 
    char; 
    text: string ( * );
    VAR status: ost$status);
  
{ ZTDCERR  tdu error-handling constants and types }
  
  CONST 
     tdc_prod_code = 'TD'; 
  
  TYPE
     error_type = (no_error, no_room_error, duplicate_input_error,
        duplicate_error, superset_error, subset_error, not_found_error); 
  
{ ZTDPERR  write error messages to listing file }
  
  PROCEDURE [XREF] report_error (text: STRING(*));
  
  PROCEDURE [XREF] error_status (status: ost$status);
  
{ ****************************** }
{ table-handling dump procedures } 
  
{ ZTDPTBD  table-handler (tdutab) procedures for dumping data } 
  
  PROCEDURE [XREF] dump_parameters (VAR parm_record: parameter_record); 
  
  PROCEDURE [XREF] dump_output_node (ordinal: ordinal_type;
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_ordinals: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
  PROCEDURE [XREF] dump_input_node ( 
        output_procedure: ^PROCEDURE(in_nd: ^input_node));
  
  PROCEDURE [XREF] reset_input_table (VAR character_count: INTEGER);
  
  PROCEDURE [XREF] dump_reset_sequence(ordinal: ordinal_type; 
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_ordinals: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
  PROCEDURE [XREF] dump_key_name_node(ordinal: ordinal_type;
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_ordinals: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
  PROCEDURE [XREF] dump_appstr_node (VAR name: STRING(*);
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_sequences: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
  PROCEDURE [XREF] reset_appstr_table;
  
  ?? EJECT ?? 
  ?? POP ?? 
  
  CONST 
     target_wordsize = 60,            { word size of target machine (170) }
     target_char_size = 7;            { bit size of each character }
  
  VAR 
     tdu_version_num: [XREF] INTEGER,  { from main program } 
  
     word_number: INTEGER := -1,      { pre-decremented word counter } 
     bits_left_in_word: INTEGER := 0, { bits remaining in word, start empty }
  
     stringrep_len: INTEGER,          { used by all STRINGREP calls }
  
     parm_record: parameter_record,   { terminal non-I/O parameters }
     in_node: ^input_node,            { input table item } 
     status: ost$status,
  
     outrec: PACKED RECORD            { output buffer }
        CASE line_type: (whole_line, opcode_line, comment_line) OF 
           = whole_line =             { for output--write the whole line } 
              line_buffer: STRING(72), 
           = opcode_line =            { for 'regular' opcode/param lines }
              filler1: STRING(1),     { CHAR won't work here } 
              label: STRING(9),       { column 2 }
              opcode: STRING(7),      { column 11 }
              parameters: STRING(20), { column 18, need lots of room here }
              comment: STRING(35),    { column 38, non-standard, oh well } 
           = comment_line =           { for full-line comments }
              comment_indicator: STRING(6), { col. 1 '*' + filler } 
              comment_text: STRING(66), { column 7, not to line up w/opcode } 
        CASEND, 
     RECEND;
  
  {  Subtable labels table }
  
  CONST 
     subtable_count = 5,              { number of subtables defined }
     subtable_input = 1, 
     subtable_names = 2, 
     subtable_init = 3, 
     subtable_appstr = 4, 
     subtable_end = 5; 
  
  VAR 
     subtable_index: INTEGER, 
     subtable_list: [STATIC] PACKED ARRAY [1..subtable_count] OF PACKED RECORD
        label: STRING(8),             { the label itself }
        label_len: 0 .. 8,            { significant length of label }
     RECEND 
        := [  ['INPUT', 5],
              ['NAMES', 5], 
              ['INIT', 4],
              ['APPSTR', 6],
              ['ENDTABL', 7] ]; 
  
  ?? NEWTITLE := 'write_tables' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] write_tables;      { this is called to write entire table } 
  
     ?? NEWTITLE := 'write_line' ?? 
     ?? SKIP := 4 ?? 
  
     PROCEDURE write_line; 
        put_file(output_file_sel, outrec.line_buffer);
     PROCEND write_line; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_opcode_line' ??
     ?? SKIP := 4 ?? 
  
     PROCEDURE write_opcode_line;
        outrec.line_type := whole_line; 
        write_line;
        outrec.line_type := opcode_line; 
        outrec.label := '';           { never want to save a label } 
     PROCEND write_opcode_line;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_comment' ?? 
     ?? SKIP := 4 ?? 
  
     PROCEDURE write_comment; 
        outrec.comment_indicator := '*'; 
        outrec.line_type := whole_line; 
        write_line;
        outrec.line_buffer := '';     { always return a blank line } 
        outrec.line_type := comment_line; 
     PROCEND write_comment; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_vfd' ?? 
     ?? EJECT ??
  
     PROCEDURE write_vfd(bit_length, field_value: INTEGER; commnt: STRING(*)); 
        VAR 
           temp_string, 
           bit_length_string,
           field_value_string: STRING(4),
           bit_l_s_length, 
           field_v_s_length: ost$string_length; { subrange for string size }
  
        outrec.opcode := 'VFD';
        utp$convert_integer_to_string(bit_length_string, bit_l_s_length, 
           bit_length, 10);
        utp$convert_integer_to_string(field_value_string, field_v_s_length, 
           field_value, 10);
{       IF field_value = (-0) THEN 
{          STRINGREP(temp_string, field_v_s_length, 
{             '-', field_value_string(1,field_v_s_length)); 
{          field_value_string := temp_string
{       IFEND; 
        outrec.parameters := ''; 
        STRINGREP(outrec.parameters, stringrep_len, 
           bit_length_string(1,bit_l_s_length), 
           '/': 1, 
           field_value_string(1,field_v_s_length));
        outrec.comment := commnt; 
        write_opcode_line; 
        outrec.comment := ''; 
        bits_left_in_word := bits_left_in_word - bit_length;
     PROCEND write_vfd; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'start_word_output' ??
     ?? EJECT ??
  
     PROCEDURE start_word_output;
        VAR 
           integer_string: STRING(6), 
           i_s_length: ost$string_length; { subrange of integer, str-len } 
  
        IF bits_left_in_word < target_wordsize THEN { only if not already word} 
           word_number := word_number + 1; 
           bits_left_in_word := target_wordsize; 
           outrec.line_type := comment_line;
           outrec.comment_text := ''; 
           utp$convert_integer_to_string(integer_string, i_s_length,
              word_number, 8);        { STRINGREP can't do octal (!) } 
           STRINGREP(outrec.comment_text, stringrep_len, 'WORD ': 5,
              integer_string: i_s_length);
           write_comment; 
        IFEND;
     PROCEND start_word_output;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_ordinals' ?? 
     ?? EJECT ??
  
     PROCEDURE write_ordinals (dump_procedure: dump_procedure_type);
        VAR 
           ordinal_ndx: INTEGER, 
           length: INTEGER,
           chars: ^STRING(*),
           total_characters, 
           total_ordinals: INTEGER, 
           node_returned: BOOLEAN, 
           bit_count, 
           word_count, 
           remainder,
           remainder_chars, 
           filler_bits, 
           char_offset: INTEGER, 
           integer_string: STRING(6), 
           i_s_length: ost$string_length, { subrange of integer, str-len } 
           comment: STRING(30); 
  
        dump_procedure^(0, length, chars, total_ordinals, total_characters,
           node_returned);
        bit_count := ( ( total_ordinals + 2 ) * 12 ); 
        word_count := bit_count DIV 60; 
        remainder := 60 - ( bit_count MOD 60 ); 
        char_offset := ( word_count * 8 ) + 8 - ( remainder DIV 7 ); 
        ordinal_ndx := 0;
        REPEAT
           dump_procedure^(ordinal_ndx, length, chars, 
              total_ordinals, total_characters, node_returned); 
           IF node_returned THEN
              IF bits_left_in_word < 12 THEN
                 start_word_output 
              IFEND;
              outrec.line_type := opcode_line; 
              comment := '';
              utp$convert_integer_to_string(integer_string, i_s_length, 
                    ordinal_ndx, 10); { ordinal in string format } 
              STRINGREP(comment, stringrep_len,
                    'ORDINAL ': 8, integer_string: i_s_length);
              write_vfd(12, char_offset, comment); 
              char_offset := char_offset + length; 
              ordinal_ndx := ordinal_ndx + 1 
           IFEND
        UNTIL NOT node_returned;
        IF bits_left_in_word < 12 THEN
           start_word_output 
        IFEND;
        outrec.line_type := opcode_line; 
        write_vfd(12, char_offset, 'END OF ORDINALS');
        IF bits_left_in_word > 0 THEN 
           remainder_chars := remainder DIV 7;
           filler_bits := remainder - ( remainder_chars * 7 );
           write_vfd(filler_bits, 0, 'FILLER')
        IFEND 
     PROCEND write_ordinals; 
  
     ?? OLDTITLE ?? 
     ?? NEWTITLE := 'write_char_sequences' ??
     ?? EJECT ??
  
     PROCEDURE write_char_sequences (dump_procedure: dump_procedure_type); 
        VAR 
           ordinal_ndx: INTEGER, 
           length: INTEGER,
           chars: ^STRING(*),
           total_characters, 
           total_ordinals: INTEGER, 
           node_returned: BOOLEAN, 
           integer_string: STRING(6), 
           i_s_length: ost$string_length, { subrange of integer, str-len } 
           char_ndx: INTEGER, 
           comment: STRING(30); 
  
        ordinal_ndx := 0;
        REPEAT
           dump_procedure^(ordinal_ndx, length, chars, 
              total_ordinals, total_characters, node_returned); 
           IF node_returned THEN
              IF bits_left_in_word = target_wordsize THEN { first word only }
                 write_vfd(4, 0, 'FILLER'); 
              IFEND;
              comment := '';
              utp$convert_integer_to_string(integer_string, i_s_length, 
                 ordinal_ndx, 10);    { ordinal in string format } 
              STRINGREP(comment, stringrep_len,
                 'ORDINAL ': 8, integer_string: i_s_length); 
              outrec.line_type := opcode_line; 
              FOR char_ndx := 1 TO length DO
                 IF bits_left_in_word < target_char_size THEN 
                    start_word_output; 
                    outrec.line_type := opcode_line; 
                    write_vfd(4, 0, 'FILLER') 
                 IFEND; 
                 write_vfd(target_char_size,
                    ORD(chars^(char_ndx)), comment);
                 comment := ''
              FOREND; 
              ordinal_ndx := ordinal_ndx + 1 
           IFEND
        UNTIL NOT node_returned;
        IF ( bits_left_in_word > 0 ) AND
           ( bits_left_in_word < target_wordsize ) THEN 
           outrec.line_type := opcode_line;
           write_vfd(bits_left_in_word, 0, 'FILLER')
        IFEND 
     PROCEND write_char_sequences;
  
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_tab_protect_parms' ?? 
     ?? EJECT ??
  
     PROCEDURE write_tab_protect_parms; 
        VAR 
           resv_ndx: INTEGER, 
           loop_ndx: INTEGER, 
           parm_ndx: INTEGER; 
        loop_ndx := (cursor_behavior_div + 1); 
  
        FOR parm_ndx := loop_ndx TO cursor_behavior_max DO
           IF (ORD(parm_record.cursor_behavior[parm_ndx]) = -1) THEN 
             write_vfd(4, 0, 'CURSOR BEHAVIOR');
           ELSE 
             write_vfd(4, ORD(parm_record.cursor_behavior[parm_ndx]),
                'CURSOR BEHAVIOR'); 
           IFEND; 
        FOREND; 
  
        resv_ndx := 4 * ((cursor_behavior_max - cursor_behavior_div)- 1); 
        write_vfd(resv_ndx, 0, 'RESERVED');
  
     PROCEND write_tab_protect_parms; 
  
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_header' ?? 
     ?? EJECT ??
  
     PROCEDURE write_header; 
        VAR 
           junk_name: STRING(7), 
           junk_len: INTEGER; 
  
        dump_parameters(parm_record); 
        junk_name := ' ';             { concatenate 'Z' to start of name } 
        STRINGREP(junk_name, junk_len, 'Z', { to ensure a valid NOS name } 
           parm_record.model_name(1,parm_record.model_name_len));
        parm_record.model_name := junk_name;
        parm_record.model_name_len := junk_len; 
  
        outrec.line_type := opcode_line; 
        outrec.label := ''; 
        outrec.comment := ''; 
        outrec.opcode := 'IDENT';
        outrec.parameters := parm_record.model_name;
        write_opcode_line; 
        outrec.opcode := 'LCC';
        outrec.parameters := 'GROUP(VIRTERM)'; 
        write_opcode_line; 
        outrec.parameters := ''; 
        STRINGREP(outrec.parameters,stringrep_len, 'CAPSULE(':8, 
           parm_record.model_name(1,parm_record.model_name_len), 
           ')':1 );
        write_opcode_line; 
        outrec.opcode := 'ENTRY';
        outrec.parameters := parm_record.model_name;
        write_opcode_line; 
        start_word_output; 
        outrec.line_type := opcode_line; 
        outrec.label := parm_record.model_name;
        outrec.opcode := 'BSS';
        outrec.parameters := '0';
        write_opcode_line; 
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'HEADER';
        write_comment;
        write_comment;
        outrec.line_type := opcode_line; 
        outrec.opcode := 'VFD';
        outrec.parameters := ''; 
        STRINGREP(outrec.parameters, stringrep_len, 
           '42/0L': 5, 
           parm_record.model_name(2,6)); { without leading 'Z' } 
        write_opcode_line; 
        bits_left_in_word := bits_left_in_word - 42; 
        write_vfd(18, tdu_version_num, 'VERSION NUMBER') 
     PROCEND write_header; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_sub_table_pointers' ?? 
     ?? EJECT ??
  
     PROCEDURE write_sub_table_pointers; 
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'SUB-TABLE POINTERS';
        write_comment;
        write_comment;                { comment_text was automatically blanked} 
        start_word_output; 
        FOR subtable_index := 1 TO subtable_count DO 
           IF bits_left_in_word < 12 THEN 
              start_word_output; 
           IFEND; 
           outrec.line_type := opcode_line;
           outrec.opcode := 'VFD'; 
           outrec.parameters := '';
           STRINGREP(outrec.parameters, stringrep_len,
              '12/',
              subtable_list[subtable_index].label: 
                 subtable_list[subtable_index].label_len,
              '-',
              parm_record.model_name(1,parm_record.model_name_len)); 
           write_opcode_line;
           bits_left_in_word := bits_left_in_word - 12;
        FOREND; 
        outrec.line_type := opcode_line; 
        IF bits_left_in_word > 0 THEN { make explicit filler }
           write_vfd(bits_left_in_word, 0, 'RESERVED'); 
        IFEND;
        start_word_output; 
        outrec.line_type := opcode_line; 
     {  write_vfd(target_wordsize, 0, 'RESERVED') } 
        write_tab_protect_parms;
     PROCEND write_sub_table_pointers; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_parameters' ?? 
     ?? EJECT ??
  
     PROCEDURE write_parameters; 
        VAR 
           parm_ndx: INTEGER; 
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'PARAMETERS';
        write_comment;
        write_comment;
        start_word_output; 
        outrec.line_type := opcode_line; 
        write_vfd(6, parm_record.cursor_encoding, 
           'CURSOR ADDRESSING TYPE'); 
        write_vfd(8, parm_record.cursor_bias, 'CURSOR ADDRESSING BIAS');
  
      { FOR parm_ndx := 0 TO cursor_behavior_max DO }
        FOR parm_ndx := 0 TO cursor_behavior_div DO
           write_vfd(4, ORD(parm_record.cursor_behavior[parm_ndx]),
              'CURSOR BEHAVIOR'); 
        FOREND; 
  
        write_vfd(1, ORD(parm_record.cursor_pos_column_flag),
           'COLUMNS BEFORE ROWS FLAG'); 
        FOR parm_ndx := 0 TO 1 DO 
           write_vfd(3, parm_record.cursor_pos_length[parm_ndx],
              'NUMBER OF DIGITS IN CURSOR POSITION'); 
        FOREND; 
        write_vfd(bits_left_in_word, 0, 'RESERVED');
  
        start_word_output; 
        outrec.line_type := opcode_line; 
        FOR parm_ndx := 0 TO parm_flag_max DO
           write_vfd(1, ORD(parm_record.flag[parm_ndx]), 'FLAG');
        FOREND; 
        write_vfd(3, parm_record.function_key_mark, 'FUNCTION KEY MARK') 
     PROCEND write_parameters; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_size_table' ??
     ?? EJECT ??
  
     PROCEDURE write_size_table;
        VAR 
           size_ndx: INTEGER; 
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'SCREEN SIZES';
        write_comment;
        write_comment;
        start_word_output; 
        outrec.line_type := opcode_line; 
        FOR size_ndx := 0 TO 3 DO 
           write_vfd(8, parm_record.size[size_ndx].cols, 'X SIZE (COLUMNS)');
           write_vfd(7, parm_record.size[size_ndx].rows, 'Y SIZE (ROWS)')
        FOREND
     PROCEND write_size_table;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_subtable_start' ??
     ?? EJECT ??
  
     PROCEDURE write_subtable_start;
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'START OF SUB-TABLES'; 
        write_comment;
        write_comment 
     PROCEND write_subtable_start;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_output_table' ??
     ?? EJECT ??
  
     PROCEDURE write_output_table;
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'OUTPUT SUB-TABLE';
        write_comment;
        outrec.comment_text := '    OFFSETS BY ORDINAL';
        write_comment;
        write_comment;
        start_word_output; 
        outrec.line_type := opcode_line; 
        write_ordinals(^dump_output_node);
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := '    OUTPUT CHARACTER SEQUENCES';
        write_comment;
        write_comment;
        outrec.line_type := opcode_line; 
        write_char_sequences(^dump_output_node)
     PROCEND write_output_table;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_input_table' ??
     ?? EJECT ??
  
     PROCEDURE write_input_table;
        VAR 
           table_size: INTEGER, 
           node_returned: BOOLEAN; 
  
        ?? NEWTITLE := 'write_input_item' ?? 
        ?? SKIP := 4 ??
  
        PROCEDURE write_input_item (in_node: ^input_node); 
  
           ?? NEWTITLE := 'write_char' ?? 
           ?? SKIP := 4 ?? 
  
           PROCEDURE write_char(char_value: INTEGER; comment: STRING(*));
  
              outrec.line_type := opcode_line; 
              IF bits_left_in_word = target_wordsize THEN { first word only }
                 write_vfd(4, 0, 'FILLER'); 
              IFEND;
              IF bits_left_in_word < target_char_size THEN
                 start_word_output;
                 outrec.line_type := opcode_line;
                 write_vfd(4, 0, 'FILLER'); 
              IFEND;
              write_vfd(target_char_size, char_value, comment); 
           PROCEND write_char; 
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_action' ?? 
           ?? SKIP := 4 ?? 
  
           PROCEDURE write_action (action: input_action);
              VAR 
                 comment: STRING(30), 
                 integer_string: STRING(6), 
                 i_s_length: ost$string_length; { subrange of integer }
  
              IF action.ordinal = no_ordinal THEN { offset to next item } 
                 comment := ''; 
                 utp$convert_integer_to_string(integer_string, i_s_length,
                    action.next_offset, 10); { offset in string format }
                 STRINGREP(comment, stringrep_len, 
                    'OFFSET ': 8, integer_string: i_s_length); 
                 write_char(action.next_offset DIV 128, comment); { high_order}
                 write_char(action.next_offset MOD 128, ''); { low-order}
              ELSE                    { ordinal }
                 comment := ''; 
                 utp$convert_integer_to_string(integer_string, i_s_length,
                    action.ordinal, 10); { ordinal in string format } 
                 STRINGREP(comment, stringrep_len, 
                    'ORDINAL ': 8, integer_string: i_s_length);
                 write_char((16383-action.ordinal) DIV 128, comment);
                 write_char((16383-action.ordinal) MOD 128, ''); { low-order }
              IFEND;
           PROCEND write_action; 
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_fail_node' ??
           ?? SKIP := 4 ?? 
  
           PROCEDURE write_fail_node (in_node: ^input_node);
              write_char(0, '*****  FAIL  *****'); 
           PROCEND write_fail_node;
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_list_node' ??
           ?? SKIP := 4 ?? 
  
           PROCEDURE write_list_node (in_node: ^input_node);
              VAR 
                 char_ndx: INTEGER; 
  
              write_char(1, '*****  LIST  *****'); 
              write_char(in_node^.list_character_count, 'LIST COUNT');
              FOR char_ndx := 1 to in_node^.list_character_count DO
                 write_char(ORD(in_node^.list_pointer^[char_ndx].character),
                    '');
                 write_action(in_node^.list_pointer^[char_ndx].action);
              FOREND; 
           PROCEND write_list_node;
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_range_node' ??
           ?? SKIP := 4 ?? 
  
           PROCEDURE write_range_node (in_node: ^input_node);
              VAR 
                 char_ndx: INTEGER; 
  
              write_char(2, '*****  RANGE  *****');
              write_char(ORD(in_node^.range_lower_bound), 'LOWER BOUND');
              write_char(ORD(in_node^.range_upper_bound), 'UPPER BOUND');
              FOR char_ndx := ORD(in_node^.range_lower_bound) TO
                              ORD(in_node^.range_upper_bound) DO
                 write_action(in_node^.range_pointer^[char_ndx]); 
              FOREND; 
           PROCEND write_range_node;
           ?? OLDTITLE ?? 
  
           ?? NEWTITLE := 'write_sar_node' ??
           ?? SKIP := 4 ?? 
  
           PROCEDURE write_sar_node (in_node: ^input_node);
  
              write_char(3, '*****  SINGLE-ACTION RANGE  *****');
              write_char(ORD(in_node^.sar_lower_bound), 'LOWER BOUND');
              write_char(ORD(in_node^.sar_upper_bound), 'UPPER BOUND');
              write_action(in_node^.sar_action); 
           PROCEND write_sar_node;
           ?? OLDTITLE ?? 
  
           ?? EJECT ??
  
           CASE in_node^.opcode OF 
              = fail =
                 write_fail_node(in_node); 
              = list =
                 write_list_node(in_node); 
              = range =
                 write_range_node(in_node); 
              = single_action_range =
                 write_sar_node(in_node); 
           CASEND;
        PROCEND write_input_item; 
        ?? OLDTITLE ??
  
        ?? EJECT ?? 
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'INPUT SUB-TABLE'; 
        write_comment;
        write_comment;
        start_word_output; 
        outrec.line_type := opcode_line; 
        outrec.label := subtable_list[subtable_input].label;
        outrec.opcode := 'BSS';
        outrec.parameters := '0';
        outrec.comment := ''; 
        write_opcode_line; 
        reset_input_table(table_size);
        dump_input_node(^write_input_item); { pass my procedure to dumper }
        IF ( bits_left_in_word > 0 ) AND
           ( bits_left_in_word < target_wordsize ) THEN 
           outrec.line_type := opcode_line;
           write_vfd(bits_left_in_word, 0, 'FILLER'); 
        IFEND;
     PROCEND write_input_table;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_key_name_table' ?? 
     ?? EJECT ??
  
     PROCEDURE write_key_name_table; 
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'KEY-NAME SUB-TABLE';
        write_comment;
        outrec.comment_text := '     ORDINALS BY KEY';
        write_comment;
        write_comment;
        start_word_output; 
        outrec.line_type := opcode_line; 
        outrec.label := subtable_list[subtable_names].label;
        outrec.opcode := 'BSS';
        outrec.parameters := '0';
        outrec.comment := ''; 
        write_opcode_line; 
        write_ordinals(^dump_key_name_node); 
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := '     KEY NAMES';
        write_comment;
        write_comment;
        outrec.line_type := opcode_line; 
        write_char_sequences(^dump_key_name_node) 
     PROCEND write_key_name_table; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_initialization_table' ??
     ?? EJECT ??
  
     PROCEDURE write_initialization_table;
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'INITIALIZATION SUB-TABLE';
        write_comment;
        outrec.comment_text := '     LINE/SCREEN ORDINALS'; 
        write_comment;
        write_comment;
        start_word_output; 
        outrec.line_type := opcode_line; 
        outrec.label := subtable_list[subtable_init].label;
        outrec.opcode := 'BSS';
        outrec.parameters := '0';
        outrec.comment := ''; 
        write_opcode_line; 
        write_ordinals(^dump_reset_sequence);
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := '     INITIALIZATION SEQUENCES'; 
        write_comment;
        write_comment;
        outrec.line_type := opcode_line; 
        write_char_sequences(^dump_reset_sequence)
     PROCEND write_initialization_table;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_appstr_table' ??
     ?? EJECT ??
  
     PROCEDURE write_appstr_table;
        VAR 
           length: INTEGER,
           chars: ^STRING(*),
           total_sequences, 
           total_characters: INTEGER, 
           node_returned: BOOLEAN, 
           name: STRING(7);
  
        ?? NEWTITLE := 'write_appstr_names' ?? 
        ?? SKIP := 4 ??
  
        PROCEDURE write_appstr_names; 
           VAR
              char_ndx: INTEGER,
              comment: STRING(30);
  
           start_word_output;
           outrec.line_type := opcode_line;
           comment := name(1,7);
           FOR char_ndx := 1 TO 7 DO
              write_vfd(6,
                 utv$convert_ascii_to_ascii64[name(char_ndx)], comment);
              comment := '' 
           FOREND;
           write_vfd(18, length, '')
        PROCEND write_appstr_names; 
        ?? OLDTITLE ??
  
        ?? NEWTITLE := 'write_appstr_sequences' ?? 
        ?? EJECT ?? 
  
        PROCEDURE write_appstr_sequences; 
           VAR
              char_ndx: INTEGER,
              comment: STRING(30);
  
           outrec.line_type := opcode_line;
           FOR char_ndx := 1 TO length DO 
              IF bits_left_in_word < target_char_size THEN
                 start_word_output;
                 outrec.line_type := opcode_line;
                 write_vfd(4, 0, 'FILLER')
              IFEND;
              write_vfd(target_char_size, 
                 ORD(chars^(char_ndx)), ''); 
           FOREND;
           IF bits_left_in_word > 0 THEN
              outrec.line_type := opcode_line; 
              write_vfd(bits_left_in_word, 0, 'FILLER') 
           IFEND
        PROCEND write_appstr_sequences; 
        ?? OLDTITLE ??
        ?? EJECT ?? 
  
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'APPLICATION STRING SUB-TABLE';
        write_comment;
        write_comment;
        start_word_output; 
        outrec.line_type := opcode_line; 
        outrec.label := subtable_list[subtable_appstr].label;
        outrec.opcode := 'BSS';
        outrec.parameters := '0';
        outrec.comment := ''; 
        write_opcode_line; 
  
        reset_appstr_table; 
        REPEAT
           dump_appstr_node(name, length, chars, 
              total_sequences, total_characters, node_returned); 
           IF node_returned THEN
              write_appstr_names; 
              write_appstr_sequences
           IFEND
        UNTIL NOT node_returned;
        start_word_output; 
        outrec.line_type := opcode_line; 
        write_vfd(target_wordsize, 0, 'END OF NAMES') 
     PROCEND write_appstr_table;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'write_trailer' ?? 
     ?? EJECT ??
  
     PROCEDURE write_trailer; 
        outrec.line_type := comment_line; 
        outrec.comment_text := '';
        write_comment;
        outrec.comment_text := 'END OF TABLE';
        write_comment;
        write_comment;
        outrec.line_type := opcode_line; 
        outrec.label := subtable_list[subtable_end].label;
        outrec.opcode := 'END';
        outrec.parameters := ''; 
        write_opcode_line; 
     PROCEND write_trailer; 
     ?? OLDTITLE ?? 
     ?? EJECT ??
  
     open_file(output_file_sel, output_sel, ascii64_sel); 
     outrec.line_type := whole_line;
     outrec.line_buffer := ''; 
  
     write_header; 
     write_sub_table_pointers; 
     write_parameters; 
     write_size_table;
     write_subtable_start;
  
     write_output_table;
     write_input_table;
     write_key_name_table; 
     write_appstr_table;
     write_initialization_table;
     write_trailer; 
  
     close_file(output_file_sel)
  PROCEND write_tables;
  ?? OLDTITLE ??
  
MODEND tduout;
MODULE tdutab;
  
?? SET ( CHKALL := ON ), RIGHT := 110 ??
  
{  Module :  TDUTAB } 
{            Copyright Control Data Systems Inc.  1992.  } 
{  Written:  1/84 by R. Lindsey  } 
{  Version:  Cyber 170/180, version 1 } 
{  Purpose:  This module encapsulates the internal tables of the TDU program. }
{            It provides functions to add elements to the tables, to optimize } 
{            them, and to return the elements for output.  } 
{            This module has no I/O.  } 
  
  ?? PUSH ( LIST := OFF ) ??          {use this line to suppress commdeck list} 
{ ?? PUSH ( LIST := ON )  ??          {use this line to list common decks } 
?? SKIP := 4 ??
  
?? NEWTITLE := 'ZTDTTAB' ??
{ **************************** }
{ common deck ZTDTTAB follows: }
  
{ ZTDTTAB  contains type declarations used by the TDU table handler et. al. }
  
  CONST 
     communications_type_max = 3,     { actual ordinal values } 
     invalid_cursor = 0,              { 'ordinal' value }
     asynch_comm = 1,                 { 'ordinal' value } 
     binary_cursor = 1,               { 'ordinal' value } 
     cursor_encoding_max = 6,         { 'invalid' is always #0 }
     parm_flag_max = 56,              { upper bound of parm flag array }
     screen_size_max = 3,             { up to 4 screen sizes }
     size_row_max = 64,               { number of rows on a screen } 
     size_col_max = 255,              { number of columns on a screen } 
     binary_col_max = 128,            { binary_cursor maximum screen columns }
     cursor_behavior_max_ord = 6,     { cursor behavior maximum ordinal } 
     cursor_behavior_max = 14,        { upper bound for wrap/scroll etc. } 
     cursor_behavior_div = 6,         { upper bound for wrap/scroll etc. } 
     no_ordinal = 0,                  { enumerated-style ordinal value }
     overstrike_ordinal = 37;         { VIRTERM-compatible } 
  
  TYPE
     ordinal_type = 0 .. 255,         { input and output VIRTERM ordinals }
  
     communications_type = 0 .. communications_type_max, 
        { invalid, asynch, synch, sna }
  
     cursor_encoding_type = 0 .. cursor_encoding_max,
        { these ordinals indicate what method of cursor positioning is used  }
        { invalid_cursor, binary, cdc721, ansi, ibm3270, ibm3151, user }
  
     parameter_record = RECORD        { contains non-input/output parameters } 
        model_name: STRING (7),       { terminal-type code as known by users }
        model_name_len: 0 .. 7,       { length of model name string used  } 
        communications: communications_type,   { asynch, synch, SNA, etc. }
        cursor_encoding: cursor_encoding_type, { cursor-positioning info  } 
        cursor_bias: -127 .. 127,     { cursor addressing offset          } 
        flag: ARRAY [ 0 .. parm_flag_max ] OF BOOLEAN, { various flags    } 
        size: ARRAY [ 0 .. screen_size_max ] OF RECORD { screen sizes }
           cols: 0 .. size_col_max,
           rows: 0 .. size_row_max,
        RECEND, 
        cursor_behavior: ARRAY [ 0 .. cursor_behavior_max ] 
                           OF -1 .. cursor_behavior_max_ord , 
        cursor_pos_column_flag: BOOLEAN, { TRUE if column pos goes first }
        cursor_pos_length: ARRAY [ 0 .. 1 ] OF 0 .. 7, { # digits per x/y }
        function_key_mark: 0 .. 7,    { # chars of blotch left by function key} 
     RECEND,
  
     string_node = PACKED RECORD      { an ordinal-designated char sequence }
        length: 0 .. 32767,           { length of char_sequence }
        chars: ^STRING(*),            { the sequence itself } 
     RECEND,
  
     dump_procedure_type =            { dumps string nodes from tables } 
        ^PROCEDURE ( ordinal: ordinal_type; 
                     VAR length: INTEGER;
                     VAR chars: ^STRING(*);
                     VAR total_ordinals: INTEGER; { last ordinal in table } 
                     VAR total_characters: INTEGER; 
                     VAR node_returned: BOOLEAN),
  
     opcode_type = (fail, list, range, single_action_range), { input opcodes }
  
     input_action = PACKED RECORD     { ordinal/pointer pair } 
        ordinal: ordinal_type,        { 0 = no ordinal, look at next_node } 
        next_offset: 0 .. 4095,       { output-table-style pointer }
        next_level: ALIGNED ^input_node, { points to another node }
     RECEND,
  
     list_node = PACKED ARRAY [1 .. *] OF { 1 element for each char in list } 
        PACKED RECORD                 { each node of an input-parse list }
           character: CHAR,           { character to match }
           action: input_action,      { ordinal/pointer pair }
        RECEND, 
  
     range_node = PACKED ARRAY [ * ] OF { 1 action for each char in range }
        input_action,                 { ordinal/pointer pair } 
  
     input_node = BOUND RECORD        { linked list of input-parsing rules }
        next_node: ^input_node,       { 'real' table will use consecutive mem }
        offset: 0 .. 4095,            { target table offset of this node }
        node_visited: BOOLEAN,        { node has been visited in this pass }
        CASE opcode: opcode_type OF   { fail, list, range, single-action range}
           = fail =                   { fail }
              ,                       { no parameters } 
           = list =                   { list }
              list_character_count: 1 .. 1023,  {  count of chars in list  } 
              list_pointer: ^ list_node, { list of char/action pairs }
           = range =                  { range } 
              range_lower_bound: CHAR,{ first character of range } 
              range_upper_bound: CHAR,{ last character in range } 
              range_pointer: ^ range_node, { list of actions, 1/char in range} 
           = single_action_range =    { single-action range } 
              sar_lower_bound: CHAR,  { first char of range } 
              sar_upper_bound: CHAR,  { last char in range } 
              sar_action: input_action,{ ordinal/pointer pair }
        CASEND, 
     RECEND,
  
     appstr_node = RECORD             { linked list of application strings }
        next_node: ^appstr_node,      { 'real' table will use consecutive mem } 
        name: STRING(31),             { non-unique key for this applictn stng } 
        value: string_node,           { length and contents of the string } 
     RECEND;
  
?? OLDTITLE ??
  
{ ************************** }
{ tdu error handler follows: } 
  
  
  
  
{ ZCLTSTR    Defines string length and string index for SCL. } 
  
    TYPE
      clt$string_length = integer,
  
      clt$string_index = integer;
  
{ ZOSTSTR    Defines the bounds of strings. } 
  
  CONST 
    osc$max_string_length = osc$max_string_size;
  
  TYPE
    ost$string_length = 0 .. osc$max_string_length;
  
{ OSDSTR    type definitions for string } 
  
  CONST 
    osc$max_string_size = 256;
  
  TYPE
    ost$string_size = 0 .. osc$max_string_size;
  
  TYPE
    ost$string_index = 1 .. osc$max_string_size + 1;
  
  TYPE
    ost$string = record
      size: ost$string_size,
      value: string (osc$max_string_size),
    recend; 
  
  
{ OSDSTAT   Definition of request status record } 
  
  CONST 
    osc$max_condition = 999999,
    osc$status_parameter_delimiter = '"';
  
  TYPE
    ost$status_condition = 0 .. osc$max_condition, 
    ost$status = record
      case normal: boolean of 
      =FALSE= 
        identifier: string (2),
        condition: ost$status_condition,
        text: ost$string, 
      casend, 
    recend; 
  
  
{ ZOSPSSA    Sets status value to indicate abnormal cond. detected. } 
  
  PROCEDURE [XREF] osp$set_status_abnormal ALIAS 'zospssa' 
    ( identifier: string (2);
      condition: ost$status_condition;
      text: string ( * );
      VAR status: ost$status);
  
  
{ ZOSPASP    Appends parameter text to a status variable. } 
  
  PROCEDURE [XREF] osp$append_status_parameter ALIAS 'zospasp' (delimiter: 
    char; 
    text: string ( * );
    VAR status: ost$status);
  
{ ZTDCERR  tdu error-handling constants and types }
  
  CONST 
     tdc_prod_code = 'TD'; 
  
  TYPE
     error_type = (no_error, no_room_error, duplicate_input_error,
        duplicate_error, superset_error, subset_error, not_found_error); 
  
{ ZTDPERR  write error messages to listing file }
  
  PROCEDURE [XREF] report_error (text: STRING(*));
  
  PROCEDURE [XREF] error_status (status: ost$status);
  
{ ZTDCCON  TDU condition codes }
  
CONST 
   tdc$status_id = 'td', 
   tdc$status_condition = 18000;
  
CONST 
   tde_error_termination = tdc$status_condition + 0, 
   {E TDU TERMINATED WITH ERRORS.}
   tde_invalid_character = tdc$status_condition + 1, 
   {E CHARACTER VALUE MUST RANGE FROM 0 TO 127.}
   tde_invalid = tdc$status_condition + 2,
   {E INCORRECT +T.}
   tde_invalid_type = tdc$status_condition + 3, 
   {E INCORRECT TYPE--ONLY STRING, INTEGER, OR VARIABLE ALLOWED.} 
   tde_invalid_comm = tdc$status_condition + 4, 
   {E INCORRECT COMMUNICATIONS TYPE.} 
   tde_invalid_cursor = tdc$status_condition + 5, 
   {E INCORRECT CURSOR_ENCODING.} 
   tde_bias_out_of_range = tdc$status_condition + 6, 
   {E CURSOR_BIAS OUT OF RANGE, MUST BE -127 TO 127.} 
   tde_continuation_overflow = tdc$status_condition + 7, 
   {E CONTINUATIONS EXCEED 256 CHARACTERS.} 
   tde_expecting_verb_variable = tdc$status_condition + 8,
   {E EXPECTING VERB OR VARIABLE, FOUND +T.}
   tde_empty_file = tdc$status_condition + 9, 
   {E EMPTY INPUT FILE.}
   tde_no_room = tdc$status_condition + 10,
   {E NO ROOM IN TABLE FOR +T.} 
   tde_duplicate_verb = tdc$status_condition + 11,
   {E VERB +T APPEARS TWICE.} 
   tde_superset = tdc$status_condition + 12, 
   {E INPUT SEQUENCE FOR +T IS A SUPERSET OF A PREVIOUS ITEM.}
   tde_subset = tdc$status_condition + 13, 
   {E INPUT SEQUENCE FOR +T IS A SUBSET OF A PREVIOUS ITEM.}
   tde_not_found = tdc$status_condition + 14,
   {E VARIABLE +T HAS NOT BEEN DECLARED.} 
   tde_optimize_table_full = tdc$status_condition + 15, 
   {E TABLE OVERFLOW DURING OPTIMIZATION.}
   tde_invalid_verb_variable = tdc$status_condition + 16, 
   {E INCORRECT VERB OR MISSING "=" IN VARIABLE ASSIGNMENT.}
   tde_duplicate_in_inout = tdc$status_condition + 17, 
   {E DUPLICATE PARAMETERS, BOTH "IN" AND "INOUT".} 
   tde_duplicate_out_inout = tdc$status_condition + 18, 
   {E DUPLICATE PARAMETERS, BOTH "OUT" AND "INOUT".}
   tde_screen_size_overflow = tdc$status_condition + 19, 
   {E TOO MANY SCREEN SIZES SPECIFIED, MAXIMUM 4.}
   tde_screen_row_overflow = tdc$status_condition + 20, 
   {E NUMBER OF ROWS MUST RANGE FROM 0 TO 64.}
   tde_screen_col_overflow = tdc$status_condition + 21, 
   {E NUMBER OF COLUMNS MUST RANGE FROM 0 TO 255.}
   tde_invalid_cursor_behavior = tdc$status_condition + 22, 
   {E INCORRECT "MOVE_PAST.." OR "CHAR_PAST.." TYPE.} 
   tde_name_required = tdc$status_condition + 23,
   {E NAME IS REQUIRED.}
   tde_name_too_long = tdc$status_condition + 24, 
   {E NAME MUST BE 1 TO 6 CHARACTERS.}
   tde_screen_out_required = tdc$status_condition + 25, 
   {E "OUT" REQUIRED FOR SET_SIZE.} 
   tde_invalid_name = tdc$status_condition + 26,
   {E INCORRECT NAME--MAY ONLY BE ALPHABETIC AND NUMERIC CHARACTERS.} 
   tde_cursor_len_out_of_range = tdc$status_condition + 27, 
   {E CURSOR_POS_COLUMN_LENGTH OR CURSOR_POS_ROW_LENGTH MUST BE 0 TO 7.}
   tde_duplicate_input = tdc$status_condition + 28,
   {E INPUT SEQUENCE FOR +T IS A DUPLICATE OF A PREVIOUS ITEM.} 
   tde_invalid_appstr_name = tdc$status_condition + 29, 
   {E INCORRECT APPLICATION STRING NAME +T--MAY ONLY USE CDC 63-CHAR SET.}
   tde_appstr_name_too_long = tdc$status_condition + 30,
   {E APPLICATION STRING NAME MUST BE 1 TO 7 CHARACTERS.} 
   tde_function_key_mark_range = tdc$status_condition + 31;
   {E FUNCTION_KEY_LEAVES_MARK MUST INDICATE 0 TO 7 CHARACTERS OF BLOTCH.}
  
{ ************************* } 
{ tdu verb-table constants: } 
  
{ ZTDCVRB  TDL Verb-table constants }
  
  { ********************************************************* } 
  { These constants define the length of various parts of the }
  {       ZTDVERB table.                                      }
  { ********************************************************* } 
  CONST 
     { The following 'ord' or 'ordinal' constants do NOT change when }
     { you add or remove verbs from the end of the verb table. } 
  
     parm_name_ord = 1,               { verb-table ordinal } 
     parm_communications_ord = 2,
     parm_cursor_encoding_ord = 3, 
     parm_flags_ord = 4,
     parm_size_ord = 5,
     parm_cursor_behavior_ord = 6, 
     parm_cursor_pos_column_flag_ord = 7, 
     parm_cursor_pos_length_ord = 8,
     parm_function_key_mark_ord = 9,
  
     { The following constants DO change when you add or remove ordinals }
     { as defined to VIRTERM. }
  
     output_last_ordinal = 153,       { count of ordinals defined to VIRTERM } 
     key_name_last_ordinal = 126, 
     init_last_ordinal = 1,
     size_output_ord = 130,           { first ordinal for screen sizes } 
  
     { The following constants DO change when you add or remove verbs }
     { from earlier positions in the verb table. }
  
     parm_name_verb = 1,              { verb-table index, used for error msgs } 
     parm_cursor_encoding_verb = 3, 
     parm_set_size_verb = 60,
     parm_cursor_behavior_verb = 61,
     max_verb_count = 327;            { total of all verbs in the entire table}
  
?? EJECT ?? 
?? POP ?? 
  
  VAR 
     parm_record: parameter_record,   { all parameters stored here } 
     input_list: ^input_node := NIL, { head of input list } 
     input_offset: INTEGER, 
     output_table: ARRAY [ 0 .. output_last_ordinal ] OF string_node,
     key_name_table: ARRAY [ 0 .. key_name_last_ordinal ] OF string_node,
     init_table: ARRAY [ 0 .. init_last_ordinal ] OF string_node,
     appstr_table, 
     appstr_next_node_dumped, 
     appstr_latest_new_node: ^appstr_node, 
     output_total_characters,
     key_name_total_characters, 
     init_total_characters,
     appstr_total_sequences,
     appstr_total_characters: INTEGER,
     status: ost$status;
  
  ?? NEWTITLE := 'store_ord_char_node' ??
  ?? EJECT ?? 
  
  PROCEDURE store_ord_char_node (ordinal: ordinal_type;
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR table: ARRAY [ * ] OF string_node;
        VAR total_characters: INTEGER;
        VAR error_return: error_type); 
  
     error_return := no_error; 
     IF table[ordinal].length > 0 THEN
        error_return := duplicate_error 
     ELSEIF sequence_length > 0 THEN
        ALLOCATE table[ordinal].chars : [ sequence_length ];
        IF table[ordinal].chars = NIL THEN 
           error_return := no_room_error;
        ELSE
           table[ordinal].length := sequence_length; 
           table[ordinal].chars^ := char_sequence(1,sequence_length);
           total_characters := total_characters + sequence_length
        IFEND 
     IFEND
  PROCEND store_ord_char_node;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'concatenate_sequences' ?? 
  ?? EJECT ?? 
  
  PROCEDURE concatenate_sequences (new_seq: STRING(*);
        new_seq_length: INTEGER;
        VAR table_node: string_node; 
        VAR total_characters: INTEGER; 
        VAR error_return: error_type);
     VAR
        allocation_len,
        stringrep_len: INTEGER, 
        old_node: string_node; 
  
     error_return := no_error;
     old_node := table_node;
     IF old_node.length = 0 THEN 
        allocation_len := new_seq_length 
     ELSE 
        allocation_len := old_node.length + new_seq_length
     IFEND; 
     table_node.length := allocation_len; 
     IF allocation_len > 0 THEN    { can't allocate 0 }
        ALLOCATE table_node.chars : [ allocation_len ];
        IF table_node.chars = NIL THEN
           error_return := no_room_error; 
        ELSE
           IF old_node.length = 0 THEN 
              table_node.chars^ := new_seq(1,new_seq_length) 
           ELSE 
              STRINGREP(table_node.chars^, stringrep_len,
                 old_node.chars^(1,old_node.length),
                 new_seq(1,new_seq_length));
              FREE old_node.chars 
           IFEND; 
           total_characters := total_characters + new_seq_length
        IFEND 
     IFEND
  PROCEND concatenate_sequences;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'initialize_tables' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] initialize_tables; 
     VAR
        table_ndx: INTEGER;
  
     ALLOCATE input_list : [ fail ];  { ignore no-room error, caught later }
     IF input_list <> NIL THEN 
        input_list^.next_node := NIL;
        input_list^.offset := 0; 
        input_list^.node_visited := FALSE 
     IFEND; 
     FOR table_ndx := 1 TO output_last_ordinal DO 
        output_table[table_ndx].length := 0;
        output_table[table_ndx].chars := NIL 
     FOREND;
     output_total_characters := 0;
     FOR table_ndx := 1 TO key_name_last_ordinal DO
        key_name_table[table_ndx].length := 0; 
        key_name_table[table_ndx].chars := NIL
     FOREND;
     key_name_total_characters := 0; 
     FOR table_ndx := 1 TO init_last_ordinal DO 
        init_table[table_ndx].length := 0;
        init_table[table_ndx].chars := NIL 
     FOREND;
     init_total_characters := 0;
     appstr_table := NIL; 
     appstr_latest_new_node := NIL; 
     appstr_next_node_dumped := NIL; 
     appstr_total_sequences := 0;
     appstr_total_characters := 0 
  PROCEND initialize_tables;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'store_parameters' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] store_parameters (parm: parameter_record);
     parm_record := parm;             { save it in my local space }
  PROCEND store_parameters;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'dump_parameters' ??
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] dump_parameters (VAR parm: parameter_record);
     parm := parm_record;             { give caller my copy }
  PROCEND dump_parameters;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'store_output_node' ?? 
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] store_output_node (ordinal: ordinal_type;
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
  
     IF ( ordinal < 0 ) OR 
        ( ordinal > output_last_ordinal ) THEN
        error_return := no_room_error
     ELSE 
        concatenate_sequences(char_sequence, sequence_length, 
           output_table[ordinal], output_total_characters, 
           error_return) 
     IFEND
  PROCEND store_output_node; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'dump_output_node' ?? 
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] dump_output_node (ordinal: ordinal_type;
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_ordinals: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
     node_returned := FALSE; 
     IF ( ordinal >= 0 ) AND 
        ( ordinal <= output_last_ordinal ) THEN 
        node_returned := TRUE; 
        total_ordinals := output_last_ordinal; 
        total_characters := output_total_characters; 
        length := output_table[ordinal].length;
        chars := output_table[ordinal].chars 
     IFEND
  PROCEND dump_output_node; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'store_key_name_node' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] store_key_name_node (ordinal: ordinal_type; 
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
  
     IF ( ordinal < 0 ) OR 
        ( ordinal > key_name_last_ordinal ) THEN 
        error_return := no_room_error
     ELSE 
        store_ord_char_node(ordinal, sequence_length, char_sequence, 
           key_name_table, key_name_total_characters, error_return)
     IFEND
  PROCEND store_key_name_node;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'dump_key_name_node' ??
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] dump_key_name_node(ordinal: ordinal_type;
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_ordinals: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
     node_returned := FALSE; 
     IF ( ordinal >= 0 ) AND 
        ( ordinal <= key_name_last_ordinal ) THEN
        node_returned := TRUE; 
        total_ordinals := key_name_last_ordinal;
        total_characters := key_name_total_characters;
        length := key_name_table[ordinal].length; 
        chars := key_name_table[ordinal].chars
     IFEND
  PROCEND dump_key_name_node;
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'store_reset_sequence' ?? 
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] store_reset_sequence (ordinal: ordinal_type;
        char_seq_length: INTEGER; 
        char_seq: STRING(*);
        VAR error_return: error_type); 
  
     IF ( ordinal < 0 ) OR 
        ( ordinal > init_last_ordinal ) THEN
        error_return := no_room_error
     ELSE 
        concatenate_sequences(char_seq, char_seq_length,
           init_table[ordinal], init_total_characters, 
           error_return);
     IFEND
  PROCEND store_reset_sequence; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'dump_reset_sequence' ?? 
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] dump_reset_sequence(ordinal: ordinal_type; 
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_ordinals: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
     node_returned := FALSE; 
     IF ( ordinal >= 0 ) AND 
        ( ordinal <= init_last_ordinal ) THEN 
        node_returned := TRUE; 
        total_ordinals := init_last_ordinal; 
        total_characters := init_total_characters; 
        length := init_table[ordinal].length;
        chars := init_table[ordinal].chars 
     IFEND
  PROCEND dump_reset_sequence; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'store_appstr_node' ?? 
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] store_appstr_node (name: STRING(*);
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
     VAR
        new_node: ^appstr_node;
  
     error_return := no_error; 
     ALLOCATE new_node;
     IF new_node = NIL THEN
        error_return := no_room_error
     ELSE 
        IF appstr_table = NIL THEN 
           appstr_table := new_node
        ELSE
           appstr_latest_new_node^.next_node := new_node
        IFEND;
        appstr_latest_new_node := new_node;
        new_node^.next_node := NIL;
        new_node^.name := name;
        new_node^.value.length := sequence_length;
        appstr_total_sequences := appstr_total_sequences + 1;
        IF sequence_length > 0 THEN 
           ALLOCATE new_node^.value.chars : [ sequence_length ]; 
           IF new_node^.value.chars = NIL THEN
              error_return := no_room_error
           ELSE 
              new_node^.value.chars^ := char_sequence(1,sequence_length); 
              appstr_total_characters :=
                 appstr_total_characters + sequence_length 
           IFEND
        IFEND 
     IFEND
  PROCEND store_appstr_node; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'reset_appstr_table' ?? 
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] reset_appstr_table;
     appstr_next_node_dumped := appstr_table
  PROCEND reset_appstr_table; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'dump_appstr_node' ?? 
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] dump_appstr_node (VAR name: STRING(*);
        VAR length: INTEGER; 
        VAR chars: ^STRING(*); 
        VAR total_sequences: INTEGER;
        VAR total_characters: INTEGER;
        VAR node_returned: BOOLEAN); 
  
     IF ( appstr_table = NIL ) OR
        ( appstr_next_node_dumped = NIL ) THEN
        node_returned := FALSE 
     ELSE 
        node_returned := TRUE; 
        name := appstr_next_node_dumped^.name;
        length := appstr_next_node_dumped^.value.length; 
        chars := appstr_next_node_dumped^.value.chars; 
        appstr_next_node_dumped := appstr_next_node_dumped^.next_node;
        total_sequences := appstr_total_sequences; 
        total_characters := appstr_total_characters
     IFEND
  PROCEND dump_appstr_node; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'store_input_node' ?? 
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] store_input_node (ordinal: ordinal_type;
        sequence_length: INTEGER;
        char_sequence: STRING(*);
        VAR error_return: error_type); 
  
     { Input character recognition sequences are stored in a tree of linked }
     {   lists.  Each character of a particular sequence occupies a node in }
     {   a different level of the tree.  Thus, when matching a sequence in }
     {   the tree, one would start at the first level (pointed to by   }
     {   input_list), and search the linked list which constitutes that level } 
     {   (using search_level).  If the character is found, the process repeats}
     {   with the next character in the sequence, and the search is of the }
     {   level pointed to by the node which was found.  } 
     { Each level consists of a linked list of 'list' nodes, where each node } 
     {   corresponds to a single-element list in the final output format.  } 
     {   These list nodes are later combined where possible into ranges and }
     {   single-action ranges by the optimize_tables procedure.  }
     {   The last node in each level's linked list is always a 'fail' node. }
  
     VAR
        new_node,
        pred_node,                    { predecessor to current node } 
        succ_node,                    { successor to current node } 
        prev_level,                   { previous level which points to current} 
        curr_level: ^input_node,      { start of the level to search } 
        node_found: BOOLEAN,
        char_ndx: INTEGER;
  
     ?? NEWTITLE := 'search_level' ?? 
     ?? SKIP := 4 ?? 
  
     PROCEDURE search_level (ch: CHAR; curr_level: ^input_node; 
           VAR pred_node: ^input_node; VAR succ_node: ^input_node;
           VAR node_found: BOOLEAN);
        { This procedure searches a particular level of the input char tree, }
        {   looking for a node which contains the given character.  If it } 
        {   doesn't find one, it returns pointers set up to insert a new node }
        {   for that character in its proper order. } 
  
        node_found := FALSE;
        pred_node := NIL;
        succ_node := curr_level;
        WHILE ( succ_node^.opcode <> fail ) AND
              ( node_found = FALSE ) AND 
              ( succ_node^.list_pointer^[1].character <= ch ) DO
           IF succ_node^.list_pointer^[1].character = ch THEN 
              node_found := TRUE
           ELSE 
              pred_node := succ_node;
              succ_node := pred_node^.next_node 
           IFEND
        WHILEND 
     PROCEND search_level; 
     ?? OLDTITLE ?? 
     ?? EJECT ??
  
     error_return := no_error; 
     curr_level := input_list; 
     FOR char_ndx := 1 TO sequence_length DO
        search_level(char_sequence(char_ndx), curr_level,
           pred_node, succ_node, node_found);
        IF node_found THEN 
           IF succ_node^.list_pointer^[1].action.ordinal > no_ordinal THEN 
              IF char_ndx <> sequence_length THEN
                 error_return := superset_error; 
                 RETURN 
              IFEND;
              error_return := duplicate_input_error; 
              RETURN
           IFEND; 
           IF char_ndx = sequence_length THEN
              error_return := subset_error;
              RETURN
           IFEND; 
           prev_level := succ_node; 
           curr_level :=      { point to next level in sequence } 
              succ_node^.list_pointer^[1].action.next_level 
        ELSE                          { no match found, build a new node } 
           ALLOCATE new_node : [ list ]; { create a list node }
           IF pred_node = NIL THEN    { never got past first node }
              IF char_ndx = 1 THEN    { first level only } 
                 new_node^.next_node := input_list; 
                 input_list := new_node
              ELSE                    { beyond first level }
                 new_node^.next_node :=
                    prev_level^.list_pointer^[1].action.next_level;
                 prev_level^.list_pointer^[1].action.next_level := new_node
              IFEND 
           ELSE                       { new node is in midst of existing level}
              new_node^.next_node := pred_node^.next_node;
              pred_node^.next_node := new_node;
           IFEND; 
           new_node^.offset := 0;
           new_node^.node_visited := FALSE; 
           new_node^.list_character_count := 1; { one element in list }
           ALLOCATE new_node^.list_pointer : [ 1..1 ]; { the list itself } 
           new_node^.list_pointer^[1].character := char_sequence(char_ndx);
           new_node^.list_pointer^[1].action.next_offset := 0; 
           IF char_ndx = sequence_length THEN
              new_node^.list_pointer^[1].action.ordinal := ordinal;
              new_node^.list_pointer^[1].action.next_level := NIL 
           ELSE 
              new_node^.list_pointer^[1].action.ordinal := no_ordinal; 
              ALLOCATE
                 new_node^.list_pointer^[1].action.next_level : [ fail ]; 
              new_node^.list_pointer^[1].action.next_level^.next_node := NIL;
              new_node^.list_pointer^[1].action.next_level^.offset := 0; 
              new_node^.list_pointer^[1].action.next_level^.
                 node_visited := FALSE; 
              prev_level := new_node;
              curr_level := 
                 new_node^.list_pointer^[1].action.next_level
           IFEND
        IFEND 
     FOREND 
  PROCEND store_input_node; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'dump_input_node' ?? 
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] dump_input_node ( 
        before_procedure: ^PROCEDURE(in_nd: ^input_node) ); 
  
     traverse_input_tree(input_list, before_procedure, NIL)
  PROCEND dump_input_node; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'reset_input_table' ?? 
  ?? SKIP := 4 ??
  
  PROCEDURE [XDCL] reset_input_table (VAR character_count: INTEGER);
  
     PROCEDURE reset_node_flags(in_node: ^input_node); 
        in_node^.node_visited := FALSE;
        calculate_input_offsets(in_node) 
     PROCEND reset_node_flags;
  
     input_offset := 0; 
     dump_input_node(^reset_node_flags);
     character_count := input_offset
  PROCEND reset_input_table; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'traverse_input_tree' ?? 
  ?? EJECT ?? 
  
  PROCEDURE traverse_input_tree (  { recursively process tree, calling proc}
        in_node: ^input_node;
        before_procedure: ^PROCEDURE(in_nd: ^input_node); 
        after_procedure: ^PROCEDURE(in_nd: ^input_node) ); 
  
     VAR
        action_ndx: INTEGER;
  
     IF in_node <> NIL THEN 
        IF before_procedure <> NIL THEN
           before_procedure^(in_node) { do whatever my caller requests }
        IFEND;
        CASE in_node^.opcode OF
           = fail = 
              ; 
           = list = 
              traverse_input_tree(in_node^.next_node, { same level first }
                 before_procedure, after_procedure); 
              FOR action_ndx := 1 TO in_node^.list_character_count DO
                 traverse_input_tree(    { now the next level } 
                    in_node^.list_pointer^[action_ndx]. 
                       action.next_level,
                    before_procedure, after_procedure) 
              FOREND; 
           = range = 
              traverse_input_tree(in_node^.next_node, 
                 before_procedure, after_procedure); 
              FOR action_ndx := ORD(in_node^.range_lower_bound) TO
                                ORD(in_node^.range_upper_bound) DO
                 traverse_input_tree(
                    in_node^.range_pointer^[action_ndx].next_level, 
                    before_procedure, after_procedure) 
              FOREND; 
           = single_action_range = 
              traverse_input_tree(in_node^.next_node, 
                 before_procedure, after_procedure); 
              traverse_input_tree( 
                 in_node^.sar_action.next_level, 
                 before_procedure, after_procedure); 
        CASEND; 
        IF after_procedure <> NIL THEN
           after_procedure^(in_node)  { do whatever desired after traversal } 
        IFEND 
     IFEND
  PROCEND traverse_input_tree; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'calculate_input_offsets' ?? 
  ?? EJECT ?? 
  
  PROCEDURE calculate_input_offsets (in_node: ^input_node); 
  
     in_node^.offset := input_offset;
     CASE in_node^.opcode OF 
        = fail =
           input_offset := input_offset + 1; 
        = list =
           input_offset := input_offset + 2 +
              ( in_node^.list_character_count * 3 ); 
        = range =
           input_offset := input_offset + 3 + (
              ( ( ORD(in_node^.range_upper_bound) - 
                  ORD(in_node^.range_lower_bound) ) + 1 ) * 2 );
        = single_action_range =
           input_offset := input_offset + 5; 
     CASEND 
  PROCEND calculate_input_offsets; 
  ?? OLDTITLE ??
  
  ?? NEWTITLE := 'optimize_tables' ??
  ?? EJECT ?? 
  
  PROCEDURE [XDCL] optimize_tables; 
     VAR
        next_ordinal: ordinal_type,
        node_returned: BOOLEAN,
        error_return: error_type;
  
     ?? NEWTITLE := 'create_ranges' ?? 
     ?? SKIP := 4 ?? 
  
     PROCEDURE create_ranges (in_node: ^input_node); 
        VAR 
           action_ndx: INTEGER; 
  
        IF in_node <> NIL THEN
           CASE in_node^.opcode OF 
              = fail =
                 ;
              = list =
                 FOR action_ndx := 1 TO in_node^.list_character_count DO 
                    IF in_node^.list_pointer^[action_ndx].action.next_level <> 
                       NIL THEN 
                       create_range_level(
                          in_node^.list_pointer^[action_ndx].action.next_level)
                    IFEND 
                 FOREND;
              = range =
                 FOR action_ndx := ORD(in_node^.range_lower_bound) TO 
                                   ORD(in_node^.range_upper_bound) DO 
                    IF in_node^.range_pointer^[action_ndx].next_level <> NIL
                       THEN 
                       create_range_level(
                          in_node^.range_pointer^[action_ndx].next_level) 
                    IFEND 
                 FOREND;
              = single_action_range =
                 IF in_node^.sar_action.next_level <> NIL THEN 
                    create_range_level(in_node^.sar_action.next_level) 
                 IFEND
           CASEND 
        IFEND 
     PROCEND create_ranges; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'create_range_level' ??
     ?? EJECT ??
  
     PROCEDURE create_range_level (VAR curr_level: ^input_node);
        { This procedure scans across a given level of the input tree, }
        {   attempting to reduce consecutive lists of characters to ranges. } 
        { It ASSUMES it is being called as the FIRST phase of input table } 
        {   optimization, so that each level consists of single-item lists }
        {   ONLY, and that the lists are in ASCENDING ORDER. }
  
        VAR 
           new_node, 
           pred_node, 
           succ_node, 
           low_node, 
           low_node_pred,
           new_low_node: ^input_node,
           low,
           high: CHAR, 
           range_ndx: INTEGER; 
  
        IF curr_level^.opcode = list THEN { just in case of empty table } 
           low := curr_level^.list_pointer^[1].character 
        IFEND;
        high := low;
        low_node := curr_level;
        succ_node := curr_level;
        pred_node := NIL;
        WHILE ( succ_node <> NIL ) AND
              ( error_return = no_error ) DO
           IF ( succ_node^.opcode <> fail ) AND
              ( succ_node^.list_pointer^[1].character = SUCC(high) ) THEN 
              high := succ_node^.list_pointer^[1].character { extend range }
           ELSEIF low = high THEN     { 'orphan' list--reset search ptrs }
              IF succ_node^.opcode = list THEN 
                 low := succ_node^.list_pointer^[1].character;
                 high := low; 
                 low_node := succ_node; 
                 low_node_pred := pred_node 
              IFEND 
           ELSE                       { at least 2 consecutive nodes found }
              ALLOCATE new_node : [ range ]; 
              IF new_node = NIL THEN 
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_optimize_table_full, '', status); 
                 error_status(status); 
                 error_return := no_room_error;
                 RETURN 
              IFEND;
              new_node^.next_node := succ_node; { new range in same spot}
              new_node^.offset := 0; 
              new_node^.node_visited := FALSE;
              IF low_node = curr_level THEN { new node is first on level}
                 curr_level := new_node { return pointer to my caller } 
              ELSE
                 low_node_pred^.next_node := new_node 
              IFEND;
              new_node^.range_lower_bound := low;
              new_node^.range_upper_bound := high;
              ALLOCATE new_node^.range_pointer : [ ORD(low)..ORD(high) ]; 
              IF new_node^.range_pointer = NIL THEN 
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_optimize_table_full, '', status); 
                 error_status(status); 
                 error_return := no_room_error;
                 RETURN 
              IFEND;
              FOR range_ndx := ORD(low) TO ORD(high) DO 
                 new_node^.range_pointer^[range_ndx] := 
                    low_node^.list_pointer^[1].action;
                 new_low_node := low_node^.next_node;
                 FREE low_node^.list_pointer;
                 FREE low_node;
                 low_node := new_low_node 
              FOREND; 
              IF succ_node^.opcode = list THEN 
                 low := succ_node^.list_pointer^[1].character;
                 high := low; 
                 low_node := succ_node; 
                 low_node_pred := new_node 
              IFEND 
           IFEND; 
           pred_node := succ_node; 
           IF succ_node^.opcode = fail THEN
              succ_node := NIL 
           ELSE 
              succ_node := pred_node^.next_node 
           IFEND
        WHILEND 
     PROCEND create_range_level;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'insert_remaining_chars' ??
     ?? EJECT ??
  
     PROCEDURE insert_remaining_chars;
        { This procedure processes the first level of the input tree only, }
        {   adding all characters that are not yet represented there.  This }
        {   is necessary because we can make no assumptions about which } 
        {   characters the application program wants to see.  We will pass }
        {   everything to the app, and let it decide what to do. }
        { At the time this procedure is called, it ASSUMES that the first }
        {   level consists ONLY of ranges and lists, and that everything }
        {   is still in ASCENDING ORDER. } 
  
        VAR 
           pred_node, 
           succ_node: ^input_node, 
           first_needed: 0 .. 129;
  
        ?? NEWTITLE := 'maybe_insert_chars' ?? 
        ?? EJECT ?? 
  
        PROCEDURE maybe_insert_chars (next_used: 0 .. 128; 
              succ_node: ^input_node;
              VAR pred_node: ^input_node;
              VAR first_needed: 0 .. 129);
  
           VAR
              new_node: ^input_node;
  
           IF next_used > first_needed THEN
              ALLOCATE new_node : [ single_action_range ]; 
              IF new_node = NIL THEN 
                 osp$set_status_abnormal(tdc_prod_code,
                    tde_optimize_table_full, '', status); 
                 error_status(status); 
                 error_return := no_room_error;
              ELSE
                 new_node^.next_node := succ_node; 
                 new_node^.offset := 0;
                 new_node^.node_visited := FALSE; 
                 IF pred_node = NIL THEN
                    input_list := new_node 
                 ELSE 
                    pred_node^.next_node := new_node 
                 IFEND; 
                 pred_node := new_node; 
                 new_node^.sar_lower_bound := CHR(first_needed); 
                 new_node^.sar_upper_bound := CHR(next_used - 1); 
                 new_node^.sar_action.ordinal := overstrike_ordinal;
                 new_node^.sar_action.next_offset := 0; 
                 new_node^.sar_action.next_level := NIL
              IFEND 
           IFEND; 
           first_needed := next_used + 1
        PROCEND maybe_insert_chars; 
        ?? OLDTITLE ??
  
        succ_node := input_list;
        pred_node := NIL;
        first_needed := 0;
        WHILE first_needed < 128 DO
           CASE succ_node^.opcode OF 
              = fail =
                 maybe_insert_chars(128, succ_node, pred_node, first_needed);
              = list =
                 maybe_insert_chars(
                    ORD(succ_node^.list_pointer^[1].character), 
                    succ_node, pred_node, first_needed); 
                 first_needed := 1 + ORD(succ_node^.list_pointer^
                    [succ_node^.list_character_count].character); 
              = range =
                 maybe_insert_chars(ORD(succ_node^.range_lower_bound),
                    succ_node, pred_node, first_needed); 
                 first_needed := 1 + ORD(succ_node^.range_upper_bound); 
           CASEND;
           pred_node := succ_node; 
           succ_node := pred_node^.next_node
        WHILEND 
     PROCEND insert_remaining_chars;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'combine_lists' ?? 
     ?? EJECT ??
  
     PROCEDURE combine_lists (in_node: ^input_node); 
        { This procedure processes all levels of the input tree, combining } 
        {   multiple list nodes at each level into a single list node. } 
        { It is called recursively by traverse_input_tree. } 
  
        VAR 
           action_ndx: INTEGER; 
  
        IF in_node <> NIL THEN
           CASE in_node^.opcode OF 
              = fail =
                 ;
              = list =
                 FOR action_ndx := 1 TO in_node^.list_character_count DO 
                    IF in_node^.list_pointer^[action_ndx].action.next_level <> 
                       NIL THEN 
                       combine_list_level(
                          in_node^.list_pointer^[action_ndx].action.next_level)
                    IFEND 
                 FOREND;
              = range =
                 FOR action_ndx := ORD(in_node^.range_lower_bound) TO 
                                   ORD(in_node^.range_upper_bound) DO 
                    IF in_node^.range_pointer^[action_ndx].next_level <> NIL
                       THEN 
                       combine_list_level(
                          in_node^.range_pointer^[action_ndx].next_level) 
                    IFEND 
                 FOREND;
              = single_action_range =
                 IF in_node^.sar_action.next_level <> NIL THEN 
                    combine_list_level(in_node^.sar_action.next_level) 
                 IFEND
           CASEND 
        IFEND 
     PROCEND combine_lists; 
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'combine_list_level' ??
     ?? EJECT ??
  
     PROCEDURE combine_list_level (VAR curr_level: ^input_node);
        { This procedure scans across a given level of the input tree, }
        {   combining all separate lists found at that level into a single }
        {   list.  It doesn't really care at what phase of the optimization }
        {   it is being called. }
  
        VAR 
           new_node, 
           pred_node, 
           succ_node: ^input_node, 
           list_count, 
           new_ndx, 
           old_ndx: INTEGER; 
  
        succ_node := curr_level;
        pred_node := NIL;
        list_count := 0;
        WHILE succ_node^.opcode <> fail DO 
           IF succ_node^.opcode = list THEN
              list_count := list_count + succ_node^.list_character_count
           IFEND; 
           pred_node := succ_node; 
           succ_node := succ_node^.next_node
        WHILEND;
        IF list_count > 0 THEN        { at least one list on this level } 
           ALLOCATE new_node : [ list ];
           IF new_node = NIL THEN
              error_return := no_room_error; 
              osp$set_status_abnormal(tdc_prod_code, tde_optimize_table_full,
                 '', status); 
              error_status(status);
              RETURN
           IFEND; 
           new_node^.offset := 0;
           new_node^.node_visited := FALSE; 
           new_node^.list_character_count := list_count;
           ALLOCATE new_node^.list_pointer : [ 1 .. list_count ];
           IF new_node^.list_pointer = NIL THEN
              error_return := no_room_error; 
              osp$set_status_abnormal(tdc_prod_code, 
                 tde_optimize_table_full, '', status);
              error_status(status);
              RETURN
           IFEND; 
           succ_node := curr_level; 
           pred_node := NIL; 
           new_ndx := 0; 
           WHILE ( succ_node <> NIL ) AND 
                 ( error_return = no_error ) DO 
              CASE succ_node^.opcode OF
                 = list =                { old node, move pieces to new node }
                    FOR old_ndx := 1 TO succ_node^.list_character_count DO
                       new_ndx := new_ndx + 1; 
                       new_node^.list_pointer^[new_ndx].character :=
                          succ_node^.list_pointer^[old_ndx].character;
                       new_node^.list_pointer^[new_ndx].action :=
                          succ_node^.list_pointer^[old_ndx].action 
                    FOREND; 
                    FREE succ_node^.list_pointer; 
                    IF succ_node = curr_level THEN { old list is first on lvl } 
                       curr_level := succ_node^.next_node; { link around it }
                       FREE succ_node;
                       succ_node := curr_level
                    ELSE
                       pred_node^.next_node := succ_node^.next_node; 
                       FREE succ_node;
                       succ_node := pred_node^.next_node
                    IFEND;
                 = range, single_action_range = 
                    pred_node := succ_node;
                    succ_node := pred_node^.next_node;
                 = fail =             { at end, insert new node here }
                    new_node^.next_node := succ_node; { new list at end }
                    IF succ_node = curr_level THEN { new node is first on lvl } 
                       curr_level := new_node { return pointer to my caller } 
                    ELSE
                       pred_node^.next_node := new_node
                    IFEND;
                    succ_node := NIL;
              CASEND; 
           WHILEND
        IFEND 
     PROCEND combine_list_level;
     ?? OLDTITLE ?? 
  
     ?? NEWTITLE := 'assign_input_offsets' ??
     ?? SKIP := 2 ?? 
  
     PROCEDURE assign_input_offsets (in_node: ^input_node);
        VAR 
           action_ndx: INTEGER; 
  
        CASE in_node^.opcode OF
           = fail = 
              ; 
           = list = 
              FOR action_ndx := 1 TO in_node^.list_character_count DO
                 IF in_node^.list_pointer^[action_ndx].action.ordinal =
                       no_ordinal THEN 
                    in_node^.list_pointer^[action_ndx].action.next_offset := 
                       in_node^.list_pointer^[action_ndx].action.next_level^
                          .offset 
                 IFEND
              FOREND; 
           = range = 
              FOR action_ndx := ORD(in_node^.range_lower_bound) TO
                                ORD(in_node^.range_upper_bound) DO
                 IF in_node^.range_pointer^[action_ndx].ordinal=no_ordinal THEN
                    in_node^.range_pointer^[action_ndx].next_offset :=
                       in_node^.range_pointer^[action_ndx].next_level^.offset
                 IFEND
              FOREND; 
           = single_action_range = 
              IF in_node^.sar_action.ordinal = no_ordinal THEN
                 in_node^.sar_action.next_offset :=
                    in_node^.sar_action.next_level^.offset
              IFEND 
        CASEND
     PROCEND assign_input_offsets;
     ?? OLDTITLE ?? 
  
     ?? EJECT ??
  
     error_return := no_error; 
     appstr_latest_new_node := appstr_table; 
  
     traverse_input_tree(input_list, NIL, ^create_ranges); 
     create_range_level(input_list);  { root level wasn't handled recursively }
     IF error_return = no_error THEN
        insert_remaining_chars;       { adds all chars not already in first lv}
        IF error_return = no_error THEN 
           traverse_input_tree(input_list, NIL, ^combine_lists); 
           combine_list_level(input_list); { root level wasn't handled }
           IF error_return = no_error THEN
              input_offset := 0;      { assign object table offset addresses }
              dump_input_node(^calculate_input_offsets); 
              dump_input_node(^assign_input_offsets)
           IFEND
        IFEND 
     IFEND
  PROCEND optimize_tables;
  ?? OLDTITLE ??
  
MODEND tdutab;
--EOR--    
--EOF--    
/
