*copyc OSD$DEFAULT_PRAGMATS
?? SET (LISTCTS := OFF) ??
MODULE bamtest_driver;
?? SET (LIST := OFF) ??
*copyc CLP$VALIDATE_NAME
*copyc CLE$ECC_LEXICAL
*copyc OSP$SET_STATUS_ABNORMAL
*copyc AMC$CONDITION_CODE_LIMITS
*copyc CLP$SCAN_PARAMETER_LIST
*copyc CLP$GET_VALUE
*copyc AMP$OPEN
*copyc AMP$GET_NEXT
*copyc AMP$CLOSE
*copyc AMP$TST_FID_OUT
*copyc AMP$TST_GETN_OUT
*copyc AMP$TST_STATUS_OUT
*copyc OST$STATUS
*copyc OST$NAME
*copyc CLP$PUT_JOB_OUTPUT

  PROCEDURE [XREF] bap$bamtest1;

  PROCEDURE [XREF] bap$bamtest2;

  PROCEDURE [XREF] bap$bamtest3;

  PROCEDURE [XREF] bap$bamtest4;

  PROCEDURE [XREF] bap$bamtest5;

  PROCEDURE [XREF] bap$bamtest6;

  PROCEDURE [XREF] bap$bamtest7;

  PROCEDURE [XREF] bap$bamtest8;

  PROCEDURE [XREF] bap$bamtest9;

  PROCEDURE [XREF] bap$bamtest10;

  PROCEDURE [XREF] bap$bamtest11;

  PROCEDURE [XREF] bap$bamtest12;

  PROCEDURE [XREF] bap$bamtest13;

  PROCEDURE [XREF] bap$bamtest14;

  PROCEDURE [XREF] bap$bamtest15;

  PROCEDURE [XREF] bap$bamtest16;

  PROCEDURE [XREF] bap$bamtest17;

  PROCEDURE [XREF] bap$bamtest18;

  PROCEDURE [XREF] bap$bamtest19;

  PROCEDURE [XREF] bap$bamtest20;

  PROCEDURE [XREF] bap$bamtest21;

  PROCEDURE [XREF] bap$bamtest22;

  PROCEDURE [XREF] bap$bamtest23;

  PROCEDURE [XREF] bap$bamtest24;

  PROCEDURE [XREF] bap$bamtest25;

  PROCEDURE [XREF] bap$bamtest26;

  PROCEDURE [XREF] bap$bamtest27;

  PROCEDURE [XREF] bap$bamtest28;

  PROCEDURE [XREF] bap$bamtest29;

  PROCEDURE [XREF] bap$bamtest30;

  PROCEDURE [XREF] bap$bamtest31;

  PROCEDURE [XREF] bap$bamtest32;

  PROCEDURE [XREF] bap$bamtest33;

  PROCEDURE [XREF] bap$bamtest34;

  PROCEDURE [XREF] bap$bamtest35;

  PROCEDURE [XREF] bap$bamtest36;

  PROCEDURE [XREF] bap$bamtest37;

  PROCEDURE [XREF] bap$bamtest38;

  PROCEDURE [XREF] bap$bamtest39;

  PROCEDURE [XREF] bap$bamtest40;

  PROCEDURE [XREF] bap$bamtest41;

  PROCEDURE [XREF] bap$bamtest42;

  PROCEDURE [XREF] bap$bamtest43;

  PROCEDURE [XREF] bap$bamtest44;

  PROCEDURE [XREF] bap$bamtest45;

  PROCEDURE [XREF] bap$bamtest46;

  PROCEDURE [XREF] bap$bamtest47;

  PROCEDURE [XREF] bap$bamtest48;

  PROCEDURE [XREF] bap$bamtest49;

  PROCEDURE [XREF] bap$bamtest50;
?? SET (LIST := ON) ??

  PROCEDURE [XDCL, #GATE] bamtest (parameter_list: clt$parameter_list;
    VAR status: ost$status);

    TYPE
      bat$input_ord = (bac$yes, bac$bamstop, bac$no, bac$long, bac$short,
        bac$tes1, bac$tes2, bac$tes3, bac$tes4, bac$tes5, bac$tes6, bac$tes7,
        bac$tes8, bac$tes9, bac$tes10, bac$tes11, bac$tes12, bac$tes13,
        bac$tes14, bac$tes15, bac$tes16, bac$tes17, bac$tes18, bac$tes19,
        bac$tes20, bac$tes21, bac$tes22, bac$tes23, bac$tes24, bac$tes25,
        bac$tes26, bac$tes27, bac$tes28, bac$tes29, bac$tes30, bac$tes31,
        bac$tes32, bac$tes33, bac$tes34, bac$tes35, bac$tes36, bac$tes37,
        bac$tes38, bac$tes39, bac$tes40, bac$tes41, bac$tes42, bac$tes43,
        bac$tes44, bac$tes45, bac$tes46, bac$tes47, bac$tes48, bac$tes49,
        bac$tes50, bac$garbage);

    CONST
      bac$long_msg_limit = 35,
      bac$short_msg_limit = 11;

{ pdt bamtest_pdt(input,i:fileref=input)

    VAR
      bamtest_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^bamtest_pdt_names, ^bamtest_pdt_params];

    VAR
      bamtest_pdt_names: [STATIC, READ, cls$pdt] array [1 .. 2] of
        clt$parameter_name_descriptor := [['INPUT', 1], ['I', 1]];

    VAR
      bamtest_pdt_params: [STATIC, READ, cls$pdt] array [1 .. 1] of
        clt$parameter_descriptor := [

{ INPUT I }
      [[clc$optional_with_default, ^bamtest_pdt_dv1], 1, 1, 1, 1,
        clc$value_range_not_allowed, [NIL, clc$file_value]]];

    VAR
      bamtest_pdt_dv1: [STATIC, READ, cls$pdt] string (5) := 'input';

    VAR
      value: clt$value,
      fid: amt$file_identifier,
      id: string (15),
      msg1,
      msg2,
      msg3: string (95),
      ptr: ^0 .. 00000ffffffff(16),
      stat: ost$status,
      cmod: bat$input_ord,
      command: ost$name,
      validated_name: ost$name,
      valid_name: boolean,
      exit_loop: boolean,
      i: integer,
      input_ord: bat$input_ord,
      input: array [bat$input_ord] of string (70),
      long_des: array [1 .. bac$long_msg_limit] of string (95),
      short_des: array [1 .. bac$short_msg_limit] of string (95),
      ba: amt$file_byte_address,
      tc: amt$transfer_count,
      fp: amt$file_position;

    CONST
      bac$null_command = '                                                    '
        CAT '                  ';

    { initialize general messages }

    msg1 := 'BAMTEST msg1: Would you like instructions?';
    msg2 := 'BAMTEST msg2: Would you like long or short form?';
    msg3 := 'BAMTEST msg3: Please enter your test request';

    { initialize input array }

    input [bac$garbage] := '    ';
    input [bac$bamstop] := 'BAMSTOP';
    input [bac$yes] := 'YES';
    input [bac$no] := 'NO';
    input [bac$long] := 'LONG';
    input [bac$short] := 'SHORT';
    input [bac$tes1] := 'TES1';
    input [bac$tes2] := 'TES2';
    input [bac$tes3] := 'TES3';
    input [bac$tes4] := 'TES4';
    input [bac$tes5] := 'TES5';
    input [bac$tes6] := 'TES6';
    input [bac$tes7] := 'TES7';
    input [bac$tes8] := 'TES8';
    input [bac$tes9] := 'TES9';
    input [bac$tes10] := 'TES10';
    input [bac$tes11] := 'TES11';
    input [bac$tes12] := 'TES12';
    input [bac$tes13] := 'TES13';
    input [bac$tes14] := 'TES14';
    input [bac$tes15] := 'TES15';
    input [bac$tes16] := 'TES16';
    input [bac$tes17] := 'TES17';
    input [bac$tes18] := 'TES18';
    input [bac$tes19] := 'TES19';
    input [bac$tes20] := 'TES20';
    input [bac$tes21] := 'TES21';
    input [bac$tes22] := 'TES22';
    input [bac$tes23] := 'TES23';
    input [bac$tes24] := 'TES24';
    input [bac$tes25] := 'TES25';
    input [bac$tes26] := 'TES26';
    input [bac$tes27] := 'TES27';
    input [bac$tes28] := 'TES28';
    input [bac$tes29] := 'TES29';
    input [bac$tes30] := 'TES30';
    input [bac$tes31] := 'TES31';
    input [bac$tes32] := 'TES32';
    input [bac$tes33] := 'TES33';
    input [bac$tes34] := 'TES34';
    input [bac$tes35] := 'TES35';
    input [bac$tes36] := 'TES36';
    input [bac$tes37] := 'TES37';
    input [bac$tes38] := 'TES38';
    input [bac$tes39] := 'TES39';
    input [bac$tes40] := 'TES40';
    input [bac$tes41] := 'TES41';
    input [bac$tes42] := 'TES42';
    input [bac$tes43] := 'TES43';
    input [bac$tes44] := 'TES44';
    input [bac$tes45] := 'TES45';
    input [bac$tes46] := 'TES46';
    input [bac$tes47] := 'TES47';
    input [bac$tes48] := 'TES48';
    input [bac$tes49] := 'TES49';
    input [bac$tes50] := 'TES50';

    { initialize descriptions }
    long_des [1] := 'BAMTEST: Long Description of commands.';
    long_des [2] :=
      'This procedure accepts input from the user to selectively execute';
    long_des [3] :=
      'user level procedures to exercise the basic access method program';
    long_des [4] :=
      'interface.  It will continue to ask for input until the string';
    long_des [5] :=
      '"stopbam" is entered, at which time the task will terminate and';
    long_des [6] :=
      'return you to NOS/VE.  Currently available test procedures and the';
    long_des [7] := 'input string used to call them are:';
    long_des [8] := '    ';
    long_des [9] := '    INPUT                      DESCRIPTION';
    long_des [10] := '    tes1:    Run severl amp$open and amp$close requests';
    long_des [11] :=
      '    tes2:    Run an amp$open, use amp$put_next to put a 100 byte';
    long_des [12] :=
      '             record, rewind, use amp$get_next to get a 100 byte record';
    long_des [13] :=
      '             and close the file.  It also verifies that the record put';
    long_des [14] := '             is the same as the record received.';
    long_des [15] :=
      '    tes3:    This proc opens a file, does two put_partials of 50 byte';
    long_des [16] :=
      '             partial records, and does four get_partials of 25 byte';
    long_des [17] := '             partial records, verifies that they are the'
      CAT ' same, and closes';
    long_des [18] := '             the file.';
    long_des [19] :=
      '    tes4:    This proc opens a file, does four put_next of 100 byte';
    long_des [20] :=
      '             records, a rewind, four get_next of 100 byte records, a';
    long_des [21] := '             close, and it verifies the records.';
    long_des [22] := '    tes5:    This proc opens a file, uses amp$put_next t'
      CAT 'o place several';
    long_des [23] :=
      '             records in a file.  It performs two amp$get_next requests';
    long_des [24] := '             checking for appropriate responses, does a '
      CAT 'rewind, and two';
    long_des [25] :=
      '             more get_nexts, first with wsl < record size, then with';
    long_des [26] := '             wsl > record size.';
    long_des [27] := '    tes6';
    long_des [28] := '    tes7:    This proc opens a file, rewinds it, does so'
      CAT 'me puts, closes';
    long_des [29] := '             the file, opens is a second time, rewinds i'
      CAT 't and does some';
    long_des [30] :=
      '             gets.  It verifies data transmission and closes the file';
    long_des [32] :=
      '    tes8:    This proc is the same as tes5, except is uses amp$file to';
    long_des [33] := '             change record type to amc$undefined first.';
    long_des [34] := '    tes9:    This proc performs an amp$file request, the'
      CAT 'n an amp$get_file_';
    long_des [35] :=
      '             attributes request to see if the data is stored correctly';

    { initialize short descriptions here }

    short_des [1] := 'BAMTEST Short Descriptions:';
    short_des [2] := '  tes1:  open and close';
    short_des [3] := '  tes2:  open, 1 put, 1 rewind, 1 get, close';
    short_des [4] :=
      '  tes3:  open, 2 put partials, rewind, 4 get partials, close';
    short_des [5] := '  tes4:  open, 4 putn, rewind, 4 getn, close';
    short_des [6] :=
      '  tes5:  open, several putn, 2 getn at eoi, rewind, getn wsl < rl,';
    short_des [7] := '         getn wsl > rl';
    short_des [8] := '  tes6:  ';
    short_des [9] := '  tes7:  open, rewind, several putn, close, open, rewind'
      CAT ', several getn, close';
    short_des [10] := '  tes8: same as tes5 with record type u';
    short_des [11] := '  tes9: open, file, get_file_attributes, close';
?? TITLE := 'actual program' ??
?? EJECT ??
    cmod := bac$garbage;
    exit_loop := FALSE;

    clp$scan_parameter_list (parameter_list, bamtest_pdt, stat);
    IF NOT stat.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('INPUT', 1, 1, clc$low, value, stat);
    IF NOT stat.normal THEN
      RETURN;
    IFEND;
    id := 'BAMDVR ';
    amp$open (value.file.local_file_name, amc$record, NIL, fid, status);
    IF NOT status.normal THEN
      amp$tst_status_out (id, status, stat);
    IFEND;

    ptr := #LOC (command);

  /main_loop/
    BEGIN
      REPEAT
        CASE cmod OF
        = bac$yes =
          clp$put_job_output (msg2, stat);
        = bac$no =
          clp$put_job_output (msg3, stat);
        = bac$long =
          FOR i := 1 TO bac$long_msg_limit DO
            clp$put_job_output (long_des [i], stat);
          FOREND;
          clp$put_job_output (msg3, stat);
        = bac$short =
          FOR i := 1 TO bac$short_msg_limit DO
            clp$put_job_output (short_des [i], stat);
          FOREND;
          clp$put_job_output (msg3, stat);
        = bac$tes1 =
          bap$bamtest1;
          clp$put_job_output (msg3, stat);
        = bac$tes2 =
          bap$bamtest2;
          clp$put_job_output (msg3, stat);
        = bac$tes3 =
          bap$bamtest3;
          clp$put_job_output (msg3, stat);
        = bac$tes4 =
          bap$bamtest4;
          clp$put_job_output (msg3, stat);
        = bac$tes5 =
          bap$bamtest5;
          clp$put_job_output (msg3, stat);
        = bac$tes6 =
          bap$bamtest6;
          clp$put_job_output (msg3, stat);
        = bac$tes7 =
          bap$bamtest7;
          clp$put_job_output (msg3, stat);
        = bac$tes8 =
          bap$bamtest8;
          clp$put_job_output (msg3, stat);
        = bac$tes9 =
          bap$bamtest9;
          clp$put_job_output (msg3, stat);
        = bac$tes10 =
          bap$bamtest10;
          clp$put_job_output (msg3, stat);
        = bac$tes11 =
          bap$bamtest11;
          clp$put_job_output (msg3, stat);
        = bac$tes12 =
          bap$bamtest12;
          clp$put_job_output (msg3, stat);
        = bac$tes13 =
          bap$bamtest13;
          clp$put_job_output (msg3, stat);
        = bac$tes14 =
          bap$bamtest14;
          clp$put_job_output (msg3, stat);
        = bac$tes15 =
          bap$bamtest15;
          clp$put_job_output (msg3, stat);
        = bac$tes16 =
          clp$put_job_output (msg3, stat);
        = bac$tes17 =
          clp$put_job_output (msg3, stat);
        = bac$tes18 =
          clp$put_job_output (msg3, stat);
        = bac$tes19 =
          clp$put_job_output (msg3, stat);
        = bac$tes20 =
          bap$bamtest20;
          clp$put_job_output (msg3, stat);
        = bac$tes21 =
          bap$bamtest21;
          clp$put_job_output (msg3, stat);
        = bac$tes22 =
          bap$bamtest22;
          clp$put_job_output (msg3, stat);
        = bac$tes23 =
          bap$bamtest23;
          clp$put_job_output (msg3, stat);
        = bac$tes24 =
          bap$bamtest24;
          clp$put_job_output (msg3, stat);
        = bac$tes25 =
          bap$bamtest25;
          clp$put_job_output (msg3, stat);
        = bac$tes26 =
          bap$bamtest26;
          clp$put_job_output (msg3, stat);
        = bac$tes27 =
          bap$bamtest27;
          clp$put_job_output (msg3, stat);
        = bac$tes28 =
          bap$bamtest28;
          clp$put_job_output (msg3, stat);
        = bac$tes29 =
          bap$bamtest29;
          clp$put_job_output (msg3, stat);
        = bac$tes30 =
          bap$bamtest30;
          clp$put_job_output (msg3, stat);
        = bac$tes31 =
          bap$bamtest31;
          clp$put_job_output (msg3, stat);
        = bac$tes32 =
          bap$bamtest32;
          clp$put_job_output (msg3, stat);
        = bac$tes33 =
          bap$bamtest33;
          clp$put_job_output (msg3, stat);
        = bac$tes34 =
          bap$bamtest34;
          clp$put_job_output (msg3, stat);
        = bac$tes35 =
          bap$bamtest35;
          clp$put_job_output (msg3, stat);
        = bac$tes36 =
          bap$bamtest36;
          clp$put_job_output (msg3, stat);
        = bac$tes37 =
          bap$bamtest37;
          clp$put_job_output (msg3, stat);
        = bac$tes38 =
          bap$bamtest38;
          clp$put_job_output (msg3, stat);
        = bac$tes39 =
          bap$bamtest39;
          clp$put_job_output (msg3, stat);
        = bac$tes40 =
          clp$put_job_output (msg3, stat);
        = bac$tes41 =
          bap$bamtest41;
          clp$put_job_output (msg3, stat);
        = bac$tes42 =
          bap$bamtest42;
          clp$put_job_output (msg3, stat);
        = bac$tes43 =
          clp$put_job_output (msg3, stat);
        = bac$tes44 =
          clp$put_job_output (msg3, stat);
        = bac$tes45 =
          clp$put_job_output (msg3, stat);
        = bac$tes46 =
          clp$put_job_output (msg3, stat);
        = bac$tes47 =
          clp$put_job_output (msg3, stat);
        = bac$tes48 =
          clp$put_job_output (msg3, stat);
        = bac$tes49 =
          clp$put_job_output (msg3, stat);
        = bac$tes50 =
          clp$put_job_output (msg3, stat);
        = bac$garbage =
          clp$put_job_output (msg1, stat);
        = bac$bamstop =
          amp$close (fid, status);
          amp$tst_status_out (id, status, stat);
          exit_loop := TRUE;
          EXIT /main_loop/;
        ELSE
          clp$put_job_output (msg3, stat);
        CASEND;
        command := bac$null_command;
        amp$get_next (fid, #LOC (command), 70, tc, ba, fp, status);
        amp$tst_getn_out (id, fid, 70, 0, tc, ba, fp, stat);
        amp$tst_status_out (id, status, stat);
        IF NOT status.normal THEN
          EXIT /main_loop/;
        IFEND;
        cmod := bac$garbage;
        clp$validate_name (command, validated_name, valid_name);
        IF NOT valid_name THEN
          osp$set_status_abnormal (amc$access_method_id, cle$improper_name,
                command, status);
          RETURN;
        IFEND;

      /for_loop/
        FOR input_ord := bac$yes TO PRED (bac$garbage) DO
          IF validated_name = input [input_ord] THEN
            cmod := input_ord;
            EXIT /for_loop/;
          IFEND;
        FOREND /for_loop/;
    UNTIL exit_loop;
  END /main_loop/;
PROCEND bamtest;

MODEND bamtest_driver;
