?? RIGHT := 110 ??
*copyc OSD$DEFAULT_PRAGMATS
?? TITLE := 'NOS/VE : Tasking : Outward call' ??
?? NEWTITLE := '  Global declarations', EJECT ??
MODULE pmm$outward_call;

{  PURPOSE:
{    This module contains procedures used to perform an outward call.
{  DESIGN:
{    The actual outward call involves usage of the POP instruction.  Since POP is not supported
{    by CYBIL, an assembly language helper procedure performs the actual outward call.  The
{    procedures in this module set up the environment for the outward call and then call
{    the helper procedure.
?? EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc PMT$USER_PROGRAM
*copyc PMT$PROGRAM_PARAMETERS
*copyc PMT$STACK_SEGMENT
*copyc CYD$CYBIL_STRUCTURE_DEFINITIONS
*copyc OSD$VIRTUAL_ADDRESS
*copyc OST$STACK_FRAME_SAVE_AREA
*copyc OST$STATUS
*copyc OSK$KEYPOINTS
*copyc OSS$JOB_PAGED_LITERAL
*copyc PMK$KEYPOINTS
*copyc PME$DEBUG_EXCEPTIONS
?? POP ??
*copyc OSP$SYSTEM_ERROR
*copyc OSP$SET_STATUS_ABNORMAL
*copyc OSP$GENERATE_MESSAGE
*copyc PMP$EXIT
*copyc PMP$TASK_DEBUG_MODE_ON
*copyc PMP$TASK_DEBUG_RING
*copyc PMP$LOAD_DEBUG_PROCEDURES
*copyc PMP$RETURN_TO_OUTWARD_CALL_SFSA
*copyc PMP$FIND_BEGIN_DEBUG
*copyc PMP$FIND_PROG_OPTIONS_AND_LIBS
*copyc PMP$INHIBIT_SYSTEM_CONDITIONS
*copyc PMP$ENABLE_SYSTEM_CONDITIONS
*copyc PMP$UPDATE_TOS_RING_3
*copyc PMP$ESTABLISH_CONDITION_HANDLER
*copyc PMV$ENABLE_INHIBIT_CONDITIONS

?? TITLE := '  [XDCL] pmp$outward_call', EJECT ??

  PROCEDURE [XDCL] pmp$outward_call (callee: ^ost$external_code_base_pointer;
        ring: ost$ring;
        parameter_list: ^cell;
        preceding_sfsa: ^ost$stack_frame_save_area;
    VAR stack_segment: ^pmt$stack_segment);

{  PURPOSE:
{    This procedure performs an outward call to a specified procedure in a specified ring.
{  NOTE:
{    All stack frames in the caller's ring are popped before the transfer is made to the
{    outer ring.

    VAR
      outward_call_sfsa: ^ost$stack_frame_save_area;

    pmp$build_outward_call_sfsa (callee, ring, parameter_list, preceding_sfsa, 0, stack_segment,
          outward_call_sfsa);
    pmp$return_to_outward_call_sfsa (outward_call_sfsa);

{   The above procedure is not expected to return.

  PROCEND pmp$outward_call;
?? TITLE := '  [XDCL] pmp$build_outward_call_sfsa', EJECT ??

  PROCEDURE [XDCL] pmp$build_outward_call_sfsa (callee: ^ost$external_code_base_pointer;
        ring: ost$ring;
        parameter_list: ^cell;
        preceding_sfsa: ^ost$stack_frame_save_area;
        stack_frame_size: ost$segment_length;
    VAR stack_segment: ^pmt$stack_segment;
    VAR outward_call_sfsa: ^ost$stack_frame_save_area);

{  PURPOSE:
{    This procedure builds a stack frame save area to be used in performing an outward call.

    VAR
      pva: ^cell,
      pad: ^SEQ ( * ),
      stack_frame: ^SEQ ( * ),
      psa: ^ost$stack_frame_save_area;

    IF stack_frame_size <> 0 THEN
      NEXT pva IN stack_segment;
{!  Use ALIGNED attribute to accomplish padding when PSR CILA247 is answered.
      NEXT pad: [[REP (8 - ((#offset (pva) + 1) MOD 8)) OF cell]] IN stack_segment;
      NEXT stack_frame: [[REP stack_frame_size OF cell]] IN stack_segment;
    IFEND;
    NEXT pva IN stack_segment;
{!  Use ALIGNED attribute to accomplish padding when PSR CILA247 is answered.
    NEXT pad: [[REP (8 - ((#offset (pva) + 1) MOD 8)) OF cell]] IN stack_segment;
    NEXT outward_call_sfsa IN stack_segment;

    { A4 is the last register that needs to be in the save area for this stack frame }
    pmp$update_tos_ring_3 (^outward_call_sfsa^.monitor_condition_register);

    outward_call_sfsa^.minimum_save_area.p_register.undefined1 := 0;
{!  Keys should be initialized based on segment attributes of the segment containing the
{!  procedure which is being called.
    psa := #previous_save_area ();
    outward_call_sfsa^.minimum_save_area.p_register.global_key := psa^.minimum_save_area.p_register.
          global_key;
    outward_call_sfsa^.minimum_save_area.p_register.undefined2 := 0;
    outward_call_sfsa^.minimum_save_area.p_register.local_key := psa^.minimum_save_area.p_register.local_key;
    outward_call_sfsa^.minimum_save_area.p_register.pva.ring := ring;
    outward_call_sfsa^.minimum_save_area.p_register.pva.seg := #segment (callee^.code_pva);
    outward_call_sfsa^.minimum_save_area.p_register.pva.offset := #offset (callee^.code_pva);
    outward_call_sfsa^.minimum_save_area.vmid := callee^.vmid;
    outward_call_sfsa^.minimum_save_area.undefined := 0;
    outward_call_sfsa^.minimum_save_area.a0_dynamic_space_pointer := outward_call_sfsa;
    outward_call_sfsa^.minimum_save_area.frame_descriptor.critical_frame_flag := FALSE;
    outward_call_sfsa^.minimum_save_area.frame_descriptor.on_condition_flag := FALSE;
    outward_call_sfsa^.minimum_save_area.frame_descriptor.undefined := 0;
    outward_call_sfsa^.minimum_save_area.frame_descriptor.x_starting := 1;
    outward_call_sfsa^.minimum_save_area.frame_descriptor.a_terminating := 4;
    outward_call_sfsa^.minimum_save_area.frame_descriptor.x_terminating := 0;
?? EJECT ??
    IF stack_frame_size <> 0 THEN
      outward_call_sfsa^.minimum_save_area.a1_current_stack_frame := stack_frame;
    ELSE
      outward_call_sfsa^.minimum_save_area.a1_current_stack_frame := outward_call_sfsa;
    IFEND;
    outward_call_sfsa^.minimum_save_area.user_mask := psa^.minimum_save_area.user_mask;
    outward_call_sfsa^.minimum_save_area.a2_previous_save_area := preceding_sfsa;
    outward_call_sfsa^.a3 := callee^.binding_pva;
    outward_call_sfsa^.a4 := parameter_list;
  PROCEND pmp$build_outward_call_sfsa;
?? TITLE := '  [XDCL] pmp$original_caller', EJECT ??

  PROCEDURE [XDCL] pmp$original_caller (user_program_cbp: ^ost$external_code_base_pointer;
        program_parameters: ^pmt$program_parameters);

{  PURPOSE:
{    This procedure transfers control to the starting procedure of the user program and
{    terminates the task if the starting procedure returns.  It is called (via PMP$OUTWARD_CALL
{    if necessary) in the ring in which the starting procedure will execute.

  PROCEDURE handle_block_exit_condition (conditions : pmt$condition;
        condition_descriptor : ^pmt$condition_information;
        save_area : ^ost$stack_frame_save_area;
        VAR status : ost$status);

    VAR
      prog_options_and_libs: ^pmt$prog_options_and_libraries;

    pmp$find_prog_options_and_libs (prog_options_and_libs);
    pmp$enable_system_conditions (prog_options_and_libs^.default_options^.conditions_enabled, local_status);
    pmp$inhibit_system_conditions (prog_options_and_libs^.default_options^.conditions_inhibited,
          local_status);

  PROCEND handle_block_exit_condition;

    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          pointer_to_procedure: cyt$pointer_to_procedure,
        = 1 =
          user_program: pmt$user_program,
        casend,
      recend,

      establish_descriptor: pmt$established_handler,
      conditions: pmt$condition,
      condition_handler: pmt$condition_handler,
      of_execution: cell,
      user_program_status: ost$status,
      pointer_to_procedure: cyt$pointer_to_procedure,
      user_program: pmt$user_program,
      local_status: ost$status;

    IF pmp$task_debug_mode_on () AND (pmp$task_debug_ring () > osc$tsrv_ring) THEN
      IF #ring (^of_execution) >= pmp$task_debug_ring () THEN
        pmp$load_debug_procedures (local_status);
        IF NOT local_status.normal THEN
          pmp$exit (local_status);
        IFEND;
        pmp$call_begin_debug (user_program_cbp^.code_pva);
      ELSE
        osp$set_status_abnormal ('PM', pme$unable_to_load_debug, 'DBP$BEGIN_DEBUG', local_status);
        osp$generate_message (local_status, local_status);
      IFEND;
    IFEND;

{ Because of the fashion in which popper works, if original caller is not called
{ from pmp$task_begin but via outward call, the condition handler will never
{ get executed because the stack is truncated immediately before original caller
{ is popped.  Therefore, the condition handler is only needed if an outward call
{ is not performed.

    IF #ring(^of_execution) <= osc$tsrv_ring THEN
      conditions.selector := pmc$block_exit_processing;
      conditions.reason := -$pmt$block_exit_reason[];
      condition_handler := ^handle_block_exit_condition;
      pmp$establish_condition_handler (conditions, condition_handler,
          ^establish_descriptor, local_status);
    IFEND;
    pointer_to_procedure.code_base_pointer_p := user_program_cbp;
    pointer_to_procedure.static_link := NIL;
    converter.pointer_to_procedure := pointer_to_procedure;
    user_program := converter.user_program;
    user_program_status.normal := TRUE;
    pmp$enable_system_conditions (pmv$enable_inhibit_conditions.enable_system_conditions, local_status);
    pmp$inhibit_system_conditions (pmv$enable_inhibit_conditions.inhibit_system_conditions, local_status);
    user_program^ (program_parameters^, user_program_status);
{   NOTE: a condition may arise when re-enabled but the condition mechanism
{         will ignore the condition in the original caller.
    pmp$exit (user_program_status);
  PROCEND pmp$original_caller;
?? TITLE := '  [XDCL] pmp$call_begin_debug', EJECT ??

  PROCEDURE [XDCL] pmp$call_begin_debug (starting_procedure_value: ^cell);

    VAR
      starting_procedure: ^cell,
      psa: ^ost$stack_frame_save_area,
      pva: ost$pva,
      begin_debug: dbt$begin_debug;

    IF starting_procedure_value <> NIL THEN
      starting_procedure := starting_procedure_value;
    ELSE
      psa := #previous_save_area ();
      pva := psa^.minimum_save_area.p_register.pva;
      starting_procedure := #address (pva.ring, pva.seg, pva.offset);
    IFEND;
    pmp$find_begin_debug (begin_debug);
    IF begin_debug <> NIL THEN
      begin_debug^ (starting_procedure);
    IFEND;
  PROCEND pmp$call_begin_debug;
MODEND pmm$outward_call;
