?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Object Code Utilities: Create Form Module' ??
MODULE ocm$create_form_module;

{ PURPOSE:
{   This module contains the command processor for the CREATE_FORM_MODULE subcommand
{   of CREATE_OBJECT_LIBRARY.
{ DESIGN:
{   The Format Display (FD) routines actually create the form module; the
{   CREATE_OBJECT_LIBRARY utility only processes the command to create a form
{   module and merges the newly-created module with the current library.
{ NOTE:
{   "Panel module" is the old name for "form module".

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_value
*copyc fdc$screen_generator_version
*copyc fdt$form_identifier
*copyc fdt$form_status
*copyc oce$library_generator_errors
*copyc oct$display_toggles
*copyc oct$new_library_module_list
*copyc osd$virtual_address
*copyc ost$date
*copyc ost$status
*copyc ost$time
*copyc pmt$condition
*copyc pmt$established_handler
*copyc pmt$system_conditions
?? POP ??
*copyc clp$evaluate_parameters
*copyc fdp$begin_create_form_module
*copyc fdp$close_form
*copyc fdp$copy_form
*copyc fdp$find_form_definition
*copyc i#current_sequence_position
*copyc ocp$add_an_nlm
*copyc ocp$close_all_open_files
*copyc ocp$create_an_nlm
*copyc ocp$initialize_olg_working_heap
*copyc ocp$search_nlm_tree
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$get_date
*copyc pmp$get_time
*copyc ocv$nlm_list
*copyc ocv$olg_scratch_seq
*copyc ocv$olg_working_heap
*copyc ocv$open_file_list
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$_create_form_module', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to process the CREATE_FORM_MODULE subcommand
{   of CREATE_OBJECT_LIBRARY.

  PROCEDURE [XDCL] ocp$_create_form_module
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$creol_crefm) create_form_module, crefm(
{   form_name, fn: name = $required
{   merge_option, mo: key
{     (add, a)
{     (replace, r)
{     (combine, c)
{    keyend = combine
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 2, 14, 17, 38, 26, 340],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'OCM$CREOL_CREFM'], [
    ['FN                             ',clc$abbreviation_entry, 1],
    ['FORM_NAME                      ',clc$nominal_entry, 1],
    ['MERGE_OPTION                   ',clc$nominal_entry, 2],
    ['MO                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [6], [
    ['A                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ADD                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['COMBINE                        ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['R                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['REPLACE                        ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'combine'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$form_name = 1,
      p$merge_option = 2,
      p$status = 3;

    VAR
      pvt: array [1 .. 3] of clt$parameter_value;

    VAR
      compact_form_identifier: fdt$form_identifier,
      create_module: boolean,
      date: ost$date,
      established_conditions: pmt$condition,
      established_descriptor: pmt$established_handler,
      form_identifier: fdt$form_identifier,
      form_module_header_p: ^llt$library_member_header,
      form_module_p: ^SEQ ( * ),
      form_module_size: ost$segment_length,
      form_status_p: ^fdt$form_status,
      form_storage_p: ^SEQ ( * ),
      header_plus_module_size: ost$segment_length,
      ignore_status: ost$status,
      module_description_p: ^oct$module_description,
      module_exists: boolean,
      module_p: ^SEQ ( * ),
      nlm_p: ^oct$new_library_module_list,
      sequence_p: ^SEQ ( * ),
      temporary_module_header: llt$library_member_header,
      time: ost$time;

?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE:
{   This procedure is the condition handler for ocp$_create_form_module.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      IF (condition.selector = ifc$interactive_condition) AND
            (condition.interactive_condition = ifc$terminate_break) THEN

{ Ignore the condition.

        RETURN;
      ELSEIF condition.selector = pmc$block_exit_processing THEN
        ocp$close_all_open_files (ocv$open_file_list);
        ocp$initialize_olg_working_heap;
        RESET ocv$olg_scratch_seq;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;
    PROCEND condition_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    established_conditions.selector := pmc$condition_combination;
    established_conditions.combination := $pmt$condition_combination
          [ifc$interactive_condition, pmc$block_exit_processing];

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$get_time (osc$hms_time, time, ignore_status);

    pmp$get_date (osc$mdy_date, date, ignore_status);
    pmp$establish_condition_handler (established_conditions, ^condition_handler, ^established_descriptor,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /protect/
    BEGIN
      fdp$begin_create_form_module (pvt [p$form_name].value^.name_value, form_identifier, create_module,
            status);
      IF (NOT status.normal) OR (NOT create_module) THEN

{ No clean up is necessary here. Procedure fdp$begin_create_form_module has already done it.

        EXIT /protect/;
      IFEND;

{ Make the form compact and clean up space used by the original form.

      fdp$copy_form (form_identifier, compact_form_identifier, status);
      fdp$close_form (form_identifier, ignore_status);
      IF NOT status.normal THEN
        EXIT /protect/;
      IFEND;

{ Get the form definition record for the form module.

      fdp$find_form_definition (compact_form_identifier, form_status_p, status);
      IF NOT status.normal THEN
        fdp$close_form (compact_form_identifier, ignore_status);
        EXIT /protect/;
      IFEND;
      temporary_module_header.name := pvt [p$form_name].value^.name_value;
      temporary_module_header.kind := llc$panel_module;
      temporary_module_header.time_created := time;
      temporary_module_header.date_created := date;
      temporary_module_header.generator_id := llc$screen_formatter;
      temporary_module_header.generator_name_vers := fdc$screen_generator_version;
      temporary_module_header.commentary := osc$null_name;
      temporary_module_header.number_of_aliases := 0;

      ALLOCATE module_description_p IN ocv$olg_working_heap^;
      IF module_description_p = NIL THEN
        fdp$close_form (compact_form_identifier, ignore_status);
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;

      module_description_p^.name := temporary_module_header.name;
      module_description_p^.source := occ$current;
      module_description_p^.kind := occ$panel_module;

      ocp$search_nlm_tree (temporary_module_header.name, nlm_p, module_exists);

{ Check for error conditions.

      CASE pvt [p$merge_option].value^.keyword_value (1) OF
      = 'A' =
        IF module_exists THEN
          fdp$close_form (compact_form_identifier, ignore_status);
          osp$set_status_abnormal (oc, oce$e_module_already_on_library, temporary_module_header.name, status);
          EXIT /protect/;
        IFEND;
      = 'R' =
        IF NOT module_exists THEN
          osp$set_status_abnormal (oc, oce$e_module_not_found, temporary_module_header.name, status);
          fdp$close_form (compact_form_identifier, ignore_status);
          EXIT /protect/;
        IFEND;
      ELSE
      CASEND;

{ Replace the module if it exists already; add it if it doesn't.

      IF module_exists THEN
        nlm_p^.description := module_description_p;
        nlm_p^.changed_info := NIL;
      ELSE
        ocp$create_an_nlm (module_description_p, nlm_p, status);
        IF NOT status.normal THEN
          fdp$close_form (compact_form_identifier, ignore_status);
          EXIT /protect/;
        IFEND;
        ocp$add_an_nlm (ocv$nlm_list^.b_link, nlm_p);
      IFEND;

      RESET ocv$olg_scratch_seq;
      NEXT form_module_header_p IN ocv$olg_scratch_seq;
      IF form_module_header_p = NIL THEN
        fdp$close_form (compact_form_identifier, ignore_status);
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;
      form_module_size := i#current_sequence_position (form_status_p^.p_form_module);
      NEXT sequence_p: [[REP form_module_size OF cell]] IN ocv$olg_scratch_seq;
      IF sequence_p = NIL THEN
        fdp$close_form (compact_form_identifier, ignore_status);
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;

{ Get the size of the module header + the module itself.

      header_plus_module_size := i#current_sequence_position (ocv$olg_scratch_seq);

      ALLOCATE module_description_p^.file: [[REP header_plus_module_size OF cell]] IN ocv$olg_working_heap^;
      IF module_description_p^.file = NIL THEN
        fdp$close_form (compact_form_identifier, ignore_status);
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;
      RESET module_description_p^.file;
      NEXT module_description_p^.panel_module_header IN module_description_p^.file;
      module_description_p^.panel_module_header^ := temporary_module_header;

{ Set up a pointer to an object of the correct size (form_module_size) in sequence
{ form_status_p^.p_form_module.

      form_storage_p := form_status_p^.p_form_module;
      RESET form_storage_p;
      NEXT form_module_p: [[REP form_module_size OF cell]] IN form_storage_p;

      NEXT module_p: [[REP form_module_size OF cell]] IN module_description_p^.file;
      module_p^ := form_module_p^;
      module_description_p^.panel_module_header^.member := #REL (module_p, module_description_p^.file^);
      module_description_p^.panel_module_header^.member_size := form_module_size;
      fdp$close_form (compact_form_identifier, ignore_status);
    END /protect/;
    pmp$disestablish_cond_handler (established_conditions, ignore_status);
  PROCEND ocp$_create_form_module;
?? OLDTITLE ??
MODEND ocm$create_form_module;
