?? RIGHT := 110 ??                                                                                            
?? NEWTITLE := 'NOS/VE:  Object Library Generator' ??                                                         
MODULE ocm$$module_list;                                                                                      
                                                                                                              
                                                                                                              
                                                                                                              
{ PURPOSE:                                                                                                    
{   To return the list of modules on the current library.                                                     
                                                                                                              
?? PUSH (LISTEXT := ON) ??                                                                                    
*copyc cle$ecc_miscellaneous                                                                                  
*copyc llt$load_module                                                                                        
*copyc llt$object_module                                                                                      
*copyc oce$library_generator_errors                                                                           
*copyc oct$module_kinds                                                                                       
*copyc oct$new_library_module_list                                                                            
*copyc oct$object_code_utility_types                                                                          
*copyc oct$open_file_list                                                                                     
?? POP ??                                                                                                     
*copyc clp$evaluate_parameters                                                                                
*copyc clp$make_list_value                                                                                    
*copyc clp$make_program_name_value                                                                            
*copyc ocp$generate_message                                                                                   
*copyc ocp$obtain_object_file                                                                                 
*copyc ocp$search_nlm_tree                                                                                    
*copyc ocp$sort_name_list                                                                                     
*copyc osp$append_status_parameter                                                                            
*copyc osp$set_status_abnormal                                                                                
*copyc osp$set_status_condition                                                                               
                                                                                                              
*copyc ocv$nlm_list                                                                                           
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??                                        
?? FMT (FORMAT := OFF) ??                                                                                     
                                                                                                              
  VAR                                                                                                         
    module_kinds: array [1 .. 10] of record                                                                   
      name: ost$name,                                                                                         
      kinds: oct$module_kinds,                                                                                
    recend := [                                                                                               
      ['COMMAND_DESCRIPTION            ', [occ$command_description, occ$applic_command_description]],         
      ['COMMAND_PROCEDURE              ', [occ$command_procedure, occ$applic_command_procedure]],             
      ['CPU_MODULE                     ', [occ$cpu_object_module]],                                           
      ['FORM_MODULE                    ', [occ$panel_module]],                                                
      ['FUNCTION_DESCRIPTION           ', [occ$function_description]],                                        
      ['FUNCTION_PROCEDURE             ', [occ$function_procedure]],                                          
      ['LOAD_MODULE                    ', [occ$load_module, occ$bound_module]],                               
      ['MESSAGE_MODULE                 ', [occ$message_module]],                                              
      ['PPU_MODULE                     ', [occ$ppu_object_module]],                                           
      ['PROGRAM_DESCRIPTION            ', [occ$program_description, occ$applic_program_description]]];        
?? FMT (FORMAT := ON) ??                                                                                      
?? OLDTITLE ??                                                                                                
?? NEWTITLE := '[XDCL] ocp$$module_list', EJECT ??                                                            
                                                                                                              
{ PURPOSE:                                                                                                    
{   Function processor for the $MODULE_LIST function.                                                         
                                                                                                              
  PROCEDURE [XDCL] ocp$$module_list                                                                           
    (    parameter_list: clt$parameter_list;                                                                  
     VAR work_area: ^clt$work_area;                                                                           
     VAR result: ^clt$data_value;                                                                             
     VAR status: ost$status);                                                                                 
                                                                                                              
?? NEWTITLE := 'build_module_list_from_current', EJECT ??                                                     
                                                                                                              
{ PURPOSE:                                                                                                    
{   Build the list of names of the selected module kinds from the current                                     
{   library.                                                                                                  
                                                                                                              
    PROCEDURE build_module_list_from_current                                                                  
      (    selected_kinds: oct$module_kinds;                                                                  
       VAR result: ^clt$data_value);                                                                          
                                                                                                              
      VAR                                                                                                     
        current_module: pmt$program_name,                                                                     
        first_module: pmt$program_name,                                                                       
        last_module: pmt$program_name,                                                                        
        module_found: boolean,                                                                                
        nlm: ^oct$new_library_module_list,                                                                    
        value: ^^clt$data_value;                                                                              
                                                                                                              
      value := ^result;                                                                                       
                                                                                                              
      first_module := ocv$nlm_list^.f_link^.name;                                                             
      last_module := ocv$nlm_list^.b_link^.name;                                                              
                                                                                                              
      ocp$search_nlm_tree (first_module, nlm, module_found);                                                  
                                                                                                              
      REPEAT                                                                                                  
        IF nlm^.name = osc$null_name THEN                                                                     
          RETURN;                                                                                             
        IFEND;                                                                                                
                                                                                                              
        current_module := nlm^.name;                                                                          
        IF nlm^.description^.kind IN selected_kinds THEN                                                      
          clp$make_list_value (work_area, value^);                                                            
          clp$make_program_name_value (current_module, work_area, value^^.element_value);                     
          value := ^value^^.link;                                                                             
        IFEND;                                                                                                
                                                                                                              
        nlm := nlm^.f_link;                                                                                   
      UNTIL current_module = last_module;                                                                     
                                                                                                              
    PROCEND build_module_list_from_current;                                                                   
?? OLDTITLE ??                                                                                                
?? NEWTITLE := 'build_module_list_from_library', EJECT ??                                                     
                                                                                                              
{ PURPOSE:                                                                                                    
{   Build the list of module names of the selected module kinds from the                                      
{   specified library file.                                                                                   
                                                                                                              
    PROCEDURE build_module_list_from_library                                                                  
      (    selected_kinds: oct$module_kinds;                                                                  
           file_name: fst$file_reference;                                                                     
       VAR result: ^clt$data_value;                                                                           
       VAR status: ost$status);                                                                               
                                                                                                              
      VAR                                                                                                     
        current_module: integer,                                                                              
        input_file: ^oct$open_file_list,                                                                      
        value: ^^clt$data_value;                                                                              
                                                                                                              
      value := ^result;                                                                                       
                                                                                                              
      ocp$obtain_object_file (file_name, input_file, status);                                                 
      IF NOT status.normal THEN                                                                               
        RETURN;                                                                                               
      IFEND;                                                                                                  
                                                                                                              
      FOR current_module := 1 TO UPPERBOUND (input_file^.directory^) DO                                       
        IF input_file^.directory^ [current_module].kind IN selected_kinds THEN                                
          clp$make_list_value (work_area, value^);                                                            
          clp$make_program_name_value (input_file^.directory^ [current_module].name, work_area,               
                value^^.element_value);                                                                       
          value := ^value^^.link;                                                                             
        IFEND;                                                                                                
      FOREND;                                                                                                 
                                                                                                              
    PROCEND build_module_list_from_library;                                                                   
?? OLDTITLE, EJECT ??                                                                                         
                                                                                                              
{ FUNCTION (OCM$CREOL_$MODL) $module_list (                                                                   
{   library: any of                                                                                           
{     key new_library keyend                                                                                  
{     file                                                                                                    
{    anyend = new_library                                                                                     
{   kinds: any of                                                                                             
{     key all keyend                                                                                          
{     list of key                                                                                             
{       (command_description, cd),                                                                            
{       (command_procedure, cp),                                                                              
{       (cpu_module, cm),                                                                                     
{       (form_module, fm),                                                                                    
{       (function_description, fd),                                                                           
{       (function_procedure, fp),                                                                             
{       (load_module, lm),                                                                                    
{       (message_module, mm),                                                                                 
{       (ppu_module, ppum, pm),                                                                               
{       (program_description, pd)                                                                             
{     keyend                                                                                                  
{    anyend = all)                                                                                            
                                                                                                              
?? PUSH (LISTEXT := ON) ??                                                                                    
?? FMT (FORMAT := OFF) ??                                                                                     
                                                                                                              
  VAR                                                                                                         
    pdt: [STATIC, READ, cls$declaration_section] record                                                       
      header: clt$pdt_header,                                                                                 
      names: array [1 .. 2] of clt$pdt_parameter_name,                                                        
      parameters: array [1 .. 2] of clt$pdt_parameter,                                                        
      type1: record                                                                                           
        header: clt$type_specification_header,                                                                
        qualifier: clt$union_type_qualifier,                                                                  
        type_size_1: clt$type_specification_size,                                                             
        element_type_spec_1: record                                                                           
          header: clt$type_specification_header,                                                              
          qualifier: clt$keyword_type_qualifier,                                                              
          keyword_specs: array [1 .. 1] of clt$keyword_specification,                                         
        recend,                                                                                               
        type_size_2: clt$type_specification_size,                                                             
        element_type_spec_2: record                                                                           
          header: clt$type_specification_header,                                                              
        recend,                                                                                               
        default_value: string (11),                                                                           
      recend,                                                                                                 
      type2: record                                                                                           
        header: clt$type_specification_header,                                                                
        qualifier: clt$union_type_qualifier,                                                                  
        type_size_1: clt$type_specification_size,                                                             
        element_type_spec_1: record                                                                           
          header: clt$type_specification_header,                                                              
          qualifier: clt$keyword_type_qualifier,                                                              
          keyword_specs: array [1 .. 1] of clt$keyword_specification,                                         
        recend,                                                                                               
        type_size_2: clt$type_specification_size,                                                             
        element_type_spec_2: record                                                                           
          header: clt$type_specification_header,                                                              
          qualifier: clt$list_type_qualifier,                                                                 
          element_type_spec: record                                                                           
            header: clt$type_specification_header,                                                            
            qualifier: clt$keyword_type_qualifier,                                                            
            keyword_specs: array [1 .. 21] of clt$keyword_specification,                                      
          recend,                                                                                             
        recend,                                                                                               
        default_value: string (3),                                                                            
      recend,                                                                                                 
    recend := [                                                                                               
    [1,                                                                                                       
    [89, 9, 1, 15, 19, 42, 289],                                                                              
    clc$function, 2, 2, 0, 0, 0, 0, 0, 'OCM$CREOL_$MODL'], [                                                  
    ['KINDS                          ',clc$nominal_entry, 2],                                                 
    ['LIBRARY                        ',clc$nominal_entry, 1]],                                                
    [                                                                                                         
{ PARAMETER 1                                                                                                 
    [2, clc$normal_usage_entry, clc$non_secure_parameter,                                                     
    $clt$parameter_spec_methods[clc$specify_positionally],                                                    
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 67,                         
  clc$optional_default_parameter, 0, 11],                                                                     
{ PARAMETER 2                                                                                                 
    [1, clc$normal_usage_entry, clc$non_secure_parameter,                                                     
    $clt$parameter_spec_methods[clc$specify_positionally],                                                    
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 864,                        
  clc$optional_default_parameter, 0, 3]],                                                                     
{ PARAMETER 1                                                                                                 
    [[1, 0, clc$union_type], [[clc$file_type, clc$keyword_type],                                              
    FALSE, 2],                                                                                                
    44, [[1, 0, clc$keyword_type], [1], [                                                                     
      ['NEW_LIBRARY                    ', clc$nominal_entry, clc$normal_usage_entry, 1]]                      
      ],                                                                                                      
    3, [[1, 0, clc$file_type]]                                                                                
    ,                                                                                                         
    'new_library'],                                                                                           
{ PARAMETER 2                                                                                                 
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$list_type],                                              
    FALSE, 2],                                                                                                
    44, [[1, 0, clc$keyword_type], [1], [                                                                     
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]                      
      ],                                                                                                      
    800, [[1, 0, clc$list_type], [784, 1, clc$max_list_size, FALSE],                                          
        [[1, 0, clc$keyword_type], [21], [                                                                    
        ['CD                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],               
        ['CM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],               
        ['COMMAND_DESCRIPTION            ', clc$nominal_entry, clc$normal_usage_entry, 1],                    
        ['COMMAND_PROCEDURE              ', clc$nominal_entry, clc$normal_usage_entry, 2],                    
        ['CP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],               
        ['CPU_MODULE                     ', clc$nominal_entry, clc$normal_usage_entry, 3],                    
        ['FD                             ', clc$abbreviation_entry, clc$normal_usage_entry, 5],               
        ['FM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 4],               
        ['FORM_MODULE                    ', clc$nominal_entry, clc$normal_usage_entry, 4],                    
        ['FP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 6],               
        ['FUNCTION_DESCRIPTION           ', clc$nominal_entry, clc$normal_usage_entry, 5],                    
        ['FUNCTION_PROCEDURE             ', clc$nominal_entry, clc$normal_usage_entry, 6],                    
        ['LM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 7],               
        ['LOAD_MODULE                    ', clc$nominal_entry, clc$normal_usage_entry, 7],                    
        ['MESSAGE_MODULE                 ', clc$nominal_entry, clc$normal_usage_entry, 8],                    
        ['MM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 8],               
        ['PD                             ', clc$abbreviation_entry, clc$normal_usage_entry, 10],              
        ['PM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 9],               
        ['PPUM                           ', clc$alias_entry, clc$normal_usage_entry, 9],                      
        ['PPU_MODULE                     ', clc$nominal_entry, clc$normal_usage_entry, 9],                    
        ['PROGRAM_DESCRIPTION            ', clc$nominal_entry, clc$normal_usage_entry, 10]]                   
        ]                                                                                                     
      ]                                                                                                       
    ,                                                                                                         
    'all']];                                                                                                  
                                                                                                              
?? FMT (FORMAT := ON) ??                                                                                      
?? POP ??                                                                                                     
                                                                                                              
    CONST                                                                                                     
      p$library = 1,                                                                                          
      p$kinds = 2;                                                                                            
                                                                                                              
    VAR                                                                                                       
      pvt: array [1 .. 2] of clt$parameter_value;                                                             
                                                                                                              
    VAR                                                                                                       
      i: integer,                                                                                             
      item_p: ^clt$data_value,                                                                                
      selected_kinds: oct$module_kinds;                                                                       
                                                                                                              
    status.normal := TRUE;                                                                                    
                                                                                                              
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);                                  
    IF NOT status.normal THEN                                                                                 
      RETURN;                                                                                                 
    IFEND;                                                                                                    
                                                                                                              
    IF pvt [p$kinds].value^.kind = clc$keyword THEN                                                           
      selected_kinds := -$oct$module_kinds [];                                                                
    ELSE { list of module kind keywords                                                                       
      selected_kinds := $oct$module_kinds [];                                                                 
      item_p := pvt [p$kinds].value;                                                                          
      WHILE item_p <> NIL DO                                                                                  
        FOR i := LOWERBOUND (module_kinds) TO UPPERBOUND (module_kinds) DO                                    
          IF item_p^.element_value^.name_value = module_kinds [i].name THEN                                   
            selected_kinds := selected_kinds + module_kinds [i].kinds;                                        
          IFEND;                                                                                              
        FOREND;                                                                                               
        item_p := item_p^.link;                                                                               
      WHILEND;                                                                                                
    IFEND;                                                                                                    
                                                                                                              
    result := NIL;                                                                                            
    IF pvt [p$library].value^.kind = clc$keyword THEN                                                         
      IF ocv$nlm_list^.f_link^.name <> osc$null_name THEN                                                     
        build_module_list_from_current (selected_kinds, result);                                              
      IFEND;                                                                                                  
                                                                                                              
    ELSE { library.kind = clc$file_value                                                                      
      build_module_list_from_library (selected_kinds, pvt [p$library].value^.file_value^, result, status);    
      IF NOT status.normal AND (status.condition = oce$w_no_modules_on_current_lib) THEN                      
        status.normal := TRUE;                                                                                
        clp$make_list_value (work_area, result);                                                              
      IFEND;                                                                                                  
    IFEND;                                                                                                    
                                                                                                              
    IF result = NIL THEN                                                                                      
      clp$make_list_value (work_area, result);                                                                
    IFEND;                                                                                                    
                                                                                                              
  PROCEND ocp$$module_list;                                                                                   
?? OLDTITLE ??                                                                                                
                                                                                                              
MODEND ocm$$module_list;                                                                                      
