
MODULE mlm$c170_helper;
*copyc OSD$DEFAULT_PRAGMATS
?? SET (LIST := OFF) ??
*copyc MLD$MEMORY_LINK_DECLARATIONS
*copyc MLT$ANT_ENTRY
*copyc MTXMS
*copyc OST$STATUS
*copyc TMT$RB_READY_TASK
*copyc mmp$free_pages
*copyc tmp$set_task_priority
*copyc SYC$MONITOR_REQUEST_CODES
*copyc I#CALL_MONITOR
*copyc osp$set_mainframe_sig_lock
*copyc osp$clear_mainframe_sig_lock
*copyc jmc$special_dispatch_priorities
*copyc osp$free_heap_pages
*copyc PMP$GET_EXECUTING_TASK_GTID
*copyc PMP$ZERO_OUT_TABLE
?? SET (LIST := ON) ??

*copyc osp$fetch_locked_variable
*copyc osp$set_locked_variable
*copyc MLT$C170_RQST_BLK

  VAR
    mlv$debug: [XREF] boolean,
    mlv$170_count: [XREF] integer,
    mlv$170_time: [XREF] integer,
    mlv$wire_mli_tables: [XDCL] boolean := FALSE,
    mlv$lock: [XREF] ost$signature_lock,
    mlv$rb_ready_task: [XREF] tmt$rb_ready_task,
    mlv$polling_delay: [XREF] integer,
{    str: string (46) := '                     ',
{    str_p: integer := 1,
    status: ost$status,
    mlv$c170_rqst_blk: [XREF] mlt$c170_rqst_blk,
    sn: mlt$system_name,
    current_request: integer,
    mlv$enabled: [XREF] boolean,
    onoff: boolean,
    mlv$count: integer := 0,
    mlv$stream: integer := 0,
    mlv$last_available: [XDCL, #GATE] integer := initial_buffer_count - 1,
    mlv$expand_count: [XDCL, #GATE] integer := 200,
    mlv$shrink_count: [XDCL, #GATE] integer := 20,
    check_count,
    check_time: integer := 0,
    mlv$s,
    mlv$e: [XDCL, #GATE] integer := 0,
    mlv$shared_segment: [XREF] mlt$shared_segment;

  PROCEDURE [XREF] mlp$kill (sn: mlt$system_name;
    VAR status: ost$status);
*copyc I#PROGRAM_ERROR
{*callc pmxlogj
{*callc rpmbina

{  PROCEDURE pt (s: string ( * );
{    done: boolean);
{
{    VAR
{      i: integer,
{      st: ost$status;
{
{    i := STRLENGTH (s);
{    str (str_p, i) := s (1, * );
{    str_p := str_p + i;
{    IF done THEN
{      { pmp$log (str, st);
{      str (1, * ) := '          ';
{      str_p := 1;
{    IFEND;
{  PROCEND pt;
{
{  PROCEDURE pi (val: integer;
{    done: boolean);
{
{    VAR
{      st: ost$status;
{
{    pmp$binary_to_ascii (val, str, 8, str_p + 21);
{    str_p := str_p + 21;
{    IF done THEN
{      { pmp$log (str, st);
{      str (1, * ) := '         ';
{      str_p := 1;
{    IFEND;
{  PROCEND pi;

?? EJECT ??

  PROCEDURE [XDCL, #GATE] mlp$initialize_helper;

    VAR
      status: ost$status;

    IF NOT mlv$enabled THEN
      RETURN;
    IFEND;
{
{ save helper taskid for use by eie
{ raise helper task priority
{
    pmp$get_executing_task_gtid (mlv$rb_ready_task.task_id);
    mlv$shared_segment.dust_id := mlv$rb_ready_task.task_id;
    tmp$set_task_priority (jmc$priority_mli_helper, 0, status);
    mlv$rb_ready_task.reqcode := syc$rc_ready_task;
    mlv$c170_rqst_blk.req := ^mlv$rb_ready_task;
    check_time := #free_running_clock (0);
  PROCEND mlp$initialize_helper;
?? EJECT ??

  PROCEDURE [XDCL, #GATE] mlp$help_c170;

    VAR
      time: integer,
      status: ost$status,
      actual,
      result,
      num: integer,
      op_status_value: integer,
      actual_op_status: integer,
      op_status_locked: boolean,
      none: boolean;

    num := 0;
    mtv$mli_status.wait_inhibit := FALSE;
    REPEAT
      none := TRUE;
      FOR current_request := 0 TO mlimi - 1 DO
        osp$fetch_locked_variable(mlv$c170_rqst_blk.arr [current_request].op_status,
             op_status_value);
        IF op_status_value = wait180 THEN
{
{ process the mli request
{
          mlp$front_end;
          mlv$count := mlv$count + 1;
          num := num + 1;
          time := #free_running_clock (0);
          mlv$c170_rqst_blk.arr [current_request].time := time;

{ set the current entry op_status to wait for 170

          osp$set_locked_variable (mlv$c170_rqst_blk.arr [current_request].op_status,
                wait180, wait170, actual_op_status, op_status_locked);
          IF NOT op_status_locked THEN
            osp$set_locked_variable (mlv$c170_rqst_blk.arr [current_request].op_status,
                  actual_op_status, wait170, actual_op_status, op_status_locked);
          IFEND;
        IFEND;
      FOREND;
    UNTIL none;
    IF num > 1 THEN
      mlv$stream := mlv$stream + num;
    IFEND;

{ check for expand/shrink every 2 minutes

    IF #free_running_clock (0) - check_time > 120000000 THEN
      IF mlv$wire_mli_tables THEN
        osp$set_mainframe_sig_lock (mlv$lock);
        osp$free_heap_pages (#LOC (mlv$shared_segment.pspace));
        osp$clear_mainframe_sig_lock (mlv$lock);
      IFEND;
      check_time := #free_running_clock (0);
      IF mlv$c170_rqst_blk.arr [mlv$last_available].used - check_count <
            mlv$shrink_count THEN
        IF mlv$last_available > (initial_buffer_count - 1) THEN
          #compare_swap (mlv$c170_rqst_blk.arr [mlv$last_available].op_status,
                idle, not_available, actual, result);
          IF result = 0 THEN
            mlv$s := mlv$s + 1;
            mlv$last_available := mlv$last_available - 1;
            mmp$free_pages (#LOC (mlv$c170_rqst_blk.buffers^
                  [mlv$last_available + 1]), (mlimi - (mlv$last_available + 1))
                  * (mlc$max_message_length + 1), osc$nowait, status);
            check_count := mlv$c170_rqst_blk.arr [mlv$last_available].used;
          IFEND;
        IFEND;
      IFEND;
      IF mlv$c170_rqst_blk.arr [mlv$last_available].used - check_count >
            mlv$expand_count THEN
        IF mlv$last_available < (mlimi - 1) THEN
          mlv$last_available := mlv$last_available + 1;
          mlv$e := mlv$e + 1;
          pmp$zero_out_table (#LOC (mlv$c170_rqst_blk.buffers^
                [mlv$last_available]), mlc$max_message_length + 1);
          mlv$c170_rqst_blk.arr [mlv$last_available].used := 0;
          mlv$c170_rqst_blk.arr [mlv$last_available].op_status := idle;
        IFEND;
      IFEND;
      check_count := mlv$c170_rqst_blk.arr [mlv$last_available].used;
    IFEND;

  PROCEND mlp$help_c170;

?? EJECT ??

  PROCEDURE mlp$front_end;
?? SET (LIST := OFF) ??
*copyc MLP$SIGN_ON_OS
?? SET (LIST := ON) ??

    VAR
      i: integer,
      time: integer,
      rl: ^mlt$receive_list,
      unique: ^mlt$application_name,
      psig: mlt$signal,
      rc: mlt$receive_count,
      pc: ^cell,
      ml: mlt$message_length,
      cond: ost$status_condition,
      ost: ost$status;

  /mli/
    BEGIN
      mlv$c170_rqst_blk.arr [current_request].copy_length := 0;
      onoff := FALSE;
      CASE mlv$c170_rqst_blk.arr [current_request].mli_packet [funct] OF
      = signon =
        onoff := TRUE;
        IF mlv$c170_rqst_blk.arr [current_request].jsn MOD 100(16) = 7 THEN
          mlp$sign_on_os (mlv$c170_rqst_blk.arr [current_request].mli_packet
                [aname], mlv$c170_rqst_blk.arr [current_request].mli_packet
                [maxmsg], mlv$c170_rqst_blk.arr [current_request].mli_packet
                [mlpv1], ost);
        ELSE
          ost.condition := mlc$illegal_function;
          EXIT /mli/;
        IFEND;
      = signoff =
        onoff := TRUE;
        IF mlv$c170_rqst_blk.arr [current_request].jsn MOD 100(16) = 7 THEN
          mlp$sign_off_os (mlv$c170_rqst_blk.arr [current_request].mli_packet
                [aname], ost);
        ELSE
          ost.condition := mlc$illegal_function;
          EXIT /mli/;
        IFEND;
      = addspl =
        mlp$add_sender_os (mlv$c170_rqst_blk.arr [current_request].mli_packet
              [aname], mlv$c170_rqst_blk.arr [current_request].mli_packet
              [sname], ost);
      = delspl =
        mlp$delete_sender_os (mlv$c170_rqst_blk.arr [current_request].
              mli_packet [aname], mlv$c170_rqst_blk.arr [current_request].
              mli_packet [sname], ost);
      = confirm =
        mlp$confirm_send_os (mlv$c170_rqst_blk.arr [current_request].mli_packet
              [aname], mlv$c170_rqst_blk.arr [current_request].mli_packet
              [sname], ost);
      = send =
        IF mlv$c170_rqst_blk.arr [current_request].mli_packet [signal] <>
              1ffff(16) THEN
          psig := #LOC (mlv$c170_rqst_blk.arr [current_request].mli_packet
                [mlpsv]);
        ELSE
          psig := NIL;
        IFEND;
        pc := #LOC (mlv$c170_rqst_blk.buffers^ [current_request]);
        mlp$send_message_os (mlv$c170_rqst_blk.arr [current_request].mli_packet
              [aname], mlv$c170_rqst_blk.arr [current_request].mli_packet
              [arbinfo], psig, pc, mlv$c170_rqst_blk.arr [current_request].
              mli_packet [buflen] * 8, mlv$c170_rqst_blk.arr [current_request].
              mli_packet [sname], ost);
        time := #free_running_clock (0);
        mlv$170_count := mlv$170_count + 1;
        mlv$170_time := mlv$170_time + (time - mlv$c170_rqst_blk.arr
              [current_request].time);
      = fetchrl =
        rl := #LOC (mlv$c170_rqst_blk.buffers^ [current_request]);
        rc := 0;
        mlp$fetch_receive_list_os (mlv$c170_rqst_blk.arr [current_request].
              mli_packet [aname], mlv$c170_rqst_blk.arr [current_request].
              mli_packet [sname], rl^, rc, ost);
        mlv$c170_rqst_blk.arr [current_request].mli_packet [mlpv1] := rc;
        mlv$c170_rqst_blk.arr [current_request].copy_length := (rc * #SIZE
              (mlt$receive_entry)) DIV 8;
        FOR i := 1 TO rc DO
          IF (rl^ [i].message_length MOD 8) = 0 THEN
            rl^ [i].message_length := rl^ [i].message_length DIV 8;
          ELSE
            rl^ [i].message_length := (rl^ [i].message_length DIV 8) + 1;
          IFEND;
        FOREND;
        IF rc > 0 THEN
          time := #free_running_clock (0);
          mlv$170_count := mlv$170_count + 1;
          mlv$170_time := mlv$170_time + (time - mlv$c170_rqst_blk.arr
                [current_request].time);
        IFEND;
      = receive =
        pc := #LOC (mlv$c170_rqst_blk.buffers^ [current_request]);
        IF mlv$c170_rqst_blk.arr [current_request].mli_packet [signal] <>
              1ffff(16) THEN
          psig := #LOC (mlv$c170_rqst_blk.arr [current_request].mli_packet
                [mlpsv]);
        ELSE
          psig := NIL;
        IFEND;
        ml := 0;
        mlp$receive_message_os (mlv$c170_rqst_blk.arr [current_request].
              mli_packet [aname], mlv$c170_rqst_blk.arr [current_request].
              mli_packet [mlpv2], psig, pc, ml, mlv$c170_rqst_blk.arr
              [current_request].mli_packet [buflen] * 8, mlv$c170_rqst_blk.arr
              [current_request].mli_packet [rindex], mlv$c170_rqst_blk.arr
              [current_request].mli_packet [mlpv3], ost);
        IF (ml MOD 8) = 0 THEN
          ml := ml DIV 8;
        ELSE
          ml := (ml DIV 8) + 1;
        IFEND;
        mlv$c170_rqst_blk.arr [current_request].copy_length := ml;
        IF (ost.normal) OR ((NOT ost.normal) AND (ost.condition =
              mlc$message_truncated)) THEN
          mlv$c170_rqst_blk.arr [current_request].mli_packet [mlpv1] := ml;
        IFEND;
        IF ml > 0 THEN
          time := #free_running_clock (0);
          mlv$170_count := mlv$170_count + 1;
          mlv$170_time := mlv$170_time + (time - mlv$c170_rqst_blk.arr
                [current_request].time);
        IFEND;
      = kill =
        IF mlv$c170_rqst_blk.arr [current_request].jsn MOD 100(16) = 7 THEN
          sn.c170_c180_flag := c170;
          sn.name_170 := mlv$c170_rqst_blk.arr [current_request].mli_packet
                [jsn] * 40(16);
          mlp$kill (sn, ost);
          FOR i := 0 TO mlimi - 1 DO
            IF mlv$c170_rqst_blk.arr [i].jsn DIV 100000(16) =
                  mlv$c170_rqst_blk.arr [current_request].mli_packet [jsn] THEN
              mlv$c170_rqst_blk.arr [i].op_status := idle;
            IFEND;
          FOREND;
        ELSE
          ost.condition := mlc$illegal_function;
          EXIT /mli/;
        IFEND;
      = kill_all =
        IF mlv$c170_rqst_blk.arr [current_request].jsn MOD 100(16) = 7 THEN
          sn.c170_c180_flag := c170;
          sn.name_170 := 0;
          mlp$kill (sn, ost);
          FOR i := 0 TO mlimi - 1 DO
            IF i <> current_request THEN
              mlv$c170_rqst_blk.arr [i].op_status := idle;
            IFEND;
          FOREND;
{          pt (' mlihelp - kill all a170', TRUE);
        ELSE
          ost.condition := mlc$illegal_function;
          EXIT /mli/;
        IFEND;
      ELSE
{
{ illegal mli function call
{
        ost.condition := mlc$illegal_function;
      CASEND;
    END /mli/;
    mlv$c170_rqst_blk.arr [current_request].mli_packet [mlpsv] := ost.
          condition;
  PROCEND mlp$front_end;
?? EJECT ??

  PROCEDURE [XDCL] mlp$get_c170_jobname (VAR jn: integer);

    jn := mlv$c170_rqst_blk.arr [current_request].jsn DIV 100000(16);
    IF onoff THEN
      IF mlv$c170_rqst_blk.arr [current_request].mli_packet [jsn] <> 0 THEN
        jn := mlv$c170_rqst_blk.arr [current_request].mli_packet [jsn];
      IFEND;
    IFEND;
    jn := jn * 40(16);

  PROCEND mlp$get_c170_jobname;
MODEND mlm$c170_helper
