?? RIGHT := 110 ??                                                                                            
?? NEWTITLE := 'NOS/VE:  Object Code Utilities', EJECT ??                                                     
MODULE ocm$function_helpers;                                                                                  
                                                                                                              
                                                                                                              
                                                                                                              
{ PURPOSE:                                                                                                    
{   Common routines to build scl function results.                                                            
                                                                                                              
?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??                                      
?? PUSH (LIST := OFF) ??                                                                                      
*copyc llt$object_module                                                                                      
*copyc llt$load_module                                                                                        
*copyc ocs$literals                                                                                           
*copyc ost$segment_access_control                                                                             
?? POP ??                                                                                                     
*copyc clp$convert_string_to_date_time                                                                        
*copyc clp$make_boolean_value                                                                                 
*copyc clp$make_date_time_value                                                                               
*copyc clp$make_file_value                                                                                    
*copyc clp$make_list_value                                                                                    
*copyc clp$make_keyword_value                                                                                 
*copyc clp$make_record_value                                                                                  
*copyc clp$make_string_value                                                                                  
*copyc clp$trimmed_string_size                                                                                
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_access_attributes_valu', EJECT ??                                             
                                                                                                              
  PROCEDURE [XDCL] ocp$make_access_attributes_valu                                                            
    (    access_attributes: llt$section_access_attributes;                                                    
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      value: ^^clt$data_value;                                                                                
                                                                                                              
    result := NIL;                                                                                            
    value := ^result;                                                                                         
                                                                                                              
    IF llc$read IN access_attributes THEN                                                                     
      clp$make_list_value (work_area, value^);                                                                
      clp$make_keyword_value ('READ', work_area, value^^.element_value);                                      
      value := ^value^^.link;                                                                                 
    IFEND;                                                                                                    
                                                                                                              
    IF llc$write IN access_attributes THEN                                                                    
      clp$make_list_value (work_area, value^);                                                                
      clp$make_keyword_value ('WRITE', work_area, value^^.element_value);                                     
      value := ^value^^.link;                                                                                 
    IFEND;                                                                                                    
                                                                                                              
    IF llc$binding IN access_attributes THEN                                                                  
      clp$make_list_value (work_area, value^);                                                                
      clp$make_keyword_value ('BINDING', work_area, value^^.element_value);                                   
      value := ^value^^.link;                                                                                 
    IFEND;                                                                                                    
                                                                                                              
    IF llc$execute IN access_attributes THEN                                                                  
      clp$make_list_value (work_area, value^);                                                                
      clp$make_keyword_value ('EXECUTE', work_area, value^^.element_value);                                   
      value := ^value^^.link;                                                                                 
    IFEND;                                                                                                    
                                                                                                              
    IF result = NIL THEN                                                                                      
      clp$make_list_value (work_area, result);                                                                
    IFEND;                                                                                                    
                                                                                                              
  PROCEND ocp$make_access_attributes_valu;                                                                    
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_access_control_value', EJECT ??                                               
                                                                                                              
  PROCEDURE [XDCL] ocp$make_access_control_value                                                              
    (    control: ost$segment_access_control;                                                                 
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      privilege: ost$name;                                                                                    
                                                                                                              
    clp$make_record_value (4, work_area, result);                                                             
                                                                                                              
    result^.field_values^ [1].name := 'CACHE_BYPASS';                                                         
    clp$make_boolean_value (control.cache_bypass, clc$true_false_boolean, work_area, result^.                 
          field_values^ [1].value);                                                                           
                                                                                                              
    CASE control.execute_privilege OF                                                                         
    = osc$non_privileged =                                                                                    
      privilege := 'NON_PRIVILEGED';                                                                          
    = osc$local_privilege =                                                                                   
      privilege := 'LOCAL_PRIVILEGE';                                                                         
    = osc$global_privilege =                                                                                  
      privilege := 'GLOBAL_PRIVILEGE';                                                                        
    ELSE                                                                                                      
      privilege := 'ILLEGAL_PRIVILEGE';                                                                       
    CASEND;                                                                                                   
    result^.field_values^ [2].name := 'EXECUTE_PRIVILEGE';                                                    
    clp$make_keyword_value (privilege, work_area, result^.field_values^ [2].value);                           
                                                                                                              
    CASE control.read_privilege OF                                                                            
    = osc$read_key_lock_controlled =                                                                          
      privilege := 'READ_KEY_LOCK_CONTROLLED';                                                                
    = osc$read_uncontrolled =                                                                                 
      privilege := 'READ_UNCONTROLLED';                                                                       
    = osc$binding_segment =                                                                                   
      privilege := 'BINDING_SEGMENT';                                                                         
    ELSE                                                                                                      
      privilege := 'ILLEGAL_PRIVILEGE';                                                                       
    CASEND;                                                                                                   
    result^.field_values^ [3].name := 'READ_PRIVILEGE';                                                       
    clp$make_keyword_value (privilege, work_area, result^.field_values^ [3].value);                           
                                                                                                              
    CASE control.write_privilege OF                                                                           
    = osc$write_key_lock_controlled =                                                                         
      privilege := 'WRITE_KEY_LOCK_CONTROLLED';                                                               
    = osc$write_uncontrolled =                                                                                
      privilege := 'WRITE_UNCONTROLLED';                                                                      
    ELSE                                                                                                      
      privilege := 'ILLEGAL_PRIVILEGE';                                                                       
    CASEND;                                                                                                   
    result^.field_values^ [4].name := 'WRITE_PRIVILEGE';                                                      
    clp$make_keyword_value (privilege, work_area, result^.field_values^ [4].value);                           
                                                                                                              
  PROCEND ocp$make_access_control_value;                                                                      
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_date_time_value', EJECT ??                                                    
                                                                                                              
  PROCEDURE [XDCL] ocp$make_date_time_value                                                                   
    (    date: ost$date;                                                                                      
         time: ost$time;                                                                                      
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      status: ost$status,                                                                                     
      the_date: clt$date_time,                                                                                
      the_time: clt$date_time;                                                                                
                                                                                                              
    result := NIL;                                                                                            
                                                                                                              
    CASE time.time_format OF                                                                                  
    = osc$ampm_time =                                                                                         
      clp$convert_string_to_date_time (time.ampm, 'AMPM', the_time, status);                                  
    = osc$hms_time =                                                                                          
      clp$convert_string_to_date_time (time.hms, 'HMS', the_time, status);                                    
    = osc$millisecond_time =                                                                                  
      clp$convert_string_to_date_time (time.millisecond, 'MS', the_time, status);                             
    ELSE                                                                                                      
      status.normal := FALSE;                                                                                 
    CASEND;                                                                                                   
                                                                                                              
    the_time.time_specified := status.normal;                                                                 
                                                                                                              
    CASE date.date_format OF                                                                                  
    = osc$month_date =                                                                                        
      clp$convert_string_to_date_time (date.month, 'MONTH', the_date, status);                                
    = osc$iso_date =                                                                                          
      clp$convert_string_to_date_time (date.iso, 'ISOD', the_date, status);                                   
    = osc$ordinal_date =                                                                                      
      clp$convert_string_to_date_time (date.ordinal, 'ORDINAL', the_date, status);                            
    = osc$dmy_date =                                                                                          
      clp$convert_string_to_date_time (date.dmy, 'DMY', the_date, status);                                    
    = osc$mdy_date =                                                                                          
      clp$convert_string_to_date_time (date.mdy, 'MDY', the_date, status);                                    
    ELSE                                                                                                      
      status.normal := FALSE;                                                                                 
    CASEND;                                                                                                   
                                                                                                              
    the_time.date_specified := status.normal;                                                                 
    IF the_time.date_specified THEN                                                                           
      the_time.value.year := the_date.value.year;                                                             
      the_time.value.month := the_date.value.month;                                                           
      the_time.value.day := the_date.value.day;                                                               
    IFEND;                                                                                                    
                                                                                                              
    clp$make_date_time_value (the_time, work_area, result);                                                   
                                                                                                              
  PROCEND ocp$make_date_time_value;                                                                           
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_file_value', EJECT ??                                                         
                                                                                                              
  PROCEDURE [XDCL] ocp$make_file_value                                                                        
    (    file_name: string ( * );                                                                             
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      index: integer,                                                                                         
      non_file_char_found: boolean;                                                                           
                                                                                                              
    VAR                                                                                                       
      non_file_char: [STATIC, READ, ocs$literals] packed array [char] of boolean := [                         
            {---} REP 32 of TRUE,                                                                             
            {   } FALSE,                                                                                      
            {---} REP 2 of TRUE,                                                                              
            { # } FALSE,                                                                                      
            { $ } FALSE,                                                                                      
            {---} REP 9 of TRUE,                                                                              
            { . } FALSE,                                                                                      
            { / } TRUE,                                                                                       
            {0..9} REP 10 of FALSE,                                                                           
            {---} REP 6 of TRUE,                                                                              
            { @ } FALSE,                                                                                      
            {A..Z} REP 26 of FALSE,                                                                           
            { [ } FALSE,                                                                                      
            { \ } FALSE,                                                                                      
            { ] } FALSE,                                                                                      
            { ^ } FALSE,                                                                                      
            { _ } FALSE,                                                                                      
            { ` } FALSE,                                                                                      
            {a..z} REP 26 of TRUE,                                                                            
            { { } FALSE,                                                                                      
            { | } FALSE,                                                                                      
            { } FALSE,                                                                                        
            { ~ } FALSE,                                                                                      
            {---} REP 129 of TRUE];                                                                           
                                                                                                              
    IF file_name (1) = ':' THEN                                                                               
      #SCAN (non_file_char, file_name (2, * ), index, non_file_char_found);                                   
      IF non_file_char_found THEN                                                                             
        clp$make_string_value (file_name (1, clp$trimmed_string_size (file_name)), work_area, result);        
      ELSE                                                                                                    
        clp$make_file_value (file_name (1, clp$trimmed_string_size (file_name)), work_area, result);          
      IFEND;                                                                                                  
    ELSEIF (file_name = 'OSF$TASK_SERVICES_LIBRARY') OR (file_name = 'OSF$CURRENT_LIBRARY') THEN              
      clp$make_keyword_value (file_name (1, 31), work_area, result);                                          
    ELSE                                                                                                      
      clp$make_string_value (file_name (1, clp$trimmed_string_size (file_name)), work_area, result);          
    IFEND;                                                                                                    
                                                                                                              
  PROCEND ocp$make_file_value;                                                                                
                                                                                                              
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_library_member_kind_va', EJECT ??                                             
                                                                                                              
  PROCEDURE [XDCL] ocp$make_library_member_kind_va                                                            
    (    library_member_kind: llt$library_member_kind;                                                        
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      kind: ost$name;                                                                                         
                                                                                                              
    CASE library_member_kind OF                                                                               
    = llc$program_description, llc$applic_program_description =                                               
      kind := 'PROGRAM_DESCRIPTION';                                                                          
    = llc$command_procedure, llc$applic_command_procedure =                                                   
      kind := 'COMMAND_PROCEDURE';                                                                            
    = llc$function_procedure =                                                                                
      kind := 'FUNCTION_PROCEDURE';                                                                           
    = llc$message_module =                                                                                    
      kind := 'MESSAGE_MODULE';                                                                               
    = llc$panel_module =                                                                                      
      kind := 'FORM_MODULE';                                                                                  
    ELSE                                                                                                      
      kind := 'UNKNOWN';                                                                                      
    CASEND;                                                                                                   
    clp$make_keyword_value (kind, work_area, result);                                                         
                                                                                                              
  PROCEND ocp$make_library_member_kind_va;                                                                    
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_module_generator_value', EJECT ??                                             
                                                                                                              
  PROCEDURE [XDCL] ocp$make_module_generator_value                                                            
    (    module_generator: llt$module_generator;                                                              
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      generator: ost$name;                                                                                    
                                                                                                              
    CASE module_generator OF                                                                                  
    = llc$algol =                                                                                             
      generator := 'ALGOL';                                                                                   
    = llc$apl =                                                                                               
      generator := 'APL';                                                                                     
    = llc$basic =                                                                                             
      generator := 'BASIC';                                                                                   
    = llc$cobol =                                                                                             
      generator := 'COBOL';                                                                                   
    = llc$assembler =                                                                                         
      generator := 'ASSEMBLER';                                                                               
    = llc$fortran =                                                                                           
      generator := 'FORTRAN';                                                                                 
    = llc$object_library_generator =                                                                          
      generator := 'OBJECT_LIBRARY_GENERATOR';                                                                
    = llc$pascal =                                                                                            
      generator := 'PASCAL';                                                                                  
    = llc$obsolete_cybil =                                                                                    
      generator := 'OBSOLETE_CYBIL';                                                                          
    = llc$pl_i =                                                                                              
      generator := 'PL_I';                                                                                    
    = llc$unknown_generator =                                                                                 
      generator := 'UNKNOWN_GENERATOR';                                                                       
    = llc$the_c_language =                                                                                    
      generator := 'THE_C_LANGUAGE';                                                                          
    = llc$ada =                                                                                               
      generator := 'ADA';                                                                                     
    = llc$real_memory_builder =                                                                               
      generator := 'REAL_MEMORY_BUILDER';                                                                     
    = llc$virtual_environment_linker =                                                                        
      generator := 'VIRTUAL_ENVIRONMENT_LINKER';                                                              
    = llc$malet =                                                                                             
      generator := 'MALET';                                                                                   
    = llc$screen_formatter =                                                                                  
      generator := 'SCREEN_FORMATTER';                                                                        
    = llc$lisp =                                                                                              
      generator := 'LISP';                                                                                    
    = llc$cybil =                                                                                             
      generator := 'CYBIL';                                                                                   
    ELSE                                                                                                      
      generator := 'INVALID_GENERATOR';                                                                       
    CASEND;                                                                                                   
    clp$make_keyword_value (generator, work_area, result);                                                    
                                                                                                              
  PROCEND ocp$make_module_generator_value;                                                                    
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_module_kind_value', EJECT ??                                                  
                                                                                                              
  PROCEDURE [XDCL] ocp$make_module_kind_value                                                                 
    (    module_kind: llt$module_kind;                                                                        
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      kind: ost$name;                                                                                         
                                                                                                              
    CASE module_kind OF                                                                                       
    = llc$mi_virtual_state =                                                                                  
      kind := 'MI_VIRTUAL_STATE';                                                                             
    = llc$vector_virtual_state =                                                                              
      kind := 'VECTOR_VIRTUAL_STATE';                                                                         
    = llc$iou =                                                                                               
      kind := 'IOU';                                                                                          
    = llc$motorola_68000 =                                                                                    
      kind := 'MOTOROLA_68000';                                                                               
    = llc$motorola_68000_absolute =                                                                           
      kind := 'MOTOROLA_68000_ABSOLUTE';                                                                      
    = llc$p_code =                                                                                            
      kind := 'P_CODE';                                                                                       
    = llc$form =                                                                                              
      kind := 'FORM';                                                                                         
    = llc$vector_extended_state =                                                                             
      kind := 'VECTOR_EXTENDED';                                                                              
    ELSE                                                                                                      
      kind := 'UNKNOWN';                                                                                      
    CASEND;                                                                                                   
    clp$make_keyword_value (kind, work_area, result);                                                         
                                                                                                              
  PROCEND ocp$make_module_kind_value;                                                                         
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$make_section_kind_value', EJECT ??                                                 
                                                                                                              
  PROCEDURE [XDCL] ocp$make_section_kind_value                                                                
    (    section_kind: llt$section_kind;                                                                      
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value);                                                                            
                                                                                                              
    VAR                                                                                                       
      kind: ost$name;                                                                                         
                                                                                                              
    CASE section_kind OF                                                                                      
    = llc$code_section =                                                                                      
      kind := 'CODE';                                                                                         
    = llc$binding_section =                                                                                   
      kind := 'BINDING';                                                                                      
    = llc$working_storage_section =                                                                           
      kind := 'WORKING_STORAGE';                                                                              
    = llc$common_block =                                                                                      
      kind := 'COMMON_BLOCK';                                                                                 
    = llc$extensible_working_storage =                                                                        
      kind := 'EXTENSIBLE_WORKING_STORAGE';                                                                   
    = llc$extensible_common_block =                                                                           
      kind := 'EXTENSIBLE_COMMON_BLOCK';                                                                      
    = llc$lts_reserved =                                                                                      
      kind := 'LINE_TABLE_RESERVED';                                                                          
    ELSE                                                                                                      
      kind := 'INVALID_SECTION_KIND';                                                                         
    CASEND;                                                                                                   
    clp$make_keyword_value (kind, work_area, result);                                                         
                                                                                                              
  PROCEND ocp$make_section_kind_value;                                                                        
?? OLDTITLE ??                                                                                                
MODEND ocm$function_helpers                                                                                   
