?? NEWTITLE := '~~~~~   common deck DSI$C170_ACCESS_TO_SSR', EJECT ??

{  SSR access routines, deck DSI$C170_ACCESS_TO_SSR.

*copyc dsc$ssr_entry_constants

  PROCEDURE get_ssr_data
    (    ssr_offset: integer;
         buffer: ^cell;
         length: integer);

    VAR
      ssr_copy_info: memory_copy_header;

    ssr_copy_info.length := length;
    ssr_copy_info.copy_method := ve64_to_nos32;
    ssr_copy_info.pva_type := start_of_ssr;
    ssr_copy_info.byte_rma := ssr_offset;
    copy_memory (ssr_copy_info, buffer);

  PROCEND get_ssr_data;
?? SKIP := 3 ??

  PROCEDURE store_ssr_data
    (    ssr_offset: integer;
         buffer: ^cell;
         length: integer);

    VAR
      ssr_copy_info: memory_copy_header;

    ssr_copy_info.length := length;
    ssr_copy_info.copy_method := nos32_to_ve64;
    ssr_copy_info.pva_type := start_of_ssr;
    ssr_copy_info.byte_rma := ssr_offset;
    copy_memory (ssr_copy_info, buffer);

  PROCEND store_ssr_data;
?? SKIP := 3 ??

  PROCEDURE [XDCL] find_ssr_entry ALIAS 'dspfind'
    (    name: string (4);
     VAR ssr_offset: integer);

    VAR
      i: integer,
      ssr_length: [STATIC] integer := 0,
      ascii_name: 0 .. 0ffffffff(16),
      directory: ^ARRAY [1 .. * ] OF integer;

    IF ssr_length = 0 THEN
      get_ssr_data (4, ^i, 1);
      ssr_length := i DIV left_slot * 2;
      IF (ssr_length = 0) OR (ssr_length > 100) THEN
        error_processor (invalid_ssr, fatal_error);
      IFEND;
      IF (ssr_length = 0) OR (ssr_length > 100) THEN
        error_processor (invalid_ssr, fatal_error);
      IFEND;
    IFEND;

    PUSH directory: [1 .. ssr_length];
    get_ssr_data (0, directory, ssr_length);

    ascii_name := $INTEGER (name (1)) * 1000000(16) + $INTEGER (name (2)) *
          10000(16) + $INTEGER (name (3)) * 100(16) + $INTEGER (name (4));

    i := 1;
    WHILE directory^ [i] <> ascii_name DO
      i := i + 2;
      IF i > ssr_length THEN
        error_processor (incorrect_ssr_set_operation, fatal_error);
      IFEND;
    WHILEND;
    ssr_offset := (i - 1) * 4;

  PROCEND find_ssr_entry;
?? SKIP := 3 ??

  PROCEDURE [XDCL] set_ssr_directory_entry ALIAS 'dspsets'
    (    ssr_offset: integer;
         new_left: 0 .. 0ffff(16);
         new_right: 0 .. 0ffff(16));

    VAR
      half_word: 0 .. 0ffffffff(16);

    half_word := new_left * left_slot + new_right;
    store_ssr_data (ssr_offset + 4, ^half_word, 1);

  PROCEND set_ssr_directory_entry;
?? SKIP := 3 ??

  PROCEDURE [XDCL] get_ssr_directory_entry ALIAS 'dspgets'
    (    ssr_offset: integer;
     VAR old_left: integer;
     VAR old_right: integer);

    VAR
      half_word: 0 .. 0ffffffff(16);

    get_ssr_data (ssr_offset + 4, ^half_word, 1);
    old_left := half_word DIV left_slot;
    old_right := half_word MOD left_slot;

  PROCEND get_ssr_directory_entry;
?? OLDTITLE ??
