MODULE dsm$fake_cm_interface ALIAS 'DSMFCI';

*copy pxiotyp
?? PUSH (LISTEXT := ON) ??
*copy pxziobs
*copy dizclos
*copy dizopen
*copy dizput
*copy dizgetd
*copy dizputd
*copy dizfirs
*copy zutpabt
*copy zutpmsg
?? POP ??

  TYPE
    big_type = packed record
      case integer of
      = 0 =
        w0: 0 .. 0ffffffff(16),
        l0: 0 .. 0fffffff(16),
      = 1 =
        t1: 0 .. 0f(16),
        w1: 0 .. 0ffffffff(16),
        l1: 0 .. 0ffffff(16),
      = 2 =
        t2: 0 .. 0ff(16),
        w2: 0 .. 0ffffffff(16),
        l2: 0 .. 0fffff(16),
      = 3 =
        t3: 0 .. 0fff(16),
        w3: 0 .. 0ffffffff(16),
        l3: 0 .. 0ffff(16),
      = 4 =
        t4: 0 .. 0ffff(16),
        w4: 0 .. 0ffffffff(16),
        l4: 0 .. 0fff(16),
      = 5 =
        t5: 0 .. 0ffff(16),
        w5: 0 .. 0ffffffff(16),
        l5: 0 .. 0ff(16),
      = 6 =
        t6: 0 .. 0ffffff(16),
        w6: 0 .. 0ffffffff(16),
        l6: 0 .. 0f(16),
      = 7 =
        t7: 0 .. 0fffffff(16),
        w7: 0 .. 0ffffffff(16),
      = 8 =
        i: integer,
      casend,
    recend;

  PROCEDURE string_number (s: string ( * );
        number: integer);

    VAR
      msg: ^string ( * ),
      n: integer,
      i: integer;

    i := STRLENGTH (s);
    PUSH msg: [i + 10];
    msg^ := s;
    STRINGREP (msg^ (i + 1, 10), n, number);
    utp$issue_dayfile_message (msg^);
  PROCEND string_number;
?? NEWTITLE := '  Simulate 017 interface', EJECT ??
{*********************************************************}
{}
{ simulate 017 requests.
{}
{*********************************************************}

  CONST
    dayfile_display = 0,
    control_point_display = 1;

  TYPE
    deadstart_type = (start_dual_state, term_dual_state);

  VAR
    running: integer := 0,
    exitcd: [XREF] integer;

  PROCEDURE [XDCL] wakeup;
  PROCEND wakeup;

  PROCEDURE [XDCL] deadstart_cpu ALIAS 'dstcpu' (kind: deadstart_type);
    utp$issue_dayfile_message ('deadstart cpu');
    utp$abort;
    IF kind = start_dual_state THEN
      running := 1;
    ELSE
      running := 0;
    IFEND;
    exitcd := running;
  PROCEND deadstart_cpu;

  PROCEDURE [XDCL] get_ve_status ALIAS 'getvest' (VAR status: integer);
    utp$issue_dayfile_message ('get ve status');
    exitcd := running;
    status := 1;
  PROCEND get_ve_status;

?? OLDTITLE ??

?? NEWTITLE := '  Central memory access routines', EJECT ??
{********************************************************}
{}
{Central memory access routines}
{}
{********************************************************}

  CONST
    max_memory_transfer = 30000;

  TYPE
    cm_transfer_method = (nos60_to_ve64, ve64_to_nos60, nos32_to_ve64,
      ve64_to_nos32, nos60_to_ve60, ve60_to_nos60, zero60_to_ve64),
    starting_pva = (interface_block, start_of_ve, start_of_ssr,
      start_of_mf_wired),
    memory_copy_header = record
      length: 0 .. max_memory_transfer,
      copy_method: cm_transfer_method,
      pva_type: starting_pva,
      byte_rma: 0 .. 0ffffffff(16),
    recend;

  VAR
    memory: file := NIL,
    pvas: array [starting_pva] of integer := [60320(8), 0, 0, 0],
    plen: array [starting_pva] of integer := [61320(8), 0, 0, 0];


  PROCEDURE [XREF] abort;

  PROCEDURE [XDCL] copy_memory ALIAS 'minilnk' (VAR hdr: memory_copy_header;
        buffer_pointer: ^cell);

    VAR
      ba: ^array [1 .. 2100] of integer,
      update: boolean,
      start: integer,
      last: integer,
      length: integer,
      size: integer,
      byte_rma: integer,
      byte_length: integer,
      buf: ^array [1 .. * ] of integer,
      ip: ^integer,
      nibble: integer,
      v: integer,
      b: big_type,
      n: integer,
      j: integer,
      i: integer;

    IF memory = NIL THEN
      utp$issue_dayfile_message ('build cm file');
      di#open (memory, 'cmimage', new#, concurrent#, first#);
      PUSH ba;
      FOR i := 1 TO 4000(8) DO
        ba^ [i] := 0;
      FOREND;
      FOR i := 1 TO osmin DIV 20000(8) DO
        di#put (memory, j, ba, 4000(8));
      FOREND;
      FOR i := 1 TO 4000(8) DO
        ba^ [i] := 0ffffffff(16);
      FOREND;
      FOR i := 1 TO (velwa - osmin) DIV 20000(8) DO
        di#put (memory, j, ba, 4000(8));
      FOREND;
    IFEND;

    byte_rma := hdr.byte_rma + pvas [hdr.pva_type];
    start := byte_rma DIV 4 * 4;
    length := hdr.length;
    CASE hdr.copy_method OF
    = nos60_to_ve60, ve60_to_nos60, zero60_to_ve64 =
      byte_length := length * 8;
    = nos32_to_ve64, ve64_to_nos32 =
      byte_length := length * 4;
    = nos60_to_ve64, ve64_to_nos60 =
      byte_length := length DIV 2 * 15;
    CASEND;

    update := FALSE;

    last := (byte_rma + byte_length + 3) DIV 4 * 4;
    IF last > plen [hdr.pva_type] THEN
      utp$issue_dayfile_message ('bad cm request');
      string_number ('length ', hdr.length);
      string_number ('offset ', hdr.byte_rma);
      string_number ('method ', $INTEGER (hdr.copy_method));
      string_number ('pva    ', $INTEGER (hdr.pva_type));
      abort;
      utp$abort;
      RETURN;
    IFEND;

    size := (last - start) DIV 4;
    PUSH buf: [1 .. size + 1];

    di#getdir (memory, start DIV 4, buf, size);

    ba := buffer_pointer;
    ip := #LOC (ba);

    CASE hdr.copy_method OF

    = zero60_to_ve64 =
      update := TRUE;
      string_number ('transfer z60v64', byte_rma);
      FOR i := 1 TO length DO
        buf^ [2 * i] := 0;
        buf^ [2 * i - 1] := 0;
      FOREND;

    = nos60_to_ve60 =
      update := TRUE;
      string_number ('transfer n60v60', byte_rma);
      FOR i := 1 TO length DO
        b.i := ba^ [i];
        buf^ [2 * i] := b.w7;
        buf^ [2 * i - 1] := b.t7;
      FOREND;

    = ve60_to_nos60 =
      string_number ('transfer v60n60', byte_rma);
      FOR i := 1 TO length DO
        b.t7 := buf^ [2 * i - 1] MOD 10000000(16);
        b.w7 := buf^ [2 * i];
        ba^ [i] := b.i;
      FOREND;

    = nos32_to_ve64 =
      update := TRUE;
      string_number ('transfer n32v64', byte_rma);
      FOR i := 1 TO length DO
        buf^ [i] := ba^ [i];
      FOREND;

    = ve64_to_nos32 =
      string_number ('transfer v64n32', byte_rma);
      FOR i := 1 TO length DO
        ba^ [i] := buf^ [i];
      FOREND;

    = nos60_to_ve64 =
      update := TRUE;
      string_number ('transfer n60v64', byte_rma);
      nibble := byte_rma MOD 4;
      b.i := buf^ [1];
      CASE nibble OF
      = 2 =
        b.l1 := 0;
        j := 2;
        nibble := 6;
      = 4 =
        b.l3 := 0;
        j := 2;
        nibble := 4;
      = 6 =
        b.l5 := 0;
        j := 2;
        nibble := 2;
      = 0 =
        j := 1;
      CASEND;
      n := b.i;

      FOR i := 1 TO length DO
        b.i := ba^ [i];
        CASE nibble OF
        = 0 =
          buf^ [j] := b.w0;
          n := b.l0 * 10(16);
          j := j + 1;
        = 1 =
          buf^ [j] := n + b.t1;
          buf^ [j + 1] := b.w1;
          n := b.l1 * 100(16);
          j := j + 2;
        = 2 =
          buf^ [j] := n + b.t2;
          buf^ [j + 1] := b.w2;
          n := b.l2 * 1000(16);
          j := j + 2;
        = 3 =
          buf^ [j] := n + b.t3;
          buf^ [j + 1] := b.w3;
          n := b.l3 * 10000(16);
          j := j + 2;
        = 4 =
          buf^ [j] := n + b.t4;
          buf^ [j + 1] := b.w4;
          n := b.l4 * 100000(16);
          j := j + 2;
        = 5 =
          buf^ [j] := n + b.t5;
          buf^ [j + 1] := b.w5;
          n := b.l5 * 1000000(16);
          j := j + 2;
        = 6 =
          buf^ [j] := n + b.t6;
          buf^ [j + 1] := b.w6;
          n := b.l6 * 10000000(16);
          j := j + 2;
        = 7 =
          buf^ [j] := n + b.t7;
          buf^ [j + 1] := b.w7;
          j := j + 2;
        CASEND;
        nibble := (nibble + 1) MOD 8;
      FOREND;

      b.i := buf^ [j];
      CASE nibble OF
      = 0 =
        ;
      = 1 =
        buf^ [j] := n + b.l6;
      = 2 =
        buf^ [j] := n + b.l5;
      = 3 =
        buf^ [j] := n + b.l4;
      = 4 =
        buf^ [j] := n + b.l3;
      = 5 =
        buf^ [j] := n + b.l2;
      = 6 =
        buf^ [j] := n + b.l1;
      = 7 =
        buf^ [j] := n + b.l0;
      CASEND;


    = ve64_to_nos60 =
      string_number ('transfer v64n60', byte_rma);
      nibble := byte_rma MOD 4;

      CASE nibble OF
      = 0 =
        j := 1;
        nibble := 0;
      = 1 =
        n := buf^ [1] MOD 100(16);
        j := 2;
        nibble := 6;
      = 2 =
        n := buf^ [1] MOD 10000(16);
        j := 2;
        nibble := 4;
      = 3 =
        n := buf^ [1] MOD 1000000(16);
        j := 2;
        nibble := 2;
      CASEND;

      FOR i := 1 TO length DO
        CASE nibble OF
        = 0 =
          n := buf^ [j + 1];
          b.w0 := buf^ [j];
          b.l0 := n DIV 10(16);
          v := n MOD 10(16);
          j := j + 2;
        = 1 =
          n := buf^ [j + 1];
          b.t1 := v;
          b.w1 := buf^ [j];
          b.l1 := n DIV 100(16);
          v := n MOD 100(16);
          j := j + 2;
        = 2 =
          n := buf^ [j + 1];
          b.t2 := v;
          b.w2 := buf^ [j];
          b.l2 := n DIV 1000(16);
          v := n MOD 1000(16);
          j := j + 2;
        = 3 =
          n := buf^ [j + 1];
          b.t3 := v;
          b.w3 := buf^ [j];
          b.l3 := n DIV 10000(16);
          v := n MOD 10000(16);
          j := j + 2;
        = 4 =
          n := buf^ [j + 1];
          b.t4 := v;
          b.w4 := buf^ [j];
          b.l4 := n DIV 100000(16);
          v := n MOD 100000(16);
          j := j + 2;
        = 5 =
          n := buf^ [j + 1];
          b.t5 := v;
          b.w5 := buf^ [j];
          b.l5 := n DIV 1000000(16);
          v := n MOD 1000000(16);
          j := j + 2;
        = 6 =
          n := buf^ [j + 1];
          b.t6 := v;
          b.w6 := buf^ [j];
          b.l6 := n DIV 10000000(16);
          v := n MOD 10000000(16);
          j := j + 2;
        = 7 =
          b.i := v * 100000000(16) + buf^ [j];
          j := j + 1;
        CASEND;
        ba^ [i] := b.i;
        nibble := (nibble + 1) MOD 8;
      FOREND;
    CASEND;

    IF update THEN
      di#putdir (memory, start DIV 4, buf, size);
      di#first (memory);
    IFEND;
  PROCEND copy_memory;

  PROCEDURE [XDCL] set_ei_pva ALIAS 'seteiad' (pva: starting_pva;
        word_offset: integer);
    string_number ('set ei pva ', $INTEGER (pva));
    string_number ('  offset = ', word_offset * 8);
    pvas [pva] := word_offset * 8;
    plen [pva] := velwa;
  PROCEND set_ei_pva;

  PROCEDURE [XDCL] get_ei_pva ALIAS 'geteiad' (pva: starting_pva;
    VAR word_offset: integer);
    utp$issue_dayfile_message ('get ei address');
    word_offset := pvas [pva];
  PROCEND get_ei_pva;
?? OLDTITLE ??

?? NEWTITLE := '  Simulated VER interface', EJECT ??
{***********************************************************}
{}
{Interface to 170 OS virtual environment resource program.}
{}
{************************************************************}

  TYPE
    a170pps = packed record
      pp_number: 0 .. 77(8),
      fill: 0 .. 77777777777777(8),
      status: 0 .. 7777(8),
    recend,
    a170_channels = packed record
      channel: 0 .. 77(8),
      fill: 0 .. 77777777777777(8),
      status: 0 .. 7777(8),
    recend,
    eq_path = packed record
      channel: 0 .. 77(8),
      equipment: 0 .. 77(8),
      unit: 0 .. 77(8),
      fill: 0 .. 7777777777(8),
      status: 0 .. 7777(8),
      fil1: 0 .. 77777777(8),
      equipment_type: 0 .. 7777(8),
      fil2: 0 .. 77777(8),
      est_ordinal: 0 .. 777(8),
    recend,
    cm_request_type = packed record
      fill1: 0 .. 77777777777777(8),
      words_div_1000: 0 .. 777777(8),
      fill2: 0 .. 7777(8),
      fwa_div_1000: 0 .. 77777777(8),
      lwa_div_1000: 0 .. 77777777(8),
    recend,
    resource_status_type = packed record
      fill1: 0 .. 77777777777777(8),
      available_words_div_1000: 0 .. 777777(8),
      fill2: 0 .. 777777777777(8),
      fill3: 0 .. 777777(8),
      available_pps: 0 .. 77(8),
    recend,
    ver_functions = (rscm, rspp, rsch, rseq, rtcm, rtpp, rtch, rteq, stcm,
      stpp, stch, steq, stmr),
    ver_request_block = packed record
      return_all: boolean,
      fill: 0 .. 377777777777(8),
      length: 0 .. 7777(8),
      general_status: 0 .. 7777(8),
      case ver_functions of
      = rscm, rtcm, stcm =
        cm_block: cm_request_type,
      = stmr =
        resources: resource_status_type,
      = rspp, rtpp, stpp =
        pp_list: array [1 .. 20] of a170pps,
      = rsch, rtch, stch =
        channel_list: array [1 .. 20] of a170_channels,
      = rseq, rteq, steq =
        eq_list: array [1 .. 10] of eq_path,
      casend,
    recend;

  TYPE
    ch_set = set of 0 .. 37(8),
    pp_set = set of 0 .. 37(8);

  VAR
    next_pp: integer := 2,
    chs: ch_set := [],
    pps: pp_set := [],
    vefwa: integer := 3ec000(16),
    velwa: integer := 3ec000(16),
    osmin: integer := 100000(16);


  PROCEDURE [XDCL] callver (VAR ver_request: ver_request_block;
        operation: ver_functions;
        wait: boolean);

    VAR
      i: integer,
      avail: integer;

    utp$issue_dayfile_message ('call ver');
    ver_request.general_status := 1;
    CASE operation OF
    = rscm =
      avail := vefwa - osmin;
      IF ver_request.cm_block.words_div_1000 <= (avail DIV 10000(8)) THEN
        vefwa := vefwa - ver_request.cm_block.words_div_1000 * 10000(8);
        ver_request.cm_block.fwa_div_1000 := vefwa DIV 10000(8);
        ver_request.cm_block.lwa_div_1000 := velwa DIV 10000(8);
      ELSE
        ver_request.general_status := 40(8);
      IFEND;

    = rtcm =
      avail := velwa - vefwa;
      IF ver_request.return_all THEN
        ver_request.cm_block.words_div_1000 := avail DIV 10000(8);
      ELSEIF ver_request.cm_block.words_div_1000 > (avail DIV 10000(8)) THEN
        ver_request.cm_block.words_div_1000 := 0;
        ver_request.general_status := 41(8);
        RETURN;
      IFEND;
      vefwa := vefwa + ver_request.cm_block.words_div_1000 * 10000(8);

    = stcm =
      ver_request.cm_block.fwa_div_1000 := vefwa DIV 10000(8);
      ver_request.cm_block.lwa_div_1000 := velwa DIV 10000(8);
      ver_request.cm_block.words_div_1000 := (velwa - vefwa) DIV 10000(8);

    = stmr =
      ver_request.resources.available_words_div_1000 := (vefwa - osmin) DIV
            10000(8);
      ver_request.resources.available_pps := 10;

    = rspp =
      FOR i := 1 TO ver_request.length DO
        ver_request.pp_list [i].pp_number := next_pp;
        pps := pps + $pp_set [next_pp];
        next_pp := next_pp + 1;
      FOREND;

    = rtpp =
      IF ver_request.return_all THEN
        pps := $pp_set [];
      IFEND;
      FOR i := 1 TO ver_request.length DO
        IF ver_request.pp_list [i].pp_number IN pps THEN
          ver_request.pp_list [i].status := 1;
          pps := pps - $pp_set [ver_request.pp_list [i].pp_number];
        ELSE
          ver_request.pp_list [i].status := 51(8);
          ver_request.general_status := 51(8);
        IFEND;
      FOREND;

    = stpp =
      FOR i := 1 TO ver_request.length DO
        IF ver_request.pp_list [i].pp_number IN pps THEN
          ver_request.pp_list [i].status := 1;
        ELSE
          ver_request.pp_list [i].status := 51(8);
          ver_request.general_status := 51(8);
        IFEND;
      FOREND;

    = rsch =
      FOR i := 1 TO ver_request.length DO
        chs := chs + $ch_set [ver_request.channel_list [i].channel];
      FOREND;

    = rtch =
      IF ver_request.return_all THEN
        chs := $ch_set [];
      IFEND;
      FOR i := 1 TO ver_request.length DO
        IF ver_request.channel_list [i].channel IN chs THEN
          ver_request.channel_list [i].status := 1;
          chs := chs - $ch_set [ver_request.channel_list [i].channel];
        ELSE
          ver_request.channel_list [i].status := 51(8);
          ver_request.general_status := 51(8);
        IFEND;
      FOREND;

    = stch =
      FOR i := 1 TO ver_request.length DO
        IF ver_request.channel_list [i].channel IN chs THEN
          ver_request.channel_list [i].status := 1;
        ELSE
          ver_request.channel_list [i].status := 51(8);
          ver_request.general_status := 51(8);
        IFEND;
      FOREND;

    = rseq =
      FOR i := 1 TO ver_request.length DO
        chs := chs + $ch_set [ver_request.channel_list [i].channel];
      FOREND;

    = rteq =
      IF ver_request.return_all THEN
        chs := $ch_set [];
      IFEND;
      FOR i := 1 TO ver_request.length DO
        IF ver_request.eq_list [i].channel IN chs THEN
          ver_request.eq_list [i].status := 1;
          chs := chs - $ch_set [ver_request.eq_list [i].channel];
        ELSE
          ver_request.eq_list [i].status := 51(8);
          ver_request.general_status := 51(8);
        IFEND;
      FOREND;

    = steq =
      FOR i := 1 TO ver_request.length DO
        IF ver_request.eq_list [i].channel IN chs THEN
          ver_request.eq_list [i].status := 1;
        ELSE
          ver_request.eq_list [i].status := 51(8);
          ver_request.general_status := 51(8);
        IFEND;
      FOREND;

    CASEND;

  PROCEND callver;
?? OLDTITLE ??
?? NEWTITLE := '  Simulated SDA interface', EJECT ??
{***********************************************************}
{}
{system deadstart assist interface definitions.
{}
{***********************************************************}


  CONST
{ logical pp numbers}
    maint_mntr = 4,
    disk_driver = 3,
    system_display_driver = 9,
    pp_resident = 10,
{ SDA function codes}
    read_mch = 2, {read maintenance channel}
    dump_pp_memory = 3, {dump pp memory to trace file}
    idle_pp = 5, {idle pp}
    register_size = 8,
    dac = 6, {deactivate pp}
    load_pp_from_ssr = 8;

  TYPE
    register_record = packed record
      register_value: packed array [1 .. register_size] of 0 .. 7777(8),
      number: 0 .. 7777(8),
      length: 0 .. 77(8),
      status: 0 .. 77(8),
    recend;

  TYPE
    pp_data_type = packed record
      port_code: 0 .. 7777(8),
      fill1: 0 .. 7777(8),
      ssr_buffer: 0 .. 77777777(8),
      completion: 0 .. 7777(8),
      buffer_length: 0 .. 7777(8),
      pp_number: 0 .. 7777(8),
      logical_pp_id: 0 .. 7777(8),
      fill2: 0 .. 77(8),
      data_buffer: ^cell,
    recend;

  PROCEDURE [XDCL] callsda (fn: integer;
    VAR pp_table: pp_data_type);
    utp$issue_dayfile_message ('call sda');
  PROCEND callsda;

?? OLDTITLE ??
MODEND dsmfci;
