?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Object Code Utilities', EJECT ??
MODULE ocm$display_helpers;



{ PURPOSE:
{   To display specific information about a module.

?? PUSH (LIST := OFF) ??
*copyc llt$object_module
*copyc llt$load_module
*copyc ost$segment_access_control
?? POP ??
*copyc clp$convert_date_time_to_string
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_date_time
*copyc ocp$output
?? NEWTITLE := '[XDCL] ocp$hexrep', EJECT ??

  PROCEDURE [XDCL] ocp$hexrep
    (VAR strng: string ( * );
     VAR length: integer;
         intger: integer);

    VAR
      str: ost$string,
      status: ost$status;

    clp$convert_integer_to_string (intger, 16, FALSE, str, status);

    strng (1) := ' ';
    strng (2, str.size) := str.value;
    length := str.size + 1;

  PROCEND ocp$hexrep;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_time', EJECT ??

  PROCEDURE [XDCL] ocp$output_time
    (    time: ^ost$time;
         end_of_line: boolean;
     VAR valid_format: boolean);

    VAR
      status: ost$status,
      str: ost$string,
      cl_time: clt$date_time;

    valid_format := TRUE;

    CASE time^.time_format OF
    = osc$ampm_time =
      clp$convert_string_to_date_time (time^.ampm, 'AMPM', cl_time, status);
    = osc$hms_time =
      ocp$output (' ', time^.hms, STRLENGTH (time^.hms), end_of_line);
      RETURN;
    = osc$millisecond_time =
      clp$convert_string_to_date_time (time^.millisecond, 'MS', cl_time, status);
    ELSE
      status.normal := FALSE;
    CASEND;

    IF status.normal THEN
      clp$convert_date_time_to_string (cl_time, 'HMS', str, status);
    IFEND;

    IF status.normal THEN
      ocp$output (' ', str.value, str.size, end_of_line);
    ELSE
      valid_format := FALSE;
      ocp$output (' ', '**:**:**', 12, end_of_line);
    IFEND;

  PROCEND ocp$output_time;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_date', EJECT ??

  PROCEDURE [XDCL] ocp$output_date
    (    date: ^ost$date;
         end_of_line: boolean;
     VAR valid_format: boolean);

    VAR
      date_time: clt$date_time,
      status: ost$status,
      str: ost$string;

    valid_format := TRUE;

    CASE date^.date_format OF
    = osc$month_date =
      clp$convert_string_to_date_time (date^.month, 'MONTH', date_time, status);
      str.value := date^.month;
      str.size := STRLENGTH (date^.month);
    = osc$iso_date =
      ocp$output (' ', date^.iso, STRLENGTH (date^.iso), end_of_line);
      RETURN;
    = osc$ordinal_date =
      clp$convert_string_to_date_time (date^.ordinal, 'ORDINAL', date_time, status);
      str.value := date^.ordinal;
      str.size := STRLENGTH (date^.ordinal);
    = osc$dmy_date =
      clp$convert_string_to_date_time (date^.dmy, 'DMY', date_time, status);
      str.value := date^.dmy;
      str.size := STRLENGTH (date^.dmy);
    = osc$mdy_date =
      clp$convert_string_to_date_time (date^.mdy, 'MDY', date_time, status);
      str.value := date^.mdy;
      str.size := STRLENGTH (date^.mdy);
    ELSE
      status.normal := FALSE;
    CASEND;

    IF status.normal THEN
      clp$convert_date_time_to_string (date_time, 'ISOD', str, status);
    IFEND;

    ocp$output (' ', str.value, str.size, end_of_line);
    valid_format := status.normal;

  PROCEND ocp$output_date;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_module_kind', EJECT ??

  PROCEDURE [XDCL] ocp$output_module_kind
    (    kind: ^llt$module_kind;
         end_of_line: boolean;
     VAR valid_kind: boolean);

    valid_kind := TRUE;

    CASE kind^ OF
    = llc$mi_virtual_state =
      ocp$output (' ', 'MI_VIRTUAL_STATE', 16, end_of_line);
    = llc$vector_virtual_state =
      ocp$output (' ', 'VECTOR_VIRTUAL_STATE', 20, end_of_line);
    = llc$iou =
      ocp$output (' ', 'IOU', 3, end_of_line);
    = llc$motorola_68000 =
      ocp$output (' ', 'MOTOROLA_68000', 14, end_of_line);
    = llc$motorola_68000_absolute =
      ocp$output (' ', 'MOTOROLA_68000_ABSOLUTE', 23, end_of_line);
    = llc$p_code =
      ocp$output (' ', 'P_CODE', 6, end_of_line);
      valid_kind := FALSE;
    = llc$vector_extended_state =
      ocp$output (' ', 'VECTOR_EXTENDED_STATE', 21, end_of_line);
    ELSE
      valid_kind := FALSE;
      ocp$output (' ', '*****************', 17, end_of_line);
    CASEND;

  PROCEND ocp$output_module_kind;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_library_member_kind', EJECT ??

  PROCEDURE [XDCL] ocp$output_library_member_kind
    (    library_member_kind: ^llt$library_member_kind;
         end_of_line: boolean;
     VAR valid_kind: boolean);

    valid_kind := TRUE;

    CASE library_member_kind^ OF
    = llc$program_description =
      ocp$output (' ', 'PROGRAM DESCRIPTION', 19, end_of_line);
    = llc$command_procedure =
      ocp$output (' ', 'COMMAND PROCEDURE', 17, end_of_line);
    = llc$command_description =
      ocp$output (' ', 'COMMAND DESCRIPTION', 19, end_of_line);
    = llc$function_procedure =
      ocp$output (' ', 'FUNCTION PROCEDURE', 18, end_of_line);
    = llc$function_description =
      ocp$output (' ', 'FUNCTION DESCRIPTION', 20, end_of_line);
    = llc$message_module =
      ocp$output (' ', 'MESSAGE MODULE', 14, end_of_line);
    = llc$panel_module =
      ocp$output (' ', 'FORM MODULE', 11, end_of_line);
    = llc$applic_program_description =
      ocp$output (' ', 'APPLICATION PROGRAM DESCRIPTION', 31, end_of_line);
    = llc$applic_command_procedure =
      ocp$output (' ', 'APPLICATION COMMAND PROCEDURE', 29, end_of_line);
    = llc$applic_command_description =
      ocp$output (' ', 'APPLICATION COMMAND DESCRIPTION', 31, end_of_line);
    ELSE
      valid_kind := FALSE;
      ocp$output (' ', '*******************', 19, end_of_line);
    CASEND;

  PROCEND ocp$output_library_member_kind;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_module_generator', EJECT ??

  PROCEDURE [XDCL] ocp$output_module_generator
    (    module_generator: ^llt$module_generator;
         end_of_line: boolean;
     VAR valid_module_generator: boolean);

    valid_module_generator := TRUE;

    CASE module_generator^ OF
    = llc$algol =
      ocp$output (' ', 'ALGOL', 5, end_of_line);
    = llc$apl =
      ocp$output (' ', 'APL', 3, end_of_line);
    = llc$basic =
      ocp$output (' ', 'BASIC', 5, end_of_line);
    = llc$cobol =
      ocp$output (' ', 'COBOL', 5, end_of_line);
    = llc$assembler =
      ocp$output (' ', 'ASSEMBLER', 9, end_of_line);
    = llc$fortran =
      ocp$output (' ', 'FORTRAN', 7, end_of_line);
    = llc$object_library_generator =
      ocp$output (' ', 'OBJECT_LIBRARY_GENERATOR', 24, end_of_line);
    = llc$pascal =
      ocp$output (' ', 'PASCAL', 6, end_of_line);
    = llc$obsolete_cybil =
      ocp$output (' ', 'OBSOLETE_CYBIL', 14, end_of_line);
    = llc$pl_i =
      ocp$output (' ', 'PL/I', 4, end_of_line);
    = llc$unknown_generator =
      ocp$output (' ', 'UNKNOWN_GENERATOR', 17, end_of_line);
    = llc$the_c_language =
      ocp$output (' ', 'THE_C_LANGUAGE', 14, end_of_line);
    = llc$ada =
      ocp$output (' ', 'ADA', 3, end_of_line);
    = llc$real_memory_builder =
      ocp$output (' ', 'REAL_MEMORY_BUILDER', 19, end_of_line);
    = llc$virtual_environment_linker =
      ocp$output (' ', 'VIRTUAL_ENVIRONMENT_LINKER', 26, end_of_line);
    = llc$malet =
      ocp$output (' ', 'MALET', 5, end_of_line);
    = llc$screen_formatter =
      ocp$output (' ', 'SCREEN_FORMATTER', 16, end_of_line);
    = llc$lisp =
      ocp$output (' ', 'LISP', 4, end_of_line);
    = llc$cybil =
      ocp$output (' ', 'CYBIL', 5, end_of_line);
    ELSE
      valid_module_generator := FALSE;
      ocp$output (' ', '************************', 24, end_of_line);
    CASEND;

  PROCEND ocp$output_module_generator;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_section_kind', EJECT ??

  PROCEDURE [XDCL] ocp$output_section_kind
    (    kind: ^llt$section_kind;
         end_of_line: boolean;
     VAR valid_kind: boolean);

    valid_kind := TRUE;

    CASE kind^ OF
    = llc$code_section =
      ocp$output (' ', 'CODE', 4, end_of_line);
    = llc$binding_section =
      ocp$output (' ', 'BINDING', 7, end_of_line);
    = llc$working_storage_section =
      ocp$output (' ', 'WORKING STORAGE', 15, end_of_line);
    = llc$common_block =
      ocp$output (' ', 'COMMON BLOCK', 12, end_of_line);
    = llc$extensible_working_storage =
      ocp$output (' ', 'EXTENSIBLE WORKING STORAGE', 26, end_of_line);
    = llc$extensible_common_block =
      ocp$output (' ', 'EXTENSIBLE COMMON BLOCK', 23, end_of_line);
    = llc$lts_reserved =
      ocp$output (' ', 'LINE TABLE RESERVED', 19, end_of_line);
    ELSE
      valid_kind := FALSE;
      ocp$output (' ', '**************************', 26, end_of_line);
    CASEND;

  PROCEND ocp$output_section_kind;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_boolean', EJECT ??

  PROCEDURE [XDCL] ocp$output_boolean
    (    boolean_value: boolean;
         end_of_line: boolean);

    IF boolean_value THEN
      ocp$output (' ', 'TRUE', 4, end_of_line);
    ELSE
      ocp$output (' ', 'FALSE', 5, end_of_line);
    IFEND;

  PROCEND ocp$output_boolean;
?? OLDTITLE ??
?? NEWTITLE := 'OCP$OUTPUT_ACCESS_ATTRIBUTES', EJECT ??

  PROCEDURE [XDCL] ocp$output_access_attributes
    (    access_attributes: llt$section_access_attributes;
         end_of_line: boolean);

    ocp$output (' ', '[', 1, FALSE);

    IF llc$read IN access_attributes THEN
      ocp$output (' ', 'R', 1, FALSE);
    IFEND;

    IF llc$write IN access_attributes THEN
      ocp$output (' ', 'W', 1, FALSE);
    IFEND;

    IF llc$binding IN access_attributes THEN
      ocp$output (' ', 'B', 1, FALSE);
    IFEND;

    IF llc$execute IN access_attributes THEN
      ocp$output (' ', 'X', 1, FALSE);
    IFEND;

    ocp$output (' ', ']', 1, end_of_line);

  PROCEND ocp$output_access_attributes;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$output_access_control', EJECT ??

  PROCEDURE [XDCL] ocp$output_access_control
    (    control: ost$segment_access_control;
         end_of_line: boolean);

    ocp$output (' ', '[', 1, FALSE);

    IF control.cache_bypass THEN
      ocp$output (' ', 'CB', 2, FALSE);
    IFEND;

    CASE control.execute_privilege OF
    = osc$non_privileged =
      ocp$output (' ', 'EX', 2, FALSE);
    = osc$local_privilege =
      ocp$output (' ', 'LP', 2, FALSE);
    = osc$global_privilege =
      ocp$output (' ', 'GP', 1, FALSE);
    ELSE
    CASEND;

    CASE control.read_privilege OF
    = osc$read_key_lock_controlled =
      ocp$output (' ', 'RK', 2, FALSE);
    = osc$read_uncontrolled =
      ocp$output (' ', 'RD', 2, FALSE);
    = osc$binding_segment =
      ocp$output (' ', 'BI', 2, FALSE);
    ELSE
    CASEND;

    CASE control.write_privilege OF
    = osc$write_key_lock_controlled =
      ocp$output (' ', 'WK', 2, FALSE);
    = osc$write_uncontrolled =
      ocp$output (' ', 'WT', 2, FALSE);
    ELSE
    CASEND;

    ocp$output (' ', ']', 1, end_of_line);

  PROCEND ocp$output_access_control;
?? OLDTITLE ??
MODEND ocm$display_helpers
