?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Deadstart : Manage SSR Routines' ??
MODULE dsm$manage_ssr_routines;

{ PURPOSE:
{   This module contains the procedures that are used to manage the system status record (SSR) areas.
{ NOTE:
{   There is a corresponding module in monitor that manages the SSR routines.  Any changes made to this
{   module may also need to be made to the module dsm$mtr_manage_ssr_routines.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dst$ssr_data_types
?? POP ??
*copyc dsp$build_sequence_p
*copyc dsp$convert_seq_p_to_r_pointer
*copyc i#real_memory_address
*copyc mmp$close_asid_based_segment
*copyc mmp$create_ssr_sdtx
*copyc mmp$open_asid_based_segment
*copyc osp$system_error
?? EJECT ??
*copyc dsv$ssr_sdte
*copyc osv$boot_is_executing
?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    dsv$ssr_size: [XDCL] 0 .. 0fffff(16),
    v$ssr_sdtex: mmt$segment_descriptor_extended;
?? TITLE := 'access_ssr_segment', EJECT ??

{ PURPOSE:
{   This procedure builds a sequence pointer to the SSR area and retrieves the desired ssr entry.

  PROCEDURE access_ssr_segment
    (    ssr_segment_number: ost$segment;
         ssr_entry_name: dst$ssr_entry_name;
     VAR ssr_seq_p: ^SEQ ( * );
     VAR ssr_entry_p: ^dst$ssr_entry);

    VAR
      ssr_address_p: ^cell;

    ssr_address_p := #ADDRESS (1, ssr_segment_number, dsc$ssr_offset);
    dsp$build_sequence_p (ssr_address_p, dsv$ssr_size, ssr_seq_p);

    RESET ssr_seq_p;
    REPEAT
      NEXT ssr_entry_p IN ssr_seq_p;
      IF (ssr_entry_p <> NIL) AND (ssr_entry_p^.name = ssr_entry_name) THEN
        RESET ssr_seq_p;
        RETURN;
      IFEND;
    UNTIL ssr_entry_p = NIL;
    osp$system_error (' Entry is not defined in the SSR', NIL);

  PROCEND access_ssr_segment;
?? TITLE := 'dsp$close_ssr', EJECT ??

{ PURPOSE:
{   This procedure removes the SSR from the segment table of the user.

  PROCEDURE [XDCL] dsp$close_ssr
    (VAR ssr_segment_number: ost$segment;
     VAR status: ost$status);

    status.normal := TRUE;
    IF NOT osv$boot_is_executing THEN
      mmp$close_asid_based_segment (ssr_segment_number, status);
    IFEND;

  PROCEND dsp$close_ssr;
?? TITLE := 'dsp$get_data_from_ssr', EJECT ??

{ PURPOSE:
{   This procedure retrieves data from the SSR.  The caller to this procedure should set up a sequence pointer
{   to their data variable, call this procedure with the sequence pointer and then access their data variable
{   directly.
{     EXAMPLE:  data_variable_seq_p := #SEQ (data_variable);
{               dsp$get_data_from_ssr (ssr_entry_name, data_variable_seq_p);
{               IF data_variable = 'xxx' THEN
{                   etc.

  PROCEDURE [XDCL] dsp$get_data_from_ssr
    (    ssr_entry_name: dst$ssr_entry_name;
     VAR ssr_value_p: ^SEQ ( * ));

    VAR
      data_seq_p: ^SEQ ( * ),
      skip_seq_p: ^SEQ ( * ),
      ssr_entry_p: ^dst$ssr_entry,
      ssr_segment_number: ost$segment,
      ssr_seq_p: ^SEQ ( * ),
      ssr_value_seq_p: ^SEQ ( * ),
      status: ost$status;

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to open the SSR.', ^status);
    IFEND;

    access_ssr_segment (ssr_segment_number, ssr_entry_name, ssr_seq_p, ssr_entry_p);

    RESET ssr_seq_p;
    IF ssr_entry_p^.right_slot > 0 THEN
      NEXT skip_seq_p: [[REP ssr_entry_p^.right_slot OF integer]] IN ssr_seq_p;
    IFEND;
    NEXT ssr_value_seq_p: [[REP ssr_entry_p^.left_slot OF integer]] IN ssr_seq_p;
    RESET ssr_value_seq_p;

    { Move the data from the SSR area to the parameter sequence pointer.

    RESET ssr_value_p;
    IF #SIZE (ssr_value_p^) > #SIZE (ssr_value_seq_p^) THEN
      NEXT data_seq_p: [[REP #SIZE (ssr_value_seq_p^) OF cell]] IN ssr_value_p;
      data_seq_p^ := ssr_value_seq_p^;
    ELSE
      NEXT data_seq_p: [[REP #SIZE (ssr_value_p^) OF cell]] IN ssr_value_seq_p;
      ssr_value_p^ := data_seq_p^;
    IFEND;
    RESET ssr_value_p;

    dsp$close_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to close the SSR.', ^status);
    IFEND;

  PROCEND dsp$get_data_from_ssr;
?? TITLE := 'dsp$get_entry_from_ssr', EJECT ??

{ PURPOSE:
{   This procedure retrieves an entry from the SSR.

  PROCEDURE [XDCL] dsp$get_entry_from_ssr
    (    ssr_entry_name: dst$ssr_entry_name;
     VAR ssr_entry: dst$ssr_entry);

    VAR
      ssr_entry_p: ^dst$ssr_entry,
      ssr_segment_number: ost$segment,
      ssr_seq_p: ^SEQ ( * ),
      status: ost$status;

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to open the SSR.', ^status);
    IFEND;

    access_ssr_segment (ssr_segment_number, ssr_entry_name, ssr_seq_p, ssr_entry_p);

    ssr_entry := ssr_entry_p^;

    dsp$close_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to close the SSR.', ^status);
    IFEND;

  PROCEND dsp$get_entry_from_ssr;
?? TITLE := 'dsp$get_ssr_data_r_pointer', EJECT ??

{ PURPOSE:
{   This procedure retrieves an r pointer to specific data in the SSR.

  PROCEDURE [XDCL] dsp$get_ssr_data_r_pointer
    (    ssr_entry_name: dst$ssr_entry_name;
     VAR ssr_data_r_pointer: dst$r_pointer);

    VAR
      ssr_data_seq_p: ^SEQ ( * ),
      ssr_segment_number: ost$segment,
      status: ost$status;

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to open the SSR.', ^status);
    IFEND;

    dsp$get_ssr_data_seq_ptr (ssr_entry_name, ssr_segment_number, ssr_data_seq_p);
    dsp$convert_seq_p_to_r_pointer (ssr_data_seq_p, ssr_data_r_pointer);

    dsp$close_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to close the SSR.', ^status);
    IFEND;

  PROCEND dsp$get_ssr_data_r_pointer;
?? TITLE := 'dsp$get_ssr_data_rma', EJECT ??

{ PURPOSE:
{   This procedure retrieves an RMA to specific data in the SSR.

  PROCEDURE [XDCL] dsp$get_ssr_data_rma
    (    ssr_entry_name: dst$ssr_entry_name;
     VAR ssr_data_rma: integer;
     VAR ssr_data_size: integer);

    VAR
      ssr_data_seq_p: ^SEQ ( * ),
      ssr_segment_number: ost$segment,
      status: ost$status;

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to open the SSR.', ^status);
    IFEND;

    dsp$get_ssr_data_seq_ptr (ssr_entry_name, ssr_segment_number, ssr_data_seq_p);
    i#real_memory_address (ssr_data_seq_p, ssr_data_rma);
    ssr_data_size := #SIZE (ssr_data_seq_p^);

    dsp$close_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to close the SSR.', ^status);
    IFEND;

  PROCEND dsp$get_ssr_data_rma;
?? TITLE := 'dsp$get_ssr_data_seq_ptr', EJECT ??

{ PURPOSE:
{   This procedure retrieves a pointer to specific data in the SSR.  This procedure expects the caller to
{   open and close the SSR.

  PROCEDURE [XDCL] dsp$get_ssr_data_seq_ptr
    (    ssr_entry_name: dst$ssr_entry_name;
         ssr_segment_number: ost$segment;
     VAR ssr_data_seq_p: ^SEQ ( * ));

    VAR
      skip_seq_p: ^SEQ ( * ),
      ssr_entry_p: ^dst$ssr_entry,
      ssr_seq_p: ^SEQ ( * );

    access_ssr_segment (ssr_segment_number, ssr_entry_name, ssr_seq_p, ssr_entry_p);

    IF ssr_entry_p^.right_slot > 0 THEN
      NEXT skip_seq_p: [[REP ssr_entry_p^.right_slot OF integer]] IN ssr_seq_p;
    IFEND;
    NEXT ssr_data_seq_p: [[REP ssr_entry_p^.left_slot OF integer]] IN ssr_seq_p;
    RESET ssr_data_seq_p;

  PROCEND dsp$get_ssr_data_seq_ptr;
?? TITLE := 'dsp$make_ssr_segment', EJECT ??

{ PURPOSE:
{   This procedure adds the predefined SSR segment to the NOS/VE job modes segment table.
{ NOTES:
{   The SSR segment is created in the BOOT interrupt handler in that an ASID is chosen and the PTEs are
{   created.  In the BOOT, this segment is added to the boot job segment table as segment four.  In NOS/VE
{   the segment starts out living only in the monitor segment table and in this procedure NOS/VE job mode
{   adds the segment to its segment table.

  PROCEDURE [XDCL] dsp$make_ssr_segment;

    VAR
      ssr_entry_p: ^dst$ssr_entry,
      ssr_segment_number: ost$segment,
      ssr_seq_p: ^SEQ ( * ),
      status: ost$status;

    mmp$create_ssr_sdtx (dsv$ssr_sdte, v$ssr_sdtex);
    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to open the SSR.', ^status);
    IFEND;

    { Make the SSR PVA just to get its true size.

    dsv$ssr_size := 10000(16);
    access_ssr_segment (ssr_segment_number, dsc$ssr_total_length, ssr_seq_p, ssr_entry_p);

    dsv$ssr_size := ssr_entry_p^.left_slot * 8;

    dsp$close_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to close the SSR.', ^status);
    IFEND;

  PROCEND dsp$make_ssr_segment;
?? TITLE := 'dsp$open_ssr', EJECT ??

{ PURPOSE:
{   This procedure adds the SSR to the segment table of the user.

  PROCEDURE [XDCL] dsp$open_ssr
    (VAR ssr_segment_number: ost$segment;
     VAR status: ost$status);

    status.normal := TRUE;
    IF osv$boot_is_executing THEN
      ssr_segment_number := dsc$ssr_segment_number;
    ELSE
      mmp$open_asid_based_segment (dsv$ssr_sdte, v$ssr_sdtex, ssr_segment_number, status);
    IFEND;

  PROCEND dsp$open_ssr;
?? TITLE := 'dsp$store_data_in_ssr', EJECT ??

{ PURPOSE:
{   This procedure stores data in the specified SSR entry.  The caller of this procedure should use the #SEQ
{   function so that they do not have to set up a sequence.
{     EXAMPLE:  dsp$store_data_in_ssr (ssr_entry_name, #SEQ (data_variable));

  PROCEDURE [XDCL] dsp$store_data_in_ssr
    (    ssr_entry_name: dst$ssr_entry_name;
         ssr_value_p: ^SEQ ( * ));

    VAR
      data_seq_p: ^SEQ ( * ),
      skip_seq_p: ^SEQ ( * ),
      ssr_entry_p: ^dst$ssr_entry,
      ssr_segment_number: ost$segment,
      ssr_seq_p: ^SEQ ( * ),
      ssr_value_seq_p: ^SEQ ( * ),
      status: ost$status;

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to open the SSR.', ^status);
    IFEND;

    access_ssr_segment (ssr_segment_number, ssr_entry_name, ssr_seq_p, ssr_entry_p);

    IF ssr_entry_p^.right_slot > 0 THEN
      NEXT skip_seq_p: [[REP ssr_entry_p^.right_slot OF integer]] IN ssr_seq_p;
    IFEND;
    NEXT ssr_value_seq_p: [[REP ssr_entry_p^.left_slot OF integer]] IN ssr_seq_p;
    RESET ssr_value_seq_p;

    { Move the data from the parameter sequence pointer to the SSR entry.

    IF #SIZE (ssr_value_p^) > #SIZE (ssr_value_seq_p^) THEN
      osp$system_error (' Trying to store too large a data item in the SSR area', NIL);
    IFEND;
    NEXT data_seq_p: [[REP #SIZE (ssr_value_p^) OF cell]] IN ssr_value_seq_p;
    data_seq_p^ := ssr_value_p^;

    dsp$close_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to close the SSR.', ^status);
    IFEND;

  PROCEND dsp$store_data_in_ssr;
?? TITLE := 'dsp$store_entry_in_ssr', EJECT ??

{ PURPOSE:
{   This procedure stores an entry in the SSR.

  PROCEDURE [XDCL] dsp$store_entry_in_ssr
    (    ssr_entry_name: dst$ssr_entry_name;
         ssr_entry_type: dst$ssr_entry_types;
         ssr_entry: dst$ssr_entry);

    VAR
      ssr_entry_p: ^dst$ssr_entry,
      ssr_segment_number: ost$segment,
      ssr_seq_p: ^SEQ ( * ),
      status: ost$status;

    dsp$open_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to open the SSR.', ^status);
    IFEND;

    access_ssr_segment (ssr_segment_number, ssr_entry_name, ssr_seq_p, ssr_entry_p);

    IF ssr_entry_type = dsc$ssr_left_slot THEN
      ssr_entry_p^.left_slot := ssr_entry.left_slot;
    ELSEIF ssr_entry_type = dsc$ssr_right_slot THEN
      ssr_entry_p^.right_slot := ssr_entry.right_slot;
    ELSE
      ssr_entry_p^.whole_slot := ssr_entry.whole_slot;
    IFEND;

    dsp$close_ssr (ssr_segment_number, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to close the SSR.', ^status);
    IFEND;

  PROCEND dsp$store_entry_in_ssr;
MODEND dsm$manage_ssr_routines;
